nxu/femto.tal

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

|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 }
%exit { #01 .System/halt DEO BRK }

%ansi { #1b18 DEO #5b18 DEO }

%WIDTH { #50 }
%LAST-COL { #4f }
%PEN-COL { #4e }

%HEIGHT { #18 }
%LAST-LINE { #17 }
%PEN-LINE { #16 }

( useful ASCII )
( - ESC 1b )
( - '[' 5b )
( - )

( 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             )
(                                       )
( 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        )

|0100

    ;demo-path .File/name DEO2
    #8000 .File/length DEO2
    ;buffer/data .File/read DEO2

    .File/success DEI2 #0000 GTH2 ,&ok JCN
    ;input-error ;println JSR2 nl exit

    &ok
    .File/success DEI2 ;buffer/data ADD2 ;buffer/limit STA2
    ;on-key .Console/vector DEO2
    ;draw-all JSR2
    BRK


@bol
    #00 ;cursor/col STA
    ;draw-cursor JSR2 BRK

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

( FIXME: handle long lines )
@forward
    ;cursor/col LDA PEN-COL GTH ,&skip JCN
    ;cursor/col LDA #01 ADD ;cursor/col STA
    ;draw-cursor JSR2
    &skip BRK

( FIXME: handle long lines )
@back
    ;cursor/col LDA #01 LTH ,&skip JCN
    ;cursor/col LDA #01 SUB ;cursor/col STA
    ;draw-cursor JSR2
    &skip BRK

@up
    ;cursor/row LDA #01 LTH ,&screen-up JCN
    ;cursor/row LDA #01 SUB ;cursor/row STA
    ;draw-cursor JSR2 BRK
    &screen-up
    ;buffer/offset LDA2 DUP2 ;buffer/data EQU2 ,&done JCN
    #0001 SUB2
    &loop DUP2 ;buffer/data EQU2 ,&complete JCN
          #0001 SUB2 LDAk #0a NEQ ,&loop JCN
          INC2
    &complete ;buffer/offset STA2 ;draw-all JSR2 BRK
    &done POP2 BRK

( FIXME: need to handle 'end of buffer' stuff )
@down
    ;cursor/row LDA PEN-LINE GTH ,&screen-down JCN
    ;cursor/row LDA #01 ADD ;cursor/row STA
    ;draw-cursor JSR2 BRK
    &screen-down
    #00 ;rel-line JSR2 ;line-len JSR2 INC2 ( add 1 for line ending )
    ;buffer/offset LDA2 ADD2
    ;buffer/offset STA2
    ;draw-all JSR2
    BRK

@quit exit

@ignore BRK

@die #00 #00 DIV

@insert ( c^ -> )
    ;cursor/col LDA PEN-COL GTH ,&skip JCN ( FIXME )
    ;cur-pos JSR2 ;shift-right JSR2
    ;cursor/col LDA INC ;cursor/col STA
    ;draw-all JSR2
    &skip BRK

@overwrite ( c^ -> )
    ;cursor/col LDA PEN-COL GTH ,&skip JCN ( FIXME )
    ;cur-pos JSR2 STA
    ;cursor/col LDA #01 ADD ;cursor/col STA
    ;draw-all JSR2
    &skip BRK

@newline ( c^ -> )
    #0a ;cur-pos JSR2 ;shift-right JSR2
    #00 ;cursor/col STA
    ;cursor/row LDA INC ;cursor/row STA
    ;draw-all JSR2
    BRK

@backspace ( -> )
    ;cur-pos JSR2 ;buffer/data EQU2 ,&skip JCN
    ;cursor/col LDA #00 EQU ,&prev-line JCN
        ;cursor/col LDA #01 SUB ;cursor/col STA
        ,&finish JMP
    &prev-line
        ;cursor/row LDA #01 SUB ;cursor/row STA
        ;cur-len JSR2 NIP ;cursor/col STA
    &finish
        ;cur-pos JSR2 ;shift-left JSR2
        ;draw-all JSR2
    &skip BRK

( there's at least one bug -- join lots of lines near start )
@delete ( -> )
    ;last-pos JSR2 #0001 SUB2 
    ;cur-pos JSR2 LTH2k ,&skip JCN
    ;cur-pos JSR2 ;shift-left JSR2
    ;draw-all JSR2
    &skip BRK

( TODO: tab? )
@on-key
    .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 #0d EQU ( \r  ) ;newline JCN2
    .Console/read DEI #0e EQU ( C-n ) ;down JCN2
    .Console/read DEI #10 EQU ( C-p ) ;up JCN2
    .Console/read DEI #18 EQU ( C-x ) ;quit 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

@min ( x^ y^ -> min^ )
    LTHk JMP SWP POP JMP2r

@draw-cursor
    ansi        ;get-row JSR2 INC ;emit-dec JSR2
    LIT '; emit ;get-col JSR2 INC ;emit-dec JSR2
    LIT 'H emit JMP2r

@draw-all
    ansi LIT '2 emit LIT 'J emit
    ansi LIT 'H emit
    #00 STH
    ;buffer/offset LDA2
    &loop
    LDAk #00 EQU ,&eof JCN
    LDAk #0a EQU ,&eol JCN
    LDAk emit INC2 ,&loop JMP
    &eol INCr STHkr LAST-LINE ( #17 ) GTH ,&eof JCN
         cr nl INC2 ,&loop JMP         
    &eof POP2 POPr
    ;draw-cursor JSR2
    JMP2r

@println ( 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

@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

( line number relative to the offset, starting at 0 )
@rel-line ( y^ -> s* )
    #00 SWP SUB STH ( [-y] )
    ;buffer/offset LDA2 ( addr* )
    &newline ( addr [-y] )
          STHkr ,&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 INCr ( addr+1 [-y+1] ) ,&newline JMP
    &done POPr JMP2r
    &not-found #00 #00 DIV

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

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

@shift-right ( c^ addr* -> )
    ROT STH                 ( addr [prev^] )
    ;buffer/limit LDA2      ( addr limit [prev^] )
    #0001 SUB2 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

@shift-left ( addr* -> )
    ;buffer/limit LDA2        ( addr limit )
    #0001 SUB2 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  ( )
    JMP2r

@input-error "input 20 "error 00
@demo-path "math32.tal 00

( col is 0-79, row is 0-23 )
@cursor [ &col 00 &row 00 ]

@get-col
    ;cursor/col LDA ;cur-len JSR2 NIP ;min JSR2 JMP2r

@get-row
    ;cursor/row LDA JMP2r

@last-pos
    ;buffer/limit LDA2 #0001 SUB2 JMP2r

(
@doc-start ( -> s* ) ;buffer/data JMP2r
@doc-limit ( -> s* ) ;buffer/limit LDA2 JMP2r
@doc-last ( -> s* ) ;buffer/limit LDA2 #0001 SUB2 JMP2r

@page-start ( -> s* ) ;buffer/offset LDA2 JMP2r
@page-limit ( -> s* ) HEIGHT ;rel-line JSR2 JMP2r
@page-last ( -> s* ) HEIGHT ;rel-line JSR2 #0001 SUB2 JMP2r

@line-start ( -> s* ) ;cursor/row LDA ;rel-line JSR2 JMP2r
@line-limit ( -> s* ) ;cursor/row LDA INC ;rel-line JSR2 JMP2r
@line-last ( -> s* ) ;cursor/row LDA INC ;rel-line JSR2 #0001 SUB2 JMP2r
)

@mod-div ( x^ y^ -> x%d x/y )
    DIVk ( x y x/y ) STHk ( x y x/y [x/y] ) MUL ( x y*x/y [x/y] )
    SUB ( x%y [x/y] ) STHr ( x%y x/y ) 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

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