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#

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

    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 ;

	    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

	    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

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

    +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

: 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