spinix-hive/pfth/ted.fth

279 lines
5.3 KiB
Forth

create ted_linenum 0 ,
create ted_first 0 ,
create ted_last 0 ,
create ted_numline 0 ,
create ted_cmd 0 ,
create ted_changed 0 ,
create ted_numchar 0 ,
create ted_bigptr 0 ,
create ted_fileid 0 ,
0 value ted_instr
0 value ted_lineptr
\ Check if a decimal digit
: ted_IsDigit ( value -- digit )
dup [char] 0 >= swap [char] 9 <= and
;
\ Get a decimal number
: ted_GetNumber ( str -- str number )
0
begin
over c@ dup ted_IsDigit
while
[char] 0 - swap 10 * +
swap 1+ swap
repeat
drop
;
\ Get a line number
: ted_GetLineNumber ( str -- str number )
dup c@ ( str byte[str] )
dup [char] . = if drop 1+ ted_linenum @ else
dup [char] - = if drop 1+ ted_linenum @ 1- else
dup [char] + = if drop 1+ ted_linenum @ 1+ else
dup [char] $ = if drop 1+ ted_numline @ 1- else
ted_IsDigit if ted_GetNumber 1- else
-2
then then then then then
( num str value )
\ ( value < 0 | value >= ted_numline ) & value <> -2
dup 0 <
over ted_numline @ >= or
over -2 <> and
if drop -3 then
;
\ Get the first and last line numbers and the command
: ted_ParseCommand ( str -- str retval )
ted_GetLineNumber dup ted_first ! -3 = if 0 exit then
ted_first @ -2 = if ted_linenum @ ted_first ! then
dup c@ [char] , =
if
1+
ted_GetLineNumber dup ted_last ! -3 = if 0 exit then
else
-2 ted_last !
then
ted_last @ -2 = if ted_first @ ted_last ! then
dup c@ ted_cmd !
ted_first @ ted_last @ > if 0 else 1 then
;
\ Print the help information
: ted_help
." TED Commands" cr
." q - quit" cr
." w - write" cr
." d - delete line" cr
." i - insert lines" cr
." a - append lines" cr
." p - print lines" cr
." j - join line (not implemented)" cr
." # - move to line #" cr
." . - current line" cr
." $ - move to last line" cr
." - - move down one line" cr
." + - move up one line" cr
." h - print help information" cr
;
: ted_InsertLine ( str linenum )
ted_numline @
begin
2dup < ( ted_linenum < ted_numline )
while
dup 1- 2* ted_lineptr + w@
over 2* ted_lineptr + w!
1-
repeat
drop 2* ted_lineptr + w!
ted_numline @ 1+ ted_numline !
;
: ted_DeleteLine ( linenum )
ted_numline @ swap
begin
2dup >
while
dup 1+ 2* ted_lineptr + w@
over 2* ted_lineptr + w!
1+
repeat
drop drop
ted_numline @ 1- ted_numline !
;
: ted_ReadLines
begin
ted_bigptr @ 1+ dup 79 accept
dup 1 = rot c@ [char] . = and 0=
while
ted_bigptr @ c!
ted_bigptr @
ted_linenum @ ted_InsertLine
ted_bigptr @ dup c@ + 1+ ted_bigptr !
ted_linenum @ 1+ ted_linenum !
repeat
drop
ted_linenum @ 1- ted_linenum !
1 ted_changed !
;
: ted_readfile
bl word
dup count 0 open-file
0 ted_linenum !
if
drop
count 0 create-file drop
ted_fileid !
else
swap drop
ted_fileid !
begin
ted_bigptr @ 1+ 100 ted_fileid @ read-line drop
0 = if drop ted_linenum @ 1- ted_linenum ! exit then
ted_bigptr @ c!
ted_bigptr @ ted_linenum @ ted_InsertLine
ted_bigptr @ c@ ted_numchar @ + ted_numchar !
ted_bigptr @ dup c@ + 1+ ted_bigptr !
ted_linenum @ 1+ ted_linenum !
again
then
;
: ted_error ." ?" cr ;
: ted_writefile
0 ted_fileid @ reposition-file drop
0
ted_numline @ 0 ?do
i 2* ted_lineptr + w@
dup count ted_fileid @ write-line drop
c@ + 1+
loop
ted_fileid @ flush-file drop
. cr
;
: ted
0 ted_numchar !
0 ted_numline !
here dup to ted_instr
80 + dup to ted_lineptr
800 + ted_bigptr !
ted_readfile
ted_numline @ 1 - ted_linenum !
ted_numchar @ . cr
begin
ted_instr 79 accept
ted_instr + 0 swap c!
ted_instr ted_ParseCommand swap drop
\ ted_first ? ted_last ? ted_cmd ? cr
ted_cmd @ swap 0 =
if
ted_error
else
\ No command
dup 0 =
if
ted_last @ dup 0 <
if
drop
ted_error
else
dup ted_linenum ! dup 1+ .
2* ted_lineptr + w@ count type cr
then
else
\ Quit
dup [char] q =
if
ted_changed @
if
ted_error
0 ted_changed !
else
drop
ted_fileid @ close-file drop
quit
then
else
\ Help
dup [char] h =
if
ted_help
else
dup [char] w =
if
ted_writefile
0 ted_changed !
else
\ Delete Lines
dup [char] d =
if
ted_first @ 0 <
if
ted_error
else
ted_first @ 1- ted_linenum !
ted_last @ 1+ ted_first @ ?do
ted_first @ ted_DeleteLine
loop
1 ted_changed !
then
ted_first @ ted_numline @ 1- min ted_linenum !
else
\ Insert Lines
dup [char] i =
if
ted_first @ 0 max ted_linenum !
ted_ReadLines
else
\ Append Lines
dup [char] a =
if
ted_first @ 1+ ted_linenum !
ted_ReadLines
else
\ Print Lines
dup [char] p =
if
ted_first @ 0 <
if
ted_error
else
ted_last @ 1+ ted_first @ do
i dup 1+ .
2* ted_lineptr + w@ count type cr
loop
then
ted_last @ ted_linenum !
else
\ Join Lines
dup [char] j =
if
." Not implemented" cr
\ Invalid Command
else
ted_error
then then then then then then then then then then
drop
again
;