' 4 Point in the space - 3D

pts = 4
Dim c(360),s(360)
Dim x(pts),y(pts),z(pts)
Dim x2(pts),y2(pts),z2(pts)
Dim x3(pts),y3(pts)
Dim xOld(pts),yOld(pts)

'cos and sin values stored for quick access
For i = 0 To 360
c(i) = Cos(i * 3.14 / 180)
s(i) = Sin(i * 3.14 / 180)
Next

'starting angles to which the object rotates
t = 360
p = 360
d = 360

'screen starting values
xc = 160
yc = 100
zc = 50

'add your own coordinates here
x(1)= 10
x(2)= 10
x(3)= -10
x(4)= -10
y(1)= 10
y(2)= -10
y(3)= 10
y(4)= -10
z(1)= 0
z(2)= 0
z(3)= 0
z(4)= 0

Cls

Do
a$=Inkey$

a = c(p) * c(d)
b = c(p) * s(d)
L = (s(p) * s(t) * c(d) - c(t) * s(d))
de = (s(p) * s(t) * s(d) + c(t) * c(d))
e = c(p) * s(t)
f = (s(p) * c(t) * c(d) + s(t) * s(d))
g = (s(p) * c(t) * s(d) - s(d) * c(d))
h = c(p) * c(t)

For i = 1 To pts
x2(i) = x(i) * a + y(i) * b - z(i) * s(p)
y2(i) = x(i) * L + y(i) * de + z(i) * e
z2(i) = x(i) * f + y(i) * g + z(i) * h

x3(i) = 256 * (x2(i) / (z2(i) + zc)) + xc
y3(i) = 256 * (y2(i) / (z2(i) + zc)) + yc

' START VARIANT

' erase old point
Pixel(xOld(i), yOld(i))=0
' draw new point
Pixel(x3(i), y3(i))=1
' store this point
xOld(i)=x3(i):yOld(i)=y3(i)
Next

' END VARIANT

'increments the angles by one
p = p + 1
t = t + 1
d = d + 1

'if angle >360 then it is set to be below this won't
'work for negative angles
p = p Mod 360
t = t Mod 360
d = d Mod 360

Pause 30
'exit the program when the ESC key is pressed
Loop Until a$=Chr$(27)
End

' **************************
' END PRG
' **************************



'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

' VARIANT 1

Next

' erase old line
Line (xOld(1),yOld(1))-(xOld(2),yOld(2)),0
Line (xOld(2),yOld(2))-(xOld(4),yOld(4)),0
Line (xOld(4),yOld(4))-(xOld(3),yOld(3)),0
Line (xOld(3),yOld(3))-(xOld(1),yOld(1)),0

' store vertices
For i = 1 To pts
xOld(i)=x3(i):yOld(i)=y3(i)
Next

' draw new line
Line (x3(1),y3(1))-(x3(2),y3(2)),1
Line (x3(2),y3(2))-(x3(4),y3(4)),1
Line (x3(4),y3(4))-(x3(3),y3(3)),1
Line (x3(3),y3(3))-(x3(1),y3(1)),1


' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

' VARIANT 2

Next

' erase old line
Line (xOld(1),yOld(1))-(xOld(2),yOld(2)),0
Line (xOld(2),yOld(2))-(xOld(4),yOld(4)),0
Line (xOld(4),yOld(4))-(xOld(3),yOld(3)),0
Line (xOld(3),yOld(3))-(xOld(1),yOld(1)),0

' erase old X
Line (xOld(1),yOld(1))-(xOld(4),yOld(4)),0
Line (xOld(2),yOld(2))-(xOld(3),yOld(3)),0

' store vertices
For i = 1 To pts
xOld(i)=x3(i):yOld(i)=y3(i)
Next

' draw new line
Line (x3(1),y3(1))-(x3(2),y3(2)),1
Line (x3(2),y3(2))-(x3(4),y3(4)),1
Line (x3(4),y3(4))-(x3(3),y3(3)),1
Line (x3(3),y3(3))-(x3(1),y3(1)),1

' draw X
Line (x3(1),y3(1))-(x3(4),y3(4)),1
Line (x3(2),y3(2))-(x3(3),y3(3)),1

' Rotation cube manual
'
CLS
an = 5
sc = 1
fov = 45
n = 8
h = 2 / TAN(pi * fov / 360)
DIM a(n, 2)
DIM b(n, 3)
DIM c(n, 4)
cubes

h = 2 / TAN(pi * fov / 360)
an2 = an * pi / 180
mono

END
'****************************************
'****************************************

SUB cubel
LINE (a(1, 1), a(1, 2))-(a(4, 1), a(4, 2))
LINE (a(1, 1), a(1, 2))-(a(2, 1), a(2, 2))
LINE (a(1, 1), a(1, 2))-(a(5, 1), a(5, 2))
LINE (a(7, 1), a(7, 2))-(a(3, 1), a(3, 2))
LINE (a(7, 1), a(7, 2))-(a(6, 1), a(6, 2))
LINE (a(7, 1), a(7, 2))-(a(8, 1), a(8, 2))
LINE (a(2, 1), a(2, 2))-(a(3, 1), a(3, 2))
LINE (a(3, 1), a(3, 2))-(a(4, 1), a(4, 2))
LINE (a(4, 1), a(4, 2))-(a(8, 1), a(8, 2))
LINE (a(8, 1), a(8, 2))-(a(5, 1), a(5, 2))
LINE (a(5, 1), a(5, 2))-(a(6, 1), a(6, 2))
LINE (a(6, 1), a(6, 2))-(a(2, 1), a(2, 2))
END SUB

'****************************************

SUB cubes
c(1, 1) = 1
c(1, 2) = 1
c(1, 3) = 1

c(2, 1) = -1
c(2, 2) = 1
c(2, 3) = 1

c(3, 1) = -1
c(3, 2) = -1
c(3, 3) = 1

c(4, 1) = 1
c(4, 2) = -1
c(4, 3) = 1

c(5, 1) = 1
c(5, 2) = 1
c(5, 3) = -1

c(6, 1) = -1
c(6, 2) = 1
c(6, 3) = -1

c(7, 1) = -1
c(7, 2) = -1
c(7, 3) = -1

c(8, 1) = 1
c(8, 2) = -1
c(8, 3) = -1

FOR l = 1 TO n
c(l, 4) = 0
NEXT l
END SUB

'****************************************

SUB fov1
FOR l = 1 TO n
no = 0
x = (h - c(l, 3))
IF x > -.1 AND x < .1 THEN
x = 1
no = 1
ENDIF

z = 60 * h / x
IF z < 0 THEN
z = 1
no = 1
ENDIF
a(l, 1) = c(l, 1) * z + 152
a(l, 2) = c(l, 2) * z + 108
IF no = 1 THEN
r = 10000 / (c(l, 1) ^ 2 + c(l, 2) ^ 2) ^ .5
a(l, 1) = c(l, 1) * r + 152
a(l, 2) = c(l, 2) * r + 108
ENDIF

NEXT l
END SUB

'****************************************

SUB ky
k$ = ""
DO WHILE k$ = ""
k$ = INKEY$
LOOP
k$ = RIGHT$(k$, 1)
END SUB

'****************************************

SUB mono
CLS

ma:
fov1
CLS
cubel

mky:
ky
IF k$ = CHR$(27) OR k$ = " " THEN GOTO mz
rot
GOTO ma

mz:
END SUB

'****************************************

SUB rot

if k$ = " " then goto rz

' key Up Arrow > zoom in
if k$ = CHR$(128) Or k$ = CHR$(160) THEN
FOR l = 1 TO n
c(l, 3) = c(l, 3) + .5
NEXT l
GOTO rz
EndIf

' key Down Arrow > zoom out
if k$ = CHR$(129) Or k$ = CHR$(161) THEN
FOR l = 1 TO n
c(l, 3) = c(l, 3) - .5
NEXT l
GOTO rz
EndIf


' key ESC > exit
if k$ = CHR$(27) then goto rz

' Rotate Down.
if k$ = "2" THEN
si = SIN(0 - an2)
co = COS(0 - an2)
yz
GOTO rz
EndIf

' Rotate Up.
if k$ = "8" THEN
si = SIN(0 + an2)
co = COS(0 + an2)
yz
GOTO rz
EndIf

' Rotate Left.
if k$ = "4" THEN
si = SIN(0 + an2)
co = COS(0 + an2)
xz
GOTO rz
EndIf

' Rotate Right.
if k$ = "6" THEN
si = SIN(0 - an2)
co = COS(0 - an2)
xz
GOTO rz
EndIf

' Rotate Counterclockwise.
if k$ = "0" THEN
si = SIN(0 - an2)
co = COS(0 - an2)
xy
GOTO rz
EndIf

' Rotate Clockwise.
if k$ = "." THEN
si = SIN(0 + an2)
co = COS(0 + an2)
xy
GOTO rz
EndIf

rz:
END SUB

'****************************************

SUB xy
FOR l = 1 TO n
x = c(l, 1)
y = c(l, 2)
c(l, 2) = y * co + x * si
c(l, 1) = x * co - y * si
NEXT l
END SUB

'****************************************

SUB xz
FOR l = 1 TO n
x = c(l, 1)
z = c(l, 3)
c(l, 3) = z * co + x * si
c(l, 1) = x * co - z * si
NEXT l
END SUB

'****************************************

SUB yz
FOR l = 1 TO n
y = c(l, 2)
z = c(l, 3)
c(l, 3) = z * co + y * si
c(l, 2) = y * co - z * si
NEXT l
END SUB
'
'********************************
'

' Cube 3D Rotation.
' -----------------
'
numLines = 11 ' 12 (0 to 11)
DIM lO(numLines,1,3) ' AS pnt 'Original line coords
DIM lR(numLines,1,3) ' AS pnt 'Rotated coords
DIM scrX(numLines,1) ' screen x coord
DIM scrY(numLines,1) ' screen y coord
DIM oldX(numLines,1) ' old x coord for erasing
DIM oldY(numLines,1) ' old y coord for erasing
DIM sj(359) ' trig tables
DIM cj(359)

x = 0
y = 1
Z = 2
p = 3

FOR i = 0 TO 359 ' create sine and cosine
sj(i) = SIN(i * (PI / 180)) ' look up tables to speed up
cj(i) = COS(i * (PI / 180)) ' the math
NEXT

' Read two points instead of one.
FOR i = 0 TO numLines
READ lO(i,0,x), lO(i,0,y), lO(i,0,z), lO(i,0,p)
READ lO(i,1,x), lO(i,1,y), lO(i,1,z), lO(i,1,p)
NEXT

CLS

xCenter = 160
yCenter = 100
zCenter = 256
theta = 0
phi = 0
thetaRot = 2
phiRot = 2
justStarted = 1

DO
FOR i = 0 TO numLines
' Save the old values of x and y so we can erase the balls later.
oldX(i,0) = scrX(i,0): oldY(i,0) = scrY(i,0)
oldX(i,1) = scrX(i,1): oldY(i,1) = scrY(i,1)

' Rotate both points on each axis.
lR(i,0,x) = -lO(i,0,x) * sj(theta) + lO(i,0,y) * cj(theta)
lR(i,0,y) = -lO(i,0,x) * cj(theta) * sj(phi) - lO(i,0,y) * sj(theta) * sj(phi) - lO(i,0,z) * cj(phi) + lO(i,0,p)
lR(i,0,z) = -lO(i,0,x) * cj(theta) * cj(phi) - lO(i,0,y) * sj(theta) * cj(phi) + lO(i,0,z) * sj(phi)

lR(i,1,x) = -lO(i,1,x) * sj(theta) + lO(i,1,y) * cj(theta)
lR(i,1,y) = -lO(i,1,x) * cj(theta) * sj(phi) - lO(i,1,y) * sj(theta) * sj(phi) - lO(i,1,z) * cj(phi) + lO(i,1,p)
lR(i,1,z) = -lO(i,1,x) * cj(theta) * cj(phi) - lO(i,1,y) * sj(theta) * cj(phi) + lO(i,1,z) * sj(phi)

' Translate both points from 3D to 2D.
IF (lR(i,0,z) + zCenter) <> 0 THEN
scrX(i,0) = 256 * (lR(i,0,x) / (lR(i,0,z) + zCenter)) + xCenter
scrY(i,0) = 256 * (lR(i,0,y) / (lR(i,0,z) + zCenter)) + yCenter
ENDIF

IF (lR(i,1,z) + zCenter) <> 0 THEN
scrX(i,1) = 256 * (lR(i,1,x) / (lR(i,1,z) + zCenter)) + xCenter
scrY(i,1) = 256 * (lR(i,1,y) / (lR(i,1,z) + zCenter)) + yCenter
ENDIF
NEXT i

Pause 20

IF justStarted = 0 THEN
' Erase old lines.
FOR i = 0 TO numLines
LINE (oldX(i,0), oldY(i,0))-(oldX(i,1), oldY(i,1)), 0
NEXT i
EndIf

' START VARIANT

' Draw new lines.
FOR i = 0 TO numLines
LINE (scrX(i,0), scrY(i,0))-(scrX(i,1), scrY(i,1)), 1
NEXT i

' END VARIANT

theta = (theta + thetaRot) MOD 360
phi = (phi + phiRot) MOD 360

justStarted = 0
LOOP UNTIL INKEY$ = CHR$(27)
End

'****************************

' Lines are stored in format (X1,Y1,Z1,p1)-(X2,Y2,Z2,p2)
DATA -50,50,50,1,50,50,50,1
DATA 50,-50,50,1,50,50,50,1
DATA 50,50,-50,1,50,50,50,1
DATA -50,-50,50,1,-50,50,50,1
DATA -50,50,-50,1,-50,50,50,1
DATA -50,-50,50,1,50,-50,50,1
DATA -50,50,-50,1,50,50,-50,1
DATA -50,-50,-50,1,50,-50,-50,1
DATA -50,-50,-50,1,-50,50,-50,1
DATA 50,-50,-50,1,50,-50,50,1
DATA 50,-50,-50,1,50,50,-50,1
DATA -50,-50,-50,1,-50,-50,50,1

'****************************
' PRG END
'****************************


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

' VARIANT 1


' Erase old X.
LINE (oldX(9, 0), oldY(9, 0))-(oldX(5, 0), oldY(5, 0)), 0
LINE (oldX(1, 0), oldY(1, 0))-(oldX(8, 0), oldY(8, 0)), 0

' Draw new lines.
FOR i = 0 TO numLines
LINE (scrX(i, 0), scrY(i, 0))-(scrX(i, 1), scrY(i, 1)), 1
NEXT i

' Draw X.
LINE (scrX(9, 0), scrY(9, 0))-(scrX(5, 0), scrY(5, 0)), 1
LINE (scrX(1, 0), scrY(1, 0))-(scrX(8, 0), scrY(8, 0)), 1


'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

' VARIANT 2


' Erase double X.
LINE (oldX(2, 0), oldY(2, 0))-(oldX(5, 0), oldY(5, 0)), 0
LINE (oldX(1, 0), oldY(1, 0))-(oldX(4, 0), oldY(4, 0)), 0
LINE (oldX(0, 0), oldY(0, 0))-(oldX(9, 0), oldY(9, 0)), 0
LINE (oldX(0, 1), oldY(0, 1))-(oldX(8, 0), oldY(8, 0)), 0

' Draw new lines.
FOR i = 0 TO numLines
LINE (scrX(i, 0), scrY(i, 0))-(scrX(i, 1), scrY(i, 1)), 1
NEXT i

' Draw double X.
LINE (scrX(2, 0), scrY(2, 0))-(scrX(5, 0), scrY(5, 0)), 1
LINE (scrX(1, 0), scrY(1, 0))-(scrX(4, 0), scrY(4, 0)), 1
LINE (scrX(0, 0), scrY(0, 0))-(scrX(9, 0), scrY(9, 0)), 1
LINE (scrX(0, 1), scrY(0, 1))-(scrX(8, 0), scrY(8, 0)), 1