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

View File

@ -99,6 +99,8 @@
@cur-wrap $1 ( did cursor just wrap? )
@max-x $2 ( cols-1 )
@max-y $2 ( rows-1 )
@saved-x $2 ( saved x coordinate )
@saved-y $2 ( saved y coordinate )
@col-bytes $2 ( 2*cols )
@debug $1 ( use debug log? )
@lastmouse-x $2 ( last mouse x )
@ -443,6 +445,9 @@
@point-to-coord ( x* y* -> row* col* )
y-point-to-row SWP2 !x-point-to-col
@unset-wrap ( -> )
#00 .cur-wrap STZ JMP2r
@start-selection ( -> )
#01 .is-lit STZ ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
@ -755,25 +760,34 @@
DUP LIT "T EQU ?exec-sd ( scroll down )
DUP LIT "X EQU ?exec-ech ( erase $n characters )
DUP LIT "Z EQU ?exec-cbt ( backward by tab stops )
DUP LIT "` EQU ?exec-hpa ( char pos abs col=$n ) ( TODO )
DUP LIT "a EQU ?exec-hpr ( char pos rel col=$n ) ( TODO )
DUP LIT "d EQU ?exec-vpa ( move cursor to row ) ( vpa )
DUP LIT "e EQU ?exec-vpr ( line pos rel row+=$n ) ( TODO )
DUP LIT "g EQU ?exec-tbc ( TODO )
DUP LIT "h EQU ?exec-sm ( enable line wrap ) ( sm )
DUP LIT "l EQU ?exec-rm ( disable line wrap ) ( rm )
DUP LIT "m EQU ?exec-sgr ( set attr )
DUP LIT "n EQU ?exec-dsr ( get status ) ( dsr )
DUP LIT "` EQU ?exec-hpa ( char pos abs col=$n )
DUP LIT "a EQU ?exec-hpr ( char pos rel col=$n )
DUP LIT "d EQU ?exec-vpa ( move cursor to row )
DUP LIT "e EQU ?exec-vpr ( line pos rel row+=$n )
DUP LIT "g EQU ?exec-tbc ( clear tab stops )
DUP LIT "h EQU ?exec-sm ( set mode )
DUP LIT "l EQU ?exec-rm ( reset mode )
DUP LIT "m EQU ?exec-sgr ( set graphical rendering )
DUP LIT "n EQU ?exec-dsr ( device status reports )
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 )
( = 1 C - bold cursor )
debug-csi BRK
@exec-set-scrolling-region ( c^ -> BRK ) POP BRK
@exec-scorc ( 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^ )
DUP2 #0004 NEQ2 ?&not-irm POP2 .irm JMP2r
&not-irm DUP2 #0007 NEQ2 ?&not-awm POP2 .awm JMP2r
@ -787,15 +801,25 @@
( 39 - default fg )
( 49 - default bg )
@read-attr ( attr* -> )
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
DUP2 #0031 GTH2 ?&skip ( attr* ; skip > 49 )
DUP2 ;sgr-fg ADD2 LDA ( attr* code^ )
DUP #40 EQU ?&reset ( attr* code^ )
DUP #80 EQU ?&invert ( attr* code^ )
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
&done update-tint
&ignored POP2 JMP2r
&reset #02 .attr STZ !&done
&invert .attr LDZ #80 ORA .attr STZ
&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 )
POP
@ -852,7 +876,7 @@
@cud ( n* -> ) clear-cursor !down-n
@cuf ( n* -> ) clear-cursor !forward-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
@vpr ( n* -> ) clear-cursor !down-n
@vpa ( n* -> ) dec-floor .cur-x LDZ2 !goto
@ -1025,7 +1049,7 @@
.cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
@goto ( y* x* -> )
#00 .cur-wrap STZ
unset-wrap
clear-cursor
.max-x LDZ2 min .cur-x 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
@back-n ( n* -> )
unset-wrap
.cur-x LDZ2 SWP2 SUB2 #0000 smax .cur-x STZ2 !draw-cursor
@up-n ( n* -> )
@ -1079,6 +1104,7 @@
ADD2 !forward-n ( )
@cbt ( n* -> )
unset-wrap
clear-cursor
dec-floor #30 SFT2 ( i=(n-1)8* )
.cur-x LDZ2 #0007 AND2 ( i* cur%8* )