Commit 16331169 authored by Bernd Paysan's avatar Bernd Paysan

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

parent 1d7f708e
......@@ -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"
......
......@@ -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+
......
......@@ -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?
......
......@@ -355,49 +355,76 @@ 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 ;
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
file1( id f-wid @ = IF dup f-wamount +!
ELSE f-wid @ 0>= f-wamount @ 0> and IF
[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
file1( id f-wid @ = IF dup f-wamount +!
ELSE f-wid @ 0>= f-wamount @ 0> and IF
." spit: " f-wid @ . f-wamount @ hex. cr THEN
id f-wid ! dup f-wamount ! THEN )
>blockalign dup negate residualwrite +! ;
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 ;
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.
write-file# ? residualwrite @ hex. forth:cr ) back tail
[: +calc fstates 0 { back tail states fails }
BEGIN tail back u> WHILE
back tail write-file# @ net2o:save-block dup +to back
IF 0 ELSE fails 1+ residualwrite off THEN to fails
residualwrite @ 0= IF
write-file# file+ blocksize @ residualwrite ! THEN
fails states u>= UNTIL
THEN
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.
write-file# ? residualwrite @ hex. forth:cr ) back tail
[: +calc fstates 0 { back tail states fails }
BEGIN tail back u> WHILE
back tail write-file# @ net2o:save-block dup +to back
IF 0 ELSE fails 1+ residualwrite off THEN to fails
residualwrite @ 0= IF
write-file# file+ blocksize @ residualwrite ! THEN
fails states u>= UNTIL
THEN
msg( ." Write end" cr ) +file
back fails states u>= IF >maxalign THEN \ if all files are done, align
;] file-sema c-section
slurp( .spit ) spit#$ $free
slurp( ." left: " tail rdata-back@ drop data-rmap with mapc dest-raddr - endwith hex.
write-file# ? residualwrite @ hex. forth:cr ) ;
back fails states u>= IF >maxalign THEN \ if all files are done, align
;] file-sema c-section
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 )
......
......@@ -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[] ;
......
......@@ -101,8 +101,8 @@ $Variable net2o-logo
[ELSE]
\ Use variables to avoid needing to quote stuff
\ Unfortunately, HTML quoting still needed
"TITLE" ['] notify-title $tmp ['] escape-<&> $tmp 1 setenv ?ior
"MESSAGE" notify@ 1 setenv ?ior
['] notify-title $tmp ['] escape-<&> $tmp "TITLE" 2swap 1 setenv ?ior
notify@ "MESSAGE" 2swap 1 setenv ?ior
[: notify-send $. space
." -a net2o -c im.received "
net2o-logo $@len IF
......
......@@ -465,6 +465,7 @@ scope: logstyles
}scope
:noname ( addr u -- )
2dup key| 0 .pk@ key| str= IF 2drop un-cmd EXIT THEN
last# >r 2dup key| to msg:id$
[: .simple-id ." : " ;] $tmp notify-nick!
r> to last# ; msg-notify-class is msg:start
......@@ -476,14 +477,21 @@ scope: logstyles
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:url
:noname ( addr u -- ) $utf8> notify+ ; msg-notify-class is msg:action
' drop msg-notify-class is msg:like
' 2drop msg-notify-class is msg:chain
' 2drop msg-notify-class is msg:re
' 2drop msg-notify-class is msg:lock
' noop msg-notify-class is msg:unlock
:noname 2drop 64drop ; msg-notify-class is msg:perms
' drop msg-notify-class is msg:away
' 2drop msg-notify-class is msg:coord
:noname 2drop 2drop ; msg-notify-class is msg:otrify
:noname drop 2drop ; msg-notify-class is msg:object
:noname ( -- ) msg-notify ; msg-notify-class is msg:end
:noname case
msg:image# of 2drop "img[] " notify+ endof
msg:thumbnail# of 2drop "thumb[] " notify+ endof
2drop
endcase ; msg-notify-class is msg:object
:noname ( -- )
msg-notify ; msg-notify-class is msg:end
:noname ( xchar -- ) ['] xemit $tmp notify+ ; msg-notify-class is msg:like
\ msg scan for hashes class
......@@ -573,14 +581,17 @@ end-class msg-?hash-class
; msg-class is msg:perms
event: :>hash-finished { d: hash -- }
hash fetch-finish# #@ IF
@ >r hash r@ execute r> >addr free throw
hash fetch-finish# #@ dup IF
bounds U+DO
I @ >r hash r@ execute r> >addr free throw
cell +LOOP
last# bucket-off
ELSE drop THEN
ELSE 2drop THEN
hash >ihave hash drop free throw ;
: fetch-queue 0 .pk.host $make { tsk w^ want# w^ pk$ -- }
want# tsk pk$ [{: tsk pk$ :}l { item }
item $@ pk$ $@ str= ?EXIT
item $@ $8 $E pk-connect? IF +resend +flow-control
{ | hashs }
item cell+ $@ bounds U+DO
......@@ -1250,7 +1261,7 @@ previous
2drop <err> ." Undecryptable message" <default> cr EXIT
THEN <info> THEN
sigpksize# - 2dup + sigpksize# >$ c-state off
nest-cmd-loop msg:end <default> ;
nest-cmd-loop o IF msg:end THEN <default> ;
: msg-tdisplay-silent ( addr u -- )
2dup 2 - + c@ $80 and IF msg-dec-sig? IF 2drop EXIT THEN THEN
sigpksize# - 2dup + sigpksize# >$ c-state off
......@@ -1415,7 +1426,7 @@ also net2o-base
: ihave, ( -- )
ihave$ $@ dup IF
maxstring over 4 + - mehave$ $@len - dup 0< IF 2drop EXIT THEN
keysize negate and dup >r
drop keysize negate and dup >r
$, mehave$ $@ $, msg-ihave
ihave$ 0 r> $del
ELSE 2drop THEN ;
......
......@@ -575,6 +575,9 @@ warnings !
\U sh cmd
\G sh: evaluate rest of command as shell command
source >in @ /string system source nip >in ! ;
synonym \ \ ( -- )
synonym #! \ ( -- )
\ hashbang comment
: debug ( -- )
\U debug [+|-<switch>]
......
......@@ -1689,7 +1689,7 @@ in net2o : dispose-context ( o:addr -- o:addr )
o-timeout o-chunks extra-dispose
data-rmap IF #0. data-rmap .mapc:dest-vaddr >dest-map 2! THEN
end-maps start-maps DO I @ ?dup-IF .mapc:free-data THEN cell +LOOP
end-strings start-strings DO I $off cell +LOOP
end-strings start-strings DO I $free cell +LOOP
end-secrets start-secrets DO I sec-free cell +LOOP
fstate-free
\ erase crypto keys
......
<?xml version="1.0" encoding="utf-8"?>
<resources>
<string name="net2o_app_name">net2o</string>
<string name="net2o_app_name">net2o TUI</string>
<string name="net2o_gui_name">net2o GUI</string>
</resources>
......@@ -5,4 +5,4 @@ page ." loading n2o..."
warnings off \ no warnings please
require n2o.fs
page
:noname load-rc save-net2o-cmds set-net2o-cmds n2o:gui ; is bootmessage
:noname load-rc save-net2o-cmds set-net2o-cmds n2o:gui bye ; is bootmessage
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