Check-in [c50e5d02db]
Not logged in

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

Overview
Comment:Added avatar display
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: c50e5d02db9725a5ea757ed2b80cc8dc9ddab9f7
User & Date: bernd 2019-03-19 22:48:59
Context
2019-03-20
13:13
Markdown viewer update check-in: ea0d5baddd user: bernd tags: trunk
2019-03-19
22:48
Added avatar display check-in: c50e5d02db user: bernd tags: trunk
2019-03-18
22:54
Improvement in social network display check-in: d9332e3ec1 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to dvcs.fs.

886
887
888
889
890
891
892
893


894

895

896
897
898
899
900
901
902
    dvcs:dispose-dvcs o> ;

: dvcs-revert ( -- ) \ restore to last revision
    dvcs:new-dvcs >o
    pull-readin  dvcs:oldid$ $@  2dup dvcs:id$ $!
    id>branches  co-rest
    dvcs:dispose-dvcs o> ;



: hash-in ( addr u -- hash u )

    2dup >file-hash 2>r write-enc-hashed 2drop 2r> ;

: hash-add ( addr u -- )
    slurp-file hash-in 2drop ;
: hash-out ( addr u -- )
    base85>$ 2dup 2>r read-enc-hashed patch-in$ $@ 2r> hash-85 spit-file ;

\ pull and sync a database









>
>

>
|
>







886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    dvcs:dispose-dvcs o> ;

: dvcs-revert ( -- ) \ restore to last revision
    dvcs:new-dvcs >o
    pull-readin  dvcs:oldid$ $@  2dup dvcs:id$ $!
    id>branches  co-rest
    dvcs:dispose-dvcs o> ;

hash#128 buffer: hash-save

: hash-in ( addr u -- hash u )
    2dup >file-hash hash-save hash#128 smove
    write-enc-hashed 2drop
    hash-save hash#128 ;
: hash-add ( addr u -- )
    slurp-file hash-in 2drop ;
: hash-out ( addr u -- )
    base85>$ 2dup 2>r read-enc-hashed patch-in$ $@ 2r> hash-85 spit-file ;

\ pull and sync a database

Changes to gui.fs.

394
395
396
397
398
399
400
























401
402
403
404
405
406

407
408
409
410
411
412
413
...
662
663
664
665
666
667
668

669
670
671
672
673
674
675
676
677
678
679
...
737
738
739
740
741
742
743



744
745
746

747
748
749
750
751
752
753
754
...
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
$0000FFFF color, sf,
$0000FFFF color, sf,
$00FFFFFF color, sf,

: nick[] ( box o:nick -- box )
    [: data >o ." clicked on " ke-nick $. cr o> ;] o click[] ;

























: 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-sk sec@ nip IF  \bold  ELSE  \regular  THEN  \sans
		['] .nick-base $tmp }}text 25%b
		ke-pets[] $[]# IF
		    {{ glue*l $00FF0020 color, slide-frame dup .button3
			['] .pet-base $tmp }}text 25%b
		    }}z
		THEN
................................................................................
to post-frame

: display-title { d: prj | ki -- }
    prj key>o ?dup-IF  .ke-imports @ >im-color# sfloats to ki  THEN
    {{
	glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
	{{

	    \large imports#rgb-fg ki + sf@ to x-color
	    prj key| ['] .key-id? $tmp }}text 40%b
	    glue*ll }}glue
	    \small prj drop keysize + le-64@ ['] .ticks $tmp }}text 40%b
	    \normal blackish
	}}h box[]
    }}z box[] project-vp .child+ ;

: display-file { d: prj -- }
    prj display-title
    prj [ keysize $10 + ]L safe/string
................................................................................
	pk startdate@ add-dtms
	pk key| last-bubble-pk $!  otr to last-otr?  text-color!
	{{
	    {{ glue*l }}glue
		{{ \sans \normal
		    {{
			glue*l }}glue



			\bold pk ['] .key-id $tmp }}text 25%b
			>o imports#rgb-fg last-ki >im-color# sfloats + sf@
			to text-color

			o o> me? IF  swap  THEN
			\regular
		    }}h
		    glue*l imports#rgb-bg last-ki >im-color# sfloats + sf@
		    slide-frame dup .button2
		    swap
		}}z me? 0= IF  chatname-tab  THEN
	    }}v
................................................................................
[IFDEF] android also android [THEN]

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

+db click( \ )
\ +db gui( \ )

{{ $80FFFFFF color, pres-frame
    {{
	{{
	    glue*l $000000FF color, slide-frame dup .button1
	    {{







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






>







 







>

|

|







 







>
>
>
|
|
|
>
|







 







|







394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
...
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
...
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
...
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
$0000FFFF color, sf,
$0000FFFF color, sf,
$00FFFFFF color, sf,

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

: show-avatar ( addr u -- o )
    2dup avatar# #@ nip 0= IF
	2dup ?read-enc-hashed
	patch-in$ $@ mem>thumb atlas-region 2swap avatar# #!
    ELSE  2drop  THEN
    thumbnail new >o
    "avatar" to name$
    white# to frame-color
    last# cell+ $@ drop to frame#
    glue*avatar to tile-glue o o>
    >r {{ r> }}v 40%b ;

: ?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
		    {{ glue*l $00FF0020 color, slide-frame dup .button3
			['] .pet-base $tmp }}text 25%b
		    }}z
		THEN
................................................................................
to post-frame

: display-title { d: prj | ki -- }
    prj key>o ?dup-IF  .ke-imports @ >im-color# sfloats to ki  THEN
    {{
	glue*l imports#rgb-bg ki + sf@ slide-frame dup .button1
	{{
	    prj key| ?avatar
	    \large imports#rgb-fg ki + sf@ to x-color
	    prj key| ['] .key-id? $tmp }}text 25%b
	    glue*ll }}glue
	    \small prj drop keysize + le-64@ [: .ticks space ;] $tmp }}text 25%b
	    \normal blackish
	}}h box[]
    }}z box[] project-vp .child+ ;

: display-file { d: prj -- }
    prj display-title
    prj [ keysize $10 + ]L safe/string
................................................................................
	pk startdate@ add-dtms
	pk key| last-bubble-pk $!  otr to last-otr?  text-color!
	{{
	    {{ glue*l }}glue
		{{ \sans \normal
		    {{
			glue*l }}glue
			0 pk key| ?avatar dup IF  nip
			    pk ['] .key-id $tmp 2drop
			ELSE  drop
			    \bold pk ['] .key-id $tmp }}text 25%b
			    >o imports#rgb-fg last-ki >im-color# sfloats + sf@
			    to text-color  o o>
			THEN
			me? IF  swap  THEN
			\regular
		    }}h
		    glue*l imports#rgb-bg last-ki >im-color# sfloats + sf@
		    slide-frame dup .button2
		    swap
		}}z me? 0= IF  chatname-tab  THEN
	    }}v
................................................................................
[IFDEF] android also android [THEN]

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

\ +db click( \ )
\ +db gui( \ )

{{ $80FFFFFF color, pres-frame
    {{
	{{
	    glue*l $000000FF color, slide-frame dup .button1
	    {{

Changes to keys.fs.

62
63
64
65
66
67
68
69

70
71
72
73
74
75
76
...
358
359
360
361
362
363
364

365
366
367
368
369
370
371
    ke-sksig sec-free
    ke-pk $free
    ke-nick $free
    ke-selfsig $free
    ke-chat $free
    ke-sigs[] $[]free
    ke-pets[] $[]free
    ke-pets# $free ;


\ key class

0
enum key#anon
enum key#user
enum key#group
................................................................................
    ." perm:   " ke-mask @ .perm cr ;
: .key-rest ( o:key -- o:key )
    ke-pk $@ key| .import85
    ke-wallet sec@ nip IF
	wallet( space ke-wallet sec@ .black85 )else( ."  W" )
    ELSE  wallet( $15 )else( 2 ) spaces THEN
    ke-selfsig $@ space .sigdates

    ke-groups $@ 2dup .in-groups groups>mask invert
    space ke-mask @ and -1 swap .permandor
    #tab emit ke-imports @ .imports
    space .nick+pet ;
: .key-list ( o:key -- o:key )
    ke-imports @ [ 1 import#provisional lshift ]L and ?EXIT
    ke-offset 64@ 64>d keypack-all# fm/mod nip 3 .r space







|
>







 







>







62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
...
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
    ke-sksig sec-free
    ke-pk $free
    ke-nick $free
    ke-selfsig $free
    ke-chat $free
    ke-sigs[] $[]free
    ke-pets[] $[]free
    ke-pets# $free
    ke-avatar $free ;

\ key class

0
enum key#anon
enum key#user
enum key#group
................................................................................
    ." perm:   " ke-mask @ .perm cr ;
: .key-rest ( o:key -- o:key )
    ke-pk $@ key| .import85
    ke-wallet sec@ nip IF
	wallet( space ke-wallet sec@ .black85 )else( ."  W" )
    ELSE  wallet( $15 )else( 2 ) spaces THEN
    ke-selfsig $@ space .sigdates
    ke-avatar $@ dup IF space 85type  ELSE  2drop  THEN
    ke-groups $@ 2dup .in-groups groups>mask invert
    space ke-mask @ and -1 swap .permandor
    #tab emit ke-imports @ .imports
    space .nick+pet ;
: .key-list ( o:key -- o:key )
    ke-imports @ [ 1 import#provisional lshift ]L and ?EXIT
    ke-offset 64@ 64>d keypack-all# fm/mod nip 3 .r space

Changes to kregion.fs.

15
16
17
18
19
20
21

22
23


24
25
26
27
28
29
30
31
32



33
34
35
36
37
38
39
40
41
42
43
\ You should have received a copy of the GNU Affero General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.

2Variable kregion \ current region pointer + remainder
Variable kfree64' \ free list for 64 bytes keys

$4000 Constant /kregion


$20 Constant crypt-align



: kalign ( addr -- addr' )
    [ crypt-align 1- ]L + [ crypt-align negate ]L and ;

: kalloc ( len -- addr )
    \G allocate a len byte block of non-swappable stuff
    kalign >r
    r@ /kregion u> !!kr-size!!
    kregion 2@ dup r@ u< IF



	2drop /kregion alloc+lock /kregion 2dup kregion 2!  THEN
    over swap r> safe/string kregion 2! ( kalloc( ." kalloc: " dup hex. cr ) ;

:noname defers 'image  #0. kregion 2! kfree64' off ; is 'image

\ fixed size secrets are assumed to be all 64 bytes long
\ if they are just 32 bytes, the second half is all zero

: kalloc64 ( -- addr )
    kfree64' @ ?dup-if  dup @ kfree64' ! dup off  exit  then
    64 kalloc ;







>


>
>









>
>
>
|


|







15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
\ You should have received a copy of the GNU Affero General Public License
\ along with this program.  If not, see <http://www.gnu.org/licenses/>.

2Variable kregion \ current region pointer + remainder
Variable kfree64' \ free list for 64 bytes keys

$4000 Constant /kregion
$10000 Constant /kregion-max \ the usual maximum locked memory is pathetic

$20 Constant crypt-align

0 Value /kregion#

: kalign ( addr -- addr' )
    [ crypt-align 1- ]L + [ crypt-align negate ]L and ;

: kalloc ( len -- addr )
    \G allocate a len byte block of non-swappable stuff
    kalign >r
    r@ /kregion u> !!kr-size!!
    kregion 2@ dup r@ u< IF
	/kregion +to /kregion#  2drop /kregion
	\ we have to fall back to alloc+guard if we want more than 64k
	/kregion# /kregion-max u> IF  alloc+guard  ELSE  alloc+lock  THEN
	/kregion 2dup kregion 2!  THEN
    over swap r> safe/string kregion 2! ( kalloc( ." kalloc: " dup hex. cr ) ;

:noname defers 'image  #0. kregion 2!  0 to /kregion# kfree64' off ; is 'image

\ fixed size secrets are assumed to be all 64 bytes long
\ if they are just 32 bytes, the second half is all zero

: kalloc64 ( -- addr )
    kfree64' @ ?dup-if  dup @ kfree64' ! dup off  exit  then
    64 kalloc ;