Commit d9c1e1f5 authored by Bernd Paysan's avatar Bernd Paysan

Chat thumbnail handling considderably improved

parent 461cd699
......@@ -897,7 +897,7 @@ hash#128 buffer: hash-save
write-enc-hashed 2drop
hash-save hash#128 ;
: hash-add ( addr u -- )
slurp-file hash-in 2drop ;
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 ;
......@@ -953,7 +953,7 @@ previous
BEGIN dvcs-request# @ WHILE stop REPEAT ;
: need-hashed? ( addr u -- flag )
enchash>filename 2dup type cr file-status nip no-file# = ;
enchash>filename file-status nip no-file# = ;
: +needed ( addr u -- )
2dup need-hashed? IF
......
......@@ -461,7 +461,7 @@ Variable thumb.png$
: avatar-thumb ( avatar -- )
glue*avatar swap }}thumb >r {{ r> }}v 40%b ;
: avatar-frame ( addr u -- frame# )
2dup avatar# #@ nip 0= IF
key| 2dup avatar# #@ nip 0= IF
2dup read-avatar 2swap avatar# #!
ELSE 2drop THEN last# cell+ $@ drop ;
: show-avatar ( addr u -- o / 0 )
......@@ -1036,44 +1036,53 @@ Variable emojis$ "👍👎🤣😍😘😛🤔😭😡😱🔃" emojis$ $! \
LOOP
THEN ; wmsg-class is msg:otrify
Hash: thumbs#
: thumb-frame ( addr u -- rect )
key| 2dup thumbs# #@ nip 0= IF
2dup read-avatar 2swap thumbs# #!
ELSE 2drop THEN last# cell+ $@ drop ;
: >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 thumb-frame object .childs[] $@ drop @ >o to frame#
frame# i.w frame# i.h tile-glue .wh-glue! o>
[: +sync +resize ;] msgs-box vp-needed +sync +resize ;
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 ['] thumb-frame catch 0= IF
>r r@ i.w r@ i.h glue*thumb r> }}thumb
EXIT THEN
128 128 glue*thumb dummy-thumb }}thumb >r
r@ [n:h update-thumb ;] { w^ xt } xt cell hash key| fetch-finish# #!
hash key| ?fetch r> ;
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 [: ." img[" 85type ']' emit
;] $tmp }}text endof
msg:thumbnail# of ?thumb endof
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 endof
;] $tmp }}text "patch" name! endof
msg:snapshot# of [: ." snapshot[" 85type ']' emit
;] $tmp }}text endof
;] $tmp }}text "snapshot" name! endof
msg:message# of [: ." message[" 85type ']' emit
;] $tmp }}text endof
;] $tmp }}text "message" name! endof
msg:posting# of ." posting"
rdrop 2dup [d:h open-posting ;] >r
['] .posting $tmp }}text
['] .posting $tmp }}text "posting" name!
endof
endcase r> ?dup-IF 0 click[] THEN
"object" name! msg-box .child+
msg-box .child+
text-color!
; wmsg-class is msg:object
......
......@@ -492,7 +492,7 @@ event: :>del-queue { d: pk d: hashs -- }
THEN hashs drop free throw
-1 queued# +! ;
event: :>hash-finished { d: hash }
fetch-finish# #@ IF
hash fetch-finish# #@ IF
@ >r hash r@ execute r> >addr free throw
last# bucket-off
ELSE drop THEN ;
......@@ -504,7 +504,7 @@ event: :>hash-finished { d: hash }
I' I keysize $10 * + umin I U+DO
I keysize net2o:copy#
I keysize up@ [{: d: hash task :}h
<event hash e$, :>hash-finished ;]
<event hash e$, :>hash-finished task event> ;]
lastfile@ >o to file-xt o>
keysize +LOOP
end-code| net2o:close-all
......@@ -541,7 +541,7 @@ forward need-hashed?
:noname ( addr u type -- )
space <warn> case
msg:image# of ." img[" 2dup 85type ?fetch endof
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
......@@ -798,7 +798,8 @@ net2o' nestsig net2o: msg-nestsig ( $:cmd+sig -- ) \g check sig+nest
\ nest-sig for msg/msging classes
' message msging-class is start-req
:noname check-date >r 2dup r> ; msging-class is nest-sig
: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
......@@ -1683,7 +1684,7 @@ forward hash-in
4 /string save-mem over >r 2dup jpeg? IF
2dup >thumbnail
?dup-IF over >r hash-in
[: forth:type img-orient forth:emit ;] $tmp
[: 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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment