: 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 2dup type cr 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 ;

: #needed ( hash -- )
    cell+ $@ key| +needed ;
: dvcs-needed-files ( -- )

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

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

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

:noname ( addr u type -- )
    obj-red
    case 0 >r
	msg:image#     of  [: ." img["      85type ']' emit
	    ;] $tmp }}text                           endof


	msg:thumbnail# of  ?thumb                    endof
	msg:patch#     of  [: ." patch["    85type ']' emit
	    ;] $tmp }}text  endof
	msg:snapshot#  of  [: ." snapshot[" 85type ']' emit
	    ;] $tmp }}text  endof
	msg:message#   of  [: ." message["  85type ']' emit
	    ;] $tmp }}text  endof

    rdrop false ;    

: bucket-off ( bucket -- ) dup $off cell+ $off ;

: #free? ( addrkey u bucket -- true / addrkey u false )
    >r r@ @ 0= IF  rdrop false  EXIT  THEN
    2dup r@ $@ str=  IF  2drop r> bucket-off true  EXIT  THEN
    rdrop false ;

$180 cells Constant table-size#

: hash@ ( bucket -- addr )  >r
    r@ @ 0= IF  table-size# allocate throw dup table-size# erase dup r> !
    ELSE  r> @  THEN ;

: #@ ( addrkey u hash -- addrval u / 0 0 ) { hash }
    2dup string-hash  hash$ bounds ?DO
	I c@ $7F and 2* cells hash @ dup 0= IF  2drop  LEAVE  THEN
	+ #@? IF  UNLOOP  EXIT  THEN
	I c@ $80 or $80 + cells hash @ + to hash
    LOOP  2drop #0. ;

: #+! ( addr1 u1 addr2 u2 -- )
    2dup #@ d0= IF  #!  ELSE  2drop last# cell+ $+!  THEN ;

: #free ( addrkey u hash -- )  { hash }
    2dup string-hash  hash$ bounds ?DO
	I c@ $7F and 2* cells hash @ dup 0= IF  2drop  LEAVE  THEN
	+ #free? IF  UNLOOP  EXIT  THEN
	I c@ $80 or $80 + cells hash @ + to hash
    LOOP  2drop ;

	dup 1 and IF  I xc@ xemit  THEN  2/
    I I' over - x-size  +LOOP  drop ;
:noname { 64^ perm d: pk -- }
    perm [ 1 64s ]L pk msg-group-o .msg:perms# #!
    pk .key-id ." : " perm 64@ 64>n .perms space
; msg-class is msg:perms

hash: fetch-queue#
hash: fetch-finish#
Variable queued#

event: :>del-queue { d: pk d: hashs -- }
    pk fetch-queue# #@ d0<> IF
	hashs last# cell+ $@ string-prefix? IF
	    last# cell+ 0 hashs nip $del
	    last# cell+ $@len 0= IF
		last# $free last# cell+ $free
	    THEN
	THEN
    THEN  hashs drop free throw
    -1 queued# +! ;
event: :>hash-finished { d: 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 ;]
		lastfile@ >o to file-xt o>
	    keysize +LOOP
	end-code| net2o:close-all
	keysize $10 *  +LOOP
	disconnect-me
    ELSE
	hashs drop 0 to hashs
    THEN
    <event pk e$, hashs e$, :>del-queue task event> ;

event: :>fetch-queue fetch-queue ;

: transmit-queue ( -- )
    fetch-queue#
    [:  1 queued# +! <event up@ elit, dup $@ e$, cell+ $@ save-mem e$,
	:>fetch-queue ?query-task event> ;] #map ;

Variable queue?
event: :>queued ( -- )
    transmit-queue  queue? off ;
: enqueue ( -- )
    queue? @ 0= IF  queue? on <event :>queued up@ event>  THEN ;

: ?#+! ( addr1 u1 addr2 u2 hash -- ) >r
    2dup r@ #@ d0= IF  r> #! enqueue  ELSE  2drop rdrop
	last# cell+ $@ bounds U+DO
	    2dup I over str= IF  2drop unloop  EXIT  THEN
	dup +LOOP  last# cell+ $+! enqueue
    THEN ;

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 ?fetch  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
	ELSE  ." #["  85type ." /@"  THEN

    dup 4 - 0 max safe/string ".jpg" str= ;
: 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 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
    2drop rectype-null ;

$Variable msg-recognizer
depth >r
' text-rec ' img-rec ' http-rec ' chain-rec ' tag-rec ' pk-rec
depth r> - msg-recognizer set-stack