nxu/term.tal

1184 lines
38 KiB
Tal
Raw Normal View History

2023-02-03 23:13:44 -05:00
( term.tal )
2023-01-23 23:16:46 -05:00
( TODO: )
2023-02-03 23:13:44 -05:00
( 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 )
2023-01-25 23:37:56 -05:00
( 5. need draw-line word, and need to use it more )
( a. on delete, CSI-P )
( b. on insert )
2023-02-03 23:13:44 -05:00
( c. etc. )
( 6. add more ansi control seqs )
2023-02-13 23:23:26 -05:00
( 7. add sublabels to ;cp437, e.g. ;cp437/space )
2023-02-04 18:16:29 -05:00
( 8. key repeat - not possible in general though )
2023-02-05 17:05:56 -05:00
( 9. support shift+arrow and alt+arrow )
2023-02-10 20:40:41 -05:00
( 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? )
2023-01-23 23:16:46 -05:00
2023-01-22 21:07:10 -05:00
( ANSI sequences )
( )
2023-01-30 14:25:03 -05:00
( set attributes: ESC [ x ; ... m -> 0:reset 1:bright 2:dim 7:reverse )
( get cursor position: ESC [ 6 n -> ESC [ $row ; $col R )
( set insert: ESC [ 4 h )
( set replace (def): ESC [ 4 l )
( enable line wrap: ESC [ 7 h )
( disable line wrap: ESC [ 7 l )
2023-01-22 21:07:10 -05:00
( )
2023-01-30 14:25:03 -05:00
( move cursor home: ESC [ H )
( move cursor: ESC [ $row ; $col H )
( move to column: ESC [ $n G )
( move to row: ESC [ $n d )
( move up: ESC [ $n A )
( move down: ESC [ $n B )
( move forward: ESC [ $n C )
( move back: ESC [ $n D )
( move forward n tabs ESC [ $n I )
2023-01-22 21:07:10 -05:00
( )
( erase from cursor to end of line: ESC [ K )
( erase from start of line to cursor: ESC [ 1 K )
( erase line: ESC [ 2 K )
( erase from current line to bottom: ESC [ J )
( erase from current line to top: ESC [ 1 J )
( erase screen: ESC [ 2 J )
2023-01-23 21:00:00 -05:00
( )
2023-01-30 10:59:52 -05:00
( insert lines: ESC [ $n L )
( delete n characters: ESC [ $n P )
( insert n blank characters: ESC [ $n @ )
2023-01-24 11:59:01 -05:00
( )
2023-01-30 10:59:52 -05:00
( show cursor: ESC [ ? 25 h )
( hide cursor: ESC [ ? 25 l )
2023-02-02 17:31:24 -05:00
( set bracketed paste mode: ESC [ ? 2004 h )
( unset bracketed paste mode: ESC [ ? 2004 l )
2023-01-30 14:25:03 -05:00
( )
2023-02-02 17:31:24 -05:00
( SEMI-SUPPORTED )
2023-02-02 16:32:01 -05:00
( select G0 charset ($c) ESC lpar $c )
( save cursor ESC 7 )
2023-02-02 17:31:24 -05:00
( restore cursor ESC 8 )
( )
( NOT SUPPORTED YET: )
2023-01-30 10:59:52 -05:00
( end alt charset ESC [ 10 m )
( end alt charset ESC [ 11 m )
2023-01-22 21:07:10 -05:00
2023-02-03 10:36:16 -05:00
( ESC [ $top $bot r -> set scrolling region [$top;$bot] )
( ESC [ 7 h/l -> set/unset auto-wrap mode )
( ESC [ 1 h/l -> set/unset application cursor keys [up: CSI A vs SS3 A] )
( ESC = -> application keypad [use SS3 sequences] )
( ESC M -> set ANSI conformance level 2 )
( ESC > -> normal keypad [normal sequences] )
( ESC [ ? 1000 h/l -> send mouse X & Y on button press and release (X11 xterm mouse protocol) )
( ESC [ ? 1002 h/l -> use cell motion mouse tracking, xterm )
( ESC [ ? 1006 h/l -> SGR mouse mode, xterm )
( ESC [ ? 1005 h/l -> UTF-8 mouse mode, xterm )
( ESC [ ? 1015 h/l -> urxvt Mouse mode )
( ESC [ ? 1051 l -> unset sun function key mode )
( ESC [ ? 1052 l -> unset hp function key mode )
( ESC [ ? 1060 l -> unset legacy keyboard emulation )
( ESC [ ? 1061 h -> set VT220 keyboard emulation )
2023-02-02 16:32:01 -05:00
2023-01-30 23:01:34 -05:00
|00 @System [ &vect $2 &expansion $2 &title $2 &metadata $2 &r $2 &g $2 &b $2 ]
2023-02-05 17:05:56 -05:00
|10 @Console [ &vect $2 &r $1 &exec $2 &mode $1 &dead $1 &exit $1 &w $1 ]
2023-01-31 15:37:14 -05:00
|20 @Screen [ &vect $2 &w $2 &h $2 &auto $1 &pad $1 &x $2 &y $2 &addr $2 &px $1 &sprite $1 ]
2023-01-23 20:22:59 -05:00
|80 @Controller [ &vect $2 &button $1 &key $1 &fn $1 ]
2023-01-31 15:37:14 -05:00
|90 @Mouse [ &vect $2 &x $2 &y $2 &state $1 &pad $3 &scrollx $2 &scrolly $2 ]
|a0 @File1 [ &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 ]
2022-11-06 21:49:02 -05:00
|0000
2023-02-03 23:13:44 -05:00
@tint $1 ( draw mode. 01=regular, 04=inverted )
@attr $1 ( 5 bits: RxxxBBFF )
2023-02-09 20:56:08 -05:00
@dirty $1 ( screen needs redraw? )
2023-02-03 23:13:44 -05:00
@lastkey $1 ( last button press )
@rows $2 ( height in characters )
@cols $2 ( width in characters )
@cur-x $2 ( cursor x: 0 <= cur-x < cols )
@cur-y $2 ( cursor y: 0 <= cur-y < rows )
@max-x $2 ( cols-1 )
@max-y $2 ( rows-1 )
@col-bytes $2 ( 2*cols )
@debug $1 ( use debug log? )
@lastmouse-x $2 ( last mouse x )
@lastmouse-y $2 ( last mouse y )
@lastmouse-st $1 ( last mouse press )
@is-lit $1 ( are we selecting an area? )
@is-lit-flip $1 ( is the selection flipped? i.e. drawing left/up )
@lit-click-x $2 ( x coord of starting selection click )
@lit-click-y $2 ( y coord of starting selection click )
@lit-drag-x $2 ( x coord of selection drag )
@lit-drag-y $2 ( y coord of selection drag )
@flash $1 ( visual bell flash timer )
@pointer-ttl $1 ( visible cursor timer )
2022-11-06 21:49:02 -05:00
2023-01-28 10:40:47 -05:00
( terminal settings )
2023-02-03 23:13:44 -05:00
@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 )
@paste $1 ( 01: bracketed paste is on, 00: is off )
2023-01-30 14:25:03 -05:00
2023-02-10 21:12:29 -05:00
( user configuration )
@visual-bell $1
2022-11-06 21:49:02 -05:00
|0100
2023-01-30 23:01:34 -05:00
( metadata )
;meta .System/metadata DEO2
;meta/name .System/title DEO2
2023-02-03 23:13:44 -05:00
( 80 cols x 24 rows + 1 col for padding )
#0018 .rows STZ2
#0051 .cols STZ2
2023-01-22 21:07:10 -05:00
( set initial cursor )
#0000 .cur-x STZ2
#0000 .cur-y STZ2
2023-01-28 10:40:47 -05:00
2023-02-03 23:58:45 -05:00
( start cursor at origin - including border )
#0008 ( border ) DUP2 .Screen/x DEO2 .Screen/y DEO2
2023-01-23 20:22:59 -05:00
( confirm no buttons pressed yet )
#00 .lastkey STZ
2023-01-22 21:07:10 -05:00
2022-11-06 21:49:02 -05:00
( set colors )
2023-01-25 12:11:16 -05:00
#07bf .System/r DEO2
#07bf .System/g DEO2
#07bf .System/b DEO2
2023-02-11 21:53:34 -05:00
( load theme to override colors and maybe dimension )
2023-01-30 22:05:47 -05:00
load-theme
2023-01-25 12:11:16 -05:00
2023-02-11 21:53:34 -05:00
( calculate derived dimensions from cols/rows )
update-dimensions
2023-01-25 12:11:16 -05:00
( set starting tint: reverse=0, bg=0, fg=2 )
#02 .attr STZ
2023-01-30 22:05:47 -05:00
update-tint
2023-01-21 15:41:27 -05:00
2023-01-28 10:40:47 -05:00
( set initial modes )
2023-02-11 22:34:06 -05:00
#00 .irm STZ ( insert and move right )
2023-02-03 23:13:44 -05:00
#01 .awm STZ ( wrap at margin )
#01 .tcem STZ ( show cursor )
#00 .paste STZ ( bracketed paste is off )
2023-01-28 10:40:47 -05:00
2022-11-06 21:49:02 -05:00
( clear screen for initial draw )
2023-01-30 22:05:47 -05:00
clear-screen
2022-11-06 21:49:02 -05:00
( set up interrupts )
;redraw .Screen/vect DEO2 ( set up screen )
;on-key .Controller/vect DEO2 ( set up keyboard )
2023-01-31 22:28:41 -05:00
;on-mouse .Mouse/vect DEO2 ( set up mouse )
2023-01-22 21:07:10 -05:00
;on-read .Console/vect DEO2 ( set up stdin )
2022-11-06 21:49:02 -05:00
2023-02-05 17:05:56 -05:00
( these only work with a patched uxnemu )
( on other emulators they should be no-ops )
;shell .Console/exec DEO2 ( set up bash subprocess )
#80 .Console/mode DEO ( start bash subprocess )
2023-02-10 21:12:29 -05:00
( user defaults )
#01 .visual-bell STZ
2023-01-29 23:07:03 -05:00
( set to 01 to enable debug log )
2023-02-11 22:34:06 -05:00
#00 .debug STZ
2023-01-25 12:11:16 -05:00
2023-02-09 20:56:08 -05:00
.debug LDZ ?&continue BRK &continue
#99 #010e DEO
2023-01-31 15:37:14 -05:00
;debug-log .File1/name DEO2
#01 .File1/append DEO
2022-11-06 21:49:02 -05:00
BRK
@update-dimensions ( -> )
( set col-bytes, frequently needed )
.cols LDZ2 DUP2 ADD2 .col-bytes STZ2
( set max row/col )
.rows LDZ2 #0001 SUB2 .max-y STZ2
.cols LDZ2 #0001 SUB2 .max-x STZ2
( set screen height/width based on rows/cols )
.cols LDZ2 #30 SFT2 ( width ) #0010 ADD2 .Screen/w DEO2
.rows LDZ2 #000c MUL2 ( height ) #0010 ADD2 .Screen/h DEO2
JMP2r
2023-02-05 17:05:56 -05:00
@shell "bash 00 "-i 00 00
2023-01-25 12:51:25 -05:00
@load-theme ( -> )
;&path .File1/name DEO2
#0006 .File1/len DEO2
;&r .File1/r DEO2
.File1/ok DEI2 ORA #01 JCN JMP2r
,&r LDR2 .System/r DEO2
,&g LDR2 .System/g DEO2
,&b LDR2 .System/b DEO2
#0002 .File1/len DEO2
;&x .File1/r DEO2
.File1/ok DEI2 ORA #01 JCN JMP2r
2023-02-11 20:09:43 -05:00
#00 ,&x LDR INC2 ( HACK ) .cols STZ2
#00 ,&y LDR .rows STZ2
JMP2r [ &path ".theme $1 &r $2 &g $2 &b $2 &x $1 &y $1 ]
2023-01-23 16:26:08 -05:00
@first-addr ( -> )
2023-01-25 12:11:16 -05:00
;cells JMP2r
2023-01-23 16:26:08 -05:00
2023-01-23 11:14:45 -05:00
@bol-addr ( -> addr* )
2023-01-29 23:07:03 -05:00
.col-bytes LDZ2 .cur-y LDZ2 MUL2 ;cells ADD2 JMP2r
2023-01-23 11:14:45 -05:00
@cur-addr ( -> addr* )
2023-01-29 23:07:03 -05:00
.col-bytes LDZ2 .cur-y LDZ2 MUL2 .cur-x LDZ2 DUP2 ADD2 ADD2 ;cells ADD2 JMP2r
2023-01-23 11:14:45 -05:00
@eol-addr ( -> addr* )
2023-01-29 23:07:03 -05:00
.col-bytes LDZ2 .cur-y LDZ2 INC2 MUL2 ;cells ADD2 JMP2r
2023-01-23 16:26:08 -05:00
2023-01-25 12:11:16 -05:00
@limit-addr ( -> )
2023-01-29 23:07:03 -05:00
.col-bytes LDZ2 .rows LDZ2 MUL2 ;cells ADD2 JMP2r
2023-01-23 11:14:45 -05:00
2023-01-22 21:07:10 -05:00
@min ( x* y* -> min* )
LTH2k JMP SWP2 POP2 JMP2r
2023-01-22 23:44:00 -05:00
@max ( x* y* -> max* )
LTH2k JMP SWP2 NIP2 JMP2r
2023-01-22 21:07:10 -05:00
2022-11-06 21:49:02 -05:00
@clear-screen
2023-02-09 20:56:08 -05:00
#01 .dirty STZ
2023-02-03 23:13:44 -05:00
LIT2r =cells ( [addr*] )
#0000 &yloop ( y* [addr*] y* )
#0000 &xloop ( y* x* [addr*] )
#0200 STH2kr STA2 ( y* x* [addr*] )
2023-02-03 23:13:44 -05:00
INC2r INC2r ( y* x* [addr+2*] )
2023-01-25 12:11:16 -05:00
INC2 DUP2 .cols LDZ2 ( y* x+1* x+1* cols* [addr+2*] )
2023-02-03 23:13:44 -05:00
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 ( )
2022-11-06 21:49:02 -05:00
2023-02-11 21:53:34 -05:00
@redraw ( -> BRK )
.pointer-ttl LDZ #00 EQU ?&pointer-ok ( )
.pointer-ttl LDZk INC DUP ROT STZ ?&pointer-ok
#01 .dirty STZ ( redraw without pointer )
&pointer-ok
2023-02-09 20:56:08 -05:00
.dirty LDZ #00 EQU ?&done
2023-02-02 22:56:58 -05:00
LIT2r =cells ( [addr*] )
2023-02-03 23:13:44 -05:00
.rows LDZ2 #0000 DUP2 #0008 ( border ) ADD2 .Screen/y DEO2
2022-11-06 21:49:02 -05:00
&yloop
2023-02-03 23:13:44 -05:00
.cols LDZ2 #0000 DUP2 #0008 ( border ) ADD2 .Screen/x DEO2
2022-11-06 21:49:02 -05:00
&xloop
2023-02-09 20:56:08 -05:00
STH2kr LDA2 ( DUP2 erase-cell ) draw-cell
#40 .Screen/sprite DEO
( FIXME start )
.Screen/y DEI2k #0004 ADD2 ROT DEO2
#40 .Screen/sprite DEO
.Screen/y DEI2k #0004 SUB2 ROT DEO2
( FIXME end )
.Screen/x DEI2k #0008 ( width/2 ) ADD2 ROT DEO2
2023-01-25 12:11:16 -05:00
INC2 INC2r INC2r
2023-01-30 23:01:34 -05:00
GTH2k ?&xloop
POP2 POP2
2023-02-03 23:13:44 -05:00
.Screen/y DEI2k #000c ( height ) ADD2 ROT DEO2
2022-11-06 21:49:02 -05:00
INC2
2023-01-30 23:01:34 -05:00
GTH2k ?&yloop
POP2 POP2 POP2r
2023-02-10 21:12:29 -05:00
.is-lit LDZ #00 EQU ?&flashing redraw-selection !&finally
&flashing .flash LDZ #00 EQU ?&pointer flash-bell draw-cursor BRK
2023-02-09 21:57:04 -05:00
&pointer draw-pointer
&finally draw-cursor #00 .dirty STZ
2023-02-09 20:56:08 -05:00
&done BRK
2022-11-06 21:49:02 -05:00
2023-02-10 21:12:29 -05:00
@flash-bell ( -> )
2023-02-10 21:18:03 -05:00
.flash LDZk #01 SUB SWP STZ ( ; flash<-flash-1 )
#0000 DUP2 .lit-click-x STZ2 .lit-click-y STZ2
.max-x LDZ2 .lit-drag-x STZ2 .max-y LDZ2 .lit-drag-y STZ2
2023-02-12 13:00:49 -05:00
redraw-selection !clear-selection
2023-02-10 21:12:29 -05:00
2023-02-09 20:56:08 -05:00
@screen-to-cell ( row* col* -> )
#30 SFT2 ( width ) #0008 ( border ) ADD2 .Screen/x DEO2
#000c MUL2 ( height ) #0008 ( border ) ADD2 .Screen/y DEO2
2023-02-06 22:49:35 -05:00
JMP2r
2023-02-09 20:56:08 -05:00
@screen-to-cursor ( -> )
.cur-y LDZ2 .cur-x LDZ2 !screen-to-cell
2023-02-10 20:40:41 -05:00
@clear-cursor ( -> )
2023-02-09 20:56:08 -05:00
screen-to-cursor cur-addr LDA2 !draw-cell
2023-02-10 20:40:41 -05:00
@draw-cursor ( -> )
2023-02-09 20:56:08 -05:00
screen-to-cursor cur-addr LDA2
.tcem LDZ #00 EQU ?&skip SWP reverse-tint SWP
&skip !draw-cell
2022-11-06 21:49:02 -05:00
2023-02-11 21:53:34 -05:00
@on-button ( -> BRK )
2023-01-25 12:11:16 -05:00
.lastkey LDZ ( last^ )
.Controller/button DEI ( last^ button^ )
STHk EOR ( last-xor-button^ [button^] )
STHr AND ( last-xor-button&button^ )
2023-01-30 22:05:47 -05:00
DUP #10 AND #00 EQU ?&no-n LIT "A arrow
&no-n DUP #20 AND #00 EQU ?&no-s LIT "B arrow
&no-s DUP #40 AND #00 EQU ?&no-w LIT "D arrow
&no-w DUP #80 AND #00 EQU ?&no-e LIT "C arrow
2023-01-25 12:11:16 -05:00
&no-e POP .Controller/button DEI .lastkey STZ BRK
2023-01-23 20:22:59 -05:00
( send ESC [ $c )
@arrow ( c^ -> )
.Console/w STH
#1b STHkr DEO LIT "[ STHkr DEO STHr DEO
JMP2r
2023-01-31 22:28:41 -05:00
@paste-from-buf ( size* -> )
;paste-buf SWP2 OVR2 ADD2 SWP2 ( limit* start* )
&loop ( limit* pos* )
LDAk .Console/w DEO INC2 ( limit* pos+1* )
GTH2k ?&loop POP2 POP2 JMP2r
2023-02-02 17:31:24 -05:00
@bracket-paste ( c^ -> )
.Console/w STH
#1b STHkr DEO
LIT "[ STHkr DEO
LIT "2 STHkr DEO
LIT "0 STHkr DEO
( c ) STHkr DEO
LIT "~ STHr DEO
JMP2r
2023-01-31 22:28:41 -05:00
@paste-snarf ( -> )
2023-02-02 17:31:24 -05:00
.paste LDZ #00 EQU ?&start LIT "0 ;bracket-paste JSR2 &start
;snarf .File2/name DEO2 ( )
2023-02-10 17:47:30 -05:00
#0780 .File2/len DEO2 ( )
2023-01-31 22:28:41 -05:00
&loop ( )
;paste-buf .File2/r DEO2 ( )
.File2/ok DEI2 ( size* )
DUP2 #0000 EQU2 ?&failed ( size* )
DUP2 paste-from-buf ( size* )
2023-02-10 17:47:30 -05:00
#0780 LTH2 ?&done ( )
2023-01-31 22:28:41 -05:00
!&loop ( )
&failed POP2
2023-02-02 17:31:24 -05:00
&done
.paste LDZ #00 EQU ?&end LIT "1 ;bracket-paste JSR2 &end
JMP2r
2023-02-09 21:55:46 -05:00
@lit-first-y
.is-lit-flip LDZ ?&flip .lit-click-y LDZ2 JMP2r &flip .lit-drag-y LDZ2 JMP2r
@lit-first-x
.is-lit-flip LDZ ?&flip .lit-click-x LDZ2 JMP2r &flip .lit-drag-x LDZ2 JMP2r
@lit-last-y
.is-lit-flip LDZ ?&flip .lit-drag-y LDZ2 JMP2r &flip .lit-click-y LDZ2 JMP2r
@lit-last-x
.is-lit-flip LDZ ?&flip .lit-drag-x LDZ2 JMP2r &flip .lit-click-x LDZ2 JMP2r
2023-02-09 20:56:08 -05:00
@redraw-selection ( -> )
2023-02-09 21:55:46 -05:00
lit-first-y .cols LDZ2 MUL2 ( y0*cols* )
2023-02-13 23:22:52 -05:00
lit-first-x ADD2 DUP2 ADD2 ( 2(y0*cols+x0)* )
2023-02-09 20:56:08 -05:00
;cells ADD2 STH2 ( [addr*] )
2023-02-09 21:55:46 -05:00
lit-last-y INC2 lit-first-y ( yn* y0* [addr*] )
DUP2 lit-first-x STH2k ( yn* y0* x0* [addr* x0*] )
2023-02-09 20:56:08 -05:00
screen-to-cell ( yn* y0* [addr* x0*] )
&yloop ( yn* y* [addr* x*] )
OVR2 OVR2 INC2 GTH2 STH .cols LDZ2 ( yn* y* cols* [addr* x* last^] )
2023-02-09 21:55:46 -05:00
lit-last-x INC2 ( yn* y* cols* xn* [addr* x* last^] )
2023-02-09 20:56:08 -05:00
STHr JMP SWP2 POP2 STH2r ( yn* y* xlim* x* [addr*] )
&xloop ( yn* y* xlim* x* [addr*] )
STH2kr LDA2 highlight-cell ( yn* y* xlim* x* [addr*] )
.Screen/x DEI2k #0008 ADD2 ROT DEO2 ( yn* y* xlim* x* [addr*] )
INC2 INC2r INC2r ( yn* y* xlim* x+1* [addr+2*] )
GTH2k ?&xloop ( yn* y* xlim* x+1* [addr+2*] )
POP2 POP2 ( yn* y* [addr+2*] )
.Screen/y DEI2k #000c ADD2 ROT DEO2 ( yn* y* [addr+2*] )
#0008 .Screen/x DEO2 ( yn* y* [addr+2*] )
LIT2r 0000 INC2 GTH2k ?&yloop ( yn* y+1* [addr+2* 0*] )
POP2 POP2 POP2r POP2r ( )
JMP2r ( )
@point-to-coord ( x* y* -> row* col* )
2023-02-12 13:00:49 -05:00
DUP2 #0008 SUB2 min #000c DIV2 .max-y LDZ2 min SWP2 ( row=(y-8)/12* x* )
DUP2 #0008 SUB2 min #03 SFT2 .max-x LDZ2 !min ( row* col=(x-8)/8* )
2023-02-09 20:56:08 -05:00
@start-selection ( -> )
2023-02-09 21:55:46 -05:00
#01 .is-lit STZ ( )
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
#00 .is-lit-flip STZ ( x* y* )
point-to-coord ( row* col* )
DUP2 .lit-click-x STZ2 .lit-drag-x STZ2 ( row* )
DUP2 .lit-click-y STZ2 .lit-drag-y STZ2 ( )
redraw-selection !draw-cursor ( )
2023-02-09 20:56:08 -05:00
@selection-is-empty ( -> bool^ )
2023-02-09 21:55:46 -05:00
.lit-click-y LDZ2 .lit-drag-y LDZ2 EQU2
.lit-click-x LDZ2 .lit-drag-x LDZ2 EQU2 AND JMP2r
2023-02-09 20:56:08 -05:00
@find-natural-end ( y* -> xend* )
DUP2 .cols LDZ2 MUL2 ( y* y*cols* )
2023-02-13 23:22:52 -05:00
DUP2 ADD2 ;cells ADD2 INC2 ( y* edge* )
DUP2 .max-x LDZ2 DUP2 ADD2 ADD2 ( y* edge* start=edge+2cols* )
&loop ( y* edge* addr* )
LDAk ?&done ( y* edge* addr* )
#0002 SUB2 LTH2k ?&loop ( y* edge* addr-2* )
&done ( y* edge* addr* )
2023-02-13 23:22:52 -05:00
SWP2 SUB2 #01 SFT2 ( y* x* )
NIP2 JMP2r ( x* )
@copy-line ( y* x1* x0* -> y* )
STH2 STH2 DUP2 find-natural-end ( y* xend* [x0* x1*] )
STH2r min ( y* xlim=min(xend,x1)* [x0*] )
2023-02-13 22:58:29 -05:00
DUP2 STH2kr GTH2 ?&ok ( y* xlim* [x0*] )
2023-02-13 22:56:04 -05:00
POP2 POP2r JMP2r ( y* ; return if line is empty )
&ok OVR2 .cols LDZ2 MUL2 ( y* xlim* y*cols* [x0*] )
2023-02-13 23:22:52 -05:00
STH2kr ADD2 DUP2 ADD2 ;cells ADD2 ( y* xlim* addr* [x0*] )
2023-02-11 22:34:06 -05:00
INC2 STH2 SWP2r STH2r ( y* xlim* x0* [addr+1*] )
SUB2 INC2 #0000 SWP2 SUB2 ( y* -count* [addr+1*] )
&loop ( y* -i* [pos*] )
LDAkr STHr copy-char ( y* -i* [pos*] )
INC2 INC2r INC2r ORAk ?&loop ( y* -i+1* [pos+2*] )
2023-02-13 22:56:04 -05:00
POP2 POP2r JMP2r ( y* ; done )
@copy-char ( c^ -> )
DUP ?&ok POP #20 ( replace \0 with space )
&ok STH ;paste-pos LDA2k ( pos* addr* [c^] )
STH2k STAr INC2 SWP2 STA2 JMP2r ( )
@copy-selection ( -> )
;paste-buf ;paste-pos STA2
lit-last-y INC2 lit-first-y ( ylim* y0* )
DUP2 lit-first-x STH2k screen-to-cell ( yn* y0* [x0*] )
&yloop ( yn* y* [x*] )
OVR2 OVR2 INC2 GTH2 STH .max-x LDZ2 ( yn* y* maxx* [x* last^] )
lit-last-x ( yn* y* maxx* xlast* [x* last^] )
STHr JMP SWP2 POP2 STH2r ( yn* y* x1* x* )
copy-line ( yn* y* )
LIT2r 0000 INC2 GTH2k ?&next !&done ( yn* y+1* [0*] )
&next ( )
#0a copy-char !&yloop ( )
&done ( )
POP2 POP2 POP2r ( )
;snarf .File2/name DEO2 ( )
;paste-pos LDA2 ;paste-buf SUB2 ( len* )
.File2/len DEO2 ( )
;paste-buf .File2/w DEO2 ( )
JMP2r ( )
2023-02-09 20:56:08 -05:00
@handle-selection ( -> )
2023-02-12 13:00:49 -05:00
selection-is-empty ?&skip copy-selection
&skip ( fall through to clear-selection )
2023-02-09 20:56:08 -05:00
@clear-selection ( -> )
#00 .is-lit STZ
2023-02-09 21:55:46 -05:00
#00 .is-lit-flip STZ
2023-02-09 20:56:08 -05:00
#01 .dirty STZ
2023-02-09 21:55:46 -05:00
#0000 DUP2 .lit-click-y STZ2
DUP2 .lit-click-x STZ2
DUP2 .lit-drag-y STZ2
.lit-drag-x STZ2 JMP2r
2023-02-09 20:56:08 -05:00
@update-selection ( -> )
2023-02-09 21:55:46 -05:00
.Mouse/x DEI2 .Mouse/y DEI2 point-to-coord ( row* col* )
OVR2 .lit-drag-y STZ2 DUP2 .lit-drag-x STZ2 ( row* col* )
OVR2 .lit-click-y LDZ2 LTH2 ?&earlier ( row* col* )
DUP2 .lit-click-x LDZ2 LTH2 ?&earlier ( row* col* )
#00 !&done &earlier #01 ( row* col* )
&done .is-lit-flip STZ POP2 POP2 JMP2r ( )
2023-02-09 20:56:08 -05:00
@end-selection ( -> )
update-selection draw-cursor !handle-selection ( )
2023-02-09 20:56:08 -05:00
2023-01-31 22:28:41 -05:00
@on-click-down ( click^ -> )
2023-02-09 20:56:08 -05:00
DUP #01 AND ?&left-click
DUP #02 AND ?&middle-click
!&done
&left-click POP !start-selection
&middle-click POP !paste-snarf
&done POP JMP2r
2023-01-31 22:28:41 -05:00
@on-click-up ( unclick^ -> )
2023-02-09 20:56:08 -05:00
#01 AND ?&left-click !&done
&left-click !end-selection
&done JMP2r
2023-01-31 22:28:41 -05:00
2023-02-06 22:49:35 -05:00
@draw-at ( x* y* addr* -> )
STH2k .Screen/addr DEO2 ( x* y* [addr*] )
STH2k .Screen/y DEO2 ( x [addr* y*] )
.Screen/x DEO2 ( [addr* y* x*] )
#43 .Screen/sprite DEOk ( 43 sprite^ [addr* y* x*] )
STH2r #0008 ADD2 .Screen/y DEO2 ( 43 sprite^ [addr*] )
STH2r #0008 ADD2 .Screen/addr DEO2 ( 43 sprite^ )
DEO JMP2r ( )
2023-02-09 21:55:46 -05:00
@draw-pointer ( -> )
.lastmouse-x LDZ2 .lastmouse-y LDZ2 ( x* y* )
.pointer-ttl LDZ ?&visible #0000 !&finally
&visible #01e0 &finally ;cp437 ADD2 !draw-at
2023-02-09 21:55:46 -05:00
2023-02-06 22:49:35 -05:00
@on-move ( -> )
#c4 .pointer-ttl STZ ( pointer visible for ~1 second )
2023-02-06 22:49:35 -05:00
.Mouse/x DEI2 .lastmouse-x LDZ2 NEQ2 ?&redraw ( )
.Mouse/y DEI2 .lastmouse-y LDZ2 NEQ2 ?&redraw ( )
JMP2r ( )
&redraw ( )
.lastmouse-x LDZ2 .lastmouse-y LDZ2 ( lx* ly* )
#0200 ;cp437 ADD2 draw-at ( )
2023-02-09 21:55:46 -05:00
.is-lit LDZ #00 EQU ?&next
2023-02-13 22:56:04 -05:00
update-selection
2023-02-09 21:55:46 -05:00
#01 .dirty STZ
&next
2023-02-06 22:49:35 -05:00
.Mouse/x DEI2 .Mouse/y DEI2 ( x* y* )
.lastmouse-y STZ2 .lastmouse-x STZ2 ( )
2023-02-09 21:55:46 -05:00
draw-pointer
2023-02-12 13:00:49 -05:00
!screen-to-cursor ( )
2023-01-31 22:28:41 -05:00
2023-02-11 21:53:34 -05:00
@on-mouse ( -> BRK )
2023-01-31 22:28:41 -05:00
.lastmouse-st LDZ ( last )
.Mouse/state DEI ( last st )
STHk OVR EOR STHkr AND ( last (last^st)&st [st] )
on-click-down ( last [st] )
DUP STHkr EOR AND ( last&(last^st) [st] )
on-click-up ( [st] )
STHr .lastmouse-st STZ ( )
2023-02-06 22:49:35 -05:00
on-move BRK ( )
2023-01-31 22:28:41 -05:00
2023-02-11 21:53:34 -05:00
@on-key ( -> BRK )
2023-02-13 23:08:15 -05:00
#00 .pointer-ttl STZ #01 .dirty STZ ( hide pointer )
2023-01-30 22:05:47 -05:00
.Controller/key DEI ?&ok !on-button
&ok alt ?on-alt-key
ctrl ?on-ctrl-key
2023-01-30 15:09:07 -05:00
.Controller/key DEI
2023-01-30 22:05:47 -05:00
DUP #08 NEQ ?&done
2023-01-30 15:09:07 -05:00
POP #7f ( send DEL instead of BS )
&done .Console/w DEO BRK
2023-01-22 15:55:52 -05:00
2023-01-30 22:05:47 -05:00
@ctrl ( -> is-down? ) .Controller/button DEI #01 AND JMP2r
@alt ( -> is-down? ) .Controller/button DEI #02 AND JMP2r
2023-01-22 15:55:52 -05:00
( alt-XYZ emits ESC and then emits XYZ )
2023-02-11 21:53:34 -05:00
@on-alt-key ( -> BRK )
2023-01-22 15:55:52 -05:00
#1b .Console/w DEO
2023-01-30 22:05:47 -05:00
ctrl ?on-ctrl-key
2023-01-22 15:55:52 -05:00
.Controller/key DEI .Console/w DEO BRK
( ctrl-$n emits: )
( 0 <= $n < @ -> $n )
( @ <= $n < ` -> $n #40 SUB )
( ` <= $n <= #ff -> $n #60 SUB )
2023-02-11 21:53:34 -05:00
@on-ctrl-key ( -> BRK )
2023-01-22 15:55:52 -05:00
.Controller/key DEI
2023-01-30 22:05:47 -05:00
DUP LIT "@ LTH ?&done
DUP LIT "` LTH ?&c1
LIT "` SUB !&done
2023-01-22 15:55:52 -05:00
&c1 LIT "@ SUB
&done .Console/w DEO BRK
2023-01-22 15:21:57 -05:00
2023-02-11 21:53:34 -05:00
@on-read-priv ( -> BRK )
2023-01-22 23:44:00 -05:00
.Console/r DEI
2023-01-30 22:05:47 -05:00
DUP LIT "; EQU ?next-arg
DUP LIT "0 LTH ?end-arg-priv
DUP LIT "9 GTH ?end-arg-priv
!add-to-arg
2023-01-24 11:59:01 -05:00
2023-02-11 21:53:34 -05:00
@start-priv ( -> BRK )
2023-01-30 14:25:03 -05:00
POP ;on-read-priv .Console/vect DEO2 BRK
2023-01-24 11:59:01 -05:00
2023-02-11 21:53:34 -05:00
@on-read-csi ( -> BRK )
2023-01-24 11:59:01 -05:00
.Console/r DEI
2023-01-30 22:05:47 -05:00
DUP LIT "? EQU ?start-priv
DUP LIT "; EQU ?next-arg
DUP LIT "0 LTH ?end-arg
DUP LIT "9 GTH ?end-arg
!add-to-arg
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@on-read-osc ( -> BRK )
2023-02-04 18:48:06 -05:00
.Console/r DEI
DUP #07 ( bell ) EQU ?&end-osc
#9c ( esc-\ ) EQU ?&end-osc BRK
&end-osc ;on-read .Console/vect DEO2 BRK
2023-01-25 23:37:56 -05:00
@debug-arg ( n* -> )
2023-01-30 22:05:47 -05:00
&short SWP debug-arg/byte
&byte DUP #04 SFT debug-arg/char
2023-02-02 22:56:58 -05:00
&char #0f AND DUP #09 GTH #27 MUL ADD #30 ADD !scratch-write
2023-01-25 23:37:56 -05:00
@debug-args ( -> )
;args/pos LDA2 ;args
&loop
2023-01-30 22:05:47 -05:00
#20 scratch-write
LDA2k debug-arg/short INC2 INC2
LTH2k ?&done !&loop
2023-01-25 23:37:56 -05:00
&done POP2 POP2 JMP2r
2023-01-24 11:59:01 -05:00
@debug-priv ( c^ -> )
2023-01-30 22:05:47 -05:00
.debug LDZ ?&continue POP JMP2r &continue
reset-scratch
2023-02-02 22:56:58 -05:00
LIT2r =scratch-write
2023-01-25 23:37:56 -05:00
LIT "1 STH2kr JSR2
LIT "b STH2kr JSR2
#20 STH2kr JSR2
LIT "[ STH2kr JSR2
#20 STH2kr JSR2
LIT "? STH2kr JSR2
2023-01-30 22:05:47 -05:00
debug-args
2023-01-25 23:37:56 -05:00
#20 STH2kr JSR2
STH2kr JSR2
#0a STH2r JSR2
2023-01-31 15:37:14 -05:00
scratch-len .File1/len DEO2
;scratch .File1/w DEO2
2023-01-25 23:37:56 -05:00
JMP2r
2023-02-11 21:53:34 -05:00
@end-arg-priv ( c^ -> BRK )
2023-01-24 11:59:01 -05:00
;on-read .Console/vect DEO2
2023-01-30 22:05:47 -05:00
DUP LIT "h EQU ?exec-priv-set-or-unset
DUP LIT "l EQU ?exec-priv-set-or-unset
DUP debug-priv
2023-01-24 11:59:01 -05:00
( TODO: handle these )
POP BRK
2023-02-11 21:53:34 -05:00
@exec-priv-set-or-unset ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
#0001 read-arg-1 ( c^ n* )
DUP2 #0019 NEQ2 ?&!25 POP2 .tcem !&change
&!25 DUP2 #07d4 NEQ2 ?&!2004 POP2 .paste !&change
&!2004 POP2 debug-priv BRK
2023-01-30 14:25:03 -05:00
&change SWP LIT "h EQU SWP STZ BRK ( h is set, l is unset )
2023-02-02 17:16:50 -05:00
@debug-read ( c^ -> )
.debug LDZ ?&continue POP JMP2r &continue
reset-scratch
debug-arg/byte
#0a scratch-write
scratch-len .File1/len DEO2
;scratch .File1/w DEO2
JMP2r
2023-01-24 11:59:01 -05:00
@debug-csi ( c^ -> )
2023-01-30 22:05:47 -05:00
.debug LDZ ?&continue POP JMP2r &continue
reset-scratch
2023-02-02 22:56:58 -05:00
LIT2r =scratch-write
2023-01-25 23:37:56 -05:00
LIT "1 STH2kr JSR2
LIT "b STH2kr JSR2
#20 STH2kr JSR2
LIT "[ STH2kr JSR2
2023-01-30 22:05:47 -05:00
debug-args
2023-01-25 23:37:56 -05:00
#20 STH2kr JSR2
STH2kr JSR2
#0a STH2r JSR2
2023-01-31 15:37:14 -05:00
scratch-len .File1/len DEO2
;scratch .File1/w DEO2
2023-01-25 23:37:56 -05:00
JMP2r
2023-01-23 20:54:52 -05:00
2023-02-11 21:53:34 -05:00
@end-arg ( c^ -> BRK )
2023-01-22 23:44:00 -05:00
;on-read .Console/vect DEO2
2023-02-10 17:47:30 -05:00
DUP debug-csi
2023-02-11 22:34:06 -05:00
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 )
2023-01-30 22:05:47 -05:00
DUP LIT "@ EQU ?exec-insert-blanks ( insert blank characters )
2023-02-11 22:34:06 -05:00
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 )
2023-02-10 20:40:41 -05:00
( ` - horizontal position absolute )
( S - scroll up n lines )
( X - erase n chars )
( Z - backward n tab stops )
( = 0 C - normal cursor )
( = 1 C - bold cursor )
2023-01-30 22:05:47 -05:00
debug-csi BRK
2023-01-22 23:44:00 -05:00
2023-01-25 23:37:56 -05:00
( set mode )
( TODO: insert/replace, line wrap, etc. )
2023-02-11 21:53:34 -05:00
@exec-set-mode ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
POP #0001 read-arg-1
DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&set
&!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&set
2023-01-28 10:40:47 -05:00
&!awm POP2 BRK
&set #01 SWP STZ BRK
2023-02-11 21:53:34 -05:00
@exec-reset-mode ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
POP #0001 read-arg-1
DUP2 #0004 NEQ2 ?&!irm POP2 .irm !&reset
&!irm DUP2 #0007 NEQ2 ?&!awm POP2 .awm !&reset
2023-01-28 10:40:47 -05:00
&!awm POP2 BRK
&reset #00 SWP STZ BRK
2023-01-25 23:37:56 -05:00
2023-01-25 12:11:16 -05:00
@read-attr ( attr* -> )
2023-01-30 22:05:47 -05:00
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
2023-01-25 12:11:16 -05:00
&set-fg .attr LDZ #fc AND ORA .attr STZ
2023-01-30 22:05:47 -05:00
&done update-tint
2023-01-25 12:11:16 -05:00
&ignored POP2 JMP2r
2023-02-11 21:53:34 -05:00
@exec-set-attr ( c^ -> BRK )
2023-01-25 12:11:16 -05:00
POP
;args/pos LDA2 ;args
&loop
2023-01-30 22:05:47 -05:00
LDA2k read-attr
2023-01-25 12:11:16 -05:00
INC2 INC2
2023-01-30 22:05:47 -05:00
LTH2k ?&done !&loop
2023-01-25 12:11:16 -05:00
&done
2023-01-28 10:40:47 -05:00
POP2 POP2 BRK
2023-01-25 12:11:16 -05:00
2023-02-11 21:53:34 -05:00
@exec1 ( addr* -> BRK )
2023-01-30 22:05:47 -05:00
STH2 #0001 read-arg-1 STH2r JSR2 BRK
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@exec-status ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
POP #0000 read-arg-1 #0006 NEQ2 ,&done
2023-01-23 11:14:45 -05:00
#1b .Console/w DEO
LIT "[ .Console/w DEO
.cur-y LDZ2 INC2 emit-dec2
2023-01-23 11:14:45 -05:00
LIT "; .Console/w DEO
.cur-x LDZ2 INC2 emit-dec2
2023-01-23 11:14:45 -05:00
LIT "R .Console/w DEO
&done BRK
2023-01-30 22:05:47 -05:00
@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
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@exec-erase-line ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
POP #0000 read-arg-1
DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ?&erase-full
2023-01-23 14:48:29 -05:00
POP2 BRK
&erase-full
2023-01-30 22:05:47 -05:00
POP2 bol-addr eol-addr erase BRK
2023-01-23 11:14:45 -05:00
&erase-to-end
2023-01-30 22:05:47 -05:00
POP2 cur-addr eol-addr erase BRK
2023-01-23 11:14:45 -05:00
&erase-from-start
2023-01-30 22:05:47 -05:00
POP2 bol-addr cur-addr erase BRK
2023-01-23 11:14:45 -05:00
2023-02-11 21:53:34 -05:00
@exec-erase-screen ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
POP #0000 read-arg-1
DUP2 #0000 EQU2 ?&erase-to-end
DUP2 #0001 EQU2 ?&erase-from-start
DUP2 #0002 EQU2 ?&erase-full
2023-01-23 16:26:08 -05:00
POP2 BRK
&erase-full
2023-01-30 22:05:47 -05:00
POP2 first-addr limit-addr erase BRK
2023-01-23 16:26:08 -05:00
&erase-to-end
2023-01-30 22:05:47 -05:00
POP2 bol-addr limit-addr erase BRK
2023-01-23 16:26:08 -05:00
&erase-from-start
2023-01-30 22:05:47 -05:00
POP2 first-addr eol-addr erase BRK
2023-01-23 11:14:45 -05:00
2023-01-23 16:26:08 -05:00
( TODO: needs to be smarter -- need to redraw tiles and keep x/y coords )
2023-01-23 11:14:45 -05:00
@erase ( start* end* -> )
2023-02-11 22:34:06 -05:00
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 ( )
2023-01-23 11:14:45 -05:00
2023-02-11 21:53:34 -05:00
@exec-move-row ( c^ -> BRK )
2023-02-11 22:34:06 -05:00
POP ( )
2023-02-02 22:12:58 -05:00
#0001 read-arg-1 dec-floor ( row )
.cur-x LDZ2 ( col )
2023-02-11 22:34:06 -05:00
goto BRK ( )
2023-01-23 21:18:50 -05:00
2023-02-11 21:53:34 -05:00
@exec-move-col ( c^ -> BRK )
2023-02-11 22:34:06 -05:00
POP ( )
2023-02-02 22:12:58 -05:00
.cur-y LDZ2 ( row )
2023-02-02 22:18:58 -05:00
#0001 read-arg-1 dec-floor ( col )
2023-02-11 22:34:06 -05:00
goto BRK ( )
2023-01-23 21:18:50 -05:00
2023-02-11 21:53:34 -05:00
@exec-move ( c^ -> BRK )
2023-02-11 22:34:06 -05:00
POP ( )
2023-02-02 22:12:58 -05:00
#0001 read-arg-1 dec-floor ( row )
#0001 read-arg-2 dec-floor ( col )
2023-02-11 22:34:06 -05:00
goto BRK ( )
2023-01-22 23:44:00 -05:00
2023-02-02 22:12:58 -05:00
@dec-floor ( x* -> x==0 ? 0* : x-1* )
ORAk ?&sub JMP2r &sub #0001 SUB2 JMP2r
2023-01-23 20:54:52 -05:00
@debug-esc ( c^ -> )
2023-01-30 22:05:47 -05:00
.debug LDZ ?&continue POP JMP2r &continue
2023-02-02 22:56:58 -05:00
LIT2r =scratch
2023-01-23 20:54:52 -05:00
LIT "1 STH2kr STA INC2r
LIT "b STH2kr STA INC2r
#20 STH2kr STA INC2r
STH2kr STA INC2r
#0a STH2r STA
2023-01-31 15:37:14 -05:00
#0005 .File1/len DEO2
;scratch .File1/w DEO2
2023-01-23 20:54:52 -05:00
JMP2r
2023-02-11 21:53:34 -05:00
@on-read-esc ( -> BRK )
2023-02-02 16:32:01 -05:00
.Console/r DEI
2023-02-10 17:47:30 -05:00
DUP debug-esc
2023-02-02 16:32:01 -05:00
DUP LIT "[ EQU ?start-csi
2023-02-04 18:48:06 -05:00
DUP LIT "] EQU ?start-osc
2023-02-02 16:32:01 -05:00
DUP LIT "( EQU ?start-charset
DUP LIT ") EQU ?start-charset
DUP LIT "7 EQU ?&skip ( save cursor )
DUP LIT "8 EQU ?&skip ( restore cursor )
debug-esc
2023-01-22 23:44:00 -05:00
;on-read .Console/vect DEO2
2023-01-30 22:05:47 -05:00
!on-read
2023-02-02 16:32:01 -05:00
&skip POP ;on-read .Console/vect DEO2 BRK
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@on-read-skip ( -> BRK )
2023-02-02 16:32:01 -05:00
;on-read .Console/vect DEO2
2023-01-22 23:44:00 -05:00
BRK
2023-02-02 16:32:01 -05:00
( '(' = designate G0 charset )
( ')' = designate G1 charset )
( '*' = designate G2 charset )
( '+' = designate G3 charset )
2023-02-11 21:53:34 -05:00
@start-charset ( c^ -> BRK )
2023-02-02 16:32:01 -05:00
POP ;on-read-skip .Console/vect DEO2 BRK
2023-02-11 21:53:34 -05:00
@start-csi ( c^ -> BRK )
2023-02-02 16:32:01 -05:00
POP reset-args ;on-read-csi .Console/vect DEO2 BRK
2023-02-11 21:53:34 -05:00
@start-osc ( c^ -> BRK )
2023-02-04 18:48:06 -05:00
POP reset-args ;on-read-osc .Console/vect DEO2 BRK
2023-02-11 21:53:34 -05:00
@on-read ( -> BRK )
2023-01-22 15:55:52 -05:00
.Console/r DEI
2023-02-10 17:47:30 -05:00
DUP debug-read
2023-01-30 22:05:47 -05:00
DUP ?&ok POP BRK
2023-02-12 13:00:49 -05:00
&ok
2023-01-30 22:05:47 -05:00
DUP #20 LTH ?read-ctrl
DUP #7f EQU ?read-del
2023-02-12 13:00:49 -05:00
( read printable )
.tint LDZ SWP DUP2 insert-cell
draw-cell forward BRK
2023-01-22 21:07:10 -05:00
2023-02-11 21:53:34 -05:00
@read-ctrl ( c^ -> BRK )
2023-01-30 22:05:47 -05:00
DUP #07 EQU ?read-bel
DUP #08 EQU ?read-bs
DUP #09 EQU ?read-tab
DUP #0a EQU ?read-nl
DUP #0d EQU ?read-cr
DUP #1b EQU ?read-esc
2022-11-06 21:49:02 -05:00
2023-02-11 21:53:34 -05:00
@read-bel ( 07 -> BRK )
2023-02-10 21:12:29 -05:00
POP .visual-bell LDZ #00 EQU ?&done
#06 .flash STZ #01 .dirty STZ
&done BRK
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@read-bs ( 08 -> BRK )
2023-01-23 16:26:08 -05:00
POP
2023-01-30 22:05:47 -05:00
clear-cursor
#0001 back-n
draw-cursor
2023-02-02 17:16:50 -05:00
BRK
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@read-esc ( 1b -> BRK )
2023-01-22 23:44:00 -05:00
POP ;on-read-esc .Console/vect DEO2 BRK
2023-02-11 21:53:34 -05:00
@read-del ( 7f -> BRK )
2023-01-23 20:54:52 -05:00
POP BRK
2022-11-06 21:49:02 -05:00
2023-02-11 21:53:34 -05:00
@read-tab ( 09 -> BRK )
2023-01-21 22:54:20 -05:00
POP
2023-01-29 23:07:03 -05:00
.cur-x LDZ2 ( x* )
NIP #07 AND #08 SUB ( i=(xlo&7)-8^ )
&loop ( i^ )
.tint LDZ #20 DUP2 ( i^ cell* cell* )
2023-01-30 22:05:47 -05:00
cur-addr STA2 ( i^ cell* ; addr<-cell )
draw-cell ( i^ )
forward ( i^ )
INC DUP ?&loop ( i+1^ )
2023-01-29 23:07:03 -05:00
POP BRK ( )
2023-01-21 22:54:20 -05:00
2023-02-11 21:53:34 -05:00
@read-cr ( 0d -> BRK )
2023-02-02 22:12:58 -05:00
POP clear-cursor #0000 .cur-x STZ2 draw-cursor BRK
2022-11-06 21:49:02 -05:00
2023-01-22 21:07:10 -05:00
@at-max-y ( -> true? )
.cur-y LDZ2 .max-y LDZ2 EQU2 JMP2r
2023-02-11 21:53:34 -05:00
@read-nl ( 0a -> BRK )
2023-02-11 22:34:06 -05:00
POP clear-cursor at-max-y ?scroll down BRK
2023-01-22 15:21:57 -05:00
2023-01-22 23:44:00 -05:00
@goto ( y* x* -> )
2023-01-30 22:05:47 -05:00
clear-cursor
.max-x LDZ2 min .cur-x STZ2
.max-y LDZ2 min .cur-y STZ2
!draw-cursor
2023-01-22 23:44:00 -05:00
2023-01-22 21:07:10 -05:00
@forward-n ( n* -> )
2023-01-30 22:05:47 -05:00
clear-cursor
.cur-x LDZ2 ADD2 .max-x LDZ2 min .cur-x STZ2
!draw-cursor
2022-11-06 21:49:02 -05:00
2023-01-22 21:07:10 -05:00
@forward ( -> )
2023-01-30 22:05:47 -05:00
#0001 !forward-n
2023-01-22 21:07:10 -05:00
@back-n ( n* -> )
2023-01-30 22:05:47 -05:00
clear-cursor
.cur-x LDZ2 GTH2k ?&zero
SWP2 SUB2 !&done
2023-01-22 21:07:10 -05:00
&zero POP2 POP2 #0000
2023-01-30 22:05:47 -05:00
&done .cur-x STZ2 !draw-cursor
2023-01-22 21:07:10 -05:00
@up-n ( n* -> )
2023-01-30 22:05:47 -05:00
clear-cursor
.cur-y LDZ2 GTH2k ?&zero
SWP2 SUB2 !&done
2023-01-22 21:07:10 -05:00
&zero POP2 POP2 #0000
2023-01-30 22:05:47 -05:00
&done .cur-y STZ2 !draw-cursor
2023-01-22 21:07:10 -05:00
@down-n ( n* -> )
2023-01-30 22:05:47 -05:00
clear-cursor
.cur-y LDZ2 ADD2 .max-y LDZ2 min .cur-y STZ2
!draw-cursor
2023-01-22 15:21:57 -05:00
2022-11-06 21:49:02 -05:00
@down ( -> )
2023-01-30 22:05:47 -05:00
#0001 !down-n
2022-11-06 21:49:02 -05:00
2023-01-28 10:40:47 -05:00
@insert-cell ( cell* -> )
2023-02-11 22:34:06 -05:00
.irm LDZ #00 EQU ?&replace ( cell* )
cur-addr ( cell* lim* )
eol-addr #0002 SUB2 ( cell* lim* last=eol-2* )
&loop ( cell* lim* pos* )
STH2k #0002 SUB2 LDA2k ( cell* lim* pos-2* cell* [pos*] )
STH2r STA2 LTH2k ?&loop ( cell* lim* pos-2* )
POP2 POP2 ( cell* )
&replace ( cell* )
cur-addr STA2 JMP2r ( )
2023-01-28 10:40:47 -05:00
2023-01-30 10:59:52 -05:00
@forward-n-tabs ( n* -> )
2023-02-12 13:00:49 -05:00
dec-floor #30 SFT2 ( i=(n-1)8* )
2023-01-30 10:59:52 -05:00
#0008 .cur-x LDZ2 #0007 AND2 SUB2 ( i* 8-cur%8* )
2023-02-02 22:12:58 -05:00
ADD2 !forward-n ( )
2023-01-30 10:59:52 -05:00
@insert-n-lines ( n* -> )
.col-bytes LDZ2 MUL2 STH2 ( [i*] )
2023-02-02 22:12:58 -05:00
bol-addr ( bound* [i*] )
limit-addr STH2kr ( bound* limit* i* [i*] )
2023-01-30 10:59:52 -05:00
INC2 INC2 SUB2 ( bound* start=limit-i-2* [i*] )
&loop ( bound* pos* [i*] )
LDA2k OVR2 STH2kr ADD2 ( bound* pos* x* pos+i* [i*] )
STA2 ( bound* pos* [i*] ; pos+i<-x )
2023-02-10 20:40:41 -05:00
#0200 OVR2 STA2 ( bound* pos* [i*] ; pos<-0200 )
2023-01-30 10:59:52 -05:00
#0002 SUB2 ( bound* pos-2* [i*] )
2023-02-02 22:12:58 -05:00
GTH2k #00 EQU ?&loop ( bound* pos-2* [i*] )
2023-01-30 10:59:52 -05:00
POP2 POP2 POP2r ( )
2023-02-11 22:34:06 -05:00
#01 .dirty STZ JMP2r ( )
2023-01-30 10:59:52 -05:00
2023-01-28 10:40:47 -05:00
@insert-n-spaces ( n* -> )
2023-02-03 23:13:44 -05:00
STH2 ( [n*] )
2023-01-30 22:05:47 -05:00
.irm LDZ #00 EQU ?&replace ( [n*] )
2023-02-03 23:13:44 -05:00
eol-addr #0001 SUB2 ( last* [n*] )
STH2kr DUP2 ADD2 SUB2 ( start=last-2n* [n*] )
cur-addr SWP2 ( end* start* [n*] )
DUP2kr ADD2r ( end* start* [n* 2n*] )
&loop ( end* pos* [n* 2n*] )
LDA2k OVR2 STH2kr ADD2 ( end* pos* x* pos+2n* )
STA2 #0002 SUB2 ( end* pos-2* [n* 2n*] )
2023-01-30 22:05:47 -05:00
GTH2k #00 EQU ?&loop ( end* pos-2* [n* 2n*] )
2023-02-03 23:13:44 -05:00
POP2 POP2 POP2r ( [n*] )
&replace ( [n*] )
LIT2r 0000 SWP2r SUB2r ( [-n*] )
2023-02-10 20:40:41 -05:00
#0200 cur-addr ( 0200 cur* [-n*] )
&loop2 ( 0200 pos* [-i*] )
STA2k INC2 INC2 INC2r ( 0200 pos+2* [-i+1*] )
ORAkr STHr ?&loop2 ( 0200 pos+2* [-i+1*] )
2023-02-03 23:13:44 -05:00
POP2 POP2 POP2r ( )
2023-02-11 22:34:06 -05:00
#01 .dirty STZ JMP2r ( )
2023-01-28 10:40:47 -05:00
2023-01-29 23:07:03 -05:00
( starts with cursor pos )
@delete-n-chars ( n* -> )
2023-02-03 23:13:44 -05:00
DUP2 ADD2 STH2 ( [i=2n*] )
eol-addr STH2kr SUB2 ( limit=eol-i* [i*] )
cur-addr ( limit* start* [i*] )
&loop ( limit* pos* [n*] )
DUP2 STH2kr ADD2 LDA2k ( limit* pos* pos+i* x* [i*] )
2023-02-10 20:40:41 -05:00
#0200 ROT2 STA2 ( limit* pos* x* [i*] ; pos+i<-0200 )
2023-02-03 23:13:44 -05:00
OVR2 STA2 INC2 INC2 ( limit* pos+2* [i*] ; pos<-x )
GTH2k ?&loop ( limit* pos+2* [i*] )
POP2 POP2 POP2r ( )
2023-02-11 22:34:06 -05:00
#01 .dirty STZ JMP2r ( )
2023-01-29 23:07:03 -05:00
( starts below current line )
@delete-n-lines ( n* -> )
2023-02-03 23:13:44 -05:00
.col-bytes LDZ2 MUL2 STH2 ( [n*] )
limit-addr STH2kr SUB2 ( limit* [n*] )
eol-addr ( limit* start* [n*] )
2023-01-30 22:05:47 -05:00
!delete-n-chars/loop
2023-01-29 23:07:03 -05:00
2023-02-11 21:53:34 -05:00
@scroll ( -> BRK )
2023-01-30 22:05:47 -05:00
limit-addr STH2
2023-01-29 23:07:03 -05:00
;cells .col-bytes LDZ2 ADD2 STH2
2022-11-06 21:49:02 -05:00
&loop
STH2kr LDA2 #0200 STH2kr STA2
2023-01-29 23:07:03 -05:00
STH2kr .col-bytes LDZ2 SUB2 STA2
2023-01-30 22:05:47 -05:00
INC2r INC2r GTH2kr STHr ?&loop
2022-11-06 21:49:02 -05:00
POP2r POP2r
2023-02-09 20:56:08 -05:00
#01 .dirty STZ
2023-01-30 22:05:47 -05:00
draw-cursor BRK
2022-11-06 21:49:02 -05:00
2023-01-25 12:11:16 -05:00
( bits: Rx xx FF BB )
( - R: reversed [0=normal, 1=reversed] )
( - F: foreground [0:black, 1:dim, 2:normal, 3:bright] )
( - B: background [0:black, 1:dim, 2:normal, 3:bright] )
@update-tint ( -> )
.attr LDZ
2023-01-30 22:05:47 -05:00
DUP #80 LTH ?&ok
2023-01-25 12:11:16 -05:00
#80 EOR DUP #02 SFT SWP #20 SFT #0c AND ORA
2023-01-31 22:30:13 -05:00
&ok .tint STZ JMP2r
2022-11-06 21:49:02 -05:00
2023-01-25 12:11:16 -05:00
@reverse-tint ( tint^ -> tint^ )
#0f AND ( x=tint&0f )
DUP #02 SFT SWP ( x>>2 x )
#03 AND #20 SFT ( x>>2 (x&3)<<2 )
2023-01-31 22:30:13 -05:00
ORA ( res=40|x>>2|(x&3)<<2 )
2023-01-25 12:11:16 -05:00
JMP2r ( res^ )
2023-02-03 23:13:44 -05:00
( to draw a 12 pixel high character we first draw the top )
( 8 pixels and then we draw the bottom 8 pixels; there is )
( an overlap of 4 pixels. we do this to avoid drawing too )
( low which might overwrite characters on the next line. )
2023-01-25 12:11:16 -05:00
( cell* = tint^ c^ )
@draw-cell ( cell* -> )
2023-02-03 23:13:44 -05:00
SWP STH ( 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 ( )
2022-11-06 21:49:02 -05:00
2023-02-09 20:56:08 -05:00
@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^] )
.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 ( )
2023-02-11 21:53:34 -05:00
@next-arg ( c^ -> BRK )
2023-01-22 23:44:00 -05:00
POP
( TODO: check if we already have max args )
2023-01-25 12:40:46 -05:00
;args/pos LDA2k INC2 INC2 SWP2 STA2 BRK
2023-01-22 23:44:00 -05:00
2023-02-11 21:53:34 -05:00
@add-to-arg ( c^ -> BRK )
2023-02-03 23:13:44 -05:00
LIT "0 SUB LITr 00 STH ( [digit*] )
;args/pos LDA2 LDA2k ( addr* value* [digit*] )
#000a MUL2 STH2r ADD2 ( addr* value*10+digit )
2023-01-22 23:44:00 -05:00
SWP2 STA2 BRK
@read-arg-1 ( default* -> n* )
2023-01-30 22:05:47 -05:00
;args LDA2 !max
2023-01-22 23:44:00 -05:00
@read-arg-2 ( default* -> n* )
2023-01-30 22:05:47 -05:00
;args INC2 INC2 LDA2 !max
2023-01-22 23:44:00 -05:00
@reset-args ( -> )
;args ;args/pos STA2
#0000 ;args LITr f8
&loop STA2k INC2 INC2
2023-01-30 22:05:47 -05:00
INCr STHkr ?&loop
2023-01-22 23:44:00 -05:00
POPr POP2 POP2 JMP2r
( emit a short as a decimal )
@emit-dec2 ( n* -> )
LITr 00 ( n [0] )
&read ( n [k] )
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
2023-02-12 13:00:49 -05:00
ORAk ,&read JCN
POP2 ( top element was 0000 )
&write ( n0 n1 ... nk [k+1] )
NIP #30 ADD .Console/w DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
STHkr ,&write JCN
POPr JMP2r
2023-01-29 23:07:03 -05:00
@debug-log "debug_term.log 00
2023-01-25 23:37:56 -05:00
@scratch $40 &pos $2
@scratch-write ( c^ -> )
;scratch/pos LDA2 STA
;scratch/pos LDA2k INC2 SWP2 STA2 JMP2r
@scratch-len ( -> n* )
;scratch/pos LDA2 ;scratch SUB2 JMP2r
@reset-scratch
;scratch ;scratch/pos STA2 JMP2r
2023-01-23 20:54:52 -05:00
2023-01-22 23:44:00 -05:00
( store up to 8 arguments for control sequences )
@args $10 &pos $2
2023-02-03 23:13:44 -05:00
( 256 chars x 2 tiles/char x 8 bytes/tile = 4096 bytes )
( second tile only uses top 50% )
@cp437
~cp437.tal
2023-01-22 15:21:57 -05:00
2023-02-10 17:47:30 -05:00
@snarf ".snarf 00
2023-02-13 22:36:51 -05:00
@meta 00 &body
2023-01-30 23:01:34 -05:00
&name "determ 0a
&details "ansi 20 "terminal 20 "emulator 0a
&author "by 20 "d_m 0a
&date "3 20 "jan 20 2023 00
2023-02-13 22:36:51 -05:00
03
2023-01-31 15:37:14 -05:00
( device mask ) 41 0d07
2023-02-13 22:36:51 -05:00
( 24x24 icon ) 83 =icon-2-bit
( manifest ) a0 =manifest
@menu-noop ( -> )
JMP2r
@manifest
02 "Determ 00
00 00 =menu-noop "About 00
00 00 =menu-noop "Exit 00
01 "Edit 00
00 00 =menu-noop "Paste 00
02 "Settings 00
00 00 =menu-noop "Visual 20 "Bell 00 ( or Silent Bell )
00 00 =menu-noop "Enable 20 "Debug 20 00 ( or Disable Debug )
00
@icon-2-bit
00 00 00 1f 3f 38 32 34 00 00 00 00 00 07 0f 0f
00 00 00 ff ff 00 00 00 00 00 00 00 00 ff ff ff
00 00 00 f8 fc 1c 4c 2c 00 00 00 00 00 e0 f0 f0
34 30 30 30 30 30 30 30 0f 0f 0f 0f 0f 0f 0f 0f
00 00 00 00 00 00 00 00 ff ff ff ff ff ff ff ff
2c 0c 0c 0c 0c 0c 0c 0c f0 f0 f0 f0 f0 f0 f0 f0
34 34 32 38 3f 1e 07 00 0f 0f 0f 07 00 03 00 00
00 00 00 00 ff a0 ff 00 ff ff ff ff 00 ff 00 00
2c 2c 4c 1c fc 38 e0 00 f0 f0 f0 e0 00 c0 00 00
2023-01-30 23:01:34 -05:00
2023-02-09 23:32:44 -05:00
( paste buffer )
2023-02-10 17:47:30 -05:00
@paste-buf $0780 ( max 80 x 24 characters )
2023-02-09 23:32:44 -05:00
@paste-pos $2
2023-01-25 12:11:16 -05:00
( store tint+char for each screen position )
2023-02-03 23:13:44 -05:00
@cells
2023-02-13 23:22:52 -05:00