draw line numbers, use color, support tabs
This commit is contained in:
parent
8acef622f4
commit
52965adb5f
129
femto.tal
129
femto.tal
|
|
@ -89,7 +89,7 @@
|
|||
|
||||
@open-file ( filename* -> )
|
||||
.File/name DEO2
|
||||
#8000 .File/length DEO2
|
||||
#f000 .File/length DEO2
|
||||
;buffer/data .File/read DEO2
|
||||
|
||||
.File/success DEI2 #0000 GTH2 ,&ok JCN
|
||||
|
|
@ -266,6 +266,19 @@
|
|||
;draw-all JSR2
|
||||
BRK
|
||||
|
||||
@insert-tab ( -> )
|
||||
;config/insert-tabs LDA ,&use-tabs JCN
|
||||
#0000 ;config/tab-width LDA2 SUB2
|
||||
&loop
|
||||
DUP2 #0000 EQU2 ,&done JCN
|
||||
#20 ;cur-pos JSR2 ;shift-right JSR2
|
||||
INC2 ,&loop JMP
|
||||
&done
|
||||
;cur-col JSR2 ;config/tab-width LDA2 ADD2 ;cursor/col STA2
|
||||
;draw-all JSR2 BRK
|
||||
&use-tabs
|
||||
#09 ;insert JMP2
|
||||
|
||||
( TODO: handle last line )
|
||||
@newline ( c^ -> )
|
||||
#0a ;cur-pos JSR2 ;shift-right JSR2
|
||||
|
|
@ -360,7 +373,7 @@
|
|||
;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 ( )
|
||||
POP2 STH2r ;cursor/row STA2
|
||||
JMP2r
|
||||
|
||||
@ensure-visible-cursor
|
||||
|
|
@ -414,6 +427,7 @@
|
|||
.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 #09 EQU ( \t ) ;insert-tab 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
|
||||
|
|
@ -440,6 +454,9 @@
|
|||
LIT '; emit INC2 ( col+1 ) ;emit-dec2 JSR2
|
||||
LIT 'H emit JMP2r
|
||||
|
||||
@term-move-right ( n* -> )
|
||||
ansi ;emit-dec2 JSR2 LIT 'C emit JMP2r
|
||||
|
||||
@term-get-cursor-position ( -> )
|
||||
ansi LIT '6 emit LIT 'n emit JMP2r
|
||||
|
||||
|
|
@ -447,12 +464,15 @@
|
|||
ansi LIT '2 emit LIT 'J emit JMP2r
|
||||
|
||||
@draw-cursor ( -> )
|
||||
;cur-col JSR2 ;cur-row JSR2
|
||||
;cur-w-col JSR2 ;term/lmargin LDA2 ADD2
|
||||
;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
|
||||
ansi ;config/color LDA2 emit emit
|
||||
LIT2 '7 '; emit emit
|
||||
LIT 'm emit ( esc [ 33 ; 7 m )
|
||||
LIT2r 2018
|
||||
;term/cols LDA2 #0000
|
||||
&loop GTH2k ,&continue JCN ,&done JMP
|
||||
|
|
@ -479,25 +499,42 @@
|
|||
ansi LIT '0 emit LIT 'm emit
|
||||
JMP2r
|
||||
|
||||
@draw-linenum ( n* -> )
|
||||
ansi ;config/color LDA2 emit emit LIT 'm emit
|
||||
;emit-dec2-pad JSR2
|
||||
ansi LIT2 'm '0 emit emit JMP2r
|
||||
|
||||
@emit-tab ( -> )
|
||||
#0000 ;config/tab-width LDA2 SUB2
|
||||
LIT2r 2018
|
||||
&loop ORAk ,&next JCN POP2 POP2r JMP2r
|
||||
&next DEOkr INC2 ,&loop JMP
|
||||
|
||||
@draw-all ( -> )
|
||||
;term-erase-all JSR2
|
||||
#0000 #0000 ;term-move-cursor JSR2
|
||||
#0001 STH2
|
||||
;buffer/line-offset LDA2 STH2 LIT2r 0001 ( [k line-offset] )
|
||||
ADD2kr STH2r ;draw-linenum JSR2
|
||||
;buffer/offset LDA2
|
||||
&loop
|
||||
LDAk #00 EQU ,&eof JCN
|
||||
LDAk #0a EQU ,&eol JCN
|
||||
LDAk #09 EQU ,&do-tab JCN
|
||||
LDAk emit INC2 ,&loop JMP
|
||||
&do-tab ;emit-tab JSR2 INC2 ,&loop JMP
|
||||
&eol INC2r STH2kr ;term/rows LDA2 GTH2 ,&done JCN
|
||||
cr nl INC2 ,&loop JMP
|
||||
cr nl INC2
|
||||
ADD2kr STH2r ;draw-linenum JSR2
|
||||
,&loop JMP
|
||||
&eof
|
||||
ansi LIT '3 emit LIT '1 emit LIT 'm emit
|
||||
&eof-loop
|
||||
STH2kr ;term/rows LDA2 GTH2 ,&done JCN
|
||||
cr nl
|
||||
;term/lmargin LDA2 ;term-move-right JSR2
|
||||
LIT '~ emit INC2r
|
||||
,&eof-loop JMP
|
||||
&done POP2 POP2r
|
||||
&done POP2 POP2r POP2r
|
||||
ansi LIT '0 emit LIT 'm emit
|
||||
;draw-statusbar JSR2
|
||||
;draw-cursor JSR2
|
||||
|
|
@ -522,6 +559,12 @@
|
|||
@cur-last ( -> n* )
|
||||
;cur-line JSR2 ;line-len JSR2 #0001 SUB2 JMP2r
|
||||
|
||||
@cur-width ( -> n* )
|
||||
;cur-line JSR2 ;line-width JSR2 JMP2r
|
||||
|
||||
@cur-w-last ( -> n* )
|
||||
;cur-line JSR2 ;line-width JSR2 #0001 SUB2 JMP2r
|
||||
|
||||
@line-len ( s* -> n* )
|
||||
#0000 STH2
|
||||
&loop LDAk #00 EQU ,&end JCN
|
||||
|
|
@ -529,6 +572,15 @@
|
|||
INC2 INC2r ,&loop JMP
|
||||
&end POP2 STH2r JMP2r
|
||||
|
||||
@line-width ( s* -> n* )
|
||||
#0000 STH2
|
||||
&loop LDAk #00 EQU ,&done JCN
|
||||
LDAk #0a EQU ,&done JCN
|
||||
LDAk #09 EQU ,&tabs JCN
|
||||
INC2 INC2r ,&loop JMP
|
||||
&tabs #0004 ADD2 ,&loop JMP
|
||||
&done POP2 STH2r JMP2r
|
||||
|
||||
@abs-line ( y* -> s* )
|
||||
#0000 SWP2 SUB2 STH2 ( [-y] )
|
||||
;buffer/data ( addr )
|
||||
|
|
@ -597,12 +649,17 @@
|
|||
#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-w-col ( -> col* )
|
||||
LIT2r 0000 ( [0] )
|
||||
;cur-line JSR2 DUP2 ;cur-col JSR2 ADD2 SWP2 ( lim s [0] )
|
||||
&loop GTH2k ,&next JCN
|
||||
POP2 POP2 STH2r JMP2r
|
||||
&next LDAk #09 EQU ,&tabs JCN INC2 INC2r ,&loop JMP
|
||||
&tabs INC2 ;config/tab-width LDA2 STH2 ADD2r ,&loop JMP
|
||||
|
||||
@cur-row ( -> row* )
|
||||
;cursor/row LDA2 JMP2r
|
||||
|
||||
|
|
@ -621,11 +678,14 @@
|
|||
@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 )
|
||||
@base-10-width ( n* -> w* )
|
||||
LIT2r 0000 ( n [0] )
|
||||
&loop ( n [w] )
|
||||
DUP2 #0000 EQU2 ,&done JCN ( n [w] )
|
||||
#000a DIV2 ( n/10 [w] )
|
||||
INC2r ,&loop JMP ( n/10 [w+1] )
|
||||
&done ( 0 [w] )
|
||||
POP2 STH2r JMP2r
|
||||
|
||||
@emit-digit ( n^ -> )
|
||||
LIT '0 ADD emit JMP2r
|
||||
|
|
@ -650,6 +710,20 @@
|
|||
&do2 #000a ;mod-div2 JSR2 NIP ;emit-digit JSR2
|
||||
&do1 NIP ;emit-digit JSR2 JMP2r
|
||||
|
||||
@emit-dec2-pad ( n* -> )
|
||||
LIT2r 2018 ( preload #20 .Console/write into rst )
|
||||
DUP2 #270f GTH2 ,&do5 JCN DEOkr
|
||||
DUP2 #03e7 GTH2 ,&do4 JCN DEOkr
|
||||
DUP2 #0063 GTH2 ,&do3 JCN DEOkr
|
||||
DUP2 #0009 GTH2 ,&do2 JCN DEOkr
|
||||
,&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
|
||||
DEOr JMP2r
|
||||
|
||||
@messages [ &input-error "input 20 "error 00
|
||||
&bytes 20 "bytes, 00
|
||||
&save-ok "saved 00
|
||||
|
|
@ -662,7 +736,28 @@
|
|||
&data $100 ]
|
||||
|
||||
@term [ &cols 0050
|
||||
&rows 0018 ]
|
||||
&rows 0018
|
||||
&lmargin 0006 ]
|
||||
|
||||
( COLORS )
|
||||
( )
|
||||
( SHORT STRING NAME )
|
||||
( 3033 "30" black )
|
||||
( 3133 "31" red )
|
||||
( 3233 "32" green )
|
||||
( 3333 "33" yellow )
|
||||
( 3433 "34" blue )
|
||||
( 3533 "35" magenta )
|
||||
( 3633 "36" cyan )
|
||||
( 3733 "37" white )
|
||||
( 3030 "00" default )
|
||||
( )
|
||||
( digits are reversed )
|
||||
( to emit from stack in )
|
||||
( last-in-first-out order )
|
||||
@config [ &tab-width 0004
|
||||
&insert-tabs 01
|
||||
&color 3333 ]
|
||||
|
||||
( relative cursor positions, e.g. 0 to cols-1 )
|
||||
@cursor [ &col 0000 &row 0000 ]
|
||||
|
|
@ -680,4 +775,4 @@
|
|||
&offset :buffer/data
|
||||
&line-count 0000
|
||||
&line-offset 0000
|
||||
&data $8000 ]
|
||||
&data $f000 ]
|
||||
|
|
|
|||
Loading…
Reference in New Issue