femto kind of working
This commit is contained in:
parent
ce43eadabd
commit
765340fde2
|
|
@ -0,0 +1,262 @@
|
|||
( femto.tal )
|
||||
|
||||
|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 )
|
||||
( )
|
||||
( 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 )
|
||||
|
||||
|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
|
||||
|
||||
@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
|
||||
|
||||
@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 #01 ADD ;cursor/col STA
|
||||
;draw-all JSR2
|
||||
&skip BRK
|
||||
|
||||
( FIXME: this is broken, shift-left in particular )
|
||||
@backspace ( -> )
|
||||
;cursor/col LDA #00 EQU ,&skip JCN
|
||||
;cursor/col LDA #01 SUB ;cursor/col STA
|
||||
;cur-pos JSR2 ;shift-left JSR2
|
||||
;draw-all JSR2
|
||||
&skip BRK
|
||||
|
||||
@on-key
|
||||
.Console/read DEI #01 EQU ;bol JCN2
|
||||
.Console/read DEI #02 EQU ;back JCN2
|
||||
.Console/read DEI #05 EQU ;eol JCN2
|
||||
.Console/read DEI #06 EQU ;forward JCN2
|
||||
.Console/read DEI #0e EQU ;down JCN2
|
||||
.Console/read DEI #10 EQU ;up JCN2
|
||||
.Console/read DEI #18 EQU ;quit JCN2
|
||||
.Console/read DEI #7f EQU ;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 ;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/data )
|
||||
;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
|
||||
|
||||
@first-line ( -> s* )
|
||||
;buffer/offset LDA2 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 ,¬-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
|
||||
¬-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 GTHk ,&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.txt 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
|
||||
|
||||
|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 ]
|
||||
27
regex.tal
27
regex.tal
|
|
@ -563,3 +563,30 @@
|
|||
|
||||
@arena-pos :arena-bot ( the next position to allocate )
|
||||
@arena-bot $400 @arena-top ( holds up to 1024 bytes )
|
||||
|
||||
( INTERVAL OPERATIONS )
|
||||
( )
|
||||
( )
|
||||
|
||||
@min ( first* last* -> min-addr* )
|
||||
SWP2 STH2k ,&incr JMP ( last first [first] )
|
||||
&loop LDAk LDAkr STHr LTH ,&replace JCN ,&incr JMP ( last a [c] )
|
||||
&replace POP2r STH2k ( last a [a] )
|
||||
&incr EQUk ,&done JCN INC2 ,&loop JMP ( last a+1 [c] )
|
||||
&done POP2 POP2 STH2r JMP2r ( c )
|
||||
|
||||
@sort ( first* last* -> )
|
||||
SWP2 ( last first )
|
||||
&loop ;min JSR2 NEQk ,&swap JCN POP2 ,&incr JMP
|
||||
&swap STH2 LDA2k ( last first fx [min] ) STH2kr STA STH2r SWP2 ( last min first )
|
||||
STH2 LDA2 ( last mx [first] ) STH2kr STA STH2r ( last first )
|
||||
&incr EQUk ,&done JCN INC2 ,&loop JMP
|
||||
&done POP2 POP2 JMP2r
|
||||
|
||||
@iv-in-range ( c^ b0^ b1^ -> bool^ )
|
||||
ROT STHk LTH ,&above JCN
|
||||
STHr GTH ,&below JCN #01 JMP2r
|
||||
&above POPr POP &below #00 JMP2r
|
||||
|
||||
@iv-find ( c^ iv* -> bool^ )
|
||||
|
||||
Loading…
Reference in New Issue