fix some more papercuts

This commit is contained in:
~d6 2023-02-19 21:53:54 -05:00
parent caf1e4dc02
commit 83e790a9b2
1 changed files with 65 additions and 39 deletions

104
term.tal
View File

@ -99,6 +99,8 @@
@cur-wrap $1 ( did cursor just wrap? ) @cur-wrap $1 ( did cursor just wrap? )
@max-x $2 ( cols-1 ) @max-x $2 ( cols-1 )
@max-y $2 ( rows-1 ) @max-y $2 ( rows-1 )
@saved-x $2 ( saved x coordinate )
@saved-y $2 ( saved y coordinate )
@col-bytes $2 ( 2*cols ) @col-bytes $2 ( 2*cols )
@debug $1 ( use debug log? ) @debug $1 ( use debug log? )
@lastmouse-x $2 ( last mouse x ) @lastmouse-x $2 ( last mouse x )
@ -443,6 +445,9 @@
@point-to-coord ( x* y* -> row* col* ) @point-to-coord ( x* y* -> row* col* )
y-point-to-row SWP2 !x-point-to-col y-point-to-row SWP2 !x-point-to-col
@unset-wrap ( -> )
#00 .cur-wrap STZ JMP2r
@start-selection ( -> ) @start-selection ( -> )
#01 .is-lit STZ ( ) #01 .is-lit STZ ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* ) .Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
@ -736,44 +741,53 @@
@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 "@ EQU ?exec-ich ( insert blank characters ) DUP LIT "@ EQU ?exec-ich ( insert blank characters )
DUP LIT "A EQU ?exec-cuu ( up ) DUP LIT "A EQU ?exec-cuu ( up )
DUP LIT "B EQU ?exec-cud ( down ) DUP LIT "B EQU ?exec-cud ( down )
DUP LIT "C EQU ?exec-cuf ( forward ) DUP LIT "C EQU ?exec-cuf ( forward )
DUP LIT "D EQU ?exec-cub ( back ) DUP LIT "D EQU ?exec-cub ( back )
DUP LIT "E EQU ?exec-cnl ( next line $n times ) DUP LIT "E EQU ?exec-cnl ( next line $n times )
DUP LIT "F EQU ?exec-cpl ( prev line $n times ) DUP LIT "F EQU ?exec-cpl ( prev line $n times )
DUP LIT "G EQU ?exec-cha ( move cursor to col ) DUP LIT "G EQU ?exec-cha ( move cursor to col )
DUP LIT "H EQU ?exec-cup ( move cursor ) DUP LIT "H EQU ?exec-cup ( move cursor )
DUP LIT "I EQU ?exec-cht ( forward by tab stops ) DUP LIT "I EQU ?exec-cht ( forward by tab stops )
DUP LIT "J EQU ?exec-ed ( erase screen ) DUP LIT "J EQU ?exec-ed ( erase screen )
DUP LIT "K EQU ?exec-el ( erase line ) DUP LIT "K EQU ?exec-el ( erase line )
DUP LIT "L EQU ?exec-il ( insert blank lines ) DUP LIT "L EQU ?exec-il ( insert blank lines )
DUP LIT "M EQU ?exec-dl ( delete n lines ) DUP LIT "M EQU ?exec-dl ( delete n lines )
DUP LIT "P EQU ?exec-dch ( delete n chars ) DUP LIT "P EQU ?exec-dch ( delete n chars )
DUP LIT "S EQU ?exec-su ( scroll up ) DUP LIT "S EQU ?exec-su ( scroll up )
DUP LIT "T EQU ?exec-sd ( scroll down ) DUP LIT "T EQU ?exec-sd ( scroll down )
DUP LIT "X EQU ?exec-ech ( erase $n characters ) DUP LIT "X EQU ?exec-ech ( erase $n characters )
DUP LIT "Z EQU ?exec-cbt ( backward by tab stops ) DUP LIT "Z EQU ?exec-cbt ( backward by tab stops )
DUP LIT "` EQU ?exec-hpa ( char pos abs col=$n ) ( TODO ) DUP LIT "` EQU ?exec-hpa ( char pos abs col=$n )
DUP LIT "a EQU ?exec-hpr ( char pos rel col=$n ) ( TODO ) DUP LIT "a EQU ?exec-hpr ( char pos rel col=$n )
DUP LIT "d EQU ?exec-vpa ( move cursor to row ) ( vpa ) DUP LIT "d EQU ?exec-vpa ( move cursor to row )
DUP LIT "e EQU ?exec-vpr ( line pos rel row+=$n ) ( TODO ) DUP LIT "e EQU ?exec-vpr ( line pos rel row+=$n )
DUP LIT "g EQU ?exec-tbc ( TODO ) DUP LIT "g EQU ?exec-tbc ( clear tab stops )
DUP LIT "h EQU ?exec-sm ( enable line wrap ) ( sm ) DUP LIT "h EQU ?exec-sm ( set mode )
DUP LIT "l EQU ?exec-rm ( disable line wrap ) ( rm ) DUP LIT "l EQU ?exec-rm ( reset mode )
DUP LIT "m EQU ?exec-sgr ( set attr ) DUP LIT "m EQU ?exec-sgr ( set graphical rendering )
DUP LIT "n EQU ?exec-dsr ( get status ) ( dsr ) DUP LIT "n EQU ?exec-dsr ( device status reports )
DUP LIT "r EQU ?exec-set-scrolling-region DUP LIT "r EQU ?exec-set-scrolling-region
DUP LIT "u EQU ?exec-scorc ( TODO ) DUP LIT "s EQU ?exec-scosc ( saved current cursor position )
DUP LIT "u EQU ?exec-scorc ( restore saved cursor position )
( = 0 C - normal cursor ) ( = 0 C - normal cursor )
( = 1 C - bold cursor ) ( = 1 C - bold cursor )
debug-csi BRK debug-csi BRK
@exec-set-scrolling-region ( c^ -> BRK ) POP BRK @exec-set-scrolling-region ( c^ -> BRK ) POP BRK
@exec-scorc ( c^ -> BRK ) POP BRK
@exec-tbc ( c^ -> BRK ) POP BRK @exec-tbc ( c^ -> BRK ) POP BRK
@exec-scosc ( c^ -> BRK )
POP .cur-x LDZ2 .saved-x STZ2 .cur-y LDZ2 .saved-y STZ2 BRK
@exec-scorc ( c^ -> BRK )
POP clear-cursor
.saved-x LDZ2 .cur-x STZ2 .saved-y LDZ2 .cur-y STZ2
draw-cursor BRK
@mode-addr ( n* -> zp^ ) @mode-addr ( n* -> zp^ )
DUP2 #0004 NEQ2 ?&not-irm POP2 .irm JMP2r DUP2 #0004 NEQ2 ?&not-irm POP2 .irm JMP2r
&not-irm DUP2 #0007 NEQ2 ?&not-awm POP2 .awm JMP2r &not-irm DUP2 #0007 NEQ2 ?&not-awm POP2 .awm JMP2r
@ -787,15 +801,25 @@
( 39 - default fg ) ( 39 - default fg )
( 49 - default bg ) ( 49 - default bg )
@read-attr ( attr* -> ) @read-attr ( attr* -> )
DUP2 #0000 NEQ2 ?&!0 #02 .attr STZ !&done ( reset ) DUP2 #0031 GTH2 ?&skip ( attr* ; skip > 49 )
&!0 DUP2 #0001 NEQ2 ?&!1 #03 !&set-fg ( bright ) DUP2 ;sgr-fg ADD2 LDA ( attr* code^ )
&!1 DUP2 #0002 NEQ2 ?&!2 #01 !&set-fg ( dim ) DUP #40 EQU ?&reset ( attr* code^ )
&!2 DUP2 #0007 NEQ2 ?&!7 .attr LDZk #80 ORA SWP STZ !&done ( reverse ) DUP #80 EQU ?&invert ( attr* code^ )
&!7 !&ignored DUP #ff EQU ?&done ( attr* code^ )
ROT ROT #0027 GTH2 ?&bg
.attr LDZ #fc !&update
&bg #20 SFT .attr LDZ #f3
&update AND ORA .attr STZ !update-tint
&set-fg .attr LDZ #fc AND ORA .attr STZ &reset #02 .attr STZ !&done
&done update-tint &invert .attr LDZ #80 ORA .attr STZ
&ignored POP2 JMP2r &done update-tint POP &skip POP2 JMP2r
@sgr-fg ( 0 1 2 3 4 5 6 7 8 9 a b c d e f )
( 00 ) 40 03 01 ff ff ff ff 80 ff ff ff ff ff ff ff ff
( 10 ) ff ff ff ff ff ff ff ff ff ff ff ff ff ff 00 02
( 20 ) 02 02 02 02 02 03 ff 02 00 01 01 01 01 01 01 03
( 30 ) ff 00
@exec-sgr ( c^ -> BRK ) @exec-sgr ( c^ -> BRK )
POP POP
@ -852,7 +876,7 @@
@cud ( n* -> ) clear-cursor !down-n @cud ( n* -> ) clear-cursor !down-n
@cuf ( n* -> ) clear-cursor !forward-n @cuf ( n* -> ) clear-cursor !forward-n
@cuu ( n* -> ) clear-cursor !up-n @cuu ( n* -> ) clear-cursor !up-n
@hpa ( n* -> ) clear-cursor dec-floor .max-x LDZ2 min .cur-x STZ2 !draw-cursor @hpa ( n* -> ) unset-wrap clear-cursor dec-floor .max-x LDZ2 min .cur-x STZ2 !draw-cursor
@hpr ( n* -> ) clear-cursor !forward-n @hpr ( n* -> ) clear-cursor !forward-n
@vpr ( n* -> ) clear-cursor !down-n @vpr ( n* -> ) clear-cursor !down-n
@vpa ( n* -> ) dec-floor .cur-x LDZ2 !goto @vpa ( n* -> ) dec-floor .cur-x LDZ2 !goto
@ -1025,7 +1049,7 @@
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r .cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
@goto ( y* x* -> ) @goto ( y* x* -> )
#00 .cur-wrap STZ unset-wrap
clear-cursor clear-cursor
.max-x LDZ2 min .cur-x STZ2 .max-x LDZ2 min .cur-x STZ2
.max-y LDZ2 min .cur-y STZ2 .max-y LDZ2 min .cur-y STZ2
@ -1035,6 +1059,7 @@
.cur-x LDZ2 ADD2 .max-x LDZ2 min .cur-x STZ2 !draw-cursor .cur-x LDZ2 ADD2 .max-x LDZ2 min .cur-x STZ2 !draw-cursor
@back-n ( n* -> ) @back-n ( n* -> )
unset-wrap
.cur-x LDZ2 SWP2 SUB2 #0000 smax .cur-x STZ2 !draw-cursor .cur-x LDZ2 SWP2 SUB2 #0000 smax .cur-x STZ2 !draw-cursor
@up-n ( n* -> ) @up-n ( n* -> )
@ -1079,6 +1104,7 @@
ADD2 !forward-n ( ) ADD2 !forward-n ( )
@cbt ( n* -> ) @cbt ( n* -> )
unset-wrap
clear-cursor clear-cursor
dec-floor #30 SFT2 ( i=(n-1)8* ) dec-floor #30 SFT2 ( i=(n-1)8* )
.cur-x LDZ2 #0007 AND2 ( i* cur%8* ) .cur-x LDZ2 #0007 AND2 ( i* cur%8* )