Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | Chat thumbnail handling considderably improved |
---|---|
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
096c09b945034089c8c804563585ceff |
User & Date: | bernd 2019-12-02 20:27:46.341 |
Context
2019-12-02
| ||
22:24 | Start album viewer check-in: a28a0f2c63 user: bernd tags: trunk | |
20:27 | Chat thumbnail handling considderably improved check-in: 096c09b945 user: bernd tags: trunk | |
2019-12-01
| ||
23:02 | Better async fetch of thumbnails check-in: e500619da6 user: bernd tags: trunk | |
Changes
Changes to dvcs.fs.
︙ | ︙ | |||
893 894 895 896 897 898 899 | 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 -- ) | | | 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 | 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 over >r hash-in 2drop r> free throw ; : hash-out ( addr u -- ) base85>$ 2dup 2>r read-enc-hashed patch-in$ $@ 2r> hash-85 spit-file ; \ pull and sync a database $B $E 2Value dvcs-bufs# |
︙ | ︙ | |||
949 950 951 952 953 954 955 | : dvcs-connects? ( -- flag ) chat-keys ['] dvcs-connect-key $[]map dvcs-request# @ 0> ; : wait-dvcs-request ( -- ) BEGIN dvcs-request# @ WHILE stop REPEAT ; : need-hashed? ( addr u -- flag ) | | | 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 | : dvcs-connects? ( -- flag ) chat-keys ['] dvcs-connect-key $[]map dvcs-request# @ 0> ; : wait-dvcs-request ( -- ) BEGIN dvcs-request# @ WHILE stop REPEAT ; : need-hashed? ( addr u -- flag ) enchash>filename file-status nip no-file# = ; : +needed ( addr u -- ) 2dup need-hashed? IF dvcs( ." need: " 2dup 85type cr ) sync-file-list[] $ins[] drop ELSE dvcs( ." don't need: " 2dup 85type cr ) 2drop THEN ; |
︙ | ︙ |
Changes to gui.fs.
︙ | ︙ | |||
457 458 459 460 461 462 463 | 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# ) | | | 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 | 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# ) key| 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 ; |
︙ | ︙ | |||
1032 1033 1034 1035 1036 1037 1038 | ELSE I [: ." [OTRifignore] #" u. forth:cr ;] do-debug 2drop THEN LOOP THEN ; wmsg-class is msg:otrify | | | | < < | | | | > > > | > | | | | | > | > > > > > | > | | | | | | | 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 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 | ELSE I [: ." [OTRifignore] #" u. forth:cr ;] do-debug 2drop THEN LOOP THEN ; wmsg-class is msg:otrify : >rotate ( addr u -- ) keysize safe/string IF c@ to rotate# ELSE drop THEN ; : >swap ( w h addr u -- w h / h w ) keysize safe/string IF c@ 4 and IF swap THEN ELSE drop THEN ; : update-thumb { d: hash object -- } hash avatar-frame object >o to frame# hash >rotate frame# i.w 2* frame# i.h 2* tile-glue hash >swap .wh-glue! o> [: +sync +resize ;] msgs-box .vp-needed +sync +resize ; : 40%bv ( o -- o ) >o current-font-size% 40% f* fdup to border fnegate f2/ to borderv o o> ; : ?thumb { d: hash -- o } hash ['] avatar-frame catch 0= IF >r r@ i.w 2* r@ i.h 2* hash >swap glue*thumb r> }}thumb >r hash r@ .>rotate ELSE 128 128 glue*thumb dummy-thumb }}thumb >r r@ [n:h update-thumb ;] { w^ xt } xt cell hash key| fetch-finish# #! hash key| ?fetch THEN {{ glue*ll }}glue r> }}v 40%bv box[] ; :noname ( addr u type -- ) obj-red case 0 >r msg:image# of msg-box .childs[] $[]# ?dup-IF rdrop 1- msg-box .childs[] $[] @ dup .name$ "thumbnail" str= IF [: ." display image: " addr data $@ 85type cr ;] 2swap $make click[] drop EXIT THEN drop THEN [: ." img[" 85type ']' emit ;] $tmp }}text "image" name! endof msg:thumbnail# of ?thumb "thumbnail" name! endof msg:patch# of [: ." patch[" 85type ']' emit ;] $tmp }}text "patch" name! endof msg:snapshot# of [: ." snapshot[" 85type ']' emit ;] $tmp }}text "snapshot" name! endof msg:message# of [: ." message[" 85type ']' emit ;] $tmp }}text "message" name! endof msg:posting# of ." posting" rdrop 2dup [d:h open-posting ;] >r ['] .posting $tmp }}text "posting" name! endof endcase r> ?dup-IF 0 click[] THEN 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.
︙ | ︙ | |||
488 489 490 491 492 493 494 | last# cell+ $@len 0= IF last# $free last# cell+ $free THEN THEN THEN hashs drop free throw -1 queued# +! ; event: :>hash-finished { d: hash } | | | | 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 | last# cell+ $@len 0= IF last# $free last# cell+ $free THEN THEN THEN hashs drop free throw -1 queued# +! ; event: :>hash-finished { d: hash } hash fetch-finish# #@ IF @ >r hash r@ execute r> >addr free throw last# bucket-off ELSE drop THEN ; : fetch-queue { task d: pk d: hashs -- } pk $8 $E pk-connect? IF +resend +flow-control hashs bounds U+DO net2o-code expect+slurp $10 blocksize! $A blockalign! I' I keysize $10 * + umin I U+DO I keysize net2o:copy# I keysize up@ [{: d: hash task :}h <event hash e$, :>hash-finished task event> ;] lastfile@ >o to file-xt o> keysize +LOOP end-code| net2o:close-all keysize $10 * +LOOP disconnect-me ELSE hashs drop 0 to hashs |
︙ | ︙ | |||
537 538 539 540 541 542 543 | forward need-hashed? : ?fetch ( addr u -- ) key| 2dup need-hashed? IF msg:id$ fetch-queue# ?#+! ELSE 2drop THEN ; :noname ( addr u type -- ) space <warn> case | | | 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 | forward need-hashed? : ?fetch ( addr u -- ) key| 2dup need-hashed? IF msg:id$ fetch-queue# ?#+! ELSE 2drop THEN ; :noname ( addr u type -- ) space <warn> case msg:image# of ." img[" 2dup 85type endof msg:thumbnail# of ." thumb[" 2dup 85type ?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 |
︙ | ︙ | |||
794 795 796 797 798 799 800 | +zero16 nest$ 0 msg-group-o .msg:keys[] $[]@ encrypt$ ['] .encsign ']nestsig ; \ nest-sig for msg/msging classes ' message msging-class is start-req | > | | 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 | +zero16 nest$ 0 msg-group-o .msg:keys[] $[]@ encrypt$ ['] .encsign ']nestsig ; \ nest-sig for msg/msging classes ' message msging-class is start-req :noname quicksig( check-date )else( pk-sig? ) >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 |
︙ | ︙ | |||
1679 1680 1681 1682 1683 1684 1685 | : img-rec ( addr u -- .. token ) 2dup "img:" string-prefix? IF over ?flush-text [: 2dup + >r 4 /string save-mem over >r 2dup jpeg? IF 2dup >thumbnail ?dup-IF over >r hash-in | | | 1680 1681 1682 1683 1684 1685 1686 1687 1688 1689 1690 1691 1692 1693 1694 | : img-rec ( addr u -- .. token ) 2dup "img:" string-prefix? IF over ?flush-text [: 2dup + >r 4 /string save-mem over >r 2dup jpeg? IF 2dup >thumbnail ?dup-IF over >r hash-in [: forth:type img-orient 1- forth:emit ;] $tmp r> free throw THEN ELSE #0. THEN 2swap slurp-file over >r hash-in r> free throw 2swap [: dup IF $, msg:thumbnail# ulit, msg-object ELSE 2drop THEN $, msg:image# ulit, msg-object ;] r> free throw r> to last->in ;] catch 0= IF rectype-name EXIT THEN THEN |
︙ | ︙ |