add statusbar, scrolling, fix generators
This commit is contained in:
parent
45f7c01b2d
commit
a5c95a04b4
BIN
assemble.com
BIN
assemble.com
Binary file not shown.
BIN
dialer.com
BIN
dialer.com
Binary file not shown.
14
dialer.jrt
14
dialer.jrt
|
@ -53,8 +53,15 @@ array dtmf-row 697 freq>div , 770 freq>div , 852 freq>div , 941 freq>div ,
|
||||||
45 probe-hi 50 probe-lo 15 probe-hi 60 probe-lo 60 probe-hi
|
45 probe-hi 50 probe-lo 15 probe-hi 60 probe-lo 60 probe-hi
|
||||||
300 fullduplex ;
|
300 fullduplex ;
|
||||||
|
|
||||||
|
( statusbar words )
|
||||||
|
var connected-time
|
||||||
|
var connected-site
|
||||||
|
|
||||||
( terminal words )
|
( terminal words )
|
||||||
: fixcursor texty 8 << textx | movecursor ;
|
: fixcursor
|
||||||
|
texty 24 - dup 0 > if times each 1 24 scrollup next 24 texty! else drop then
|
||||||
|
texty 8 << textx | movecursor ;
|
||||||
|
|
||||||
: nl nextline fixcursor ;
|
: nl nextline fixcursor ;
|
||||||
: emit draw-char fixcursor ;
|
: emit draw-char fixcursor ;
|
||||||
: xmit ( st -- ) chars each i emit 1 sleep-csec next ;
|
: xmit ( st -- ) chars each i emit 1 sleep-csec next ;
|
||||||
|
@ -154,8 +161,11 @@ var curr-logobit
|
||||||
15 textx! s" days of your limited trial!" xmit nl nl 200 sleep-csec
|
15 textx! s" days of your limited trial!" xmit nl nl 200 sleep-csec
|
||||||
lgray fg! ;
|
lgray fg! ;
|
||||||
|
|
||||||
|
: login black bg! white fg!
|
||||||
|
begin wait-key nl key>scan %esc != while s" LOGON PLEASE: " xmit repeat ;
|
||||||
|
|
||||||
: go splash 0 15 textxy!
|
: go splash 0 15 textxy!
|
||||||
s" 5551212" connect s" CONNECT 57600" xmit nl rick-welcome ;
|
s" 5551212" connect s" CONNECT 57600" xmit nl rick-welcome login ;
|
||||||
|
|
||||||
' go ' main redefine
|
' go ' main redefine
|
||||||
|
|
||||||
|
|
30
iter.jrt
30
iter.jrt
|
@ -142,15 +142,6 @@ nexttop :push >next
|
||||||
>next >next 1 nextpeek - >i :| 2 nextpeek +for? 3 |; >next ;
|
>next >next 1 nextpeek - >i :| 2 nextpeek +for? 3 |; >next ;
|
||||||
: pchars ( st -- ) 1- >i :| <i 1+ dup b@ if >i 1 else drop 0 then 1 |; >next ;
|
: pchars ( st -- ) 1- >i :| <i 1+ dup b@ if >i 1 else drop 0 then 1 |; >next ;
|
||||||
|
|
||||||
(
|
|
||||||
: gen-save-args [ extra-args... extra-arg-count -- ]
|
|
||||||
begin dup while swap >next 1- repeat drop ;
|
|
||||||
: gen-save [ 0 0 extra-args... extra-arg-count -- 1 cnext ]
|
|
||||||
>r r@ gen-save-args <r 2 + >rot drop drop 1 swap ;
|
|
||||||
: gen-restore [ arg-count -- args... ]
|
|
||||||
begin dup while <next swap 1- repeat drop ;
|
|
||||||
)
|
|
||||||
|
|
||||||
:asm _resume ( cpcancel -- 0 0 args... )
|
:asm _resume ( cpcancel -- 0 0 args... )
|
||||||
POP DX
|
POP DX
|
||||||
MOV AX SS
|
MOV AX SS
|
||||||
|
@ -162,8 +153,6 @@ nexttop :push >next
|
||||||
( make SP affect the nextstack and DI affect the data stack. )
|
( make SP affect the nextstack and DI affect the data stack. )
|
||||||
STD ( data stack grows down )
|
STD ( data stack grows down )
|
||||||
XCHG DI SP
|
XCHG DI SP
|
||||||
( PUSH decrements and then stores; STOSW stores then decrements. )
|
|
||||||
SCASW ( pre-decrement )
|
|
||||||
|
|
||||||
POP BX ( points to xt of the girl calling this, discard )
|
POP BX ( points to xt of the girl calling this, discard )
|
||||||
POP BX ( points to the following the yield )
|
POP BX ( points to the following the yield )
|
||||||
|
@ -172,6 +161,9 @@ nexttop :push >next
|
||||||
CMP @[ cancelled @] 0 #
|
CMP @[ cancelled @] 0 #
|
||||||
JNZ 0 @>
|
JNZ 0 @>
|
||||||
( not cancelled; move CX values from next-stack to data-stack )
|
( not cancelled; move CX values from next-stack to data-stack )
|
||||||
|
( PUSH decrements and then stores; STOSW stores then decrements. )
|
||||||
|
SCASW ( pre-decrement )
|
||||||
|
|
||||||
JCXZ 2 @>
|
JCXZ 2 @>
|
||||||
1 :>
|
1 :>
|
||||||
POP AX
|
POP AX
|
||||||
|
@ -190,24 +182,23 @@ nexttop :push >next
|
||||||
0 <:
|
0 <:
|
||||||
( cancelled! )
|
( cancelled! )
|
||||||
( fix SP )
|
( fix SP )
|
||||||
CLD SCASW XCHG SP DI
|
CLD XCHG SP DI
|
||||||
|
|
||||||
( throw away next values )
|
( throw away next values )
|
||||||
SHL CX 1 #
|
SHL CX 1 #
|
||||||
ADD DI AX
|
ADD DI CX
|
||||||
|
|
||||||
( update nexttop )
|
( update nexttop )
|
||||||
MOV @[ SS: nexttop @] DI
|
MOV @[ SS: nexttop @] DI
|
||||||
|
|
||||||
( abort the current word )
|
( abort the current word )
|
||||||
DEC BP DEC BP
|
DEC BP DEC BP
|
||||||
MOV SI @[ BP]
|
MOV SI @[ BP]
|
||||||
|
|
||||||
( run the "cancel" xt in DX )
|
( run the "cancel" xt in DX )
|
||||||
MOV BX DX
|
MOV BX DX
|
||||||
JMP @[ BX]
|
JMP @[ BX]
|
||||||
|
|
||||||
( : _resume [ cpcancel -- c f args... ]
|
|
||||||
nextdrop 0 0 <rot
|
|
||||||
cancelled @ if <next ub@ n-nextdrop execute rdrop return then
|
|
||||||
drop <next dup 1+ >r rswap ub@ gen-restore ; )
|
|
||||||
|
|
||||||
:asm _suspend ( 0 0 cpresume -- 1 n )
|
:asm _suspend ( 0 0 cpresume -- 1 n )
|
||||||
POP DX
|
POP DX
|
||||||
MOV AX SS
|
MOV AX SS
|
||||||
|
@ -241,9 +232,6 @@ nexttop :push >next
|
||||||
PUSH CX
|
PUSH CX
|
||||||
NEXT
|
NEXT
|
||||||
|
|
||||||
( : _suspend [ cpresume -- ]
|
|
||||||
rswap r@ ub@ swap >r gen-save rswap r>next r>next ; )
|
|
||||||
|
|
||||||
: GENSTART_ r>next :| ' noop _resume |; >next ;
|
: GENSTART_ r>next :| ' noop _resume |; >next ;
|
||||||
|
|
||||||
{ var gen-arg-count
|
{ var gen-arg-count
|
||||||
|
|
30
text.jrt
30
text.jrt
|
@ -172,3 +172,33 @@ var boxstyle
|
||||||
swap 2 - over boxmiddle
|
swap 2 - over boxmiddle
|
||||||
boxbottom ;
|
boxbottom ;
|
||||||
|
|
||||||
|
:asm segwordmove ( dst src count seg -- )
|
||||||
|
MOV BX DS
|
||||||
|
MOV AX SI
|
||||||
|
POP ES
|
||||||
|
MOV DX ES
|
||||||
|
MOV DS DX
|
||||||
|
POP CX
|
||||||
|
POP SI
|
||||||
|
POP DI
|
||||||
|
CMP DI SI
|
||||||
|
JL 0 @> ( if dst < src, then copy from the top )
|
||||||
|
STD
|
||||||
|
SHL CX 1 #
|
||||||
|
ADD DI CX
|
||||||
|
ADD SI CX
|
||||||
|
SHR CX 1 #
|
||||||
|
CMPSW ( decrement back to the beginning of the copy )
|
||||||
|
0 <:
|
||||||
|
REPZ MOVSW
|
||||||
|
CLD
|
||||||
|
MOV SI AX
|
||||||
|
MOV DS BX
|
||||||
|
NEXT
|
||||||
|
|
||||||
|
: scrollup ( y ybottom -- )
|
||||||
|
>r r@ over - pagew * swap
|
||||||
|
pagew 2* * textpage @ +
|
||||||
|
dup pagew 2* + <rot SCREENSEG segwordmove
|
||||||
|
textpos @ 0 <r textxy! pagew 32 draw-hrepeat textpos ! ;
|
||||||
|
|
||||||
|
|
BIN
tinyjort.com
BIN
tinyjort.com
Binary file not shown.
|
@ -505,9 +505,10 @@ dbg" boot"
|
||||||
POP AX
|
POP AX
|
||||||
ADD AX 4096 #
|
ADD AX 4096 #
|
||||||
MOV SS AX
|
MOV SS AX
|
||||||
MOV t& lastseg @+ AX
|
|
||||||
MOV SP 0x100 #
|
MOV SP 0x100 #
|
||||||
|
MOV t& lastseg @+ AX
|
||||||
MOV BP 0x00 #
|
MOV BP 0x00 #
|
||||||
|
CLD
|
||||||
NEXT
|
NEXT
|
||||||
|
|
||||||
target t& &here !t
|
target t& &here !t
|
||||||
|
|
BIN
zipoff.com
BIN
zipoff.com
Binary file not shown.
BIN
zipstub.seg
BIN
zipstub.seg
Binary file not shown.
Loading…
Reference in a new issue