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