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