( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Copyright [c] 2009 - 2010, Charles Childers                 )
( License: ISC                                                )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )


( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( This is a block editor that I've been using for many years. )
( It's simple, and doesn't have a lot of features, but it is  )
( more than enough for most of my prototyping work.           )
(                                                             )
( Actually, it's proven more popular than I ever expected. It )
( has been used by many of Retro's users, and implementations )
( now exist for several other Forth systems.                  )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Line and column numbers start at 0.                         )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Quick Reference:                                            )
(      # s        Select a new block                          )
(        p        Previous block                              )
(        n        Next block                                  )
(      # i ..     Insert .. into line                         )
(   # #2 ia ..    Insert .. into line [#2] starting at        )
(                 column [#]                                  )
(        x        Erase the current block                     )
(      # d        Erase the specified line                    )
(        v        Display the current block                   )
(        e        Evaluate Block                              )
(        ea       Evaluate All Blocks                         )
(        new      Erase all blocks                            )
( # set-blocks    Set the # of blocks. Calls 'new'            )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( The memory layout and basic configuration.                  )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
' canvas open
vocab editor ((

4 elements #-blocks offset line-ending blk
10 !line-ending

: block     512 * @offset + ;
: (block)   @blk block ;
: (line)    64 * (block) + ;

stub (v)
stub (ia)
: v   ( -  ) (v) ;
: s   ( n- ) !blk v ;
: d   ( n- ) (line) 32 64 fill v ;
: x   ( -  ) (block) 32 512 fill v ;
: p   ( -  ) blk -- v ;
: n   ( -  ) blk ++ v ;
: ia  ( nn"- ) (ia) ;
: i   ( n"- ) 0 swap ia v ;
: new ( -  ) @offset 32 512 @#-blocks * fill ;
: e   ( -  ) (block) 512 eval ;
: ea  ( -  ) @offset @#mem over - eval ;

( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Default Block Viewer                                        )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{
  : type    for @+ emit next drop ;
  : rows    8 fori . dup 64 type 64 + cr nexti ;
  : .block  ." Block: " @blk . ." of " @#-blocks 1- . ;
  : x       ." +---:---+---:---" ;
  : bar     space space x x x x cr ;
  : vb      bar @blk block rows drop bar ;
  here is (v) ] clear renderLater vb .block ;
}


( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( Default "Insert At"                                         )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
{
  variable ws
  : nofilter ( - ) whitespace dup @ @ws off later @ws !whitespace ;
  : getline  ( - ) @line-ending accept ;
  : setup    ( nn-aan ) tib swap tib getLength ;
  here is (ia) ] nofilter (line) + getline setup copy v ;
}

: set-blocks ( n- )
  !#-blocks @#mem 512 @#-blocks * - !offset ;


( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
( All done! Fill the blocks with spaces, and we're good to go )
( ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ )
64 set-blocks
))
' editor shut
' canvas shut