spinix-hive/pfth/ted.fth

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
;