Notable features of this program include the use of the dot-product operator to perform 3D rotation (matrix dot-product) and hidden surface removal (vector dot-product), the sortlib library to order the tetrahedra so that they are drawn from the back towards the front, and array-slicing to extract the vertices of an individual tetrahedron from a larger array.
It is compatible with both BBC BASIC for Windows and BBC BASIC for SDL 2.0.
Code: Select all
ON ERROR OSCLI "REFRESH ON" : MODE 3 : PRINT REPORT$ : END
REM Spinning tetrahedra, Richard Russell, 06-Mar-2025
REM!Keep rs2
nTet% = 20
INSTALL @lib$ + "sortlib"
Sort%% = FN_sortinit(1,0)
MODE 9 : OFF
ORIGIN 640,512
COLOUR 4,64,64,255
DIM XYZ(2,5), s%(6*nTet%-1)
DIM xyz(2,6*nTet%-1), tmp(2,6*nTet%-1), pqr(2,6*nTet%-1), abc(2,6*nTet%-1)
rs2 = 1 / SQR(2)
FOR I% = 0 TO 6*nTet%-1 : s%(I%) = -I% : NEXT
FOR T% = 0 TO nTet%-1
RESTORE
FOR I% = 0 TO 5
READ XYZ(0,I%), XYZ(1,I%), XYZ(2,I%)
NEXT
PROCrotate(XYZ(), XYZ(), 2*PI*RND(1), 2*PI*RND(1))
xyz(0,T%*6 TO T%*6+5) = XYZ(0,0 TO)
xyz(1,T%*6 TO T%*6+5) = XYZ(1,0 TO)
xyz(2,T%*6 TO T%*6+5) = XYZ(2,0 TO)
pqr(0,T%*6 TO T%*6+5) = RND(1)-0.5
pqr(1,T%*6 TO T%*6+5) = RND(1)-0.5
pqr(2,T%*6 TO T%*6+5) = RND(1)-0.5
NEXT T%
pqr() *= 10
DATA -1,0,-rs2, 1,0,-rs2, 0,-1,rs2, 0,1,rs2, -1,0,-rs2, 1,0,-rs2
*REFRESH OFF
COLOUR 128+8
b = 0 : c = 0 : B = 0 : C = 0
REPEAT
PROCrotate(xyz(),tmp(),b,c)
PROCrotate(pqr(),abc(),B,C)
tmp() += abc()
C% = 6*nTet%
CALL Sort%%, abc(1,0), s%(0), tmp(0,0), tmp(1,0), tmp(2,0)
CLS
FOR T% = 0 TO 6*nTet%-6 STEP 6
PROCplot(tmp(0,T% TO T%+5),tmp(1,T% TO T%+5),tmp(2,T% TO T%+5))
NEXT T%
WAIT 1 : *REFRESH
b += 0.03
c += 0.06
B += 0.01
C += 0.015
UNTIL FALSE
END
DEF PROCrotate(a(),t(),b,c)
LOCAL b(), c() : DIM b(2,2), c(2,2)
b() = COS(b), 0, -SIN(b), 0, 1, 0, SIN(b), 0, COS(b)
c() = COS(c), SIN(c), 0, -SIN(c), COS(c), 0, 0, 0, 1
c() = b() . c() : t() = c() . a()
ENDPROC
DEF PROCplot(x(),y(),z())
LOCAL K%, X%, Y%, a,b,c,d,e,f, e(),l(),n()
DIM e(2),l(0),n(2) : y() += 24 : REM camera distance
FOR K% = 0 TO 5
IF K% >= 2 THEN
a = x(K%) - x(K%-1)
b = y(K%) - y(K%-1)
c = z(K%) - z(K%-1)
d = x(K%-2) - x(K%)
e = y(K%-2) - y(K%)
f = z(K%-2) - z(K%)
n() = b*f-c*e, c*d-a*f, a*e-b*d
IF K% AND 1 n() = -n() : REM winding direction
e() = SUM(x(K%-2 TO K%)), SUM(y(K%-2 TO K%)), SUM(z(K%-2 TO K%))
l() = n() . e()
ENDIF
X% = 2000 * x(K%) / y(K%)
Y% = 2000 * z(K%) / y(K%)
IF K% >= 2 IF l(0) > 0 GCOL K% : PLOT 85,X%,Y% ELSE MOVE X%,Y%
NEXT
ENDPROC