nxu/femto.tal

( femto.tal                                  )
(                                            )
( requires terminal to be in raw mode        )
( see femto launcher script for more details )
(                                            )
( ANSI sequences                             )
(                                            )
( goto $row,$col    ESC [ $row ; $col H      )
( goto home         ESC [ H                  )
( go up             ESC [ A                  )
( go down           ESC [ B                  )
( go right          ESC [ C                  )
( go left           ESC [ D                  )
(                                            )
( query cursor      ESC [ 6 n                )
(                                            )
( all scroll on     ESC [ r                  )
( region scroll on  ESC [ $y0 ; $y1 r        )
( scroll down       ESC D                    )
( scroll up         ESC M                    )
(                                            )
( erase cur->eol    ESC [ K                  )
( erase cur->sol    ESC [ 1 K                )
( erase line        ESC [ 2 K                )
( erase line->bot   ESC [ J                  )
( erase line->top   ESC [ 1 J                )
( erase all         ESC [ 2 J                )
(                                            )
( set attrs         ESC [ $at1 ; ... m       )
( reset             ESC [ m                  )
(     0 reset, 1 bright, 2 dim,              )
(     4 underscore, 5 blink,                 )
(     7 reverse, 8 hidden                    )
(                                            )
( fg (30-37), bg (40-47)                     )
(     black, red, green, yellow,             )
(     blue, magenta, cyan, white             )

( TODO: )
( - optimize term drawing )
( - get long line truncation/scrolling working )
( - line numbers in left column (toggle mode?) )
( - help text )
( - save file command -> tmp first )
( - open file command? )
( - close file command? )
( - move by word/paragraph )
( - search )
( - search&replace )
( - tab support? )
( - windows line-ending support (CRLF) )

( FIXME: )
( - stop using bytes for row/col/etc. )
( - consider storing absolute cursor instead )

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

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

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

( startup )
|0100 ;startup JMP2

@startup ;read-filename .Console/vector DEO2 BRK

( ERROR HANDLING )

( using error! will print the given message before causing )
( the interpreter to halt. )
@error! ( msg* -> )
    LIT '! emit sp
    &loop LDAk ,&continue JCN ,&done JMP
    &continue LDAk emit INC2 ,&loop JMP
    &done POP2 nl
    dbg BRK

( error messages )
@term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
@rel-line-error "invalid 20 "relative 20 "line 20 "number 00

@open-file ( filename* -> )
                 .File/name   DEO2
           #8000 .File/length DEO2
    ;buffer/data .File/read   DEO2

    .File/success DEI2 #0000 GTH2 ,&ok JCN
    ;messages/input-error ;print JSR2 nl quit!

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

@setup-terminal-size ( -> )
    ( ;setup-80x24 JSR2 )
    #03e7 #03e7 ;term-move-cursor JSR2
    ;term-get-cursor-position JSR2
    ;tmp/data ;tmp/pos STA2
    ;receive-terminal-size .Console/vector DEO2
    JMP2r

@receive-terminal-size ( -> )
    .Console/read DEI ;tmp/pos LDA2 STA
    ;tmp/pos LDA2 INC2 ;tmp/pos STA2
    .Console/read DEI LIT 'R EQU ;parse-terminal-size JCN2
    BRK

@parse-terminal-size ( -> )
    LIT2r 0000 LIT2r 0000
    ;tmp/data LDAk    #1b NEQ ,&parse-error JCN ( i ) INC2
              LDAk LIT '[ NEQ ,&parse-error JCN ( i ) INC2
    &loop
        LDAk LIT '; EQU ,&parse-col JCN
        LIT2r 000a MUL2r
        LDAk LIT '0 SUB #00 SWP STH2 ADD2r
        INC2 ,&loop JMP
    &parse-col
        INC2 STH2r #0002 SUB2 ;term/rows STA2
    &loop2
        LDAk LIT 'R EQU ,&done JCN
        LIT2r 000a MUL2r
        LDAk LIT '0 SUB #00 SWP STH2 ADD2r
        INC2 ,&loop2 JMP
    &done
        STH2r ;term/cols STA2 POP2
        ;on-key .Console/vector DEO2
        ;draw-all JSR2
        BRK
    &parse-error POP2 ;tmp/data LDA2
                 ;term-size-parse-error ;error! JMP2

@setup-linecount ( -> )
    ;buffer/data LIT2r 0001
    &loop DUP2 ;buffer/limit LDA2 EQU2 ,&done JCN
          LDAk #00 EQU ,&done JCN
          LDAk #0a NEQ JMP INC2r
          INC2 ,&loop JMP
    &done POP2
          STH2r ;buffer/line-count STA2
          JMP2r

@setup-80x24 ( -> )
    #0050 ;term/cols STA2
    #0014 ;term/rows STA2
    ;on-key .Console/vector DEO2
    ;draw-all JSR2
    JMP2r

@read-filename ( -> )
    #12 DEI #0a EQU ,&execute JCN      ( did we read \n ? )
    #12 DEI ;tmp/pos LDA2 STA          ( no, so save in buffer ) 
    ;tmp/pos LDA2 INC2 ;tmp/pos STA2   ( pos++ )
    BRK                                ( return )

    &execute                           ( we saw a newline, so do something )
    #00 ;tmp/pos LDA2 STA              ( null terminate str )
    ;tmp/data ;tmp/pos STA2            ( reset pos )
    ;tmp/data ;filename ;str-copy JSR2 ( open file )
    ;filename ;open-file JSR2          ( open file )
    ;setup-linecount JSR2              ( determine # of lines )
    ;setup-terminal-size JSR2          ( detect terminal dimensions )
    ( ;setup-80x24 JSR2                  ( hardcoded terminal size ) )
    BRK

@bol ( -> )
    #0000 ;cursor/col STA2
    ;draw-statusbar JSR2
    ;draw-cursor JSR2 BRK

( FIXME: handle long lines )
@eol ( -> )
    ;cur-line JSR2 ;line-len JSR2 ;cursor/col STA2
    ;draw-statusbar JSR2
    ;draw-cursor JSR2 BRK

( FIXME: handle long lines )
@forward ( -> )
    ;cur-pos JSR2 ;last-pos JSR2 GTH2 ,&skip JCN
    ;cur-col JSR2 ;cur-last JSR2 GTH2 ,&next-line JCN
    ;cur-col JSR2 INC2 ;cursor/col STA2
    ;draw-statusbar JSR2 ;draw-cursor JSR2
    ,&skip JMP
    &next-line #0000 ;cursor/col STA2 
               ;cursor/row LDA2 INC2 ;cursor/row STA2
               ;ensure-visible-cursor JSR2
               ;draw-cursor JSR2
    &skip BRK

( FIXME: handle long lines )
@back ( -> )
    ;cur-col JSR2 #01 LTH ,&skip JCN
    ;cur-col JSR2 #0001 SUB2 ;cursor/col STA2
    ;draw-statusbar JSR2
    ;draw-cursor JSR2
    &skip BRK

@up ( -> )
    ;cur-line-num JSR2 #0000 EQU2 ,&done JCN
    ;cursor/row LDA2 #0001 LTH2 ,&screen-up JCN
    ;cursor/row LDA2 #0001 SUB2 ;cursor/row STA2
    ;draw-statusbar JSR2
    ;draw-cursor JSR2 BRK
    &screen-up
    ;cur-line-num JSR2 #0001 SUB2
    ;jump-to-line JSR2
    ;draw-all JSR2
    &done BRK

@down ( -> )
    ;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN
    ;cursor/row LDA2 INC2 ;cursor/row STA2
    ;ensure-visible-cursor JSR2
    ;draw-statusbar JSR2
    ;draw-cursor JSR2 BRK
    &done BRK

@page-up ( -> )
    ;bof-is-visible JSR2 ,&near-eof JCN
        ;buffer/line-offset LDA2
        ;term/rows LDA2 SUB2 #0003 ADD2
        DUP2 ;abs-line JSR2 ;buffer/offset STA2
                            ;buffer/line-offset STA2
        ;ensure-visible-cursor JSR2
        ;draw-all JSR2 BRK
    &near-eof
        #0000 ;cursor/row STA2
        #0000 ;cursor/col STA2
        ;draw-cursor JSR2 BRK

@page-down
    ;eof-is-visible JSR2 ,&near-eof JCN
        ;buffer/line-offset LDA2
        ;term/rows LDA2 ADD2 #0003 SUB2
        DUP2 ;abs-line JSR2 ;buffer/offset STA2
                            ;buffer/line-offset STA2
        ;ensure-visible-cursor JSR2
        ;draw-all JSR2 BRK
    &near-eof
        ;buffer/line-count LDA2
        ;buffer/line-offset LDA2 INC2
        SUB2 ;cursor/row STA2
        ;cur-len JSR2 ;cursor/col STA2
        ;draw-cursor JSR2 BRK

@quit quit!

@ignore BRK

@insert ( c^ -> )
    ;cur-pos JSR2 ;shift-right JSR2
    ;cur-col JSR2 INC2 ;cursor/col STA2
    ;draw-all JSR2
    BRK

( TODO: handle last line )
@newline ( c^ -> )
    #0a ;cur-pos JSR2 ;shift-right JSR2
    #0000 ;cursor/col STA2
    ;cursor/row LDA2 INC2 ;cursor/row STA2
    ;buffer/line-count LDA2k INC2 SWP2 STA2
    ;ensure-visible-cursor JSR2
    ;draw-all JSR2
    BRK

@at-buffer-start ( -> bool^ )
    ;cur-pos JSR2 ;buffer/data EQU2 JMP2r

@at-line-start ( -> bool^ )
    ;cursor/col LDA2 #0000 EQU2 JMP2r

@bof-is-visible ( -> bool^ )
    ;buffer/line-offset LDA2 #0000 EQU2 JMP2r

@eof-is-visible ( -> bool^ )
    ;buffer/line-offset LDA2 ;term/rows LDA2 ADD2 INC2
    ;buffer/line-count LDA2
    GTH2 JMP2r

@backspace ( -> )
    ;at-buffer-start JSR2 ,&skip JCN
    ;at-line-start JSR2 ,&prev-line JCN
        ;cur-col JSR2 #0001 SUB2 ;cursor/col STA2
        ,&finish JMP
    &prev-line
        ;cur-line-num JSR2 #0001 SUB2
        ;jump-to-line JSR2 ( TODO: fix weird eof behavior )
        ;cur-len JSR2 ;cursor/col STA2
        ;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
    &finish
        ;cur-pos JSR2 ;shift-left JSR2
        ;draw-all JSR2
    &skip BRK

@delete ( -> )
    ;last-pos JSR2 #0001 SUB2 ( lst-1 )
    ;cur-pos JSR2 LTH2 ,&skip JCN
    ;cur-pos JSR2 LDAk STH ( cur [c] )
    ;shift-left JSR2 ( [c] )
    STHr #0a NEQ ,&not-newline JCN
    ;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
    &not-newline ;draw-all JSR2
    &skip BRK

@escape ( -> )
    #01 ;saw-esc STA BRK

@goto-end ( -> )
    ;more-than-one-screen JSR2 ,&large JCN
        ;buffer/line-count LDA2 #0001 SUB2 ;cursor/row STA2
        #0000 ,&continue JMP
    &large
        ;term/rows LDA2 #0001 SUB2 ;cursor/row STA2
        ;buffer/line-count LDA2 ;term/rows LDA2 SUB2
    &continue
        DUP2 ;buffer/line-offset STA2
        ;abs-line JSR2 ;buffer/offset STA2
        ;cur-len JSR2 ;cursor/col STA2
        ;draw-all JSR2 BRK

@goto-start ( -> )
    ;buffer/data ;buffer/offset STA2
    #0000 ;buffer/line-offset STA2
    #0000 ;cursor/col STA2
    #0000 ;cursor/row STA2
    ;draw-all JSR2
    BRK

@goto-line ( -> )
    #0016 ;jump-to-line JSR2
    ;draw-all JSR2 BRK

@jump-to-line ( n* -> )
    ;term/rows LDA2 #0002 DIV2 LTH2k ( n rows/2 n<rows/2? ) ,&early JCN
    OVR2 SWP2 SUB2 ( n n-rows/2 )
    ;buffer/line-count LDA2 ( n n-rows/2 lines )
    ;term/rows LDA2 SUB2 ( n n-rows/2 lines-rows )
    GTH2k ( n n-rows/2 lines-rows n-rows/2>lines-rows? )
    ,&late JCN ( n n-rows/2 lines-rows )
    POP2 ,&finish JMP
    &early ( n rows/2 )
        POP2 #0000 ,&finish JMP ( n 0000 )
    &late ( n n-rows/2 lines-rows )
        NIP2
    &finish ( n o )
        SUB2k STH2 DUP2 ( n o o [n-o] )
        ;buffer/line-offset STA2 ( n o [n-o] )
        ;abs-line JSR2 ;buffer/offset STA2 ( n [n-o] )
        #0000 ;cursor/col STA2 ( n [n-o] )
        POP2 STH2r ;cursor/row STA2 ( )
        JMP2r

@ensure-visible-cursor 
    ;cursor/row LDA2 ;term/rows LDA2 LTH2 ,&noop JCN
    ;cur-line-num JSR2 ;jump-to-line JSR2
    ;draw-all JSR2
    &noop JMP2r

@refresh
    ;draw-all JSR2 BRK

@debug
    ;rel-line-error ;error! JMP2

( TODO: M-f and M-b for next/previous word )
(       M-n and M-p for next/previous paragraph )
(       maybe M-% for search&replace )
@on-key-escaped ( -> )
    #00 ;saw-esc STA
    .Console/read DEI LIT '< EQU ( M-< ) ;goto-start JCN2
    .Console/read DEI LIT '> EQU ( M-> ) ;goto-end JCN2
    .Console/read DEI LIT 'g EQU ( M-g ) ;goto-line JCN2
    .Console/read DEI LIT 'v EQU ( M-v ) ;page-up JCN2
    BRK

@move-to-message-line ( -> )
    #0002 ;term/rows LDA2 #0002 ADD2 ;term-move-cursor JSR2 JMP2r

( TODO: filename prmopt )
@save ( -> )
    ;buffer/limit LDA2 ;buffer/data SUB2 STH2 ( [size] )
    ;tmp-file-name .File/name DEO2
    STH2kr         .File/length DEO2
    ;buffer/data   .File/write DEO2

    ;move-to-message-line JSR2
    .File/success DEI2 STH2r EQU2 ( ok? ) ,&ok JCN
    ;messages/save-failed ,&finish JMP
    &ok ;messages/save-ok
    &finish ;print JSR2 BRK

@tmp-file-name "file.tmp 00

( TODO: C-g or C-h for help )
( TODO: C-s for search )
( TODO: tab input? )
@on-key
    ;saw-esc LDA ;on-key-escaped JCN2
    .Console/read DEI #01 EQU ( C-a ) ;bol JCN2
    .Console/read DEI #02 EQU ( C-b ) ;back JCN2
    .Console/read DEI #04 EQU ( C-d ) ;delete JCN2
    .Console/read DEI #05 EQU ( C-e ) ;eol JCN2
    .Console/read DEI #06 EQU ( C-f ) ;forward JCN2
    .Console/read DEI #0c EQU ( C-l ) ;refresh JCN2
    .Console/read DEI #0d EQU ( \r  ) ;newline JCN2
    .Console/read DEI #0e EQU ( C-n ) ;down JCN2
    .Console/read DEI #0f EQU ( C-o ) ;save JCN2
    .Console/read DEI #10 EQU ( C-p ) ;up JCN2
    .Console/read DEI #16 EQU ( C-v ) ;page-down JCN2
    .Console/read DEI #18 EQU ( C-x ) ;quit JCN2
    .Console/read DEI #1a EQU ( C-z ) ;debug JCN2
    .Console/read DEI #1b EQU ( ESC ) ;escape JCN2
    .Console/read DEI #7f EQU ( DEL ) ;backspace JCN2
    .Console/read DEI #20 LTH ;ignore JCN2 ( ignore for now )
    .Console/read DEI #7e GTH ;ignore JCN2 ( ignore for now )
    .Console/read DEI ( printable ASCII ) ;insert JMP2
    BRK

@min2 ( x* y* -> min* )
    LTH2k JMP SWP2 POP2 JMP2r

@term-move-cursor ( col* row* -> )
    ansi        INC2 ( row+1 ) ;emit-dec2 JSR2
    LIT '; emit INC2 ( col+1 ) ;emit-dec2 JSR2
    LIT 'H emit JMP2r

@term-get-cursor-position ( -> )
    ansi LIT '6 emit LIT 'n emit JMP2r

@term-erase-all ( -> )
    ansi LIT '2 emit LIT 'J emit JMP2r

@draw-cursor ( -> )
    ;cur-col JSR2 ;cur-row JSR2
    ;term-move-cursor JSR2 JMP2r

@draw-statusbar ( -> )
    #0000 ;term/rows LDA2 ;term-move-cursor JSR2
    ansi LIT '7 emit LIT 'm emit
    LIT2r 2018
    ;term/cols LDA2 #0000
    &loop GTH2k ,&continue JCN ,&done JMP
    &continue DEOkr INC2 ,&loop JMP
    &done POP2 POP2 POP2r

    #0000 ;term/rows LDA2 ;term-move-cursor JSR2
    ;messages/saved ;print JSR2
    ;filename ;print JSR2
    #20 emit
    LIT '[ emit
    ;buffer/limit LDA2 ;buffer/data SUB2 ;emit-dec2 JSR2
    ;messages/bytes ;print JSR2
    #20 emit
    ;buffer/line-count LDA2 ;emit-dec2 JSR2
    ;messages/lines ;print JSR2
    #20 emit
    LIT '( emit
    ;cur-col JSR2 INC ;emit-dec JSR2
    LIT ', emit
    ;cur-abs-row JSR2 INC2 ;emit-dec2 JSR2
    LIT ') emit

    ansi LIT '0 emit LIT 'm emit
    JMP2r

@draw-all ( -> )
    ;term-erase-all JSR2
    #0000 #0000 ;term-move-cursor JSR2
    #0001 STH2
    ;buffer/offset LDA2
    &loop
    LDAk #00 EQU ,&eof JCN
    LDAk #0a EQU ,&eol JCN
    LDAk emit INC2 ,&loop JMP
    &eol INC2r STH2kr ;term/rows LDA2 GTH2 ,&done JCN
         cr nl INC2 ,&loop JMP
    &eof
        ansi LIT '3 emit LIT '1 emit LIT 'm emit
    &eof-loop
        STH2kr ;term/rows LDA2 GTH2 ,&done JCN
        cr nl
        LIT '~ emit INC2r
        ,&eof-loop JMP
    &done POP2 POP2r
    ansi LIT '0 emit LIT 'm emit
    ;draw-statusbar JSR2
    ;draw-cursor JSR2
    JMP2r

@str-copy ( src* dst* -> )
          STH2 ( src [dst] )
    &loop LDAk #00 EQU ,&done JCN
          LDAk STH2kr STA
          INC2 INC2r ,&loop JMP
    &done POP2 #00 STH2r STA
          JMP2r

@print ( s* -> )
    &loop LDAk #00 EQU ,&eof JCN
    LDAk #18 DEO INC2 ,&loop JMP
    &eof POP2 JMP2r

@cur-len ( -> n* )
    ;cur-line JSR2 ;line-len JSR2 JMP2r

@cur-last ( -> n* )
    ;cur-line JSR2 ;line-len JSR2 #0001 SUB2 JMP2r

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

@abs-line ( y* -> s* )
    #0000 SWP2 SUB2 STH2 ( [-y] )
    ;buffer/data ( addr )
    &newline ( addr [-y] )
          STH2kr ORA ,&loop JCN ,&done JMP
    &loop ( addr [-y] )
          LDAk #00 EQU ,&not-found JCN ( addr [-y] )
          LDAk #0a EQU ,&found JCN ( addr [-y] )
          INC2 ,&loop JMP ( addr+1 [-y] )
    &found INC2 INC2r ( addr+1 [-y+1] ) ,&newline JMP
    &done POP2r JMP2r
    &not-found POP2 POP2r #0000 JMP2r

( line number relative to the offset, starting at 0 )
@rel-line ( y* -> s* )
    #0000 SWP2 SUB2 STH2 ( [-y] )
    ;buffer/offset LDA2 ( addr* )
    STH2kr #0000 EQU2 ,&done JCN ( addr [-y] )
    &newline ( addr [-y] )
          STH2kr ORA ,&loop JCN ,&done JMP
    &loop ( addr [-y] )
          LDAk #00 EQU ,&not-found JCN ( addr [-y] )
          LDAk #0a EQU ,&found JCN ( addr [-y] )
          INC2 ,&loop JMP ( addr+1 [-y] )
    &found INC2 INC2r ( addr+1 [-y+1] ) ,&newline JMP
    &done POP2r JMP2r
    &not-found ;rel-line-error ;error! JMP2

@cur-line ( -> s* )
    ;cursor/row LDA2 ;rel-line JSR2 JMP2r

@cur-line-num ( -> n* )
    ;cursor/row LDA2 ;buffer/line-offset LDA2 ADD2 JMP2r

@cur-pos ( -> s* )
    ;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r

@cur-abs-row ( -> n* )
    ;buffer/line-offset LDA2 ;cursor/row LDA2 ADD2 JMP2r

@last-abs-row ( -> n* )
    ;buffer/line-count LDA2 #0001 SUB2 JMP2r

@shift-right ( c^ addr* -> )
    ROT STH                 ( addr [prev^] )
    ;last-pos JSR2 SWP2     ( last addr [prev^] )
    &loop LTH2k ,&done JCN  ( last addr [prev^] )
          LDAk STH SWPr     ( last addr [prev^ curr^] )
          DUP2 STHr         ( last addr addr prev^ [curr^] )
          ROT ROT STA       ( last addr [curr^] )
          INC2 ,&loop JMP   ( last addr+1 [curr^] )
    &done NIP2 DUP2         ( addr addr [prev^] )
          STHr ROT ROT      ( addr prev^ addr )
          STA INC2          ( addr+1 )
          ;buffer/limit STA2 ( )
    JMP2r

( TODO: change last/addr order and GTH -> LTH to remove hack )
@shift-left ( addr* -> )
    ;last-pos JSR2 SWP2              ( last addr )
    &loop GTH2k ,&next JCN           ( last addr )
                ,&done JMP           ( last addr )
    &next DUP2 INC2 LDAk             ( last addr addr+1 c1^ )
          STH SWP2 STHr              ( last addr+1 addr c1^ )
          ROT ROT                    ( last addr+1 c1^ addr )
          STA ,&loop JMP             ( last addr+1 )
    &done POP2                       ( last )
          ;buffer/limit STA2         ( )
          #00 ;buffer/limit LDA2 STA ( ensure null termination )
    JMP2r

( TODO: should be using cur-col and cur-row almost everywhere )
( otherwise, bugs! )

@cur-col ( -> col* )
    ;cursor/col LDA2 ;cur-len JSR2 ;min2 JSR2 JMP2r

@cur-row ( -> row* )
    ;cursor/row LDA2 JMP2r

@last-pos ( -> addr* )
    ;buffer/limit LDA2 #0001 SUB2 JMP2r

@more-than-one-screen ( -> bool^ )
    ;buffer/line-count LDA2 ;term/rows LDA2 GTH2 JMP2r

@fits-in-one-screen ( -> bool^ )
    ;buffer/line-count LDA2 ;term/rows LDA2 INC2 LTH2 JMP2r

@mod-div ( x^ y^ -> x%d x/y )
    DIVk STHk MUL SUB STHr JMP2r

@mod-div2 ( x^ y^ -> x%d x/y )
    DIV2k STH2k MUL2 SUB2 STH2r JMP2r

( @emit
    &short ( s* -> ) SWP ,&byte JSR
    &byte ( b^ -> ) DUP #04 SFT ,&nib JSR
    &nib ( n^ -> ) #0f AND DUP #09 GTH #27 MUL ADD #30 ADD #18 DEO
    JMP2r )

@emit-digit ( n^ -> )
    LIT '0 ADD emit JMP2r

@emit-dec ( n^ -> )
    DUP #63 GTH ,&do3 JCN
    DUP #09 GTH ,&do2 JCN
                ,&do1 JMP
    &do3 #64 ;mod-div JSR2 ;emit-digit JSR2
    &do2 #0a ;mod-div JSR2 ;emit-digit JSR2
    &do1                   ;emit-digit JSR2 JMP2r

@emit-dec2 ( n* -> )
    DUP2 #270f GTH2 ,&do5 JCN
    DUP2 #03e7 GTH2 ,&do4 JCN
    DUP2 #0063 GTH2 ,&do3 JCN
    DUP2 #0009 GTH2 ,&do2 JCN
                    ,&do1 JMP
    &do5 #2710 ;mod-div2 JSR2 NIP ;emit-digit JSR2
    &do4 #03e8 ;mod-div2 JSR2 NIP ;emit-digit JSR2
    &do3 #0064 ;mod-div2 JSR2 NIP ;emit-digit JSR2
    &do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2
    &do1                      NIP ;emit-digit JSR2 JMP2r

@messages [ &input-error "input 20 "error 00
            &bytes 20 "bytes, 00
            &save-ok "saved 00
            &save-failed "failed 00
            &lines 20 "lines] 00
            &saved "-- 20 00
            &unsaved "** 20 00 ]

@tmp [ &pos :tmp/data
       &data $100 ]

@term [ &cols 0050
        &rows 0018 ]

( relative cursor positions, e.g. 0 to cols-1 )
@cursor [ &col 0000 &row 0000 ]

( did we just see ESC? )
@saw-esc 00

( )
@filename $80

( |1ffc )
( offset is address of the first visible line )
( size is total size of data in bytes )
@buffer [ &limit 0000
          &offset :buffer/data
          &line-count 0000
          &line-offset 0000
          &data $8000 ]