nxu/femto.tal

( femto.tal                                  )
(                                            )
( requires terminal to be in raw mode        )
( see femto launcher script for more details )

( TODO: )
( - get long line truncation/scrolling working )
( - allow line numbers to be toggled off )
( - open file command? )
( - close file command? )
( - search&replace )

|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 ]

( MAX file size is currently #ce80, i.e. 52864 bytes )

%dbg { #ff .System/debug DEO }
%emit { .Console/write DEO }
%sp { #2018 DEO }
%nl { #0a18 DEO }
%cr { #0d18 DEO }
%crlf { cr nl }
%ansi { #1b18 DEO #5b18 DEO }

( emit macros )
( )
( these save one byte and are easier to read. )
%emit-! { LIT2 "! 18 DEO }
%emit-$ { LIT2 "$ 18 DEO }
%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 }
%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 }
%emit-] { LIT2 "] 18 DEO }
%emit-m { LIT2 "m 18 DEO }
%emit-n { LIT2 "n 18 DEO }
%emit-~ { LIT2 "~ 18 DEO }

%quit! { #01 .System/halt DEO BRK }
%lmargin { #0006 }

( zero page )
|0000

( terminal size information )
( )
( for now these are constant but eventually we could detect terminal resizes )
@term [
    &cols $2        ( relative x coordinate of cursor, from 0 )
    &rows $2        ( relative y coordinate of cursor, from 1 )
]

( configuration settings used when editing )
( )
( these can be changed at any time without breaking anything else )
@config [
    &tab-width $2    ( how many spaces to display tab chars )
    &tab-adjust $2   ( how many "extra" spaces; tab-width - 1 )
    &insert-tabs $1  ( tab key inserts tabs when true )
    &color $2        ( digits of highlight color in reverse order )
    &red $2          ( digits of color for line/EOF markers in reverse order )
]

( tracks information related to the buffer's view of data )
( )
( limit and line-count change when we modify the buffer. )
( offset and line-offset change when we move the view port. )
@buffer [
    &limit $2       ( last byte of actual data (not including \0) + 1 )
    &line-count $2  ( total number of lines in file )
    &offset $2      ( first byte of data visible in terminal )
    &line-offset $2 ( first line of text visible in terminal )
]

( relative cursor positions, e.g. 0 to cols-1 )
( )
( when these change we may need to move the view port as well )
@cursor [
    &col $2         ( current column value 0-n (may exceed lenght of row) )
    &row $2         ( current relative row value, 0-(height-1) )
]

( tracks overall editor state between events )
@state [
    &in-help $1     ( are we showing help? )
    &in-undo $1     ( are we currently in undo? )
    &key $1         ( last key read )
    &saw-esc $1     ( did we just see ESC? )
    &saw-xterm $1   ( did we just see an ESC [ xterm sequence? )
    &saw-vt $1      ( did we just see an ESC [ $N vt sequence? )
    &redraw $1      ( redrawing: bits determine which parts )
                        ( 0x01 cursor )
                        ( 0x02 statusbar )
                        ( 0x04 prompt )
                        ( 0x08 matches )
                        ( 0x10 body and everything else )
    &message $1     ( did we just print a message? )
    &modified $1    ( has the buffer been modified? )
    &quitting $1    ( are we in the process of quitting? )
]

( prompt uses .tmp/pos and .tmp to track user input )
@prompt [
    &active $1      ( is prompt currently active? )
    &vector $2      ( what code to run when user responds )
    &string $2      ( string to print for the prompt )
]

( temporary input buffer used for a variety of things )
@tmp [
    $80             ( small scratch pad when reading data )
    &pos $2         ( temporary pointer to address when reading data )
]

( search uses .tmp/pos and .tmp to track query string )
@searching [
    &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 )
]

( startup )
|0100
    ( init zero page )
    #0050 .term/cols STZ2
    #0018 .term/rows STZ2
    #0004 .config/tab-width STZ2
    #0003 .config/tab-adjust STZ2
    #00   .config/insert-tabs STZ
    #3333 .config/color STZ2
(    #3133 .config/red STZ2 )
(    #3033 .config/color STZ2 )
    #3033 .config/red STZ2
    ;data .buffer/offset STZ2

    ( start reading the filename from argv )
    ;filename .tmp/pos STZ2
    ;read-filename .Console/vector DEO2
    BRK

( import uxn regex library )
~regex.tal

( ERROR HANDLING )

( using errorq will print the given message before causing )
( the interpreter to halt. )
@errorq ( msg* -> )
    emit-! sp print nl 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* -> )
                 .File/name   DEO2
           #ce81 .File/length DEO2
    ;data .File/read   DEO2

    .File/success DEI2 #0000 EQU2 .state/modified STZ
    .File/success DEI2 #ce81 LTH2 ?&ok
    crlf
    ;messages/input-error print
    ;filename print crlf quit!

    ( calculate buffer limit address using start + size )
    &ok .File/success DEI2 ;data ADD2 .buffer/limit STZ2
    JMP2r

( ask the terminal for its size )
( )
( called during editor initialization by ;read-filename )
( )
( TODO: consider supporting terminal resizing )
@setup-terminal-size ( -> )
    #03e7 DUP2 term-move-cursor
    term-get-cursor-position
    ;tmp .tmp/pos STZ2
    ;receive-terminal-size .Console/vector DEO2
    JMP2r

( receive size information from the terminal )
( )
( called from Console/vector after ;setup-terminal-size )
@receive-terminal-size ( -> )
    .Console/read DEI .state/key STZ
    .state/key LDZ .tmp/pos LDZ2 STA
    .tmp/pos LDZ2 INC2 .tmp/pos STZ2
    .state/key LDZ LIT "R EQU ?parse-terminal-size
    BRK

( parse and store terminal size information )
( )
( called by ;receive-terminal-size after complete message received )
@parse-terminal-size ( -> )
    #0000 ,&acc STR2
    .tmp LDZk #1b NEQ ?&parse-error ( i ) INC
         LDZk LIT "[ NEQ ?&parse-error ( i ) INC
    &loop
        LDZk LIT "; EQU ?&parse-col
        LIT2r =&loop !&read
    &parse-col
        INC ,&acc LDR2 #0002 SUB2 .term/rows STZ2
        #0000 ,&acc STR2
    &loop2
        LDZk LIT "R EQU ?&done
        LIT2r =&loop2 !&read
    &read
        LDZk LIT "0 SUB #00 SWP
        ,&acc LDR2 #000a MUL2 ADD2 ,&acc STR2
        INC JMP2r
    &done
        ,&acc LDR2 .term/cols STZ2 POP
        ;on-key .Console/vector DEO2
        draw-all
        BRK
    [ &acc $2 ]
    &parse-error POP .tmp LDZ2
                 ;messages/term-size-parse-error !errorq

@count-c ( c^ -> n* )
    STH #0000 ;data             ( 0* data* [c^] )
    &loop LDAk #00 EQU ?&done   ( n* data* [c^] )
          LDAk STHkr NEQ ?&next ( n* data* [c^] )
          SWP2 INC2 SWP2        ( n+1* data* [c^] )
    &next INC2 !&loop           ( n+1* data+1* [c^] )
    &done POP2 POPr JMP2r       ( n* )

( 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 ( -> )
    #0a count-c INC2 .buffer/line-count STZ2
    #09 count-c #0000 GTH2 .config/insert-tabs STZ
    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 ( -> )
    #12 DEI #0a EQU ?&execute      ( did we read \n ? )
    #12 DEI .tmp/pos LDZ2 STA          ( no, so save in buffer )
    .tmp/pos LDZ2 INC2 .tmp/pos STZ2   ( pos++ )
    BRK                                ( return )

    &execute                           ( we saw a newline, so do something )
    #00 .tmp/pos LDZ2 STA              ( null terminate str )
    ;filename open-file          ( open file )
    setup-linecount              ( determine # of lines )
    setup-terminal-size          ( detect terminal dimensions )
    BRK

( jump to beginning of line )
@bol ( -> )
    #0000 .cursor/col STZ2
    redraw-statusbar-and-cursor
    !return

( jump to beginning of line )
@eol ( -> )
    cur-len .cursor/col STZ2
    redraw-statusbar-and-cursor
    !return

@forward ( -> )
    go-forward !return

( move forward by one character )
@go-forward ( -> )
    cur-pos last-pos GTH2 ( ?return ) ?&noop
    redraw-statusbar-and-cursor
    cur-col cur-len LTH2 ?&normal
        #0000 .cursor/col STZ2
        .cursor/row LDZ2 INC2 .cursor/row STZ2
        !ensure-visible-cursor
    &normal
        cur-col INC2 .cursor/col STZ2
    &noop JMP2r

( move backward by one character )
@back ( -> )
    go-back !return

( internal implementation shared by ;back and ;backspace )
@go-back ( -> )
    cur-pos ;data EQU2 ?&noop
    cur-col #0001 LTH2 ?&next-line
        cur-col #0001 SUB2 .cursor/col STZ2
        !redraw-statusbar-and-cursor
    &next-line
        .cursor/row LDZ2k #0001 SUB2 ROT STZ2
        cur-len .cursor/col STZ2
        ensure-visible-cursor
        redraw-statusbar-and-cursor
    &noop JMP2r

( move up by one line )
@up ( -> )
    .cursor/row LDZ2 #0000 EQU2 ?return
    .cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2
    ensure-visible-cursor
    redraw-statusbar-and-cursor
    !return

( move down by one line )
@down ( -> )
    .cursor/row LDZ2
    .buffer/line-count LDZ2 #0001 SUB2 EQU2 ?return
    .cursor/row LDZ2 INC2 .cursor/row STZ2
    ensure-visible-cursor
    redraw-statusbar-and-cursor
    !return

@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 #00 EQU JMP2r

@forward-by-word ( -> )
    cur-pos
    &first
        LDAk #00 EQU ?&done
        LDAk is-word-char ?&second
        INC2 go-forward !&first
    &second
        LDAk #00 EQU ?&done
        LDAk not-word-char ?&done
        INC2 go-forward !&second
    &done
        POP2 !return

@back-by-word ( -> )
    cur-pos #0001 SUB2
    &first
        DUP2 ;data LTH2 ?&done
        LDAk is-word-char ?&second
        #0001 SUB2 go-back !&first
    &second
        DUP2 ;data LTH2 ?&done
        LDAk not-word-char ?&done
        #0001 SUB2 go-back !&second
    &done
        POP2 !return

@help
    #01 .state/in-help STZ
    term-erase-all
    #0000 #0000 term-move-cursor
    emit-color-bold
    ;help-text print
    emit-reset
    redraw-all
    BRK

( center buffer view on the current line )
@center-view
    .term/rows LDZ2 INC2 #0002 DIV2 STH2k
    .cursor/row LDZ2 LTH2 ?&standard
        POP2r
        #0000 .buffer/line-offset STZ2
        ;data .buffer/offset STZ2
        !&done
    &standard
        .cursor/row LDZ2 STH2r SUB2
        DUP2 .buffer/line-offset STZ2
        abs-line .buffer/offset STZ2
    &done
        redraw-all !return

( move up by one page )
@page-up ( -> )
    .term/rows LDZ2 #0002 SUB2 STH2k
    .buffer/line-offset LDZ2 LTH2 ?&move-full
        POP2r
        zero-row
        #0000 .cursor/col STZ2
        !&done
    &move-full
        .cursor/row LDZ2 STH2kr SUB2 .cursor/row STZ2
        .buffer/line-offset LDZ2 STH2r SUB2
                  DUP2 .buffer/line-offset STZ2
        abs-line .buffer/offset STZ2
    &done
        redraw-all !return

( move down by one page )
@page-down
    eof-is-visible ?&near-eof
        .term/rows LDZ2 #0002 SUB2 STH2k
        .buffer/line-offset LDZ2 ADD2
                      DUP2 .buffer/line-offset STZ2
            abs-line .buffer/offset STZ2
        .cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2
        redraw-all !return
    &near-eof
        .buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
        cur-len .cursor/col STZ2
        redraw-cursor !return

( 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
    #01 .state/quitting STZ
    .state/modified LDZ #00 EQU ?quit-now
    ;messages/quit-prompt ;messages/null ;do-quit start-prompt
    redraw-prompt-and-cursor !return

( display two strings on the message line )
( )
( often this involves a static messages + an argument like ;tmp. )
( )
( use messages/null for the second string if only one is needed. )
@send-message ( s1* s2* -> )
    #01 .state/message STZ
    move-to-message-line
    SWP2 print !print

( callback executed in response to the quit prompt. )
@do-quit
    .tmp LDZ LIT "n EQU ?quit-now
    .tmp LDZ LIT "y EQU ?save
        #00 .state/quitting STZ
        ;messages/unknown-input ;tmp send-message
        BRK

( label that calls quit! )
( )
( this definition is needed so the address can be used by JCN2. )
@quit-now quit!

( label that calls BRK )
( )
( this definition is needed so the address can be used by JCN2. )
@ignore
    BRK

( insert the given character at the cursor position )
( )
( this should not be called for newlines, see ;newline )
@insert ( c^ -> )
    cur-pos shift-right
    cur-col INC2 .cursor/col STZ2
    redraw-all !return

( insert the given character in the prompt )
@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 )
    redraw-prompt-and-cursor !return

( 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 ( -> )
    .config/insert-tabs LDZ ?&use-tabs
    #0000 .config/tab-width LDZ2 SUB2
    &loop
        DUP2 #0000 EQU2 ?&done
        #20 cur-pos shift-right
        INC2 !&loop
    &done
        cur-col .config/tab-width LDZ2 ADD2 .cursor/col STZ2
        redraw-all !return
    &use-tabs
        #09 !insert

( insert a newline at the cursor position )
@newline ( c^ -> )
    #0a cur-pos shift-right
    #0000 .cursor/col STZ2
    .cursor/row LDZ2 INC2 .cursor/row STZ2
    .buffer/line-count LDZ2k INC2 ROT STZ2
    ensure-visible-cursor
    redraw-all !return

( delete the character to the left of the cursor, if any )
@backspace ( -> )
    cur-pos ;data EQU2 ?return
    go-back !delete

( delete the last character in the prompt )
@backspace-prompt ( -> )
    .tmp/pos LDZ2 ;tmp EQU2 ?&skip ( ?return )
    #00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 )
    STH2k STA ( data[pos-1] <- 0 )
    STH2r .tmp/pos STZ2 ( pos <- pos-1 )
    &skip redraw-prompt-and-cursor !return

( delete the character under the cursor, if any )
@delete ( -> )
    last-pos cur-pos LTH2 ?return
    cur-pos LDAk STH ( cur [c] )
    shift-left ( [c] )
    STHr #0a NEQ ?&not-newline
    .buffer/line-count LDZ2k #0001 SUB2 ROT STZ2
    &not-newline redraw-all !return

( 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 ( -> )
    #01 .state/saw-esc STZ BRK

( move to the end of the file )
@goto-end ( -> )
    .buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2
    .buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ?&use-zero
        SUB2 #0002 ADD2 !&continue
    &use-zero
        POP2 POP2 #0000
    &continue
        DUP2 .buffer/line-offset STZ2
        abs-line .buffer/offset STZ2
        cur-len .cursor/col STZ2
        redraw-all !return

( move to the start of the file )
@goto-start ( -> )
    zero-row
    #0000 .cursor/col STZ2
    redraw-all !return

( prompt for a line number and move to that line )
@goto-line ( -> )
    ;messages/goto-line ;messages/null ;do-goto-line start-prompt
    redraw-prompt-and-cursor !return

( 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^ )
        LDAk ?&non-empty
            #00 JMP2r
    &non-empty
        LIT2r 0000
    &loop
        LDAk ?&continue
            POP2 STH2r #01 JMP2r
    &continue
        LDAk LIT "0 LTH ?&fail
        LDAk LIT "9 GTH ?&fail
            LIT2r 000a MUL2r
            LDAk LIT "0 SUB #00 SWP STH2 ADD2r
            INC2 !&loop
    &fail
        POP2r #00 JMP2r

( go to the given line number )
( )
( this is used as a callback from the goto-line prompt )
@do-goto-line ( n* -> )
    ;tmp parse-decimal-number
        ?&ok
        ;messages/unknown-input ;tmp send-message
        !return
    &ok
        #0001 SUB2 ( convert 1-indexing to 0-indexing )
        DUP2 .buffer/line-count LDZ2 LTH2 ?&within
        POP2 !goto-end
    &within
        jump-to-line
        redraw-all !return

( move the cursor to the given coordinates )
( )
( this won't move the display if the given coordinates are visible. )
@move-to-coord ( col* row* -> )
    DUP2 line-is-visible ?jump-to-coord/short
    !jump-to-coord

( move the cursor to the given coordinates )
( )
( this will always ensure the display is centered on the given coordinates )
@jump-to-coord ( x* y* -> )
    .term/rows LDZ2 INC2 #0002 DIV2 LTH2k ( x y rows/2 y<rows/2? ) ?&early
    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 ( x y y-rows/2 lines-rows )
    POP2 !&finish
    &early ( x y rows/2 )
        POP2 #0000 !&finish ( x y 0000 )
    &late ( x y y-rows/2 lines-rows )
        NIP2
    &finish ( x y o )
        redraw-all
        SUB2k STH2 DUP2 ( x y o o [y-o] )
        .buffer/line-offset STZ2 ( x y o [y-o] )
        abs-line .buffer/offset STZ2 ( x y [y-o] )
        POP2r
    &short
        redraw-statusbar-and-cursor
        .cursor/row STZ2 ( x )
        .cursor/col STZ2
        JMP2r

( jump to the given line number )
@jump-to-line ( n* -> )
    #0000 SWP2 !jump-to-coord

( 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
    .cursor/row LDZ2 .buffer/line-offset LDZ2
    SUB2 .term/rows LDZ2 LTH2 ?&noop
    .cursor/row LDZ2 jump-to-line
    redraw-all
    &noop JMP2r

( currently used to print stack information. )
@debug
    ;messages/input-error !errorq

( 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 ( -> )
    #0000 .term/rows LDZ2 #0002 ADD2 !term-move-cursor

( 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* -> )
    .prompt/active LDZ ?&is-active
        #01 .prompt/active STZ        ( prompt/active <- 1 )
        .prompt/vector STZ2           ( prompt/vector <- vector )
        ;tmp str-copy ( tmp <- default )
        ;tmp ADD2 .tmp/pos STZ2  ( tmp/pos <- len(default)+data )
        .prompt/string STZ2           ( prompt/string <- prompt )
        JMP2r
    &is-active
        #0000 DIV

( ends prompt without calling vector )
@cancel-prompt ( -> )
    #00 .prompt/active STZ
    #00 .state/quitting STZ
    clear-message-line
    redraw-prompt-and-cursor
    !return

( finishes prompt and executes callback )
( )
( when called vector should end in a BRK instruction )
@finish-prompt ( -> )
    #00 .prompt/active STZ
    clear-message-line
    redraw-prompt-and-cursor
    .prompt/vector LDZ2 JMP2

( begin saving the file, prompting the user for a fiel name )
@save
    ;messages/save-prompt ;filename ;do-save start-prompt
    redraw-prompt-and-cursor
    !return

( save the file with the filename found in tmp )
@do-save ( -> )
    .buffer/limit LDZ2 ;data SUB2 STH2 ( [size] )
    ;tmp .File/name DEO2
    STH2kr    .File/length DEO2
    ;data     .File/write DEO2

    .File/success DEI2 STH2r EQU2 ?&ok
        ;messages/save-failed !&finish
    &ok
        #00 .state/modified STZ
        ;tmp ;filename str-copy POP2
        ;messages/save-ok
    &finish
        ;tmp send-message
        .state/quitting LDZ ?quit-now
        #03 .state/redraw STZ ( FIXME: why do we have to do this? )
        !return

( begin a search, prompting for a search string )
@search ( -> )
    ;messages/search-prompt ;messages/null ;do-search start-prompt
    redraw-prompt-and-cursor
    !return

( execute a search, using the given search string )
@do-search ( -> )
    .cursor/row LDZ2 .searching/orig-row STZ2
    .cursor/col LDZ2 .searching/orig-col STZ2
    #0000 .searching/regex STZ2
    move-to-next-match ?&found
        move-to-prev-match ?&found
            ;messages/no-matches-found ;tmp send-message BRK
    &found
        #01 .searching/active STZ
        redraw-matches
        !return

( begin a search, prompting for a regular expression )
@regex-search ( -> )
    ;messages/regex-search-prompt ;messages/null ;do-regex-search start-prompt
    redraw-prompt-and-cursor !return

( execute a search, using the given regular expressions )
( )
( TODO: handle invalid regular expressions that fail to compile )
@do-regex-search ( -> )
    cur-pos DUP2 .searching/start STZ2 .searching/end STZ2
    .cursor/row LDZ2 .searching/orig-row STZ2
    .cursor/col LDZ2 .searching/orig-col STZ2
    ;tmp compile .searching/regex STZ2
    move-to-next-regex-match ?&found
        move-to-prev-regex-match ?&found
            ;messages/no-matches-found ;tmp send-message BRK
    &found
        #01 .searching/active STZ
        redraw-matches
        !return

( toggle the color used by the terminal )
( )
( available colors are: )
( - black )
( - red )
( - green )
( - yellow )
( - blue )
( - magenta )
( - cyan )
( - white )
@toggle-color ( -> )
    .config/color LDZ2 #3733 EQU2 ?{
        .config/color LDZ2 #0100 ADD2 DUP2 .config/color STZ2
        DUP2 #3733 LTH2 ?{ .config/red STZ2 !&done }
        POP2 #3133 .config/red STZ2 !&done
    }
    #3033 DUP2 .config/color STZ2 .config/red STZ2
    &done redraw-all !return

( 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 ( -> )
    .config/insert-tabs LDZk #00 EQU SWP STZ
    redraw-statusbar-and-cursor !return

( interpret user input as an escaped sequence )
( )
( called by on-key with state/saw-esc is true )
( )
( TODO: maybe M-% for search&replace )
@on-key-escaped ( -> )
    #00 .state/saw-esc STZ
    .state/key LDZ LIT "< EQU ( M-< ) ?goto-start
    .state/key LDZ LIT "> EQU ( M-> ) ?goto-end
    .state/key LDZ LIT "b EQU ( M-b ) ?back-by-word
    .state/key LDZ LIT "c EQU ( M-c ) ?toggle-color
    .state/key LDZ LIT "f EQU ( M-f ) ?forward-by-word
    .state/key LDZ LIT "g EQU ( M-g ) ?goto-line
    .state/key LDZ LIT "h EQU ( M-h ) ?help
    .state/key LDZ LIT "s EQU ( M-s ) ?regex-search
    .state/key LDZ LIT "t EQU ( M-t ) ?toggle-tabs
    .state/key LDZ LIT "u EQU ( M-u ) ?undo
    .state/key LDZ LIT "v EQU ( M-v ) ?page-up
    .state/key LDZ LIT "[ EQU ( M-[ ) ?xterm
    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
    #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 ( -> )
    .state/saw-vt LDZk STH #00 SWP STZ
    .state/key LDZ LIT "~ EQU ?&ok
        POPr BRK
    &ok
      STHr DUP LIT "1 NEQ ?&not-1
        ( ^[[1~ -> home ) POP !bol
    &not-1 DUP LIT "2 NEQ ?&not-2
        ( ^[[2~ -> insert ) POP BRK
    &not-2 DUP LIT "3 NEQ ?&not-3
        ( ^[[3~ -> delete ) POP !delete
    &not-3 DUP LIT "4 NEQ ?&not-4
        ( ^[[4~ -> end ) POP !eol
    &not-4 DUP LIT "5 NEQ ?&not-5
        ( ^[[5~ -> page up ) POP !page-up
    &not-5 DUP LIT "6 NEQ ?&not-6
        ( ^[[6~ -> page down ) POP !page-down
    &not-6 DUP LIT "7 NEQ ?&not-7
        ( ^[[7~ -> home ) POP !bol
    &not-7 DUP LIT "8 NEQ ?&not-8
        ( ^[[8~ -> end ) POP !eol
    &not-8
        ( ??? ) 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 ( -> )
    #00 .state/saw-xterm STZ
    .state/key LDZ LIT "A EQU ( ^[[A -> up ) ?up
    .state/key LDZ LIT "B EQU ( ^[[B -> down ) ?down
    .state/key LDZ LIT "C EQU ( ^[[C -> right ) ?forward
    .state/key LDZ LIT "D EQU ( ^[[D -> left ) ?back
    .state/key LDZ LIT "F EQU ( ^[[F -> end ) ?eol
    .state/key LDZ LIT "H EQU ( ^[[H -> home ) ?bol
    .state/key LDZ LIT "0 LTH ?ignore
    .state/key LDZ LIT "8 GTH ?ignore
    .state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 )
    BRK

( 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
    .state/message LDZ #00 EQU ?&done
        move-to-message-line
        term-erase-line
        #00 .state/message STZ
    &done JMP2r

( cancel the active search )
( )
( this method unsets searching/active and also restores )
( the original cursor position. )
@cancel-search
    .searching/orig-row LDZ2 jump-to-line
    .searching/orig-col LDZ2 .cursor/col STZ2
    !finish-search

( cancel the active search )
( )
( this method unsets searching/active. unlike ;cancel-search )
( this leaves the cursor where it is. )
@finish-search
    #00 .searching/active STZ
    reset-arena redraw-all !return

( 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. )
( )
( 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 ( -> )
    .searching/regex LDZ2 ORA ?&is-regex
        move-to-next-match POP !return
    &is-regex
        move-to-next-regex-match POP !return

( 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 ( -> )
    .searching/regex LDZ2 ORA ?&is-regex
        move-to-prev-match POP !return
    &is-regex
        move-to-prev-regex-match POP !return

( move to the next substring match. )
( )
( called by ;jump-to-next-match. )
@move-to-next-match ( -> ok^ )
    .buffer/limit LDZ2
    cur-pos INC2
    &loop
        GTH2k #00 EQU ?&fail
        DUP2 matches-at
        ORA ?&found
        INC2 !&loop
    &found
        NIP2 jump-to-pos #01 JMP2r
    &fail
        POP2 POP2 #00 JMP2r

( move to the previous substring match. )
( )
( called by ;jump-to-prev-match. )
@move-to-prev-match ( -> ok^ )
    ;data
    cur-pos #0001 SUB2
    &loop
        GTH2k ?&fail
        DUP2 matches-at
        ORA ?&found
        #0001 SUB2 !&loop
    &found
        NIP2 jump-to-pos #01 JMP2r
    &fail
        POP2 POP2 #00 JMP2r

( 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
        POP2 #00 JMP2r
    &ok
        .searching/regex LDZ2 rx-search ?&found
        #00 JMP2r
    &found
        ;search-end LDA2 .searching/end STZ2
        ;search-start LDA2 DUP2 .searching/start STZ2
        jump-to-pos #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. )
( 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 ;data ( limit pos [res] )
    &loop ( limit pos [res] )
        GTH2k #00 EQU ?&done ( limit pos )
        DUP2 .searching/regex LDZ2 rx-search ( limit pos match? )
        #00 EQU ?&done ( limit pos )
        OVR2 ;search-end LDA2 LTH2 ?&done
        POP2 POPr LITr 01
        ;search-start LDA2 .searching/start STZ2
        ;search-end LDA2 DUP2 .searching/end STZ2
        !&loop
    &done
        POP2 POP2 STHr DUP #00 EQU ?&fail
        .searching/start LDZ2 jump-to-pos
    &fail
        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
    .state/key LDZ #07 EQU ( C-g ) ?cancel-search
    .state/key LDZ #08 EQU ( C-h ) ?help
    .state/key LDZ #0d EQU ( \r  ) ?finish-search
    .state/key LDZ #12 EQU ( C-r ) ?jump-to-prev-match
    .state/key LDZ #13 EQU ( C-s ) ?jump-to-next-match
    .state/key LDZ #6e EQU (  n  ) ?jump-to-next-match
    .state/key LDZ #70 EQU (  p  ) ?jump-to-prev-match
    !ignore

( 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
    .state/key LDZ #07 EQU ( C-g ) ?cancel-prompt
    .state/key LDZ #08 EQU ( C-h ) ?help
    .state/key LDZ #0d EQU ( \r  ) ?finish-prompt
    .state/key LDZ #7f EQU ( DEL ) ?backspace-prompt
    .state/key LDZ #20 LTH ?ignore ( ignore for now )
    .state/key LDZ #7e GTH ?ignore ( ignore for now )
    .state/key LDZ ( printable ASCII ) !insert-prompt
    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 )
( )
( 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
    #00 .state/in-undo STZ
    .Console/read DEI .state/key STZ
    clear-message-line
    .state/in-help LDZ #00 .state/in-help STZ ?return
    .searching/active LDZ ?on-key-searching
    .prompt/active LDZ ?on-key-prompt
    .state/saw-vt LDZ ?on-key-vt
    .state/saw-xterm LDZ ?on-key-xterm
    .state/saw-esc LDZ ?on-key-escaped
    .state/key LDZ #01 EQU ( C-a ) ?bol
    .state/key LDZ #02 EQU ( C-b ) ?back
    .state/key LDZ #04 EQU ( C-d ) ?delete
    .state/key LDZ #05 EQU ( C-e ) ?eol
    .state/key LDZ #06 EQU ( C-f ) ?forward
    .state/key LDZ #08 EQU ( C-h ) ?help
    .state/key LDZ #09 EQU ( \t  ) ?insert-tab
    .state/key LDZ #0c EQU ( C-l ) ?center-view
    .state/key LDZ #0d EQU ( \r  ) ?newline
    .state/key LDZ #0e EQU ( C-n ) ?down
    .state/key LDZ #0f EQU ( C-o ) ?save
    .state/key LDZ #10 EQU ( C-p ) ?up
    .state/key LDZ #13 EQU ( C-s ) ?search
    .state/key LDZ #16 EQU ( C-v ) ?page-down
    .state/key LDZ #18 EQU ( C-x ) ?quit
    .state/key LDZ #1a EQU ( C-z ) ?debug
    .state/key LDZ #1b EQU ( ESC ) ?escape
    .state/key LDZ #7f EQU ( DEL ) ?backspace
    .state/key LDZ #20 LTH ?ignore ( ignore for now )
    .state/key LDZ #7e GTH ?ignore ( ignore for now )
    .state/key LDZ ( printable ASCII ) !insert

( return the smaller of two short values )
@min2 ( x* y* -> min* )
    LTH2k JMP SWP2 POP2 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^ -> )
    .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
@redraw-statusbar-and-cursor ( -> ) #03 !redraw-add
@redraw-prompt-and-cursor    ( -> ) #05 !redraw-add
@redraw-matches              ( -> ) #08 !redraw-add
@redraw-all                  ( -> ) #1f !redraw-add

( draw the current cursor location )
@draw-cursor ( -> )
    .prompt/active LDZ #00 EQU JMP JMP2r
        ( TODO: handle long lines )
        cur-w-col lmargin ADD2
        .cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2
        !term-move-cursor

( current column in terms of display width )
( )
( this is different than ;cur-col due to tabs )
@cur-w-col ( -> col* )
    LIT2r 0000 ( [0] )
    cur-line DUP2 cur-col ADD2 SWP2 ( lim s [0] )
    &loop GTH2k ?&next
          POP2 POP2 STH2r JMP2r
    &next LDAk #09 EQU ?&tabs INC2 INC2r !&loop
    &tabs INC2 .config/tab-width LDZ2 STH2 ADD2r !&loop

( move the terminal cursor to the statusbar line )
@move-to-statusbar ( -> )
    #0000 .term/rows LDZ2 !term-move-cursor

( draw the full statusbar )
@draw-statusbar ( -> )
    move-to-statusbar
    emit-color-reverse-nonbold

    LIT2r 2018 .term/cols LDZ2 #0001 ( cols i [2018] )
    &loop LTH2k ?&done DEOkr INC2 !&loop
    &done POP2 POP2 POP2r ( )

    move-to-statusbar

    ( display ** if the buffer has unsaved changes, -- otherwise )
    #2d .state/modified LDZ #00 NEQ #03 MUL SUB DUP emit emit sp

    ;filename print
    sp emit-[
    .buffer/limit LDZ2 ;data SUB2 emit-dec2
    ;messages/bytes print
    sp
    .buffer/line-count LDZ2 emit-dec2
    ;messages/lines print
    sp emit-lpar
    cur-col INC2 emit-dec2
    emit-,
    .cursor/row LDZ2 INC2 emit-dec2
    emit-rpar sp emit-[
    LIT "s .config/insert-tabs LDZ ADD emit
    emit-] sp
    ;messages/help-msg print
    !emit-reset

@draw-prompt ( -> )
    clear-message-line
    .prompt/active LDZ ?&is-active
        JMP2r
    &is-active
        #01 .state/message STZ
        move-to-message-line
        emit-color-bold
        .prompt/string LDZ2 print
        emit-reset
        ;tmp print
        JMP2r

@draw-linenum ( n* -> )
    emit-reset
    emit-color
    emit-dec2-pad sp
    !emit-reset

@matches-at ( s* -> limit* )
    LIT2r =tmp
    &loop LDAkr STHr #00 EQU ?&done
          LDAk LDAkr STHr NEQ ?&fail
          INC2 INC2r !&loop
    &fail POP2 #0000
    &done POP2r JMP2r

( TODO: this doesn't handle tabs correctly )
@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 ( offset limit [cols-col] )
    OVR2 STH2r ADD2 ( offset limit offset+cols-col )
    min2 STH2 ( offset [cutoff] )
    &loop ( i [cutoff] )
        DUP2 STH2kr LTH2 #00 EQU ?&done
        LDAk #00 EQU ?&done
        LDAk #18 DEO INC2 !&loop
    &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
        POP2 .buffer/limit LDZ2 JMP2r
    &not-end
        !abs-line

@draw-regex-matches ( -> )
    emit-color-reverse ( )
    screen-limit .buffer/offset LDZ2 ( limit pos )
    &loop ( limit pos )
        GTH2k #00 EQU ( limit pos limit>pos=0? )
        ?&done ( limit pos )
        DUP2 .searching/regex LDZ2 ( limit pos pos rx )
        rx-search #00 EQU ( limit pos found=0? )
        ?&done ( limit pos )
        POP2 ;search-start LDA2 ( limit start )
        GTH2k #00 EQU ( limit start limit>start=0? )
        ?&done ( limit start )
        ;search-end LDA2 OVR2 ( limit start end start )
        pos-to-row-col ( 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 ( limit )
        ;search-end LDA2 ( limit end ) !&loop
    &done ( limit pos )
        POP2 POP2 JMP2r

@draw-matches ( -> )
    ( return if not searching )
    .searching/active LDZ #00 EQU ?&return ( )
    .searching/regex LDZ2 ORA ?draw-regex-matches
    emit-color-reverse
    lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 )
    .buffer/offset LDZ2 DUP2
    screen-limit SUB2 STH2 ( offset [-count] )

    &loop ( offset [-count] )
        STH2kr #0000 EQU2 ?&done
        DUP2 matches-at ( offset mlim [-count] )
        DUP2 ORA ?&found
        POP2 ( offset [-count] )
        LDAk #0a EQU ?&newline
        draw-matches/count-tabs
        #0001 !&next ( 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] )
        draw-region ( offset [mlim -count] )
        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
    &newline ( offset [-count] )
        lmargin ,&x STR2
        ,&y LDR2 INC2 ,&y STR2
        INC2 INC2r
        !&loop
    &done
        POP2 POP2r
        emit-reset
    &return
        JMP2r
        [ &x $2 &y $2 ]
    &count-tabs ( offset -> offset )
        LDAk #09 NEQ ?&count-tabs/done
        ,&x LDR2 .config/tab-adjust LDZ2 ADD2 ,&x STR2
        &count-tabs/done JMP2r

@emit-tab ( -> )
    #0000 .config/tab-width LDZ2 SUB2
    LIT2r 2018
    &loop ORAk ?&next POP2 POP2r JMP2r
    &next DEOkr INC2 !&loop


( 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
    emit-; INC2 ( col+1 ) emit-dec2
    emit-H JMP2r

( ANSI control sequence to move N positions right )
(   ESC [ $n C )
@term-move-right ( n* -> )
    ansi emit-dec2 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

( ANSI control sequence to erase entire screen )
(   ESC [ 2 J )
@term-erase-all ( -> )
    LIT2 00 "J LIT "2 !ansi-emit

( ANSI control sequence to erase the current line )
(   ESC [ 2 K )
@term-erase-line ( -> )
    LIT2 00 "K LIT "2 !ansi-emit

@ansi-emit ( 00 cn ... c1 c0 -> )
    LITr 18 ( Console/write )
    #5b1b STHkr DEO STHkr DEO ( ESC [ )
    &loop DUP ?&next POP POPr JMP2r
    &next STHkr DEO !&loop

( ESC [ 3 1 m )
@emit-red ( -> )
    LIT2 00 "m .config/red LDZ2 !ansi-emit

( ESC [ 0 m )
@emit-reset ( -> )
    #00 LIT2 "m "0 !ansi-emit

( ESC [ 1 m $ ESC [ 0 m )
@emit-red-dollar ( -> )
    emit-red emit-$ !emit-reset

( ESC [ 3 $x ; 7 m )
( $x is 0-7 )
@emit-color-reverse ( -> )
    LIT2 00 "m LIT2 "7 "; .config/color LDZ2 !ansi-emit

@emit-color ( -> )
    LIT2 00 "m .config/color LDZ2 !ansi-emit

( ESC [ 3 $x ; 1 m )
( $x is 0-7 )
@emit-color-bold ( -> )
    LIT2 00 "m LIT2 "1 "; .config/color LDZ2 !ansi-emit

( ESC [ 3 $x ; 1 ; 7 m )
( $x is 0-7 )
@emit-color-reverse-bold ( -> )
    LIT2 00 "m LIT2 "7 "; LIT2 "1 "; .config/color LDZ2 !ansi-emit

@emit-color-reverse-nonbold ( -> )
    LIT2 00 "m LIT2 "7 "; .config/color LDZ2 LIT2 "; "0 !ansi-emit

@draw-all ( -> )
    term-erase-all
    #0000 #0000 term-move-cursor
    .buffer/line-offset LDZ2 STH2 LIT2r 0001 ( [k line-offset] )
    .buffer/offset LDZ2
    &bol
         ADD2kr STH2r draw-linenum
         lmargin INC2 ,&x STR2
    &loop ( offset [k line-offset] )
        LDAk #00 EQU ?&eof
        LDAk #0a EQU ?&eol
        ,&x LDR2 .term/cols LDZ2
        LTH2k ?&ok
        GTH2 ?&skip
        emit-red-dollar ,&x LDR2 INC2 ,&x STR2
    &skip INC2
        !&loop
    &ok POP2 POP2
        LDAk #09 EQU ?&do-tab
        LDAk emit INC2 ,&x LDR2 INC2 ,&x STR2
        !&loop
    &eol INC2r
        STH2kr .term/rows LDZ2 GTH2 ?&done
        crlf INC2 !&bol
    &do-tab emit-tab INC2
            .config/tab-width LDZ2 ,&x LDR2 ADD2 ,&x STR2
            !&loop
    [ &x $2 ]
    &eof
         emit-red
    &eof-loop
        STH2kr .term/rows LDZ2 GTH2 ?&done
        crlf
        lmargin term-move-right
        emit-~ INC2r
        !&eof-loop
    &done POP2 POP2r POP2r
    emit-reset
    draw-matches
    draw-statusbar
    draw-prompt
    !draw-cursor

( handler completion code to do necessary drawing and BRK )
@return ( -> )
    .state/redraw LDZ
            DUP #10 AND ?&draw-all
            DUP #08 AND ?&do-8 !&skip-8 &do-8 draw-matches
    &skip-8 DUP #04 AND ?&do-4 !&skip-4 &do-4 draw-prompt
    &skip-4 DUP #02 AND ?&do-2 !&skip-2 &do-2 draw-statusbar
    &skip-2 DUP #01 AND ?&do-1 !&finish &do-1 draw-cursor !&finish
    &draw-all draw-all
    &finish POP #00 .state/redraw STZ BRK

@str-copy ( src* dst* -> len* )
          STH2 DUP2 ( src src [dst] )
    &loop LDAk #00 EQU ?&done
          LDAk STH2kr STA
          INC2 INC2r !&loop
    &done ( src src+n [dst+n] )
          SWP2 SUB2
          #00 STH2r STA
          JMP2r

@print ( s* -> )
    LDAk ?{ POP2 JMP2r } LDAk #18 DEO INC2 !print

@cur-len ( -> n* )
    cur-line !line-len

@line-len ( s* -> n* )
    #0000 STH2
    &loop LDAk #00 EQU ?&end
          LDAk #0a EQU ?&end
          INC2 INC2r !&loop
    &end POP2 STH2r JMP2r

@line-is-visible ( n* -> bool^ )
    .buffer/line-offset LDZ2 LTH2k ?&no
    .term/rows LDZ2 ADD2 LTH2 JMP2r
    &no POP2 POP2 #00 JMP2r

@jump-to-pos ( s* -> )
    pos-to-logical-row-col SWP2 !move-to-coord

@pos-to-display-row-col ( s* -> row* col* )
    .config/tab-width LDZ2 ;pos-to-row-col/tab-width STA2 !pos-to-row-col

@pos-to-logical-row-col ( s* -> row* col* )
    #0001 ;pos-to-row-col/tab-width STA2 ( fall-through )

@pos-to-row-col ( s* -> row* col* )
    #0000 ,&row STR2
    #0000 ,&col STR2
    ;data
    &loop ( s pos )
        GTH2k #00 EQU ?&done
        LDAk #0a EQU ?&newline
        LDAk #09 EQU ?&tab
        #0001
    &inc
        ,&col LDR2 ADD2 ,&col STR2
        INC2 !&loop
    &newline
        #0000 ,&col STR2
        ,&row LDR2 INC2 ,&row STR2
        INC2 !&loop
    &tab
        LIT2 [ &tab-width $2 ] !&inc
    &done
        POP2 POP2
        ,&row LDR2 ,&col LDR2 JMP2r
    [ &row $2 &col $2 ]

( counts y lines forward from the given address )
@line-to-pos ( addr* y* -> s* )
    #0000 SWP2 SUB2 STH2                   ( addr [-y] )
    &newline                               ( addr [-y] )
          STH2kr ORA ?&loop !&done
    &loop                                  ( addr [-y] )
          LDAk #00 EQU ?&not-found     ( addr [-y] )
          LDAk #0a EQU ?&found         ( addr [-y] )
          INC2 !&loop                  ( addr+1 [-y] )
    &found INC2 INC2r !&newline
    &done POP2r JMP2r
    &not-found POP2 POP2r #0000 JMP2r

( find string pointer for absolute y coordinate )
@abs-line ( y* -> s* )
    ;data SWP2 !line-to-pos

( return a pointer to the current line )
@cur-line ( -> s* )
    .cursor/row LDZ2 .buffer/line-offset LDZ2 LTH2k ?&early
        ( 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
    &early
        ( if cursor/row is earlier than line-offset )
        ( we need to use the absolute y coordinate )
        POP2 !abs-line

( return a pointer to the current cursor position )
@cur-pos ( -> s* )
    cur-line cur-col ADD2 JMP2r

( insert one character at the cursor position )
@shift-right ( c^ addr* -> )
    #01 .state/modified STZ
    ROT STH                 ( addr [prev^] )
    last-pos SWP2     ( last addr [prev^] )
    .state/in-undo LDZ ?&loop
        STH2k #00 STH2r u-push
    &loop LTH2k ?&done  ( 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   ( last addr+1 [curr^] )
    &done NIP2 DUP2         ( addr addr [prev^] )
          STHr ROT ROT      ( addr prev^ addr )
          STA INC2          ( addr+1 )
          .buffer/limit STZ2 (  )
    JMP2r

( remove one character at the cursor position )
( )
( TODO: change last/addr order and GTH -> LTH to remove hack )
@shift-left ( addr* -> )
    #01 .state/modified STZ
    last-pos SWP2              ( last addr )
    .state/in-undo LDZ ?&loop
        STH2k cur-pos LDA STH2r u-push
    &loop GTH2k ?&next           ( last addr )
                !&done           ( 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             ( last addr+1 )
    &done POP2                       ( last )
          .buffer/limit STZ2         (  )
          #00 .buffer/limit LDZ2 STA ( ensure null termination )
    JMP2r

( current column in terms of bytes in buffer )
@cur-col ( -> col* )
    .cursor/col LDZ2 cur-len !min2

( jump to the first line in the buffer )
@zero-row ( -> )
    ;data .buffer/offset STZ2
    #0000 .buffer/line-offset STZ2
    #0000 .cursor/row STZ2
    JMP2r

( return the location of the last character in the buffer )
@last-pos ( -> addr* )
    .buffer/limit LDZ2 #0001 SUB2 JMP2r

( emit a short as a decimal )
@emit-dec2 ( n* -> )
    LITr 00 ( n [0] )
    &read ( n [k] )
        #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] )
        DUP2 ORA ?&read
    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
    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
    POP2 ( top element was 0000 )
    &write0 ( n0 n1 ... nk [k+1] )
        DUP2 ORA ?emit-dec2/write
        POP2 sp LITr 01 SUBr
        STHkr ?&write0
        POPr JMP2r

( various string constants used as messages for the user )
@messages [ &null 00
            &input-error "Input 20 "error, 20 "file 20 "too 20 "large: 20 00
            &bytes 20 "bytes, 00
            &save-ok "Successfully 20 "saved 20 00
            &save-failed "Failed 20 "to 20 "save 20 00
            &lines 20 "lines] 00
            &goto-line "Go 20 "to 20 "line: 20 00
            &save-prompt "File 20 "Name 20 "to 20 "Write: 20 00
            &search-prompt "Text 20 "to 20 "Search 20 "for: 20 00
            &regex-search-prompt "Regex 20 "to 20 "Search 20 "for: 20 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
            &term-size-parse-error "Error 20 "parsing 20 "term 20 "size 00
            &help-msg "(help: 20 "C-h) 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

( perform the undo action )
@undo ( -> )
    #01 .state/in-undo STZ
    ;undo-stack/pos LDA2 ;undo-stack EQU2 ?&noop
    ;undo-stack/pos LDA2 #0003 SUB2
    DUP2 ;undo-stack/pos STA2
    LDA2k STH2 ( pos [addr] )
    INC2 INC2 LDA STH2r ( c addr )
    jump-to-pos
    DUP #00 EQU ?&delete
    DUP #0a EQU ?&newline
    DUP #09 EQU ?&tab
    !insert
    &newline POP !newline
    &tab POP !insert-tab
    &delete POP !delete
    &noop BRK

( free up space in the undo stack by evicting the oldest entry )
@u-free ( -> )
    ;undo-stack STH2k #0003 ADD2 ( st+3 [st] )
    &loop LDAk STH2kr STA
          INC2 INC2r
          DUP2 ;undo-stack/pos LDA2 LTH2 ?&loop
    ;undo-stack/pos LDA2k #0003 SUB2 SWP2 STA2
    POP2 POP2r JMP2r

( push a new item on the undo stack )
@u-push ( c^ addr* -> )
    ;undo-stack/pos DUP2 LDA2 ( c^ addr* top* pos* )
    GTH2 ( c^ addr* top>pos^ ) ?&has-room ( c^ addr* )
        u-free
    &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

( path to file being edited )
@filename $80

( 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. )
( when pos points to data the stack is empty. )
( when pos points to pos the stack is full. )
@undo-stack [
    $180 ( 128 steps )
    &pos =undo-stack
]

( actual file data to be edited )
@data $ce80

( end of femto.tal )