( Graphics viewer "GRFIX" 9/29/83 )
forget it
: it ;

4 variable mode.sel

mode.sel mode
print " Compiling "Grfix" ... " cr

5000 string image
255 0 image poke
5000 string other
5000 variable max.size
350 string deletions
0 variable delptr
40 string image.name
1 variable normal
0 variable b&w
0 variable home.dot
1 variable starting
1 variable changed
0 variable index
0 variable top
16 variable bc
1 variable pc
10 variable ar
50 variable tr
5 variable sr
5 variable rr
0 variable rd
0 variable sz
0 variable xt
0 variable yt
0 variable zt
0 variable xr
0 variable yr
0 variable zr
3 variable gc
0 variable rg
0 variable inserting
64 variable rel.bit
128 variable draw.bit
0 variable tempa

: not 0 = ;

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

: chruc dup 96 > if 32 - then ;

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

: mark.home home.dot if
  160 mode.sel 6 = if 2 * then
  80 normal if else drop 100 then plot then ;

: draw.nokey key.ready if
  else draw mark.home then ;

: getanum num.lock.off pad readln
  pad getnum valid
  if else drop then valid ;

: bwconvert 
  b&w if
  0 image begin
  dup peek 255 <> while
  dup peek 240 and
  over poke
  7 + repeat
  drop 
  then ;

:  ( A - W black & white )
  b&w 1 xor -> b&w 
  bwconvert draw ;

:  ( A - M mode select )
  mode.sel 2 xor -> mode.sel 
  1 autorun abort ;

: 	 objerase
  0 image objadr
  200 scale
  160 mode.sel 6 = if 2 * then xpos
  80 normal if else drop 100 then ypos
  30 dup -> xr xrot
  0 dup -> yr yrot
  0 dup -> zr zrot
  0 dup -> rd radius
  4 dup -> sz scalz
  3 dup -> gc objcolor
  5000 dup -> rg range
  0 dup dup -> xt xtran
  dup dup -> yt ytran
  dup -> zt ztran  draw.nokey ;

:  1 -> changed
  0 keymode 1 autorun abort ;

:  xr ar - dup -> xr xrot  draw.nokey ;

:  xr ar + dup -> xr xrot  draw.nokey ;

:  yr ar + dup -> yr yrot  draw.nokey ;

:  yr ar - dup -> yr yrot  draw.nokey ;

:  zr ar - dup -> zr zrot  draw.nokey ;

:  zr ar + dup -> zr zrot  draw.nokey ;

:  rd 100 - dup -> rd radius  draw.nokey ;

:  rd 100 + dup -> rd radius  draw.nokey ;

:  rg dup abs rr > if dup rr / +
  else drop rg 1 + then dup -> rg range  draw.nokey ;

:  rg dup abs rr > if dup rr / -
  else drop rg 1 - then dup -> rg range  draw.nokey ;

: [ sz 1 - dup -> sz scalz  draw.nokey ;

: ] sz 1 + dup -> sz scalz  draw.nokey ;

:  zt tr + dup -> zt ztran  draw.nokey ;

:  zt tr - dup -> zt ztran  draw.nokey ;

:  xt tr + dup -> xt xtran  draw.nokey ;

:  xt tr - dup -> xt xtran  draw.nokey ;

:  yt tr + dup -> yt ytran  draw.nokey ;

:  yt tr - dup -> yt ytran  draw.nokey ;

:  home.dot 1 xor -> home.dot draw.nokey ;

: x xr dup 370 + swap 10 + do i xrot draw
  10 +loop ;

: y yr dup 370 + swap 10 + do i yrot draw
  10 +loop ;

: z zr dup 370 + swap 10 + do i zrot draw
  10 +loop ;

: gr.directions 
  normal if
  0 38 20 24 window
  erase 80 ypos draw
  cls
  print " View:  "
  34 putc 0 image.name writeln 34 putc cr
  bc pc 1 color
  print " Rotate F1,2=X F3,4=Y F5,6=Z "
  bc pc 3 color print "  Range F7,8 " cr
  bc pc 2 color
  print " Translate  "
  27 putc 44 putc 26 putc print " =X  "
  print " ins,del=Y  "
  24 putc 44 putc 25 putc print " =Z  "
  bc pc 1 color print " [F]ull " cr
  bc pc 1 color
  print " Spin "X","Y","Z"  "
  bc pc 3 color print " Radius F9,10 Depth [,] " cr
  bc pc 2 color
  print " C=Color Home=Mark Tab=Reset Esc=Quit " 
  else
  mode.sel mode 100 ypos
  bc pc 0 color draw
  24 vtab 0 htab
  then ;

: f ( full screen )
  normal 1 xor -> normal
  gr.directions ;

: c bc pc 3 color
  cls cr print " Enter Background Color: "
  getanum if -> bc then
  print " Enter Palette Color: "
  getanum if -> pc then
  print " Enter Draw Color: "
  getanum if
  dup -> gc objcolor then draw
  bc pc 3 color gr.directions ;

: view  
  bwconvert
  1 sequence
  gr.directions
  0 autorun 1 keymode
  1 -> changed 	 ;

36 string dir.entry
36 string dir.fcb

: dir.namechar dir.entry peek putc ;

: dir.name bc pc 3 pick 3 mod 1 + color
  9 1 do i dir.namechar loop cr 1 + ;

: directory cr
 1 dir.fcb assign " ????????img "
 0 dir.entry -> dx
 hex 1A00 -> ax 21 int decimal
 0 dir.fcb -> dx
 hex 1100 -> ax 21 int decimal
 0 begin ax 255 and 0 = while
  dir.name
  hex 0 dir.fcb -> dx
  1200 -> ax 21 int decimal
 repeat drop cr ;

: grfix local segment
 mode.sel mode
 0 autodraw
 ormode
 objerase
 mode.sel 6 = if 15 -> bc then 
 bc pc 3 color cls
 print " GraFORTH PC Image Display " cr
 print " Here are the Available Images: " cr
 directory
 bc pc 3 color
 print " Enter Your Selection " cr
 print " (no entry = quit):  "
 pad readln
 pad peek
 13 <> if
  pad -> 0 image.name assign
  pad concat " .img "
  0 image 5000 memory
  pad -> read
  view
 else 0 autorun 0 keymode
 then ;
close run
