f5840434bc 2010-05-31 charlesch: ( Retro Experimental Editor ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) f5840434bc 2010-05-31 charlesch: ( This is a replacement for the RED/REM editors used in past ) f5840434bc 2010-05-31 charlesch: ( releases of Retro. ) e1d6b3829d 2010-06-06 charlesch: ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) e1d6b3829d 2010-06-06 charlesch: ( Copyright 2009 - 2010 Charles Childers, Luke Parrish ) 604f10a85e 2010-06-06 charlesch: ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) f5840434bc 2010-05-31 charlesch: ( Key Action ) f5840434bc 2010-05-31 charlesch: ( --- ------------------------------------------------- ) f5840434bc 2010-05-31 charlesch: ( i Move cursor up ) f5840434bc 2010-05-31 charlesch: ( j Move cursor left ) f5840434bc 2010-05-31 charlesch: ( k Move cursor right ) f5840434bc 2010-05-31 charlesch: ( l Move cursor down ) f5840434bc 2010-05-31 charlesch: ( [ Switch to previous block ) f5840434bc 2010-05-31 charlesch: ( ] Switch to next block ) f5840434bc 2010-05-31 charlesch: ( e Evaluate current block ) f5840434bc 2010-05-31 charlesch: ( E Evaluate all blocks ) f5840434bc 2010-05-31 charlesch: ( m Move cursor to start of next line ) f5840434bc 2010-05-31 charlesch: ( I Move cursor to top line of block ) f5840434bc 2010-05-31 charlesch: ( J Move cursor to start of current line ) f5840434bc 2010-05-31 charlesch: ( K Move cursor to last line of block ) f5840434bc 2010-05-31 charlesch: ( L Move cursor to end of current line ) f5840434bc 2010-05-31 charlesch: ( M Center cursor on current line ) f5840434bc 2010-05-31 charlesch: ( z Exit RxE ) f5840434bc 2010-05-31 charlesch: ( { Export current block ) f5840434bc 2010-05-31 charlesch: ( } Import a saved block into the current block ) 1e2c8d0386 2010-06-06 charlesch: ( | Import an 8-line text file into the current block ) 1e2c8d0386 2010-06-06 charlesch: ( ** if the lines are > 64 chars, you may overwrite ) 1e2c8d0386 2010-06-06 charlesch: ( ** parts of the following block. Use with caution. ) f5840434bc 2010-05-31 charlesch: ( TAB Switch between edit and command mode ) f5840434bc 2010-05-31 charlesch: ( ESC Switch between edit and command mode ) f5840434bc 2010-05-31 charlesch: ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: &console open f5840434bc 2010-05-31 charlesch: &files open f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: vocab rxe::core f5840434bc 2010-05-31 charlesch: (( f5840434bc 2010-05-31 charlesch: ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) f5840434bc 2010-05-31 charlesch: 3 elements #-blocks offset blk f5840434bc 2010-05-31 charlesch: : block 512 * @offset + ; f5840434bc 2010-05-31 charlesch: : (block) @blk block ; f5840434bc 2010-05-31 charlesch: : (line) 64 * (block) + ; f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: {{ 56671955eb 2010-06-03 crc: : <|> red '| emit ; 56671955eb 2010-06-03 crc: : <+> red '+ emit ; f5840434bc 2010-05-31 charlesch: : type for @+ emit next drop ; f5840434bc 2010-05-31 charlesch: : rows 8 for <|> dup 64 cyan type 64 + <|> cr next ; f5840434bc 2010-05-31 charlesch: : .block space ." #" @blk . cr ; 56671955eb 2010-06-03 crc: : bar red <+> 64 for '- emit next <+> ; f5840434bc 2010-05-31 charlesch: : vb bar cr @blk block rows drop bar yellow .block white ; f5840434bc 2010-05-31 charlesch: ---reveal--- f5840434bc 2010-05-31 charlesch: : (v) ( - ) home vb ; f5840434bc 2010-05-31 charlesch: : new ( - ) offset @ 32 512 #-blocks @ * fill ; f5840434bc 2010-05-31 charlesch: : e ( - ) (block) 512 eval ; f5840434bc 2010-05-31 charlesch: : ea ( - ) @offset @#-blocks 512 * eval ; f5840434bc 2010-05-31 charlesch: : set-blocks ( n- ) f5840434bc 2010-05-31 charlesch: here !offset dup !#-blocks 512 * allot ; f5840434bc 2010-05-31 charlesch: }} f5840434bc 2010-05-31 charlesch: 128 set-blocks new f5840434bc 2010-05-31 charlesch: ( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ) f5840434bc 2010-05-31 charlesch: 3 elements line column mode f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: stub rxe.display f5840434bc 2010-05-31 charlesch: stub rxe.in f5840434bc 2010-05-31 charlesch: : rxe.key key ; f5840434bc 2010-05-31 charlesch: : rxe.write ! ; f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: ( Display block, with cursor ) f5840434bc 2010-05-31 charlesch: : pos ( -cl) @column @line ; f5840434bc 2010-05-31 charlesch: : get ( cl-a) (line) + ; f5840434bc 2010-05-31 charlesch: : va ( a-va) dup @ swap ; 56671955eb 2010-06-03 crc: : c! ( a-) '* swap ! ; f5840434bc 2010-05-31 charlesch: : show ( va- ) dup c! (v) ! ; f5840434bc 2010-05-31 charlesch: : insmode @mode if ." INS" else ." CMD" then cr ; f5840434bc 2010-05-31 charlesch: : display ( - ) pos get va show insmode ; f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: ( Bounds checking ) f5840434bc 2010-05-31 charlesch: : top ( - ) 0 !line ; f5840434bc 2010-05-31 charlesch: : bot ( - ) 7 !line ; f5840434bc 2010-05-31 charlesch: : beg ( - ) 0 !column ; f5840434bc 2010-05-31 charlesch: : end ( - ) 63 !column ; f5840434bc 2010-05-31 charlesch: : mid ( - ) 31 !column ; f5840434bc 2010-05-31 charlesch: : 1st ( - ) 0 !blk ; f5840434bc 2010-05-31 charlesch: : bounds ( - ) f5840434bc 2010-05-31 charlesch: @column -1 =if end line -- then f5840434bc 2010-05-31 charlesch: @column 64 =if beg line ++ then f5840434bc 2010-05-31 charlesch: @line -1 =if top blk -- then f5840434bc 2010-05-31 charlesch: @line 8 =if bot blk ++ then f5840434bc 2010-05-31 charlesch: @blk -1 =if 1st then f5840434bc 2010-05-31 charlesch: @blk @#-blocks >if blk -- then ; f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: : input ( - ) f5840434bc 2010-05-31 charlesch: repeat f5840434bc 2010-05-31 charlesch: rxe.display f5840434bc 2010-05-31 charlesch: @mode 0; drop f5840434bc 2010-05-31 charlesch: key f5840434bc 2010-05-31 charlesch: dup 27 <> 0; drop f5840434bc 2010-05-31 charlesch: dup 8 =if drop column -- rxe.display [ over 8 , , ] then f5840434bc 2010-05-31 charlesch: dup 10 =if drop line ++ else pos get rxe.write column ++ then f5840434bc 2010-05-31 charlesch: again ; f5840434bc 2010-05-31 charlesch: : ws ( - ) whitespace off later whitespace on ; f5840434bc 2010-05-31 charlesch: : match ( c- ) s" $$_" dup push 2 + ! pop find if @d->xt execute else drop then ; f5840434bc 2010-05-31 charlesch: : edit? ( c-c ) dup 27 =if rxe.in drop then ; f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: : advance? ( - ) f5840434bc 2010-05-31 charlesch: 1 +line @line 8 >if 0 !line 1 +blk then 0 !column ; f5840434bc 2010-05-31 charlesch: : remap ( c-c ) f5840434bc 2010-05-31 charlesch: dup 9 =if drop 27 then f5840434bc 2010-05-31 charlesch: dup 13 =if drop 10 then f5840434bc 2010-05-31 charlesch: dup 10 =if drop 32 advance? then ; f5840434bc 2010-05-31 charlesch: here ] bounds display ; is rxe.display f5840434bc 2010-05-31 charlesch: here ] mode on ws input mode off ; is rxe.in f5840434bc 2010-05-31 charlesch: )) f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: vocab rxe::keys f5840434bc 2010-05-31 charlesch: (( f5840434bc 2010-05-31 charlesch: : $$i line -- ; ( i = up ) f5840434bc 2010-05-31 charlesch: : $$j column -- ; ( j = left ) f5840434bc 2010-05-31 charlesch: : $$k line ++ ; ( k = down ) f5840434bc 2010-05-31 charlesch: : $$l column ++ ; ( l = right ) f5840434bc 2010-05-31 charlesch: : $$m $$k beg ; ( m = enter ) f5840434bc 2010-05-31 charlesch: : $$I top ; ( I = top ) f5840434bc 2010-05-31 charlesch: : $$J beg ; ( J = start ) f5840434bc 2010-05-31 charlesch: : $$K bot ; ( K = bottom ) f5840434bc 2010-05-31 charlesch: : $$L end ; ( L = end ) f5840434bc 2010-05-31 charlesch: : $$M mid ; ( M = middle ) f5840434bc 2010-05-31 charlesch: : $$[ blk -- ; ( p = previous block ) f5840434bc 2010-05-31 charlesch: : $$] blk ++ ; ( n = next block ) f5840434bc 2010-05-31 charlesch: : $$z ( z = exit rxe ) f5840434bc 2010-05-31 charlesch: &rxe::keys shut f5840434bc 2010-05-31 charlesch: &remap-keys :devector f5840434bc 2010-05-31 charlesch: pop pop 2drop normal ; f5840434bc 2010-05-31 charlesch: : $$e ( e = evaluate block ) f5840434bc 2010-05-31 charlesch: normal pop pop 2drop e ; f5840434bc 2010-05-31 charlesch: : $$E ( E = evaluate all ) f5840434bc 2010-05-31 charlesch: normal pop pop 2drop ea ; f5840434bc 2010-05-31 charlesch: {{ f5840434bc 2010-05-31 charlesch: 3 elements fid action mode 30b3b10062 2010-06-06 charlesch: : ask ( $- ) type space 32 accept ; 96353f6640 2010-06-06 charlesch: : open ( - ) tib @mode fopen !fid ; 96353f6640 2010-06-06 charlesch: : emit ( c- ) @fid fwrite drop ; 96353f6640 2010-06-06 charlesch: : dump ( an- ) for @+ emit next drop 10 emit ; 96353f6640 2010-06-06 charlesch: : key ( -c ) @fid fread ; 96353f6640 2010-06-06 charlesch: : read ( an- ) for key swap !+ next key 2drop ; 96353f6640 2010-06-06 charlesch: : short ( an- ) drop repeat key dup 10 =if 2drop ;then swap !+ again ; 96353f6640 2010-06-06 charlesch: : all ( -a ) @blk block 8 for dup 64 @action execute 64 + next ; 96353f6640 2010-06-06 charlesch: : end ( a- ) @fid fclose 2drop ; 604f10a85e 2010-06-06 charlesch: : common ( - ) ask !mode !action open @fid if all end then clear ; f5840434bc 2010-05-31 charlesch: ---reveal--- 604f10a85e 2010-06-06 charlesch: : $${ &dump :w s" Save to:" common ; 604f10a85e 2010-06-06 charlesch: : $$} &read :r s" Read from:" common ; 604f10a85e 2010-06-06 charlesch: : $$| &short :r s" Read from:" common ; f5840434bc 2010-05-31 charlesch: }} f5840434bc 2010-05-31 charlesch: )) f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: : edit ( - ) f5840434bc 2010-05-31 charlesch: &remap &remap-keys :is f5840434bc 2010-05-31 charlesch: &rxe::keys open clear bold f5840434bc 2010-05-31 charlesch: repeat rxe.display key edit? match again ; f5840434bc 2010-05-31 charlesch: f5840434bc 2010-05-31 charlesch: &rxe::keys shut f5840434bc 2010-05-31 charlesch: &rxe::core shut f5840434bc 2010-05-31 charlesch: &files shut f5840434bc 2010-05-31 charlesch: &console shut 30b3b10062 2010-06-06 charlesch: 30b3b10062 2010-06-06 charlesch: ( Load optional extensions ) 30b3b10062 2010-06-06 charlesch: include rxe.extensions.retro