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
|
||||
300 fullduplex ;
|
||||
|
||||
( statusbar words )
|
||||
var connected-time
|
||||
var connected-site
|
||||
|
||||
( 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 ;
|
||||
: emit draw-char fixcursor ;
|
||||
: 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
|
||||
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!
|
||||
s" 5551212" connect s" CONNECT 57600" xmit nl rick-welcome ;
|
||||
s" 5551212" connect s" CONNECT 57600" xmit nl rick-welcome login ;
|
||||
|
||||
' 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 ;
|
||||
: 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... )
|
||||
POP DX
|
||||
MOV AX SS
|
||||
|
@ -162,8 +153,6 @@ nexttop :push >next
|
|||
( make SP affect the nextstack and DI affect the data stack. )
|
||||
STD ( data stack grows down )
|
||||
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 the following the yield )
|
||||
|
@ -172,6 +161,9 @@ nexttop :push >next
|
|||
CMP @[ cancelled @] 0 #
|
||||
JNZ 0 @>
|
||||
( 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 @>
|
||||
1 :>
|
||||
POP AX
|
||||
|
@ -190,24 +182,23 @@ nexttop :push >next
|
|||
0 <:
|
||||
( cancelled! )
|
||||
( fix SP )
|
||||
CLD SCASW XCHG SP DI
|
||||
CLD XCHG SP DI
|
||||
|
||||
( throw away next values )
|
||||
SHL CX 1 #
|
||||
ADD DI AX
|
||||
ADD DI CX
|
||||
|
||||
( update nexttop )
|
||||
MOV @[ SS: nexttop @] DI
|
||||
|
||||
( abort the current word )
|
||||
DEC BP DEC BP
|
||||
MOV SI @[ BP]
|
||||
|
||||
( run the "cancel" xt in DX )
|
||||
MOV BX DX
|
||||
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 )
|
||||
POP DX
|
||||
MOV AX SS
|
||||
|
@ -241,9 +232,6 @@ nexttop :push >next
|
|||
PUSH CX
|
||||
NEXT
|
||||
|
||||
( : _suspend [ cpresume -- ]
|
||||
rswap r@ ub@ swap >r gen-save rswap r>next r>next ; )
|
||||
|
||||
: GENSTART_ r>next :| ' noop _resume |; >next ;
|
||||
|
||||
{ var gen-arg-count
|
||||
|
|
30
text.jrt
30
text.jrt
|
@ -172,3 +172,33 @@ var boxstyle
|
|||
swap 2 - over boxmiddle
|
||||
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
|
||||
ADD AX 4096 #
|
||||
MOV SS AX
|
||||
MOV t& lastseg @+ AX
|
||||
MOV SP 0x100 #
|
||||
MOV t& lastseg @+ AX
|
||||
MOV BP 0x00 #
|
||||
CLD
|
||||
NEXT
|
||||
|
||||
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