Artifact ae8e2736d12b9eecd799bfd38e7ebfee1faa77b3
File editor.rx part of check-in [03e21899eb] - update editor, image by crc on 2011-01-17 15:20:35. [annotate]
( retro editor v11-2011.01.17 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Key Action )
( --- ------------------------------------------------- )
( i Move cursor up )
( j Move cursor left )
( k Move cursor down )
( l Move cursor right )
( [ Switch to previous block )
( ] Switch to next block )
( e Evaluate current block )
( E Evaluate all blocks )
( m Move cursor to start of next line )
( I Move cursor to top line of block )
( J Move cursor to start of current line )
( K Move cursor to last line of block )
( L Move cursor to end of current line )
( M Center cursor on current line )
( z Exit RxE )
( { Load "blocks" )
( } Save "blocks" )
( TAB Switch between edit and command mode )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
chain: editor'
: textColor ^console'cyan ;
: statusColor ^console'yellow ;
: uiColor ^console'red ;
{{
2 elements buffer count
: restore ( - ) &getc :devector ok ;
: get ( -c ) @buffer @ ;
: next ( -c ) @count [ count -- get buffer ++ ] [ 32 restore ] if ;
: replace ( - ) &next &getc :is ;
: eval ( an- ) !count !buffer replace ;
7 elements #blocks offset blk line column mode active
: toBlock 1600 * @offset + ;
: thisBlock @blk toBlock ;
: toLine 80 * thisBlock + ;
( check boundaries ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: top ( - ) 0 !line ;
: bot ( - ) 19 !line ;
: beg ( - ) 0 !column ;
: end ( - ) 79 !column ;
: mid ( - ) 41 !column ;
: 1st ( - ) 0 !blk ;
: bounds ( - )
@column -1 = [ end line -- ] ifTrue
@column 80 = [ beg line ++ ] ifTrue
@line -1 = [ top blk -- ] ifTrue
@line 20 = [ bot blk ++ ] ifTrue
@blk -1 = [ 1st ] ifTrue
@blk @#blocks >= [ blk -- ] ifTrue ;
( display a block ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: rows 20 [ dup 80 textColor [ @ putc ] ^types'BUFFER each@ 80 + cr ] times ;
: mode? @mode [ "INS" ] [ "CMD" ] if ;
: .block @column @line @blk mode? "(%s) #%d - %d:%d " puts ;
: bar uiColor 80 [ '- putc ] times cr ;
: vb @blk toBlock rows drop bar statusColor .block ^console'normal ;
: (v) ( - ) ^console'colors @ [ ^console'home ] &clear if vb ;
: pos ( -cl ) @column @line ;
: get ( cl-a ) toLine + ;
: va ( a-va ) dup @ swap ;
: c! ( a- ) '* swap ! ;
: show ( va- ) dup c! (v) ! ;
: display ( - ) bounds pos get va show ;
( input processing ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: ws ( - ) remapping off later remapping on ;
: advance? ( - ) line ++ @line 20 >= [ 0 !line blk ++ ] ifTrue 0 !column ;
: del ( - )
@column dup
[ dup 80 =
[ drop !column display 0 ]
[ 32 over @line get ! 1+ -1 ] if
] while ;
: remap ( c-c )
dup 9 = [ drop 27 ] ifTrue
dup 13 = [ drop 0 ] ifTrue
dup 10 = [ drop 0 advance? display ] ifTrue ;
: input ( - )
repeat
display
@mode 0; drop
getc 0;
dup 27 <> 0; drop
dup 8 = [ drop column -- display ] [ pos get ! column ++ ] if
again ;
: rxe.in ( -c ) mode on ws input mode off ;
: match ( c- ) "$$_" dup [ 2 + ! ] dip find [ @d->xt do ] &drop if ;
: edit? ( c-c ) dup 27 = [ rxe.in drop ] ifTrue ;
( various support bits ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
: new ( - ) @offset 32 1600 @#blocks * fill ;
: e ( - ) thisBlock 1600 eval ;
: ea ( - ) @offset @#blocks 1600 * eval ;
: run ( - )
@fb [ ^console'colors off ] ifTrue active on
&remap &remapKeys :is clear
[ display getc edit? match @active ] while ;
---reveal---
: setBlocks ( n- ) !#blocks @memory 1600 @#blocks * - !offset new ;
: edit ( - )
@ch 22 >= @cw 80 >= and
&run [ "requires an 80x22 or greater display, sorry!\n" puts ] if ;
: $$i line -- ;
: $$j column -- ;
: $$k line ++ ;
: $$l column ++ ;
: $$m $$k beg ;
: $$I top ;
: $$J beg ;
: $$K bot ;
: $$L end ;
: $$M mid ;
: $$D del ;
: $$[ blk -- ;
: $$] blk ++ ;
: $${ @offset "blocks" ^files'slurp drop ;
: $$} @offset @#blocks 1600 * "blocks" ^files'spew ;
: $$e active off ^console'normal e ;
: $$E active off ^console'normal ea ;
: $$z active off ;
128 setBlocks
}}
;chain
global
with editor'