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: |
4afc95c122b7a31ce4814cbda8982873 |
| 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
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*/ ;
|