Check-in [4afc95c122]
Not logged in

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

Overview
Comment:Store ihave informations in chat log
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 4afc95c122b7a31ce4814cbda89828738fb0c3b3
User & Date: bernd 2020-01-08 23:31:49
Context
2020-01-09
13:46
Temporary problem for notify-send, fix sending out ihaves check-in: 221f127fec user: bernd tags: trunk
2020-01-08
23:31
Store ihave informations in chat log check-in: 4afc95c122 user: bernd tags: trunk
2020-01-06
21:59
light/dark-mode check-in: a2d9044788 user: bernd tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to gui.fs.

675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
[ELSE]
    [IFDEF] linux
	: open-url ( addr u -- )
	    [: ." xdg-open " type ;] $tmp system ;
    [THEN]
[THEN]

: .posting ( addr u -- )
    2dup keysize /string
    2dup printable? IF  '[' emit type '@' emit
    ELSE  ." #["  85type ." /@"  THEN
    key| .key-id? ;

hash: chain-tags#

scope{ dvcs
dvcs-log-class class
end-class posting-log-class

Variable like-char







<
<
<
<
<
<







675
676
677
678
679
680
681






682
683
684
685
686
687
688
[ELSE]
    [IFDEF] linux
	: open-url ( addr u -- )
	    [: ." xdg-open " type ;] $tmp system ;
    [THEN]
[THEN]







hash: chain-tags#

scope{ dvcs
dvcs-log-class class
end-class posting-log-class

Variable like-char

Changes to keys.fs.

1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399

Variable tries#
#10 Value maxtries#

forward read-chatgroups

: n2o-greeting ( -- )
    [:  ." net2o " (c) ."  2010-2019 Bernd Paysan" cr
	." net2o interactive shell, type 'bye' to quit" cr ;]
    do-debug ;

: get-skc ( -- )
    secret-keys# IF  read-chatgroups  EXIT  THEN
    n2o-greeting  tries# off
    debug-vector @ op-vector !@ >r <default>







|







1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399

Variable tries#
#10 Value maxtries#

forward read-chatgroups

: n2o-greeting ( -- )
    [:  ." net2o " (c) ."  2010-2020 Bernd Paysan" cr
	." net2o interactive shell, type 'bye' to quit" cr ;]
    do-debug ;

: get-skc ( -- )
    secret-keys# IF  read-chatgroups  EXIT  THEN
    n2o-greeting  tries# off
    debug-vector @ op-vector !@ >r <default>

Changes to msg.fs.

72
73
74
75
76
77
78



79
80


81
82
83

84
85
86
87
88
89
90
91
...
301
302
303
304
305
306
307




308
309
310
311
312
313
314
315
316
317
318
319
320
321
...
461
462
463
464
465
466
467

468
469







































470
471
472
473
474
475
476
...
558
559
560
561
562
563
564






565
566
567
568
569
570
571
572
573
574

575
576
577
578
579
580
581
...
835
836
837
838
839
840
841























842
843
844
845
846
847
848
....
1132
1133
1134
1135
1136
1137
1138




1139
1140

1141
1142
1143
1144
1145
1146
1147
		    dup a[] $[] $free
		    a[] over cells cell $del
		ELSE
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;




: serialize-log ( addr u -- $addr )
    [: bounds ?DO


	    I $@ check-date 0= IF  net2o-base:$, net2o-base:nestsig
	    ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
      cell +LOOP ;]

    gen-cmd ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages in group " msg-group-o dup hex. .msg:name$ type cr )
    ?.net2o/chats  net2o:new-msging >o
................................................................................
Forward msg:want

hash: fetch-finish#
Variable fetch-queue[]

hash: ihave#





: .ihaves ( -- )
    ." ====== hash owend by ======" cr
    ihave# [: dup $@ 85type ." :"
	cell+ $@ bounds U+DO
	    space '@' emit
	    I $@ 2dup keysize2 safe/string type '.' emit
	    key2| .simple-id
	cell +LOOP cr ;] #map ;

: msg:ihave ( id u1 hash u2 -- )
\    ." ihave:" 2over dump 2dup dump
    2dup ihave$ $+!  2over mehave$ $!
    bounds U+DO  2dup I keysize ihave# #!ins[]  keysize +LOOP  2drop ;
: pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ;
................................................................................
' drop  msg-notify-class is msg:like
' 2drop  msg-notify-class is msg:lock
' noop  msg-notify-class is msg:unlock
:noname 2drop 64drop ; msg-notify-class is msg:perms
' drop  msg-notify-class is msg:away
' 2drop msg-notify-class is msg:coord
:noname 2drop 2drop ; msg-notify-class is msg:otrify

:noname ( -- ) msg-notify ; msg-notify-class is msg:end
:noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like








































:noname ( addr u -- )
    last# >r  2dup key| to msg:id$
    .log-num
    2dup startdate@ .log-date
    2dup enddate@ .log-end
    .key-id ." : " 
................................................................................
    -1 queue? !@ 0= IF  <event :>queued up@ event>  THEN ;

forward need-hashed?
: ?fetch ( addr u -- )
    key| 2dup need-hashed? IF
	fetch-queue[] ['] $ins[] resize-sema c-section drop
    ELSE  2drop  THEN ;







:noname ( addr u type -- )
    space <warn> case
	msg:image#     of  ." img["      2dup 85type ?fetch  endof
	msg:thumbnail# of  ." thumb["    2dup key| 85type
	    space 2dup keysize safe/string IF  c@ '0' + emit  ELSE  drop  THEN
	    ?fetch  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
	key| .key-id
	0
    endcase ." ]" <default> ;
................................................................................
    >r 2dup r> ; msging-class is nest-sig
' message msg-class is start-req
:noname 2dup msg-dec?-sig? ; msg-class is nest-sig

' context-table is gen-table

also }scope
























msging-table $save

: msg-reply ( tag -- )
    ." got reply " hex. pubkey $@ key>nick forth:type forth:cr ;
: expect-msg ( o:connection -- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;
................................................................................

: msg-tdisplay ( addr u -- )
    2dup 2 - + c@ $80 and IF  msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end <default> ;




' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display

: ?search-lock ( addr u -- )
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN
    REPEAT  2drop ;
: msg-tredisplay ( n -- )







>
>
>

|
>
>
|
|
|
>
|







 







>
>
>
>




|
<
<







 







>


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







 







>
>
>
>
>
>










>







 







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







 







>
>
>
>


>







72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322


323
324
325
326
327
328
329
...
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
514
515
516
517
518
519
520
521
522
523
524
...
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
...
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
....
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
		    dup a[] $[] $free
		    a[] over cells cell $del
		ELSE
		    1+
		THEN
	REPEAT  drop ;] msglog-sema c-section ;

forward msg-scan-hash
forward msg-serialize-hash

: serialize-log ( addr u -- $addr )
    [: [: bounds ?DO
		I $@ check-date 0= IF
		    2dup msg:display
		    net2o-base:$, net2o-base:nestsig
		ELSE   msg( ." removed entry " dump )else( 2drop )  THEN
	    cell +LOOP
	    msg-serialize-hash
	;] msg-scan-hash ;] gen-cmd ;

Variable saved-msg$
64Variable saved-msg-ticks

: save-msgs ( group-o -- ) to msg-group-o
    msg( ." Save messages in group " msg-group-o dup hex. .msg:name$ type cr )
    ?.net2o/chats  net2o:new-msging >o
................................................................................
Forward msg:want

hash: fetch-finish#
Variable fetch-queue[]

hash: ihave#

: .@host.id ( pk+host u -- )
    '@' emit
    2dup keysize2 safe/string type '.' emit
    key2| .simple-id ;
: .ihaves ( -- )
    ." ====== hash owend by ======" cr
    ihave# [: dup $@ 85type ." :"
	cell+ $@ bounds U+DO
	    space I $@ .@host.id


	cell +LOOP cr ;] #map ;

: msg:ihave ( id u1 hash u2 -- )
\    ." ihave:" 2over dump 2dup dump
    2dup ihave$ $+!  2over mehave$ $!
    bounds U+DO  2dup I keysize ihave# #!ins[]  keysize +LOOP  2drop ;
: pk.host ( -- addr u ) [: pk@ type host$ $. ;] $tmp ;
................................................................................
' drop  msg-notify-class is msg:like
' 2drop  msg-notify-class is msg:lock
' noop  msg-notify-class is msg:unlock
:noname 2drop 64drop ; msg-notify-class is msg:perms
' drop  msg-notify-class is msg:away
' 2drop msg-notify-class is msg:coord
:noname 2drop 2drop ; msg-notify-class is msg:otrify
:noname drop 2drop ; msg-notify-class is msg:object
:noname ( -- ) msg-notify ; msg-notify-class is msg:end
:noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like

\ msg scan for hashes class

msg-class class
    field: ?hashs[]
end-class msg-?hash-class

' 2drop msg-?hash-class is msg:start
' noop  msg-?hash-class is msg:end
' 2drop msg-?hash-class is msg:tag
' 2drop msg-?hash-class is msg:signal
' 2drop msg-?hash-class is msg:chain
' 2drop msg-?hash-class is msg:id
' 2drop msg-?hash-class is msg:re
' 2drop msg-?hash-class is msg:text
' 2drop msg-?hash-class is msg:url
' drop  msg-?hash-class is msg:like
:noname ( addr u -- )
    0 .v-dec$ dup IF
	msg-key!  msg-group-o .msg:+lock  THEN ; msg-?hash-class is msg:lock
:noname ( -- )
    msg-group-o .msg:-lock ; msg-?hash-class is msg:unlock
' drop msg-?hash-class is msg:away
:noname 2drop 64drop ; msg-?hash-class is msg:perms
:noname ( addr u id -- )
    case
	msg:image#      of  key| ?hashs[] $+[]!  endof
	msg:thumbnail#  of  key| ?hashs[] $+[]!  endof
	msg:patch#      of  key| ?hashs[] $+[]!  endof
	msg:snapshot#   of  key| ?hashs[] $+[]!  endof
	2drop
    endcase ; msg-?hash-class is msg:object

: msg-scan-hash ( ... xt -- ... )
    msg-?hash-class new >o
    msg-table @ token-table !
    execute dispose o> ;

\ main message class

:noname ( addr u -- )
    last# >r  2dup key| to msg:id$
    .log-num
    2dup startdate@ .log-date
    2dup enddate@ .log-end
    .key-id ." : " 
................................................................................
    -1 queue? !@ 0= IF  <event :>queued up@ event>  THEN ;

forward need-hashed?
: ?fetch ( addr u -- )
    key| 2dup need-hashed? IF
	fetch-queue[] ['] $ins[] resize-sema c-section drop
    ELSE  2drop  THEN ;

: .posting ( addr u -- )
    2dup keysize /string
    2dup printable? IF  '[' emit type '@' emit
    ELSE  ." #["  85type ." /@"  THEN
    key| .key-id? ;

:noname ( addr u type -- )
    space <warn> case
	msg:image#     of  ." img["      2dup 85type ?fetch  endof
	msg:thumbnail# of  ." thumb["    2dup key| 85type
	    space 2dup keysize safe/string IF  c@ '0' + emit  ELSE  drop  THEN
	    ?fetch  endof
	msg:patch#     of  ." patch["    85type  endof
	msg:snapshot#  of  ." snapshot[" 85type  endof
	msg:message#   of  ." message["  85type  endof
	msg:posting#   of  ." posting" .posting  endof
	drop
	2dup keysize /string
	2dup printable? IF  '[' emit  type '@' emit
	ELSE  ." #["  85type ." /@"  THEN
	key| .key-id
	0
    endcase ." ]" <default> ;
................................................................................
    >r 2dup r> ; msging-class is nest-sig
' message msg-class is start-req
:noname 2dup msg-dec?-sig? ; msg-class is nest-sig

' context-table is gen-table

also }scope

\ serialize hashes

: msg-serialize-hash ( -- )
    { | w^ want# }
    ?hashs[] want# [{: want# :}l
	2dup ihave# #@ dup IF
	    bounds U+DO
		2dup I $@ want# #+!
	    cell +LOOP  2drop
	ELSE  2drop
	    2dup need-hashed? IF  2drop   ELSE  
		0 .pk.host
		2over 2over 2swap ihave# #!ins[]
		want# #+!
	    THEN
	THEN
    ;] $[]map
    want# [:
	msg( dup $@ .@host.id ." : " dup cell+ $@ 85type forth:cr )
	dup cell+ $@ $, $@ $, msg-ihave ;] #map
    ?hashs[] $[]free
    want# #frees ;

msging-table $save

: msg-reply ( tag -- )
    ." got reply " hex. pubkey $@ key>nick forth:type forth:cr ;
: expect-msg ( o:connection -- )
    reply( ['] msg-reply )else( ['] drop ) expect-reply-xt +chat-control ;
................................................................................

: msg-tdisplay ( addr u -- )
    2dup 2 - + c@ $80 and IF  msg-dec-sig? IF
	    2drop <err> ." Undecryptable message" <default> cr  EXIT
	THEN  <info>  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end <default> ;
: msg-tdisplay-silent ( addr u -- )
    2dup 2 - + c@ $80 and IF  msg-dec-sig? IF  2drop  EXIT  THEN  THEN
    sigpksize# - 2dup + sigpksize# >$  c-state off
    nest-cmd-loop msg:end ;
' msg-tdisplay msg-class is msg:display
' msg-tdisplay msg-notify-class is msg:display
' msg-tdisplay-silent msg-?hash-class is msg:display
: ?search-lock ( addr u -- )
    BEGIN  dup  WHILE  cell- 2dup + $@ sigpksize# - 1- + c@ $2E = IF
		2dup + $@ ['] msg:display catch IF  2drop  THEN
		msg-group-o .msg:keys[] $[]# IF  drop 0  THEN
	    THEN
    REPEAT  2drop ;
: msg-tredisplay ( n -- )

Changes to qrscan.fs.

420
421
422
423
424
425
426








427
428


429
430
431
432
433
434
435
	new-scantex-raw new-scantex new-scantex-final 0>framebuffer
    THEN ;
: scale+rotate ( -- )
    p1 2@ p0 2@ p- p3 2@ p2 2@ p- p+ p2/
    s>f y-scansize f/ y-rots sf!  s>f x-scansize f/ x-scl sf!
    p0 2@ p2 2@ p- p1 2@ p3 2@ p- p+ p2/
    s>f y-scansize f/ y-scl sf!  s>f x-scansize f/ x-rots sf! ;








: set-scan' ( -- )
    compute-xpoint ( .. x y )


    scale+rotate
    y-offset f+ scan-w fm/ y-spos sf!
    x-offset f+ scan-w fm/ x-spos sf! ;

: scan-xy ( -- sx sy )
    1e cam-h cam-w over umin swap fm*/
    1e cam-w cam-h over umin      fm*/ ;







>
>
>
>
>
>
>
>


>
>







420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
	new-scantex-raw new-scantex new-scantex-final 0>framebuffer
    THEN ;
: scale+rotate ( -- )
    p1 2@ p0 2@ p- p3 2@ p2 2@ p- p+ p2/
    s>f y-scansize f/ y-rots sf!  s>f x-scansize f/ x-scl sf!
    p0 2@ p2 2@ p- p1 2@ p3 2@ p- p+ p2/
    s>f y-scansize f/ y-scl sf!  s>f x-scansize f/ x-rots sf! ;
: pf+ ( fx fy fx' fy' -- fx+x' fy+y' )
    frot f+ f-rot f+ fswap ;
: perspective { f: x f: y -- x' y' }
    p0 2@ s>f y f- s>f x f-
    p1 2@ s>f y f- s>f x f- fnegate fswap pf+
    p2 2@ s>f y f- s>f x f- fnegate fswap fnegate fswap pf+
    p3 2@ s>f y f- s>f x f- fswap fnegate pf+
    f2/ f2/ fswap f2/ f2/  ;
: set-scan' ( -- )
    compute-xpoint ( .. x y )
\    fover fover .xpoint
    fover fover perspective f. f. cr
    scale+rotate
    y-offset f+ scan-w fm/ y-spos sf!
    x-offset f+ scan-w fm/ x-spos sf! ;

: scan-xy ( -- sx sy )
    1e cam-h cam-w over umin swap fm*/
    1e cam-w cam-h over umin      fm*/ ;