421 lines
10 KiB
Tal
421 lines
10 KiB
Tal
( ANSI sequences )
|
|
( )
|
|
( set attributes: ESC [ x ; ... m -> 0:reset 1:bright 2:dim 7:reverse )
|
|
( get cursor position: ESC [ 6 n -> ESC [ $row ; $col R )
|
|
( enable line wrap: ESC [ 7 h )
|
|
( disable line wrap: ESC [ 7 l )
|
|
( )
|
|
( move cursor home: ESC [ H )
|
|
( move cursor: ESC [ $row ; $col H )
|
|
( move up: ESC [ $n A )
|
|
( move down: ESC [ $n B )
|
|
( move forward: ESC [ $n C )
|
|
( move back: ESC [ $n D )
|
|
( )
|
|
( erase from cursor to end of line: ESC [ K )
|
|
( erase from start of line to cursor: ESC [ 1 K )
|
|
( erase line: ESC [ 2 K )
|
|
( erase from current line to bottom: ESC [ J )
|
|
( erase from current line to top: ESC [ 1 J )
|
|
( erase screen: ESC [ 2 J )
|
|
|
|
|00 @System [ &vect $2 &pad $6 &r $2 &g $2 &b $2 ]
|
|
|10 @Console [ &vect $2 &r $1 &pad $5 &w $1 ]
|
|
|20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &pixel $1 &sprite $1 ]
|
|
|80 @Controller [ &vect $2 &button $1 &key $1 ]
|
|
|
|
|0000
|
|
@tint $1 ( draw mode. 01=regular, 04=inverted )
|
|
@dirty? $1 ( screen needs redraw? )
|
|
@rows $2 ( height in characters )
|
|
@cols $2 ( width in characters )
|
|
@cur-x $2 ( cursor x: 0 <= cur-x < cols )
|
|
@cur-y $2 ( cursor y: 0 <= cur-y < rows )
|
|
@max-x $2 ( cols-1 )
|
|
@max-y $2 ( rows-1 )
|
|
|
|
|0100
|
|
( 80 cols x 24 rows )
|
|
#0028 .rows STZ2
|
|
#0050 .cols STZ2
|
|
|
|
( set max row/col )
|
|
.rows LDZ2 #0001 SUB2 .max-y STZ2
|
|
.cols LDZ2 #0001 SUB2 .max-x STZ2
|
|
|
|
( set initial cursor )
|
|
#0000 .cur-x STZ2
|
|
#0000 .cur-y STZ2
|
|
|
|
( set screen height/width based on rows/cols )
|
|
.rows LDZ2 #30 SFT2 .Screen/h DEO2
|
|
.cols LDZ2 #30 SFT2 .Screen/w DEO2
|
|
|
|
( set colors )
|
|
#0cf0 .System/r DEO2
|
|
#0c88 .System/g DEO2
|
|
#0c0f .System/b DEO2
|
|
|
|
( clear screen for initial draw )
|
|
;clear-screen JSR2
|
|
|
|
( set up interrupts )
|
|
;redraw .Screen/vect DEO2 ( set up screen )
|
|
;on-key .Controller/vect DEO2 ( set up keyboard )
|
|
;on-read .Console/vect DEO2 ( set up stdin )
|
|
|
|
( return )
|
|
BRK
|
|
|
|
@bol-addr ( -> addr* )
|
|
.cols LDZ2 .cur-y LDZ2 MUL2 JMP2r
|
|
|
|
@cur-addr ( -> addr* )
|
|
;bol-addr JSR2 .cur-x LDZ2 ADD2 JMP2r
|
|
|
|
@eol-addr ( -> addr* )
|
|
.cols LDZ2 .cur-y LDZ2 INC2 MUL2 JMP2r
|
|
|
|
@min ( x* y* -> min* )
|
|
LTH2k JMP SWP2 POP2 JMP2r
|
|
|
|
@max ( x* y* -> max* )
|
|
LTH2k JMP SWP2 NIP2 JMP2r
|
|
|
|
@clear-screen
|
|
#01 .dirty? STZ
|
|
;screen STH2
|
|
#0000 &yloop
|
|
#0000 &xloop
|
|
#20 STH2kr STA INC2r
|
|
INC2 DUP2 .cols LDZ2 LTH2 ,&xloop JCN
|
|
POP2
|
|
INC2 DUP2 .rows LDZ2 LTH2 ,&yloop JCN
|
|
POP2 POP2r
|
|
JMP2r
|
|
|
|
@redraw
|
|
#41 .tint STZ
|
|
.dirty? LDZ #00 EQU ,&done JCN
|
|
;screen STH2
|
|
#0000 DUP2 .Screen/y DEO2
|
|
&yloop
|
|
#0000 DUP2 .Screen/x DEO2
|
|
&xloop
|
|
STH2kr LDA ;draw-tile JSR2
|
|
.Screen/x DEI2 #0008 ADD2 .Screen/x DEO2
|
|
INC2 INC2r
|
|
DUP2 .cols LDZ2 LTH2 ,&xloop JCN
|
|
POP2
|
|
.Screen/y DEI2 #0008 ADD2 .Screen/y DEO2
|
|
INC2
|
|
DUP2 .rows LDZ2 LTH2 ,&yloop JCN
|
|
POP2 POP2r
|
|
|
|
;show-cursor JSR2
|
|
#00 .dirty? STZ
|
|
&done BRK
|
|
|
|
@hide-cursor
|
|
.tint LDZ
|
|
#41 .tint STZ
|
|
;draw-cursor JSR2
|
|
.tint STZ JMP2r
|
|
|
|
@show-cursor
|
|
.tint LDZ
|
|
#44 .tint STZ
|
|
;draw-cursor JSR2
|
|
.tint STZ JMP2r
|
|
|
|
@draw-cursor
|
|
.cur-x LDZ2 #30 SFT2 .Screen/x DEO2
|
|
.cur-y LDZ2 #30 SFT2 .Screen/y DEO2
|
|
.cur-y LDZ2 .cols LDZ2 MUL2 .cur-x LDZ2 ADD2 ;screen ADD2 LDA
|
|
;draw-tile JMP2
|
|
|
|
@on-key ( -> )
|
|
.Controller/key DEI ,&ok JCN BRK
|
|
&ok ,alt? JSR ,on-alt-key JCN
|
|
,ctrl? JSR ,on-ctrl-key JCN
|
|
.Controller/key DEI .Console/w DEO BRK
|
|
|
|
@ctrl? ( -> down? ) .Controller/button DEI #01 AND JMP2r
|
|
@alt? ( -> down? ) .Controller/button DEI #02 AND JMP2r
|
|
|
|
( alt-XYZ emits ESC and then emits XYZ )
|
|
@on-alt-key ( -> )
|
|
#1b .Console/w DEO
|
|
,ctrl? JSR ,on-ctrl-key JCN
|
|
.Controller/key DEI .Console/w DEO BRK
|
|
|
|
( ctrl-$n emits: )
|
|
( 0 <= $n < @ -> $n )
|
|
( @ <= $n < ` -> $n #40 SUB )
|
|
( ` <= $n <= #ff -> $n #60 SUB )
|
|
@on-ctrl-key ( -> )
|
|
.Controller/key DEI
|
|
DUP LIT "@ LTH ,&done JCN
|
|
DUP LIT "` LTH ,&c1 JCN
|
|
LIT "` SUB ,&done JMP
|
|
&c1 LIT "@ SUB
|
|
&done .Console/w DEO BRK
|
|
|
|
@on-read-seq ( -> )
|
|
.Console/r DEI
|
|
DUP LIT "; EQU ;next-arg JCN2
|
|
DUP LIT "0 LTH ;end-arg JCN2
|
|
DUP LIT "9 GTH ;end-arg JCN2
|
|
;add-to-arg JMP2
|
|
|
|
@end-arg ( c^ -> )
|
|
;on-read .Console/vect DEO2
|
|
DUP LIT "h EQU ;exec-noop JCN2 ( enable line wrap )
|
|
DUP LIT "l EQU ;exec-noop JCN2 ( disable line wrap )
|
|
DUP LIT "m EQU ;exec-noop JCN2 ( set attr )
|
|
DUP LIT "n EQU ;exec-status JCN2 ( get status )
|
|
DUP LIT "H EQU ;exec-move JCN2 ( move cursor )
|
|
DUP LIT "A EQU ;exec-up JCN2 ( up )
|
|
DUP LIT "B EQU ;exec-down JCN2 ( down )
|
|
DUP LIT "C EQU ;exec-forward JCN2 ( forward )
|
|
DUP LIT "D EQU ;exec-back JCN2 ( back )
|
|
DUP LIT "J EQU ;exec-erase-line JCN2 ( erase line )
|
|
DUP LIT "K EQU ;exec-noop JCN2 ( erase screen )
|
|
POP BRK
|
|
|
|
@exec-noop ( c^ -> )
|
|
POP BRK
|
|
|
|
@exec1 ( addr* -> )
|
|
STH2 #0001 ;read-arg-1 JSR2 STH2r JSR2 BRK
|
|
|
|
@exec-status
|
|
POP #0000 ;read-arg-1 JSR2 #0006 NEQ2 ,&done
|
|
#1b .Console/w DEO
|
|
LIT "[ .Console/w DEO
|
|
LIT "4 .Console/w DEO
|
|
LIT "0 .Console/w DEO
|
|
LIT "; .Console/w DEO
|
|
LIT "7 .Console/w DEO
|
|
LIT "9 .Console/w DEO
|
|
LIT "R .Console/w DEO
|
|
&done BRK
|
|
|
|
@exec-up POP ;up-n ;exec1 JMP2
|
|
@exec-down POP ;down-n ;exec1 JMP2
|
|
@exec-forward POP ;forward-n ;exec1 JMP2
|
|
@exec-back POP ;back-n ;exec1 JMP2
|
|
|
|
@exec-erase-line
|
|
POP #0000 ;read-arg-1 JSR2
|
|
DUP2 #0000 EQU2 ,&erase-to-end JCN
|
|
DUP2 #0001 EQU2 ,&erase-from-start JCN
|
|
DUP2 #0002 EQU2 ,&erase-full JCN
|
|
POP2 BRK
|
|
( #010f DEO BRK ( FIXME ) )
|
|
&erase-full
|
|
POP2 ;bol-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK
|
|
&erase-to-end
|
|
POP2 ;cur-addr JSR2 INC2 ;eol-addr JSR2 ;erase JSR2 BRK
|
|
&erase-from-start
|
|
POP2 ;bol-addr JSR2 ;cur-addr JSR2 INC2 ;erase JSR2 BRK
|
|
|
|
( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords )
|
|
|
|
@erase ( start* end* -> )
|
|
OVR2 SWP2 SUB2 STH2 ( start* [count*] )
|
|
#20 ROT ROT ( 20 start* [count*] )
|
|
&loop
|
|
STAk INC2r
|
|
STH2kr ORA ,&loop JCN
|
|
POP2r POP2 POP
|
|
#01 .dirty? STZ ( FIXME )
|
|
JMP2r
|
|
|
|
@exec-move ( c^ -> )
|
|
POP LIT2r ffff
|
|
#0001 ;read-arg-1 JSR2 STH2kr ADD2 ( row )
|
|
#0001 ;read-arg-2 JSR2 STH2r ADD2 ( col )
|
|
;goto JSR2 BRK
|
|
|
|
@on-read-esc ( -> )
|
|
.Console/r DEI LIT "[ EQU ;start-seq JCN2
|
|
;on-read .Console/vect DEO2
|
|
;on-read JMP2
|
|
|
|
@start-seq ( -> )
|
|
;reset-args JSR2
|
|
;on-read-seq .Console/vect DEO2
|
|
BRK
|
|
|
|
@on-read
|
|
.Console/r DEI
|
|
DUP ,&ok JCN POP BRK
|
|
&ok #41 .tint STZ
|
|
;read JSR2 BRK
|
|
|
|
@read ( c^ -> )
|
|
DUP #20 LTH ;read-ctrl JCN2
|
|
DUP #7f EQU ;read-del JCN2
|
|
;read-printable JMP2
|
|
|
|
@read-ctrl ( c^ -> )
|
|
DUP #07 EQU ;read-bel JCN2
|
|
DUP #08 EQU ;read-bs JCN2
|
|
DUP #09 EQU ;read-tab JCN2
|
|
DUP #0a EQU ;read-nl JCN2
|
|
DUP #0d EQU ;read-cr JCN2
|
|
DUP #1b EQU ;read-esc JCN2
|
|
|
|
@read-bel ( 07 -> )
|
|
POP JMP2r ( TODO: flash terminal )
|
|
|
|
@read-bs ( 08 -> )
|
|
POP JMP2r ( POP ;scroll JMP2 )
|
|
|
|
@read-esc ( 1b -> )
|
|
POP ;on-read-esc .Console/vect DEO2 BRK
|
|
|
|
@read-del ( 7f -> )
|
|
POP JMP2r
|
|
|
|
( @read-tab POP JMP2r )
|
|
@read-tab
|
|
POP
|
|
.cur-x LDZ2 NIP #07 AND #08 SUB
|
|
&loop
|
|
#20 DUP ;cursor-addr JSR2 STA
|
|
;draw-tile JSR2
|
|
;forward JSR2
|
|
INC DUP ,&loop JCN
|
|
POP JMP2r
|
|
|
|
@read-cr ( 0d -> )
|
|
POP ;hide-cursor JSR2 #0000 .cur-x STZ2 JMP2r
|
|
|
|
@at-max-y ( -> true? )
|
|
.cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
|
|
|
|
@read-nl ( 0a -> )
|
|
POP ;hide-cursor JSR2
|
|
,at-max-y JSR ;scroll JCN2 ;down JMP2
|
|
|
|
@read-printable ( c -> )
|
|
DUP ;cursor-addr JSR2 STA
|
|
;draw-tile JSR2
|
|
;forward JMP2
|
|
|
|
@goto ( y* x* -> )
|
|
;hide-cursor JSR2
|
|
.max-x LDZ2 ;min JSR2 .cur-x STZ2
|
|
.max-y LDZ2 ;min JSR2 .cur-y STZ2
|
|
;show-cursor JMP2
|
|
|
|
@forward-n ( n* -> )
|
|
;hide-cursor JSR2
|
|
.cur-x LDZ2 ADD2 .max-x LDZ2 ;min JSR2 .cur-x STZ2
|
|
;show-cursor JMP2
|
|
|
|
@forward ( -> )
|
|
#0001 ,forward-n JMP
|
|
|
|
@back-n ( n* -> )
|
|
;hide-cursor JSR2
|
|
.cur-x LDZ2 GTH2k ,&zero JCN
|
|
SWP2 SUB2 ,&done JMP
|
|
&zero POP2 POP2 #0000
|
|
&done .cur-x STZ2 ;show-cursor JMP2
|
|
|
|
@up-n ( n* -> )
|
|
;hide-cursor JSR2
|
|
.cur-y LDZ2 GTH2k ,&zero JCN
|
|
SWP2 SUB2 ,&done JMP
|
|
&zero POP2 POP2 #0000
|
|
&done .cur-y STZ2 ;show-cursor JMP2
|
|
|
|
@down-n ( n* -> )
|
|
;hide-cursor JSR2
|
|
.cur-y LDZ2 ADD2 .max-y LDZ2 ;min JSR2 .cur-y STZ2
|
|
;show-cursor JMP2
|
|
|
|
@down ( -> )
|
|
#0001 ,down-n JMP
|
|
|
|
@scroll
|
|
;end-screen STH2
|
|
;screen .cols LDZ2 ADD2 STH2
|
|
&loop
|
|
STH2kr LDA #20 STH2kr STA
|
|
STH2kr .cols LDZ2 SUB2 STA
|
|
INC2r GTH2kr STHr ,&loop JCN
|
|
POP2r POP2r
|
|
#01 .dirty? STZ
|
|
;show-cursor JMP2
|
|
|
|
@cursor-addr ( -> addr* )
|
|
.cur-y LDZ2 .cols LDZ2 MUL2
|
|
.cur-x LDZ2 ADD2 ;screen ADD2
|
|
JMP2r
|
|
|
|
( 0 <= c < 256 )
|
|
@draw-tile ( c^ -> )
|
|
DUP #80 LTH
|
|
,draw-7bit JCN
|
|
,draw-8bit JMP
|
|
|
|
( 0 <= index < 128 )
|
|
@load-tile ( index^ -> )
|
|
#00 SWP #30 SFT2
|
|
;ascii ADD2 .Screen/addr DEO2
|
|
JMP2r
|
|
|
|
( 0 <= c < 128 )
|
|
@draw-7bit ( c^ -> )
|
|
;load-tile JSR2
|
|
.tint LDZ .Screen/sprite DEO
|
|
JMP2r
|
|
|
|
( 128 <= c < 256 )
|
|
@draw-8bit ( 8bit^ -> )
|
|
#80 SUB ;load-tile JSR2
|
|
.tint LDZ #05 EOR .Screen/sprite DEO
|
|
JMP2r
|
|
|
|
( 128 1-bit 8x8 tiles for ASCII 7-bit characters )
|
|
@ascii
|
|
~chr/ascii.tal
|
|
|
|
@next-arg ( c^ -> )
|
|
POP
|
|
( TODO: check if we already have max args )
|
|
;args/pos LDA2k INC2 INC2 STA2 BRK
|
|
|
|
@add-to-arg ( c^ -> )
|
|
LIT "0 SUB LITr 00 STH ( [digit*] )
|
|
;args/pos LDA2 LDA2k ( addr* value* [digit*] )
|
|
#000a MUL2 STH2r ADD2 ( addr* value*10+digit )
|
|
SWP2 STA2 BRK
|
|
|
|
@read-arg-1 ( default* -> n* )
|
|
;args LDA2 ;max JMP2
|
|
@read-arg-2 ( default* -> n* )
|
|
;args INC2 INC2 LDA2 ;max JMP2
|
|
|
|
@reset-args ( -> )
|
|
;args ;args/pos STA2
|
|
#0000 ;args LITr f8
|
|
&loop STA2k INC2 INC2
|
|
INCr STHkr ,&loop JCN
|
|
POPr POP2 POP2 JMP2r
|
|
|
|
( store up to 8 arguments for control sequences )
|
|
@args $10 &pos $2
|
|
|
|
( store characters for redraw, etc. )
|
|
@screen $0c80 ( 80 x 40 )
|
|
@end-screen
|
|
|
|
( ( store attributes for redraw, etc. )
|
|
@attrs $0c80 ( 80 x 40 )
|
|
@end-attrs )
|