clean up, use insert-cell

This commit is contained in:
~d6 2023-02-11 22:34:06 -05:00
parent 56200a1c59
commit 675af45ff3
1 changed files with 56 additions and 63 deletions

119
term.tal
View File

@ -156,7 +156,7 @@
update-tint update-tint
( set initial modes ) ( set initial modes )
#01 .irm STZ ( insert and move right ) #00 .irm STZ ( insert and move right )
#01 .awm STZ ( wrap at margin ) #01 .awm STZ ( wrap at margin )
#01 .tcem STZ ( show cursor ) #01 .tcem STZ ( show cursor )
#00 .paste STZ ( bracketed paste is off ) #00 .paste STZ ( bracketed paste is off )
@ -179,7 +179,7 @@
#01 .visual-bell STZ #01 .visual-bell STZ
( set to 01 to enable debug log ) ( set to 01 to enable debug log )
#01 .debug STZ #00 .debug STZ
.debug LDZ ?&continue BRK &continue .debug LDZ ?&continue BRK &continue
#99 #010e DEO #99 #010e DEO
@ -416,12 +416,12 @@
STH2r min ( y* xlim=min(xend,x1)* [x0*] ) STH2r min ( y* xlim=min(xend,x1)* [x0*] )
OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] ) OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] )
STH2kr ADD2 #0002 MUL2 ;cells ADD2 ( y* xlim* addr* [x0*] ) STH2kr ADD2 #0002 MUL2 ;cells ADD2 ( y* xlim* addr* [x0*] )
INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] ) INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] )
SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] ) SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] )
&loop ( y* -i* [pos*] ) &loop ( y* -i* [pos*] )
LDAkr STHr copy-char ( y* -i* [pos*] ) LDAkr STHr copy-char ( y* -i* [pos*] )
INC2 INC2r INC2r ORAk ?&loop ( y* -i+1* [pos+2*] ) INC2 INC2r INC2r ORAk ?&loop ( y* -i+1* [pos+2*] )
POP2 POP2r JMP2r ( y* ) POP2 POP2r JMP2r ( y* )
@copy-char ( c^ -> ) @copy-char ( c^ -> )
DUP ?&ok POP #20 ( replace \0 with space ) DUP ?&ok POP #20 ( replace \0 with space )
@ -652,24 +652,24 @@
@end-arg ( c^ -> BRK ) @end-arg ( c^ -> BRK )
;on-read .Console/vect DEO2 ;on-read .Console/vect DEO2
DUP debug-csi DUP debug-csi
DUP LIT "d EQU ?exec-move-row ( move cursor to row ) DUP LIT "d EQU ?exec-move-row ( move cursor to row )
DUP LIT "h EQU ?exec-set-mode ( enable line wrap ) DUP LIT "h EQU ?exec-set-mode ( enable line wrap )
DUP LIT "l EQU ?exec-reset-mode ( disable line wrap ) DUP LIT "l EQU ?exec-reset-mode ( disable line wrap )
DUP LIT "m EQU ?exec-set-attr ( set attr ) DUP LIT "m EQU ?exec-set-attr ( set attr )
DUP LIT "n EQU ?exec-status ( get status ) DUP LIT "n EQU ?exec-status ( get status )
DUP LIT "@ EQU ?exec-insert-blanks ( insert blank characters ) DUP LIT "@ EQU ?exec-insert-blanks ( insert blank characters )
DUP LIT "A EQU ?exec-up ( up ) DUP LIT "A EQU ?exec-up ( up )
DUP LIT "B EQU ?exec-down ( down ) DUP LIT "B EQU ?exec-down ( down )
DUP LIT "C EQU ?exec-forward ( forward ) DUP LIT "C EQU ?exec-forward ( forward )
DUP LIT "D EQU ?exec-back ( back ) DUP LIT "D EQU ?exec-back ( back )
DUP LIT "G EQU ?exec-move-col ( move cursor to col ) DUP LIT "G EQU ?exec-move-col ( move cursor to col )
DUP LIT "H EQU ?exec-move ( move cursor ) DUP LIT "H EQU ?exec-move ( move cursor )
DUP LIT "I EQU ?exec-forward-tabs ( forward by tab stops ) DUP LIT "I EQU ?exec-forward-tabs ( forward by tab stops )
DUP LIT "J EQU ?exec-erase-screen ( erase screen ) DUP LIT "J EQU ?exec-erase-screen ( erase screen )
DUP LIT "K EQU ?exec-erase-line ( erase line ) DUP LIT "K EQU ?exec-erase-line ( erase line )
DUP LIT "L EQU ?exec-insert-lines ( insert blank lines ) DUP LIT "L EQU ?exec-insert-lines ( insert blank lines )
DUP LIT "M EQU ?exec-delete-lines ( delete n lines ) DUP LIT "M EQU ?exec-delete-lines ( delete n lines )
DUP LIT "P EQU ?exec-delete-chars ( delete n chars ) DUP LIT "P EQU ?exec-delete-chars ( delete n chars )
( ` - horizontal position absolute ) ( ` - horizontal position absolute )
( S - scroll up n lines ) ( S - scroll up n lines )
( X - erase n chars ) ( X - erase n chars )
@ -769,34 +769,34 @@
( 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 ( start* end* ) EQU2k ?&skip ( start* end* )
OVR2 SWP2 ( start* start* end* ) OVR2 SWP2 ( start* start* end* )
SUB2 STH2 #0200 SWP2 ( 0200 start* [count*] ) SUB2 STH2 #0200 SWP2 ( 0200 start* [count*] )
&loop ( 0200 addr* [i*] ) &loop ( 0200 addr* [i*] )
STA2k INC2 INC2 INC2r INC2r ( 0200 addr+2* [i+1*] ) STA2k INC2 INC2 INC2r INC2r ( 0200 addr+2* [i+1*] )
ORAkr STHr ?&loop ( 0200 addr+2* [i+2*] ) ORAkr STHr ?&loop ( 0200 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 ( )
&skip POP2 POP2 JMP2r ( ) &skip POP2 POP2 JMP2r ( )
@exec-move-row ( c^ -> BRK ) @exec-move-row ( c^ -> BRK )
POP POP ( )
#0001 read-arg-1 dec-floor ( row ) #0001 read-arg-1 dec-floor ( row )
.cur-x LDZ2 ( col ) .cur-x LDZ2 ( col )
goto BRK goto BRK ( )
@exec-move-col ( c^ -> BRK ) @exec-move-col ( c^ -> BRK )
POP POP ( )
.cur-y LDZ2 ( row ) .cur-y LDZ2 ( row )
#0001 read-arg-1 dec-floor ( col ) #0001 read-arg-1 dec-floor ( col )
goto BRK goto BRK ( )
@exec-move ( c^ -> BRK ) @exec-move ( c^ -> BRK )
POP POP ( )
#0001 read-arg-1 dec-floor ( row ) #0001 read-arg-1 dec-floor ( row )
#0001 read-arg-2 dec-floor ( col ) #0001 read-arg-2 dec-floor ( col )
goto BRK goto BRK ( )
@dec-floor ( x* -> x==0 ? 0* : x-1* ) @dec-floor ( x* -> x==0 ? 0* : x-1* )
ORAk ?&sub JMP2r &sub #0001 SUB2 JMP2r ORAk ?&sub JMP2r &sub #0001 SUB2 JMP2r
@ -848,8 +848,7 @@
.Console/r DEI .Console/r DEI
DUP debug-read DUP debug-read
DUP ?&ok POP BRK DUP ?&ok POP BRK
&ok ( #42 .tint STZ ) &ok !read
!read
@read ( c^ -> BRK ) @read ( c^ -> BRK )
DUP #20 LTH ?read-ctrl DUP #20 LTH ?read-ctrl
@ -901,13 +900,10 @@
.cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
@read-nl ( 0a -> BRK ) @read-nl ( 0a -> BRK )
POP clear-cursor POP clear-cursor at-max-y ?scroll down BRK
at-max-y ?scroll down BRK
@read-printable ( c^ -> BRK ) @read-printable ( c^ -> BRK )
.tint LDZ SWP DUP2 cur-addr STA2 .tint LDZ SWP DUP2 insert-cell draw-cell forward BRK
draw-cell
forward BRK
@goto ( y* x* -> ) @goto ( y* x* -> )
clear-cursor clear-cursor
@ -945,19 +941,16 @@
@down ( -> ) @down ( -> )
#0001 !down-n #0001 !down-n
@insert ( c^ -> )
.attr LDZ SWP !insert-cell
@insert-cell ( cell* -> ) @insert-cell ( cell* -> )
.irm LDZ #00 EQU ?&replace ( cell* ) .irm LDZ #00 EQU ?&replace ( cell* )
eol-addr #0001 SUB2 ( cell* last=eol-1* ) cur-addr ( cell* lim* )
cur-addr ( cell* last* cur* ) eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
&loop ( cell* last* pos* ) &loop ( cell* lim* pos* )
LDA2k OVR2 INC2 STA2 ( cell* last* pos* ; pos+1<-pos ) STH2k #0002 SUB2 LDA2k ( cell* lim* pos-2* cell* [pos*] )
INC2 GTH2k ?&loop ( cell* last pos+1* ) STH2r STA2 LTH2k ?&loop ( cell* lim* pos-2* )
POP2 POP2 ( cell* ) POP2 POP2 ( cell* )
&replace ( cell* ) &replace ( cell* )
cur-addr STA2 JMP2r ( ) cur-addr STA2 JMP2r ( )
@forward-n-tabs ( n* -> ) @forward-n-tabs ( n* -> )
dec-floor #0008 MUL2 ( i=(n-1)8* ) dec-floor #0008 MUL2 ( i=(n-1)8* )
@ -976,7 +969,7 @@
#0002 SUB2 ( bound* pos-2* [i*] ) #0002 SUB2 ( bound* pos-2* [i*] )
GTH2k #00 EQU ?&loop ( 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*] )
@ -997,7 +990,7 @@
STA2k INC2 INC2 INC2r ( 0200 pos+2* [-i+1*] ) STA2k INC2 INC2 INC2r ( 0200 pos+2* [-i+1*] )
ORAkr STHr ?&loop2 ( 0200 pos+2* [-i+1*] ) ORAkr STHr ?&loop2 ( 0200 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* -> )
@ -1010,7 +1003,7 @@
OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x ) OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x )
GTH2k ?&loop ( 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* -> )