Verified Commit 16331169 authored by Bernd Paysan's avatar Bernd Paysan
Browse files

Fixes for GUI, for Android, new version of spit enabled, fix timeout handing for files

parent 1d7f708e

AndroidManifest/apps

+1 −1
Original line number Diff line number Diff line
@@ -22,7 +22,7 @@ cat <<EOF 
        </activity>

        <activity android:name="${APP_PACKAGE}.Gforth_n2o_gui"

                android:icon="@drawable/net2o"

                android:label="@string/net2o_app_name"

                android:label="@string/net2o_gui_name"

                android:windowAnimationStyle="@android:style/Animation.Activity"

		android:windowSoftInputMode="stateHidden|adjustResize"

                android:configChanges="orientation|screenSize|keyboardHidden"

addr.fs

+4 −3
Original line number Diff line number Diff line
@@ -107,8 +107,8 @@ previous 
    host:ipv4 be-ul@ dup IF host:ipv4 4 .ip4a 2drop  THEN

    host:portv4 w@ host:portv6 w@ = or  IF host:portv4 w@ ." :" 0 .r  THEN

    host:route $@ dup IF  '|' emit xtype  ELSE  2drop  THEN

    host:key sec@ dup IF  '$' emit .black85  ELSE  2drop  THEN

    host:ekey $@ dup IF  '§' xemit 85type  ELSE  2drop  THEN

    host:ekey $@ dup IF  ':' xemit <info> 85type <default>  ELSE  2drop  THEN

    host:key sec@ dup IF  ':' emit .black85  ELSE  2drop  THEN

    o> ; 



: .nat-addrs ( -- )
@@ -172,7 +172,8 @@ previous 
    priv-addr$ $[]free ;



: !my-addr$ ( -- )

    my-key-default 0= ?EXIT  my-addr$ $[]free

    my-key-default 0= ?EXIT

    my-addr$ $[]free  pub-addr$ $[]free  priv-addr$ $[]free

    now>never  my-addr[] [:

	nat( ." insert into my-addr$: " dup .addr forth:cr )

	dup .host:ekey-to 64@ 64dup 64-0= n>64 64+

connected.fs

+8 −6
Original line number Diff line number Diff line
@@ -301,13 +301,13 @@ $20 Value max-resend# 
: prepare-resend ( flag -- end start acks ackm taibits backbits headbits )

    data-rmap with mapc

	ack( ." head/tail: " dup forth:. dest-head hex. dest-tail hex. forth:cr )

	IF    dest-head addr>bytes -4 and

	ELSE  dest-head 1- addr>bytes 1+  THEN 0 max

	IF    dest-head dup >r addr>bytes -4 and

	ELSE  dest-top dup >r 1- addr>bytes 1+  THEN 0 max

	dest-tail addr>bytes -4 and \ dup data-ack# umin!

	data-ackbits @ dest-size addr>bytes 1-

	dest-tail addr>bits

	dest-back dest-size + addr>bits

	dest-head addr>bits

	r> addr>bits

    endwith ;



in net2o : do-resend ( flag -- )
@@ -524,7 +524,7 @@ in net2o : ack-code ( ackflag -- ackflag ) >r 
	net2o:gen-resend  net2o:genack

	r@ resend-toggle# and IF

	    ack( ." ack: do-resend" forth:cr )

	    true net2o:do-resend

	    ticker 64@ resend-all-to 64@ 64<> net2o:do-resend

	THEN

	0 data-rmap .mapc:do-slurp !@

	?dup-IF  ulit, ack-flush
@@ -541,7 +541,7 @@ in net2o : do-ack-rest ( ackflag -- ) 
    dup resend-toggle# and IF

	cmd-resend? drop

    THEN

    acks# and data-rmap .mapc:ack-advance?

    ( acks# and ) data-rmap .mapc:ack-advance?

    IF  net2o:ack-code  THEN  ack-timing ;



in net2o : do-ack ( -- )
@@ -565,9 +565,11 @@ also net2o-base 
    timeout( .keepalive )

    data-rmap dup 0= ?EXIT

    with mapc dest-req dup ack-advance? or to ack-advance? endwith

    timeout( dup IF  ." ack-advance"  ELSE  ." saving"  THEN  forth:cr )

    dup IF

	!ticks ticker 64@ resend-all-to 64!

	[ ack-toggle# resend-toggle# or ]L net2o:do-ack-rest  THEN ;

	[ ack-toggle# resend-toggle# or ]L net2o:do-ack-rest

    ELSE  net2o:save&done  THEN ;

previous



: cmd-timeout ( -- )  cmd-resend?

file.fs

+61 −33
Original line number Diff line number Diff line
@@ -355,10 +355,7 @@ Variable f-ramount 
Variable f-wid -1 f-wid !

Variable f-wamount



: fstates-free ( -- )

     file-state $@ bounds ?DO  I @ .dispose  cell +LOOP ;

: fstate-free ( -- )  file-state @ 0= ?EXIT

    [: fstates-free file-state $free ;] file-sema c-section ;

[IFDEF] old-spit

    in net2o : save-block ( back tail id -- delta ) { id -- delta }

	data-rmap with mapc fix-size raddr+ endwith residualwrite @ umin

	id id>addr? .fs-write
@@ -367,13 +364,37 @@ in net2o : save-block ( back tail id -- delta ) { id -- delta } 
	    ." spit: " f-wid @ . f-wamount @ hex. cr  THEN

	id f-wid ! dup f-wamount !  THEN )

	>blockalign dup negate residualwrite +! ;

[THEN]



\ careful: must follow exactly the same logic as slurp (see below)

in net2o : save-block ( back tail id len -- delta ) { id len -- delta }

    slurp( ." spit: " id hex. len hex. )

    id $FF = IF  swap - len umin \ only alignment

    ELSE

	data-rmap with mapc fix-size raddr+ endwith

	len umin

	id id>addr? .fs-write

    THEN

    len over - residualwrite ! ;



: .spit ( -- )

    spit#$ $@ 2dup dump

    bounds ?DO  I c@ hex. I 1+ p2@+ >r x64. cr r> I - +LOOP ;

    spit#$ $@ bounds ?DO  I c@ hex. I 1+ p2@+ >r x64. cr r> I - +LOOP ;



in net2o : spit [: { back tail | spitbuf# -- newback } +calc slurp( .spit )

	spit#$ $@ bounds ?DO

	    back tail I count swap p2@+ I - { +I }

	    64>n residualwrite @ - 0 max

	    net2o:save-block slurp( ." => " dup hex. forth:cr )

	    dup +to back

	    0<> residualwrite @ and IF  0 to +I  ELSE  residualwrite off  THEN

	    +I +to spitbuf#

	    back tail u>= ?LEAVE

	+I +LOOP

	spit#$ 0 spitbuf# $del

	back ;] file-sema c-section +file ;



\ careful: must follow exactly the same logic as slurp (see below)



[IFDEF] old-spit

    in net2o : spit { back tail -- newback }

	back tail back u<= ?EXIT fstates 0= ?EXIT drop

	slurp( ." spit: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
@@ -392,12 +413,18 @@ in net2o : spit { back tail -- newback } 
	slurp( .spit ) spit#$ $free

	slurp( ."  left: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.

	write-file# ? residualwrite @ hex. forth:cr ) ;

[THEN]



: save-to ( addr u n -- )  state-addr .fs-create ;

: save-to# ( addr u n -- )  state-addr >o  1 fs-class!  fs-create o> ;



\ file status stuff



: fstates-free ( -- )

     file-state $@ bounds ?DO  I @ .dispose  cell +LOOP ;

: fstate-free ( -- )  file-state @ 0= ?EXIT

    [: fstates-free file-state $free ;] file-sema c-section ;



scope{ net2o



: get-stat ( -- mtime mod )
@@ -427,7 +454,8 @@ base ! 
    dup blocksize !

    file( ." file read: ======= " dup . forth:cr

    ." file write: ======= " dup . forth:cr )

    dup residualread !  residualwrite ! ;

    [IFDEF] old-spit dup [ELSE] 0 [THEN]  residualwrite !

    residualread ! ;



: close-all ( -- )

    msg( ." Closing all files" forth:cr )

gui.fs

+18 −15
Original line number Diff line number Diff line
@@ -400,20 +400,19 @@ Variable user-avatar# 
Variable dummy-thumb#

Variable user.png$

Variable thumb.png$

: read-user.png ( -- )

    [ "doc/user.png" ]path user.png$ $slurp-file ;

: read-thumb.png ( -- )

    [ "minos2/thumb.png" ]path thumb.png$ $slurp-file ;

: read-user ( -- region )

    [ "doc/user.png" ]path user.png$ $slurp-file

    user.png$ $@ mem>thumb atlas-region ;

: read-thumb ( -- )

    [ "minos2/thumb.png" ]path thumb.png$ $slurp-file

    thumb.png$ $@ mem>thumb atlas-region ;

: user-avatar ( -- addr )

    user-avatar# @ 0= IF

	read-user.png user.png$ $@ mem>thumb atlas-region

	user-avatar# $!

	read-user user-avatar# $!

    THEN   user-avatar# $@ drop ;

: read-dummy ( -- addr u )

    read-thumb.png thumb.png$ $@ mem>thumb atlas-region ;

: dummy-thumb ( -- addr )

    dummy-thumb# @ 0= IF

	read-dummy dummy-thumb# $!

	read-thumb dummy-thumb# $!

    THEN   dummy-thumb# $@ drop ;

: avatar-thumb ( avatar -- )

    glue*avatar swap }}thumb >r {{ r> }}v 40%b ;
@@ -428,10 +427,14 @@ Variable thumb.png$ 
    >r r@ $@ read-avatar r> cell+ $@ smove ;

: re-dummy ( -- )

    dummy-thumb# @ 0= ?EXIT \ nobody has a dummy thumb

    read-dummy dummy-thumb# $@ smove ;

    read-thumb dummy-thumb# $@ smove ;

: re-user ( -- )

    user-avatar# @ 0= ?EXIT \ nobody has a dummy thumb

    read-user user-avatar# $@ smove ;



:noname defers free-thumbs

    re-dummy avatar# ['] re-avatar #map ; is free-thumbs

    re-user re-dummy avatar# ['] re-avatar #map

    fetch-finish# #frees ; is free-thumbs



event: :>update-avatar ( thumb hash u1 -- )

    avatar-frame swap .childs[] $@ drop @ >o to frame# o>
@@ -611,7 +614,7 @@ previous 
}}z box[] to id-frame



: show-nicks ( -- )

    dummy-thumb drop

    user-avatar drop dummy-thumb drop

    fill-nicks fill-groups !online-symbol

    next-slide +lang +resize  peers-box engage

    peers-box 0.01e [: .vp-top fdrop title-vp .vp-top +sync +resize ;] >animate ;
@@ -1049,8 +1052,8 @@ Variable re-indent# 
    keysize safe/string IF  c@ 4 and IF  swap  THEN  ELSE  drop  THEN ;



: update-thumb { d: hash object -- }

    hash avatar-frame object >o dup $10 dump to frame# hash >rotate

    frame# i.w frame# i.h tile-glue hash >swap .wh-glue!  o>

    hash avatar-frame object >o to frame# hash >rotate

    frame# i.w frame# i.h hash >swap  tile-glue .wh-glue!  o>

    [: +sync +resize ;] msgs-box .vp-needed +sync +resize ;



: 40%bv ( o -- o ) >o current-font-size% 40% f* fdup to border
@@ -1062,7 +1065,7 @@ Variable re-indent# 
	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# #!

	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[] ;