  `checkstk
`code check_link
`define pt   xp 0.l yp 4.l zp 8.l plt 12.w
`define pt   hp_1 14.l hp_2 18.l vp_1 22.l vp_2 26.l

start
  30 #0 :pt_size *26 (#0 #0 :pt_base #0 :pt + :pt_limit

  4862 :rs   27574 :rc   27999 :rh
  rh :xx 0  :xy 0  :xz
  0  :yx rh :yy 0  :yz
  0  :zx 0  :zy rh :zz

  "con_512x256a0x0" -2 [#2 d0.1 d1.1- d3.0 a0] :channel
  [#3 d0.32 d3.1- a0.channel] [#3 d0.14 d3.1- a0.channel]
  "00c701ff00000000ffff"$ :window
  "0014002800c80020ffff"$ :window1
  "0014002800c80040ffff"$ :window2

`   HORIZON        !
  "0100000001000000ff00000001000001"$ [loadpt]
  "ff000000ff00000101000000ff000001"$ [loadpt]
  "01000000010000010000000000000000"$ [loadpt]

`   TETRAHEDRIAN 1 !
  "000afff600be00000000000a00c80001"$ [loadpt]
  "fff6fff600be0001000afff600be0001"$ [loadpt]
  "000afff600d200010000000a00c80001"$ [loadpt]
  "fff6fff600d20001000afff600d20001"$ [loadpt]
  "fff6fff600be0001fff6fff600d20001"$ [loadpt]
`   TETRAHEDRIAN 2 !
  "000a000a018600000000fff601900002"$ [loadpt]
  "fff6000a01860002000a000a01860002"$ [loadpt]
  "000a000a019a00020000fff601900002"$ [loadpt]
  "fff6000a019a0002000a000a019a0002"$ [loadpt]
  "fff6000a01860002fff6000a01860002"$ [loadpt]
 
char
  ky =88 ~ ?   rs    [rotate_v]   !plot
  ky =87 ~ ?   0 -rs [rotate_v]   !plot
  ky =65 ~ ?   rs    [rotate_h]   !plot
  ky =68 ~ ?   0 -rs [rotate_h]   !plot
  ky =77 ~ mv <6- | ?   mv -2 :mv [instrument]   !plot
  ky =85 ~ mv >6  | ?   mv +2 :mv [instrument]   !plot
  ky =72 ~ ?   rs    [rotate]   !plot
  ky =75 ~ ?   0 -rs [rotate]   !plot
  ky =95 ~ ?   ;

  pt_size *6 +pt_base :pt
loop1
  0 -mv #0 #0   *zz /rh +zp :zp   *zx /rh +xp :xp   *zy /rh +yp :yp
  pt +pt_size #0 :pt <pt_limit ?loop1
 
  [#3 d3.0 a0.channel d1, d0,1]  ?nochar
  &0df$ :ky   !char

nochar
  :

plot
  `checkstk
  0 :ky   pt_base :pt

loop2
  zx *xp zy *yp zz *zp + + /rh :d
  xx *xp xy *yp xz *zp + + /rh *512 :hd
  yx *xp yy *yp yz *zp + + /rh *512 :vd
  plt >0 ?notfirst
  d <10 ?   hd /d +256 :hp   vd /d +128 :vp
  !skip

notfirst
  window hp_1 hp_2 vp_1 vp_2 `line   18- #0 :vp_1 :vp_2
  d >2000 ?skip   d <10 ?trim1
  hd /d +256 :hp   vd /d +128 :vp
  d_l <10 ?trim2
  hp_l :hp_2   vp_l :vp_2
  !draw

trim1
  d_l <10 ?skip
  hp_l :hp_2   vp_l :vp_2
  d_l -d   10 -d
  hd_l -hd *#1 /#2 +hd /10 +256 :hp
  vd_l -vd *#1 /#2 +vd /10 +128 :vp
  : :
  !draw

trim2
  d -d_l   10 -d_l
  hd -hd_l *#1 /#2 +hd_l /10 +256 :hp_2
  vd -vd_l *#1 /#2 +vd_l /10 +128 :vp_2
  : :

draw
  window   hp #0 :hp_1   hp_2   vp #0 :vp_1   vp_2
` debugon
  `line
`debugoff

skip
  hp :hp_l   vp :vp_l   hd :hd_l   vd :vd_l   d :d_l
  pt +pt_size #0 :pt <pt_limit ?loop2
  !char

rotate_v
  [clr_inst]
  zx *rc yx *#2 + /rh   yx *rc zx *#3 - /rh :yx   :zx
  zy *rc yy *#2 + /rh   yy *rc zy *#3 - /rh :yy   :zy
  zz *rc yz *#2 + /rh   yz *rc zz *#3 - /rh :yz   :zz
  :   [instrument]   ;

rotate_h
  [clr_inst]
  zx *rc xx *#2 + /rh   xx *rc zx *#3 - /rh :xx   :zx
  zy *rc xy *#2 + /rh   xy *rc zy *#3 - /rh :xy   :zy
  zz *rc xz *#2 + /rh   xz *rc zz *#3 - /rh :xz   :zz
  :   [instrument]   ;

rotate
  [clr_inst]
  yx *rc xx *#2 + /rh   xx *rc yx *#3 - /rh :xx   :yx
  yy *rc xy *#2 + /rh   xy *rc yy *#3 - /rh :xy   :yy
  yz *rc xz *#2 + /rh   xz *rc yz *#3 - /rh :xz   :yz
  :   [instrument]   ;

instrument
  window1   0 -zx *20 /rh +20   20   zz *10 /rh +10   10   `line
  zy *10 /rh +10 :inst1
  window2   20   20   10      inst1   `line
  window2   0    40   inst1   inst1   `line
  xy *20 /rh +20 :inst2   yy *10 /rh +10 :inst3
  window2   0    inst2   inst1  inst3 `line
  window2   40   inst2   inst1  inst3 `line
  ;

clr_inst
  [instrument]
  ;

loadpt
`define loadparm xp_ld 0.w yp_ld 2.w zp_ld 4.w plt_ld 6.w
  :loadparm
  xp_ld :xp   yp_ld :yp   zp_ld :zp   plt_ld :plt
  18- #0 #0 #0 :vp_1 :hp_1 :vp_2 :hp_2
  pt +pt_size :pt
dummy1
  loadparm +8 :loadparm
  xp_ld :xp   yp_ld :yp   zp_ld :zp   plt_ld :plt
  18- #0 #0 #0 :vp_1 :hp_1 :vp_2 :hp_2
  pt +pt_size :pt
  ;
 
`job start 200 800 200
