wip
This commit is contained in:
parent
4781d9251b
commit
7fd7623677
|
|
@ -114,7 +114,7 @@
|
||||||
@free ( addr* -> )
|
@free ( addr* -> )
|
||||||
;find-addr JSR2
|
;find-addr JSR2
|
||||||
ORAk #00 EQU ,&skip JCN
|
ORAk #00 EQU ,&skip JCN
|
||||||
;erase-slot JMP2
|
;erase-slot JMP2
|
||||||
&skip POP2 JSR2
|
&skip POP2 JSR2
|
||||||
|
|
||||||
( reading metadata from the arena )
|
( reading metadata from the arena )
|
||||||
|
|
|
||||||
58
fix16.tal
58
fix16.tal
|
|
@ -192,7 +192,7 @@
|
||||||
@x16-negate ( x* -> -x* )
|
@x16-negate ( x* -> -x* )
|
||||||
#0000 SWP2 SUB2 JMP2r
|
#0000 SWP2 SUB2 JMP2r
|
||||||
|
|
||||||
@x16-mul ( x* y* -> xy* )
|
( @x16-mul ( x* y* -> xy* )
|
||||||
DUP #00 EQU ?&rhs-whole
|
DUP #00 EQU ?&rhs-whole
|
||||||
SWP2 DUP #00 EQU ?&rhs-whole
|
SWP2 DUP #00 EQU ?&rhs-whole
|
||||||
,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR
|
,&y3 STR ,&y1 STR ,&x3 STR ,&x1 STR
|
||||||
|
|
@ -200,9 +200,9 @@
|
||||||
LIT2 &x0 00 &x1 00 ,&y2 LDR2 MUL2 ADD2
|
LIT2 &x0 00 &x1 00 ,&y2 LDR2 MUL2 ADD2
|
||||||
,&x2 LDR2 LIT2 &y0 00 &y1 00 MUL2 ADD2
|
,&x2 LDR2 LIT2 &y0 00 &y1 00 MUL2 ADD2
|
||||||
,&x0 LDR2 ,&y0 LDR2 MUL2 #80 SFT2 ADD2 JMP2r
|
,&x0 LDR2 ,&y0 LDR2 MUL2 #80 SFT2 ADD2 JMP2r
|
||||||
&rhs-whole #08 SFT2 MUL2 JMP2r
|
&rhs-whole #08 SFT2 MUL2 JMP2r )
|
||||||
|
|
||||||
@x16-div ( x* y* -> x/y* )
|
( @x16-div ( x* y* -> x/y* )
|
||||||
DIV2k STH2k ( x y x/y {x/y} )
|
DIV2k STH2k ( x y x/y {x/y} )
|
||||||
LITr 80 SFT2r ( x y x/y {div=(x/y)<<8 )
|
LITr 80 SFT2r ( x y x/y {div=(x/y)<<8 )
|
||||||
OVR2 STH2 ( x y x/y {y div} )
|
OVR2 STH2 ( x y x/y {y div} )
|
||||||
|
|
@ -218,7 +218,54 @@
|
||||||
!&loop ( rem-yi yi {shifti div+shifti} )
|
!&loop ( rem-yi yi {shifti div+shifti} )
|
||||||
&done
|
&done
|
||||||
POP2 POP2 ( {shiftk div} )
|
POP2 POP2 ( {shiftk div} )
|
||||||
POP2r STH2r JMP2r ( div )
|
POP2r STH2r JMP2r ( div ) )
|
||||||
|
|
||||||
|
@x16-mul ( x* y* -- xy* )
|
||||||
|
;x16-mul-unsigned !x16-signed-op
|
||||||
|
|
||||||
|
@x16-mul-unsigned ( x* y* -- xy* )
|
||||||
|
DUP #00 EQU ?x16-mul-unsigned-rhs-whole
|
||||||
|
SWP2 DUP #00 EQU ?x16-mul-unsigned-rhs-whole
|
||||||
|
,&al STR ,&ah STR ,&bl STR ,&bh STR
|
||||||
|
LIT2 &a1 00 &al 00 LIT2 &b1 00 &bl 00 MUL2 #08 SFT2
|
||||||
|
LIT2 &a2 00 &ah 00 ,&b1 LDR2 MUL2 ADD2
|
||||||
|
,&a1 LDR2 LIT2 &b2 00 &bh 00 MUL2 ADD2
|
||||||
|
,&a2 LDR2 ,&b2 LDR2 MUL2 #80 SFT2 ADD2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@x16-mul-unsigned-rhs-whole ( x0_x1* y0_00* -- xy* )
|
||||||
|
#08 SFT2 MUL2
|
||||||
|
JMP2r
|
||||||
|
|
||||||
|
@x16-div ( x* y* -- x/y* )
|
||||||
|
;x16-div-unsigned !x16-signed-op
|
||||||
|
|
||||||
|
@x16-div-unsigned ( x* y* -> x/y* )
|
||||||
|
DIV2k STH2k ( x y x/y [x/y] )
|
||||||
|
LITr 80 SFT2r ( x y x/y [div=(x/y)<<8] )
|
||||||
|
OVR2 STH2 ( x y x/y [y div] )
|
||||||
|
MUL2 SUB2 ( x%y [y div] )
|
||||||
|
STH2r LIT2r 0100 ( x%y y [0100 div] )
|
||||||
|
|
||||||
|
( We know x%y < y, so start right-shifting y. )
|
||||||
|
&loop DUP2 #0000 EQU2 ?&done
|
||||||
|
#01 SFT2 LITr 01 SFT2r ( rem yi [shifti div] )
|
||||||
|
LTH2k ,&loop JCN ( rem yi [shifti div] )
|
||||||
|
SWP2 OVR2 SUB2 SWP2 ( rem-yi yi [shifti div] )
|
||||||
|
DUP2r ROT2r ADD2r SWP2r ( rem-yi yi [shifti div+shifti] )
|
||||||
|
!&loop ( rem-yi yi [shifti div+shifti] )
|
||||||
|
&done
|
||||||
|
|
||||||
|
POP2 POP2 ( [shiftk div] )
|
||||||
|
POP2r STH2r JMP2r ( div )
|
||||||
|
|
||||||
|
@x16-signed-op ( x* y* f* -- f(x,y)* )
|
||||||
|
STH2 LIT2r 0001
|
||||||
|
DUP2 #8000 LTH2 ?&ypos x16-negate SWPr
|
||||||
|
&ypos SWP2 DUP2 #8000 LTH2 ?&xpos x16-negate SWPr
|
||||||
|
&xpos SWP2 SWP2r STH2r JSR2
|
||||||
|
STHr ?&xypos x16-negate &xypos POPr
|
||||||
|
JMP2r
|
||||||
|
|
||||||
@x16-quotient ( x* y* -> x//y* )
|
@x16-quotient ( x* y* -> x//y* )
|
||||||
DIV2 #80 SFT2 JMP2r
|
DIV2 #80 SFT2 JMP2r
|
||||||
|
|
@ -290,6 +337,9 @@
|
||||||
x16-pi/2 ADD2 ( fall-thru )
|
x16-pi/2 ADD2 ( fall-thru )
|
||||||
|
|
||||||
@x16-sin ( x* -> sin[x]* )
|
@x16-sin ( x* -> sin[x]* )
|
||||||
|
DUP2 #8000 LTH2 ?&non-negative
|
||||||
|
x16-negate x16-sin/non-negative !x16-negate
|
||||||
|
&non-negative
|
||||||
x16-pi*2 STH2 ( x [2pi] )
|
x16-pi*2 STH2 ( x [2pi] )
|
||||||
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
|
DUP2 STH2kr x16-quotient ( x x/2pi [2pi] )
|
||||||
STH2r x16-mul SUB2 ( x' ; 0 <= x' < 2pi )
|
STH2r x16-mul SUB2 ( x' ; 0 <= x' < 2pi )
|
||||||
|
|
|
||||||
49
interval.tal
49
interval.tal
|
|
@ -21,6 +21,15 @@
|
||||||
@iv-is-point ( x** -> bool^ )
|
@iv-is-point ( x** -> bool^ )
|
||||||
EQU2 JMP2r
|
EQU2 JMP2r
|
||||||
|
|
||||||
|
( )
|
||||||
|
@iv-emit ( x** -> )
|
||||||
|
[ LIT "[ #18 DEO ]
|
||||||
|
SWP2 x16-emit
|
||||||
|
[ LIT ", #18 DEO #20 #18 DEO ]
|
||||||
|
x16-emit
|
||||||
|
[ LIT "] #18 DEO ]
|
||||||
|
JMP2r
|
||||||
|
|
||||||
( [x0, x1] | [y0, y1] -> [min[x0,y0], max[x1,y1]] )
|
( [x0, x1] | [y0, y1] -> [min[x0,y0], max[x1,y1]] )
|
||||||
@iv-union ( x** y** -> x|y** )
|
@iv-union ( x** y** -> x|y** )
|
||||||
ROT2 x16-max STH2
|
ROT2 x16-max STH2
|
||||||
|
|
@ -42,10 +51,14 @@
|
||||||
|
|
||||||
@iv-abs ( x** -> |x|** )
|
@iv-abs ( x** -> |x|** )
|
||||||
OVR2 OVR2 iv-crosses-zero ?&cross
|
OVR2 OVR2 iv-crosses-zero ?&cross
|
||||||
DUP2 ORA ?&positive
|
DUP2 #8000 LTH2 ?&positive
|
||||||
( negative ) x16-negate SWP2 !x16-negate
|
( negative ) x16-negate SWP2 !x16-negate
|
||||||
&positive JMP2r
|
&positive JMP2r
|
||||||
&cross SWP2 x16-negate x16-max #0000 SWP2 JMP2r
|
&cross POP x16-negate #0000 SWP2 JMP2r
|
||||||
|
|
||||||
|
@iv-scalar-add ( x** y* -> x+y** )
|
||||||
|
STH2k x16-add SWP2
|
||||||
|
STH2r x16-add SWP2 JMP2r
|
||||||
|
|
||||||
( [x0, x1] + [y0, y1] -> [x0+y0, x1+y1] )
|
( [x0, x1] + [y0, y1] -> [x0+y0, x1+y1] )
|
||||||
@iv-add ( x** y** -> x+y** )
|
@iv-add ( x** y** -> x+y** )
|
||||||
|
|
@ -61,10 +74,10 @@
|
||||||
( [x0, x1] * (-y) -> [x1y, x0y] )
|
( [x0, x1] * (-y) -> [x1y, x0y] )
|
||||||
( [x0, x1] * 0 -> [0, 0] )
|
( [x0, x1] * 0 -> [0, 0] )
|
||||||
@iv-scalar-mul ( x** y* -> xy** )
|
@iv-scalar-mul ( x** y* -> xy** )
|
||||||
STH2k #0000 GTH2 ?&positive ( x0* x1* [y*] )
|
STH2k #0000 x16-gt ?&positive ( x0* x1* [y*] )
|
||||||
SWP2 &positive ( a* b* [y*] )
|
SWP2 &positive ( a* b* [y*] )
|
||||||
STH2kr x16-mul SWP2 ( by* a* [y*] )
|
STH2kr x16-mul SWP2 ( by* a* [y*] )
|
||||||
STH2r x16-mul SWP2 JMP2r ( ay* by* )
|
STH2r x16-mul SWP2 JMP2r ( ay* by* )
|
||||||
|
|
||||||
( [x0, x1] * [y0, y1] -> [min[x0y0, x0y1], max[x1y0, x1y1]] )
|
( [x0, x1] * [y0, y1] -> [min[x0y0, x0y1], max[x1y0, x1y1]] )
|
||||||
@iv-mul ( x** y** -> xy** )
|
@iv-mul ( x** y** -> xy** )
|
||||||
|
|
@ -75,4 +88,28 @@
|
||||||
iv-scalar-mul STH2r STH2r ( b0* b1* a0* a1* )
|
iv-scalar-mul STH2r STH2r ( b0* b1* a0* a1* )
|
||||||
!iv-union ( a|b** )
|
!iv-union ( a|b** )
|
||||||
|
|
||||||
|
@iv-square ( x** -> xx** )
|
||||||
|
iv-abs OVR2 OVR2 !iv-mul
|
||||||
|
|
||||||
|
@iv-pow ( x** k^ -> x^k** )
|
||||||
|
DUP #00 EQU ?&one
|
||||||
|
DUP #01 EQU ?&id
|
||||||
|
DUP #02 EQU ?&square
|
||||||
|
DUP #01 AND ?&odd
|
||||||
|
#01 SFT iv-pow OVR2 OVR2 !iv-mul
|
||||||
|
&one POP POP2 POP2 #0100 DUP2 JMP2r
|
||||||
|
&id POP JMP2r
|
||||||
|
&square POP !iv-square
|
||||||
|
&odd #01 SUB STH OVR2 OVR2 STHr iv-pow !iv-mul
|
||||||
|
|
||||||
|
( FIXME: not reliable )
|
||||||
|
@iv-sin ( x** -> sin[x]** )
|
||||||
|
x16-sin SWP2 x16-sin
|
||||||
|
OVR2 OVR2 x16-lt JMP SWP2 JMP2r
|
||||||
|
|
||||||
|
( FIXME: not reliable )
|
||||||
|
@iv-cos ( x** -> sin[x]** )
|
||||||
|
x16-cos SWP2 x16-cos
|
||||||
|
OVR2 OVR2 x16-lt JMP SWP2 JMP2r
|
||||||
|
|
||||||
~fix16.tal
|
~fix16.tal
|
||||||
|
|
|
||||||
163
term.tal
163
term.tal
|
|
@ -99,7 +99,6 @@
|
||||||
@saved-x $2 ( saved x coordinate )
|
@saved-x $2 ( saved x coordinate )
|
||||||
@saved-y $2 ( saved y coordinate )
|
@saved-y $2 ( saved y coordinate )
|
||||||
@col-bytes $2 ( 2*cols )
|
@col-bytes $2 ( 2*cols )
|
||||||
@debug $1 ( use debug log? )
|
|
||||||
@lastmouse-x $2 ( last mouse x )
|
@lastmouse-x $2 ( last mouse x )
|
||||||
@lastmouse-y $2 ( last mouse y )
|
@lastmouse-y $2 ( last mouse y )
|
||||||
@lastmouse-st $1 ( last mouse press )
|
@lastmouse-st $1 ( last mouse press )
|
||||||
|
|
@ -120,21 +119,26 @@
|
||||||
@paste $1 ( 01: bracketed paste is on, 00: is off )
|
@paste $1 ( 01: bracketed paste is on, 00: is off )
|
||||||
|
|
||||||
( user configuration )
|
( user configuration )
|
||||||
@visual-bell $1
|
@debug $1 ( use debug log? )
|
||||||
@border-pad $2 ( should be 0000 or 0010 )
|
@show-banner $1 ( show banner on startup? )
|
||||||
|
@visual-bell $1 ( flash visual bell? otherwise do nothing )
|
||||||
|
@border-pad $2 ( use border? should be 0000 or 0010 )
|
||||||
|
|
||||||
|0100
|
|0100
|
||||||
( metadata )
|
( metadata )
|
||||||
;meta .System/metadata DEO2
|
;meta .System/metadata DEO2
|
||||||
;meta/name .System/title DEO2
|
;meta/name .System/title DEO2
|
||||||
|
|
||||||
( 80 cols x 24 rows )
|
( user configuration defaults )
|
||||||
|
#01 .debug STZ
|
||||||
|
#01 .show-banner STZ
|
||||||
|
#0010 .border-pad STZ2
|
||||||
|
#01 .visual-bell STZ
|
||||||
|
|
||||||
|
( 80 cols x 24 rows by default )
|
||||||
#0018 .rows STZ2
|
#0018 .rows STZ2
|
||||||
#0050 .cols STZ2
|
#0050 .cols STZ2
|
||||||
|
|
||||||
( #0010 .border-pad STZ2 )
|
|
||||||
#0000 .border-pad STZ2
|
|
||||||
|
|
||||||
( start cursor at origin - including border )
|
( start cursor at origin - including border )
|
||||||
.border-pad LDZ2 .Screen/x DEO2
|
.border-pad LDZ2 .Screen/x DEO2
|
||||||
.border-pad LDZ2 .Screen/y DEO2
|
.border-pad LDZ2 .Screen/y DEO2
|
||||||
|
|
@ -144,31 +148,38 @@
|
||||||
#07bf .System/g DEO2
|
#07bf .System/g DEO2
|
||||||
#07bf .System/b DEO2
|
#07bf .System/b DEO2
|
||||||
|
|
||||||
( set up interrupts )
|
load-theme ( optional theme sets colors/dimensions )
|
||||||
;redraw .Screen/vect DEO2 ( set up screen )
|
|
||||||
;on-key .Controller/vect DEO2 ( set up keyboard )
|
|
||||||
;on-mouse .Mouse/vect DEO2 ( set up mouse )
|
|
||||||
;on-read .Console/vect DEO2 ( set up stdin )
|
|
||||||
|
|
||||||
( load theme to override colors and maybe dimension )
|
;on-redraw .Screen/vect DEO2 ( set up screen callback )
|
||||||
load-theme
|
;on-key .Controller/vect DEO2 ( set up keyboard callback )
|
||||||
|
;on-mouse .Mouse/vect DEO2 ( set up mouse callback )
|
||||||
|
;on-read .Console/vect DEO2 ( set up stdin callback )
|
||||||
|
|
||||||
( these only work with a patched uxnemu )
|
setup-subprocess ( set up experimental subprocess support )
|
||||||
( on other emulators they should be no-ops )
|
reset-terminal ( initialize terminal state and settings )
|
||||||
|
setup-debugging ( set up debugging if requested )
|
||||||
|
draw-banner ( draw banner if requested )
|
||||||
|
|
||||||
|
BRK
|
||||||
|
|
||||||
|
( these only work with a patched uxnemu )
|
||||||
|
( on other emulators they should be no-ops )
|
||||||
|
@setup-subprocess ( -> )
|
||||||
;shell .Console/exec DEO2 ( set up bash subprocess )
|
;shell .Console/exec DEO2 ( set up bash subprocess )
|
||||||
#80 .Console/mode DEO ( start bash subprocess )
|
#80 .Console/mode DEO ( start bash subprocess )
|
||||||
|
JMP2r
|
||||||
|
|
||||||
( initialize terminal state and settings )
|
@setup-debugging ( -> )
|
||||||
reset-terminal
|
.debug LDZ ?&continue JMP2r &continue
|
||||||
|
#99 #010e DEO ( put 99 in wst so #010e DEO reliably logs )
|
||||||
( set to 01 to enable debug log )
|
|
||||||
#00 .debug STZ
|
|
||||||
|
|
||||||
.debug LDZ ?&continue BRK &continue
|
|
||||||
#99 #010e DEO
|
|
||||||
;debug-log .File1/name DEO2
|
;debug-log .File1/name DEO2
|
||||||
#01 .File1/append DEO
|
#01 .File1/append DEO
|
||||||
BRK
|
JMP2r
|
||||||
|
|
||||||
|
@draw-banner ( -> )
|
||||||
|
redraw ;banner-ascii
|
||||||
|
&loop LDAk DUP ?&ok POP POP2 JMP2r
|
||||||
|
&ok read INC2 !&loop
|
||||||
|
|
||||||
@reset-terminal ( -> )
|
@reset-terminal ( -> )
|
||||||
( set initial cursor )
|
( set initial cursor )
|
||||||
|
|
@ -194,9 +205,6 @@
|
||||||
( prepare for initial draw )
|
( prepare for initial draw )
|
||||||
init-screen
|
init-screen
|
||||||
|
|
||||||
( user defaults )
|
|
||||||
#01 .visual-bell STZ
|
|
||||||
|
|
||||||
( draw border )
|
( draw border )
|
||||||
.border-pad LDZ2 ORA ?draw-border
|
.border-pad LDZ2 ORA ?draw-border
|
||||||
JMP2r
|
JMP2r
|
||||||
|
|
@ -310,7 +318,10 @@
|
||||||
&loop ( 04 sprite^ [-count] )
|
&loop ( 04 sprite^ [-count] )
|
||||||
DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r
|
DEOk INC2r STH2kr ORA ?&loop POP2r JMP2r
|
||||||
|
|
||||||
@redraw ( -> BRK )
|
@on-redraw ( -> )
|
||||||
|
redraw BRK
|
||||||
|
|
||||||
|
@redraw ( -> )
|
||||||
.pointer-ttl LDZ #00 EQU ?&pointer-ok ( )
|
.pointer-ttl LDZ #00 EQU ?&pointer-ok ( )
|
||||||
.pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok
|
.pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok
|
||||||
#01 .dirty STZ ( redraw without pointer )
|
#01 .dirty STZ ( redraw without pointer )
|
||||||
|
|
@ -329,10 +340,10 @@
|
||||||
INC2 GTH2k ?&yloop
|
INC2 GTH2k ?&yloop
|
||||||
POP2 POP2 POP2r
|
POP2 POP2 POP2r
|
||||||
.is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally
|
.is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally
|
||||||
&flashing .flash LDZ #00 EQU ?&pointer flash-bell draw-cursor BRK
|
&flashing .flash LDZ #00 EQU ?&pointer flash-bell !draw-cursor
|
||||||
&pointer draw-pointer
|
&pointer draw-pointer
|
||||||
&finally draw-cursor #00 .dirty STZ
|
&finally draw-cursor #00 .dirty STZ
|
||||||
&done BRK
|
&done JMP2r
|
||||||
|
|
||||||
@flash-bell ( -> )
|
@flash-bell ( -> )
|
||||||
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
|
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
|
||||||
|
|
@ -983,17 +994,22 @@
|
||||||
POP reset-args ;on-read-osc .Console/vect DEO2 BRK
|
POP reset-args ;on-read-osc .Console/vect DEO2 BRK
|
||||||
|
|
||||||
@on-read ( -> BRK )
|
@on-read ( -> BRK )
|
||||||
.Console/r DEI
|
.Console/r DEI read BRK
|
||||||
|
|
||||||
|
@read ( c^ -> )
|
||||||
DUP debug-read
|
DUP debug-read
|
||||||
DUP ?&ok POP BRK
|
DUP ?&ok POP JMP2r
|
||||||
&ok
|
&ok
|
||||||
DUP #20 LTH ?read-ctrl
|
DUP #20 LTH ?read-ctrl
|
||||||
DUP #7f EQU ?read-del
|
DUP #7f EQU ?read-del
|
||||||
|
( fall through to draw )
|
||||||
|
|
||||||
|
@draw ( c^ -> )
|
||||||
.tint LDZ SWP DUP2 insert-cell draw-cell
|
.tint LDZ SWP DUP2 insert-cell draw-cell
|
||||||
.cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ
|
.cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ
|
||||||
clear-cursor forward BRK
|
clear-cursor !forward
|
||||||
|
|
||||||
@read-ctrl ( c^ -> BRK )
|
@read-ctrl ( c^ -> )
|
||||||
DUP #07 EQU ?read-bel
|
DUP #07 EQU ?read-bel
|
||||||
DUP #08 EQU ?read-bs
|
DUP #08 EQU ?read-bs
|
||||||
DUP #09 EQU ?read-tab
|
DUP #09 EQU ?read-tab
|
||||||
|
|
@ -1002,46 +1018,46 @@
|
||||||
DUP #0c EQU ?read-lf
|
DUP #0c EQU ?read-lf
|
||||||
DUP #0d EQU ?read-cr
|
DUP #0d EQU ?read-cr
|
||||||
DUP #1b EQU ?read-esc
|
DUP #1b EQU ?read-esc
|
||||||
POP BRK
|
POP JMP2r
|
||||||
|
|
||||||
@read-bel ( 07 -> BRK )
|
@read-bel ( 07 -> )
|
||||||
POP .visual-bell LDZ #00 EQU ?&done
|
POP .visual-bell LDZ #00 EQU ?&done
|
||||||
#06 .flash STZ #01 .dirty STZ
|
#06 .flash STZ #01 .dirty STZ
|
||||||
&done BRK
|
&done JMP2r
|
||||||
|
|
||||||
@read-bs ( 08 -> BRK )
|
@read-bs ( 08 -> )
|
||||||
POP clear-cursor #0001 back-n BRK
|
POP clear-cursor #0001 !back-n
|
||||||
|
|
||||||
@read-esc ( 1b -> BRK )
|
@read-esc ( 1b -> )
|
||||||
POP ;on-read-esc .Console/vect DEO2 BRK
|
POP ;on-read-esc .Console/vect DEO2 JMP2r
|
||||||
|
|
||||||
@read-del ( 7f -> BRK )
|
@read-del ( 7f -> )
|
||||||
POP BRK
|
POP JMP2r
|
||||||
|
|
||||||
@read-tab ( 09 -> BRK )
|
@read-tab ( 09 -> )
|
||||||
POP
|
POP
|
||||||
.cur-x LDZ2 ( x* )
|
.cur-x LDZ2 ( x* )
|
||||||
NIP #07 AND #08 SUB ( i=(xlo&7)-8^ )
|
NIP #07 AND #08 SUB ( i=(xlo&7)-8^ )
|
||||||
&loop ( i^ )
|
&loop ( i^ )
|
||||||
.tint LDZ #20 DUP2 ( i^ cell* cell* )
|
.tint LDZ #20 DUP2 ( i^ cell* cell* )
|
||||||
cur-addr STA2 ( i^ cell* ; addr<-cell )
|
cur-addr STA2 ( i^ cell* ; addr<-cell )
|
||||||
draw-cell ( i^ )
|
draw-cell ( i^ )
|
||||||
clear-cursor
|
clear-cursor ( i^ )
|
||||||
forward ( i^ )
|
forward ( i^ )
|
||||||
INC DUP ?&loop ( i+1^ )
|
INC DUP ?&loop ( i+1^ )
|
||||||
POP BRK ( )
|
POP JMP2r ( )
|
||||||
|
|
||||||
@cr ( -> )
|
@cr ( -> )
|
||||||
clear-cursor #0000 .cur-x STZ2 !draw-cursor
|
clear-cursor #0000 .cur-x STZ2 !draw-cursor
|
||||||
|
|
||||||
@read-cr ( 0d -> BRK )
|
@read-cr ( 0d -> )
|
||||||
POP .cur-wrap LDZ ?&skip cr &skip BRK
|
POP .cur-wrap LDZ ?&skip cr &skip JMP2r
|
||||||
|
|
||||||
@at-max-x ( -> true? ) .cur-x LDZ2 .max-x LDZ2 EQU2 JMP2r
|
@at-max-x ( -> true? ) .cur-x LDZ2 .max-x LDZ2 EQU2 JMP2r
|
||||||
@at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
|
@at-max-y ( -> true? ) .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
|
||||||
|
|
||||||
@read-lf ( 0a -> BRK )
|
@read-lf ( 0a -> )
|
||||||
POP lf BRK
|
POP !lf
|
||||||
|
|
||||||
@lf ( -> )
|
@lf ( -> )
|
||||||
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
|
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
|
||||||
|
|
@ -1083,8 +1099,7 @@
|
||||||
&scrolling !scroll
|
&scrolling !scroll
|
||||||
|
|
||||||
@insert-cell ( cell* -> )
|
@insert-cell ( cell* -> )
|
||||||
( DUP #20 EQU ?&space ) ( cell* )
|
maybe-autowrap ( cell* )
|
||||||
maybe-autowrap ( &space ) ( cell* )
|
|
||||||
.irm LDZ #00 EQU ?&replace ( cell* )
|
.irm LDZ #00 EQU ?&replace ( cell* )
|
||||||
cur-addr ( cell* lim* )
|
cur-addr ( cell* lim* )
|
||||||
eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
|
eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
|
||||||
|
|
@ -1238,17 +1253,16 @@
|
||||||
INCr STHkr ?&loop
|
INCr STHkr ?&loop
|
||||||
POPr POP2 POP2 JMP2r
|
POPr POP2 POP2 JMP2r
|
||||||
|
|
||||||
( emit a short as a decimal )
|
( emit a signed short as a decimal )
|
||||||
|
@emit-sdec2 ( n* -> )
|
||||||
|
DUP2k #1f SFT2 EQUk ?&s LIT2 "- 18 DEO
|
||||||
|
&s MUL2 SUB2 ( fall-through to emit-dec2 )
|
||||||
|
|
||||||
|
( emit an unsigned short as a decimal )
|
||||||
@emit-dec2 ( n* -> )
|
@emit-dec2 ( n* -> )
|
||||||
LITr 00 ( n [0] )
|
LITr ff00 &read #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ORAk ?&read
|
||||||
&read ( n [k] )
|
POP2 &write NIP #30 ADD #18 DEO OVRr ADDr STHkr ?&write
|
||||||
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
|
POP2r JMP2r
|
||||||
ORAk ?&read
|
|
||||||
POP2 ( top element was 0000 )
|
|
||||||
&write ( n0 n1 ... nk [k+1] )
|
|
||||||
NIP #30 ADD .Console/w DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
|
|
||||||
STHkr ?&write
|
|
||||||
POPr JMP2r
|
|
||||||
|
|
||||||
@debug-log "debug_term.log 00
|
@debug-log "debug_term.log 00
|
||||||
@scratch $40 &pos $2
|
@scratch $40 &pos $2
|
||||||
|
|
@ -1281,6 +1295,19 @@
|
||||||
( device mask ) 41 0d07
|
( device mask ) 41 0d07
|
||||||
( 24x24 icon ) 83 =icon-2-bit
|
( 24x24 icon ) 83 =icon-2-bit
|
||||||
|
|
||||||
|
@banner-ascii
|
||||||
|
0d 0a
|
||||||
|
20 20 c9 cd cd cd cd cd cd cd cd cd cd cd cd cd cd cd bb 0d 0a
|
||||||
|
20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
|
||||||
|
20 20 ba 20 20 "d "e "t "e "r "m 20 20 "v "1 "0 20 20 ba 0d 0a
|
||||||
|
20 20 ba 20 20 20 20 "b "y 20 "d "_ "m 20 20 20 20 20 ba 0d 0a
|
||||||
|
20 20 ba 20 20 "1 "8 20 "m "a "r 20 "2 "0 "2 "3 20 20 ba 0d 0a
|
||||||
|
20 20 ba 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ba 0d 0a
|
||||||
|
20 20 c8 cd cd cb cd cd cd cd cd cd cd cd cd cb cd cd bc 0d 0a
|
||||||
|
20 20 c9 cb cb ce cb cb cb cb cb cb cb cb cb ce cb cb bb 0d 0a
|
||||||
|
20 20 c8 ca ca ca ca ca ca ca ca ca ca ca ca ca ca ca bc 0d 0a
|
||||||
|
0d 0a 00
|
||||||
|
|
||||||
@icon-2-bit
|
@icon-2-bit
|
||||||
00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f
|
00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f
|
||||||
00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff
|
00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue