Hash: avatar#

glue new Constant glue*avatar
glue*avatar >o pixelsize# 64 fm* 0e 0g glue-dup hglue-c glue! vglue-c glue! 0glue dglue-c glue! o>

: read-avatar ( addr u -- addr' u' )
    ?read-enc-hashed mem>thumb atlas-region ;
: show-avatar ( addr u -- o / 0 )
    [: 2dup avatar# #@ nip 0= IF
	    2dup read-avatar 2swap avatar# #!
	ELSE  2drop  THEN
	glue*avatar last# cell+ $@ drop }}thumb
	>r {{ r> }}v 40%b ;] catch IF  2drop 0  THEN ;

: re-avatar ( last# -- )
    >r r@ $@ read-avatar r> cell+ $@ smove ;

:noname defers free-thumbs
    avatar# ['] re-avatar #map ; is free-thumbs

event: :>fetch-avatar ( hash u1 pk u2 -- )
    $8 $A pk-connect? IF  +resend +flow-control
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	net2o:copy# end-code| net2o:close-all disconnect-me
    ELSE  2drop  THEN ;

: ?+avatars ( o:key o/0 -- o / )
    ?dup-0=-IF
	<event ke-avatar $@ e$, ke-pk $@ e$, :>fetch-avatar
	?query-task event>
    THEN ;

: ?avatar ( addr u -- o / )
    key# #@ IF
	cell+ .ke-avatar $@ dup IF
	    show-avatar ?dup-0=-IF  THEN
	ELSE  2drop  THEN
    ELSE  drop  THEN ;

: show-nick ( o:key -- )
    ke-imports @ [ 1 import#provisional lshift ]L and ?EXIT
    ke-imports @ >im-color# sfloats { ki }
    {{ glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
	{{
	    {{ \large imports#rgb-fg ki + sf@ to x-color
		ke-avatar $@ dup IF  show-avatar ?+avatars
		ELSE  2drop  THEN
		ke-sk sec@ nip IF  \bold  ELSE  \regular  THEN  \sans
		['] .nick-base $tmp }}text 25%b
		ke-pets[] $[]# IF
		    {{
			x-color glue*l pet-color x-color slide-frame dup .button3 to x-color
			['] .pet-base $tmp }}text 25%b
		    }}z

    \G I got a reply, my address is unknown
    beacon( ticks .ticks ."  Got unknown reply: " sockaddr< alen @ .address forth:cr )
    sockaddr< alen @ beacons# #@ d0<> IF  last# do-beacon  THEN ;
: .-beacon ( addr u -- ) 2drop
    \G I got a reply, my address is known
    beacon( ticks .ticks ."  Got known reply: " sockaddr< alen @ .address forth:cr )
    sockaddr< alen @ beacons# #@ IF
	>r r@ 64@ ticks 64umin config:beacon-ticks& 2@ d>64 64+ r> 64!
    ELSE  drop  THEN ;
: >-beacon ( addr u -- )
    \G I got a punch
    nat( ticks .ticks ."  Got punch: " sockaddr< alen @ .address forth:cr )
    check-punch-hash ?dup-IF
	\ !!FIXME!! accept only two: one IPv4, one IPv6.
	\ !!FIXME!! and try merging the two into existent

\ typically after a minute or so.
\ To keep connections alive, you have to send a "beacon" a bit before
\ the connection would expire to refresh the NAT window.
\ beacons are send regularly regardless if you have any other traffic,
\ because that's easier to do.
\ beacons are one-byte packets, with ASCII characters to say what they mean




hash: beacons# \ destinations to send beacons to
Variable need-beacon# need-beacon# on \ true if needs a hash for the ? beacon

: next-beacon ( -- 64tick )
    64#-1 beacons# [: cell+ $@ drop 64@ 64umin ;] #map ;

: send-beacons ( -- ) !ticks
    beacons# [: dup $@ { baddr u } cell+ $@ drop { beacon }
	beacon 64@ ticker 64@ 64u<= IF
	    beacon( ticks .ticks ."  send beacon to: " baddr u .address )
	    ticker 64@ config:beacon-short-ticks& 2@ d>64 64+ beacon 64!
	    net2o-sock
	    beacon 64'+ @ ?dup-IF
		.beacon-hash $@ beacon( ."  hash: " 2dup 85type )
	    ELSE
		s" ?"
	    THEN
	    beacon( cr )
	    0 baddr u sendto drop +send
	THEN
	;] #map ;

: beacon? ( -- )
    next-beacon ticker 64@ 64u<= IF  send-beacons  THEN ;

: +beacon ( sockaddr len xt -- )
    >r ticks config:beacon-short-ticks& 2@ d>64 64+ o r> { 64^ dest w^ obj w^ xt }
    beacon( ." add beacon: " 2dup .address ."  ' " xt @ .name cr )
    2dup beacons# #@ d0= IF
	dest 1 64s cell+ cell+ 2swap beacons# #!
    ELSE
	obj 2 cells last# cell+ $+! 2drop
    THEN ;

    dirstack stack> { w^ dir }
    dir $@ set-dir throw  dir $free ;
: dir@ ( -- addr u )
    dirstack $[]# 1- dirstack $[]@ ;

scope{ config

2Variable beacon-ticks&
2Variable beacon-short-ticks&
2Variable dht-cleaninterval&
2Variable ekey-timeout&
Variable timeouts#
Variable passmode#
Variable logsize#
2Variable savedelta&
2Variable patchlimit&

[defined] android 1 and passmode# ! \ default is all entry is masked out
#14 timeouts# !

$1000.0000. patchlimit& 2! \ 256MB patch limit size
#10.000.000.000. savedelta& 2! \ 10 seconds deltat
#3600.000.000.000. ekey-timeout& 2! \ one hour ekey timeout
#60.000.000.000. dht-cleaninterval& 2! \ one minute dht clean interval
#50.000.000.000. beacon-ticks& 2!
#2.000.000.000. beacon-short-ticks& 2!

: .net2o-config/ ( addr u -- addr' u' ) [: .net2o-config$ $. '/' emit type ;] $tmp ;
: .net2o-cache/ ( addr u -- addr' u' ) [: .net2o-cache$ $. '/' emit type ;] $tmp ;
: ~net2o-cache/ ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop set-dir throw ;
: ~net2o-cache/.. ( addr u -- )
    .net2o-cache/ 2dup $1FF init-dir drop dirname set-dir throw ;