'HYPRCUBE.BAS
  'Rotates hypercube about real and imaginary axes
DECLARE SUB rot (a, b) 'serves 6 possible pairs of axes
DECLARE SUB plot () 'plots on active screen (in memory)
DIM SHARED corn(15, 3)  '16 hypercube vertices
DIM SHARED trail(32) AS INTEGER 'line drawing sequence
DIM SHARED col(32) AS INTEGER  'line colours sequence
DIM rotate AS INTEGER 'rotation mode(uses ASCII value)
DIM SHARED sn, cs AS SINGLE       'sin & cos(rotation angle)
FOR n = 0 TO 15: FOR m = 0 TO 3   'read Hypercube...
 READ corn(n, m): NEXT: NEXT   '...coords, (u,x,y,z)
FOR n = 0 TO 32: READ trail(n): NEXT   'line sequence
FOR n = 0 TO 32: READ col(n): NEXT     'colour sequence
start: 'rotation on x(ASCII=120) axis, 0.01 radians
ky = 120: ang = .01: sn = SIN(ang): cs = COS(ang)
SCREEN 9: WINDOW (-4.8, -2.4)-(1.6, 2.4) 'EGA screen...
DO 'looping    '...which has two pages for animation
key$ = INKEY$       'check for key press
IF key$ <> "" THEN ky = ASC(key$) 'read key ASCII value
SELECT CASE ky  'action is based on key ASCII value
 CASE 120 TO 122: rotate = ky 'rot. about x,y or z axis
 CASE 49 TO 51: rotate = ky '1,2 or 3 - rot x/y/z with u
 CASE 102: ang = ang + .002    '"f" makes faster
 sn = SIN(ang): cs = COS(ang): ky = 0
 CASE 115: ang = ang - .002     '"s" makes slower
 sn = SIN(ang): cs = COS(ang): ky = 0   'nullify ky
 CASE 32: rotate = 0  'spacebar stops rotation
 CASE 101: FOR n = 0 TO 7: FOR m = 1 TO 3
 corn(n, m) = corn(n, m) * 1.1: NEXT: NEXT 'e expands..
 ky = 0    '...cube at u = -1 (once, then ky nullified)
 CASE 114: FOR n = 0 TO 7: FOR v = 1 TO 3
  corn(n, m) = corn(n, m) * .9: NEXT: NEXT   'r reduces..
 ky = 0     '...cube at u = -1 (once, then ky nullified)
 CASE 99: c = 1 - c: ky = 0 'c toggles 0/1 (CLS on/off)
END SELECT
SELECT CASE rotate       'current rotation mode
 CASE 120: CALL rot(2, 3)    'y and z axes
 CASE 121: CALL rot(3, 1)    'z and x axes
 CASE 122: CALL rot(1, 2)    'x and y axes
 CASE 49: CALL rot(1, 0)     'x and u axes
 CASE 50: CALL rot(2, 0)     'y and u axes
 CASE 51: CALL rot(3, 0)     'z and u axes
END SELECT
IF c = 0 THEN CLS     'if c = 1, screen not cleared
plot   'plots on active page in memory to be swapped...
p = 1 - p: SCREEN , , p, 1 - p  '...with visual page
FOR n = 1 TO 500: NEXT 'counted delay for viewing time
LOOP UNTIL ky = 27      'until Escape key hit
END     'Now for coordinates (u, x, y, z) of ...
'points 0-15. Points 0-7 are at u=-1 & 8-15 are at u=+1
DATA -1,-1,-1,-1, -1,-1,-1, 1, -1,-1, 1,-1, -1,-1, 1, 1
DATA -1, 1,-1,-1, -1, 1,-1, 1, -1, 1, 1,-1, -1, 1, 1, 1
DATA 1,-1,-1,-1, 1,-1,-1, 1, 1,-1, 1,-1, 1,-1, 1, 1
DATA 1, 1,-1,-1,  1, 1,-1, 1, 1, 1, 1,-1, 1, 1, 1, 1
  'Drawing trail goes through points twice, in order -
DATA 0,1,3,2,6,14,10,8,9,11,3,7,15,14,12,13,9
DATA 1,5,7,6,4,12,8,0,4,5,13,15,11,10,2,0
     'lines are coloured in following order -
DATA 0,4,3,4,2,1,2,3,4,3,1,2,1,4,3,4,2
DATA 1,2,3,4,3,1,2,1,2,4,1,3,2,4,1,3

SUB plot   'rt & lft eye plots on active page in memory
FOR n = 0 TO 32: s = trail(n)   'use 'trail' sequence
  'for orthogonal projection, use next line OR ....
 x = corn(s, 1): y = corn(s, 2): z = corn(s, 3)
  '....for perspective projection, use next two lines
 'f = 2 / (3 - corn(s, 0))
 'x = f* corn(s,1): y = f* corn(s,2): z = f* corn(s,3)
 fz = z / (z + 10): xr = x - (x + .8) * fz
 xl = -3.2 - x - (x + 2.4) * fz: yb = y - y * fz
 IF n > 0 THEN  'can't draw line with only point 0
 LINE (xs, yc)-(xr, yb), col(n)     'right eye
 LINE (xm, yc)-(xl, yb), col(n)     'left eye
 END IF
 xs = xr: xm = xl: yc = yb  'start points for next line
NEXT
END SUB

SUB rot (a, b)  'affects coords a/b(any pair of u,x,y,z)
FOR m = 0 TO 15      'rotate 16 vertices
 temp = corn(m, a) * cs + corn(m, b) * sn   '=new (m,a)
 corn(m, b) = corn(m, b) * cs - corn(m, a) * sn
 corn(m, a) = temp: NEXT   'need original (m,a) in eqn.2
END SUB