( "bedit" block editor 11/14/83 )

forget it
6 mode
print " Compiling "Bedit" ... " cr

: it ;

8 variable hsize
32 variable vsize
0 variable maxx
0 variable maxy
0 variable xp
0 variable yp
0 variable oxp
0 variable oyp
1 variable step
1 variable gmode
3 variable gc
0 variable cursor.on
0 variable vert.addr
0 variable index
47104 variable screen.addr
0 variable el.hr
0 variable el.vr
0 variable el.type
16000 string block

: num.lock.off
  64 segment
  23 dup peek 223 and swap poke
  24 dup peek 32 or swap poke
  local segment ;

: chruc dup 95 > if 32 - then ;

: not 0 = ;

: beepnotes
  2 , 676 ,,
  2 , 845 ,,
  0 , 0 ,, ;

: beep ' beepnotes -> play ;

: check
  xp 4 < if 4 -> xp then
  xp maxx >= if maxx 1 - -> xp then
  yp 4 < if 4 -> yp then
  yp maxy >= if maxy 1 - -> yp then ;

: setmode
  gmode dup 1 = if ormode then
  dup 2 = if exmode then
  3 = if andmode then ;

: flip.cursor
  xp yp plot
  cursor.on not -> cursor.on ;

: key.ready
  num.lock.off
  2816 -> ax 33 int
  ax 1 and ;

: reset xp -> oxp yp -> oyp ;

: do.menu
  cls
  print " 1-Load 2-Save 3-Move 4-Plot  5-Line " cr
  print " 6-Box  7-Fill 8-Spec Esc-Quit " cr
  print " Arrow Keys=Move. Ins,Del=Step size " ;

: setup
  4 mode
  ormode
  3 dup -> gc gcolor
  0 38 22 24 window
  do.menu
  hsize dup 0 block poke 4 * 4 + -> maxx
  vsize dup 1 block poke 4 + -> maxy
  maxx 4 + 2 / -> xp maxy 4 + 2 / -> yp reset
  3 gcolor
  3 3 move
  hsize 4 * 4 + vsize 4 + box 
  xp yp move gc gcolor 
  setmode ;

: getakey
  exmode
  3 gcolor
  begin
    flip.cursor
    100
    begin
      dup 0 <>
      key.ready not 
      and while
      1 -
    repeat
    drop
    key.ready
  until
  cursor.on if flip.cursor then
  setmode getc 
  gc gcolor ;

: get.vert.addr
  dup 2 / 80 *
  swap 1 and 8192 * + 
  -> vert.addr ;

: block.poke
  local segment
  index block poke
  index 1 + -> index ;

: format cls print " Formatting  "
  34 putc pad writeln 34 putc spce
  2 -> index
  vsize 4 + 4 do
  i get.vert.addr
  hsize 1 + 1 do
  screen.addr segment
  i vert.addr + peek
  block.poke
  loop
  print " . "
  loop
  local segment ;

: root.load pad peek 13 <>
   if
     pad concat " .BLK "
     0 block 15999 memory pad -> read
     0 block peek -> hsize
     1 block peek -> vsize
     setup gc gcolor
     4 4 move
     0 block putblk
   then ;

: load 
   cls cr print " Load: "
   pad readln root.load 
   do.menu ;

: root.save
  pad peek 13 <>
  if
    format
    cr print " Saving ... "
    pad concat " .BLK "
    0 block
    dup peek
    1 block peek * 2 +
    memory pad -> write 
  then ;

: save
   cls cr print " Save: "
   pad readln root.save 
   do.menu ;

: gmove xp yp move reset ;

: gplot xp yp plot reset ;

: gline oxp oyp move xp yp line reset ;

: gbox oxp oyp move xp yp box reset ;

: gfill oxp oyp move xp yp fill reset ;

: spec.color print " Color (0 - 3) : "
  getc dup -> gc gcolor ;

: spec.size
  print " "Size" erases display. OK (Y/N) ? "
  pad readln pad peek chruc
  89 = if
  cls print " Enter width in multiples of 4 : "
  pad readln pad getnum 4 / -> hsize
  print " enter height : "
  pad readln pad getnum -> vsize
  setup
  then ;

: spec.erase print " Erase Display (Y/N) ? "
  pad readln pad peek chruc
  89 = if setup then ;

: spec.mode print " Enter Number for Mode (now  "
  gmode . print " ) " cr
  print " 1 = OR 2 = XOR 3 = AND : "
  getc dup 128 > if 186 -
  else 48 - then
  dup 0 > over 4 < and if -> gmode
  else drop then ;

: spec.ellipse
  print " Ellipse centered on last position. " cr
  print " Enter vertical radius : "
  pad readln pad getnum -> el.vr
  valid 0 <> ( on stack )
  print " Enter horizontal radius : "
  pad readln pad getnum -> el.hr
  valid 0 <> and if
  print " (L)ine or (F)ill ? "
  pad readln pad peek chruc -> el.type
  xp -> oxp yp -> oyp
  el.type 76 = if
  xp el.hr + yp move then
  361 0 do
  el.hr 100 * i cos* 101 / xp +
  el.vr 100 * i sin* 101 / yp +
  el.type 76 = if line
  else oxp oyp move box
  then loop
  then ;

: special 
  cls print " [8-Special:] 1-Color 2-Size 3-Erase " cr
  print     "              4-Mode  5-Ellipse  "
  getc
  dup 128 > if 187 - else 49 - then
  dup 5 <
  over 0 >= and if
   cls 
   case:
   spec.color
   spec.size
   spec.erase
   spec.mode
   spec.ellipse
   then
   else drop then
   do.menu ;

: uparr yp step - -> yp check ;

: rtarr xp step + -> xp check ;

: lftarr xp step - -> xp check ;

: dwnarr yp step + -> yp check ;

: pgdwn rtarr dwnarr ;

: pgup rtarr uparr ;

: end lftarr dwnarr ;

: home lftarr uparr ;

: ins step 1 + -> step ;

: del step 1 - dup 0 <> if -> step then ;

: com.keys 0 , ( place holder )
  ( escape )
  27 ,
  ( function keys except f9, f10 )
  187 , 188 , 189 , 190 ,
  191 , 192 , 193 , 194 ,
  ( number matrix )
  199 , 200 , 201 ,
  203 , 205 ,
  207 , 208 , 209 ,
  210 , 211 , 
  0 , ;

: quit
  cls print " Quit (Y/N) ? "
  pad readln
  pad peek chruc
  89 = if pad assign " workfile "
  root.save abort then do.menu ;

: find.com
  dup 128 < 
  over 32 > and if
  138 + then
  0 push
  1 begin
  dup ' com.keys + peek
  dup 0 <> while
  3 pick = if
  pop dup push ( index )
  then
  1 + repeat
  drop ( test )
  drop ( index )
  drop ( character )
  i not if
  cls beep print " Use the Function Keys (return)  "
  getc do.menu then
  pull dup ; ( found value )

: bedit
  pad assign " workfile "
  root.load
  begin
  getakey
  find.com
  if
  1 - case:
  quit
  load
  save
  gmove
  gplot
  gline
  gbox
  gfill
  special
  home
  uparr
  pgup
  lftarr
  rtarr
  end
  dwnarr
  pgdwn
  ins
  del
  then
  else drop then
  0 until ;
close run
