d6
/
nxu
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

big refactor

This commit is contained in:
~d6 2023-02-19 00:39:48 -05:00
parent 92c443fd85
commit a1e2aa17fd
1 changed files with 171 additions and 183 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

354
term.tal
View File

@ -2,23 +2,21 @@
( TODO: ) ( TODO: )
( 1. fix bugs ) ( 1. fix bugs )
( 2. need to focus on line wrap )
( 3. need to implement scrolling regions ) ( 3. need to implement scrolling regions )
( 4. need to be more rigorous about insert vs replace )
( 5. need draw-line word, and need to use it more ) ( 5. need draw-line word, and need to use it more )
( a. on delete, CSI-P ) ( a. on delete, CSI-P )
( b. on insert ) ( b. on insert )
( c. etc. ) ( c. etc. )
( 6. add more ansi control seqs ) ( 6. add more ansi control seqs )
( 7. add sublabels to ;cp437, e.g. ;cp437/space ) ( 7. add sublabels to ;cp437, e.g. ;cp437/space )
( 8. key repeat - not possible in general though )
( 9. support shift+arrow and alt+arrow ) ( 9. support shift+arrow and alt+arrow )
( 10. crawl has screen-clearing issues ) ( 10. crawl has screen-clearing issues )
( 11. cursor hiding for cmatrix ) ( 11. cursor hiding for cmatrix )
( 12. clean up super ugly selection code ) ( 12. clean up super ugly selection code )
( 13. hide cursor when not moving for awhile ) ( 13. hide cursor when not moving for awhile )
( 14. configure terminal dimensions (config file?) )
( 15. blinking text? ) ( 15. blinking text? )
( 16. status line in femto, etc. is weird )
( 17. determ.terminfo )
( ANSI sequences ) ( ANSI sequences )
( ) ( )
@ -90,6 +88,7 @@
|b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ] |b0 @File2 [ &vect $2 &ok $2 &stat $2 &del $1 &append $1 &name $2 &len $2 &r $2 &w $2 ]
|0000 |0000
( @dummy $10 ( ughhhh ) )
@tint $1 ( draw mode. 01=regular, 04=inverted ) @tint $1 ( draw mode. 01=regular, 04=inverted )
@attr $1 ( 5 bits: RxxxBBFF ) @attr $1 ( 5 bits: RxxxBBFF )
@dirty $1 ( screen needs redraw? ) @dirty $1 ( screen needs redraw? )
@ -116,6 +115,7 @@
@pointer-ttl $1 ( visible cursor timer ) @pointer-ttl $1 ( visible cursor timer )
( terminal settings ) ( terminal settings )
@ignored $1 ( ignored )
@irm $1 ( 01: insert and move right, 00: replace and overwrite ) @irm $1 ( 01: insert and move right, 00: replace and overwrite )
@awm $1 ( 01: wrap chars at margin, 00: overwrite at margin ) @awm $1 ( 01: wrap chars at margin, 00: overwrite at margin )
@tcem $1 ( 01: cursor is visible, 00: cursor is invisible ) @tcem $1 ( 01: cursor is visible, 00: cursor is invisible )
@ -160,7 +160,7 @@
reset-terminal reset-terminal
( set to 01 to enable debug log ) ( set to 01 to enable debug log )
#00 .debug STZ #01 .debug STZ
.debug LDZ ?&continue BRK &continue .debug LDZ ?&continue BRK &continue
#99 #010e DEO #99 #010e DEO
@ -189,8 +189,8 @@
#01 .tcem STZ ( show cursor ) #01 .tcem STZ ( show cursor )
#00 .paste STZ ( bracketed paste is off ) #00 .paste STZ ( bracketed paste is off )
( clear screen for initial draw ) ( prepare for initial draw )
clear-screen init-screen
( user defaults ) ( user defaults )
#01 .visual-bell STZ #01 .visual-bell STZ
@ -250,19 +250,24 @@
@max ( x* y* -> max* ) @max ( x* y* -> max* )
LTH2k JMP SWP2 NIP2 JMP2r LTH2k JMP SWP2 NIP2 JMP2r
@clear-screen ( signed max )
#01 .dirty STZ ( #8000 < #8001 < ... < #ffff < #0000 < #0001 < ... < #7fff )
LIT2r =cells ( [addr*] ) @smax ( x* y* -> min* )
#0000 &yloop ( y* [addr*] y* ) EOR2k POP #80 AND ?min !max
#0000 &xloop ( y* x* [addr*] )
#0200 STH2kr STA2 ( y* x* [addr*] ) ( initialize screen cells and prepare for first draw )
INC2r INC2r ( y* x* [addr+2*] ) @init-screen ( -> )
INC2 DUP2 .cols LDZ2 ( y* x+1* x+1* cols* [addr+2*] ) first-addr limit-addr #0200 !init
LTH2 ?&xloop ( y* x+1* [addr+2*] )
POP2 ( y* [addr*] ) @init ( start* limit* cell* -> )
INC2 DUP2 .rows LDZ2 ( y+1* y+1* rows* [addr*] ) STH2 EQU2k ?&skip ( start* limit* [cell*] )
LTH2 ?&yloop ( y+1* [addr*] ) #01 .dirty STZ OVR2 ( start* limit* start* [cell*] )
POP2 POP2r JMP2r ( ) #01 SFT2 SWP2 #01 SFT2 SUB2 ( start* -count* [cell*] )
STH2 SWP2r STH2r SWP2 ( cell* start* [-count*] )
&loop ( cell* addr* [-i*] )
STA2k INC2 INC2 INC2r ( cell* addr+2* [-i+1*] )
ORAkr STHr ?&loop ( cell* addr+2* [-i+1*] )
&skip POP2 POP2 POP2r JMP2r ( )
( uses the existing .Screen/x and .Screen/y ) ( uses the existing .Screen/x and .Screen/y )
( returns them to their starting values when finished ) ( returns them to their starting values when finished )
@ -656,6 +661,7 @@
DUP #07 ( bell ) EQU ?&end-osc DUP #07 ( bell ) EQU ?&end-osc
#9c ( esc-\ ) EQU ?&end-osc BRK #9c ( esc-\ ) EQU ?&end-osc BRK
&end-osc ;on-read .Console/vect DEO2 BRK &end-osc ;on-read .Console/vect DEO2 BRK
( TODO: support 7-bit 1b 5c sequence? )
@debug-arg ( n* -> ) @debug-arg ( n* -> )
&short SWP debug-arg/byte &short SWP debug-arg/byte
@ -731,48 +737,51 @@
@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 "@ EQU ?exec-ich ( insert blank characters )
DUP LIT "h EQU ?exec-set-mode ( enable line wrap ) DUP LIT "A EQU ?exec-cuu ( up )
DUP LIT "l EQU ?exec-reset-mode ( disable line wrap ) DUP LIT "B EQU ?exec-cud ( down )
DUP LIT "m EQU ?exec-set-attr ( set attr ) DUP LIT "C EQU ?exec-cuf ( forward )
DUP LIT "n EQU ?exec-status ( get status ) DUP LIT "D EQU ?exec-cub ( back )
DUP LIT "@ EQU ?exec-insert-blanks ( insert blank characters ) DUP LIT "E EQU ?exec-cnl ( next line $n times )
DUP LIT "A EQU ?exec-up ( up ) DUP LIT "F EQU ?exec-cpl ( prev line $n times )
DUP LIT "B EQU ?exec-down ( down ) DUP LIT "G EQU ?exec-cha ( move cursor to col )
DUP LIT "C EQU ?exec-forward ( forward ) DUP LIT "H EQU ?exec-cup ( move cursor )
DUP LIT "D EQU ?exec-back ( back ) DUP LIT "I EQU ?exec-cht ( forward by tab stops )
DUP LIT "G EQU ?exec-move-col ( move cursor to col ) DUP LIT "J EQU ?exec-ed ( erase screen )
DUP LIT "H EQU ?exec-move ( move cursor ) DUP LIT "K EQU ?exec-el ( erase line )
DUP LIT "I EQU ?exec-forward-tabs ( forward by tab stops ) DUP LIT "L EQU ?exec-il ( insert blank lines )
DUP LIT "J EQU ?exec-erase-screen ( erase screen ) DUP LIT "M EQU ?exec-dl ( delete n lines )
DUP LIT "K EQU ?exec-erase-line ( erase line ) DUP LIT "P EQU ?exec-dch ( delete n chars )
DUP LIT "L EQU ?exec-insert-lines ( insert blank lines ) DUP LIT "S EQU ?exec-su ( scroll up )
DUP LIT "M EQU ?exec-delete-lines ( delete n lines ) DUP LIT "T EQU ?exec-sd ( scroll down )
DUP LIT "P EQU ?exec-delete-chars ( delete n chars ) DUP LIT "X EQU ?exec-ech ( erase $n characters )
DUP LIT "Z EQU ?exec-back-tabs ( backward by tab stops ) DUP LIT "Z EQU ?exec-cbt ( backward by tab stops )
( ` - horizontal position absolute ) DUP LIT "` EQU ?exec-hpa ( char pos abs col=$n ) ( TODO )
( S - scroll up n lines ) DUP LIT "a EQU ?exec-hpr ( char pos rel col=$n ) ( TODO )
( X - erase n chars ) DUP LIT "d EQU ?exec-vpa ( move cursor to row ) ( vpa )
( Z - backward n tab stops ) 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 "r EQU ?exec-set-scrolling-region
DUP LIT "u EQU ?exec-scorc ( TODO )
( = 0 C - normal cursor ) ( = 0 C - normal cursor )
( = 1 C - bold cursor ) ( = 1 C - bold cursor )
debug-csi BRK debug-csi BRK
( set mode ) @exec-set-scrolling-region ( c^ -> BRK ) POP BRK
( TODO: insert/replace, line wrap, etc. ) @exec-scorc ( c^ -> BRK ) POP BRK
@exec-set-mode ( c^ -> BRK ) @exec-tbc ( c^ -> BRK ) POP BRK
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^ -> BRK ) @mode-addr ( n* -> zp^ )
POP #0001 read-arg-1 DUP2 #0004 NEQ2 ?&not-irm POP2 .irm JMP2r
DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&reset &not-irm DUP2 #0007 NEQ2 ?&not-awm POP2 .awm JMP2r
&!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&reset &not-awm POP2 .ignored JMP2r
&!awm POP2 BRK
&reset #00 SWP STZ BRK @sm ( n* -> ) mode-addr #01 SWP STZ JMP2r
@rm ( n* -> ) mode-addr #00 SWP STZ JMP2r
@read-attr ( attr* -> ) @read-attr ( attr* -> )
DUP2 #0000 NEQ2 ?&!0 #02 .attr STZ !&done ( reset ) DUP2 #0000 NEQ2 ?&!0 #02 .attr STZ !&done ( reset )
@ -785,7 +794,7 @@
&done update-tint &done update-tint
&ignored POP2 JMP2r &ignored POP2 JMP2r
@exec-set-attr ( c^ -> BRK ) @exec-sgr ( c^ -> BRK )
POP POP
;args/pos LDA2 ;args ;args/pos LDA2 ;args
&loop &loop
@ -795,11 +804,37 @@
&done &done
POP2 POP2 BRK POP2 POP2 BRK
@exec1 ( addr* -> BRK ) @exec0 ( addr* -> BRK ) STH2 #0000 read-arg-1 STH2r JSR2 BRK
STH2 #0001 read-arg-1 STH2r JSR2 BRK @exec1 ( addr* -> BRK ) STH2 #0001 read-arg-1 STH2r JSR2 BRK
@exec-status ( c^ -> BRK ) @exec-cuu POP ;cuu !exec1
POP #0000 read-arg-1 #0006 NEQ2 ,&done @exec-cud POP ;cud !exec1
@exec-cuf POP ;cuf !exec1
@exec-cub POP ;cub !exec1
@exec-ich POP ;ich !exec1
@exec-dl POP ;dl !exec1
@exec-dch POP ;dch !exec1
@exec-il POP ;il !exec1
@exec-cht POP ;cht !exec1
@exec-cbt POP ;cbt !exec1
@exec-cnl POP ;cnl !exec1
@exec-cpl POP ;cpl !exec1
@exec-su POP ;su !exec1
@exec-ech POP ;ech !exec1
@exec-hpa POP ;hpa !exec1
@exec-hpr POP ;hpr !exec1
@exec-vpr POP ;vpr !exec1
@exec-sd POP BRK ( TODO )
@exec-vpa POP ;vpa !exec1
@exec-cha POP ;cha !exec1
@exec-el POP ;el !exec0
@exec-ed POP ;ed_ !exec0
@exec-sm POP ;sm !exec1
@exec-rm POP ;rm !exec1
@exec-dsr POP ;dsr !exec1
@dsr ( n* -> )
#0006 NEQ2 ?&done
#1b .Console/w DEO #1b .Console/w DEO
LIT "[ .Console/w DEO LIT "[ .Console/w DEO
.cur-y LDZ2 INC2 emit-dec2 .cur-y LDZ2 INC2 emit-dec2
@ -808,69 +843,53 @@
LIT "R .Console/w DEO LIT "R .Console/w DEO
&done BRK &done BRK
@exec-up POP ;up-n !exec1 @cnl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !down-n
@exec-down POP ;down-n !exec1 @cpl ( n* -> ) clear-cursor #0000 .cur-x STZ2 !up-n
@exec-forward POP ;forward-n !exec1 @cub ( n* -> ) clear-cursor !back-n
@exec-back POP ;back-n !exec1 @cud ( n* -> ) clear-cursor !down-n
@exec-insert-blanks POP ;insert-n-spaces !exec1 @cuf ( n* -> ) clear-cursor !forward-n
@exec-delete-lines POP ;delete-n-lines !exec1 @cuu ( n* -> ) clear-cursor !up-n
@exec-delete-chars POP ;delete-n-chars !exec1 @hpa ( n* -> ) clear-cursor dec-floor .max-x LDZ2 min .cur-x STZ2 !draw-cursor
@exec-insert-lines POP ;insert-n-lines !exec1 @hpr ( n* -> ) clear-cursor !forward-n
@exec-forward-tabs POP ;forward-n-tabs !exec1 @vpr ( n* -> ) clear-cursor !down-n
@exec-back-tabs POP ;back-n-tabs !exec1 @vpa ( n* -> ) dec-floor .cur-x LDZ2 !goto
@cha ( n* -> ) dec-floor .cur-y LDZ2 SWP !goto
@exec-erase-line ( c^ -> BRK ) @su ( n* -> )
POP #0000 read-arg-1 #0000 SWP2 SUB2 STH2 clear-cursor ( [-count*] )
&loop scroll INC2r ORAkr STHr ?&loop ( [-i+1*] )
POP2r JMP2r ( )
@ech ( n* -> )
#0000 SWP2 SUB2 STH2 ( [-count*] )
#0200 cur-addr ( 0200 addr* [-count*] )
&loop ( 0200 pos* [-i*] )
STA2k INC2 INC2 ( 0200 pos+2* [-i*] ; pos<-0200 )
INC2r ORAkr STHr ?&loop ( pos+2* [-i+1*] )
POP2 POP2 POP2r ( )
#01 .dirty STZ JMP2r ( )
@el ( n* -> )
DUP2 #0000 EQU2 ?&erase-to-end DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ?&erase-from-start DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ?&erase-full DUP2 #0002 EQU2 ?&erase-full
POP2 BRK POP2 JMP2r
&erase-full &erase-full POP2 bol-addr eol-addr !erase
POP2 bol-addr eol-addr erase BRK &erase-to-end POP2 cur-addr eol-addr !erase
&erase-to-end &erase-from-start POP2 bol-addr cur-addr !erase
POP2 cur-addr eol-addr erase BRK
&erase-from-start
POP2 bol-addr cur-addr erase BRK
@exec-erase-screen ( c^ -> BRK ) @ed_ ( n* -> )
POP #0000 read-arg-1
DUP2 #0000 EQU2 ?&erase-to-end DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ?&erase-from-start DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ?&erase-full DUP2 #0002 EQU2 ?&erase-full
POP2 BRK POP2 JMP2r
&erase-full &erase-full POP2 first-addr limit-addr !erase
POP2 first-addr limit-addr erase BRK &erase-to-end POP2 bol-addr limit-addr !erase
&erase-to-end &erase-from-start POP2 first-addr eol-addr !erase
POP2 bol-addr limit-addr erase BRK
&erase-from-start
POP2 first-addr eol-addr erase BRK
( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords ) @erase ( start* end* -> ) #0200 !init
@erase ( start* end* -> )
EQU2k ?&skip ( start* end* )
OVR2 SWP2 ( start* start* end* )
SUB2 STH2 #0200 SWP2 ( 0200 start* [count*] )
&loop ( 0200 addr* [i*] )
STA2k INC2 INC2 INC2r INC2r ( 0200 addr+2* [i+1*] )
ORAkr STHr ?&loop ( 0200 addr+2* [i+2*] )
POP2r POP2 POP2 ( )
#01 .dirty STZ ( ; FIXME just redraw affected tiles )
JMP2r ( )
&skip POP2 POP2 JMP2r ( )
@exec-move-row ( c^ -> BRK ) @exec-cup ( c^ -> BRK )
POP ( )
#0001 read-arg-1 dec-floor ( row )
.cur-x LDZ2 ( col )
goto BRK ( )
@exec-move-col ( c^ -> BRK )
POP ( )
.cur-y LDZ2 ( row )
#0001 read-arg-1 dec-floor ( col )
goto 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 )
@ -911,12 +930,11 @@
!on-read !on-read
&skip POP ;on-read .Console/vect DEO2 BRK &skip POP ;on-read .Console/vect DEO2 BRK
@exec-ind ( c^ -> ) POP down BRK @exec-ind ( c^ -> ) POP clear-cursor down-or-scroll BRK
@exec-nel ( c^ -> ) POP cr BRK @exec-nel ( c^ -> ) POP cr BRK
@exec-hts ( c^ -> ) POP BRK @exec-hts ( c^ -> ) POP BRK ( TODO )
@exec-ri ( c^ -> ) POP up BRK @exec-ri ( c^ -> ) POP clear-cursor #0001 up-n BRK
@exec-dcs ( c^ -> ) POP BRK @exec-dcs ( c^ -> ) POP BRK ( TODO )
@exec-st ( c^ -> ) POP BRK
@exec-ris ( c^ -> ) @exec-ris ( c^ -> )
POP first-addr limit-addr erase POP first-addr limit-addr erase
@ -950,6 +968,7 @@
( TODO: all cursor movement should potentially set/unset this flag ) ( TODO: all cursor movement should potentially set/unset this flag )
( so this should move into forward and everything else ) ( so this should move into forward and everything else )
.cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ .cur-x LDZ2 .max-x LDZ2 EQU2 .cur-wrap STZ
clear-cursor
forward forward
BRK BRK
@ -957,9 +976,9 @@
DUP #07 EQU ?read-bel DUP #07 EQU ?read-bel
DUP #08 EQU ?read-bs DUP #08 EQU ?read-bs
DUP #09 EQU ?read-tab DUP #09 EQU ?read-tab
DUP #0a EQU ?read-nl DUP #0a EQU ?read-lf
DUP #0b EQU ?read-nl DUP #0b EQU ?read-lf
DUP #0c EQU ?read-nl DUP #0c EQU ?read-lf
DUP #0d EQU ?read-cr DUP #0d EQU ?read-cr
DUP #1b EQU ?read-esc DUP #1b EQU ?read-esc
POP BRK POP BRK
@ -970,11 +989,7 @@
&done BRK &done BRK
@read-bs ( 08 -> BRK ) @read-bs ( 08 -> BRK )
POP POP clear-cursor #0001 back-n BRK
clear-cursor
#0001 back-n
draw-cursor
BRK
@read-esc ( 1b -> BRK ) @read-esc ( 1b -> BRK )
POP ;on-read-esc .Console/vect DEO2 BRK POP ;on-read-esc .Console/vect DEO2 BRK
@ -990,6 +1005,7 @@
.tint LDZ #20 DUP2 ( i^ cell* cell* ) .tint LDZ #20 DUP2 ( i^ cell* cell* )
cur-addr STA2 ( i^ cell* ; addr<-cell ) cur-addr STA2 ( i^ cell* ; addr<-cell )
draw-cell ( i^ ) draw-cell ( i^ )
clear-cursor
forward ( i^ ) forward ( i^ )
INC DUP ?&loop ( i+1^ ) INC DUP ?&loop ( i+1^ )
POP BRK ( ) POP BRK ( )
@ -998,19 +1014,16 @@
clear-cursor #0000 .cur-x STZ2 !draw-cursor clear-cursor #0000 .cur-x STZ2 !draw-cursor
@read-cr ( 0d -> BRK ) @read-cr ( 0d -> BRK )
POP .cur-wrap LDZ ?&skip POP .cur-wrap LDZ ?&skip cr &skip BRK
( clear-cursor #0000 .cur-x STZ2 draw-cursor ) cr
&skip BRK
@at-max-y ( -> true? ) @at-max-y ( -> true? )
.cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r .cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
@read-nl ( 0a -> BRK ) @read-lf ( 0a -> BRK )
POP .cur-wrap LDZ ?&skip POP lf BRK
clear-cursor at-max-y ?&scrolling
down BRK @lf ( -> )
&scrolling scroll .cur-wrap LDZ ?&skip clear-cursor down-or-scroll &skip JMP2r
&skip BRK
@goto ( y* x* -> ) @goto ( y* x* -> )
clear-cursor clear-cursor
@ -1019,36 +1032,22 @@
!draw-cursor !draw-cursor
@forward-n ( n* -> ) @forward-n ( n* -> )
clear-cursor .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
@forward ( -> )
#0001 !forward-n
@back-n ( n* -> ) @back-n ( n* -> )
clear-cursor .cur-x LDZ2 SWP2 SUB2 #0000 smax .cur-x STZ2 !draw-cursor
.cur-x LDZ2 GTH2k ?&zero
SWP2 SUB2 !&done
&zero POP2 POP2 #0000
&done .cur-x STZ2 !draw-cursor
@up-n ( n* -> ) @up-n ( n* -> )
clear-cursor .cur-y LDZ2 SWP2 SUB2 #0000 smax .cur-y STZ2 !draw-cursor
.cur-y LDZ2 GTH2k ?&zero
SWP2 SUB2 !&done
&zero POP2 POP2 #0000
&done .cur-y STZ2 !draw-cursor
@up ( -> ) #0001 !up-n
@down-n ( n* -> ) @down-n ( n* -> )
clear-cursor .cur-y LDZ2 ADD2 .max-y LDZ2 min .cur-y STZ2 !draw-cursor
.cur-y LDZ2 ADD2 .max-y LDZ2 min .cur-y STZ2
!draw-cursor
@forward ( -> ) #0001 !forward-n
@down ( -> ) #0001 !down-n @down ( -> ) #0001 !down-n
@down-or-scroll ( -> ) at-max-y ?&s !down &s !scroll
@maybe-autowrap ( -> ) @maybe-autowrap ( -> )
.cur-wrap LDZ #00 EQU ?&skip .cur-wrap LDZ #00 EQU ?&skip
#00 .cur-wrap STZ #00 .cur-wrap STZ
@ -1073,17 +1072,19 @@
&replace ( cell* ) &replace ( cell* )
cur-addr STA2 JMP2r ( ) cur-addr STA2 JMP2r ( )
@forward-n-tabs ( n* -> ) @cht ( n* -> )
clear-cursor
dec-floor #30 SFT2 ( i=(n-1)8* ) dec-floor #30 SFT2 ( i=(n-1)8* )
#0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* ) #0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* )
ADD2 !forward-n ( ) ADD2 !forward-n ( )
@back-n-tabs ( n* -> ) @cbt ( n* -> )
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* )
ADD2 !back-n ( ) ADD2 !back-n ( )
@insert-n-lines ( n* -> ) @il ( n* -> )
.col-bytes LDZ2 MUL2 STH2 ( [i*] ) .col-bytes LDZ2 MUL2 STH2 ( [i*] )
bol-addr ( bound* [i*] ) bol-addr ( bound* [i*] )
limit-addr STH2kr ( bound* limit* i* [i*] ) limit-addr STH2kr ( bound* limit* i* [i*] )
@ -1097,7 +1098,7 @@
POP2 POP2 POP2r ( ) POP2 POP2 POP2r ( )
#01 .dirty STZ JMP2r ( ) #01 .dirty STZ JMP2r ( )
@insert-n-spaces ( n* -> ) @ich ( n* -> )
STH2 ( [n*] ) STH2 ( [n*] )
eol-addr #0001 SUB2 ( last* [n*] ) eol-addr #0001 SUB2 ( last* [n*] )
STH2kr DUP2 ADD2 SUB2 ( start=last-2n* [n*] ) STH2kr DUP2 ADD2 SUB2 ( start=last-2n* [n*] )
@ -1117,7 +1118,7 @@
#01 .dirty STZ JMP2r ( ) #01 .dirty STZ JMP2r ( )
( starts with cursor pos ) ( starts with cursor pos )
@delete-n-chars ( n* -> ) @dch ( n* -> )
DUP2 ADD2 STH2 ( [i=2n*] ) DUP2 ADD2 STH2 ( [i=2n*] )
eol-addr STH2kr SUB2 ( limit=eol-i* [i*] ) eol-addr STH2kr SUB2 ( limit=eol-i* [i*] )
cur-addr ( limit* start* [i*] ) cur-addr ( limit* start* [i*] )
@ -1130,11 +1131,11 @@
#01 .dirty STZ JMP2r ( ) #01 .dirty STZ JMP2r ( )
( starts below current line ) ( starts below current line )
@delete-n-lines ( n* -> ) @dl ( n* -> )
.col-bytes LDZ2 MUL2 STH2 ( [n*] ) .col-bytes LDZ2 MUL2 STH2 ( [n*] )
limit-addr STH2kr SUB2 ( limit* [n*] ) limit-addr STH2kr SUB2 ( limit* [n*] )
eol-addr ( limit* start* [n*] ) eol-addr ( limit* start* [n*] )
!delete-n-chars/loop !dch/loop
@scroll ( -> ) @scroll ( -> )
limit-addr STH2 ( [lim*] ) limit-addr STH2 ( [lim*] )
@ -1143,9 +1144,9 @@
STH2kr LDA2 #0200 STH2kr STA2 ( cell* [lim* pos* cell*] ; pos<-0200 ) STH2kr LDA2 #0200 STH2kr STA2 ( cell* [lim* pos* cell*] ; pos<-0200 )
STH2kr .col-bytes LDZ2 SUB2 STA2 ( [lim* pos*] ; pos-cb<-cell ) STH2kr .col-bytes LDZ2 SUB2 STA2 ( [lim* pos*] ; pos-cb<-cell )
INC2r INC2r GTH2kr STHr ?&loop ( [lim* pos+2*] ) INC2r INC2r GTH2kr STHr ?&loop ( [lim* pos+2*] )
POP2r POP2r POP2r POP2r ( )
#01 .dirty STZ #01 .dirty STZ ( )
!draw-cursor !draw-cursor ( )
( bits: Rx xx FF BB ) ( bits: Rx xx FF BB )
( - R: reversed [0=normal, 1=reversed] ) ( - R: reversed [0=normal, 1=reversed] )
@ -1181,17 +1182,6 @@
.Screen/y DEI2k #0004 SUB2 ROT DEO2 ( ) .Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
JMP2r ( ) JMP2r ( )
@erase-cell ( cell* -> )
NIP LITr 40 ( c^ [tint^] )
#00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] )
.Screen/addr DEO2k ( addr* s^ [tint^] )
STHkr .Screen/sprite DEO ( addr* s^ [tint^] )
.Screen/y DEI2k #0004 ADD2 ROT DEO2 ( addr* s^ [tint^] )
STH #0004 ADD2 STHr DEO2 ( [tint^] )
STHr .Screen/sprite DEO ( )
.Screen/y DEI2k #0004 SUB2 ROT DEO2 ( )
JMP2r ( )
@highlight-cell ( cell* -> ) @highlight-cell ( cell* -> )
NIP LITr 47 ( c^ [tint^] ) NIP LITr 47 ( c^ [tint^] )
#00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] ) #00 SWP #40 SFT2 ;cp437 ADD2 ( addr* [tint^] )
@ -1214,10 +1204,8 @@
#000a MUL2 STH2r ADD2 ( addr* value*10+digit ) #000a MUL2 STH2r ADD2 ( addr* value*10+digit )
SWP2 STA2 BRK SWP2 STA2 BRK
@read-arg-1 ( default* -> n* ) @read-arg-1 ( default* -> n* ) ;args LDA2 !max
;args LDA2 !max @read-arg-2 ( default* -> n* ) ;args INC2 INC2 LDA2 !max
@read-arg-2 ( default* -> n* )
;args INC2 INC2 LDA2 !max
@reset-args ( -> ) @reset-args ( -> )
;args ;args/pos STA2 ;args ;args/pos STA2