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. ) f5840434bc 2010-05-31 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 ) 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: {{ f5840434bc 2010-05-31 charlesch: : <|> red char: | emit ; f5840434bc 2010-05-31 charlesch: : <+> red char: + 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 ; f5840434bc 2010-05-31 charlesch: : bar red <+> 64 for char: - 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 ; f5840434bc 2010-05-31 charlesch: : c! ( a-) char: * 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 c80dbb6638 2010-06-01 luke: : blank ( -f ) @line (line) -1 64 c80dbb6638 2010-06-01 luke: for over r + @ 32 = not if drop 0 then next nip ; c80dbb6638 2010-06-01 luke: : toblank repeat line ++ blank if; again ; c80dbb6638 2010-06-01 luke: : swaplines c80dbb6638 2010-06-01 luke: @line dup 1- (line) swap (line) 2dup here 64 copy c80dbb6638 2010-06-01 luke: swap 64 copy here swap 64 copy ; c80dbb6638 2010-06-01 luke: : pullspace d918c68871 2010-06-01 charlesch: @line toblank repeat @line over =if drop line ++ bounds ;then c80dbb6638 2010-06-01 luke: swaplines line -- again ; c80dbb6638 2010-06-01 luke: : shovespace c80dbb6638 2010-06-01 luke: line -- bounds c80dbb6638 2010-06-01 luke: @line repeat c80dbb6638 2010-06-01 luke: line ++ blank if !line ;then c80dbb6638 2010-06-01 luke: swaplines again ; 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 ) c80dbb6638 2010-06-01 luke: : $$b pullspace ; c80dbb6638 2010-06-01 luke: : $$B shovespace ; 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 f5840434bc 2010-05-31 charlesch: : ask ( - ) ." File? " 32 accept ; f5840434bc 2010-05-31 charlesch: : open ( - ) tib @mode fopen !fid ; f5840434bc 2010-05-31 charlesch: : emit ( c- ) @fid fwrite drop ; f5840434bc 2010-05-31 charlesch: : dump ( an- ) for @+ emit next drop 10 emit ; f5840434bc 2010-05-31 charlesch: : key ( -c ) @fid fread ; f5840434bc 2010-05-31 charlesch: : read ( an- ) for key swap !+ next key 2drop ; f5840434bc 2010-05-31 charlesch: : all ( -a ) @blk block 8 for dup 64 @action execute 64 + next ; f5840434bc 2010-05-31 charlesch: : end ( a- ) @fid fclose 2drop ; f5840434bc 2010-05-31 charlesch: : common ( - ) ask open @fid if all end then clear ; f5840434bc 2010-05-31 charlesch: ---reveal--- f5840434bc 2010-05-31 charlesch: : $${ &dump !action :w !mode common ; f5840434bc 2010-05-31 charlesch: : $$} &read !action :r !mode 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 c80dbb6638 2010-06-01 luke: edit