Artifact 8d0615bdc0c10580201b0c071a5064f229a8e779

File editor.rx part of check-in [90c0b418f9] - Update to 11.0-2010.12.19 and latest VM; fix editor.rx and debug.rx to work with new image by charleschilders on 2010-12-20 00:46:13. [annotate]

( retro editor v11-2010.11.15 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( 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                                                            )
(  z      Exit RxE                                                            )
(  {      Load "blocks"                                                       )
(  }      Save "blocks"                                                       )
( TAB     Switch between edit and command mode                                )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
chain: editor'
: color.text   ^console'cyan   ;
: color.status ^console'yellow ;
: color.ui     ^console'red    ;

{{
  2 elements buffer count
  : restore ( -   )  &key :devector ok ;
  : get     ( -c  )  @buffer @ ;
  : next    ( -c  )  @count 0 = [ 32 restore ] [ count -- get buffer ++ ] choose ;
  : replace ( -   )  &next &key :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 color.text [ @ putc ] ^types'BUFFER each@ 80 + cr ] times ;
  : mode?   @mode [ "INS" ] [ "CMD" ] choose ;
  : .block  @column @line @blk mode? "(%s) #%d - %d:%d  " puts ;
  : bar     ^console'red 80 [ '- putc ] times cr ;
  : vb      @blk toBlock rows drop bar color.status .block ^console'normal ;
  : (v)     (   -   ) ^console'colors @ [ ^console'home ] [ clear ] choose 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 ;
  : remap    ( c-c )
    dup  9 = [ drop 27 ] ifTrue
    dup 13 = [ drop 10 ] ifTrue
    dup 10 = [ drop 32 advance? ] ifTrue ;
  : input    (  -  )
    repeat
      display
      @mode 0; drop
      key
      dup 27 <> 0; drop
      dup  8 = [ drop column -- [[ 8 , &input , ]] ] ifTrue
      dup 10 = [ drop line ++ ] [ pos get ! column ++ ] choose
    again ;
  : rxe.in   (  -c ) mode on ws input mode off ;
  : match    ( c-  ) "$$_" dup [ 2 + ! ] dip find [ @d->xt do ] &drop choose ;
  : 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 ;
---reveal---
  : setBlocks  ( n- ) !#blocks @memory 1600 @#blocks * - !offset new ;
  : edit ( - )
    @ch 22 > @cw 80 > and dup
    [ "requires an 80x22 or greater display, sorry!\n" puts ] ifFalse
    0; drop
    @fb [ ^console'colors off ] ifTrue active on
    &remap &remapKeys :is clear
    [ display key edit? match @active ] while ;
  : $$i line -- ;
  : $$j column -- ;
  : $$k line ++ ;
  : $$l column ++ ;
  : $$m $$k beg ;
  : $$I top ;
  : $$J beg ;
  : $$K bot ;
  : $$L end ;
  : $$M mid ;
  : $$[ 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'