' 4D engine
' made by Svjatoslav Agejenko
' in 2003.08
' H-Page: svjatoslav.eu
' E-Mail: svjatoslavagejenko@gmail.com
 
DECLARE SUB chlin (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!)
DECLARE SUB rot (x1!, y1!, z1!, q1!, x4!, y4!, z4!, q4!)
DECLARE SUB setpal ()
DECLARE SUB getp (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!, n!, rx!, ry!, rz!, rq!)
DECLARE SUB qpyra (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!, x3!, y3!, z3!, q3!, x4!, y4!, z4!, q4!, x5!, y5!, z5!, q5!)
DECLARE FUNCTION vahe! (x1!, y1!, z1!, q1!, x2!, y2!, z2!, q2!)
DIM SHARED siz
DIM SHARED an1, an2, an3, an4, an5, an6
DIM SHARED myx, myy, myz, myq
DIM SHARED pi
DIM SHARED s1, s2, s3, s4, s5, s6
DIM SHARED c1, c2, c3, c4, c5, c6

DIM SHARED px(1 TO 10)
DIM SHARED py(1 TO 10)
DIM SHARED pm
DIM SHARED frm

PRINT " 4D Engine, 2003.08"
PRINT " Svjatoslav Agejenko: n0@hot.ee"
PRINT ""
PRINT " use keys:"
PRINT "       rotate:"
PRINT "               qw - XZ"
PRINT "               as - YZ"
PRINT "               zx - XY"
PRINT "               er - QX"
PRINT "               df - QY"
PRINT "               cv - QZ"
PRINT "       move:"
PRINT "               46 - x"
PRINT "               82 - y"
PRINT "               71 - z"
PRINT "               -+ - q"
PRINT
PRINT "       ESC - to quit program"
PRINT
PRINT "press any key to continue..."
a$ = INPUT$(1)

pi = 3.1415

an1 = pi * .5
an2 = an1
an3 = an1
an4 = an1
an5 = an1
an6 = an1

myx = 0
myy = 0
myz = 0
myq = .5
SCREEN 12
setpal


1
CLS
s1 = SIN(an1): c1 = COS(an1)
s2 = SIN(an2): c2 = COS(an2)
s3 = SIN(an3): c3 = COS(an3)
s4 = SIN(an4): c4 = COS(an4)
s5 = SIN(an5): c5 = COS(an5)
s6 = SIN(an6): c6 = COS(an6)

FOR frm = 1 TO 15 STEP 3
  qpyra -10, -10, -10, 0, 10, -10, -10, 0, 0, -10, 10, 0, 0, 10, 0, 0, 0, 0, 0, 10
NEXT frm

a$ = INPUT$(1)

SELECT CASE a$
CASE CHR$(27)
  SYSTEM
CASE "q"
  an1 = an1 + .1
CASE "w"
  an1 = an1 - .1
CASE "a"
  an2 = an2 + .1
CASE "s"
  an2 = an2 - .1
CASE "z"
  an3 = an3 + .1
CASE "x"
  an3 = an3 - .1
CASE "e"
  an4 = an4 + .1
CASE "r"
  an4 = an4 - .1
CASE "d"
  an5 = an5 + .1
CASE "f"
  an5 = an5 - .1
CASE "c"
  an6 = an6 + .1
CASE "v"
  an6 = an6 - .1

CASE "4"
  myx = myx - 3
CASE "6"
  myx = myx + 3
CASE "8"
  myz = myz + 3
CASE "2"
  myz = myz - 3
CASE "7"
  myy = myy + 3
CASE "1"
  myy = myy - 3
CASE "+"
  myq = myq + .3
CASE "-"
  myq = myq - .3

END SELECT
GOTO 1

SUB chlin (ox1, oy1, oz1, oq1, ox2, oy2, oz2, oq2)
x1 = ox1: y1 = oy1: z1 = oz1: q1 = oq1
x2 = ox2: y2 = oy2: z2 = oz2: q2 = oq2

IF (q1 > myq) AND (q2 < myq) THEN
  SWAP x1, x2
  SWAP y1, y2
  SWAP z1, z2
  SWAP q1, q2
END IF

IF (q1 < myq) AND (q2 > myq) THEN
  vq = q2 - q1
  vmq = myq - q1
  jt = vmq / vq
  pm = pm + 1
  rx = (x2 - x1) * jt + x1
  ry = (y2 - y1) * jt + y1
  rz = (z2 - z1) * jt + z1 + 50
  px(pm) = rx / rz * 700 + 320
  py(pm) = ry / rz * 700 + 240
END IF
END SUB

SUB getp (x1, y1, z1, q1, x2, y2, z2, q2, n, rx, ry, rz, rq)
xv = x2 - x1
yv = y2 - y1
zv = z2 - z1
qv = q2 - q1

rx = x1 + (xv * n)
ry = y1 + (yv * n)
rz = z1 + (zv * n)
rq = q1 + (qv * n)
END SUB

SUB qpyra (ox1, oy1, oz1, oq1, ox2, oy2, oz2, oq2, ox3, oy3, oz3, oq3, ox4, oy4, oz4, oq4, ox5, oy5, oz5, oq5)

ox1 = ox1 - myx
oy1 = oy1 - myy
oz1 = oz1 - myz
oq1 = oq1 - myq - frm

ox2 = ox2 - myx
oy2 = oy2 - myy
oz2 = oz2 - myz
oq2 = oq2 - myq - frm

ox3 = ox3 - myx
oy3 = oy3 - myy
oz3 = oz3 - myz
oq3 = oq3 - myq - frm

ox4 = ox4 - myx
oy4 = oy4 - myy
oz4 = oz4 - myz
oq4 = oq4 - myq - frm

ox5 = ox5 - myx
oy5 = oy5 - myy
oz5 = oz5 - myz
oq5 = oq5 - myq - frm

rot ox1, oy1, oz1, oq1, x1, y1, z1, q1
rot ox2, oy2, oz2, oq2, x2, y2, z2, q2
rot ox3, oy3, oz3, oq3, x3, y3, z3, q3
rot ox4, oy4, oz4, oq4, x4, y4, z4, q4
rot ox5, oy5, oz5, oq5, x5, y5, z5, q5

pm = 0

chlin x1, y1, z1, q1, x2, y2, z2, q2
chlin x1, y1, z1, q1, x3, y3, z3, q3
chlin x1, y1, z1, q1, x4, y4, z4, q4
chlin x1, y1, z1, q1, x5, y5, z5, q5

chlin x2, y2, z2, q2, x3, y3, z3, q3
chlin x2, y2, z2, q2, x4, y4, z4, q4
chlin x2, y2, z2, q2, x5, y5, z5, q5

chlin x3, y3, z3, q3, x4, y4, z4, q4
chlin x3, y3, z3, q3, x5, y5, z5, q5

chlin x4, y4, z4, q4, x5, y5, z5, q5

FOR a = 1 TO pm
  FOR b = a + 1 TO pm
    LINE (px(a), py(a))-(px(b), py(b)), 15 - frm
  NEXT b
NEXT a


END SUB

SUB rot (x1, y1, z1, q1, x4, y4, z4, q4)

' qx
q2 = q1 * s4 - x1 * c4
x2 = q1 * c4 + x1 * s4

' qy
q3 = q2 * s5 - y1 * c5
y2 = q2 * c5 + y1 * s5

' qz
q4 = q3 * s6 - z1 * c6
z2 = q3 * c6 + z1 * s6

' zx
x3 = x2 * s1 - z2 * c1
z3 = x2 * c1 + z2 * s1

' zy
y3 = y2 * s2 - z3 * c2
z4 = y2 * c2 + z3 * s2

' xy
y4 = y3 * s3 - x3 * c3
x4 = y3 * c3 + x3 * s3


END SUB

SUB setpal

FOR a = 0 TO 15
  OUT &H3C8, a
  OUT &H3C9, a * 4
  OUT &H3C9, a * 4
  OUT &H3C9, a * 4
  LINE (a, 0)-(a, 400), a
NEXT a
'a$ = INPUT$(1)
END SUB

FUNCTION vahe (x1, y1, z1, q1, x2, y2, z2, q2)
vahe = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2 + (q1 - q2) ^ 2)
END FUNCTION