refactors, comments, saving bytes

This commit is contained in:
~d6 2022-04-04 00:40:37 -04:00
parent c237be7cbc
commit ab336cdc00
1 changed files with 332 additions and 88 deletions

420
femto.tal
View File

@ -92,19 +92,20 @@
( zero page ) ( zero page )
|0000 |0000
@counter $2 ( terminal size information )
@term [ @term [
&cols $2 ( relative x coordinate of cursor, from 0 ) &cols $2 ( relative x coordinate of cursor, from 0 )
&rows $2 ( relative y coordinate of cursor, from 1 ) &rows $2 ( relative y coordinate of cursor, from 1 )
] ]
( configuration settings used when editing )
@config [ @config [
&tab-width $2 ( how many spaces to display tab chars ) &tab-width $2 ( how many spaces to display tab chars )
&insert-tabs $1 ( tab key inserts tabs when true ) &insert-tabs $1 ( tab key inserts tabs when true )
&color $2 ( digits of highlight color in reverse order ) &color $2 ( digits of highlight color in reverse order )
] ]
( tracks information related to the buffer's view of data )
@buffer [ @buffer [
&limit $2 ( last byte of actual data (not including \0) + 1 ) &limit $2 ( last byte of actual data (not including \0) + 1 )
&offset $2 ( first byte of data visible in terminal ) &offset $2 ( first byte of data visible in terminal )
@ -118,6 +119,7 @@
&row $2 ( current relative row value, 0-(height-1) ) &row $2 ( current relative row value, 0-(height-1) )
] ]
( tracks overall editor state between events )
@state [ @state [
&key $1 ( last key read ) &key $1 ( last key read )
&saw-esc $1 ( did we just see ESC? ) &saw-esc $1 ( did we just see ESC? )
@ -141,9 +143,10 @@
&string $2 ( string to print for the prompt ) &string $2 ( string to print for the prompt )
] ]
( temporary input buffer used for a variety of things )
@tmp [ @tmp [
&pos $2 ( temporary pointer to address when reading data ) &pos $2 ( temporary pointer to address when reading data )
&data $40 ( small scratch pad when reading data ) &data $80 ( small scratch pad when reading data )
] ]
( search uses .tmp/pos and .tmp/data to track query string ) ( search uses .tmp/pos and .tmp/data to track query string )
@ -161,6 +164,7 @@
;init-zero-page JSR2 ;init-zero-page JSR2
;startup JMP2 ;startup JMP2
( import uxn regex library )
~regex.tal ~regex.tal
( intialize zero page variables ) ( intialize zero page variables )
@ -194,6 +198,11 @@
&done POP2 nl &done POP2 nl
dbg BRK dbg BRK
( 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 )
@open-file ( filename* -> ) @open-file ( filename* -> )
.File/name DEO2 .File/name DEO2
#c950 .File/length DEO2 #c950 .File/length DEO2
@ -207,6 +216,11 @@
&ok .File/success DEI2 ;data ADD2 .buffer/limit STZ2 &ok .File/success DEI2 ;data ADD2 .buffer/limit STZ2
JMP2r JMP2r
( ask the terminal for its size )
( )
( called during editor initialization by ;read-filename )
( )
( TODO: consider supporting terminal resizing )
@setup-terminal-size ( -> ) @setup-terminal-size ( -> )
#03e7 DUP2 ;term-move-cursor JSR2 #03e7 DUP2 ;term-move-cursor JSR2
;term-get-cursor-position JSR2 ;term-get-cursor-position JSR2
@ -214,6 +228,9 @@
;receive-terminal-size .Console/vector DEO2 ;receive-terminal-size .Console/vector DEO2
JMP2r JMP2r
( receive size information from the terminal )
( )
( called from Console/vector after ;setup-terminal-size )
@receive-terminal-size ( -> ) @receive-terminal-size ( -> )
.Console/read DEI .state/key STZ .Console/read DEI .state/key STZ
.state/key LDZ .tmp/pos LDZ2 STA .state/key LDZ .tmp/pos LDZ2 STA
@ -221,6 +238,9 @@
.state/key LDZ LIT 'R EQU ;parse-terminal-size JCN2 .state/key LDZ LIT 'R EQU ;parse-terminal-size JCN2
BRK BRK
( parse and store terminal size information )
( )
( called by ;receive-terminal-size after complete message received )
@parse-terminal-size ( -> ) @parse-terminal-size ( -> )
LIT2r 0000 LIT2r 0000 LIT2r 0000 LIT2r 0000
.tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC .tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC
@ -245,6 +265,10 @@
&parse-error POP .tmp/data LDZ2 &parse-error POP .tmp/data LDZ2
;messages/term-size-parse-error ;error! JMP2 ;messages/term-size-parse-error ;error! JMP2
( 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. )
@setup-linecount ( -> ) @setup-linecount ( -> )
;data LIT2r 0001 ;data LIT2r 0001
&loop DUP2 .buffer/limit LDZ2 EQU2 ,&done JCN &loop DUP2 .buffer/limit LDZ2 EQU2 ,&done JCN
@ -256,6 +280,14 @@
STH2r .buffer/line-count STZ2 STH2r .buffer/line-count STZ2
JMP2r JMP2r
( 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 )
@read-filename ( -> ) @read-filename ( -> )
#12 DEI #0a EQU ,&execute JCN ( did we read \n ? ) #12 DEI #0a EQU ,&execute JCN ( did we read \n ? )
#12 DEI .tmp/pos LDZ2 STA ( no, so save in buffer ) #12 DEI .tmp/pos LDZ2 STA ( no, so save in buffer )
@ -269,16 +301,19 @@
;setup-terminal-size JSR2 ( detect terminal dimensions ) ;setup-terminal-size JSR2 ( detect terminal dimensions )
BRK BRK
( jump to beginning of line )
@bol ( -> ) @bol ( -> )
#0000 .cursor/col STZ2 #0000 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
( jump to beginning of line )
@eol ( -> ) @eol ( -> )
;cur-len JSR2 .cursor/col STZ2 ;cur-len JSR2 .cursor/col STZ2
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
( move forward by one character )
@forward ( -> ) @forward ( -> )
;cur-pos JSR2 ;last-pos JSR2 GTH2 ;return JCN2 ;cur-pos JSR2 ;last-pos JSR2 GTH2 ;return JCN2
;cur-col JSR2 ;cur-len JSR2 LTH2 ,&normal JCN ;cur-col JSR2 ;cur-len JSR2 LTH2 ,&normal JCN
@ -291,6 +326,11 @@
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
( move backward by one character )
@back ( -> )
;go-back JSR2 ;return JMP2
( internal implementation shared by ;back and ;backspace )
@go-back ( -> ) @go-back ( -> )
;cur-pos JSR2 ;data EQU2 ,&noop JCN ;cur-pos JSR2 ;data EQU2 ,&noop JCN
;cur-col JSR2 #0001 LTH2 ,&next-line JCN ;cur-col JSR2 #0001 LTH2 ,&next-line JCN
@ -303,9 +343,7 @@
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
&noop JMP2r &noop JMP2r
@back ( -> ) ( move up by one line )
;go-back JSR2 ;return JMP2
@up ( -> ) @up ( -> )
.cursor/row LDZ2 #0000 EQU2 ;return JCN2 .cursor/row LDZ2 #0000 EQU2 ;return JCN2
.cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 .cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
@ -313,16 +351,16 @@
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
@last-abs-row ( -> n* ) ( move down by one line )
.buffer/line-count LDZ2 #0001 SUB2 JMP2r
@down ( -> ) @down ( -> )
.cursor/row LDZ2 ;last-abs-row JSR2 EQU2 ;return JCN2 .cursor/row LDZ2
.buffer/line-count LDZ2 #0001 SUB2 EQU2 ;return JCN2
.cursor/row LDZ2 INC2 .cursor/row STZ2 .cursor/row LDZ2 INC2 .cursor/row STZ2
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-statusbar-and-cursor JSR2 ;redraw-statusbar-and-cursor JSR2
;return JMP2 ;return JMP2
( center buffer view on the current line )
@center-view @center-view
.term/rows LDZ2 INC2 #0002 DIV2 STH2k .term/rows LDZ2 INC2 #0002 DIV2 STH2k
.cursor/row LDZ2 LTH2 ,&standard JCN .cursor/row LDZ2 LTH2 ,&standard JCN
@ -337,6 +375,7 @@
&done &done
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( move up by one page )
@page-up ( -> ) @page-up ( -> )
.term/rows LDZ2 #0002 SUB2 STH2k .term/rows LDZ2 #0002 SUB2 STH2k
.buffer/line-offset LDZ2 LTH2 ,&move-full JCN .buffer/line-offset LDZ2 LTH2 ,&move-full JCN
@ -352,7 +391,7 @@
&done &done
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( move down by one page )
@page-down @page-down
;eof-is-visible JSR2 ,&near-eof JCN ;eof-is-visible JSR2 ,&near-eof JCN
.term/rows LDZ2 #0002 SUB2 STH2k .term/rows LDZ2 #0002 SUB2 STH2k
@ -366,6 +405,13 @@
;cur-len JSR2 .cursor/col STZ2 ;cur-len JSR2 .cursor/col STZ2
;redraw-cursor JSR2 ;return JMP2 ;redraw-cursor JSR2 ;return JMP2
( 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 )
@quit @quit
#01 .state/quitting STZ #01 .state/quitting STZ
.state/modified LDZ ,&is-modified JCN .state/modified LDZ ,&is-modified JCN
@ -374,11 +420,17 @@
;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2 ;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
( 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. )
@send-message ( s1* s2* -> ) @send-message ( s1* s2* -> )
#01 .state/message STZ #01 .state/message STZ
;move-to-message-line JSR2 ;move-to-message-line JSR2
SWP2 ;print JSR2 ;print JMP2 SWP2 ;print JSR2 ;print JMP2
( callback executed in response to the quit prompt. )
@do-quit @do-quit
.tmp/data LDZ LIT 'n EQU ;quit-now JCN2 .tmp/data LDZ LIT 'n EQU ;quit-now JCN2
.tmp/data LDZ LIT 'y EQU ;save JCN2 .tmp/data LDZ LIT 'y EQU ;save JCN2
@ -386,23 +438,38 @@
;messages/unknown-input ;tmp/data ;send-message JSR2 ;messages/unknown-input ;tmp/data ;send-message JSR2
BRK BRK
( label that calls quit! )
( )
( this definition is needed so the address can be used by JCN2. )
@quit-now quit! @quit-now quit!
( label that calls BRK )
( )
( this definition is needed so the address can be used by JCN2. )
@ignore @ignore
( ;draw-cursor JSR2 ) BRK BRK
( insert the given character at the cursor position )
( )
( this should not be called for newlines, see ;newline )
@insert ( c^ -> ) @insert ( c^ -> )
#01 .state/modified STZ #01 .state/modified STZ
;cur-pos JSR2 ;shift-right JSR2 ;cur-pos JSR2 ;shift-right JSR2
;cur-col JSR2 INC2 .cursor/col STZ2 ;cur-col JSR2 INC2 .cursor/col STZ2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( insert the given character in the prompt )
@insert-prompt ( c^ -> ) @insert-prompt ( c^ -> )
.tmp/pos LDZ2 STH2k STA ( data[pos] <- c ) .tmp/pos LDZ2 STH2k STA ( data[pos] <- c )
INC2r #00 STH2kr STA ( data[pos+1] <- 0 ) INC2r #00 STH2kr STA ( data[pos+1] <- 0 )
STH2r .tmp/pos STZ2 ( pos <- pos+1 ) STH2r .tmp/pos STZ2 ( pos <- pos+1 )
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
( 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 ( -> ) @insert-tab ( -> )
#01 .state/modified STZ #01 .state/modified STZ
.config/insert-tabs LDZ ,&use-tabs JCN .config/insert-tabs LDZ ,&use-tabs JCN
@ -417,7 +484,7 @@
&use-tabs &use-tabs
#09 ;insert JMP2 #09 ;insert JMP2
( TODO: handle last line ) ( insert a newline at the cursor position )
@newline ( c^ -> ) @newline ( c^ -> )
#01 .state/modified STZ #01 .state/modified STZ
#0a ;cur-pos JSR2 ;shift-right JSR2 #0a ;cur-pos JSR2 ;shift-right JSR2
@ -427,15 +494,12 @@
;ensure-visible-cursor JSR2 ;ensure-visible-cursor JSR2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
@eof-is-visible ( -> bool^ ) ( delete the character to the left of the cursor, if any )
.buffer/line-offset LDZ2 .term/rows LDZ2 ADD2 INC2
.buffer/line-count LDZ2
GTH2 JMP2r
@backspace ( -> ) @backspace ( -> )
;cur-pos JSR2 ;data EQU2 ;return JCN2 ;cur-pos JSR2 ;data EQU2 ;return JCN2
;go-back JSR2 ;delete JMP2 ;go-back JSR2 ;delete JMP2
( delete the last character in the prompt )
@backspace-prompt ( -> ) @backspace-prompt ( -> )
.tmp/pos LDZ2 ;tmp/data EQU2 ,&skip JCN ( ;return JCN2 ) .tmp/pos LDZ2 ;tmp/data EQU2 ,&skip JCN ( ;return JCN2 )
#00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 ) #00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 )
@ -443,6 +507,7 @@
STH2r .tmp/pos STZ2 ( pos <- pos-1 ) STH2r .tmp/pos STZ2 ( pos <- pos-1 )
&skip ;redraw-prompt-and-cursor JSR2 ;return JMP2 &skip ;redraw-prompt-and-cursor JSR2 ;return JMP2
( delete the character under the cursor, if any )
@delete ( -> ) @delete ( -> )
#01 .state/modified STZ #01 .state/modified STZ
;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2 ;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2
@ -452,9 +517,17 @@
.buffer/line-count LDZ2k #0001 SUB2 ROT STZ2 .buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
&not-newline ;redraw-all JSR2 ;return JMP2 &not-newline ;redraw-all JSR2 ;return JMP2
( 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. )
@escape ( -> ) @escape ( -> )
#01 .state/saw-esc STZ BRK #01 .state/saw-esc STZ BRK
( move to the end of the file )
@goto-end ( -> ) @goto-end ( -> )
.buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2 .buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
.buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ,&use-zero JCN .buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ,&use-zero JCN
@ -467,15 +540,20 @@
;cur-len JSR2 .cursor/col STZ2 ;cur-len JSR2 .cursor/col STZ2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( move to the start of the file )
@goto-start ( -> ) @goto-start ( -> )
;zero-row JSR2 ;zero-row JSR2
#0000 .cursor/col STZ2 #0000 .cursor/col STZ2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( prompt for a line number and move to that line )
@goto-line ( -> ) @goto-line ( -> )
;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2 ;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
( parse the given string as a decimal number )
( )
( returns the number as a short followed by whether parsing was ok )
@parse-decimal-number ( addr* -> n* ok^ ) @parse-decimal-number ( addr* -> n* ok^ )
LDAk ,&non-empty JCN LDAk ,&non-empty JCN
#00 JMP2r #00 JMP2r
@ -492,9 +570,11 @@
INC2 ,&loop JMP INC2 ,&loop JMP
&fail &fail
POP2r #00 JMP2r POP2r #00 JMP2r
@do-goto-line ( go to the given line number )
( )
( this is used as a callback from the goto-line prompt )
@do-goto-line ( n* -> )
;tmp/data ;parse-decimal-number JSR2 ;tmp/data ;parse-decimal-number JSR2
,&ok JCN ,&ok JCN
;messages/unknown-input ;tmp/data ;send-message JSR2 ;messages/unknown-input ;tmp/data ;send-message JSR2
@ -507,10 +587,16 @@
;jump-to-line JSR2 ;jump-to-line JSR2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( move the cursor to the given coordinates )
( )
( this won't move the display if the given coordinates are visible. )
@move-to-coord ( col* row* -> ) @move-to-coord ( col* row* -> )
DUP2 ;line-is-visible JSR2 ;jump-to-coord/short JCN2 DUP2 ;line-is-visible JSR2 ;jump-to-coord/short JCN2
;jump-to-coord JMP2 ;jump-to-coord JMP2
( move the cursor to the given coordinates )
( )
( this will always ensure the display is centered on the given coordinates )
@jump-to-coord ( x* y* -> ) @jump-to-coord ( x* y* -> )
.term/rows LDZ2 INC2 #0002 DIV2 LTH2k ( x y rows/2 y<rows/2? ) ,&early JCN .term/rows LDZ2 INC2 #0002 DIV2 LTH2k ( x y rows/2 y<rows/2? ) ,&early JCN
OVR2 SWP2 SUB2 ( x y y-rows/2 ) OVR2 SWP2 SUB2 ( x y y-rows/2 )
@ -535,9 +621,14 @@
.cursor/col STZ2 .cursor/col STZ2
JMP2r JMP2r
( jump to the given line number )
@jump-to-line ( n* -> ) @jump-to-line ( n* -> )
#0000 SWP2 ;jump-to-coord JMP2 #0000 SWP2 ;jump-to-coord JMP2
( ensure the cursor is visibe )
( )
( if the cursor is not already visible the screen will be )
( centered on the cursor's coordinates. )
@ensure-visible-cursor @ensure-visible-cursor
.cursor/row LDZ2 .buffer/line-offset LDZ2 .cursor/row LDZ2 .buffer/line-offset LDZ2
SUB2 .term/rows LDZ2 LTH2 ,&noop JCN SUB2 .term/rows LDZ2 LTH2 ,&noop JCN
@ -545,13 +636,27 @@
;redraw-all JSR2 ;redraw-all JSR2
&noop JMP2r &noop JMP2r
( currently used to print stack information. )
@debug @debug
;messages/rel-line-error ;error! JMP2 ;messages/rel-line-error ;error! JMP2
( 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. )
@move-to-message-line ( -> ) @move-to-message-line ( -> )
#0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2 #0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2
( when called vector should end in BRK ) ( 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. )
@start-prompt ( prompt* default* vector* -> ) @start-prompt ( prompt* default* vector* -> )
.prompt/active LDZ ,&is-active JCN .prompt/active LDZ ,&is-active JCN
#01 .prompt/active STZ ( prompt/active <- 1 ) #01 .prompt/active STZ ( prompt/active <- 1 )
@ -572,18 +677,22 @@
;redraw-prompt-and-cursor JSR2 ;redraw-prompt-and-cursor JSR2
;return JMP2 ;return JMP2
( when called vector should end in BRK ) ( finishes prompt and executes callback )
( )
( when called vector should end in a BRK instruction )
@finish-prompt ( -> ) @finish-prompt ( -> )
#00 .prompt/active STZ #00 .prompt/active STZ
;clear-message-line JSR2 ;clear-message-line JSR2
;redraw-prompt-and-cursor JSR2 ;redraw-prompt-and-cursor JSR2
.prompt/vector LDZ2 JMP2 .prompt/vector LDZ2 JMP2
( begin saving the file, prompting the user for a fiel name )
@save @save
;messages/save-prompt ;filename ;do-save ;start-prompt JSR2 ;messages/save-prompt ;filename ;do-save ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;redraw-prompt-and-cursor JSR2
;return JMP2 ;return JMP2
( save the file with the filename found in tmp/data )
@do-save ( -> ) @do-save ( -> )
.buffer/limit LDZ2 ;data SUB2 STH2 ( [size] ) .buffer/limit LDZ2 ;data SUB2 STH2 ( [size] )
;tmp/data .File/name DEO2 ;tmp/data .File/name DEO2
@ -601,11 +710,13 @@
.state/quitting LDZ ;quit-now JCN2 .state/quitting LDZ ;quit-now JCN2
;return JMP2 ;return JMP2
( begin a search, prompting for a search string )
@search ( -> ) @search ( -> )
;messages/search-prompt ;messages/null ;do-search ;start-prompt JSR2 ;messages/search-prompt ;messages/null ;do-search ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;redraw-prompt-and-cursor JSR2
;return JMP2 ;return JMP2
( execute a search, using the given search string )
@do-search ( -> ) @do-search ( -> )
.cursor/row LDZ2 .searching/orig-row STZ2 .cursor/row LDZ2 .searching/orig-row STZ2
.cursor/col LDZ2 .searching/orig-col STZ2 .cursor/col LDZ2 .searching/orig-col STZ2
@ -618,10 +729,14 @@
;redraw-matches JSR2 ;redraw-matches JSR2
;return JMP2 ;return JMP2
( begin a search, prompting for a regular expression )
@regex-search ( -> ) @regex-search ( -> )
;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2 ;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2
;redraw-prompt-and-cursor JSR2 ;return JMP2 ;redraw-prompt-and-cursor JSR2 ;return JMP2
( execute a search, using the given regular expressions )
( )
( TODO: handle invalid regular expressions that fail to compile )
@do-regex-search ( -> ) @do-regex-search ( -> )
;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2 ;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2
.cursor/row LDZ2 .searching/orig-row STZ2 .cursor/row LDZ2 .searching/orig-row STZ2
@ -635,16 +750,35 @@
;redraw-matches JSR2 ;redraw-matches JSR2
;return JMP2 ;return JMP2
( toggle the color used by the terminal )
( )
( available colors are: )
( - black )
( - red )
( - green )
( - yellow )
( - blue )
( - magenta )
( - cyan )
( - white )
@toggle-color ( -> ) @toggle-color ( -> )
.config/color LDZ2 #3733 EQU2 ,&wrap-around JCN .config/color LDZ2 #3733 EQU2 ,&wrap-around JCN
.config/color LDZ2 #0100 ADD2 .config/color STZ2 ,&done JMP .config/color LDZ2 #0100 ADD2 .config/color STZ2 ,&done JMP
&wrap-around #3033 .config/color STZ2 &wrap-around #3033 .config/color STZ2
&done ;redraw-all JSR2 ;return JMP2 &done ;redraw-all JSR2 ;return JMP2
( toggle whether to use literal tab characters )
( )
( when opening a file, this defaults to 01 if existing tab )
( characters are found, and 00 otherwise. )
@toggle-tabs ( -> ) @toggle-tabs ( -> )
.config/insert-tabs LDZk #01 EOR SWP STZ .config/insert-tabs LDZk #01 EOR SWP STZ
;redraw-statusbar-and-cursor JSR2 ;return JMP2 ;redraw-statusbar-and-cursor JSR2 ;return JMP2
( interpret user input as an escaped sequence )
( )
( called by on-key with state/saw-esc is true )
( )
( TODO: M-f and M-b for next/previous word ) ( TODO: M-f and M-b for next/previous word )
( M-n and M-p for next/previous paragraph ) ( M-n and M-p for next/previous paragraph )
( maybe M-% for search&replace ) ( maybe M-% for search&replace )
@ -660,9 +794,22 @@
.state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2 .state/key LDZ LIT '[ EQU ( M-[ ) ;xterm JCN2
BRK BRK
( 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 )
@xterm @xterm
#01 .state/saw-xterm STZ BRK #01 .state/saw-xterm STZ BRK
( 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. )
@on-key-vt ( -> ) @on-key-vt ( -> )
.state/saw-vt LDZk STH #00 SWP STZ .state/saw-vt LDZk STH #00 SWP STZ
.state/key LDZ LIT '~ EQU ,&ok JCN .state/key LDZ LIT '~ EQU ,&ok JCN
@ -687,6 +834,12 @@
&not-8 &not-8
( ??? ) POP BRK ( ??? ) POP BRK
( 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. )
@on-key-xterm ( -> ) @on-key-xterm ( -> )
#00 .state/saw-xterm STZ #00 .state/saw-xterm STZ
.state/key LDZ LIT 'A EQU ( ^[[A -> up ) ;up JCN2 .state/key LDZ LIT 'A EQU ( ^[[A -> up ) ;up JCN2
@ -700,9 +853,17 @@
.state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 ) .state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 )
BRK BRK
( ANSI control sequence to clear the current line )
@clear-line ( -> ) @clear-line ( -> )
ansi emit-2 emit-K JMP2r ansi emit-2 emit-K JMP2r
( 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. )
@clear-message-line @clear-message-line
.state/message LDZ #00 EQU ,&done JCN .state/message LDZ #00 EQU ,&done JCN
;move-to-message-line JSR2 ;move-to-message-line JSR2
@ -710,12 +871,20 @@
#00 .state/message STZ #00 .state/message STZ
&done JMP2r &done JMP2r
( cancel the active search )
( )
( this method unsets searching/active and also restores )
( the original cursor position. )
@cancel-search @cancel-search
#00 .searching/active STZ #00 .searching/active STZ
.searching/orig-row LDZ2 ;jump-to-line JSR2 .searching/orig-row LDZ2 ;jump-to-line JSR2
.searching/orig-col LDZ2 .cursor/col STZ2 .searching/orig-col LDZ2 .cursor/col STZ2
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
( cancel the active search )
( )
( this method unsets searching/active. unlike ;cancel-search )
( this leaves the cursor where it is. )
@finish-search @finish-search
#00 .searching/active STZ #00 .searching/active STZ
;redraw-all JSR2 ;return JMP2 ;redraw-all JSR2 ;return JMP2
@ -725,19 +894,35 @@
( a global list of all matches, which means that currently ) ( a global list of all matches, which means that currently )
( it can change in response to e.g. cursor position when ) ( it can change in response to e.g. cursor position when )
( matches overlap. ) ( matches overlap. )
( )
( 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. )
( 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. )
@jump-to-next-match ( -> ) @jump-to-next-match ( -> )
.searching/regex LDZ2 ORA ,&is-regex JCN .searching/regex LDZ2 ORA ,&is-regex JCN
;move-to-next-match JSR2 POP ;return JMP2 ;move-to-next-match JSR2 POP ;return JMP2
&is-regex &is-regex
;move-to-next-regex-match JSR2 POP ;return JMP2 ;move-to-next-regex-match JSR2 POP ;return JMP2
( 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. )
@jump-to-prev-match ( -> ) @jump-to-prev-match ( -> )
.searching/regex LDZ2 ORA ,&is-regex JCN .searching/regex LDZ2 ORA ,&is-regex JCN
;move-to-prev-match JSR2 POP ;return JMP2 ;move-to-prev-match JSR2 POP ;return JMP2
&is-regex &is-regex
;move-to-prev-regex-match JSR2 POP ;return JMP2 ;move-to-prev-regex-match JSR2 POP ;return JMP2
( move to the next substring match. )
( )
( called by ;jump-to-next-match. )
@move-to-next-match ( -> ok^ ) @move-to-next-match ( -> ok^ )
.buffer/limit LDZ2 .buffer/limit LDZ2
;cur-pos JSR2 INC2 ;cur-pos JSR2 INC2
@ -751,6 +936,9 @@
&fail &fail
POP2 POP2 #00 JMP2r POP2 POP2 #00 JMP2r
( move to the previous substring match. )
( )
( called by ;jump-to-prev-match. )
@move-to-prev-match ( -> ok^ ) @move-to-prev-match ( -> ok^ )
;data ;data
;cur-pos JSR2 #0001 SUB2 ;cur-pos JSR2 #0001 SUB2
@ -764,6 +952,9 @@
&fail &fail
POP2 POP2 #00 JMP2r POP2 POP2 #00 JMP2r
( move to the next regex match. )
( )
( called by ;jump-to-next-match. )
@move-to-next-regex-match ( -> ok^ ) @move-to-next-regex-match ( -> ok^ )
.searching/end LDZ2 .buffer/limit LDZ2 OVR2 .searching/end LDZ2 .buffer/limit LDZ2 OVR2
GTH2 ,&ok JCN GTH2 ,&ok JCN
@ -776,6 +967,10 @@
;search-start LDA2 DUP2 .searching/start STZ2 ;search-start LDA2 DUP2 .searching/start STZ2
;jump-to-pos JSR2 #01 JMP2r ;jump-to-pos JSR2 #01 JMP2r
( move to the previous substring match. )
( )
( called by ;jump-to-prev-match. )
( )
( compared to move-to-next-regex-match this is kind of inefficient. ) ( 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. ) ( that's because we have no easy way to search backwards from a point. )
( ) ( )
@ -802,6 +997,13 @@
&fail &fail
JMP2r JMP2r
( 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) )
@on-key-searching @on-key-searching
.state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2 .state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2
.state/key LDZ #0d EQU ( \r ) ;finish-search JCN2 .state/key LDZ #0d EQU ( \r ) ;finish-search JCN2
@ -811,6 +1013,19 @@
.state/key LDZ #70 EQU ( p ) ;jump-to-prev-match JCN2 .state/key LDZ #70 EQU ( p ) ;jump-to-prev-match JCN2
;ignore JMP2 ;ignore JMP2
( 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. )
@on-key-prompt @on-key-prompt
.state/key LDZ #07 EQU ( C-g ) ;cancel-prompt JCN2 .state/key LDZ #07 EQU ( C-g ) ;cancel-prompt JCN2
.state/key LDZ #0d EQU ( \r ) ;finish-prompt JCN2 .state/key LDZ #0d EQU ( \r ) ;finish-prompt JCN2
@ -820,7 +1035,19 @@
.state/key LDZ ( printable ASCII ) ;insert-prompt JMP2 .state/key LDZ ( printable ASCII ) ;insert-prompt JMP2
BRK BRK
( 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. )
( )
( TODO: C-h for help ) ( TODO: C-h for help )
( )
( 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. )
@on-key @on-key
.Console/read DEI .state/key STZ .Console/read DEI .state/key STZ
;clear-message-line JSR2 ;clear-message-line JSR2
@ -829,12 +1056,12 @@
.state/saw-vt LDZ ;on-key-vt JCN2 .state/saw-vt LDZ ;on-key-vt JCN2
.state/saw-xterm LDZ ;on-key-xterm JCN2 .state/saw-xterm LDZ ;on-key-xterm JCN2
.state/saw-esc LDZ ;on-key-escaped JCN2 .state/saw-esc LDZ ;on-key-escaped JCN2
.state/key LDZ #01 EQU ( C-a ) ;bol JCN2 .state/key LDZ #01 EQU ( C-a ) ;bol JCN2
.state/key LDZ #02 EQU ( C-b ) ;back JCN2 .state/key LDZ #02 EQU ( C-b ) ;back JCN2
.state/key LDZ #04 EQU ( C-d ) ;delete JCN2 .state/key LDZ #04 EQU ( C-d ) ;delete JCN2
.state/key LDZ #05 EQU ( C-e ) ;eol JCN2 .state/key LDZ #05 EQU ( C-e ) ;eol JCN2
.state/key LDZ #06 EQU ( C-f ) ;forward JCN2 .state/key LDZ #06 EQU ( C-f ) ;forward JCN2
.state/key LDZ #09 EQU ( \t ) ;insert-tab JCN2 .state/key LDZ #09 EQU ( \t ) ;insert-tab JCN2
.state/key LDZ #0c EQU ( C-l ) ;center-view JCN2 .state/key LDZ #0c EQU ( C-l ) ;center-view JCN2
.state/key LDZ #0d EQU ( \r ) ;newline JCN2 .state/key LDZ #0d EQU ( \r ) ;newline JCN2
.state/key LDZ #0e EQU ( C-n ) ;down JCN2 .state/key LDZ #0e EQU ( C-n ) ;down JCN2
@ -850,26 +1077,41 @@
.state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now ) .state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now )
.state/key LDZ ( printable ASCII ) ;insert JMP2 .state/key LDZ ( printable ASCII ) ;insert JMP2
( return the smaller of two short values )
@min2 ( x* y* -> min* ) @min2 ( x* y* -> min* )
LTH2k JMP SWP2 POP2 JMP2r LTH2k JMP SWP2 POP2 JMP2r
( ANSI control sequence to move the cursor to the given coord )
@term-move-cursor ( col* row* -> ) @term-move-cursor ( col* row* -> )
ansi INC2 ( row+1 ) ;emit-dec2 JSR2 ansi INC2 ( row+1 ) ;emit-dec2 JSR2
emit-; INC2 ( col+1 ) ;emit-dec2 JSR2 emit-; INC2 ( col+1 ) ;emit-dec2 JSR2
emit-H JMP2r emit-H JMP2r
( ANSI control sequence to move N positions right )
@term-move-right ( n* -> ) @term-move-right ( n* -> )
ansi ;emit-dec2 JSR2 emit-C JMP2r ansi ;emit-dec2 JSR2 emit-C JMP2r
( ANSI control sequence to get the cursor position )
@term-get-cursor-position ( -> ) @term-get-cursor-position ( -> )
ansi emit-6 emit-n JMP2r ansi emit-6 emit-n JMP2r
( ANSI control sequence to erase entire screen )
@term-erase-all ( -> ) @term-erase-all ( -> )
ansi emit-2 emit-J JMP2r ansi emit-2 emit-J JMP2r
( 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. )
@redraw-add ( n^ -> ) @redraw-add ( n^ -> )
.state/redraw LDZk ROT ORA SWP STZ JMP2r .state/redraw LDZk ROT ORA SWP STZ JMP2r
( various redrawing methods )
( )
( these don't perform a redraw right away, but instead )
( signal that the next drawing should include that part. )
@redraw-cursor ( -> ) #01 ;redraw-add JMP2 @redraw-cursor ( -> ) #01 ;redraw-add JMP2
@redraw-statusbar ( -> ) #02 ;redraw-add JMP2 @redraw-statusbar ( -> ) #02 ;redraw-add JMP2
@redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2 @redraw-statusbar-and-cursor ( -> ) #03 ;redraw-add JMP2
@ -877,6 +1119,7 @@
@redraw-matches ( -> ) #08 ;redraw-add JMP2 @redraw-matches ( -> ) #08 ;redraw-add JMP2
@redraw-all ( -> ) #1f ;redraw-add JMP2 @redraw-all ( -> ) #1f ;redraw-add JMP2
( draw the current cursor location )
@draw-cursor ( -> ) @draw-cursor ( -> )
.prompt/active LDZ ,&on-prompt JCN .prompt/active LDZ ,&on-prompt JCN
( TODO: handle long lines ) ( TODO: handle long lines )
@ -887,7 +1130,8 @@
JMP2r JMP2r
( current column in terms of display width ) ( current column in terms of display width )
( this is different due to tabs ) ( )
( this is different than ;cur-col due to tabs )
@cur-w-col ( -> col* ) @cur-w-col ( -> col* )
LIT2r 0000 ( [0] ) LIT2r 0000 ( [0] )
;cur-line JSR2 DUP2 ;cur-col JSR2 ADD2 SWP2 ( lim s [0] ) ;cur-line JSR2 DUP2 ;cur-col JSR2 ADD2 SWP2 ( lim s [0] )
@ -896,45 +1140,45 @@
&next LDAk #09 EQU ,&tabs JCN INC2 INC2r ,&loop JMP &next LDAk #09 EQU ,&tabs JCN INC2 INC2r ,&loop JMP
&tabs INC2 .config/tab-width LDZ2 STH2 ADD2r ,&loop JMP &tabs INC2 .config/tab-width LDZ2 STH2 ADD2r ,&loop JMP
( display ** if the buffer has unsaved changes, -- otherwise )
@get-save-status @get-save-status
.state/modified LDZ ,&is-modified JCN ;messages/unsaved ;messages/saved
;messages/saved JMP2r .state/modified LDZ JMP SWP2 POP2 JMP2r
&is-modified ;messages/unsaved JMP2r
( display [t] if the file uses tabs, [s] otherwise )
@get-tab-status @get-tab-status
.config/insert-tabs LDZ ,&tabs JCN ;messages/st-tabs ;messages/st-spaces
;messages/st-spaces JMP2r .config/insert-tabs LDZ JMP SWP2 POP2 JMP2r
&tabs ;messages/st-tabs JMP2r
( move the terminal cursor to the statusbar line )
@move-to-statusbar ( -> )
#0000 .term/rows LDZ2 ;term-move-cursor JMP2
( draw the full statusbar )
@draw-statusbar ( -> ) @draw-statusbar ( -> )
#0000 .term/rows LDZ2 ;term-move-cursor JSR2 ;move-to-statusbar JSR2
;emit-color-reverse JSR2 ;emit-color-reverse JSR2
LIT2r 2018
.term/cols LDZ2 #0000
&loop GTH2k ,&continue JCN ,&done JMP
&continue DEOkr INC2 ,&loop JMP
&done POP2 POP2 POP2r
#0000 .term/rows LDZ2 ;term-move-cursor JSR2 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
;get-save-status JSR2 ;print JSR2 ;get-save-status JSR2 ;print JSR2
;filename ;print JSR2 ;filename ;print JSR2
sp sp emit-[
emit-[
.buffer/limit LDZ2 ;data SUB2 ;emit-dec2 JSR2 .buffer/limit LDZ2 ;data SUB2 ;emit-dec2 JSR2
;messages/bytes ;print JSR2 ;messages/bytes ;print JSR2
sp sp
.buffer/line-count LDZ2 ;emit-dec2 JSR2 .buffer/line-count LDZ2 ;emit-dec2 JSR2
;messages/lines ;print JSR2 ;messages/lines ;print JSR2
sp sp emit-(
emit-(
;cur-col JSR2 INC2 ;emit-dec2 JSR2 ;cur-col JSR2 INC2 ;emit-dec2 JSR2
emit-, emit-,
.cursor/row LDZ2 INC2 ;emit-dec2 JSR2 .cursor/row LDZ2 INC2 ;emit-dec2 JSR2
emit-) emit-) sp
sp
;get-tab-status JSR2 ;print JSR2 ;get-tab-status JSR2 ;print JSR2
;emit-reset JSR2 ;emit-reset JMP2
JMP2r
@draw-prompt ( -> ) @draw-prompt ( -> )
;clear-message-line JSR2 ;clear-message-line JSR2
@ -957,15 +1201,11 @@
@matches-at ( s* -> limit* ) @matches-at ( s* -> limit* )
LIT2r :tmp/data LIT2r :tmp/data
&loop &loop LDAkr STHr #00 EQU ,&done JCN
LDAkr STHr ,&non-zero JCN ,&done JMP LDAk LDAkr STHr NEQ ,&fail JCN
&non-zero INC2 INC2r ,&loop JMP
LDAk LDAkr STHr NEQ ,&fail JCN &fail POP2 #0000
INC2 INC2r ,&loop JMP &done POP2r JMP2r
&done
POP2r JMP2r
&fail
POP2r POP2 #0000 JMP2r
@draw-region ( offset* limit* col* row* -> ) @draw-region ( offset* limit* col* row* -> )
OVR2 ( offset limit col row col ) OVR2 ( offset limit col row col )
@ -977,7 +1217,7 @@
DUP2 STH2kr LTH2 ,&continue JCN ,&done JMP DUP2 STH2kr LTH2 ,&continue JCN ,&done JMP
&continue ( i [cutoff] ) &continue ( i [cutoff] )
LDAk #00 EQU ,&done JCN LDAk #00 EQU ,&done JCN
LDAk #18 DEO INC2 ,&loop JMP LDAk #18 DEO INC2 ,&loop JMP
&done &done
POP2 POP2r JMP2r POP2 POP2r JMP2r
@ -1121,7 +1361,7 @@
&skip-8 DUP #04 AND ,&do-4 JCN ,&skip-4 JMP &do-4 ;draw-prompt 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-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 &skip-2 DUP #01 AND ,&do-1 JCN ,&finish JMP &do-1 ;draw-cursor JSR2 ,&finish JMP
&draw-all .counter LDZ2k INC2 ROT STZ2 ;draw-all JSR2 &draw-all ;draw-all JSR2
&finish POP #00 .state/redraw STZ BRK &finish POP #00 .state/redraw STZ BRK
@str-copy ( src* dst* -> ) @str-copy ( src* dst* -> )
@ -1202,6 +1442,7 @@
@rel-line ( y* -> s* ) @rel-line ( y* -> s* )
.buffer/offset LDZ2 SWP2 ;line-to-pos JMP2 .buffer/offset LDZ2 SWP2 ;line-to-pos JMP2
( return a pointer to the current line )
@cur-line ( -> s* ) @cur-line ( -> s* )
.cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2k .cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2k
.term/rows LDZ2 LTH2 ,&ok JCN .term/rows LDZ2 LTH2 ,&ok JCN
@ -1209,9 +1450,11 @@
&ok &ok
SUB2 ;rel-line JMP2 SUB2 ;rel-line JMP2
( return a pointer to the current cursor position )
@cur-pos ( -> s* ) @cur-pos ( -> s* )
;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r ;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r
( insert one character at the cursor position )
@shift-right ( c^ addr* -> ) @shift-right ( c^ addr* -> )
ROT STH ( addr [prev^] ) ROT STH ( addr [prev^] )
;last-pos JSR2 SWP2 ( last addr [prev^] ) ;last-pos JSR2 SWP2 ( last addr [prev^] )
@ -1226,6 +1469,8 @@
.buffer/limit STZ2 ( ) .buffer/limit STZ2 ( )
JMP2r JMP2r
( remove one character at the cursor position )
( )
( TODO: change last/addr order and GTH -> LTH to remove hack ) ( TODO: change last/addr order and GTH -> LTH to remove hack )
@shift-left ( addr* -> ) @shift-left ( addr* -> )
;last-pos JSR2 SWP2 ( last addr ) ;last-pos JSR2 SWP2 ( last addr )
@ -1244,46 +1489,42 @@
@cur-col ( -> col* ) @cur-col ( -> col* )
.cursor/col LDZ2 ;cur-len JSR2 ;min2 JMP2 .cursor/col LDZ2 ;cur-len JSR2 ;min2 JMP2
( jump to the first line in the buffer )
@zero-row ( -> ) @zero-row ( -> )
;data .buffer/offset STZ2 ;data .buffer/offset STZ2
#0000 .buffer/line-offset STZ2 #0000 .buffer/line-offset STZ2
#0000 .cursor/row STZ2 #0000 .cursor/row STZ2
JMP2r JMP2r
( return the location of the last character in the buffer )
@last-pos ( -> addr* ) @last-pos ( -> addr* )
.buffer/limit LDZ2 #0001 SUB2 JMP2r .buffer/limit LDZ2 #0001 SUB2 JMP2r
@mod-div2 ( x^ y^ -> x%d x/y ) ( emit a short as a decimal )
DIV2k STH2k MUL2 SUB2 STH2r JMP2r
@emit-digit ( n^ -> )
LIT '0 ADD emit JMP2r
@emit-dec2 ( n* -> ) @emit-dec2 ( n* -> )
DUP2 #270f GTH2 ,&do5 JCN LITr 00 ( n [0] )
DUP2 #03e7 GTH2 ,&do4 JCN &read ( n [k] )
DUP2 #0063 GTH2 ,&do3 JCN #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
DUP2 #0009 GTH2 ,&do2 JCN DUP2 ORA ,&read JCN
,&do1 JMP POP2 ( top element was 0000 )
&do5 #2710 ;mod-div2 JSR2 NIP ;emit-digit JSR2 &write ( n0 n1 ... nk [k+1] )
&do4 #03e8 ;mod-div2 JSR2 NIP ;emit-digit JSR2 NIP #30 ADD #18 DEO LITr 01 SUBr ( n0 ... n{k-1} [k] )
&do3 #0064 ;mod-div2 JSR2 NIP ;emit-digit JSR2 STHkr ,&write JCN
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2 POPr JMP2r
&do1 NIP ;emit-digit JMP2
( emit a short as a decimal with leading spaces )
@emit-dec2-pad ( n* -> ) @emit-dec2-pad ( n* -> )
LIT2r 2018 ( preload #20 .Console/write into rst ) #00 ,&zero STR
DUP2 #270f GTH2 ,&do5 JCN DEOkr #2710 ,&parse JSR
DUP2 #03e7 GTH2 ,&do4 JCN DEOkr #03e8 ,&parse JSR
DUP2 #0063 GTH2 ,&do3 JCN DEOkr #0064 ,&parse JSR
DUP2 #0009 GTH2 ,&do2 JCN DEOkr #000a ,&parse JSR
,&do1 JMP ,&emit JSR POP sp JMP2r
&do5 #2710 ;mod-div2 JSR2 NIP ;emit-digit JSR2 &parse DIV2k DUP ,&emit JSR MUL2 SUB2 JMP2r
&do4 #03e8 ;mod-div2 JSR2 NIP ;emit-digit JSR2 &emit DUP [ LIT &zero $1 ] #0000 EQU2 ,&skip JCN
&do3 #0064 ;mod-div2 JSR2 NIP ;emit-digit JSR2 #01 ,&zero STR
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2 #30 ADD #18 DEO JMP2r
&do1 NIP ;emit-digit JSR2 &skip POP sp JMP2r
DEOr JMP2r
( various string constants used as messages for the user ) ( various string constants used as messages for the user )
@messages [ &null 00 @messages [ &null 00
@ -1302,10 +1543,13 @@
&saved "-- 20 00 &saved "-- 20 00
&unsaved "** 20 00 &unsaved "** 20 00
&term-size-parse-error "error 20 "parsing 20 "term 20 "size 00 &term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
&rel-line-error "invalid 20 "relative 20 "line 20 "number 00 &rel-line-error "invalid 20 "relative 20 "line 20 "number 00
&st-tabs "[t] 00 &st-tabs "[t] 00
&st-spaces "[s] 00 &st-spaces "[s] 00
] ]
@filename $80 ( path to file being edited ) ( path to file being edited )
@data $c950 ( actual file data to be edited ) @filename $80
( actual file data to be edited )
@data $c950