############################################################################
#
#	File:     tess.icn
#
#	Subject:  Program to display and manipulate a 4-D tesseract
#
#	Author:   Chris Tenaglia
#
#	Date:     September 6, 2009
#
############################################################################
#
#	This file is in the public domain.
#
############################################################################
#
#	Usage:  tess [size]
#
#	The size is optional and defaults to 1024.
#
#	Keypresses in the window control the animation:
#	x : move x-axis
#	y : move y-axis
#	z : move z-axis
#	a : move the OTHER axis
#	i : move closer in
#	o : move futher out
#	f : freeze rotation
#	r : reset to original settings
#	q : quit
#	up/down/left/right arrows move shape on screen
#
############################################################################
#
#	Requires:  Version 9 graphics
#
############################################################################

# USAGE: TESS  [size]
#        The size is optional. I believe it's pixels. The window produced is
#        square shaped. The size defaults to 1024. Of course you need an X
#        display to run this. It has been successfully run under VMS and
#        Ultrix unix as is. It's written for monochrome displays. You will
#        have to prep your environment for X before running it.
#
# UPDATE       BY        WHAT
# 22-AUG-1992  TENAGLIA  INITIAL PORTING FROM DOS BASIC
# 23-AUG-1992  TENAGLIA  OPTIMIZE AND ELIMINATE UNNECESSARY VARIABLES
# 28-AUG-1992  TENAGLIA  MADE HANDLE BOUNDARY CONDITIONS BETTER
# 08-APR-1992  TENAGLIA  ADDED COLORS FOR COLOR X-TERMINALS
# 30-MAR-2011  TENAGLIA  SUBMITTED TO ICON PROGRAM LIBRARY
# 09-MAY-2012  TOWNSEND  ADDED TO ICON PROGRAM LIBRARY WITH MINIMAL CHANGES

global vs, vt,  ne,  pi, twopi, vs2, vs3,   # view parameters
       vx, vy,  vz,  vw,                    # view projectors
       ox, oy, oldx, oldy,                  # old x,y positions
       x,   h,  dh,  xi,                    # axis pointer & increment
       y,   p,  dp,  yi,                    # axis pointer & increment
       z,   b,  db,                         # axis pointer & increment
       w,   a,  da,                         # axis pointer & increment
       dv, dd,  d,                          # distance increments
       sa,  sb, sp,  sh,                    # sine constants
       ca,  cb, cp,  ch,                    # cosine constants
       ppux,ppuy,scale,                     # more projection constants
       projtessarect,                       # new projection matrices
       oldproj,                             # former matrix
       tessarect,                           # tessarect matrix
       edges, colors,                       # edges matrix
       xwindow, lines, columns              # xwindow variables

#SUB MAIN AND SETUP PROCEDURES
#EJECT

#
# this is the main drawing loop
#
procedure main(stuff)
  setup(stuff)
  getview()
  repeat
    {
    genview()
    testkey(stuff)
    changeview()
    }
  end

#
# this sets up some main x variables and constants
#
procedure setup(settings)
  local i
  vs := real(settings[1] | 1024.0)
  vs2:= vs * 5.0
  vs3:= -vs* 4.0
  vt := 16
  ne := 48
  pi := 3.1415927
  twopi     := pi * 2.0
  tessarect := [ [ 1, 1,-1,-1 ],      # C
                 [ 1,-1,-1,-1 ],      # 8
                 [-1,-1,-1,-1 ],      # 0
                 [-1, 1,-1,-1 ],      # 4
                 [ 1, 1, 1,-1 ],      # E
                 [ 1,-1, 1,-1 ],      # A
                 [-1,-1, 1,-1 ],      # 2
                 [-1, 1, 1,-1 ],      # 6
                 [ 1, 1,-1, 1 ],      # D
                 [ 1,-1,-1, 1 ],      # 9
                 [-1,-1,-1, 1 ],      # 1
                 [-1, 1,-1, 1 ],      # 5
                 [ 1, 1, 1, 1 ],      # F
                 [ 1,-1, 1, 1 ],      # B
                 [-1,-1, 1, 1 ],      # 3
                 [-1, 1, 1, 1 ] ]     # 7
  edges     :=  [ -1,  9, -2, 10, -3, 11, -4, 12,
                  -5, 13, -6, 14, -7, 15, -8, 16,
                  -1,  2,  3,  4,  1,  5,  6,  7,
                   8,  5, -2,  6, -3,  7, -4,  8,
                  -9, 10, 11, 12,  9, 13, 14, 15,
                  16, 13,-10, 14,-11, 15,-12, 16 ]
  colors  := []
  every i := 1 to 16 do put(colors,"yellow")
  every i := 1 to 16 do put(colors,"red")
  every i := 1 to 16 do put(colors,"cyan")
  projtessarect := table(0)
  oldproj       := table(0)
  end

#SUB BUILD WINDOW & OTHER NEEDED CONSTANTS
#EJECT

#
# set up other important windowing variables and constants
#
procedure getview()
  ox      := vs / 2.0
  oy      := vs / 2.0
  lines   := integer(vs / 14.22 + 0.5)
  columns := integer(vs /  5.69 + 0.5)
  scale   := 5.0
  ppux    := scale * 10.0 ; ppuy    := scale *  8.0
  dv      := 2.0          ; dd      := 0.0          ; d       := 2.0
  h       := pi / 4.0     ; dh      := 0.0040        ; xi      := 0.0
  p       := 0.0          ; dp      := 0.0          ; yi      := 0.0
  b       := 0.0          ; db      := 0.0
  a       := 0.015        ; da      := 0.0
#
# configure the X-connection
#
#  every write(&features)
  (xwindow := open("TESS","x",
                   "x=" || integer(vs),"y=" || integer(vs),
                   "bg=black","fg=white",
                   "lines=" || lines,"columns=" || columns)) |
    {
    write("Can't open window. Press <RETURN>")
    stop("ABEND ANOX")
    }
  WSync(xwindow)
#  XSetStipple(xwindow,8,0)
  WAttrib(xwindow,"drawop=xor")
  GotoRC(xwindow,1,1)
  write(xwindow,"Tessarect Simulation\n")
#  write(xwindow," x : move x-axis          | r : reset to original settings")
#  write(xwindow," y : move y-axis          | o : move futher out")
#  write(xwindow," z : move z-axis          | i : move closer in ")
#  write(xwindow," a : move the OTHER axis  | q : quit")
#  write(xwindow," up/down/left/right arrows move shape on screen")
#  write(xwindow," f : freeze rotation      |   : blank stop movement")
  end

#SUB ACTUAL TESSARECT ANIMATOR
#EJECT

#
# calculate points in 4 dimensions
#
procedure calcview()
  sh := sin(h)    ; ch := cos(h)
  sp := sin(p)    ; cp := cos(p)
  sb := sin(b)    ; cb := cos(b)
  sa := sin(a)    ; ca := cos(a)
  vx := -dv * ca * cp * sh
  vy := -dv * ca * cp * ch
  vz := -dv * ca * sp
  vw := -dv * sa
  end
#
# run a display pass
#
procedure genview()
  calcview()
  project()
  connect()
  oldproj := copy(projtessarect)
  end
#
# project 4 dimensions to fewer dimensions
#
procedure project()
  local i, q, xa, ya, za, tx, ty, tz
  projtessarect := table(0)
  every i := 1 to vt do
    {
    x := tessarect[i][1] - vx
    y := tessarect[i][2] - vy
    z := tessarect[i][3] - vz
    w := tessarect[i][4] - vw
    q := w * sa

    x := (x * ca - q) / w
    y := (y * ca - q) / w
    z := (z * ca - q) / w

    xa:= ch * x - sh * y
    ya:= sh * x + ch * y
    za:= cp * z - sp * ya

    tx:= cb * xa + sb * za
    ty:= cp * ya + sp * z
    tz:= cb * za - sb * xa

    projtessarect[i || "," || 1] := ox + ppux * d * tx / ty
    projtessarect[i || "," || 2] := oy + ppuy * d * tz / ty
    }
  end

#EJECT

#
# perform motion
#
procedure changeview()
  if (h +:= dh) > twopi  then h  -:= twopi
  if (p -:= dp) < -twopi then p  +:= twopi
  if (a +:= da) > twopi  then a  -:= twopi
  if (b -:= db) < -twopi then b  +:= twopi
  if (dv > 0.0) & (dv < 6.0) then
    {
    dv +:= dd
    } else {
    dv -:= (2.0 * dd)
    dd  := 0.0
    }
  if (ox > 0.0) & (ox < vs) then
    {
    ox +:= xi
    } else {
    ox -:= (2.0 * xi)
    xi  := 0.0
    }
  if (oy > 0.0) & (oy < vs) then
    {
    oy +:= yi
    } else {
    oy -:= (2.0 * yi)
    yi  := 0.0
    }
  end

#EJECT

#
# draw it
#
procedure connect()
  local i, pt, b1, b2, a1, a2, oldxb, oldyb
  every i := 1 to ne do
    {
    if i=(1|17|33) then WAttrib(xwindow,"fg=" || colors[i])
    pt := abs(edges[i])
    b1 := oldproj[pt || "," || 1]
    b2 := oldproj[pt || "," || 2]
    a1 := projtessarect[pt || "," || 1]
    a2 := projtessarect[pt || "," || 2]
    if edges[i] < 0 then
      {
      oldx := a1
      oldy := a2
      oldxb:= b1
      oldyb:= b2
      next
      }

    if ((vs2 > oldxb > vs3) &
        (vs2 > b1    > vs3) &
        (vs2 > oldyb > vs3) &
        (vs2 > b2    > vs3)) then
       DrawLine(xwindow,oldxb,oldyb,b1,b2)

    if ((vs2 > oldx > vs3) &
        (vs2 > a1   > vs3) &
        (vs2 > oldy > vs3) &
        (vs2 > a2   > vs3)) then
       DrawLine(xwindow,oldx,oldy,a1,a2)

    oldx := a1
    oldy := a2
    oldxb:= b1
    oldyb:= b2
    }
  WSync(xwindow)
  end

#EJECT

#
# sense the outside world
#
procedure testkey(window)
  local things, request
  static    uparrow,  downarrow, leftarrow,   rightarrow,
            xrotate,  yrotate,   zrotate,     arotate,
            closer,   further,   halt,        freeze,
            quit,     restart
  initial { uparrow   := "65362" ; downarrow  := "65364"
            leftarrow := "65361" ; rightarrow := "65363"
            xrotate   := "x"     ; yrotate    := "y"
            zrotate   := "z"     ; arotate    := "a"
            closer    := "i"     ; further    := "o"
            halt      := " "     ; freeze     := "f"
            quit      := "q"     ; restart    := "r"
          }
  if (things := Pending(xwindow)) & (*things > 0) then
    {
    request := map(Event(xwindow))
    } 
  case request of
    {
    xrotate    : dh := if dh = 0.0 then 0.0070 else 0.00
    yrotate    : dp := if dp = 0.0 then 0.0039 else 0.00
    zrotate    : db := if db = 0.0 then 0.0025 else 0.00
    arotate    : da := if da = 0.0 then 0.0016 else 0.00
    closer     : dd := if dd = 0.0 then -0.05 else 0.00
    further    : dd := if dd = 0.0 then 0.05  else 0.00
    leftarrow  : xi := -5.0
    rightarrow : xi :=  5.0
    uparrow    : yi := -5.0
    downarrow  : yi :=  5.0
    halt       : { xi := 0.00 ; yi := 0.00 ; dd := 0.00 }
    freeze     : { dh := 0.00 ; dp := 0.00 ; db := 0.00 ; da := 0.00 }
    restart    : { close(xwindow) ; setup(window) ; getview() ; connect() }
    quit       : stop("Execution Interrupted")
    }
  end
