Check-in [b00fe09554]
Not logged in

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

Overview
Comment:Start image/thumbnail stuff
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: b00fe09554716fcb3c36cd28ae1f8cbbfe405195
User & Date: bernd 2019-11-28 14:48:36.371
Context
2019-11-28
16:14
Image+thumb stuff check-in: 76091b4829 user: bernd tags: trunk
14:48
Start image/thumbnail stuff check-in: b00fe09554 user: bernd tags: trunk
2019-11-27
22:36
Image recognizer check-in: e88060e605 user: bernd tags: trunk
Changes
Unified Diff Ignore Whitespace Patch
Changes to Makefile.in.
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
	  cmd.fs connected.fs connect.fs crypt.fs dht.fs err.fs file.fs	      \
	  gui.fs gui-night.fs net2o.fs ip.fs helper.fs keys.fs log.fs msg.fs  \
	  notify.fs qr.fs socks.fs squid.fs tools.fs vault.fs rng.fs xtype.fs \
	  $(TESTS) $(FORTHLIB) ed25519-donnalib.fs keccaklib.fs		      \
	  threefishlib.fs startn2o.fs doc/net2o-logo.png version.fs.in	      \
	  android/net.fs android/notify.fs linux/net.fs linux/notify.fs	      \
	  dhtroot.fs dvcs.fs qrscan.fs android/qrscan-android.fs	      \
	  linux/qrscan-linux.fs doc/net2o-200.png doc/net2o.png	doc/user.png  \
	  json/parser.fs json/g+-schema.fs json/g+-import.fs		      \
	  json/fb-schema.fs json/twitter-schema.fs json/test.fs		      \
	  json/test.json json/diaspora-schema.fs html/parser.fs xml/parser.fs \
	  xml/blogger-atom.fs

ICONS = icons/hicolor/128x128/apps/net2o.png				      \
	icons/hicolor/16x16/apps/net2o.png				      \
	icons/hicolor/192x192/apps/net2o.png				      \







|
|







41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
	  cmd.fs connected.fs connect.fs crypt.fs dht.fs err.fs file.fs	      \
	  gui.fs gui-night.fs net2o.fs ip.fs helper.fs keys.fs log.fs msg.fs  \
	  notify.fs qr.fs socks.fs squid.fs tools.fs vault.fs rng.fs xtype.fs \
	  $(TESTS) $(FORTHLIB) ed25519-donnalib.fs keccaklib.fs		      \
	  threefishlib.fs startn2o.fs doc/net2o-logo.png version.fs.in	      \
	  android/net.fs android/notify.fs linux/net.fs linux/notify.fs	      \
	  dhtroot.fs dvcs.fs qrscan.fs android/qrscan-android.fs	      \
	  linux/qrscan-linux.fs doc/net2o-200.png doc/net2o.png doc/user.png  \
	  doc/thumb.png json/parser.fs json/g+-schema.fs json/g+-import.fs    \
	  json/fb-schema.fs json/twitter-schema.fs json/test.fs		      \
	  json/test.json json/diaspora-schema.fs html/parser.fs xml/parser.fs \
	  xml/blogger-atom.fs

ICONS = icons/hicolor/128x128/apps/net2o.png				      \
	icons/hicolor/16x16/apps/net2o.png				      \
	icons/hicolor/192x192/apps/net2o.png				      \
Added doc/thumb.png.

cannot compute difference between binary files

Changes to gui.fs.
426
427
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
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

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 ;
Variable user-avatar#

Variable user.png$

: read-user.png ( -- )
    "doc/user.png" open-fpath-file throw 2drop
    dup >r user.png$ $slurp r> close-file throw ;



: user-avatar ( -- addr u )
    user-avatar# @ 0= IF
	read-user.png user.png$ $@ mem>thumb atlas-region
	user-avatar# $!
    THEN   user-avatar# $@ ;





: avatar-thumb ( avatar -- )
    glue*avatar swap }}thumb >r {{ r> }}v 40%b ;
: avatar-frame ( addr u -- frame# )
    2dup avatar# #@ nip 0= IF
	2dup read-avatar 2swap avatar# #!
    ELSE  2drop  THEN  last# cell+ $@ drop ;
: show-avatar ( addr u -- o / 0 )
    [: avatar-frame avatar-thumb ;] 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: :>update-avatar ( thumb hash u1 -- )
    avatar-frame swap .childs[] $@ drop @ >o to frame# o>
    ['] +sync peers-box .vp-needed +sync ;
event: :>fetch-avatar { thumb up hash u1 pk u2 -- }
    pk u2 $8 $A pk-connect? IF  +resend +flow-control
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	hash u1 net2o:copy# end-code| net2o:close-all disconnect-me
	<event thumb elit, hash u1 e$, :>update-avatar up event>
    ELSE  2drop  THEN ;

: ?+avatars ( o:key o/0 -- o )
    ?dup-0=-IF
	user-avatar drop avatar-thumb
	<event dup elit, up@ elit,
	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 user-avatar drop avatar-thumb   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







>
>
>




>

>



>
>
>
|



|
>
>
>
>
>


















|



|




|



















|







426
427
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
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

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>
: glue*thumb ( w h -- o )
    glue new >o pixelsize# fm* 0e 0g vglue-c glue!
    pixelsize# fm* 0e 0g hglue-c glue! 0glue dglue-c glue! o o> ;

: read-avatar ( addr u -- addr' u' )
    ?read-enc-hashed mem>thumb atlas-region ;
Variable user-avatar#
Variable dummy-thumb#
Variable user.png$
Variable thumb.png$
: read-user.png ( -- )
    "doc/user.png" open-fpath-file throw 2drop
    dup >r user.png$ $slurp r> close-file throw ;
: read-thumb.png ( -- )
    "doc/thumb.png" open-fpath-file throw 2drop
    dup >r thumb.png$ $slurp r> close-file throw ;
: user-avatar ( -- addr )
    user-avatar# @ 0= IF
	read-user.png user.png$ $@ mem>thumb atlas-region
	user-avatar# $!
    THEN   user-avatar# $@ drop ;
: dummy-thumb ( -- addr )
    dummy-thumb# @ 0= IF
	read-thumb.png thumb.png$ $@ mem>thumb atlas-region
	dummy-thumb# $!
    THEN   dummy-thumb# $@ drop ;
: avatar-thumb ( avatar -- )
    glue*avatar swap }}thumb >r {{ r> }}v 40%b ;
: avatar-frame ( addr u -- frame# )
    2dup avatar# #@ nip 0= IF
	2dup read-avatar 2swap avatar# #!
    ELSE  2drop  THEN  last# cell+ $@ drop ;
: show-avatar ( addr u -- o / 0 )
    [: avatar-frame avatar-thumb ;] 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: :>update-avatar ( thumb hash u1 -- )
    avatar-frame swap .childs[] $@ drop @ >o to frame# o>
    ['] +sync peers-box .vp-needed +sync ;
event: :>fetch-avatar { thumb task hash u1 pk u2 -- }
    pk u2 $8 $A pk-connect? IF  +resend +flow-control
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	hash u1 net2o:copy# end-code| net2o:close-all disconnect-me
	<event thumb elit, hash u1 e$, :>update-avatar task event>
    ELSE  2drop  THEN ;

: ?+avatars ( o:key o/0 -- o )
    ?dup-0=-IF
	user-avatar avatar-thumb
	<event dup elit, up@ elit,
	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 user-avatar avatar-thumb   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
1015
1016
1017
1018
1019
1020
1021


















1022
1023
1024
1025



1026
1027

1028

1029

1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
		THEN
	    ELSE
		I [: ."  [OTRifignore] #" u. forth:cr ;] do-debug
		2drop
	    THEN
	LOOP
    THEN ; wmsg-class is msg:otrify


















:noname ( addr u type -- )
    obj-red
    [: case 0 >r
	    msg:image#     of  ." img["      85type  endof



	    msg:thumbnail# of  ." thumb["    85type  endof
	    msg:patch#     of  ." patch["    85type  endof

	    msg:snapshot#  of  ." snapshot[" 85type  endof

	    msg:message#   of  ." message["  85type  endof

	    msg:posting#   of  ." posting"
		rdrop 2dup [d:h open-posting ;] >r
		.posting
	    endof
	endcase ." ]" r> ;] $tmp }}text
    swap ?dup-IF  0 click[]  THEN
    "object" name! msg-box .child+
    text-color!
; wmsg-class is msg:object

in net2o : new-wmsg ( o:connection -- o )
    o wmsg-class new >o  parent!  msg-table @ token-table ! o o> ;
' net2o:new-wmsg is net2o:new-msg







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


|
|
>
>
>
|
|
>
|
>
|
>
|
|
|
|
<
|







1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070

1071
1072
1073
1074
1075
1076
1077
1078
		THEN
	    ELSE
		I [: ."  [OTRifignore] #" u. forth:cr ;] do-debug
		2drop
	    THEN
	LOOP
    THEN ; wmsg-class is msg:otrify

Hash: thumbs#

: thumb-frame ( addr u -- o )
    keysize safe/string key|
    2dup thumbs# #@ nip 0= IF
	2dup read-avatar 2swap thumbs# #!
    ELSE  2drop  THEN  last# cell+ $@ drop ;

: ?thumb ( addr u -- o )
    2dup ['] thumb-frame catch 0= IF
	>r 2drop r@ i.w r@ i.h glue*thumb r> }}thumb
	EXIT  THEN
    2drop
    128 128 glue*thumb dummy-thumb }}thumb >r
    <event ['] drop elit, msg:id$ e$, e$,
    :>fetch-thumb ?query-task event> r> ;

:noname ( addr u type -- )
    obj-red
    case 0 >r
	msg:image#     of  [: ." img["      2dup 85type ']' emit
	    ;] $tmp }}text >r
	    <event ['] noop elit, msg:id$ e$, e$,
	    :>fetch-img ?query-task event> r>        endof
	msg:thumbnail# of  ?thumb                    endof
	msg:patch#     of  [: ." patch["    85type ']' emit
	    ;] $tmp }}text  endof
	msg:snapshot#  of  [: ." snapshot[" 85type ']' emit
	    ;] $tmp }}text  endof
	msg:message#   of  [: ." message["  85type ']' emit
	    ;] $tmp }}text  endof
	msg:posting#   of  ." posting"
	    rdrop 2dup [d:h open-posting ;] >r
	    ['] .posting $tmp }}text
	endof

    endcase r> ?dup-IF  0 click[]  THEN
    "object" name! msg-box .child+
    text-color!
; wmsg-class is msg:object

in net2o : new-wmsg ( o:connection -- o )
    o wmsg-class new >o  parent!  msg-table @ token-table ! o o> ;
' net2o:new-wmsg is net2o:new-msg
Changes to msg.fs.
472
473
474
475
476
477
478















479
480
481


482


483
484
485
486
487
488
489
    "👹" bounds U+DO
	dup 1 and IF  I xc@ xemit  THEN  2/
    I I' over - x-size  +LOOP  drop ;
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    pk .key-id ." : " perm 64@ 64>n .perms space
; msg-class is msg:perms















:noname ( addr u type -- )
    space <warn> case
	msg:image#     of  ." img["      85type  endof


	msg:thumbnail# of  ." thumb["    85type  endof


	msg:patch#     of  ." patch["    85type  endof
	msg:snapshot#  of  ." snapshot[" 85type  endof
	msg:message#   of  ." message["  85type  endof
	drop
	2dup keysize /string
	2dup printable? IF  '[' emit  type '@' emit
	ELSE  ." #["  85type ." /@"  THEN







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


|
>
>
|
>
>







472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
    "👹" bounds U+DO
	dup 1 and IF  I xc@ xemit  THEN  2/
    I I' over - x-size  +LOOP  drop ;
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    pk .key-id ." : " perm 64@ 64>n .perms space
; msg-class is msg:perms

event: :>fetch-img { xt: action d: pk d: hash }
    pk $8 $E pk-connect? IF  +resend +flow-control
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	hash key| net2o:copy# end-code| net2o:close-all disconnect-me
	action
    ELSE  2drop  THEN ;
event: :>fetch-thumb { xt: action d: pk d: hash }
    pk $8 $E pk-connect? IF  +resend +flow-control
	net2o-code expect+slurp $10 blocksize! $A blockalign!
	hash keysize safe/string key| net2o:copy#
	hash key| net2o:copy# end-code| net2o:close-all disconnect-me
	hash keysize 2* safe/string drop c@ action
    ELSE  2drop  THEN ;

:noname ( addr u type -- )
    space <warn> case
	msg:image#     of  ." img["      2dup 85type
	    <event ['] noop elit, msg:id$ e$, e$,
	    :>fetch-img ?query-task event>       endof
	msg:thumbnail# of  ." thumb["    85type ( 2dup 85type
	    <event ['] drop elit, msg:id$ e$, e$,
	    :>fetch-thumb ?query-task event> )   endof
	msg:patch#     of  ." patch["    85type  endof
	msg:snapshot#  of  ." snapshot[" 85type  endof
	msg:message#   of  ." message["  85type  endof
	drop
	2dup keysize /string
	2dup printable? IF  '[' emit  type '@' emit
	ELSE  ." #["  85type ." /@"  THEN