['] addme-end IS expect-reply? ;
previous

: +addme ['] addme  is setip-xt  next-request request-gen ! ;
: -setip ['] .iperr is setip-xt ;

: sub-me ( -- ) msg( ." sub-me" forth:cr )
    dht-connection >o o to connection  +resend
    net2o-code  expect-reply
    pk@ $, dht-id
    pub-addr$ [: sigsize# - 2dup + sigdate datesize# move
      gen-host-del $, dht-host- ;] $[]map
    end-with
    cookie+request
    end-code| o> ;

: addme-owndht ( -- )
    pk@ >d#id >o  dht-host $[]off
    my-addr$ [: dht-host $+[]! ;] $[]map o> ;

\ replace me stuff

    msg-tdisplay
    msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
    +sync +resize o> ;
' wmsg-display wmsg-class to msg:display

#128 Value gui-msgs# \ display last 128 messages
0 Value chat-edit    \ chat edit field
0 Value chat-edit-bg \ chat edit background

: (gui-msgs) ( gaddr u -- )
    reset-time
    64#0 to last-tick  last-bubble-pk $free
    0 to msg-par  0 to msg-box
    msgs-box .dispose-childs
    glue*lll }}glue msgs-box .child+

    [: msg-group$ $@ (gui-msgs) ;] !wrapper
    msgs-box >o [: +sync +resize ;] vp-needed vp-bottom
    +sync +resize o>  ;
' msg-wredisplay wmsg-class is msg:redisplay

[IFDEF] android also android [THEN]

: ?chat-otr-status ( o:edit-w -- )
    msg-group-o .msg:?otr
    IF   otr-col#  [ greenish x-color ] Fliteral
    ELSE chat-col# [ blackish x-color ] Fliteral  THEN
    chat-edit    >o to w-color o>
    chat-edit-bg >o to w-color o> ;

: chat-edit-enter ( o:edit-w -- )
    text$ dup IF  do-chat-cmd? 0= IF  avalanche-text
	ELSE  ?chat-otr-status  THEN
    ELSE  2drop  THEN
    64#-1 line-date 64!  $lastline $free ;

\ +db click( \ )
\ +db click-o( \ )
\ +db gui( \ )

		dup to msgs-box
		dup font-size# 66% f* fdup vslider
	    over >r }}h box[] r>
	    font-size# 66% f* fdup hslider
	}}v box[]
	{{
	    {{ glue*lll edit-bg x-color font-size# 40% f* }}frame dup .button3
		dup to chat-edit-bg
		{{ \normal \regular blackish "" }}edit 40%b dup to chat-edit glue*l }}glue
		    glue*lll }}glue
		}}h box[]
	    }}z chat-edit [: edit-w .chat-edit-enter drop nip 0 tuck false ;] edit[] ' size-limit filter[]
	    >o act >o [: connection .chat-next-line ;] is edit-next-line o> o o>
	    >o act >o [: connection .chat-prev-line ;] is edit-prev-line o> o o>
	    {{

    end-code| -setip net2o:send-replace  announced on ;

\ NAT retraversal

Forward insert-addr ( o -- )

: renat ( -- )

    [: msg:peers[] $@ bounds ?DO
	  I @ >o o-beacon pings
	  \ !!FIXME!! should maybe do a re-lookup?
	  ret-addr $10 erase  dest-0key dest-0key> !
	  punch-addrs $@ bounds ?DO
	      I @ insert-addr IF
		  o to connection
		  net2o-code new-request true gen-punchload gen-punch
		  end-code
	      THEN
	  cell +LOOP o>
      cell +LOOP
    ;] group#map ;

\ notification for address changes

[IFDEF] android     require android/net.fs  [ELSE]
    [IFDEF] PF_NETLINK  require linux/net.fs    [THEN]
[THEN]

	beacons# #frees
	0 >o dhtroot +dht-beacon o>
	renat
    [IFDEF] renat-complete ;] catch renat-complete throw [THEN]
    beacon( ." done renat" cr ) ;

scope{ /chat
:noname ( addr u -- ) renat-all /nat ; is /renat
}scope

\ beacon handling

event: :>do-beacon ( addr -- )
    beacon( ." :>do-beacon" forth:cr )
    { beacon } beacon cell+ $@ 1 64s /string bounds ?DO

forward avalanche-text

false value away?

: group#map ( xt -- )
    msg-group# swap [{: xt: xt :}l cell+ $@ drop cell+ .xt ;] #map ;

uval-o chat-cmd-o

object uclass chat-cmd-o
also net2o-base scope: /chat
umethod /me ( addr u -- )
    \U me <action>          send string as action
    \G me: send remaining string as action


umethod /away ( addr u -- )
    \U away [<action>]      send string or "away from keyboard" as action
    \G away: send string or "away from keyboard" as action
synonym /back /away
umethod /otr ( addr u -- )
    \U otr on|off|message   turn otr mode on/off (or one-shot)
umethod /chain ( addr u -- )
    \U chain on|off         turn chain mode on/off
umethod /peers ( addr u -- )
    \U peers                list peers
    \G peers: list peers in all groups
umethod /gps ( addr u -- )
    \U gps                  send coordinates
    \G gps: send your coordinates
synonym /here /gps
umethod /chats ( addr u -- )
    \U chats                list chats
    \G chats: list all chats
umethod /nat ( addr u -- )
    \U nat                  list NAT info
    \G nat: list nat traversal information of all peers in all groups
umethod /renat ( addr u -- )
    \U renat                redo NAT traversal
    \G renat: redo nat traversal
umethod /help ( addr u -- )
    \U help                 show help
    \G help: list help
umethod /myaddrs ( addr u -- )
    \U myaddrs              list my addresses
    \G myaddrs: list my own local addresses (debugging)
umethod /!myaddrs ( addr u -- )
    \U !myaddrs             re-obtain my addresses
    \G !myaddrs: if automatic detection of address changes fail,
    \G !myaddrs: you can use this command to re-obtain your local addresses
umethod /notify ( addr u -- )
    \U notify always|on|off|led <rgb> <on-ms> <off-ms>|interval <time>[smh]|mode 0-3
    \G notify: Change notificaton settings
umethod /beacons ( addr u -- )
    \U beacons              list beacons
    \G beacons: list all beacons
umethod /n2o ( addr u -- )
    \U n2o <cmd>            execute n2o command
    \G n2o: Execute normal n2o command
umethod /invitations ( addr u -- )
    \U invitations          handle invitations
    \G invitations: handle invitations: accept, ignore or block invitations
umethod /sync ( addr u -- )
    \U sync [+date] [-date] synchronize logs
    \G sync: synchronize chat logs, starting and/or ending at specific
    \G sync: time/date
umethod /version ( addr u -- )
    \U version              version string
    \G version: print version string
umethod /log ( addr u -- )
    \U log [#lines]         show log
    \G log: show the log, default is a screenful
umethod /logstyle ( addr u -- )
    \U logstyle [+-style]   set log style
    \G logstyle: set log styles, the following settings exist:
    \G logstyle: +date      a date per log line
    \G logstyle: +num       a message number per log line
umethod /otrify ( addr u -- )
    \U otrify #line[s]      otrify message
    \G otrify: turn an older message of yours into an OTR message
umethod /lock ( addr u -- )
    \U lock {@nick}         lock down
    \G lock: lock down communication to list of nicks
umethod /unlock ( addr u -- )
    \U unlock               stop lock down
    \G unlock: stop lock down
umethod /bye ( addr u -- )
    \U bye
    \G bye: leaves the current chat
umethod /chat ( addr u -- )
    \U chat [group][@user]  switch/connect chat
    \G chat: switch to chat with user or group
umethod /split ( addr u -- )
    \U split                split load
    \G split: reduce distribution load by reconnecting
end-class chat-cmds

chat-cmds new Constant text-chat-cmd-o

text-chat-cmd-o to chat-cmd-o

:noname ( addr u -- )
    [: $, msg-action ;] send-avalanche ; is /me

:noname ( addr u -- )
    dup 0= IF  2drop
	away? IF  "I'm back"  ELSE  "Away from keyboard"  THEN
	away? 0= to away?
    THEN
    [: $, msg-action ;] send-avalanche ; is /away


:noname ( addr u -- )

    2dup s" on" str= >r
    2dup s" off" str= r@ or IF   2drop
	msg-group-o r@ IF  .msg:+otr  ELSE  .msg:-otr  THEN
	<info> ." === " r> IF  ." enter"  ELSE  ." leave"  THEN
	."  otr mode ===" <default> forth:cr
    ELSE  rdrop
	msg-group-o .msg:mode @ >r
	msg-group-o .msg:+otr avalanche-text
	r> msg-group-o .msg:mode !
    THEN ; is /otr

:noname ( addr u -- )

    2dup s" on" str= >r
    s" off" str= r@ or IF
	msg-group-o r@ IF  .msg:+chain  ELSE  .msg:-chain  THEN
	<info> ." === " r> IF  ." enter"  ELSE  ." leave"  THEN
	."  chain mode ==="
    ELSE  <err> ." only 'chain on|off' are allowed" rdrop  THEN
    <default> forth:cr ; is /chain

:noname ( addr u -- )  2drop


    [: msg:name$ .group ." : "
	msg:peers[] $@ bounds ?DO
	    space I @ >o .con-id space
	    ack@ .rtdelay 64@ 64>f 1n f* (.time) o>
	cell +LOOP  forth:cr ;] group#map ; is /peers

:noname ( addr u -- )  2drop


    coord! coord@ 2dup 0 -skip nip 0= IF  2drop
    ELSE
	[: $, msg-coord ;] send-avalanche
    THEN ; is /gps



:noname ( addr u -- )


    bl skip '/' skip
    2dup [: ."     \U " forth:type ;] $tmp ['] .chathelp search-help
    [: ."     \G " forth:type ':' forth:emit ;] $tmp ['] .cmd search-help ;
is /help

:noname ( addr u -- )


    2drop .invitations ; is /invitations

:noname ( addr u -- )

    2drop ." ===== chats: "
    [:  msg:name$ msg-group$ $@ str= IF ." *" THEN
	msg:name$ .group
	." [" msg:peers[] $[]# 0 .r ." ]#"
	msg:log[] $[]# u. ;] group#map
    ." =====" forth:cr ; is /chats

:noname ( addr u -- )  2drop




    [:  ." ===== Group: " msg:name$ .group ."  =====" forth:cr
	msg:peers[] $@ bounds ?DO
	    ." --- " I @ >o .con-id ." : " return-address .addr-path
	    ."  ---" forth:cr .nat-addrs o>
	cell +LOOP ;] group#map ; is /nat

:noname ( addr u -- )


    2drop
    ." ===== all =====" forth:cr    .my-addr$s
    ." ===== public =====" forth:cr .pub-addr$s
    ." ===== private =====" forth:cr .priv-addr$s ; is /myaddrs
:noname ( addr u -- )



    2drop !my-addr ; is /!myaddrs

:noname ( addr u -- )


    ['] notify-cmds evaluate-in .notify ; is /notify

:noname ( addr u -- )


    2drop ." === beacons ===" forth:cr
    beacons# [: dup $@ .address space
      cell+ $@ over 64@ .ticks space
      1 64s safe/string bounds ?DO
	  I 2@ ?dup-IF ..con-id space THEN .name
      2 cells +LOOP forth:cr ;] #map ; is /beacons




:noname ( addr u -- )



    s>unumber? IF  drop  ELSE  2drop 0  THEN  cells >r
    msg-group-o .msg:peers[] $@ r@ u<= IF  drop rdrop  EXIT  THEN
    r> + @ >o o to connection
    ." === sync ===" forth:cr
    net2o-code expect-msg [: msg-group last?, ;] [msg,] end-code o> ; is /sync

:noname ( addr u -- )


    2drop .n2o-version space .gforth-version forth:cr ; is /version

:noname ( addr u -- )


    s>unumber? IF  drop >r  ELSE  2drop rows >r  THEN
    msg-group$ $@ >group purge-log
    r>  display-lastn ; is /log

:noname ( addr u -- )




    ['] logstyles evaluate-in ; is /logstyle

:noname ( addr u -- )


    msg-group-o .msg:mode dup @ msg:otr# or swap
    [: now>otr
	[: BEGIN  bl $split 2>r dup  WHILE  s>unumber? WHILE
			drop do-otrify  2r>  REPEAT THEN
	    2drop 2r> 2drop
	;] (send-avalanche) drop .chat save-msgs&
    ;] !wrapper ; is /otrify

:noname ( addr u -- )


    word-args ['] args>keylist execute-parsing
    [: key-list v-enc$ $, net2o-base:msg-lock ;] send-avalanche
    vkey keysize msg-keys[] $+[]!
    msg-group-o .msg:+lock ; is /lock
:noname ( addr u -- )


    2drop msg-group-o .msg:-lock ; is /unlock

:noname ( addr u -- )


    2drop -1 [IFDEF] android android:level# [ELSE] level# [THEN] +! ; is /bye
}scope

: ?slash ( addr u -- addr u flag )
    over c@ dup '/' = swap '\' = or ;

: do-chat-cmd? ( addr u -- t / addr u f )
    ?slash dup 0= ?EXIT  drop

      2dup pk-peek?  IF  chat-connect  ELSE  2drop  THEN ;] $[]map ;

: ?wait-chat ( -- addr u ) #0. /chat:/chats
    BEGIN  chats# 0= WHILE  wait-chat chat-connects  REPEAT
    msg-group$ $@ ; \ stub

scope{ /chat
:noname ( addr u -- )


    chat-keys $[]off nick>chat 0 chat-keys $[]@ key>group
    msg-group$ $@ >group msg-group-o .msg:peers[] $@ dup 0= IF  2drop
	nip IF  chat-connects
	ELSE  ." That chat isn't active" forth:cr  THEN
    ELSE
	bounds ?DO  2dup I @ .pubkey $@ key2| str= 0= WHILE  cell +LOOP
	    2drop chat-connects  ELSE  UNLOOP 2drop THEN
    THEN  #0. /chats ; is /chat
}scope

also net2o-base
: punch-addr-ind@ ( -- o )
    punch-addrs $[]# 0 U+DO
	I punch-addrs $[] @ .host:route $@len IF
	    I punch-addrs $[] @ unloop  EXIT

    msg:peers[] >r 0
    BEGIN  dup 1+ r@ $[]# u<  WHILE
	    dup r@ $[] 2@ .send-reconnect1
	    1+ dup r@ $[] @ >o o to connection disconnect-me o>
    REPEAT drop rdrop ;

scope{ /chat
:noname ( addr u -- )  2drop


    msg-group$ $@ >group msg-group-o .split-load ; is /split
}scope

\ chat toplevel

: do-chat ( addr u -- )
    get-order n>r
    chat-history  ['] /chat >body 1 set-order

?set-debug

:noname defers 'cold ?set-debug n2o-history ; is 'cold

\ allow issuing commands during chat

scope{ /chat

:noname [: word-args ['] evaluate do-net2o-cmds ;] catch
    ?dup-IF  <err> ." error: " error$ type cr <default>  THEN ; is /n2o

}scope

: start-n2o ( -- )
    [IFDEF] cov+ load-cov [THEN]
    cmd-args ++debug %droprate %droprate \ read in all debugging stuff
    profile( init-timer )
    argc @ 1 > IF next-cmd ELSE n2o:help THEN