option explicit
option default FLOAT
' 3D solid graphics demo using quarternions to rotate the coordinates
'
cls
'
' Adjust the following to fit your display
'
dim scale=600 'length of the edge of the cube in "real" space
'define the projection plane in units from the observer
DIM viewplane = -500
DIM cubelocation(2)=(mm.hres/2,MM.VRES/2,-2000) 'actual location of the centre of the cube in "real" 3D space
'
'
' define the coordinates of a cube with the z-axis towards the viewer and the centre at 0,0,0
dim cube(3,7)=(-1,-1,1,0, -1,1,1,0, 1,1,1,0, 1,-1,1,0, -1,-1,-1,0, -1,1,-1,0, 1,1,-1,0, 1,-1,-1,0 ) 'coordinates of the cube
dim centroid(3,5)=(0,0,1,0, -1,0,0,0, 0,1,0,0, 1,0,0,0, 0,0,-1,0, 0,-1,0,0) 'centre of each face in space
'
' define the coordinate triples that make up two triangles for each face of the cube, together with a face index number
' all drawing is done as filled triangles
' NB the triangles must be in the same order as the faces, two triangles/face
'
dim cubetriangles%(3,11)=(0,1,2,0, 0,2,3,0, 0,1,5,1, 0,4,5,1, 1,2,6,2, 1,5,6,2, 3,6,7,3, 3,2,6,3, 4,6,7,4, 4,5,6,4, 0,4,7,5, 0,3,7,5)
'
dim q1(4),v(4),vout(4),M_PI=3.14159265359,i%,j%,k%,x1,y1,z1,x2,y2,z2,x3,y3,z3
dim csort(5)
dim sortorder%(5)
DIM integer xx0(11), yy0(11), xx1(11), yy1(11), xx2(11), yy2(11), tcol(5) ,scol(11) 'arrays for calling the triangle draw routine
'
for i%=0 to 7 'scale the cube verticies up depending on the display size
for j%=0 to 2
cube(j%,i%)=cube(j%,i%)*scale/2
next j%
next i%
'
for i%=0 to 5 'scale the centroid positions up depending on the display size
for j%=0 to 2
centroid(j%,i%)=centroid(j%,i%)*scale/2
next j%
next i%
'
' define the colour of each face of the cube
tcol(0)=rgb(red)
tcol(1)=rgb(blue)
tcol(2)=rgb(magenta)
tcol(3)=rgb(yellow)
tcol(4)=rgb(cyan)
tcol(5)=rgb(green)


for i%=0 to 7 'convert coordinates to normalised form
x1=cube(0,i%): y1=cube(1,i%): z1=cube(2,i%)
create_vector(x1,y1,z1,v())
cube(0,i%)=v(2): cube(1,i%)=v(3): cube(2,i%)=v(4): cube(3,i%)=v(0)
next i%
'
for i%=0 to 5 'convert centroid coordinates to normalised form
x1=centroid(0,i%): y1=centroid(1,i%): z1=centroid(2,i%)
create_vector(x1,y1,z1,v())
centroid(0,i%)=v(2): centroid(1,i%)=v(3): centroid(2,i%)=v(4): centroid(3,i%)=v(0)
next i%

'create a quarternion to rotate 15 degrees about a chosen axis
'play with the x,y,z vector which is the sxis of rotation
create_normalised_quaternion(15,1,0.5,0.25,q1())
'
do
for i%=0 to 7 'rotate coordinates
v(2)=cube(0,i%): v(3)=cube(1,i%): v(4)=cube(2,i%): v(0)=cube(3,i%): v(1)=0
rotate_vector(vout(),v(),q1())
cube(0,i%)=vout(2): cube(1,i%)=vout(3): cube(2,i%)=vout(4): cube(3,i%)=vout(0)
next i%
'
for i%=0 to 5 'rotate centroids
v(2)=centroid(0,i%): v(3)=centroid(1,i%): v(4)=centroid(2,i%): v(0)=centroid(3,i%): v(1)=0
rotate_vector(vout(),v(),q1())
centroid(0,i%)=vout(2): centroid(1,i%)=vout(3): centroid(2,i%)=vout(4): centroid(3,i%)=vout(0)
csort(i%)=vout(4)
sortorder%(i%)=i%
next i%
'
floatindexsort(csort(),sortorder%(),6) 'sort the faces in the order of the depth
'
for i%=0 to 5 'project the coordinates onto the viewplane
j%=sortorder%(i%)*2 'get the furthest, as yet undisplayed, face from the viewer
k%=i%*2
z1=cube(2,cubetriangles%(0,j%))*cube(3,cubetriangles%(0,j%))+cubelocation(2)
x1=(cube(0,cubetriangles%(0,j%))*cube(3,cubetriangles%(0,j%))*viewplane/z1 +cubelocation(0))
y1=(cube(1,cubetriangles%(0,j%))*cube(3,cubetriangles%(0,j%))*viewplane/z1 +cubelocation(1))
z2=cube(2,cubetriangles%(1,j%))*cube(3,cubetriangles%(1,j%))+cubelocation(2)
x2=(cube(0,cubetriangles%(1,j%))*cube(3,cubetriangles%(1,j%))*viewplane/z2 +cubelocation(0))
y2=(cube(1,cubetriangles%(1,j%))*cube(3,cubetriangles%(1,j%))*viewplane/z2 +cubelocation(1))
z3=cube(2,cubetriangles%(2,j%))*cube(3,cubetriangles%(2,j%))+cubelocation(2)
x3=(cube(0,cubetriangles%(2,j%))*cube(3,cubetriangles%(2,j%))*viewplane/z3 +cubelocation(0))
y3=(cube(1,cubetriangles%(2,j%))*cube(3,cubetriangles%(2,j%))*viewplane/z3 +cubelocation(1))
xx0(k%)=x1 :yy0(k%)=y1: xx1(k%)=x2 :yy1(k%)=y2: xx2(k%)=x3 :yy2(k%)=y3 :scol(k%)=tcol(j%\2)
k%=k%+1
z1=cube(2,cubetriangles%(0,j%+1))*cube(3,cubetriangles%(0,j%+1))+cubelocation(2)
x1=(cube(0,cubetriangles%(0,j%+1))*cube(3,cubetriangles%(0,j%+1))*viewplane/z1 +cubelocation(0))
y1=(cube(1,cubetriangles%(0,j%+1))*cube(3,cubetriangles%(0,j%+1))*viewplane/z1 +cubelocation(1))
z2=cube(2,cubetriangles%(1,j%+1))*cube(3,cubetriangles%(1,j%+1))+cubelocation(2)
x2=(cube(0,cubetriangles%(1,j%+1))*cube(3,cubetriangles%(1,j%+1))*viewplane/z2 +cubelocation(0))
y2=(cube(1,cubetriangles%(1,j%+1))*cube(3,cubetriangles%(1,j%+1))*viewplane/z2 +cubelocation(1))
z3=cube(2,cubetriangles%(2,j%+1))*cube(3,cubetriangles%(2,j%+1))+cubelocation(2)
x3=(cube(0,cubetriangles%(2,j%+1))*cube(3,cubetriangles%(2,j%+1))*viewplane/z3 +cubelocation(0))
y3=(cube(1,cubetriangles%(2,j%+1))*cube(3,cubetriangles%(2,j%+1))*viewplane/z3 +cubelocation(1))
xx0(k%)=x1 :yy0(k%)=y1: xx1(k%)=x2 :yy1(k%)=y2: xx2(k%)=x3 :yy2(k%)=y3 :scol(k%)=tcol(j%\2)
next i%
cls
triangles(12,xx0(),yy0(),xx1(),yy1(),xx2(),yy2(),scol(),100000)
pause 1000
loop
end

'
sub create_normalised_quaternion(theta,x,y,z,q())
local radians = theta/180.0*M_PI
local sineterm= sin(radians!/2)
q(1)=cos(radians/2)
q(2)=x* sineterm
q(3)=y* sineterm
q(4)=z* sineterm
q(0)=sqr(q!(1)*q(1) + q(2)*q(2) + q(3)*q(3) + q(4)*q(4)) 'calculate the magnitude
q(1)=q(1)/q(0) 'create a normalised quaternion
q(2)=q(2)/q(0)
q(3)=q(3)/q(0)
q(4)=q(4)/q(0)
q(0)=1
end sub
'
sub invert_quaternion(n(),q())
n(0)=q(0)
n(1)=q(1)
n(2)=-q(2)
n(3)=-q(3)
n(4)=-q(4)
end sub
'
sub multiply_quaternion(n(),q1(),q2())
local a1=q1(1),a2=q2(1),b1=q1(2),b2=q2(2),c1=q1(3),c2=q2(3),d1=q1(4),d2=q2(4)
n(1)=a1*a2-b1*b2-c1*c2-d1*d2
n(2)=a1*b2+b1*a2+c1*d2-d1*c2
n(3)=a1*c2-b1*d2+c1*a2+d1*b2
n(4)=a1*d2+b1*c2-c1*b2+d1*a2
n(0)=q1(0)*q2(0)
end sub
'
sub create_vector(x,y,z,v())
v(0)=sqr(x*x + y*y + z*z)
v(1)=0
v(2)=x/v(0)
v(3)=y/v(0)
v(4)=z/v(0)
end sub

sub rotate_vector(vnew(),v(),q())
local n(4),iq(4)
multiply_quaternion(n(),q(),v())
invert_quaternion(iq(),q())
multiply_quaternion(vnew(),n(),iq())
end sub

Csub triangles 'draws multiple triangles with a delay between if required
00000000
8C820004 27BDFFA0 AFBF005C AFBE0058 AFB70054 AFB60050 AFB5004C AFB40048
AFB30044 AFB20040 AFB1003C AFB00038 AFA40060 AFA50064 AFA60068 184000EE
AFA7006C AFA00030 3C159D00 8FA30030 8FA50068 8FA80070 000310C0 00A22021
01021821 8C840000 8C630000 8FA90064 AFA40018 01223821 AFA3001C 8FA40074
8FA3006C 8FA80078 8FA9007C 00623021 00822821 01022021 01221021 8FA80018
8FA9001C 8CC60000 8CA50000 0128182A 8CF30000 8C9E0000 AFA60028 AFA5002C
10600006 8C540000 02601021 AFA90018 00C09821 AFA8001C AFA20028 8FA5001C
03C5102A 10400008 8FA90018 8FA20028 8FA8002C AFBE001C AFA80028 00A0F021
AFA2002C 8FA90018 8FA3001C 0069102A 10400008 8FA50018 8FA4001C 02601021
AFA40018 8FB30028 AFA9001C AFA20028 8FA50018 10BE008C 8FA4001C 109E00A4
8FA50018 2483FFFF 0065102A 1440002E 8FB00018 8FA90028 8FA2002C 8FA8001C
01334823 00531023 03C5B023 AFBE0034 0105B823 0280F021 AFA90020 AFA20024
00A08021 00009021 00008821 0060A021 0237001A 02E001F4 8FA30024 8FA20020
02002821 02003821 02228821 26100001 00002012 0256001A 02C001F4 00932021
02439021 00003012 00D33021 00C4182A 10600003 00801021 00C02021 00403021
8EA20048 AFBE0010 8C420000 0040F809 00000000 0290102A 1040FFE5 00000000
03C0A021 8FBE0034 03D0102A 14400030 8FA8001C 8FA90018 8FA4002C 8FA50028
0093B023 0085B823 02089023 02098823 03C91823 03C81023 72579002 72368802
AFB40018 AFB6001C AFB70020 0260B021 00A0B821 00609821 0040A021 0254001A
028001F4 8FA3001C 8FA20020 02002821 02003821 02429021 26100001 00002012
0233001A 026001F4 00972021 02238821 00003012 00D63021 00C4182A 10600003
00801021 00C02021 00403021 8FA80018 8EA20048 AFA80010 8C420000 0040F809
00000000 03D0102A 1040FFE4 00000000 8FA90080 8D240000 8D220004 00821025
5440001D 8EA20004 8FA20030 8FA40060 24420001 8C830004 AFA20030 000217C3
0043202A 5480FF52 8FA30030 14620006 8FA50060 8FA80030 8CA20000 0102102B
1440FF4B 8FA30030 8FBF005C 8FBE0058 8FB70054 8FB60050 8FB5004C 8FB40048
8FB30044 8FB20040 8FB1003C 8FB00038 03E00008 27BD0060 0040F809 00000000
1000FFE2 8FA20030 8FA80028 0113102A 1440001D 02603821 0268102A 1440001C
8FA70028 02603821 02602021 8FA9002C 0124102A 54400003 8FA4002C 00E9102A
0122380B 8EA20048 8FA30018 AFB40010 00E33821 8C420000 00602821 00803021
0040F809 00E43823 1000FFC2 8FA90080 8FA3001C 0065102A 1040FF5F 8FA90028
1000FF89 8FB00018 1000FFE8 8FA40028 1000FFE6 02602021 1440FFCC 8FBF005C
8C820000 5440FF10 AFA00030 1000FFC8 8FBE0058
End Csub


Csub floatindexsort ' sorts a floating point array but keeps an index so you know the original order
00000000
8CC60000 27BDFF98 AFB00040 AFBF0064 AFBE0060 AFB7005C AFB60058 AFB50054
AFB40050 AFB3004C AFB20048 AFB10044 AFA6001C AFA40068 AFA5006C 00C08021
3C039D00 001017C2 00508021 00108043 12000068 8FBF0064 8FA4001C 0204102A
1040FFF9 001017C2 8FA60068 00102080 00C42021 00102823 AFA50010 AFA40028
8FA5001C 8FA4006C 001010C0 AFA6002C 8FA60010 00821021 00B02823 AFA20024
AFA50034 AFA00020 0006F080 0006B8C0 8FA20020 8FA50028 0202B021 8FA20024
8CA60000 AFA50014 8C450000 02D0202A AFA60018 1480002A AFA50030 8FA60020
8FA2006C 000690C0 00529021 8FB50024 8FB40028 8FB1002C 1000000F 00C09821
8E220000 8E440000 8E450004 0213B021 02D0302A AE820000 023E8821 02401021
AEA40000 AEA50004 02579021 029EA021 14C00013 02B7A821 8FA40010 8E250000
8C620068 02649821 8FA40018 AFA30038 0040F809 AFB10014 2405FFFF 1045FFE8
8FA30038 8FA60068 00161080 8FA4006C 00C21021 0016B0C0 AFA20014 00961021
8FA60020 8FA50030 24C60001 AFA60020 000527C3 8FA60018 8FA50014 ACA60000
8FA50028 8FA60030 24A50004 AFA50028 AC460000 AC440004 8FA20024 8FA4002C
8FA50020 8FA60034 24420008 24840004 AFA20024 14A6FFB6 AFA4002C 001017C2
00508021 00108043 5600FF9C 8FA4001C 8FBF0064 8FBE0060 8FB7005C 8FB60058
8FB50054 8FB40050 8FB3004C 8FB20048 8FB10044 8FB00040 03E00008 27BD0068
End Csub