Artifact 34841649ef2377f0bba161d7252fcefd861d8aba
File rxe.retro part of check-in [d918c68871] - Fix a bug leaving values on the stack in RxE when using $$b key. by charleschilders on 2010-06-01 10:24:11. [annotate]
( Retro Experimental Editor ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( This is a replacement for the RED/REM editors used in past )
( releases of Retro. )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Key Action )
( --- ------------------------------------------------- )
( i Move cursor up )
( j Move cursor left )
( k Move cursor right )
( l Move cursor down )
( [ 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 )
( { Export current block )
( } Import a saved block into the current block )
( TAB Switch between edit and command mode )
( ESC Switch between edit and command mode )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
&console open
&files open
vocab rxe::core
((
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
3 elements #-blocks offset blk
: block 512 * @offset + ;
: (block) @blk block ;
: (line) 64 * (block) + ;
{{
: <|> red char: | emit ;
: <+> red char: + emit ;
: type for @+ emit next drop ;
: rows 8 for <|> dup 64 cyan type 64 + <|> cr next ;
: .block space ." #" @blk . cr ;
: bar red <+> 64 for char: - emit next <+> ;
: vb bar cr @blk block rows drop bar yellow .block white ;
---reveal---
: (v) ( - ) home vb ;
: new ( - ) offset @ 32 512 #-blocks @ * fill ;
: e ( - ) (block) 512 eval ;
: ea ( - ) @offset @#-blocks 512 * eval ;
: set-blocks ( n- )
here !offset dup !#-blocks 512 * allot ;
}}
128 set-blocks new
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
3 elements line column mode
stub rxe.display
stub rxe.in
: rxe.key key ;
: rxe.write ! ;
( Display block, with cursor )
: pos ( -cl) @column @line ;
: get ( cl-a) (line) + ;
: va ( a-va) dup @ swap ;
: c! ( a-) char: * swap ! ;
: show ( va- ) dup c! (v) ! ;
: insmode @mode if ." INS" else ." CMD" then cr ;
: display ( - ) pos get va show insmode ;
( Bounds checking )
: top ( - ) 0 !line ;
: bot ( - ) 7 !line ;
: beg ( - ) 0 !column ;
: end ( - ) 63 !column ;
: mid ( - ) 31 !column ;
: 1st ( - ) 0 !blk ;
: bounds ( - )
@column -1 =if end line -- then
@column 64 =if beg line ++ then
@line -1 =if top blk -- then
@line 8 =if bot blk ++ then
@blk -1 =if 1st then
@blk @#-blocks >if blk -- then ;
: input ( - )
repeat
rxe.display
@mode 0; drop
key
dup 27 <> 0; drop
dup 8 =if drop column -- rxe.display [ over 8 , , ] then
dup 10 =if drop line ++ else pos get rxe.write column ++ then
again ;
: ws ( - ) whitespace off later whitespace on ;
: match ( c- ) s" $$_" dup push 2 + ! pop find if @d->xt execute else drop then ;
: edit? ( c-c ) dup 27 =if rxe.in drop then ;
: advance? ( - )
1 +line @line 8 >if 0 !line 1 +blk then 0 !column ;
: remap ( c-c )
dup 9 =if drop 27 then
dup 13 =if drop 10 then
dup 10 =if drop 32 advance? then ;
here ] bounds display ; is rxe.display
here ] mode on ws input mode off ; is rxe.in
: blank ( -f ) @line (line) -1 64
for over r + @ 32 = not if drop 0 then next nip ;
: toblank repeat line ++ blank if; again ;
: swaplines
@line dup 1- (line) swap (line) 2dup here 64 copy
swap 64 copy here swap 64 copy ;
: pullspace
@line toblank repeat @line over =if drop line ++ bounds ;then
swaplines line -- again ;
: shovespace
line -- bounds
@line repeat
line ++ blank if !line ;then
swaplines again ;
))
vocab rxe::keys
((
: $$i line -- ; ( i = up )
: $$j column -- ; ( j = left )
: $$k line ++ ; ( k = down )
: $$l column ++ ; ( l = right )
: $$m $$k beg ; ( m = enter )
: $$I top ; ( I = top )
: $$J beg ; ( J = start )
: $$K bot ; ( K = bottom )
: $$L end ; ( L = end )
: $$M mid ; ( M = middle )
: $$[ blk -- ; ( p = previous block )
: $$] blk ++ ; ( n = next block )
: $$b pullspace ;
: $$B shovespace ;
: $$z ( z = exit rxe )
&rxe::keys shut
&remap-keys :devector
pop pop 2drop normal ;
: $$e ( e = evaluate block )
normal pop pop 2drop e ;
: $$E ( E = evaluate all )
normal pop pop 2drop ea ;
{{
3 elements fid action mode
: ask ( - ) ." File? " 32 accept ;
: open ( - ) tib @mode fopen !fid ;
: emit ( c- ) @fid fwrite drop ;
: dump ( an- ) for @+ emit next drop 10 emit ;
: key ( -c ) @fid fread ;
: read ( an- ) for key swap !+ next key 2drop ;
: all ( -a ) @blk block 8 for dup 64 @action execute 64 + next ;
: end ( a- ) @fid fclose 2drop ;
: common ( - ) ask open @fid if all end then clear ;
---reveal---
: $${ &dump !action :w !mode common ;
: $$} &read !action :r !mode common ;
}}
))
: edit ( - )
&remap &remap-keys :is
&rxe::keys open clear bold
repeat rxe.display key edit? match again ;
&rxe::keys shut
&rxe::core shut
&files shut
&console shut
edit