d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

convert to JCI/JMI/JSI

This commit is contained in:
~d6 2023-01-30 22:05:47 -05:00
parent 66a1326e3a
commit 55e35d0761
1 changed files with 209 additions and 209 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

418
term.tal
View File

@ -104,11 +104,11 @@
#07bf .System/r DEO2 #07bf .System/r DEO2
#07bf .System/g DEO2 #07bf .System/g DEO2
#07bf .System/b DEO2 #07bf .System/b DEO2
;load-theme JSR2 load-theme
( set starting tint: reverse=0, bg=0, fg=2 ) ( set starting tint: reverse=0, bg=0, fg=2 )
#02 .attr STZ #02 .attr STZ
;update-tint JSR2 update-tint
( set initial modes ) ( set initial modes )
#01 .irm STZ ( insert and move right ) #01 .irm STZ ( insert and move right )
@ -117,7 +117,7 @@
#00 .paste STZ ( bracketed paste is off ) #00 .paste STZ ( bracketed paste is off )
( clear screen for initial draw ) ( clear screen for initial draw )
;clear-screen JSR2 clear-screen
( set up interrupts ) ( set up interrupts )
;redraw .Screen/vect DEO2 ( set up screen ) ;redraw .Screen/vect DEO2 ( set up screen )
@ -127,7 +127,7 @@
( set to 01 to enable debug log ) ( set to 01 to enable debug log )
#00 .debug STZ #00 .debug STZ
.debug LDZ ,&continue JCN BRK &continue .debug LDZ ?&continue BRK &continue
#99 #010e DEO #99 #010e DEO
;debug-log .File/name DEO2 ;debug-log .File/name DEO2
#01 .File/append DEO #01 .File/append DEO
@ -174,57 +174,57 @@
#4220 STH2kr STA2 ( y* x* [addr*] ) #4220 STH2kr STA2 ( y* x* [addr*] )
INC2r INC2r ( y* x* [addr+2*] ) INC2r INC2r ( y* x* [addr+2*] )
INC2 DUP2 .cols LDZ2 ( y* x+1* x+1* cols* [addr+2*] ) INC2 DUP2 .cols LDZ2 ( y* x+1* x+1* cols* [addr+2*] )
LTH2 ,&xloop JCN ( y* x+1* [addr+2*] ) LTH2 ?&xloop ( y* x+1* [addr+2*] )
POP2 ( y* [addr*] ) POP2 ( y* [addr*] )
INC2 DUP2 .rows LDZ2 ( y+1* y+1* rows* [addr*] ) INC2 DUP2 .rows LDZ2 ( y+1* y+1* rows* [addr*] )
LTH2 ,&yloop JCN ( y+1* [addr*] ) LTH2 ?&yloop ( y+1* [addr*] )
POP2 POP2r JMP2r ( ) POP2 POP2r JMP2r ( )
@redraw @redraw
.dirty? LDZ #00 EQU ,&done JCN .dirty? LDZ #00 EQU ?&done
;cells STH2 ( [addr*] ) ;cells STH2 ( [addr*] )
#0000 DUP2 .Screen/y DEO2 #0000 DUP2 .Screen/y DEO2
&yloop &yloop
#0000 DUP2 .Screen/x DEO2 #0000 DUP2 .Screen/x DEO2
&xloop &xloop
STH2kr LDA2 ;draw-cell JSR2 STH2kr LDA2 draw-cell
.Screen/x DEI2k #0008 ADD2 ROT DEO2 .Screen/x DEI2k #0008 ADD2 ROT DEO2
INC2 INC2r INC2r INC2 INC2r INC2r
DUP2 .cols LDZ2 LTH2 ,&xloop JCN DUP2 .cols LDZ2 LTH2 ?&xloop
POP2 POP2
.Screen/y DEI2k #0008 ADD2 ROT DEO2 .Screen/y DEI2k #0008 ADD2 ROT DEO2
INC2 INC2
DUP2 .rows LDZ2 LTH2 ,&yloop JCN DUP2 .rows LDZ2 LTH2 ?&yloop
POP2 POP2r POP2 POP2r
;draw-cursor JSR2 draw-cursor
#00 .dirty? STZ #00 .dirty? STZ
&done BRK &done BRK
@clear-cursor @clear-cursor
.cur-x LDZ2 #30 SFT2 .Screen/x DEO2 .cur-x LDZ2 #30 SFT2 .Screen/x DEO2
.cur-y LDZ2 #30 SFT2 .Screen/y DEO2 .cur-y LDZ2 #30 SFT2 .Screen/y DEO2
;cur-addr JSR2 LDA2 cur-addr LDA2
;draw-cell JMP2 !draw-cell
@draw-cursor @draw-cursor
.cur-x LDZ2 #30 SFT2 .Screen/x DEO2 .cur-x LDZ2 #30 SFT2 .Screen/x DEO2
.cur-y LDZ2 #30 SFT2 .Screen/y DEO2 .cur-y LDZ2 #30 SFT2 .Screen/y DEO2
;cur-addr JSR2 LDA2 cur-addr LDA2
.tcem LDZ #00 EQU ,&skip JCN .tcem LDZ #00 EQU ?&skip
SWP ;reverse-tint JSR2 SWP SWP reverse-tint SWP
&skip &skip
;draw-cell JMP2 !draw-cell
@on-button ( -> ) @on-button ( -> )
.lastkey LDZ ( last^ ) .lastkey LDZ ( last^ )
.Controller/button DEI ( last^ button^ ) .Controller/button DEI ( last^ button^ )
STHk EOR ( last-xor-button^ [button^] ) STHk EOR ( last-xor-button^ [button^] )
STHr AND ( last-xor-button&button^ ) STHr AND ( last-xor-button&button^ )
DUP #10 AND #00 EQU ,&no-n JCN LIT "A ,arrow JSR DUP #10 AND #00 EQU ?&no-n LIT "A arrow
&no-n DUP #20 AND #00 EQU ,&no-s JCN LIT "B ,arrow JSR &no-n DUP #20 AND #00 EQU ?&no-s LIT "B arrow
&no-s DUP #40 AND #00 EQU ,&no-w JCN LIT "D ,arrow JSR &no-s DUP #40 AND #00 EQU ?&no-w LIT "D arrow
&no-w DUP #80 AND #00 EQU ,&no-e JCN LIT "C ,arrow JSR &no-w DUP #80 AND #00 EQU ?&no-e LIT "C arrow
&no-e POP .Controller/button DEI .lastkey STZ BRK &no-e POP .Controller/button DEI .lastkey STZ BRK
( send ESC [ $c ) ( send ESC [ $c )
@ -234,21 +234,21 @@
JMP2r JMP2r
@on-key ( -> ) @on-key ( -> )
.Controller/key DEI ,&ok JCN ,on-button JMP .Controller/key DEI ?&ok !on-button
&ok ,alt? JSR ,on-alt-key JCN &ok alt ?on-alt-key
,ctrl? JSR ,on-ctrl-key JCN ctrl ?on-ctrl-key
.Controller/key DEI .Controller/key DEI
DUP #08 NEQ ,&done JCN DUP #08 NEQ ?&done
POP #7f ( send DEL instead of BS ) POP #7f ( send DEL instead of BS )
&done .Console/w DEO BRK &done .Console/w DEO BRK
@ctrl? ( -> is-down? ) .Controller/button DEI #01 AND JMP2r @ctrl ( -> is-down? ) .Controller/button DEI #01 AND JMP2r
@alt? ( -> is-down? ) .Controller/button DEI #02 AND JMP2r @alt ( -> is-down? ) .Controller/button DEI #02 AND JMP2r
( alt-XYZ emits ESC and then emits XYZ ) ( alt-XYZ emits ESC and then emits XYZ )
@on-alt-key ( -> ) @on-alt-key ( -> )
#1b .Console/w DEO #1b .Console/w DEO
,ctrl? JSR ,on-ctrl-key JCN ctrl ?on-ctrl-key
.Controller/key DEI .Console/w DEO BRK .Controller/key DEI .Console/w DEO BRK
( ctrl-$n emits: ) ( ctrl-$n emits: )
@ -257,48 +257,48 @@
( ` <= $n <= #ff -> $n #60 SUB ) ( ` <= $n <= #ff -> $n #60 SUB )
@on-ctrl-key ( -> ) @on-ctrl-key ( -> )
.Controller/key DEI .Controller/key DEI
DUP LIT "@ LTH ,&done JCN DUP LIT "@ LTH ?&done
DUP LIT "` LTH ,&c1 JCN DUP LIT "` LTH ?&c1
LIT "` SUB ,&done JMP LIT "` SUB !&done
&c1 LIT "@ SUB &c1 LIT "@ SUB
&done .Console/w DEO BRK &done .Console/w DEO BRK
@on-read-priv @on-read-priv
.Console/r DEI .Console/r DEI
DUP LIT "; EQU ;next-arg JCN2 DUP LIT "; EQU ?next-arg
DUP LIT "0 LTH ;end-arg-priv JCN2 DUP LIT "0 LTH ?end-arg-priv
DUP LIT "9 GTH ;end-arg-priv JCN2 DUP LIT "9 GTH ?end-arg-priv
;add-to-arg JMP2 !add-to-arg
@start-priv @start-priv
POP ;on-read-priv .Console/vect DEO2 BRK POP ;on-read-priv .Console/vect DEO2 BRK
@on-read-csi ( -> ) @on-read-csi ( -> )
.Console/r DEI .Console/r DEI
DUP LIT "? EQU ;start-priv JCN2 DUP LIT "? EQU ?start-priv
DUP LIT "; EQU ;next-arg JCN2 DUP LIT "; EQU ?next-arg
DUP LIT "0 LTH ;end-arg JCN2 DUP LIT "0 LTH ?end-arg
DUP LIT "9 GTH ;end-arg JCN2 DUP LIT "9 GTH ?end-arg
;add-to-arg JMP2 !add-to-arg
@debug-arg ( n* -> ) @debug-arg ( n* -> )
&short SWP ,&byte JSR &short SWP debug-arg/byte
&byte DUP #04 SFT ,&char JSR &byte DUP #04 SFT debug-arg/char
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD ;scratch-write JSR2 &char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD scratch-write
JMP2r JMP2r
@debug-args ( -> ) @debug-args ( -> )
;args/pos LDA2 ;args ;args/pos LDA2 ;args
&loop &loop
#20 ;scratch-write JSR2 #20 scratch-write
LDA2k ;debug-arg/short JSR2 INC2 INC2 LDA2k debug-arg/short INC2 INC2
LTH2k ,&done JCN ,&loop JMP LTH2k ?&done !&loop
&done POP2 POP2 JMP2r &done POP2 POP2 JMP2r
@debug-priv ( c^ -> ) @debug-priv ( c^ -> )
.debug LDZ ,&continue JCN POP JMP2r &continue .debug LDZ ?&continue POP JMP2r &continue
;reset-scratch JSR2 reset-scratch
;scratch-write STH2 ;scratch-write STH2
LIT "1 STH2kr JSR2 LIT "1 STH2kr JSR2
LIT "b STH2kr JSR2 LIT "b STH2kr JSR2
@ -306,67 +306,67 @@
LIT "[ STH2kr JSR2 LIT "[ STH2kr JSR2
#20 STH2kr JSR2 #20 STH2kr JSR2
LIT "? STH2kr JSR2 LIT "? STH2kr JSR2
;debug-args JSR2 debug-args
#20 STH2kr JSR2 #20 STH2kr JSR2
STH2kr JSR2 STH2kr JSR2
#0a STH2r JSR2 #0a STH2r JSR2
;scratch-len JSR2 .File/len DEO2 scratch-len .File/len DEO2
;scratch .File/w DEO2 ;scratch .File/w DEO2
JMP2r JMP2r
@end-arg-priv ( c^ -> ) @end-arg-priv ( c^ -> )
;on-read .Console/vect DEO2 ;on-read .Console/vect DEO2
DUP LIT "h EQU ,exec-priv-set-or-unset JCN DUP LIT "h EQU ?exec-priv-set-or-unset
DUP LIT "l EQU ,exec-priv-set-or-unset JCN DUP LIT "l EQU ?exec-priv-set-or-unset
DUP ,debug-priv JSR DUP debug-priv
( TODO: handle these ) ( TODO: handle these )
POP BRK POP BRK
@exec-priv-set-or-unset ( c^ -> ) @exec-priv-set-or-unset ( c^ -> )
#0001 ;read-arg-1 JSR2 ( c^ n* ) #0001 read-arg-1 ( c^ n* )
DUP2 #0019 NEQ2 ,&!25 JCN POP2 .tcem ,&change JMP DUP2 #0019 NEQ2 ?&!25 POP2 .tcem !&change
&!25 DUP2 #07d4 NEQ2 ,&!2004 JCN POP2 .paste ,&change JMP &!25 DUP2 #07d4 NEQ2 ?&!2004 POP2 .paste !&change
&!2004 POP2 ;debug-priv JSR2 BRK &!2004 POP2 debug-priv BRK
&change SWP LIT "h EQU SWP STZ BRK ( h is set, l is unset ) &change SWP LIT "h EQU SWP STZ BRK ( h is set, l is unset )
@debug-csi ( c^ -> ) @debug-csi ( c^ -> )
.debug LDZ ,&continue JCN POP JMP2r &continue .debug LDZ ?&continue POP JMP2r &continue
;reset-scratch JSR2 reset-scratch
;scratch-write STH2 ;scratch-write STH2
LIT "1 STH2kr JSR2 LIT "1 STH2kr JSR2
LIT "b STH2kr JSR2 LIT "b STH2kr JSR2
#20 STH2kr JSR2 #20 STH2kr JSR2
LIT "[ STH2kr JSR2 LIT "[ STH2kr JSR2
;debug-args JSR2 debug-args
#20 STH2kr JSR2 #20 STH2kr JSR2
STH2kr JSR2 STH2kr JSR2
#0a STH2r JSR2 #0a STH2r JSR2
;scratch-len JSR2 .File/len DEO2 scratch-len .File/len DEO2
;scratch .File/w DEO2 ;scratch .File/w DEO2
JMP2r JMP2r
@end-arg ( c^ -> ) @end-arg ( c^ -> )
;on-read .Console/vect DEO2 ;on-read .Console/vect DEO2
( DUP ,debug-csi JSR ) ( DUP debug-csi )
DUP LIT "d EQU ;exec-move-row JCN2 ( move cursor to row ) DUP LIT "d EQU ?exec-move-row ( move cursor to row )
DUP LIT "h EQU ;exec-set-mode JCN2 ( enable line wrap ) DUP LIT "h EQU ?exec-set-mode ( enable line wrap )
DUP LIT "l EQU ;exec-reset-mode JCN2 ( disable line wrap ) DUP LIT "l EQU ?exec-reset-mode ( disable line wrap )
DUP LIT "m EQU ;exec-set-attr JCN2 ( set attr ) DUP LIT "m EQU ?exec-set-attr ( set attr )
DUP LIT "n EQU ;exec-status JCN2 ( get status ) DUP LIT "n EQU ?exec-status ( get status )
DUP LIT "@ EQU ;exec-insert-blanks JCN2 ( insert blank characters ) DUP LIT "@ EQU ?exec-insert-blanks ( insert blank characters )
DUP LIT "A EQU ;exec-up JCN2 ( up ) DUP LIT "A EQU ?exec-up ( up )
DUP LIT "B EQU ;exec-down JCN2 ( down ) DUP LIT "B EQU ?exec-down ( down )
DUP LIT "C EQU ;exec-forward JCN2 ( forward ) DUP LIT "C EQU ?exec-forward ( forward )
DUP LIT "D EQU ;exec-back JCN2 ( back ) DUP LIT "D EQU ?exec-back ( back )
DUP LIT "G EQU ;exec-move-col JCN2 ( move cursor to col ) DUP LIT "G EQU ?exec-move-col ( move cursor to col )
DUP LIT "H EQU ;exec-move JCN2 ( move cursor ) DUP LIT "H EQU ?exec-move ( move cursor )
DUP LIT "I EQU ;exec-forward-tabs JCN2 ( forward by tab stops ) DUP LIT "I EQU ?exec-forward-tabs ( forward by tab stops )
DUP LIT "J EQU ;exec-erase-screen JCN2 ( erase screen ) DUP LIT "J EQU ?exec-erase-screen ( erase screen )
DUP LIT "K EQU ;exec-erase-line JCN2 ( erase line ) DUP LIT "K EQU ?exec-erase-line ( erase line )
DUP LIT "L EQU ;exec-insert-lines JCN2 ( insert blank lines ) DUP LIT "L EQU ?exec-insert-lines ( insert blank lines )
DUP LIT "M EQU ;exec-delete-lines JCN2 ( delete n lines ) DUP LIT "M EQU ?exec-delete-lines ( delete n lines )
DUP LIT "P EQU ;exec-delete-chars JCN2 ( delete n chars ) DUP LIT "P EQU ?exec-delete-chars ( delete n chars )
;debug-csi JSR2 BRK debug-csi BRK
@exec-noop ( c^ -> ) @exec-noop ( c^ -> )
POP BRK POP BRK
@ -374,45 +374,45 @@
( set mode ) ( set mode )
( TODO: insert/replace, line wrap, etc. ) ( TODO: insert/replace, line wrap, etc. )
@exec-set-mode ( c^ -> ) @exec-set-mode ( c^ -> )
POP #0001 ;read-arg-1 JSR2 POP #0001 read-arg-1
DUP2 #0004 NEQ2 ,&!irm JCN POP2 .irm ,&set JMP DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&set
&!irm DUP2 #0007 NEQ2 ,&!awm JCN POP2 .awm ,&set JMP &!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&set
&!awm POP2 BRK &!awm POP2 BRK
&set #01 SWP STZ BRK &set #01 SWP STZ BRK
@exec-reset-mode ( c^ -> ) @exec-reset-mode ( c^ -> )
POP #0001 ;read-arg-1 JSR2 POP #0001 read-arg-1
DUP2 #0004 NEQ2 ,&!irm JCN POP2 .irm ,&reset JMP DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&reset
&!irm DUP2 #0007 NEQ2 ,&!awm JCN POP2 .awm ,&reset JMP &!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&reset
&!awm POP2 BRK &!awm POP2 BRK
&reset #00 SWP STZ BRK &reset #00 SWP STZ BRK
@read-attr ( attr* -> ) @read-attr ( attr* -> )
DUP2 #0000 NEQ2 ,&!0 JCN #02 .attr STZ ,&done JMP ( reset ) DUP2 #0000 NEQ2 ?&!0 #02 .attr STZ !&done ( reset )
&!0 DUP2 #0001 NEQ2 ,&!1 JCN #03 ,&set-fg JMP ( bright ) &!0 DUP2 #0001 NEQ2 ?&!1 #03 !&set-fg ( bright )
&!1 DUP2 #0002 NEQ2 ,&!2 JCN #01 ,&set-fg JMP ( dim ) &!1 DUP2 #0002 NEQ2 ?&!2 #01 !&set-fg ( dim )
&!2 DUP2 #0007 NEQ2 ,&!7 JCN .attr LDZk #80 ORA SWP STZ ,&done JMP ( reverse ) &!2 DUP2 #0007 NEQ2 ?&!7 .attr LDZk #80 ORA SWP STZ !&done ( reverse )
&!7 ,&ignored JMP &!7 !&ignored
&set-fg .attr LDZ #fc AND ORA .attr STZ &set-fg .attr LDZ #fc AND ORA .attr STZ
&done ;update-tint JSR2 &done update-tint
&ignored POP2 JMP2r &ignored POP2 JMP2r
@exec-set-attr ( c^ -> ) @exec-set-attr ( c^ -> )
POP POP
;args/pos LDA2 ;args ;args/pos LDA2 ;args
&loop &loop
LDA2k ;read-attr JSR2 LDA2k read-attr
INC2 INC2 INC2 INC2
LTH2k ,&done JCN ,&loop JMP LTH2k ?&done !&loop
&done &done
POP2 POP2 BRK POP2 POP2 BRK
@exec1 ( addr* -> ) @exec1 ( addr* -> )
STH2 #0001 ;read-arg-1 JSR2 STH2r JSR2 BRK STH2 #0001 read-arg-1 STH2r JSR2 BRK
@exec-status @exec-status
POP #0000 ;read-arg-1 JSR2 #0006 NEQ2 ,&done POP #0000 read-arg-1 #0006 NEQ2 ,&done
#1b .Console/w DEO #1b .Console/w DEO
LIT "[ .Console/w DEO LIT "[ .Console/w DEO
LIT "4 .Console/w DEO LIT "4 .Console/w DEO
@ -423,50 +423,50 @@
LIT "R .Console/w DEO LIT "R .Console/w DEO
&done BRK &done BRK
@exec-up POP ;up-n ;exec1 JMP2 @exec-up POP ;up-n !exec1
@exec-down POP ;down-n ;exec1 JMP2 @exec-down POP ;down-n !exec1
@exec-forward POP ;forward-n ;exec1 JMP2 @exec-forward POP ;forward-n !exec1
@exec-back POP ;back-n ;exec1 JMP2 @exec-back POP ;back-n !exec1
@exec-insert-blanks POP ;insert-n-spaces ;exec1 JMP2 @exec-insert-blanks POP ;insert-n-spaces !exec1
@exec-delete-lines POP ;delete-n-lines ;exec1 JMP2 @exec-delete-lines POP ;delete-n-lines !exec1
@exec-delete-chars POP ;delete-n-chars ;exec1 JMP2 @exec-delete-chars POP ;delete-n-chars !exec1
@exec-insert-lines POP ;insert-n-lines ;exec1 JMP2 @exec-insert-lines POP ;insert-n-lines !exec1
@exec-forward-tabs POP ;forward-n-tabs ;exec1 JMP2 @exec-forward-tabs POP ;forward-n-tabs !exec1
@exec-erase-line @exec-erase-line
POP #0000 ;read-arg-1 JSR2 POP #0000 read-arg-1
DUP2 #0000 EQU2 ,&erase-to-end JCN DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ,&erase-from-start JCN DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ,&erase-full JCN DUP2 #0002 EQU2 ?&erase-full
POP2 BRK POP2 BRK
&erase-full &erase-full
POP2 ;bol-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK POP2 bol-addr eol-addr erase BRK
&erase-to-end &erase-to-end
POP2 ;cur-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK POP2 cur-addr eol-addr erase BRK
&erase-from-start &erase-from-start
POP2 ;bol-addr JSR2 ;cur-addr JSR2 ;erase JSR2 BRK POP2 bol-addr cur-addr erase BRK
@exec-erase-screen @exec-erase-screen
POP #0000 ;read-arg-1 JSR2 POP #0000 read-arg-1
DUP2 #0000 EQU2 ,&erase-to-end JCN DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ,&erase-from-start JCN DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ,&erase-full JCN DUP2 #0002 EQU2 ?&erase-full
POP2 BRK POP2 BRK
&erase-full &erase-full
POP2 ;first-addr JSR2 ;limit-addr JSR2 ;erase JSR2 BRK POP2 first-addr limit-addr erase BRK
&erase-to-end &erase-to-end
POP2 ;bol-addr JSR2 ;limit-addr JSR2 ;erase JSR2 BRK POP2 bol-addr limit-addr erase BRK
&erase-from-start &erase-from-start
POP2 ;first-addr JSR2 ;eol-addr JSR2 ;erase JSR2 BRK POP2 first-addr eol-addr erase BRK
( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords ) ( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords )
@erase ( start* end* -> ) @erase ( start* end* -> )
EQU2k ,&skip JCN ( start* end* ) EQU2k ?&skip ( start* end* )
OVR2 SWP2 ( start* start* end* ) OVR2 SWP2 ( start* start* end* )
SUB2 STH2 #4220 SWP2 ( 4220 start* [count*] ) SUB2 STH2 #4220 SWP2 ( 4220 start* [count*] )
&loop ( 4220 addr* [i*] ) &loop ( 4220 addr* [i*] )
STA2k INC2 INC2 INC2r INC2r ( 4220 addr+2* [i+1*] ) STA2k INC2 INC2 INC2r INC2r ( 4220 addr+2* [i+1*] )
ORAkr STHr ,&loop JCN ( 4220 addr+2* [i+2*] ) ORAkr STHr ?&loop ( 4220 addr+2* [i+2*] )
POP2r POP2 POP2 ( ) POP2r POP2 POP2 ( )
#01 .dirty? STZ ( ; FIXME just redraw affected tiles ) #01 .dirty? STZ ( ; FIXME just redraw affected tiles )
JMP2r ( ) JMP2r ( )
@ -474,24 +474,24 @@
@exec-move-row ( c^ -> ) @exec-move-row ( c^ -> )
POP POP
#0001 ;read-arg-1 JSR2 #0001 SUB2 ( row ) #0001 read-arg-1 #0001 SUB2 ( row )
.cur-x LDZ2 ( col ) .cur-x LDZ2 ( col )
;goto JSR2 BRK goto BRK
@exec-move-col ( c^ -> ) @exec-move-col ( c^ -> )
POP POP
.cur-y LDZ2 ( row ) .cur-y LDZ2 ( row )
#0001 ;read-arg-2 JSR2 #0001 SUB2 ( col ) #0001 read-arg-2 #0001 SUB2 ( col )
;goto JSR2 BRK goto BRK
@exec-move ( c^ -> ) @exec-move ( c^ -> )
POP POP
#0001 ;read-arg-1 JSR2 #0001 SUB2 ( row ) #0001 read-arg-1 #0001 SUB2 ( row )
#0001 ;read-arg-2 JSR2 #0001 SUB2 ( col ) #0001 read-arg-2 #0001 SUB2 ( col )
;goto JSR2 BRK goto BRK
@debug-esc ( c^ -> ) @debug-esc ( c^ -> )
.debug LDZ ,&continue JCN POP JMP2r &continue .debug LDZ ?&continue POP JMP2r &continue
;scratch STH2 ;scratch STH2
LIT "1 STH2kr STA INC2r LIT "1 STH2kr STA INC2r
LIT "b STH2kr STA INC2r LIT "b STH2kr STA INC2r
@ -503,43 +503,43 @@
JMP2r JMP2r
@on-read-esc ( -> ) @on-read-esc ( -> )
.Console/r DEI LIT "[ EQU ;start-csi JCN2 .Console/r DEI LIT "[ EQU ?start-csi
.Console/r DEI ,debug-esc JSR .Console/r DEI debug-esc
;on-read .Console/vect DEO2 ;on-read .Console/vect DEO2
;on-read JMP2 !on-read
@start-csi ( -> ) @start-csi ( -> )
;reset-args JSR2 reset-args
;on-read-csi .Console/vect DEO2 ;on-read-csi .Console/vect DEO2
BRK BRK
@on-read @on-read
.Console/r DEI .Console/r DEI
DUP ,&ok JCN POP BRK DUP ?&ok POP BRK
&ok ( #42 .tint STZ ) &ok ( #42 .tint STZ )
;read JMP2 !read
@read ( c^ -> ) @read ( c^ -> )
DUP #20 LTH ;read-ctrl JCN2 DUP #20 LTH ?read-ctrl
DUP #7f EQU ;read-del JCN2 DUP #7f EQU ?read-del
;read-printable JMP2 !read-printable
@read-ctrl ( c^ -> ) @read-ctrl ( c^ -> )
DUP #07 EQU ;read-bel JCN2 DUP #07 EQU ?read-bel
DUP #08 EQU ;read-bs JCN2 DUP #08 EQU ?read-bs
DUP #09 EQU ;read-tab JCN2 DUP #09 EQU ?read-tab
DUP #0a EQU ;read-nl JCN2 DUP #0a EQU ?read-nl
DUP #0d EQU ;read-cr JCN2 DUP #0d EQU ?read-cr
DUP #1b EQU ;read-esc JCN2 DUP #1b EQU ?read-esc
@read-bel ( 07 -> ) @read-bel ( 07 -> )
POP BRK ( TODO: flash terminal ) POP BRK ( TODO: flash terminal )
@read-bs ( 08 -> ) @read-bs ( 08 -> )
POP POP
;clear-cursor JSR2 clear-cursor
#0001 ;back-n JSR2 #0001 back-n
;draw-cursor JSR2 draw-cursor
JMP2r JMP2r
@read-esc ( 1b -> ) @read-esc ( 1b -> )
@ -555,147 +555,147 @@
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 JSR2 STA2 ( i^ cell* ; addr<-cell ) cur-addr STA2 ( i^ cell* ; addr<-cell )
;draw-cell JSR2 ( i^ ) draw-cell ( i^ )
;forward JSR2 ( i^ ) forward ( i^ )
INC DUP ,&loop JCN ( i+1^ ) INC DUP ?&loop ( i+1^ )
POP BRK ( ) POP BRK ( )
@read-cr ( 0d -> ) @read-cr ( 0d -> )
POP ;clear-cursor JSR2 #0000 .cur-x STZ2 BRK POP clear-cursor #0000 .cur-x STZ2 BRK
@at-max-y ( -> true? ) @at-max-y ( -> true? )
.cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
@read-nl ( 0a -> ) @read-nl ( 0a -> )
POP ;clear-cursor JSR2 POP clear-cursor
,at-max-y JSR ;scroll JCN2 ;down JSR2 BRK at-max-y ?scroll down BRK
@read-printable ( c -> ) @read-printable ( c -> )
.tint LDZ SWP DUP2 ;cur-addr JSR2 STA2 .tint LDZ SWP DUP2 cur-addr STA2
;draw-cell JSR2 draw-cell
;forward JSR2 BRK forward BRK
@goto ( y* x* -> ) @goto ( y* x* -> )
;clear-cursor JSR2 clear-cursor
.max-x LDZ2 ;min JSR2 .cur-x STZ2 .max-x LDZ2 min .cur-x STZ2
.max-y LDZ2 ;min JSR2 .cur-y STZ2 .max-y LDZ2 min .cur-y STZ2
;draw-cursor JMP2 !draw-cursor
@forward-n ( n* -> ) @forward-n ( n* -> )
;clear-cursor JSR2 clear-cursor
.cur-x LDZ2 ADD2 .max-x LDZ2 ;min JSR2 .cur-x STZ2 .cur-x LDZ2 ADD2 .max-x LDZ2 min .cur-x STZ2
;draw-cursor JMP2 !draw-cursor
@forward ( -> ) @forward ( -> )
#0001 ,forward-n JMP #0001 !forward-n
@back-n ( n* -> ) @back-n ( n* -> )
;clear-cursor JSR2 clear-cursor
.cur-x LDZ2 GTH2k ,&zero JCN .cur-x LDZ2 GTH2k ?&zero
SWP2 SUB2 ,&done JMP SWP2 SUB2 !&done
&zero POP2 POP2 #0000 &zero POP2 POP2 #0000
&done .cur-x STZ2 ;draw-cursor JMP2 &done .cur-x STZ2 !draw-cursor
@up-n ( n* -> ) @up-n ( n* -> )
;clear-cursor JSR2 clear-cursor
.cur-y LDZ2 GTH2k ,&zero JCN .cur-y LDZ2 GTH2k ?&zero
SWP2 SUB2 ,&done JMP SWP2 SUB2 !&done
&zero POP2 POP2 #0000 &zero POP2 POP2 #0000
&done .cur-y STZ2 ;draw-cursor JMP2 &done .cur-y STZ2 !draw-cursor
@down-n ( n* -> ) @down-n ( n* -> )
;clear-cursor JSR2 clear-cursor
.cur-y LDZ2 ADD2 .max-y LDZ2 ;min JSR2 .cur-y STZ2 .cur-y LDZ2 ADD2 .max-y LDZ2 min .cur-y STZ2
;draw-cursor JMP2 !draw-cursor
@down ( -> ) @down ( -> )
#0001 ,down-n JMP #0001 !down-n
( @insert ( c^ -> ) ( @insert ( c^ -> )
.attr LDZ SWP ,insert-cell JMP .attr LDZ SWP !insert-cell
@insert-cell ( cell* -> ) @insert-cell ( cell* -> )
.irm LDZ #00 EQU ,&replace JCN ( cell* ) .irm LDZ #00 EQU ?&replace ( cell* )
;eol-addr JSR2 #0001 SUB2 ( cell* last=eol-1* ) eol-addr #0001 SUB2 ( cell* last=eol-1* )
;cur-addr JSR2 ( cell* last* cur* ) cur-addr ( cell* last* cur* )
&loop ( cell* last* pos* ) &loop ( cell* last* pos* )
LDA2k OVR2 INC2 STA2 ( cell* last* pos* ; pos+1<-pos ) LDA2k OVR2 INC2 STA2 ( cell* last* pos* ; pos+1<-pos )
INC2 LTH2k ,&loop JCN ( cell* last pos+1* ) INC2 LTH2k ?&loop ( cell* last pos+1* )
POP2 POP2 ( cell* ) POP2 POP2 ( cell* )
&replace ( cell* ) &replace ( cell* )
;cur-addr JSR2 STA2 JMP2r ( ) ) cur-addr STA2 JMP2r ( ) )
@forward-n-tabs ( n* -> ) @forward-n-tabs ( n* -> )
#0001 SUB2 #0008 MUL2 ( i=(n-1)8* ) #0001 SUB2 #0008 MUL2 ( i=(n-1)8* )
#0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* ) #0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* )
ADD2 ;forward-n JMP2 ( ) ADD2 !forward-n ( )
@insert-n-lines ( n* -> ) @insert-n-lines ( n* -> )
.col-bytes LDZ2 MUL2 STH2 ( [i*] ) .col-bytes LDZ2 MUL2 STH2 ( [i*] )
;bol-addr JSR2 ( bound* [i*] ) bol-addr ( bound* [i*] )
;limit-addr JSR2 STH2kr ( bound* limit* i* [i*] ) limit-addr STH2kr ( bound* limit* i* [i*] )
INC2 INC2 SUB2 ( bound* start=limit-i-2* [i*] ) INC2 INC2 SUB2 ( bound* start=limit-i-2* [i*] )
&loop ( bound* pos* [i*] ) &loop ( bound* pos* [i*] )
LDA2k OVR2 STH2kr ADD2 ( bound* pos* x* pos+i* [i*] ) LDA2k OVR2 STH2kr ADD2 ( bound* pos* x* pos+i* [i*] )
STA2 ( bound* pos* [i*] ; pos+i<-x ) STA2 ( bound* pos* [i*] ; pos+i<-x )
#4220 OVR2 STA2 ( bound* pos* [i*] ; pos<-4220 ) #4220 OVR2 STA2 ( bound* pos* [i*] ; pos<-4220 )
#0002 SUB2 ( bound* pos-2* [i*] ) #0002 SUB2 ( bound* pos-2* [i*] )
GTH2k #00 EQU ,&loop JCN ( bound* pos-2* [i*] ) GTH2k #00 EQU ?&loop ( bound* pos-2* [i*] )
POP2 POP2 POP2r ( ) POP2 POP2 POP2r ( )
#01 .dirty? STZ JMP2r ( ) #01 .dirty? STZ JMP2r ( )
@insert-n-spaces ( n* -> ) @insert-n-spaces ( n* -> )
STH2 ( [n*] ) STH2 ( [n*] )
.irm LDZ #00 EQU ,&replace JCN ( [n*] ) .irm LDZ #00 EQU ?&replace ( [n*] )
;eol-addr JSR2 #0001 SUB2 ( last* [n*] ) eol-addr #0001 SUB2 ( last* [n*] )
STH2kr DUP2 ADD2 SUB2 ( start=last-2n* [n*] ) STH2kr DUP2 ADD2 SUB2 ( start=last-2n* [n*] )
;cur-addr JSR2 SWP2 ( end* start* [n*] ) cur-addr SWP2 ( end* start* [n*] )
DUP2kr ADD2r ( end* start* [n* 2n*] ) DUP2kr ADD2r ( end* start* [n* 2n*] )
&loop ( end* pos* [n* 2n*] ) &loop ( end* pos* [n* 2n*] )
LDA2k OVR2 STH2kr ADD2 ( end* pos* x* pos+2n* ) LDA2k OVR2 STH2kr ADD2 ( end* pos* x* pos+2n* )
STA2 #0002 SUB2 ( end* pos-2* [n* 2n*] ) STA2 #0002 SUB2 ( end* pos-2* [n* 2n*] )
GTH2k #00 EQU ,&loop JCN ( end* pos-2* [n* 2n*] ) GTH2k #00 EQU ?&loop ( end* pos-2* [n* 2n*] )
POP2 POP2 POP2r ( [n*] ) POP2 POP2 POP2r ( [n*] )
&replace ( [n*] ) &replace ( [n*] )
LIT2r 0000 SWP2r SUB2r ( [-n*] ) LIT2r 0000 SWP2r SUB2r ( [-n*] )
#4220 ;cur-addr JSR2 ( 4220 cur* [-n*] ) #4220 cur-addr ( 4220 cur* [-n*] )
&loop2 ( 4220 pos* [-i*] ) &loop2 ( 4220 pos* [-i*] )
STA2k INC2 INC2 INC2r ( 4220 pos+2* [-i+1*] ) STA2k INC2 INC2 INC2r ( 4220 pos+2* [-i+1*] )
ORAkr STHr ,&loop2 JCN ( 4220 pos+2* [-i+1*] ) ORAkr STHr ?&loop2 ( 4220 pos+2* [-i+1*] )
POP2 POP2 POP2r ( ) POP2 POP2 POP2r ( )
#01 .dirty? STZ JMP2r ( ) #01 .dirty? STZ JMP2r ( )
( starts with cursor pos ) ( starts with cursor pos )
@delete-n-chars ( n* -> ) @delete-n-chars ( n* -> )
DUP2 ADD2 STH2 ( [i=2n*] ) DUP2 ADD2 STH2 ( [i=2n*] )
;eol-addr JSR2 STH2kr SUB2 ( limit=eol-i* [i*] ) eol-addr STH2kr SUB2 ( limit=eol-i* [i*] )
;cur-addr JSR2 ( limit* start* [i*] ) cur-addr ( limit* start* [i*] )
&loop ( limit* pos* [n*] ) &loop ( limit* pos* [n*] )
DUP2 STH2kr ADD2 LDA2k ( limit* pos* pos+i* x* [i*] ) DUP2 STH2kr ADD2 LDA2k ( limit* pos* pos+i* x* [i*] )
#4220 ROT2 STA2 ( limit* pos* x* [i*] ; pos+i<-4220 ) #4220 ROT2 STA2 ( limit* pos* x* [i*] ; pos+i<-4220 )
OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x ) OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x )
GTH2k ,&loop JCN ( limit* pos+2* [i*] ) GTH2k ?&loop ( limit* pos+2* [i*] )
POP2 POP2 POP2r ( ) POP2 POP2 POP2r ( )
#01 .dirty? STZ JMP2r ( ) #01 .dirty? STZ JMP2r ( )
( starts below current line ) ( starts below current line )
@delete-n-lines ( n* -> ) @delete-n-lines ( n* -> )
.col-bytes LDZ2 MUL2 STH2 ( [n*] ) .col-bytes LDZ2 MUL2 STH2 ( [n*] )
;limit-addr JSR2 STH2kr SUB2 ( limit* [n*] ) limit-addr STH2kr SUB2 ( limit* [n*] )
;eol-addr JSR2 ( limit* start* [n*] ) eol-addr ( limit* start* [n*] )
,delete-n-chars/loop JMP !delete-n-chars/loop
@scroll @scroll
;limit-addr JSR2 STH2 limit-addr STH2
;cells .col-bytes LDZ2 ADD2 STH2 ;cells .col-bytes LDZ2 ADD2 STH2
&loop &loop
STH2kr LDA2 #4220 STH2kr STA2 STH2kr LDA2 #4220 STH2kr STA2
STH2kr .col-bytes LDZ2 SUB2 STA2 STH2kr .col-bytes LDZ2 SUB2 STA2
INC2r INC2r GTH2kr STHr ,&loop JCN INC2r INC2r GTH2kr STHr ?&loop
POP2r POP2r POP2r POP2r
#01 .dirty? STZ #01 .dirty? STZ
;draw-cursor JSR2 BRK draw-cursor BRK
( 0 <= index < 128 ) ( 0 <= index < 128 )
@load-tile ( index^ -> ) @load-tile ( index^ -> )
@ -709,7 +709,7 @@
( - B: background [0:black, 1:dim, 2:normal, 3:bright] ) ( - B: background [0:black, 1:dim, 2:normal, 3:bright] )
@update-tint ( -> ) @update-tint ( -> )
.attr LDZ .attr LDZ
DUP #80 LTH ,&ok JCN DUP #80 LTH ?&ok
#80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA #80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA
&ok #40 ORA &ok #40 ORA
.tint STZ JMP2r .tint STZ JMP2r
@ -724,9 +724,9 @@
( cell* = tint^ c^ ) ( cell* = tint^ c^ )
@draw-cell ( cell* -> ) @draw-cell ( cell* -> )
SWP STH ( c^ [tint^] ) SWP STH ( c^ [tint^] )
DUP #80 LTH ,&draw JCN ( c^ [tint^] ) DUP #80 LTH ?&draw ( c^ [tint^] )
#80 SUB ( c-80^ [tint^] ) #80 SUB ( c-80^ [tint^] )
&draw ;load-tile JSR2 ( [tint^] ) &draw load-tile ( [tint^] )
STHr .Screen/sprite DEO ( ) STHr .Screen/sprite DEO ( )
JMP2r ( ) JMP2r ( )
@ -742,15 +742,15 @@
SWP2 STA2 BRK SWP2 STA2 BRK
@read-arg-1 ( default* -> n* ) @read-arg-1 ( default* -> n* )
;args LDA2 ;max JMP2 ;args LDA2 !max
@read-arg-2 ( default* -> n* ) @read-arg-2 ( default* -> n* )
;args INC2 INC2 LDA2 ;max JMP2 ;args INC2 INC2 LDA2 !max
@reset-args ( -> ) @reset-args ( -> )
;args ;args/pos STA2 ;args ;args/pos STA2
#0000 ;args LITr f8 #0000 ;args LITr f8
&loop STA2k INC2 INC2 &loop STA2k INC2 INC2
INCr STHkr ,&loop JCN INCr STHkr ?&loop
POPr POP2 POP2 JMP2r POPr POP2 POP2 JMP2r
@debug-log "debug_term.log 00 @debug-log "debug_term.log 00