You. Forth. Simplicity. git repository download prior releases documentation wiki issue tracker mailing list and forum irc channel and logs try it

reload node | edit | recent changes | front page

#! /usr/local/bin/rf-linux -f

: <= 1+ < ; : >= 1- > ;
: between ( c a b -- f ) rot swap over >= -rot <= and ;
: q default clear bye ;

: xy 27 emit '[ emit # '; emit # 'H emit ;
: color 27 emit '[ emit # 'm emit ;

: default 0 color ;
: bold 1 color ;
: underscore 4 color ;
: blink 5 color ;
: reverse 7 color ;
: concealed 8 color ;
: fg 30 + color ;
: bg 40 + color ;

0 constant black
1 constant red
2 constant green
3 constant yellow
4 constant blue
5 constant magenta
6 constant cyan
7 constant white

64 constant /line
16 constant /block
/line /block * constant $block
variable ln 0 ln !
variable col 0 col !

create curr $block allot curr $block 32 fill

: title s" untitled " 1 1 xy blue bg white fg bold ." 2myED - " dup -rot type /line swap - 9 - spaces default ;
: status 1 /block 2 + xy blue bg white fg dup -rot 32 emit type /line swap - 1- spaces default ;
: caret col @ 1+ ln @ 2 + xy ;
: update-status blue bg white fg 1 /block 2 + xy /line spaces 2 /block 2 + xy ." ln " ln @ 1+ # ." col " col @ 1+ # default caret ;
: get-char ( x y -- c ) 2dup swap 1+ swap 2 + xy /line * + curr + c@ ;
: set-char ( c x y -- ) /line * + curr + c! ;
: line ( # -- ) black bg white fg col @ over xy 0 swap repeat 2dup get-char emit swap 1+ swap over /line =if 2drop ;then again ;
: lines 0 repeat dup line 1+ dup /block =if drop ;then again ;
: update-line ln @ line ;
: query-quit s" quit? (y/n) " status 14 /block 2 + xy ekey 'y =if q then update-status ;
: next-ln ln @ 1+ dup /block >= if 1- then ln ! update-status ;
: prev-ln ln @ 1- dup -1 =if 1+ then ln ! update-status ;
: next-col col @ 1+ dup /line >= if drop 0 next-ln then col ! update-status ;
: prev-col col @ 1- dup -1 =if 1+ then col ! update-status ;
: return 0 col ! next-ln update-status ;
: backspace prev-col 32 col @ ln @ set-char update-line update-status ;
: delete-sub repeat col @ 1+ ln @ get-char col @ ln @ set-char next-col col @ /line 1- =if ;then again ;
: delete col @ delete-sub 32 /line 1- ln @ set-char col ! update-line update-status ;
: delete-line ln @ /line * curr + 0 repeat 2dup + 32 swap c! 1+ dup /line >= if 2drop update-line update-status ;then again ;

loc:
variable cnt
create req2 128 allot req2 128 0 fill
: key-status dup /line 1- /block 2 + xy blue bg white fg emit default caret ;
: num-status dup /line 3 - /block 2 + xy blue bg white fg '0 + dup '1 <= if drop 32 then emit default caret ;
: set2 ( n -- ) req2 + 1 swap c! ; | n < 128
: get2 dup 128 < if req2 + c@ ;then drop 0 ;
'd set2
: num+cmd ekey dup '0 '9 between if '0 - dup cnt ! num-status drop ekey ;then ;
:: mode key-status drop ;
:: no-mode 32 key-status drop ;
:: 0 cnt ! num+cmd cnt @ swap dup get2 0 =if 0 num-status ;then
key-status ekey 32 key-status drop 0 num-status drop ;
;loc is [num][cmd] ( -- num cmd1 cmd2 ) is no-mode is mode

: replace-loop ekey dup 27 =if drop ;then
dup 127 ( delete ) =if backspace 'r mode replace-loop ;then
dup 10 ( new line ) =if return 'r mode replace-loop ;then
dup 32 col @ ln @ set-char update-line next-col 'r mode replace-loop ;

: help-cmd space wsparse blue fg bold type default 2 spaces lnparse type cr ;
: show-help
bold
." 2myED - Help Screen" cr cr
default
{ help-cmd q quit }
{ help-cmd j next line }
{ help-cmd k previous line }
{ help-cmd l next column }
{ help-cmd h previous column }
{ help-cmd | start of line }
{ help-cmd $ end of line }
{ help-cmd x delete character and move rest of line one character to the left }
{ help-cmd dd clear line }
{ help-cmd r enter replace mode (write text to block) }
{ help-cmd i same as 'r' }
{ help-cmd o same as 'r', but move to next line first }
{ help-cmd O move to previos line before entering replace mode }
{ help-cmd e evaluate current block }
{ help-cmd ? show this help screen } cr
blue fg bold ." Esc " default ." will escape input/replace mode" cr
blue fg bold ." Backspace " default ." will erase one character at current position" cr
blue fg bold ." Return " default ." will move to the start of next line in any state" cr
blue fg bold ." j k l h x " default ." can be prefixed with a number from 0-9" cr
." specifying the repeat count of the command" cr cr
red fg bold
." Press any key to continue... "
default ekey
;

variable cnt variable ext
: rep wsparse cnt @ dup 0 =if 1+ then repeat -rot 2dup eval rot 1- dup 0 =if drop 2drop ;then again ;
: cmd [num][cmd] ext ! swap cnt !
update-status
switch
'q case: query-quit update-status cmd break
'j case: { rep next-ln } cmd break
'k case: { rep prev-ln } cmd break
'l case: { rep next-col } cmd break
'h case: { rep prev-col } cmd break
'| case: 0 col ! update-status cmd break
'$ case: /line 1- col ! update-status cmd break
10 case: { rep return } cmd break
127 case: { rep backspace } cmd break
'x case: { rep delete } cmd break
'd case: ext @ 'd =if delete-line cmd ;then s" illegal command, expected 'dd'" status caret cmd break
'r case: 'r mode replace-loop no-mode cmd break
'i case: 'i mode replace-loop no-mode cmd break
'o case: return 'r mode replace-loop no-mode cmd break
'O case: 0 col ! prev-ln update-status 'r mode replace-loop no-mode cmd break
'e case: default clear curr $block eval cr ." Press any key to continue... " ekey clear title lines update-status cmd break
'? case: default clear show-help clear title lines update-status cmd break
s" illegal command" status caret cmd ;

clear title lines update-status cmd