nxu/femto.tal

1668 lines
53 KiB
Tal
Raw Normal View History

2022-02-09 20:04:12 -05:00
( femto.tal )
( )
( requires terminal to be in raw mode )
2022-02-07 22:57:34 -05:00
( see femto launcher script for more details )
2022-02-06 17:07:11 -05:00
2022-02-11 19:15:40 -05:00
( TODO: )
( - get long line truncation/scrolling working )
2022-03-24 01:42:20 -04:00
( - allow line numbers to be toggled off )
2022-02-11 19:15:40 -05:00
( - open file command? )
( - close file command? )
( - search&replace )
2022-02-15 21:19:44 -05:00
2022-02-06 17:07:11 -05:00
|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ]
|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ]
|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ]
2022-04-10 02:05:09 -04:00
( MAX file size is currently #ce80, i.e. 52864 bytes )
2022-04-02 23:14:18 -04:00
2022-02-06 17:07:11 -05:00
%dbg { #ff .System/debug DEO }
%emit { .Console/write DEO }
%sp { #2018 DEO }
%nl { #0a18 DEO }
%cr { #0d18 DEO }
2022-04-12 12:15:42 -04:00
%crlf { cr nl }
2022-02-06 17:07:11 -05:00
%ansi { #1b18 DEO #5b18 DEO }
( emit macros )
( )
( these save one byte and are easier to read. )
%emit-! { LIT2 '! 18 DEO }
%emit-$ { LIT2 '$ 18 DEO }
2022-04-20 23:02:27 -04:00
%emit-lpar { LIT2 28 18 DEO }
%emit-rpar { LIT2 29 18 DEO }
%emit-, { LIT2 ', 18 DEO }
%emit-0 { LIT2 '0 18 DEO }
%emit-1 { LIT2 '1 18 DEO }
%emit-2 { LIT2 '2 18 DEO }
%emit-3 { LIT2 '3 18 DEO }
%emit-6 { LIT2 '6 18 DEO }
%emit-7 { LIT2 '7 18 DEO }
2022-04-06 20:39:02 -04:00
%emit-: { LIT2 ': 18 DEO }
%emit-; { LIT2 '; 18 DEO }
%emit-C { LIT2 'C 18 DEO }
%emit-H { LIT2 'H 18 DEO }
%emit-J { LIT2 'J 18 DEO }
%emit-K { LIT2 'K 18 DEO }
%emit-[ { LIT2 '[ 18 DEO }
2022-04-06 20:39:02 -04:00
%emit-] { LIT2 '] 18 DEO }
%emit-m { LIT2 'm 18 DEO }
%emit-n { LIT2 'n 18 DEO }
%emit-~ { LIT2 '~ 18 DEO }
2022-03-08 23:31:12 -05:00
%quit! { #01 .System/halt DEO BRK }
2022-04-01 23:47:37 -04:00
%lmargin { #0006 }
2022-03-07 12:56:52 -05:00
( zero page )
|0000
2022-04-04 00:40:37 -04:00
( terminal size information )
2022-04-07 00:16:25 -04:00
( )
( for now these are constant but eventually we could detect terminal resizes )
2022-03-07 22:38:02 -05:00
@term [
2022-03-24 01:42:20 -04:00
&cols $2 ( relative x coordinate of cursor, from 0 )
&rows $2 ( relative y coordinate of cursor, from 1 )
2022-03-07 22:38:02 -05:00
]
2022-04-04 00:40:37 -04:00
( configuration settings used when editing )
2022-04-07 00:16:25 -04:00
( )
( these can be changed at any time without breaking anything else )
2022-03-07 22:38:02 -05:00
@config [
2022-04-06 20:39:02 -04:00
&tab-width $2 ( how many spaces to display tab chars )
&insert-tabs $1 ( tab key inserts tabs when true )
&color $2 ( digits of highlight color in reverse order )
2022-03-07 22:38:02 -05:00
]
2022-04-04 00:40:37 -04:00
( tracks information related to the buffer's view of data )
2022-04-07 00:16:25 -04:00
( )
( limit and line-count change when we modify the buffer. )
( offset and line-offset change when we move the view port. )
2022-03-07 22:38:02 -05:00
@buffer [
&limit $2 ( last byte of actual data (not including \0) + 1 )
&line-count $2 ( total number of lines in file )
2022-04-07 00:16:25 -04:00
&offset $2 ( first byte of data visible in terminal )
2022-03-07 22:38:02 -05:00
&line-offset $2 ( first line of text visible in terminal )
]
( relative cursor positions, e.g. 0 to cols-1 )
2022-04-07 00:16:25 -04:00
( )
( when these change we may need to move the view port as well )
2022-03-07 22:38:02 -05:00
@cursor [
&col $2 ( current column value 0-n (may exceed lenght of row) )
&row $2 ( current relative row value, 0-(height-1) )
]
2022-04-04 00:40:37 -04:00
( tracks overall editor state between events )
2022-03-07 22:38:02 -05:00
@state [
&in-help $1 ( are we showing help? )
2022-04-08 23:52:07 -04:00
&in-undo $1 ( are we currently in undo? )
2022-03-30 23:41:16 -04:00
&key $1 ( last key read )
2022-03-07 22:38:02 -05:00
&saw-esc $1 ( did we just see ESC? )
2022-03-24 01:26:06 -04:00
&saw-xterm $1 ( did we just see an ESC [ xterm sequence? )
&saw-vt $1 ( did we just see an ESC [ $N vt sequence? )
2022-03-30 01:26:33 -04:00
&redraw $1 ( redrawing: bits determine which parts )
( 0x01 cursor )
( 0x02 statusbar )
( 0x04 prompt )
( 0x08 matches )
( 0x10 body and everything else )
2022-04-01 23:47:37 -04:00
&message $1 ( did we just print a message? )
2022-03-23 22:55:03 -04:00
&modified $1 ( has the buffer been modified? )
&quitting $1 ( are we in the process of quitting? )
2022-03-07 22:38:02 -05:00
]
( prompt uses .tmp/pos and .tmp/data to track user input )
@prompt [
&active $1 ( is prompt currently active? )
&vector $2 ( what code to run when user responds )
2022-03-23 21:46:59 -04:00
&string $2 ( string to print for the prompt )
2022-03-07 22:38:02 -05:00
]
2022-04-04 00:40:37 -04:00
( temporary input buffer used for a variety of things )
2022-03-07 22:38:02 -05:00
@tmp [
&pos $2 ( temporary pointer to address when reading data )
2022-04-04 00:40:37 -04:00
&data $80 ( small scratch pad when reading data )
2022-03-07 22:38:02 -05:00
]
2022-03-29 00:02:22 -04:00
( search uses .tmp/pos and .tmp/data to track query string )
@searching [
2022-03-31 23:21:49 -04:00
&active $1 ( are we displaying search results? )
&orig-row $2 ( row we began the search at )
&orig-col $2 ( col we began the search at )
&regex $2 ( regex to be stored if any )
&start $2 ( absolute start pos of match )
&end $2 ( absolute limit pos of match )
2022-03-29 00:02:22 -04:00
]
2022-02-17 23:33:48 -05:00
( startup )
2022-03-07 22:38:02 -05:00
|0100
2022-04-07 00:16:25 -04:00
( init zero page )
2022-03-07 22:38:02 -05:00
#0050 .term/cols STZ2
#0018 .term/rows STZ2
#0004 .config/tab-width STZ2
2022-03-25 00:12:09 -04:00
#00 .config/insert-tabs STZ
2022-03-07 22:38:02 -05:00
#3333 .config/color STZ2
;data .buffer/offset STZ2
2022-02-06 17:07:11 -05:00
2022-04-07 00:16:25 -04:00
( start reading the filename from argv )
2022-03-07 22:38:02 -05:00
;filename .tmp/pos STZ2
;read-filename .Console/vector DEO2
BRK
2022-02-09 02:35:46 -05:00
2022-04-07 00:16:25 -04:00
( import uxn regex library )
~regex.tal
2022-02-13 14:46:50 -05:00
( ERROR HANDLING )
( using error! will print the given message before causing )
( the interpreter to halt. )
@error! ( msg* -> )
2022-04-09 00:16:22 -04:00
emit-! sp ;print JSR2 nl dbg BRK
2022-02-13 14:46:50 -05:00
2022-04-04 00:40:37 -04:00
( open the given file at editor start up )
( )
( this is called during startup by ;read-filename )
( )
( TODO: enable closing/opening files with editor already running )
2022-02-09 02:35:46 -05:00
@open-file ( filename* -> )
2022-02-09 20:04:12 -05:00
.File/name DEO2
2022-04-10 02:05:09 -04:00
#ce81 .File/length DEO2
2022-03-07 22:38:02 -05:00
;data .File/read DEO2
2022-02-06 17:07:11 -05:00
2022-04-09 00:05:12 -04:00
.File/success DEI2 #0000 EQU2 .state/modified STZ
2022-04-10 02:05:09 -04:00
.File/success DEI2 #ce81 LTH2 ,&ok JCN
2022-04-12 12:15:42 -04:00
crlf
2022-03-08 23:31:12 -05:00
;messages/input-error ;print JSR2
2022-04-12 12:15:42 -04:00
;filename ;print JSR2 crlf quit!
2022-02-06 17:07:11 -05:00
2022-02-09 20:04:12 -05:00
( calculate buffer limit address using start + size )
2022-03-07 22:38:02 -05:00
&ok .File/success DEI2 ;data ADD2 .buffer/limit STZ2
2022-02-09 02:35:46 -05:00
JMP2r
2022-02-09 01:05:11 -05:00
2022-04-04 00:40:37 -04:00
( ask the terminal for its size )
( )
( called during editor initialization by ;read-filename )
( )
( TODO: consider supporting terminal resizing )
2022-02-18 00:20:09 -05:00
@setup-terminal-size ( -> )
2022-03-25 23:17:34 -04:00
#03e7 DUP2 ;term-move-cursor JSR2
2022-02-09 02:35:46 -05:00
;term-get-cursor-position JSR2
2022-03-07 22:38:02 -05:00
;tmp/data .tmp/pos STZ2
2022-02-09 02:35:46 -05:00
;receive-terminal-size .Console/vector DEO2
JMP2r
2022-04-04 00:40:37 -04:00
( receive size information from the terminal )
( )
( called from Console/vector after ;setup-terminal-size )
2022-02-18 00:20:09 -05:00
@receive-terminal-size ( -> )
2022-03-30 23:41:16 -04:00
.Console/read DEI .state/key STZ
.state/key LDZ .tmp/pos LDZ2 STA
2022-03-07 22:38:02 -05:00
.tmp/pos LDZ2 INC2 .tmp/pos STZ2
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT 'R EQU ;parse-terminal-size JCN2
2022-02-09 02:35:46 -05:00
BRK
2022-04-04 00:40:37 -04:00
( parse and store terminal size information )
( )
( called by ;receive-terminal-size after complete message received )
2022-02-09 02:35:46 -05:00
@parse-terminal-size ( -> )
2022-04-06 20:39:02 -04:00
#0000 ,&acc STR2
2022-03-07 22:38:02 -05:00
.tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC
LDZk LIT '[ NEQ ,&parse-error JCN ( i ) INC
2022-02-09 02:35:46 -05:00
&loop
2022-03-07 22:38:02 -05:00
LDZk LIT '; EQU ,&parse-col JCN
2022-04-06 20:39:02 -04:00
LIT2r :&loop ,&read JMP
2022-02-09 02:35:46 -05:00
&parse-col
2022-04-06 20:39:02 -04:00
INC ,&acc LDR2 #0002 SUB2 .term/rows STZ2
#0000 ,&acc STR2
2022-02-09 02:35:46 -05:00
&loop2
2022-03-07 22:38:02 -05:00
LDZk LIT 'R EQU ,&done JCN
2022-04-06 20:39:02 -04:00
LIT2r :&loop2 ,&read JMP
&read
LDZk LIT '0 SUB #00 SWP
,&acc LDR2 #000a MUL2 ADD2 ,&acc STR2
INC JMP2r
2022-02-09 02:35:46 -05:00
&done
2022-04-06 20:39:02 -04:00
,&acc LDR2 .term/cols STZ2 POP
2022-02-09 02:35:46 -05:00
;on-key .Console/vector DEO2
;draw-all JSR2
BRK
2022-04-06 20:39:02 -04:00
[ &acc $2 ]
2022-03-07 22:38:02 -05:00
&parse-error POP .tmp/data LDZ2
2022-03-25 00:12:09 -04:00
;messages/term-size-parse-error ;error! JMP2
2022-02-09 02:35:46 -05:00
2022-04-06 20:39:02 -04:00
@count-c ( c^ -> n* )
#0000 ,&count STR2
STH ;data
2022-04-06 22:41:25 -04:00
&loop LDAk #00 EQU ,&done JCN
2022-04-06 20:39:02 -04:00
LDAk STHkr NEQ ,&next JCN
,&count LDR2 INC2 ,&count STR2
&next INC2 ,&loop JMP
&done POP2 POPr ,&count LDR2 JMP2r [ &count $2 ]
2022-04-04 00:40:37 -04:00
( save count of number of lines in input file )
( )
( this method also detects whether \t characters are used, )
( and uses this to initialize config/insert-tabs. )
2022-02-11 15:39:49 -05:00
@setup-linecount ( -> )
2022-04-06 20:39:02 -04:00
#0a ;count-c JSR2 INC2 .buffer/line-count STZ2
#09 ;count-c JSR2 #0000 GTH2 .config/insert-tabs STZ
2022-04-06 22:41:25 -04:00
JMP2r
2022-02-11 15:39:49 -05:00
2022-04-04 00:40:37 -04:00
( reads filename from the program's argv )
( )
( currently femto must be given a file to edit, and reading this )
( filename is the first thing that happens in ;startup. )
( )
( TODO: support other situations, such as: )
( - launching femto without a file name )
( - closing the given file and opening a new one )
2022-02-09 02:35:46 -05:00
@read-filename ( -> )
2022-02-11 15:39:49 -05:00
#12 DEI #0a EQU ,&execute JCN ( did we read \n ? )
2022-03-07 22:38:02 -05:00
#12 DEI .tmp/pos LDZ2 STA ( no, so save in buffer )
.tmp/pos LDZ2 INC2 .tmp/pos STZ2 ( pos++ )
2022-02-11 15:39:49 -05:00
BRK ( return )
&execute ( we saw a newline, so do something )
2022-03-07 22:38:02 -05:00
#00 .tmp/pos LDZ2 STA ( null terminate str )
2022-02-11 15:39:49 -05:00
;filename ;open-file JSR2 ( open file )
;setup-linecount JSR2 ( determine # of lines )
;setup-terminal-size JSR2 ( detect terminal dimensions )
2022-02-06 17:07:11 -05:00
BRK
2022-04-04 00:40:37 -04:00
( jump to beginning of line )
2022-02-18 00:20:09 -05:00
@bol ( -> )
2022-03-07 22:38:02 -05:00
#0000 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-statusbar-and-cursor JSR2
;return JMP2
2022-02-06 17:07:11 -05:00
2022-04-04 00:40:37 -04:00
( jump to beginning of line )
2022-02-18 00:20:09 -05:00
@eol ( -> )
2022-04-01 23:47:37 -04:00
;cur-len JSR2 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-statusbar-and-cursor JSR2
;return JMP2
2022-02-06 17:07:11 -05:00
2022-02-18 00:20:09 -05:00
@forward ( -> )
2022-04-06 23:26:07 -04:00
;go-forward JSR2 ;return JMP2
( move forward by one character )
@go-forward ( -> )
;cur-pos JSR2 ;last-pos JSR2 GTH2 ( ;return JCN2 ) ,&noop JCN
2022-04-06 20:39:02 -04:00
;redraw-statusbar-and-cursor JSR2
;cur-col JSR2 ;cur-len JSR2 LTH2 ,&normal JCN
#0000 .cursor/col STZ2
.cursor/row LDZ2 INC2 .cursor/row STZ2
2022-04-06 23:26:07 -04:00
;ensure-visible-cursor JMP2
2022-03-25 23:17:34 -04:00
&normal
;cur-col JSR2 INC2 .cursor/col STZ2
2022-04-06 23:26:07 -04:00
&noop JMP2r
2022-02-06 17:07:11 -05:00
2022-04-04 00:40:37 -04:00
( move backward by one character )
@back ( -> )
;go-back JSR2 ;return JMP2
( internal implementation shared by ;back and ;backspace )
2022-03-30 01:26:33 -04:00
@go-back ( -> )
2022-04-01 23:47:37 -04:00
;cur-pos JSR2 ;data EQU2 ,&noop JCN
2022-03-25 23:17:34 -04:00
;cur-col JSR2 #0001 LTH2 ,&next-line JCN
2022-04-01 23:47:37 -04:00
;cur-col JSR2 #0001 SUB2 .cursor/col STZ2
;redraw-statusbar-and-cursor JMP2
2022-03-25 23:17:34 -04:00
&next-line
2022-04-01 23:47:37 -04:00
.cursor/row LDZ2k #0001 SUB2 ROT STZ2
2022-03-25 23:17:34 -04:00
;cur-len JSR2 .cursor/col STZ2
2022-04-01 23:47:37 -04:00
;ensure-visible-cursor JSR2
;redraw-statusbar-and-cursor JSR2
&noop JMP2r
2022-03-30 01:26:33 -04:00
2022-04-04 00:40:37 -04:00
( move up by one line )
2022-02-18 00:20:09 -05:00
@up ( -> )
2022-04-01 23:47:37 -04:00
.cursor/row LDZ2 #0000 EQU2 ;return JCN2
2022-04-01 00:44:07 -04:00
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
;ensure-visible-cursor JSR2
2022-04-01 23:47:37 -04:00
;redraw-statusbar-and-cursor JSR2
;return JMP2
2022-04-04 00:40:37 -04:00
( move down by one line )
2022-02-18 00:20:09 -05:00
@down ( -> )
2022-04-04 00:40:37 -04:00
.cursor/row LDZ2
.buffer/line-count LDZ2 #0001 SUB2 EQU2 ;return JCN2
2022-04-01 00:44:07 -04:00
.cursor/row LDZ2 INC2 .cursor/row STZ2
2022-02-14 16:47:36 -05:00
;ensure-visible-cursor JSR2
2022-04-01 23:47:37 -04:00
;redraw-statusbar-and-cursor JSR2
;return JMP2
2022-02-06 17:07:11 -05:00
2022-04-06 23:26:07 -04:00
@is-word-char ( c^ -> bool^ )
DUP #2f GTH OVR #3a LTH AND STH
DUP #40 GTH OVR #5b LTH AND STH ORAr
DUP #60 GTH SWP #7b LTH AND STHr ORA JMP2r
@not-word-char ( c^ -> bool^ )
;is-word-char JSR2 #00 EQU JMP2r
@forward-by-word ( -> )
;cur-pos JSR2
&first
LDAk #00 EQU ,&done JCN
LDAk ;is-word-char JSR2 ,&second JCN
INC2 ;go-forward JSR2 ,&first JMP
&second
LDAk #00 EQU ,&done JCN
LDAk ;not-word-char JSR2 ,&done JCN
INC2 ;go-forward JSR2 ,&second JMP
&done
POP2 ;return JMP2
@back-by-word ( -> )
;cur-pos JSR2 #0001 SUB2
&first
DUP2 ;data LTH2 ,&done JCN
LDAk ;is-word-char JSR2 ,&second JCN
#0001 SUB2 ;go-back JSR2 ,&first JMP
&second
DUP2 ;data LTH2 ,&done JCN
LDAk ;not-word-char JSR2 ,&done JCN
#0001 SUB2 ;go-back JSR2 ,&second JMP
&done
POP2 ;return JMP2
@help
#01 .state/in-help STZ
;term-erase-all JSR2
#0000 #0000 ;term-move-cursor JSR2
;emit-color-bold JSR2
;help-text ;print JSR2
;emit-reset JSR2
;redraw-all JSR2
BRK
2022-04-04 00:40:37 -04:00
( center buffer view on the current line )
@center-view
2022-03-31 01:52:20 -04:00
.term/rows LDZ2 INC2 #0002 DIV2 STH2k
.cursor/row LDZ2 LTH2 ,&standard JCN
POP2r
#0000 .buffer/line-offset STZ2
;data .buffer/offset STZ2
,&done JMP
&standard
.cursor/row LDZ2 STH2r SUB2
DUP2 .buffer/line-offset STZ2
;abs-line JSR2 .buffer/offset STZ2
&done
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-04-04 00:40:37 -04:00
( move up by one page )
@page-up ( -> )
.term/rows LDZ2 #0002 SUB2 STH2k
.buffer/line-offset LDZ2 LTH2 ,&move-full JCN
POP2r
;zero-row JSR2
2022-03-07 22:38:02 -05:00
#0000 .cursor/col STZ2
,&done JMP
&move-full
.cursor/row LDZ2 STH2kr SUB2 .cursor/row STZ2
.buffer/line-offset LDZ2 STH2r SUB2
DUP2 .buffer/line-offset STZ2
;abs-line JSR2 .buffer/offset STZ2
&done
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-04-04 00:40:37 -04:00
( move down by one page )
2022-02-15 21:58:12 -05:00
@page-down
;eof-is-visible JSR2 ,&near-eof JCN
.term/rows LDZ2 #0002 SUB2 STH2k
.buffer/line-offset LDZ2 ADD2
DUP2 .buffer/line-offset STZ2
;abs-line JSR2 .buffer/offset STZ2
.cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-02-15 21:58:12 -05:00
&near-eof
2022-04-01 23:47:37 -04:00
.buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
2022-03-07 22:38:02 -05:00
;cur-len JSR2 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-cursor JSR2 ;return JMP2
2022-02-15 21:58:12 -05:00
2022-04-04 00:40:37 -04:00
( return true if the end of the file is visible )
@eof-is-visible ( -> bool^ )
.buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2
.buffer/line-count LDZ2
GTH2 JMP2r
( beginning quitting femto, prompting if unsaved changes )
2022-03-23 22:55:03 -04:00
@quit
#01 .state/quitting STZ
2022-04-08 23:52:07 -04:00
.state/modified LDZ #00 EQU ;quit-now JCN2
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2
2022-02-07 22:25:32 -05:00
2022-04-04 00:40:37 -04:00
( display two strings on the message line )
( )
( often this involves a static messages + an argument like ;tmp/data. )
( )
( use messages/null for the second string if only one is needed. )
2022-04-01 23:47:37 -04:00
@send-message ( s1* s2* -> )
#01 .state/message STZ
;move-to-message-line JSR2
SWP2 ;print JSR2 ;print JMP2
2022-04-04 00:40:37 -04:00
( callback executed in response to the quit prompt. )
2022-03-23 22:55:03 -04:00
@do-quit
.tmp/data LDZ LIT 'n EQU ;quit-now JCN2
.tmp/data LDZ LIT 'y EQU ;save JCN2
#00 .state/quitting STZ
2022-04-01 23:47:37 -04:00
;messages/unknown-input ;tmp/data ;send-message JSR2
2022-03-23 22:55:03 -04:00
BRK
2022-04-04 00:40:37 -04:00
( label that calls quit! )
( )
( this definition is needed so the address can be used by JCN2. )
2022-03-23 22:55:03 -04:00
@quit-now quit!
2022-04-04 00:40:37 -04:00
( label that calls BRK )
( )
( this definition is needed so the address can be used by JCN2. )
2022-03-23 22:55:03 -04:00
@ignore
2022-04-04 00:40:37 -04:00
BRK
2022-02-07 22:25:32 -05:00
2022-04-04 00:40:37 -04:00
( insert the given character at the cursor position )
( )
( this should not be called for newlines, see ;newline )
2022-02-06 17:07:11 -05:00
@insert ( c^ -> )
;cur-pos JSR2 ;shift-right JSR2
2022-03-07 22:38:02 -05:00
;cur-col JSR2 INC2 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-02-07 22:25:32 -05:00
2022-04-04 00:40:37 -04:00
( insert the given character in the prompt )
2022-03-23 22:12:17 -04:00
@insert-prompt ( c^ -> )
.tmp/pos LDZ2 STH2k STA ( data[pos] <- c )
INC2r #00 STH2kr STA ( data[pos+1] <- 0 )
STH2r .tmp/pos STZ2 ( pos <- pos+1 )
2022-03-30 01:26:33 -04:00
;redraw-prompt-and-cursor JSR2 ;return JMP2
2022-03-23 22:12:17 -04:00
2022-04-04 00:40:37 -04:00
( insert a tab at the cursor position )
( )
( depending on the state of config/insert-tabs this will )
( either call ;insert with \t or else insert a number of )
( spaces based on .config/tab-width. )
@insert-tab ( -> )
2022-03-07 22:38:02 -05:00
.config/insert-tabs LDZ ,&use-tabs JCN
#0000 .config/tab-width LDZ2 SUB2
&loop
DUP2 #0000 EQU2 ,&done JCN
#20 ;cur-pos JSR2 ;shift-right JSR2
INC2 ,&loop JMP
&done
2022-03-07 22:38:02 -05:00
;cur-col JSR2 .config/tab-width LDZ2 ADD2 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
&use-tabs
#09 ;insert JMP2
2022-04-04 00:40:37 -04:00
( insert a newline at the cursor position )
2022-02-07 22:25:32 -05:00
@newline ( c^ -> )
#0a ;cur-pos JSR2 ;shift-right JSR2
2022-03-07 22:38:02 -05:00
#0000 .cursor/col STZ2
2022-04-01 00:44:07 -04:00
.cursor/row LDZ2 INC2 .cursor/row STZ2
2022-03-23 21:46:59 -04:00
.buffer/line-count LDZ2k INC2 ROT STZ2
2022-02-15 21:19:44 -05:00
;ensure-visible-cursor JSR2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-02-07 22:25:32 -05:00
2022-04-04 00:40:37 -04:00
( delete the character to the left of the cursor, if any )
2022-02-06 17:07:11 -05:00
@backspace ( -> )
2022-04-01 23:47:37 -04:00
;cur-pos JSR2 ;data EQU2 ;return JCN2
;go-back JSR2 ;delete JMP2
2022-03-25 23:17:34 -04:00
2022-04-04 00:40:37 -04:00
( delete the last character in the prompt )
2022-03-23 22:12:17 -04:00
@backspace-prompt ( -> )
2022-04-01 23:47:37 -04:00
.tmp/pos LDZ2 ;tmp/data EQU2 ,&skip JCN ( ;return JCN2 )
2022-03-23 22:12:17 -04:00
#00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 )
STH2k STA ( data[pos-1] <- 0 )
STH2r .tmp/pos STZ2 ( pos <- pos-1 )
2022-04-01 23:47:37 -04:00
&skip ;redraw-prompt-and-cursor JSR2 ;return JMP2
2022-03-23 22:12:17 -04:00
2022-04-04 00:40:37 -04:00
( delete the character under the cursor, if any )
2022-02-07 22:25:32 -05:00
@delete ( -> )
2022-04-01 23:47:37 -04:00
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
2022-02-13 14:46:50 -05:00
;cur-pos JSR2 LDAk STH ( cur [c] )
;shift-left JSR2 ( [c] )
2022-02-11 15:39:49 -05:00
STHr #0a NEQ ,&not-newline JCN
2022-03-23 21:46:59 -04:00
.buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
2022-03-30 01:26:33 -04:00
&not-newline ;redraw-all JSR2 ;return JMP2
2022-02-06 17:07:11 -05:00
2022-04-04 00:40:37 -04:00
( used at the start of an escape sequence to set up state. )
( )
( many keys such as page-down will actually send an escape character )
( followed by others. to support these we use saw-esc to interpret )
( input characters differently. )
( )
( see also state/saw-xterm which supports such sequences. )
2022-02-08 22:22:08 -05:00
@escape ( -> )
2022-03-07 22:38:02 -05:00
#01 .state/saw-esc STZ BRK
2022-02-08 22:22:08 -05:00
2022-04-04 00:40:37 -04:00
( move to the end of the file )
2022-02-12 02:25:41 -05:00
@goto-end ( -> )
.buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
.buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ,&use-zero JCN
SUB2 #0002 ADD2 ,&continue JMP
&use-zero
POP2 POP2 #0000
2022-02-13 14:46:50 -05:00
&continue
2022-03-07 22:38:02 -05:00
DUP2 .buffer/line-offset STZ2
;abs-line JSR2 .buffer/offset STZ2
;cur-len JSR2 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-02-12 02:25:41 -05:00
2022-04-04 00:40:37 -04:00
( move to the start of the file )
2022-02-08 22:22:08 -05:00
@goto-start ( -> )
;zero-row JSR2
2022-03-07 22:38:02 -05:00
#0000 .cursor/col STZ2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-04-04 00:40:37 -04:00
( prompt for a line number and move to that line )
2022-02-10 01:40:48 -05:00
@goto-line ( -> )
2022-03-24 00:09:55 -04:00
;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2
2022-03-30 01:26:33 -04:00
;redraw-prompt-and-cursor JSR2 ;return JMP2
2022-03-24 00:09:55 -04:00
2022-04-04 00:40:37 -04:00
( parse the given string as a decimal number )
( )
( returns the number as a short followed by whether parsing was ok )
2022-03-24 00:09:55 -04:00
@parse-decimal-number ( addr* -> n* ok^ )
LDAk ,&non-empty JCN
#00 JMP2r
&non-empty
LIT2r 0000
&loop
LDAk ,&continue JCN
POP2 STH2r #01 JMP2r
&continue
LDAk LIT '0 LTH ,&fail JCN
LDAk LIT '9 GTH ,&fail JCN
LIT2r 000a MUL2r
LDAk LIT '0 SUB #00 SWP STH2 ADD2r
INC2 ,&loop JMP
&fail
POP2r #00 JMP2r
2022-04-04 00:40:37 -04:00
( go to the given line number )
( )
( this is used as a callback from the goto-line prompt )
@do-goto-line ( n* -> )
2022-03-24 00:09:55 -04:00
;tmp/data ;parse-decimal-number JSR2
,&ok JCN
2022-04-01 23:47:37 -04:00
;messages/unknown-input ;tmp/data ;send-message JSR2
2022-03-30 01:26:33 -04:00
;return JMP2
2022-03-24 00:09:55 -04:00
&ok
#0001 SUB2 ( convert 1-indexing to 0-indexing )
DUP2 .buffer/line-count LDZ2 LTH2 ,&within JCN
POP2 ;goto-end JMP2
&within
;jump-to-line JSR2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2 ;return JMP2
2022-02-10 01:40:48 -05:00
2022-04-04 00:40:37 -04:00
( move the cursor to the given coordinates )
( )
( this won't move the display if the given coordinates are visible. )
2022-03-31 13:48:08 -04:00
@move-to-coord ( col* row* -> )
DUP2 ;line-is-visible JSR2 ;jump-to-coord/short JCN2
;jump-to-coord JMP2
2022-04-04 00:40:37 -04:00
( move the cursor to the given coordinates )
( )
( this will always ensure the display is centered on the given coordinates )
2022-03-31 13:48:08 -04:00
@jump-to-coord ( x* y* -> )
.term/rows LDZ2 INC2 #0002 DIV2 LTH2k ( x y rows/2 y<rows/2? ) ,&early JCN
OVR2 SWP2 SUB2 ( x y y-rows/2 )
.buffer/line-count LDZ2 ( x y y-rows/2 lines )
.term/rows LDZ2 SUB2 ( x y y-rows/2 lines-rows )
GTH2k ( x y y-rows/2 lines-rows y-rows/2>lines-rows? )
,&late JCN ( x y y-rows/2 lines-rows )
2022-02-10 01:40:48 -05:00
POP2 ,&finish JMP
2022-03-31 13:48:08 -04:00
&early ( x y rows/2 )
POP2 #0000 ,&finish JMP ( x y 0000 )
&late ( x y y-rows/2 lines-rows )
2022-02-14 16:47:36 -05:00
NIP2
2022-03-31 13:48:08 -04:00
&finish ( x y o )
;redraw-all JSR2
SUB2k STH2 DUP2 ( x y o o [y-o] )
.buffer/line-offset STZ2 ( x y o [y-o] )
;abs-line JSR2 .buffer/offset STZ2 ( x y [y-o] )
POP2r
&short
;redraw-statusbar-and-cursor JSR2
.cursor/row STZ2 ( x )
.cursor/col STZ2
2022-02-10 01:40:48 -05:00
JMP2r
2022-04-04 00:40:37 -04:00
( jump to the given line number )
2022-03-31 13:48:08 -04:00
@jump-to-line ( n* -> )
#0000 SWP2 ;jump-to-coord JMP2
2022-04-04 00:40:37 -04:00
( ensure the cursor is visibe )
( )
( if the cursor is not already visible the screen will be )
( centered on the cursor's coordinates. )
2022-03-07 22:38:02 -05:00
@ensure-visible-cursor
.cursor/row LDZ2 .buffer/line-offset LDZ2
SUB2 .term/rows LDZ2 LTH2 ,&noop JCN
2022-04-01 23:47:37 -04:00
.cursor/row LDZ2 ;jump-to-line JSR2
2022-03-30 01:26:33 -04:00
;redraw-all JSR2
2022-02-14 16:47:36 -05:00
&noop JMP2r
2022-04-04 00:40:37 -04:00
( currently used to print stack information. )
2022-02-13 14:46:50 -05:00
@debug
2022-04-08 23:52:07 -04:00
;messages/input-error ;error! JMP2
2022-02-13 14:46:50 -05:00
2022-04-04 00:40:37 -04:00
( move the terminal's cursor to the message line )
( )
( this low level method does not change any editor state (such as )
( the cursor) but is used to display messages. )
2022-02-15 21:19:44 -05:00
@move-to-message-line ( -> )
2022-03-23 22:12:17 -04:00
#0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2
2022-02-15 21:19:44 -05:00
2022-04-04 00:40:37 -04:00
( start a prompt on the message line )
( )
( the arguments are as follows: )
( - the prompt string will printed in bold )
( - the default string will be editable )
( - the vector address will be used on return )
( )
( prompts can always be cancelled using C-g. )
( )
( when called vector should end in a BRK instructinon. )
2022-03-23 21:46:59 -04:00
@start-prompt ( prompt* default* vector* -> )
.prompt/active LDZ ,&is-active JCN
#01 .prompt/active STZ ( prompt/active <- 1 )
.prompt/vector STZ2 ( prompt/vector <- vector )
2022-04-11 21:57:45 -04:00
;tmp/data ;str-copy JSR2 ( tmp/data <- default )
2022-04-10 02:05:09 -04:00
;tmp/data ADD2 .tmp/pos STZ2 ( tmp/pos <- len(default)+data )
2022-03-23 21:46:59 -04:00
.prompt/string STZ2 ( prompt/string <- prompt )
JMP2r
&is-active
#0000 DIV
( ends prompt without calling vector )
@cancel-prompt ( -> )
2022-04-01 23:47:37 -04:00
#00 .prompt/active STZ
#00 .state/quitting STZ
;clear-message-line JSR2
;redraw-prompt-and-cursor JSR2
;return JMP2
2022-03-23 21:46:59 -04:00
2022-04-04 00:40:37 -04:00
( finishes prompt and executes callback )
( )
( when called vector should end in a BRK instruction )
2022-03-23 21:46:59 -04:00
@finish-prompt ( -> )
2022-04-01 23:47:37 -04:00
#00 .prompt/active STZ
;clear-message-line JSR2
;redraw-prompt-and-cursor JSR2
.prompt/vector LDZ2 JMP2
2022-03-23 21:46:59 -04:00
2022-04-04 00:40:37 -04:00
( begin saving the file, prompting the user for a fiel name )
2022-03-23 21:46:59 -04:00
@save
;messages/save-prompt ;filename ;do-save ;start-prompt JSR2
2022-04-01 23:47:37 -04:00
;redraw-prompt-and-cursor JSR2
;return JMP2
2022-03-23 21:46:59 -04:00
2022-04-04 00:40:37 -04:00
( save the file with the filename found in tmp/data )
2022-03-23 21:46:59 -04:00
@do-save ( -> )
2022-03-07 22:38:02 -05:00
.buffer/limit LDZ2 ;data SUB2 STH2 ( [size] )
2022-03-23 21:46:59 -04:00
;tmp/data .File/name DEO2
STH2kr .File/length DEO2
;data .File/write DEO2
2022-02-15 21:19:44 -05:00
2022-04-09 00:44:14 -04:00
.File/success DEI2 STH2r EQU2 ,&ok JCN
2022-03-24 01:26:06 -04:00
;messages/save-failed ,&finish JMP
&ok
#00 .state/modified STZ
2022-04-10 02:05:09 -04:00
;tmp/data ;filename ;str-copy JSR2 POP2
2022-04-01 23:47:37 -04:00
;messages/save-ok
2022-03-23 22:55:03 -04:00
&finish
2022-04-01 23:47:37 -04:00
;tmp/data ;send-message JSR2
2022-03-23 22:55:03 -04:00
.state/quitting LDZ ;quit-now JCN2
2022-04-09 00:44:14 -04:00
#03 .state/redraw STZ ( FIXME: why do we have to do this? )
2022-03-30 01:26:33 -04:00
;return JMP2
2022-02-15 21:19:44 -05:00
2022-04-04 00:40:37 -04:00
( begin a search, prompting for a search string )
2022-03-29 00:02:22 -04:00
@search ( -> )
;messages/search-prompt ;messages/null ;do-search ;start-prompt JSR2
2022-04-01 23:47:37 -04:00
;redraw-prompt-and-cursor JSR2
;return JMP2
2022-03-29 00:02:22 -04:00
2022-04-04 00:40:37 -04:00
( execute a search, using the given search string )
2022-03-29 00:02:22 -04:00
@do-search ( -> )
.cursor/row LDZ2 .searching/orig-row STZ2
.cursor/col LDZ2 .searching/orig-col STZ2
#0000 .searching/regex STZ2
2022-03-31 23:21:49 -04:00
;move-to-next-match JSR2 ,&found JCN
2022-04-01 23:47:37 -04:00
;move-to-prev-match JSR2 ,&found JCN
;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
&found
#01 .searching/active STZ
;redraw-matches JSR2
;return JMP2
2022-03-31 23:21:49 -04:00
2022-04-04 00:40:37 -04:00
( begin a search, prompting for a regular expression )
@regex-search ( -> )
2022-03-31 23:21:49 -04:00
;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2
2022-04-04 00:40:37 -04:00
( execute a search, using the given regular expressions )
( )
( TODO: handle invalid regular expressions that fail to compile )
2022-03-31 23:21:49 -04:00
@do-regex-search ( -> )
;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2
.cursor/row LDZ2 .searching/orig-row STZ2
.cursor/col LDZ2 .searching/orig-col STZ2
;tmp/data ;compile JSR2 .searching/regex STZ2
2022-03-31 23:21:49 -04:00
;move-to-next-regex-match JSR2 ,&found JCN
2022-04-01 23:47:37 -04:00
;move-to-prev-regex-match JSR2 ,&found JCN
;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK
&found
#01 .searching/active STZ
;redraw-matches JSR2
;return JMP2
2022-03-29 00:02:22 -04:00
2022-04-04 00:40:37 -04:00
( toggle the color used by the terminal )
( )
( available colors are: )
( - black )
( - red )
( - green )
( - yellow )
( - blue )
( - magenta )
( - cyan )
( - white )
2022-03-24 01:35:35 -04:00
@toggle-color ( -> )
.config/color LDZ2 #3733 EQU2 ,&wrap-around JCN
.config/color LDZ2 #0100 ADD2 .config/color STZ2 ,&done JMP
&wrap-around #3033 .config/color STZ2
2022-03-30 01:26:33 -04:00
&done ;redraw-all JSR2 ;return JMP2
2022-03-24 01:35:35 -04:00
2022-04-04 00:40:37 -04:00
( toggle whether to use literal tab characters )
( )
( when opening a file, this defaults to 01 if existing tab )
( characters are found, and 00 otherwise. )
2022-03-25 00:12:09 -04:00
@toggle-tabs ( -> )
2022-04-06 20:39:02 -04:00
.config/insert-tabs LDZk #00 EQU SWP STZ
;redraw-statusbar-and-cursor JSR2 ;return JMP2
2022-04-04 00:40:37 -04:00
( interpret user input as an escaped sequence )
( )
( called by on-key with state/saw-esc is true )
( )
2022-04-06 23:26:07 -04:00
( TODO: maybe M-% for search&replace )
2022-03-23 21:46:59 -04:00
@on-key-escaped ( -> )
#00 .state/saw-esc STZ
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT '< EQU ( M-< ) ;goto-start JCN2
.state/key LDZ LIT '> EQU ( M-> ) ;goto-end JCN2
2022-04-06 23:26:07 -04:00
.state/key LDZ LIT 'b EQU ( M-b ) ;back-by-word JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT 'c EQU ( M-c ) ;toggle-color JCN2
2022-04-06 23:26:07 -04:00
.state/key LDZ LIT 'f EQU ( M-f ) ;forward-by-word JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT 'g EQU ( M-g ) ;goto-line JCN2
.state/key LDZ LIT 's EQU ( M-s ) ;regex-search JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT 't EQU ( M-t ) ;toggle-tabs JCN2
2022-04-08 23:52:07 -04:00
.state/key LDZ LIT 'u EQU ( M-u ) ;undo JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT 'v EQU ( M-v ) ;page-up JCN2
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2
2022-03-24 01:26:06 -04:00
BRK
2022-04-04 00:40:37 -04:00
( set our input to expect xterm control sequences )
( )
( after seeing ESC followed by [ we expect various )
( ANSI or xterm control sequences. these include )
( things like: )
( - up/down/left/right arrow keys )
( - page up/page down keys )
( - end/home keys )
2022-03-24 01:26:06 -04:00
@xterm
#01 .state/saw-xterm STZ BRK
2022-04-04 00:40:37 -04:00
( after seeing sequences like "ESC [ 1" we expect )
( to see a trailing ~ to complete the sequence. )
( )
( this callback checks for and if set performs )
( the relevant action. )
2022-03-24 01:26:06 -04:00
@on-key-vt ( -> )
.state/saw-vt LDZk STH #00 SWP STZ
.state/key LDZ LIT '~ EQU ,&ok JCN
2022-03-24 01:26:06 -04:00
POPr BRK
&ok
STHr DUP LIT '1 NEQ ,&not-1 JCN
( ^[[1~ -> home ) POP ;bol JMP2
&not-1 DUP LIT '2 NEQ ,&not-2 JCN
( ^[[2~ -> insert ) POP BRK
&not-2 DUP LIT '3 NEQ ,&not-3 JCN
( ^[[3~ -> delete ) POP ;delete JMP2
&not-3 DUP LIT '4 NEQ ,&not-4 JCN
( ^[[4~ -> end ) POP ;eol JMP2
&not-4 DUP LIT '5 NEQ ,&not-5 JCN
( ^[[5~ -> page up ) POP ;page-up JMP2
&not-5 DUP LIT '6 NEQ ,&not-6 JCN
( ^[[6~ -> page down ) POP ;page-down JMP2
&not-6 DUP LIT '7 NEQ ,&not-7 JCN
( ^[[7~ -> home ) POP ;bol JMP2
&not-7 DUP LIT '8 NEQ ,&not-8 JCN
( ^[[8~ -> end ) POP ;eol JMP2
&not-8
( ??? ) POP BRK
2022-04-04 00:40:37 -04:00
( after seeing sequences like "ESC [" we expect )
( to see more characters to determine the logical key. )
( )
( this callback performs the relevant action, )
( or else sets (or unsets) state as necessary )
( to continue (or end) the sequence. )
2022-03-24 01:26:06 -04:00
@on-key-xterm ( -> )
#00 .state/saw-xterm STZ
2022-03-30 23:41:16 -04:00
.state/key LDZ LIT 'A EQU ( ^[[A -> up ) ;up JCN2
.state/key LDZ LIT 'B EQU ( ^[[B -> down ) ;down JCN2
.state/key LDZ LIT 'C EQU ( ^[[C -> right ) ;forward JCN2
.state/key LDZ LIT 'D EQU ( ^[[D -> left ) ;back JCN2
.state/key LDZ LIT 'F EQU ( ^[[F -> end ) ;eol JCN2
.state/key LDZ LIT 'H EQU ( ^[[H -> home ) ;bol JCN2
.state/key LDZ LIT '0 LTH ;ignore JCN2
.state/key LDZ LIT '8 GTH ;ignore JCN2
.state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 )
2022-03-23 21:46:59 -04:00
BRK
2022-04-04 00:40:37 -04:00
( clear the message line )
( )
( this includes the code needed to move the cursor )
( to that line, the ANSI control sequence to clear )
( the line, and unsetting state/message. )
( )
( if state/message is unset this is a no-op. )
2022-03-23 22:55:03 -04:00
@clear-message-line
2022-04-01 23:47:37 -04:00
.state/message LDZ #00 EQU ,&done JCN
;move-to-message-line JSR2
;term-erase-line JSR2
2022-04-01 23:47:37 -04:00
#00 .state/message STZ
&done JMP2r
2022-03-23 22:55:03 -04:00
2022-04-04 00:40:37 -04:00
( cancel the active search )
( )
( this method unsets searching/active and also restores )
( the original cursor position. )
2022-03-29 00:02:22 -04:00
@cancel-search
.searching/orig-row LDZ2 ;jump-to-line JSR2
.searching/orig-col LDZ2 .cursor/col STZ2
2022-04-10 13:55:40 -04:00
,finish-search JMP
2022-03-29 00:02:22 -04:00
2022-04-04 00:40:37 -04:00
( cancel the active search )
( )
( this method unsets searching/active. unlike ;cancel-search )
( this leaves the cursor where it is. )
2022-03-29 00:02:22 -04:00
@finish-search
#00 .searching/active STZ
2022-04-10 13:55:40 -04:00
;reset-arena JSR2 ;redraw-all JSR2 ;return JMP2
2022-03-29 00:02:22 -04:00
2022-03-31 13:59:20 -04:00
( TODO: i haven't decided how to solve the problem of )
( overlapping matches yet. i don't really want to maintain )
( a global list of all matches, which means that currently )
( it can change in response to e.g. cursor position when )
( matches overlap. )
2022-04-04 00:40:37 -04:00
( )
( UPDATE: now that we have searching/start and searching/end )
( we can use those to resume the search after the full match. )
( this solves the problem except in some very strange cases )
( which are quite unlikely. )
2022-03-31 13:59:20 -04:00
2022-04-04 00:40:37 -04:00
( jump forward to the next match, if any. )
( )
( moves the cursor forward to the next match. if there are no )
( further matches the cursor does not move. )
2022-03-31 23:21:49 -04:00
@jump-to-next-match ( -> )
.searching/regex LDZ2 ORA ,&is-regex JCN
;move-to-next-match JSR2 POP ;return JMP2
&is-regex
;move-to-next-regex-match JSR2 POP ;return JMP2
2022-03-31 23:21:49 -04:00
2022-04-04 00:40:37 -04:00
( jump backward to the previous match, if any. )
( )
( moves the cursor backward to the previous match. if there are )
( no further matches the cursor does not move. )
2022-03-31 23:21:49 -04:00
@jump-to-prev-match ( -> )
.searching/regex LDZ2 ORA ,&is-regex JCN
;move-to-prev-match JSR2 POP ;return JMP2
&is-regex
;move-to-prev-regex-match JSR2 POP ;return JMP2
2022-03-31 23:21:49 -04:00
2022-04-04 00:40:37 -04:00
( move to the next substring match. )
( )
( called by ;jump-to-next-match. )
2022-03-31 23:21:49 -04:00
@move-to-next-match ( -> ok^ )
.buffer/limit LDZ2
;cur-pos JSR2 INC2
&loop
GTH2k #00 EQU ,&fail JCN
DUP2 ;matches-at JSR2
ORA ,&found JCN
INC2 ,&loop JMP
&found
NIP2 ;jump-to-pos JSR2 #01 JMP2r
&fail
2022-04-01 23:47:37 -04:00
POP2 POP2 #00 JMP2r
2022-04-04 00:40:37 -04:00
( move to the previous substring match. )
( )
( called by ;jump-to-prev-match. )
2022-03-31 23:21:49 -04:00
@move-to-prev-match ( -> ok^ )
2022-03-31 01:52:20 -04:00
;data
;cur-pos JSR2 #0001 SUB2
&loop
2022-04-01 00:44:07 -04:00
GTH2k ,&fail JCN
2022-03-31 01:52:20 -04:00
DUP2 ;matches-at JSR2
ORA ,&found JCN
#0001 SUB2 ,&loop JMP
&found
NIP2 ;jump-to-pos JSR2 #01 JMP2r
2022-03-31 01:52:20 -04:00
&fail
2022-04-01 23:47:37 -04:00
POP2 POP2 #00 JMP2r
2022-03-31 23:21:49 -04:00
2022-04-04 00:40:37 -04:00
( move to the next regex match. )
( )
( called by ;jump-to-next-match. )
@move-to-next-regex-match ( -> ok^ )
.searching/end LDZ2 .buffer/limit LDZ2 OVR2
GTH2 ,&ok JCN
POP2 #00 JMP2r
&ok
.searching/regex LDZ2 ;rx-search JSR2 ,&found JCN
#00 JMP2r
2022-03-31 23:21:49 -04:00
&found
;search-end LDA2 .searching/end STZ2
;search-start LDA2 DUP2 .searching/start STZ2
2022-03-31 23:21:49 -04:00
;jump-to-pos JSR2 #01 JMP2r
2022-04-04 00:40:37 -04:00
( move to the previous substring match. )
( )
( called by ;jump-to-prev-match. )
( )
( compared to move-to-next-regex-match this is kind of inefficient. )
( that's because we have no easy way to search backwards from a point. )
( )
( we could do some kind of fancy thing where we search the previous )
( N bytes, then the 2N bytes before that, etc. )
( )
( however, 64K is small enough that just searching from the beginning )
( and then taking the last match before the cursor works. )
@move-to-prev-regex-match ( -> ok^ )
LITr 00
;cur-pos JSR2 ;data ( limit pos [res] )
&loop ( limit pos [res] )
GTH2k #00 EQU ,&done JCN ( limit pos )
DUP2 .searching/regex LDZ2 ;rx-search JSR2 ( limit pos match? )
#00 EQU ,&done JCN ( limit pos )
OVR2 ;search-end LDA2 LTH2 ,&done JCN
POP2 POPr LITr 01
;search-start LDA2 .searching/start STZ2
;search-end LDA2 DUP2 .searching/end STZ2
,&loop JMP
2022-03-31 23:21:49 -04:00
&done
POP2 POP2 STHr DUP #00 EQU ,&fail JCN
.searching/start LDZ2 ;jump-to-pos JSR2
&fail
JMP2r
2022-03-29 00:02:22 -04:00
2022-04-04 00:40:37 -04:00
( on-key event handler to use when searching )
( )
( when searching the user can: )
( - move to the next match (n or C-s) )
( - move to the previous match (p or C-r) )
( - end the search leaving the cursor where it is (enter) )
( - cancel the search restoring the cursor (C-g) )
2022-03-29 00:02:22 -04:00
@on-key-searching
2022-03-30 23:41:16 -04:00
.state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2
.state/key LDZ #08 EQU ( C-h ) ;help JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ #0d EQU ( \r ) ;finish-search JCN2
2022-03-31 23:21:49 -04:00
.state/key LDZ #12 EQU ( C-r ) ;jump-to-prev-match JCN2
.state/key LDZ #13 EQU ( C-s ) ;jump-to-next-match JCN2
.state/key LDZ #6e EQU ( n ) ;jump-to-next-match JCN2
.state/key LDZ #70 EQU ( p ) ;jump-to-prev-match JCN2
2022-03-29 00:02:22 -04:00
;ignore JMP2
2022-04-04 00:40:37 -04:00
( on-key event handler to use when prompt is active )
( )
( when the prompt is active the user can: )
( - append characters to the input string )
( - delete from the end of the input string (backspace) )
( - complete the input and act (enter) )
( - cancel the prompt without action (C-g) )
( )
( TODO: currently it's impossible to edit the prompt )
( except from the end. ideally we'd support most of the )
( same navigation commands as we do in the buffer, such as )
( C-a, C-d, etc. however, it's enough extra work to enable )
( this that for now i haven't done it. )
2022-03-23 21:46:59 -04:00
@on-key-prompt
2022-03-30 23:41:16 -04:00
.state/key LDZ #07 EQU ( C-g ) ;cancel-prompt JCN2
.state/key LDZ #08 EQU ( C-h ) ;help JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ #0d EQU ( \r ) ;finish-prompt JCN2
.state/key LDZ #7f EQU ( DEL ) ;backspace-prompt JCN2
.state/key LDZ #20 LTH ;ignore JCN2 ( ignore for now )
.state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now )
.state/key LDZ ( printable ASCII ) ;insert-prompt JMP2
2022-03-23 21:46:59 -04:00
BRK
2022-04-04 00:40:37 -04:00
( on-key event handler )
( )
( this is the "normal" event handler to use for editing )
( the buffer. it checks various state values to determine )
( if we're in the midst of a control sequence, if we're )
( searching or have an active prompt, etc. )
( )
2022-03-23 22:55:03 -04:00
( TODO: C-h for help )
2022-04-04 00:40:37 -04:00
( )
( you could also imagine building data structures of )
( commands to unify input strings, help text, callbacks, )
( and so on. this might ultimately be more efficient but )
( for now what we have works. )
2022-02-09 20:04:12 -05:00
@on-key
2022-04-08 23:52:07 -04:00
#00 .state/in-undo STZ
.Console/read DEI .state/key STZ
2022-03-23 22:55:03 -04:00
;clear-message-line JSR2
.state/in-help LDZ #00 .state/in-help STZ ;return JCN2
2022-03-29 00:02:22 -04:00
.searching/active LDZ ;on-key-searching JCN2
2022-03-23 21:46:59 -04:00
.prompt/active LDZ ;on-key-prompt JCN2
2022-03-24 01:26:06 -04:00
.state/saw-vt LDZ ;on-key-vt JCN2
.state/saw-xterm LDZ ;on-key-xterm JCN2
2022-03-07 22:38:02 -05:00
.state/saw-esc LDZ ;on-key-escaped JCN2
2022-04-04 00:40:37 -04:00
.state/key LDZ #01 EQU ( C-a ) ;bol JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ #02 EQU ( C-b ) ;back JCN2
.state/key LDZ #04 EQU ( C-d ) ;delete JCN2
.state/key LDZ #05 EQU ( C-e ) ;eol JCN2
.state/key LDZ #06 EQU ( C-f ) ;forward JCN2
.state/key LDZ #08 EQU ( C-h ) ;help JCN2
2022-04-04 00:40:37 -04:00
.state/key LDZ #09 EQU ( \t ) ;insert-tab JCN2
2022-03-30 23:41:16 -04:00
.state/key LDZ #0c EQU ( C-l ) ;center-view JCN2
.state/key LDZ #0d EQU ( \r ) ;newline JCN2
.state/key LDZ #0e EQU ( C-n ) ;down JCN2
.state/key LDZ #0f EQU ( C-o ) ;save JCN2
.state/key LDZ #10 EQU ( C-p ) ;up JCN2
.state/key LDZ #13 EQU ( C-s ) ;search JCN2
.state/key LDZ #16 EQU ( C-v ) ;page-down JCN2
.state/key LDZ #18 EQU ( C-x ) ;quit JCN2
.state/key LDZ #1a EQU ( C-z ) ;debug JCN2
.state/key LDZ #1b EQU ( ESC ) ;escape JCN2
.state/key LDZ #7f EQU ( DEL ) ;backspace JCN2
.state/key LDZ #20 LTH ;ignore JCN2 ( ignore for now )
.state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now )
.state/key LDZ ( printable ASCII ) ;insert JMP2
2022-02-06 17:07:11 -05:00
2022-04-04 00:40:37 -04:00
( return the smaller of two short values )
2022-02-15 21:58:12 -05:00
@min2 ( x* y* -> min* )
LTH2k JMP SWP2 POP2 JMP2r
2022-04-04 00:40:37 -04:00
( method to add bits to the redraw register )
( )
( state/redraw uses 8 bits to represent which parts )
( of the screen (if any) should be redrawn. this method )
( uses logical-or (ORA) to add the bits of n to those )
( already set. )
2022-03-30 01:26:33 -04:00
@redraw-add ( n^ -> )
.state/redraw LDZk ROT ORA SWP STZ JMP2r
2022-04-04 00:40:37 -04:00
( various redrawing methods )
( )
( these don't perform a redraw right away, but instead )
( signal that the next drawing should include that part. )
2022-04-10 02:05:09 -04:00
@redraw-cursor ( -> ) #01 ,redraw-add JMP
@redraw-statusbar-and-cursor ( -> ) #03 ,redraw-add JMP
@redraw-prompt-and-cursor ( -> ) #05 ,redraw-add JMP
@redraw-matches ( -> ) #08 ,redraw-add JMP
@redraw-all ( -> ) #1f ,redraw-add JMP
2022-03-30 01:26:33 -04:00
2022-04-04 00:40:37 -04:00
( draw the current cursor location )
2022-02-18 00:20:09 -05:00
@draw-cursor ( -> )
2022-04-08 23:52:07 -04:00
.prompt/active LDZ #00 EQU JMP JMP2r
( TODO: handle long lines )
;cur-w-col JSR2 lmargin ADD2
2022-04-01 23:47:37 -04:00
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
2022-03-11 00:48:52 -05:00
;term-move-cursor JMP2
2022-02-09 01:05:11 -05:00
2022-04-01 23:47:37 -04:00
( current column in terms of display width )
2022-04-04 00:40:37 -04:00
( )
( this is different than ;cur-col due to tabs )
2022-04-01 23:47:37 -04:00
@cur-w-col ( -> col* )
LIT2r 0000 ( [0] )
;cur-line JSR2 DUP2 ;cur-col JSR2 ADD2 SWP2 ( lim s [0] )
&loop GTH2k ,&next JCN
POP2 POP2 STH2r JMP2r
&next LDAk #09 EQU ,&tabs JCN INC2 INC2r ,&loop JMP
&tabs INC2 .config/tab-width LDZ2 STH2 ADD2r ,&loop JMP
2022-04-04 00:40:37 -04:00
( move the terminal cursor to the statusbar line )
@move-to-statusbar ( -> )
#0000 .term/rows LDZ2 ;term-move-cursor JMP2
2022-03-25 00:12:09 -04:00
2022-04-04 00:40:37 -04:00
( draw the full statusbar )
2022-02-18 00:20:09 -05:00
@draw-statusbar ( -> )
2022-04-04 00:40:37 -04:00
;move-to-statusbar JSR2
2022-03-04 15:30:26 -05:00
;emit-color-reverse JSR2
2022-02-11 15:39:49 -05:00
2022-04-04 00:40:37 -04:00
LIT2r 2018 .term/cols LDZ2 #0001 ( cols i [2018] )
&loop LTH2k ,&done JCN DEOkr INC2 ,&loop JMP
&done POP2 POP2 POP2r ( )
;move-to-statusbar JSR2
2022-04-06 22:41:25 -04:00
( display ** if the buffer has unsaved changes, -- otherwise )
#2d .state/modified LDZ #00 NEQ #03 MUL SUB DUP emit emit sp
2022-02-11 15:39:49 -05:00
;filename ;print JSR2
2022-04-04 00:40:37 -04:00
sp emit-[
2022-04-06 22:41:25 -04:00
.buffer/limit LDZ2 ;data SUB2 ;emit-dec2 JSR2
2022-02-11 15:39:49 -05:00
;messages/bytes ;print JSR2
sp
2022-03-07 22:38:02 -05:00
.buffer/line-count LDZ2 ;emit-dec2 JSR2
2022-02-11 15:39:49 -05:00
;messages/lines ;print JSR2
2022-04-20 23:02:27 -04:00
sp emit-lpar
2022-03-11 00:06:48 -05:00
;cur-col JSR2 INC2 ;emit-dec2 JSR2
emit-,
2022-04-01 23:47:37 -04:00
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2
2022-04-20 23:02:27 -04:00
emit-rpar sp emit-[
2022-04-06 20:39:02 -04:00
LIT 's .config/insert-tabs LDZ ADD emit
emit-] sp
;messages/help-msg ;print JSR2
;emit-reset JMP2
2022-02-09 01:05:11 -05:00
2022-03-23 21:46:59 -04:00
@draw-prompt ( -> )
2022-03-23 22:55:03 -04:00
;clear-message-line JSR2
2022-03-23 21:46:59 -04:00
.prompt/active LDZ ,&is-active JCN
JMP2r
&is-active
2022-04-01 23:47:37 -04:00
#01 .state/message STZ
;move-to-message-line JSR2
2022-03-23 21:46:59 -04:00
;emit-color-bold JSR2
.prompt/string LDZ2 ;print JSR2
;emit-reset JSR2
;tmp/data ;print JSR2
2022-04-01 23:47:37 -04:00
JMP2r
2022-03-23 21:46:59 -04:00
@draw-linenum ( n* -> )
2022-03-04 15:30:26 -05:00
;emit-reset JSR2
2022-04-10 02:05:09 -04:00
;emit-color JSR2
;emit-dec2-pad JSR2 sp
2022-04-10 02:05:09 -04:00
;emit-reset JMP2
2022-03-29 00:02:22 -04:00
@matches-at ( s* -> limit* )
LIT2r :tmp/data
2022-04-04 00:40:37 -04:00
&loop LDAkr STHr #00 EQU ,&done JCN
LDAk LDAkr STHr NEQ ,&fail JCN
INC2 INC2r ,&loop JMP
&fail POP2 #0000
&done POP2r JMP2r
2022-03-29 00:02:22 -04:00
2022-04-06 22:41:25 -04:00
( TODO: this doesn't handle tabs correctly )
2022-03-29 00:02:22 -04:00
@draw-region ( offset* limit* col* row* -> )
OVR2 ( offset limit col row col )
.term/cols LDZ2 SWP2 SUB2 STH2 ( offset limit col row [cols-col] )
;term-move-cursor JSR2 ( offset limit [cols-col] )
OVR2 STH2r ADD2 ( offset limit offset+cols-col )
;min2 JSR2 STH2 ( offset [cutoff] )
&loop ( i [cutoff] )
2022-04-08 23:52:07 -04:00
DUP2 STH2kr LTH2 #00 EQU ,&done JCN
2022-03-29 00:02:22 -04:00
LDAk #00 EQU ,&done JCN
2022-04-04 00:40:37 -04:00
LDAk #18 DEO INC2 ,&loop JMP
2022-03-29 00:02:22 -04:00
&done
POP2 POP2r JMP2r
@screen-limit ( -> sc-limit* )
.term/rows LDZ2 .buffer/line-offset LDZ2 ADD2 ( row0+rows )
DUP2 .buffer/line-count LDZ2 LTH2 ,&not-end JCN
POP2 .buffer/limit LDZ2 JMP2r
&not-end
;abs-line JMP2
@draw-regex-matches ( -> )
;emit-color-reverse JSR2 ( )
;screen-limit JSR2 .buffer/offset LDZ2 ( limit pos )
&loop ( limit pos )
GTH2k #00 EQU ( limit pos limit>pos=0? )
,&done JCN ( limit pos )
DUP2 .searching/regex LDZ2 ( limit pos pos rx )
;rx-search JSR2 #00 EQU ( limit pos found=0? )
,&done JCN ( limit pos )
POP2 ;search-start LDA2 ( limit start )
GTH2k #00 EQU ( limit start limit>start=0? )
,&done JCN ( limit start )
;search-end LDA2 OVR2 ( limit start end start )
;pos-to-row-col JSR2 ( limit start end row col )
lmargin ADD2 ( limit start end row col+lm )
SWP2 .buffer/line-offset LDZ2 SUB2 ( limit start end col+lm row-lo )
;draw-region JSR2 ( limit )
;search-end LDA2 ( limit end ) ,&loop JMP
&done ( limit pos )
POP2 POP2 JMP2r
2022-03-29 00:02:22 -04:00
@draw-matches ( -> )
( return if not searching )
.searching/active LDZ #00 EQU ,&return JCN ( )
.searching/regex LDZ2 ORA ;draw-regex-matches JCN2
2022-03-29 00:02:22 -04:00
;emit-color-reverse JSR2
lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
2022-03-29 00:02:22 -04:00
.buffer/offset LDZ2 DUP2
;screen-limit JSR2 SUB2 STH2 ( offset [-count] )
&loop ( offset [-count] )
STH2kr #0000 EQU2 ,&done JCN
DUP2 ;matches-at JSR2 ( offset mlim [-count] )
DUP2 ORA ,&found JCN
POP2 ( offset [-count] )
LDAk #0a EQU ,&newline JCN
#0001 ,&next JMP ( offset n [-count] )
&found ( offset mlim [-count] )
STH2k ( offset mlim [mlim -count] )
OVR2 SWP2 ,&x LDR2 ,&y LDR2 ( offset offset mlim x y [mlim -count] )
2022-04-01 23:47:37 -04:00
;draw-region JSR2 ( offset [mlim -count] )
2022-03-29 00:02:22 -04:00
STH2r ( offset mlim [-count] )
OVR2 SUB2 ( offset mlim-offset [-count] )
&next ( offset n [-count] )
DUP2 ,&x LDR2 ADD2 ,&x STR2 ( offset n [-count )
STH2k ( offset n [n -count] )
ADD2 ADD2r ( offset+n [n-count] )
,&loop JMP
&newline ( offset [-count] )
lmargin ,&x STR2
2022-03-29 00:02:22 -04:00
,&y LDR2 INC2 ,&y STR2
INC2 INC2r
,&loop JMP
&done
POP2 POP2r
;emit-reset JSR2
&return
JMP2r
[ &x $2 &y $2 ]
2022-03-29 00:02:22 -04:00
@emit-tab ( -> )
2022-03-07 22:38:02 -05:00
#0000 .config/tab-width LDZ2 SUB2
LIT2r 2018
&loop ORAk ,&next JCN POP2 POP2r JMP2r
&next DEOkr INC2 ,&loop JMP
2022-04-10 02:05:09 -04:00
( ANSI terminal notes )
( )
( attrs [0-7] )
( reset, bright, dim, underscore, )
( blink, ???, reverse, hidden )
( )
( fg [30-37], bg [40-47] )
( black, red, green, yellow, )
( blue, magenta, cyan, white )
( ANSI control sequence to move the cursor to the given coord )
( ESC [ $row ; $col H )
@term-move-cursor ( col* row* -> )
ansi INC2 ( row+1 ) ;emit-dec2 JSR2
emit-; INC2 ( col+1 ) ;emit-dec2 JSR2
emit-H JMP2r
( ANSI control sequence to move N positions right )
( ESC [ $n C )
@term-move-right ( n* -> )
ansi ;emit-dec2 JSR2 emit-C JMP2r
( ANSI control sequence to get the cursor position )
( ESC [ 6 n )
@term-get-cursor-position ( -> )
LIT2 00 'n LIT '6 ,ansi-emit JMP
( ANSI control sequence to erase entire screen )
( ESC [ 2 J )
@term-erase-all ( -> )
LIT2 00 'J LIT '2 ,ansi-emit JMP
( ANSI control sequence to erase the current line )
( ESC [ 2 K )
@term-erase-line ( -> )
LIT2 00 'K LIT '2 ,ansi-emit JMP
@ansi-emit ( 00 cn ... c1 c0 -> )
LITr 18 ( Console/write )
#5b1b STHkr DEO STHkr DEO ( ESC [ )
2022-04-11 21:57:45 -04:00
&loop DUP ,&next JCN POP POPr JMP2r
2022-04-10 02:05:09 -04:00
&next STHkr DEO ,&loop JMP
( ESC [ 3 1 m )
2022-03-04 01:47:11 -05:00
@emit-red ( -> )
2022-04-10 02:05:09 -04:00
LIT2 00 'm LIT2 '1 '3 ,ansi-emit JMP
2022-03-04 01:47:11 -05:00
( ESC [ 0 m )
2022-03-04 01:47:11 -05:00
@emit-reset ( -> )
2022-04-10 02:05:09 -04:00
#00 LIT2 'm '0 ,ansi-emit JMP
2022-03-04 01:47:11 -05:00
( ESC [ 1 m $ ESC [ 0 m )
2022-03-04 01:47:11 -05:00
@emit-red-dollar ( -> )
2022-05-03 21:22:32 -04:00
,emit-red JSR emit-$ ,emit-reset JMP
2022-03-04 01:47:11 -05:00
( ESC [ 3 $x ; 7 m )
( $x is 0-7 )
2022-03-04 15:30:26 -05:00
@emit-color-reverse ( -> )
2022-04-10 02:05:09 -04:00
LIT2 00 'm LIT2 '7 '; .config/color LDZ2 ,ansi-emit JMP
@emit-color ( -> )
LIT2 00 'm .config/color LDZ2 ,ansi-emit JMP
2022-03-04 15:30:26 -05:00
( ESC [ 3 $x ; 1 m )
( $x is 0-7 )
2022-03-23 21:46:59 -04:00
@emit-color-bold ( -> )
2022-04-10 02:05:09 -04:00
LIT2 00 'm LIT2 '1 '; .config/color LDZ2 ,ansi-emit JMP
2022-03-23 21:46:59 -04:00
2022-02-18 00:20:09 -05:00
@draw-all ( -> )
2022-02-09 01:05:11 -05:00
;term-erase-all JSR2
2022-02-18 00:20:09 -05:00
#0000 #0000 ;term-move-cursor JSR2
2022-03-07 22:38:02 -05:00
.buffer/line-offset LDZ2 STH2 LIT2r 0001 ( [k line-offset] )
.buffer/offset LDZ2
2022-03-04 15:30:26 -05:00
&bol
ADD2kr STH2r ;draw-linenum JSR2
lmargin INC2 ,&x STR2
2022-03-04 01:47:11 -05:00
&loop ( offset [k line-offset] )
2022-03-04 15:30:26 -05:00
LDAk #00 EQU ,&eof JCN
LDAk #0a EQU ,&eol JCN
2022-03-07 22:38:02 -05:00
,&x LDR2 .term/cols LDZ2
2022-03-04 01:47:11 -05:00
LTH2k ,&ok JCN
GTH2 ,&skip JCN
;emit-red-dollar JSR2 ,&x LDR2 INC2 ,&x STR2
2022-03-04 15:30:26 -05:00
&skip INC2
2022-03-11 00:06:48 -05:00
,&loop JMP
2022-03-04 01:47:11 -05:00
&ok POP2 POP2
2022-03-04 15:30:26 -05:00
LDAk #09 EQU ,&do-tab JCN
LDAk emit INC2 ,&x LDR2 INC2 ,&x STR2
,&loop JMP
&eol INC2r
2022-03-11 00:06:48 -05:00
STH2kr .term/rows LDZ2 GTH2 ,&done JCN
2022-04-12 12:15:42 -04:00
crlf INC2 ,&bol JMP
2022-03-04 15:30:26 -05:00
&do-tab ;emit-tab JSR2 INC2
2022-03-07 22:38:02 -05:00
.config/tab-width LDZ2 ,&x LDR2 ADD2 ,&x STR2
2022-03-04 15:30:26 -05:00
,&loop JMP
2022-03-04 01:47:11 -05:00
[ &x $2 ]
2022-02-13 14:46:50 -05:00
&eof
2022-03-04 01:47:11 -05:00
;emit-red JSR2
2022-02-13 14:46:50 -05:00
&eof-loop
2022-03-07 22:38:02 -05:00
STH2kr .term/rows LDZ2 GTH2 ,&done JCN
2022-04-12 12:15:42 -04:00
crlf
lmargin ;term-move-right JSR2
2022-03-30 01:26:33 -04:00
emit-~ INC2r
2022-02-13 14:46:50 -05:00
,&eof-loop JMP
&done POP2 POP2r POP2r
2022-03-04 01:47:11 -05:00
;emit-reset JSR2
2022-03-29 00:02:22 -04:00
;draw-matches JSR2
;draw-statusbar JSR2
2022-03-30 01:26:33 -04:00
;draw-prompt JSR2
2022-04-08 23:52:07 -04:00
;draw-cursor JMP2
2022-02-06 17:07:11 -05:00
2022-03-30 01:26:33 -04:00
( handler completion code to do necessary drawing and BRK )
@return ( -> )
2022-03-31 23:21:49 -04:00
.state/redraw LDZ
DUP #10 AND ,&draw-all JCN
DUP #08 AND ,&do-8 JCN ,&skip-8 JMP &do-8 ;draw-matches JSR2
&skip-8 DUP #04 AND ,&do-4 JCN ,&skip-4 JMP &do-4 ;draw-prompt JSR2
&skip-4 DUP #02 AND ,&do-2 JCN ,&skip-2 JMP &do-2 ;draw-statusbar JSR2
&skip-2 DUP #01 AND ,&do-1 JCN ,&finish JMP &do-1 ;draw-cursor JSR2 ,&finish JMP
2022-04-04 00:40:37 -04:00
&draw-all ;draw-all JSR2
&finish POP #00 .state/redraw STZ BRK
2022-03-30 01:26:33 -04:00
2022-04-10 02:05:09 -04:00
@str-copy ( src* dst* -> len* )
STH2 DUP2 ( src src [dst] )
2022-02-11 15:39:49 -05:00
&loop LDAk #00 EQU ,&done JCN
LDAk STH2kr STA
INC2 INC2r ,&loop JMP
2022-04-10 02:05:09 -04:00
&done ( src src+n [dst+n] )
SWP2 SUB2
#00 STH2r STA
2022-03-23 21:46:59 -04:00
JMP2r
2022-02-11 15:39:49 -05:00
@print ( s* -> )
2022-02-06 17:07:11 -05:00
&loop LDAk #00 EQU ,&eof JCN
LDAk #18 DEO INC2 ,&loop JMP
&eof POP2 JMP2r
@cur-len ( -> n* )
2022-03-07 12:56:52 -05:00
;cur-line JSR2 ;line-len JMP2
2022-02-06 17:07:11 -05:00
@line-len ( s* -> n* )
#0000 STH2
&loop LDAk #00 EQU ,&end JCN
LDAk #0a EQU ,&end JCN
INC2 INC2r ,&loop JMP
2022-02-06 17:07:11 -05:00
&end POP2 STH2r JMP2r
2022-03-31 13:48:08 -04:00
@line-is-visible ( n* -> bool^ )
.buffer/line-offset LDZ2 LTH2k ,&no JCN
.term/rows LDZ2 ADD2 LTH2 JMP2r
&no POP2 POP2 #00 JMP2r
@jump-to-pos ( s* -> )
2022-03-31 23:21:49 -04:00
;pos-to-row-col JSR2 SWP2 ;move-to-coord JMP2
@pos-to-row-col ( s* -> row* col* )
#0000 ,&row STR2
#0000 ,&col STR2
;data
&loop ( s pos )
2022-04-08 23:52:07 -04:00
GTH2k #00 EQU ,&done JCN
LDAk #0a EQU ,&newline JCN
,&col LDR2 INC2 ,&col STR2
INC2 ,&loop JMP
&newline
#0000 ,&col STR2
,&row LDR2 INC2 ,&row STR2
INC2 ,&loop JMP
&done
2022-03-31 01:52:20 -04:00
POP2 POP2
,&row LDR2 ,&col LDR2 JMP2r
[ &row $2 &col $2 ]
2022-04-01 23:47:37 -04:00
( counts y lines forward from the given address )
@line-to-pos ( addr* y* -> s* )
#0000 SWP2 SUB2 STH2 ( addr [-y] )
&newline ( addr [-y] )
2022-02-10 01:40:48 -05:00
STH2kr ORA ,&loop JCN ,&done JMP
2022-04-01 23:47:37 -04:00
&loop ( addr [-y] )
LDAk #00 EQU ,&not-found JCN ( addr [-y] )
LDAk #0a EQU ,&found JCN ( addr [-y] )
INC2 ,&loop JMP ( addr+1 [-y] )
&found INC2 INC2r ,&newline JMP
2022-02-10 01:40:48 -05:00
&done POP2r JMP2r
&not-found POP2 POP2r #0000 JMP2r
2022-04-01 23:47:37 -04:00
( find string pointer for absolute y coordinate )
@abs-line ( y* -> s* )
;data SWP2 ;line-to-pos JMP2
2022-04-04 00:40:37 -04:00
( return a pointer to the current line )
2022-02-06 17:07:11 -05:00
@cur-line ( -> s* )
2022-04-06 22:41:25 -04:00
.cursor/row LDZ2 .buffer/line-offset LDZ2 LTH2k ,&early JCN
( if cursor/row is later than line-offset )
( we can save some time by starting at )
( buffer/offset instead of the beginning )
SUB2 .buffer/offset LDZ2 SWP2 ;line-to-pos JMP2
&early
( if cursor/row is earlier than line-offset )
( we need to use the absolute y coordinate )
2022-04-01 23:47:37 -04:00
POP2 ;abs-line JMP2
2022-02-14 16:47:36 -05:00
2022-04-04 00:40:37 -04:00
( return a pointer to the current cursor position )
2022-02-06 17:07:11 -05:00
@cur-pos ( -> s* )
2022-02-18 00:20:09 -05:00
;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r
2022-02-06 17:07:11 -05:00
2022-04-04 00:40:37 -04:00
( insert one character at the cursor position )
2022-02-06 17:07:11 -05:00
@shift-right ( c^ addr* -> )
2022-04-08 23:52:07 -04:00
#01 .state/modified STZ
2022-02-06 17:07:11 -05:00
ROT STH ( addr [prev^] )
2022-02-14 16:47:36 -05:00
;last-pos JSR2 SWP2 ( last addr [prev^] )
2022-04-08 23:52:07 -04:00
.state/in-undo LDZ ,&loop JCN
STH2k #00 STH2r ;u-push JSR2
2022-02-06 17:07:11 -05:00
&loop LTH2k ,&done JCN ( last addr [prev^] )
LDAk STH SWPr ( last addr [prev^ curr^] )
DUP2 STHr ( last addr addr prev^ [curr^] )
ROT ROT STA ( last addr [curr^] )
INC2 ,&loop JMP ( last addr+1 [curr^] )
&done NIP2 DUP2 ( addr addr [prev^] )
STHr ROT ROT ( addr prev^ addr )
STA INC2 ( addr+1 )
2022-03-07 22:38:02 -05:00
.buffer/limit STZ2 ( )
2022-02-06 17:07:11 -05:00
JMP2r
2022-04-04 00:40:37 -04:00
( remove one character at the cursor position )
( )
2022-02-13 14:46:50 -05:00
( TODO: change last/addr order and GTH -> LTH to remove hack )
2022-02-06 17:07:11 -05:00
@shift-left ( addr* -> )
2022-04-08 23:52:07 -04:00
#01 .state/modified STZ
2022-02-14 16:47:36 -05:00
;last-pos JSR2 SWP2 ( last addr )
2022-04-08 23:52:07 -04:00
.state/in-undo LDZ ,&loop JCN
STH2k ;cur-pos JSR2 LDA STH2r ;u-push JSR2
2022-02-13 14:46:50 -05:00
&loop GTH2k ,&next JCN ( last addr )
,&done JMP ( last addr )
&next DUP2 INC2 LDAk ( last addr addr+1 c1^ )
STH SWP2 STHr ( last addr+1 addr c1^ )
ROT ROT ( last addr+1 c1^ addr )
STA ,&loop JMP ( last addr+1 )
&done POP2 ( last )
2022-03-07 22:38:02 -05:00
.buffer/limit STZ2 ( )
#00 .buffer/limit LDZ2 STA ( ensure null termination )
2022-02-06 17:07:11 -05:00
JMP2r
2022-04-01 23:47:37 -04:00
( current column in terms of bytes in buffer )
2022-02-18 00:20:09 -05:00
@cur-col ( -> col* )
2022-03-07 22:38:02 -05:00
.cursor/col LDZ2 ;cur-len JSR2 ;min2 JMP2
2022-02-07 22:25:32 -05:00
2022-04-04 00:40:37 -04:00
( jump to the first line in the buffer )
@zero-row ( -> )
2022-03-07 22:38:02 -05:00
;data .buffer/offset STZ2
#0000 .buffer/line-offset STZ2
#0000 .cursor/row STZ2
JMP2r
2022-04-04 00:40:37 -04:00
( return the location of the last character in the buffer )
2022-02-18 00:20:09 -05:00
@last-pos ( -> addr* )
2022-03-07 22:38:02 -05:00
.buffer/limit LDZ2 #0001 SUB2 JMP2r
2022-02-07 22:25:32 -05:00
2022-04-04 00:40:37 -04:00
( emit a short as a decimal )
2022-02-09 01:05:11 -05:00
@emit-dec2 ( n* -> )
2022-04-04 00:40:37 -04:00
LITr 00 ( n [0] )
&read ( n [k] )
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
DUP2 ORA ,&read JCN
POP2 ( top element was 0000 )
&write ( n0 n1 ... nk [k+1] )
NIP #30 ADD #18 DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
STHkr ,&write JCN
POPr JMP2r
( emit a short as a decimal with leading spaces )
@emit-dec2-pad ( n* -> )
LITr 00 ( n [0] )
&read ( n [k] )
#000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
STHkr #05 LTH ,&read JCN
POP2 ( top element was 0000 )
&write0 ( n0 n1 ... nk [k+1] )
DUP2 ORA ,emit-dec2/write JCN
POP2 sp LITr 01 SUBr
STHkr ,&write0 JCN
POPr JMP2r
2022-03-07 22:38:02 -05:00
( various string constants used as messages for the user )
2022-03-23 22:55:03 -04:00
@messages [ &null 00
2022-04-09 00:05:12 -04:00
&input-error "Input 20 "error, 20 "file 20 "too 20 "large: 20 00
&bytes 20 "bytes, 00
2022-03-23 22:12:17 -04:00
&save-ok "Successfully 20 "saved 20 00
&save-failed "Failed 20 "to 20 "save 20 00
&lines 20 "lines] 00
2022-03-24 00:09:55 -04:00
&goto-line "Go 20 "to 20 "line: 20 00
2022-03-23 21:46:59 -04:00
&save-prompt "File 20 "Name 20 "to 20 "Write: 20 00
2022-03-29 00:02:22 -04:00
&search-prompt "Text 20 "to 20 "Search 20 "for: 20 00
&regex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 00
2022-03-23 22:55:03 -04:00
&quit-prompt "Save 20 "modified 20 "file 20 "(y/n)? 20 00
&unknown-input "Unknown 20 "input: 20 00
&no-matches-found "No 20 "matches 20 "found: 20 00
2022-04-08 23:52:07 -04:00
&term-size-parse-error "Error 20 "parsing 20 "term 20 "size 00
&help-msg "(help: 20 "C-h) 00
2022-03-25 00:12:09 -04:00
]
2022-02-08 22:22:08 -05:00
@help-text
09 "femto 20 "input 20 "reference 09 "(C 20 "is 20 "Ctrl, 20 "M 20 "is 20 "Meta/Alt ") 0d 0a
0d 0a
09 "quit 09 09 "C-x 09 09 "cancel 09 09 "C-g 0d 0a
09 "save 09 09 "C-o 09 09 "undo 09 09 "C-u 0d 0a
0d 0a
09 "move 20 "up 09 09 "C-p 20 "(up) 09 "page 20 "up 09 09 "M-v 20 "(pg-up) 0d 0a
09 "move 20 "down 09 "C-n 20 "(down) 09 "page 20 "down 09 "C-v 20 "(pg-dn) 0d 0a
09 "move 20 "left 09 "C-b 20 "(left) 09 "line 20 "start 09 "C-a 20 "(home) 0d 0a
09 "move 20 "right 09 "C-f 20 "(right) 09 "line 20 "end 09 "C-e 20 "(end) 0d 0a
0d 0a
09 "goto 20 "file 20 "start 09 "M-< 09 09 "left 20 "by 20 "word 09 "M-b 0d 0a
09 "goto 20 "file 20 "end 09 "M-> 09 09 "right 20 "by 20 "word 09 "M-f 0d 0a
09 "goto 20 "line 09 "M-g 09 09 "center 20 "cursor 09 "C-l 0d 0a
0d 0a
09 "search 09 09 "C-s 09 09 "toggle 20 "colors 09 "M-c 0d 0a
09 "regex 20 "search 09 "M-s 09 09 "toggle 20 "tabs 09 "M-t 0d 0a
09 "next 20 "match 09 "C-s 20 "(n) 0d 0a
09 "prev 20 "match 09 "C-r 20 "(p) 0d 0a
09 "end 20 "search 09 "enter 0d 0a
09 "cancel 20 "search 09 "C-g 0d 0a
0d 0a
09 09 09 "press 20 "any 20 "key 20 "to 20 "continue... 0d 0a
00
2022-04-09 00:16:22 -04:00
( perform the undo action )
2022-04-08 23:52:07 -04:00
@undo ( -> )
#01 .state/in-undo STZ
;undo-stack/pos LDA2 ;undo-stack/data EQU2 ,&noop JCN
;undo-stack/pos LDA2 #0003 SUB2
DUP2 ;undo-stack/pos STA2
LDA2k STH2 ( pos [addr] )
INC2 INC2 LDA STH2r ( c addr )
;jump-to-pos JSR2
DUP #00 EQU ,&delete JCN
DUP #0a EQU ,&newline JCN
DUP #09 EQU ,&tab JCN
;insert JMP2
&newline POP ;newline JMP2
&tab POP ;insert-tab JMP2
&delete POP ;delete JMP2
&noop BRK
2022-04-09 00:16:22 -04:00
( free up space in the undo stack by evicting the oldest entry )
2022-04-08 23:52:07 -04:00
@u-free ( -> )
;undo-stack/data STH2k #0003 ADD2 ( st+3 [st] )
&loop LDAk STH2kr STA
INC2 INC2r
DUP2 ;undo-stack/pos LDA2 LTH2 ,&loop JCN
2022-04-10 13:55:40 -04:00
;undo-stack/pos LDA2k #0003 SUB2 SWP2 STA2
POP2 POP2r JMP2r
2022-04-08 23:52:07 -04:00
2022-04-09 00:16:22 -04:00
( push a new item on the undo stack )
2022-04-08 23:52:07 -04:00
@u-push ( c^ addr* -> )
;undo-stack/pos DUP2 LDA2 ( c^ addr* top* pos* )
GTH2 ( c^ addr* top>pos^ ) ,&has-room JCN ( c^ addr* )
;u-free JSR2
&has-room ;undo-stack/pos LDA2 ( c^ addr* pos* )
STH2k ( c addr pos [pos] )
STA2 ( c [pos] )
STH2r INC2 INC2 STH2k ( c pos+2 [pos+2] )
STA ( [pos+2] )
STH2r INC2 ( pos+3 ) ;undo-stack/pos STA2 ( [] )
JMP2r
2022-04-04 00:40:37 -04:00
( path to file being edited )
@filename $80
2022-04-09 00:05:12 -04:00
( stack of data to undo )
( )
( each item in the stack consists of: )
( - 2 bytes: address to jump to )
( - 1 byte: character to insert, or \0 to delete )
( )
( pos points to the next open stack frame. )
2022-04-09 00:16:22 -04:00
( when pos points to data the stack is empty. )
2022-04-09 00:05:12 -04:00
( when pos points to pos the stack is full. )
2022-04-08 23:52:07 -04:00
@undo-stack [
&data $180 ( 128 steps )
&pos :undo-stack/data
]
2022-04-04 00:40:37 -04:00
( actual file data to be edited )
2022-04-10 02:05:09 -04:00
@data $ce80
2022-04-08 23:52:07 -04:00
( end of femto.tal )