263 lines
7.1 KiB
Tal
263 lines
7.1 KiB
Tal
|
( 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 ]
|