Check-in [e426aee2a6]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Background-load avatar image if not available
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e426aee2a617ee44ad98ac24ad6d2df3460fcfc8
User & Date: bernd 2019-11-26 20:35:38
Context
2019-11-26
22:05
Auto-load avatar check-in: 721303536c user: bernd tags: trunk
20:35
Background-load avatar image if not available check-in: e426aee2a6 user: bernd tags: trunk
2019-11-22
18:49
Show avatar only when known check-in: a8fe9cd4db user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to gui.fs.

428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446












447
448
449
450
451
452
453
454
455
456
457
458
459
460
461

462
463
464
465
466
467
468
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 )
    [: 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  THEN ;

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

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













: ?avatar ( addr u -- o / )
    key# #@ IF
	cell+ .ke-avatar $@ dup IF
	    show-avatar
	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  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







|




|






>
>
>
>
>
>
>
>
>
>
>
>




|









|
>







428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
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

Changes to helper.fs.

230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
    \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 beacon-ticks# 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







|







230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
    \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

Changes to net2o.fs.

1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
1786
1787
....
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
\ 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

#50.000.000.000 d>64 64Value beacon-ticks# \ 50s beacon tick rate
#2.000.000.000 d>64 64Value beacon-short-ticks# \ 2s short beacon tick rate

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@ beacon-short-ticks# 64+ beacon 64!
	    net2o-sock
	    beacon 64'+ @ ?dup-IF
		.beacon-hash $@ beacon( ."  hash: " 2dup 85type )
	    ELSE
		s" ?"
	    THEN
	    beacon( cr )
................................................................................
	THEN
	;] #map ;

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

: +beacon ( sockaddr len xt -- )
    >r ticks beacon-short-ticks# 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 ;








<
<
<










|







 







|







1760
1761
1762
1763
1764
1765
1766



1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
....
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
\ 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 )
................................................................................
	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 ;

Changes to tools.fs.

390
391
392
393
394
395
396


397
398
399
400
401
402
403
...
447
448
449
450
451
452
453


454
455
456
457
458
459
460
    dirstack stack> { w^ dir }
    dir $@ set-dir throw  dir $free ;
: dir@ ( -- addr u )
    dirstack $[]# 1- dirstack $[]@ ;

scope{ config



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



: .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 ;







>
>







 







>
>







390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
...
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
    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 ;