fix some more papercuts
This commit is contained in:
parent
caf1e4dc02
commit
83e790a9b2
104
term.tal
104
term.tal
|
|
@ -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* )
|
||||
|
|
@ -736,44 +741,53 @@
|
|||
@end-arg ( c^ -> BRK )
|
||||
;on-read .Console/vect DEO2
|
||||
DUP debug-csi
|
||||
DUP LIT "@ EQU ?exec-ich ( insert blank characters )
|
||||
DUP LIT "A EQU ?exec-cuu ( up )
|
||||
DUP LIT "B EQU ?exec-cud ( down )
|
||||
DUP LIT "C EQU ?exec-cuf ( forward )
|
||||
DUP LIT "D EQU ?exec-cub ( back )
|
||||
DUP LIT "E EQU ?exec-cnl ( next 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 "H EQU ?exec-cup ( move cursor )
|
||||
DUP LIT "I EQU ?exec-cht ( forward by tab stops )
|
||||
DUP LIT "J EQU ?exec-ed ( erase screen )
|
||||
DUP LIT "@ EQU ?exec-ich ( insert blank characters )
|
||||
DUP LIT "A EQU ?exec-cuu ( up )
|
||||
DUP LIT "B EQU ?exec-cud ( down )
|
||||
DUP LIT "C EQU ?exec-cuf ( forward )
|
||||
DUP LIT "D EQU ?exec-cub ( back )
|
||||
DUP LIT "E EQU ?exec-cnl ( next 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 "H EQU ?exec-cup ( move cursor )
|
||||
DUP LIT "I EQU ?exec-cht ( forward by tab stops )
|
||||
DUP LIT "J EQU ?exec-ed ( erase screen )
|
||||
DUP LIT "K EQU ?exec-el ( erase line )
|
||||
DUP LIT "L EQU ?exec-il ( insert blank lines )
|
||||
DUP LIT "M EQU ?exec-dl ( delete n lines )
|
||||
DUP LIT "P EQU ?exec-dch ( delete n chars )
|
||||
DUP LIT "S EQU ?exec-su ( scroll up )
|
||||
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 "L EQU ?exec-il ( insert blank lines )
|
||||
DUP LIT "M EQU ?exec-dl ( delete n lines )
|
||||
DUP LIT "P EQU ?exec-dch ( delete n chars )
|
||||
DUP LIT "S EQU ?exec-su ( scroll up )
|
||||
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 )
|
||||
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 ?¬-irm POP2 .irm JMP2r
|
||||
¬-irm DUP2 #0007 NEQ2 ?¬-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* )
|
||||
|
|
|
|||
Loading…
Reference in New Issue