Skip to content

Instantly share code, notes, and snippets.

@dhotson
Created January 19, 2015 06:17
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save dhotson/686036fb771fbbca8c48 to your computer and use it in GitHub Desktop.
Save dhotson/686036fb771fbbca8c48 to your computer and use it in GitHub Desktop.
'-----------< Yet Another 3D Demo/Engine v2.0 >---------
'By Dennis Hotson (djdennie69@hotmail.com)
'
'INSTRUCTIONS:
'* Use the mouse to look around
'* Use arrow keys OR "WASD" to move/strafe
'* Use the - and + keys to move up/down
'* Click left mouse button to rotate cube
'* Click right mouse button to rotate square
'
'
'Note: You may want to change the screen mode if it doesn't work.
'If so, go down and change the set320x200 thingo
'$DYNAMIC
TYPE vect3d
x AS SINGLE
y AS SINGLE
z AS SINGLE
n AS INTEGER '-----< used for sorting polygons
END TYPE
TYPE poly
p(3) AS vect3d
END TYPE
'-----< object stuff
DECLARE SUB drawobjpoly (obj() AS poly, col&, light AS vect3d, b%, cir%)
DECLARE SUB makecube (Array() AS poly, d AS vect3d)
DECLARE SUB makesinus (obj() AS poly)
DECLARE SUB makegrid (obj() AS poly, d AS vect3d)
DECLARE SUB makeshadow (obj() AS poly, o() AS poly, level%)
DECLARE SUB transobj (obj() AS poly, t AS vect3d, pn AS INTEGER)
DECLARE SUB rotobj (obj() AS poly, r AS vect3d, ctr AS vect3d)
DECLARE SUB drawobj (obj() AS poly, col&)
'-----< vector stuff
DECLARE SUB vadd (v1 AS vect3d, v2 AS vect3d, o AS vect3d, pn AS INTEGER)
DECLARE SUB vlin (v AS vect3d, col!)
DECLARE SUB vdisp (v AS vect3d)
DECLARE SUB vcro (v1 AS vect3d, v2 AS vect3d, o AS vect3d)
DECLARE SUB vmul (v AS vect3d, m AS vect3d, o AS vect3d)
DECLARE SUB vhat (v AS vect3d, o AS vect3d)
DECLARE SUB rotvect (old AS vect3d, r AS vect3d)
DECLARE FUNCTION vmod (v AS vect3d)
DECLARE FUNCTION dot (v1 AS vect3d, v2 AS vect3d)
DECLARE FUNCTION vang! (v1 AS vect3d, v2 AS vect3d)
DECLARE FUNCTION vhor (v1 AS vect3d, v2 AS vect3d)
DECLARE FUNCTION vver (v1 AS vect3d, v2 AS vect3d)
'-----< misc stuff
DECLARE SUB zsort (thearray() AS vect3d)
DECLARE SUB avp (obj() AS poly, o() AS vect3d)
DECLARE SUB gendir ()
DECLARE FUNCTION p3dt2d (v AS vect3d, o AS vect3d) 'convert 3d coordinates into 2d screen coordinates
DECLARE FUNCTION acos! (x!)
'$INCLUDE: 'future.bi'
DIM cube(0) AS poly 'object to draw
DIM cub2(0) AS poly
DIM shadow(0) AS poly ' shadow object
DIM square(0) AS poly ' " "
DIM sinus(0) AS poly
DIM cen AS vect3d
DIM rot AS vect3d
DIM dm(1) AS vect3d
DIM temp AS vect3d 'temp vector (misc use)
DIM SHARED dir(2) AS vect3d 'relative direction vectors (used with p3dt2d)
DIM SHARED res AS vect3d 'screen resolution
DIM SHARED v AS vect3d 'view vector
DIM SHARED vpos AS vect3d 'view position
ON ERROR GOTO 10 '-------< error handling (basically ignore all errors)
GOTO 20
10 RESUME NEXT
20
CONST pi = 3.141592654#
CONST deg = 180 / pi
CONST rad = pi / 180
'-------------------< initialise screen/keyboard
res.x = 320
res.y = 240
res.z = 32
setscreenmode CINT(res.x), CINT(res.y), CINT(res.z)
pge% = Pages%
kbhon
'-------------------------------------<<<<<<<<< Create objects >>>>>>>>>>
temp.x = 4
temp.y = 4
temp.z = 4
makecube cube(), temp '-------------< make cube
temp.x = 2
temp.y = 2
temp.z = 2
transobj cube(), temp, -1
temp.x = 10
temp.y = .5
temp.z = 10
makecube square(), temp '---------< make flat square
temp.x = 5
temp.y = 0
temp.z = 5
transobj square(), temp, -1
cen.x = 0
cen.x = 0
cen.x = 0
temp.x = 0
temp.y = 0
temp.z = pi
rotobj square(), temp, cen
temp.x = 0
temp.y = 4
temp.z = 0
transobj square(), temp, -1
temp.x = 6
temp.y = 0
temp.z = 6
makegrid sinus(), temp '---------< make grid (for sinus)
temp.x = 3
temp.y = 0
temp.z = 3
transobj sinus(), temp, -1
'-----< some constant colours
white& = RGB2Color(255, 255, 255)
red& = RGB2Color(255, 0, 0)
blue& = RGB2Color(0, 0, 255)
'-------------------------------------<<<<<<<<< Create objects >>>>>>>>>>
v.x = 0
v.y = 0
v.z = 5
vpos.z = -30
DO '-------------------------------< start of main loop
future.updatemouse
stp! = .4
f! = f! + 1
IF TIMER > (oldtime! + 1) THEN
fps! = f!
f! = 0
oldtime! = TIMER
END IF
IF GetKey(72) OR GetKey(17) THEN '---------< move forward
vpos.x = vpos.x + dir(2).x * stp!
vpos.y = vpos.y + dir(2).y * stp!
vpos.z = vpos.z + dir(2).z * stp!
END IF
IF GetKey(80) OR GetKey(31) THEN '---------< move back
vpos.x = vpos.x - dir(2).x * stp!
vpos.y = vpos.y - dir(2).y * stp!
vpos.z = vpos.z - dir(2).z * stp!
END IF
IF GetKey(77) OR GetKey(32) THEN '---------< strafe right
vpos.x = vpos.x + dir(0).x * stp!
vpos.y = vpos.y + dir(0).y * stp!
vpos.z = vpos.z + dir(0).z * stp!
END IF
IF GetKey(75) OR GetKey(30) THEN '---------< strafe left
vpos.x = vpos.x - dir(0).x * stp!
vpos.y = vpos.y - dir(0).y * stp!
vpos.z = vpos.z - dir(0).z * stp!
END IF
IF GetKey(78) THEN '---------< move up
vpos.x = vpos.x + dir(1).x * stp!
vpos.y = vpos.y + dir(1).y * stp!
vpos.z = vpos.z + dir(1).z * stp!
END IF
IF GetKey(74) THEN '---------< move down
vpos.x = vpos.x - dir(1).x * stp!
vpos.y = vpos.y - dir(1).y * stp!
vpos.z = vpos.z - dir(1).z * stp!
END IF
IF GetKey(18) AND old <> 1 THEN '---------< change display mode
mode = (mode + 1) MOD 3
old = 1
END IF
IF GetKey(18) = 0 THEN
old = 0
END IF
'--< find change in mouse coordinates "dm(0)"
dm(0).x = (Future.MouseX - dm(1).x)
dm(0).y = (Future.MouseY - dm(1).y)
setlocation res.x / 2, res.y / 2
dm(1).x = Future.MouseX
dm(1).y = Future.MouseY
hor! = hor! + dm(0).x
ver! = ver! + dm(0).y
'--< set some limits on up\down view angle
IF ver! > 150 THEN ver! = 150
IF ver! < -150 THEN ver! = -150
'---< determine and set view angle depending on mouse
v.x = SIN(hor! * rad * .6)
v.y = -ver! / 80
v.z = COS(hor! * rad * .6)
gendir '----------< generate relative direction vectors
IF (Future.MouseB AND 1) = 1 THEN 'Rotate cube on mouseclick
rot.x = .01
rot.y = .02
rot.z = SIN(TIMER) / 20
rotobj cube(), rot, cen
END IF
IF (Future.MouseB AND 2) = 2 THEN 'Rotate square on mouseclick
rot.x = 0
rot.y = .02
rot.z = 0
rotobj square(), rot, cen
END IF
'-------< process and translate objects
makeshadow cube(), shadow(), -4 'create shadow of cube() and store it in shadow()
makesinus sinus()
temp.x = 0
temp.y = -7
temp.z = 0
transobj sinus(), temp, 1
p = (p + 1) MOD pge%
setpage p
future.cls RGB2Color(100, 130, 255)
'future.emsput 0, 0, handle%
'------------------------------------------------------<<<<<<DRAW STUFF
c& = RGB2Color(127 * SIN(TIMER / 8) + 128, 127 * COS(TIMER / 4) + 128, 127 * SIN(TIMER / 2) + 128)
trans = 50 * SIN(TIMER) + 205
SELECT CASE mode
CASE 0
'--------< filled objects
drawobjpoly sinus(), white&, v, 150, 0
drawobjpoly square(), blue&, v, 70, -1
drawobjpoly shadow(), 0, v, trans / 5, 0
drawobjpoly cube(), c&, v, trans, -1
CASE 1
'-------< no transparency
drawobjpoly sinus(), white&, v, -1, 0
drawobjpoly square(), blue&, v, -1, 0
drawobjpoly shadow(), 0, v, -1, 0
drawobjpoly cube(), c&, v, -1, 0
CASE 2
'---------< wireframe
drawobj sinus(), white&
drawobj square(), blue&
drawobj shadow(), 0
drawobj cube(), c&
END SELECT
future.pset res.x / 2, res.y / 2, NOT Future.POINT((res.x / 2), (res.y / 2))
future.print 1, 1, "FPS:" + STR$(fps!), 0, -1
'--------------------------------------------------------<<<<<<<<
viewpage p
LOOP UNTIL GetKey(1)
resetscreen
kbhoff
REM $STATIC
FUNCTION acos! (x!)
acos! = -ATN(x! / SQR(-x! + 1)) + 1.5708
END FUNCTION
SUB avp (obj() AS poly, o() AS vect3d)
STATIC temp AS vect3d
REDIM o(UBOUND(obj)) AS vect3d
FOR i = 0 TO UBOUND(obj)
temp.x = obj(i).p(0).x - vpos.x
temp.y = obj(i).p(0).y - vpos.y
temp.z = obj(i).p(0).z - vpos.z
a! = vhor(temp, dir(2))
temp.x = obj(i).p(1).x - vpos.x
temp.y = obj(i).p(1).y - vpos.y
temp.z = obj(i).p(1).z - vpos.z
b! = vhor(temp, dir(2))
temp.x = obj(i).p(2).x - vpos.x
temp.y = obj(i).p(2).y - vpos.y
temp.z = obj(i).p(2).z - vpos.z
c! = vhor(temp, dir(2))
temp.x = obj(i).p(3).x - vpos.x
temp.y = obj(i).p(3).y - vpos.y
temp.z = obj(i).p(3).z - vpos.z
d! = vhor(temp, dir(2))
o(i).z = (a! + b! + c! + d!) / 4
o(i).n = i
NEXT i
END SUB
DEFSNG A-Z
FUNCTION dot (v1 AS vect3d, v2 AS vect3d)
d = (v1.x * v2.x) + (v1.y * v2.y) + (v1.z * v2.z)
dot = d
END FUNCTION
SUB drawobj (obj() AS poly, col&)
STATIC s AS vect3d
STATIC o AS vect3d
FOR i = LBOUND(obj) TO UBOUND(obj)
FOR n = 0 TO 4
IF p3dt2d(obj(i).p(n MOD 4), s) AND n > 0 THEN
future.LINE o.x, o.y, s.x, s.y, col&, -1
END IF
o.x = s.x
o.y = s.y
NEXT n
NEXT i
END SUB
DEFINT A-Z
SUB drawobjpoly (obj() AS poly, col&, light AS vect3d, blend%, cir%)
IF blend% > 0 THEN setblender blend%
STATIC s AS vect3d
STATIC o AS vect3d
STATIC temp AS vect3d
STATIC tmp1 AS vect3d
STATIC tmp2 AS vect3d
STATIC red, green, blue AS INTEGER
STATIC red2, green2, blue2 AS SINGLE
REDIM a(0) AS vect3d
REDIM poly(1, 2) AS vect3d
avp obj(), a()
zsort a()
z% = UBOUND(obj)
'FOR j = LBOUND(obj) TO UBOUND(obj)
DO
i% = a(z%).n
a = p3dt2d(obj(i%).p(0), poly(0, 0))
b = p3dt2d(obj(i%).p(1), poly(0, 1))
c = p3dt2d(obj(i%).p(2), poly(0, 2))
e = p3dt2d(obj(i).p(2), poly(1, 0))
f = p3dt2d(obj(i).p(3), poly(1, 1))
g = p3dt2d(obj(i).p(0), poly(1, 2))
cull = (a <> 0 AND b <> 0 AND c <> 0 AND e <> 0 AND f <> 0 AND g <> 0)
vadd obj(i).p(1), obj(i).p(2), tmp1, -1
vadd obj(i).p(0), obj(i).p(1), tmp2, -1
vcro tmp2, tmp1, temp
IF (blend% = -1) AND (ABS((vang!(v, temp))) > (pi / 2)) THEN
a = 0 '------< backface cull
e = 0
END IF
angle! = vang!(temp, light)
br! = 1 / ((.4 * angle! ^ 2) + 1)
'br% = 1 / ((.02 * angle! ^ 2) + (1 / 255))
color2rgb col&, red, green, blue
red2 = red
green2 = green
blue2 = blue
red2 = red2 * br!
green2 = green2 * br!
blue2 = blue2 * br!
IF cull THEN future.trifill poly(0, 0).x, poly(0, 0).y, poly(0, 1).x, poly(0, 1).y, poly(0, 2).x, poly(0, 2).y, RGB2Color(red2, green2, blue2)
IF cull THEN future.trifill poly(1, 0).x, poly(1, 0).y, poly(1, 1).x, poly(1, 1).y, poly(1, 2).x, poly(1, 2).y, RGB2Color(red2, green2, blue2)
'IF a <> 0 AND b <> 0 AND c <> 0 THEN future.trifill poly(0, 0).x, poly(0, 0).y, poly(0, 1).x, poly(0, 1).y, poly(0, 2).x, poly(0, 2).y, RGB2Color(red2, green2, blue2)
'IF e <> 0 AND f <> 0 AND g <> 0 THEN future.trifill poly(1, 0).x, poly(1, 0).y, poly(1, 1).x, poly(1, 1).y, poly(1, 2).x, poly(1, 2).y, RGB2Color(red2, green2, blue2)
IF cir% AND cull THEN
FOR n = 0 TO 4
IF p3dt2d(obj(i).p(n MOD 4), s) AND n > 0 THEN
future.LINE o.x, o.y, s.x, s.y, 0, -1
IF cir% > 0 THEN
temp.x = obj(i).p(n MOD 4).x - vpos.x '|
temp.y = obj(i).p(n MOD 4).y - vpos.y '+-< find distance to point (used for circle radius)
temp.z = obj(i).p(n MOD 4).z - vpos.z '|
d = res.x / (3 * vmod(temp)) '+
future.fillcircle s.x, s.y, d, col&
END IF
END IF
o.x = s.x
o.y = s.y
NEXT n
END IF
z% = z% - 1
LOOP UNTIL z% = LBOUND(obj) - 1
'NEXT j
setblender 0
END SUB
DEFSNG A-Z
SUB gendir
STATIC temp AS vect3d
'---------<<->> generate direction vectors perpendicular to view vector
'dir(0) = vector in "x" direction
'dir(1) = vector in "y" direction
'dir(2) = vector in "z" direction
dir(2).x = v.x
dir(2).y = v.y
dir(2).z = v.z
dir(0).x = dir(2).z
dir(0).y = 0
dir(0).z = -dir(2).x
vcro dir(2), dir(0), dir(1)
vhat dir(0), temp
dir(0).x = temp.x
dir(0).y = temp.y
dir(0).z = temp.z
vhat dir(1), temp
dir(1).x = -temp.x
dir(1).y = -temp.y
dir(1).z = -temp.z
vhat dir(2), temp
dir(2).x = temp.x
dir(2).y = temp.y
dir(2).z = temp.z
'---------<<->>
END SUB
SUB makecube (Array() AS poly, d AS vect3d)
REDIM Array(5) AS poly
'------------------ 1
Array(0).p(0).x = 0
Array(0).p(0).y = 0
Array(0).p(0).z = 0
Array(0).p(1).x = d.x
Array(0).p(1).y = 0
Array(0).p(1).z = 0
Array(0).p(2).x = d.x
Array(0).p(2).y = d.y
Array(0).p(2).z = 0
Array(0).p(3).x = 0
Array(0).p(3).y = d.y
Array(0).p(3).z = 0
'------------------ 2
Array(1).p(0).x = d.x
Array(1).p(0).y = 0
Array(1).p(0).z = 0
Array(1).p(1).x = d.x
Array(1).p(1).y = 0
Array(1).p(1).z = d.z
Array(1).p(2).x = d.x
Array(1).p(2).y = d.y
Array(1).p(2).z = d.z
Array(1).p(3).x = d.x
Array(1).p(3).y = d.y
Array(1).p(3).z = 0
'------------------ 3
Array(2).p(0).x = d.x
Array(2).p(0).y = d.y
Array(2).p(0).z = 0
Array(2).p(1).x = d.x
Array(2).p(1).y = d.y
Array(2).p(1).z = d.z
Array(2).p(2).x = 0
Array(2).p(2).y = d.y
Array(2).p(2).z = d.z
Array(2).p(3).x = 0
Array(2).p(3).y = d.y
Array(2).p(3).z = 0
'------------------ 4
Array(3).p(0).x = 0
Array(3).p(0).y = 0
Array(3).p(0).z = 0
Array(3).p(1).x = 0
Array(3).p(1).y = d.y
Array(3).p(1).z = 0
Array(3).p(2).x = 0
Array(3).p(2).y = d.y
Array(3).p(2).z = d.z
Array(3).p(3).x = 0
Array(3).p(3).y = 0
Array(3).p(3).z = d.z
'------------------ 5
Array(4).p(0).x = d.x
Array(4).p(0).y = 0
Array(4).p(0).z = d.z
Array(4).p(1).x = 0
Array(4).p(1).y = 0
Array(4).p(1).z = d.z
Array(4).p(2).x = 0
Array(4).p(2).y = d.y
Array(4).p(2).z = d.z
Array(4).p(3).x = d.x
Array(4).p(3).y = d.y
Array(4).p(3).z = d.z
'------------------ 6
Array(5).p(0).x = 0
Array(5).p(0).y = 0
Array(5).p(0).z = 0
Array(5).p(1).x = 0
Array(5).p(1).y = 0
Array(5).p(1).z = d.z
Array(5).p(2).x = d.x
Array(5).p(2).y = 0
Array(5).p(2).z = d.z
Array(5).p(3).x = d.x
Array(5).p(3).y = 0
Array(5).p(3).z = 0
END SUB
DEFINT A-Z
SUB makegrid (obj() AS poly, d AS vect3d)
REDIM obj((d.x * d.z) - 1) AS poly
i = 0
FOR x = 0 TO (d.x - 1)
FOR z = 0 TO (d.z - 1)
obj(i).p(3).x = x
obj(i).p(3).z = z
obj(i).p(2).x = x
obj(i).p(2).z = z + 1
obj(i).p(1).x = x + 1
obj(i).p(1).z = z + 1
obj(i).p(0).x = x + 1
obj(i).p(0).z = z
i = i + 1
NEXT z
NEXT x
END SUB
SUB makeshadow (obj() AS poly, o() AS poly, level)
REDIM o(UBOUND(obj)) AS poly
FOR i = 0 TO UBOUND(o)
FOR n = 0 TO 3
o(i).p(n).x = obj(i).p(n).x
o(i).p(n).y = level
o(i).p(n).z = obj(i).p(n).z
NEXT n
NEXT i
END SUB
SUB makesinus (obj() AS poly)
FOR i = LBOUND(obj) TO UBOUND(obj)
FOR n = 0 TO 3
obj(i).p(n).y = SIN(obj(i).p(n).x - (TIMER * pi)) + COS(obj(i).p(n).z - (TIMER))
NEXT n
NEXT i
END SUB
DEFSNG A-Z
FUNCTION p3dt2d (p AS vect3d, o AS vect3d)
STATIC r AS vect3d
STATIC tmp AS vect3d
tmp.x = p.x - vpos.x
tmp.y = p.y - vpos.y
tmp.z = p.z - vpos.z
r.x = vhor(tmp, dir(0))
r.y = vhor(tmp, dir(1))
r.z = vhor(tmp, dir(2))
IF r.z > 0 THEN
d = SQR(r.x ^ 2 + r.y ^ 2 + r.z ^ 2)
IF d <> 0 THEN
o.x = (r.x * res.x) / d + (res.x / 2)
o.y = (r.y * res.x) / d + (res.y / 2)
END IF
p3dt2d = d
ELSE
p3dt2d = 0
END IF
'IF o.x > res.x OR o.x < 0 THEN p3dt2d = 0
'IF o.y > res.y OR o.y < 0 THEN p3dt2d = 0
END FUNCTION
SUB rotobj (obj() AS poly, r AS vect3d, ctr AS vect3d)
STATIC old AS vect3d
STATIC new AS vect3d
FOR n = LBOUND(obj) TO UBOUND(obj)
FOR i = 0 TO 3
old.x = obj(n).p(i).x - ctr.x
old.y = obj(n).p(i).y - ctr.y
old.z = obj(n).p(i).z - ctr.z
new.y = (old.y * COS(r.x)) - (old.z * SIN(r.x))
new.z = (old.z * COS(r.x)) + (old.y * SIN(r.x))
old.y = new.y
old.z = new.z
new.z = (old.z * COS(r.y)) - (old.x * SIN(r.y))
new.x = (old.x * COS(r.y)) + (old.z * SIN(r.y))
old.z = new.z
old.x = new.x
new.x = (old.x * COS(r.z)) - (old.y * SIN(r.z))
new.y = (old.y * COS(r.z)) + (old.x * SIN(r.z))
obj(n).p(i).x = new.x + ctr.x
obj(n).p(i).y = new.y + ctr.y
obj(n).p(i).z = new.z + ctr.z
NEXT i
NEXT n
END SUB
DEFINT A-Z
SUB rotvect (old AS vect3d, r AS vect3d)
STATIC new AS vect3d
new.y = (old.y * COS(r.x)) - (old.z * SIN(r.x))
new.z = (old.z * COS(r.x)) + (old.y * SIN(r.x))
old.y = new.y
old.z = new.z
new.z = (old.z * COS(r.y)) - (old.x * SIN(r.y))
new.x = (old.x * COS(r.y)) + (old.z * SIN(r.y))
old.z = new.z
old.x = new.x
new.x = (old.x * COS(r.z)) - (old.y * SIN(r.z))
new.y = (old.y * COS(r.z)) + (old.x * SIN(r.z))
old.x = new.x
old.y = new.y
old.z = new.z
END SUB
DEFSNG A-Z
SUB transobj (obj() AS poly, t AS vect3d, pn AS INTEGER)
FOR i = LBOUND(obj) TO UBOUND(obj)
FOR n = 0 TO 3
obj(i).p(n).x = obj(i).p(n).x + t.x * pn
obj(i).p(n).y = obj(i).p(n).y + t.y * pn
obj(i).p(n).z = obj(i).p(n).z + t.z * pn
NEXT n
NEXT i
END SUB
DEFINT A-Z
SUB vadd (v1 AS vect3d, v2 AS vect3d, o AS vect3d, pn AS INTEGER)
o.x = v1.x + (v2.x * pn)
o.y = v1.y + (v2.y * pn)
o.z = v1.z + (v2.z * pn)
END SUB
FUNCTION vang! (v1 AS vect3d, v2 AS vect3d)
a! = dot(v1, v2)
a! = a! / vmod(v1)
a! = a! / vmod(v2)
vang! = acos!(a!)
END FUNCTION
DEFSNG A-Z
SUB vcro (v1 AS vect3d, v2 AS vect3d, o AS vect3d)
'cross product
o.x = v1.y * v2.z - v2.y * v1.z
o.y = v1.z * v2.x - v2.z * v1.x
o.z = v1.x * v2.y - v2.x * v1.y
END SUB
SUB vdisp (v AS vect3d)
'display vector
PRINT "x="; v.x, "y="; v.y, "z="; v.z, "mod="; vmod(v)
END SUB
SUB vhat (v AS vect3d, o AS vect3d)
'create unit vector in direction v
STATIC m AS vect3d
a = vmod(v)
IF ABS(a) > 0 THEN
m.x = 1 / a
m.y = 1 / a
m.z = 1 / a
END IF
vmul v, m, o
END SUB
FUNCTION vhor (v1 AS vect3d, v2 AS vect3d)
'scalar resolute (amount of v1 in direction of v2)
STATIC temp AS vect3d
vhat v2, temp
vhor = dot(v1, temp)
END FUNCTION
FUNCTION vmod (v AS vect3d)
'return length of v
a = v.x * v.x
b = v.y * v.y
c = v.z * v.z
d = SQR(a + b + c)
vmod = d
END FUNCTION
SUB vmul (v AS vect3d, m AS vect3d, o AS vect3d)
'multiply two vectors
o.x = v.x * m.x
o.y = v.y * m.y
o.z = v.z * m.z
END SUB
FUNCTION vver (v1 AS vect3d, v2 AS vect3d)
'amount of v1 perpendicular to v2
vver = SQR(vmod(v2) ^ 2 - vhor(v1, v2) ^ 2)
END FUNCTION
SUB zsort (thearray() AS vect3d)
'----------------< fast sorting
first = LBOUND(thearray): last = UBOUND(thearray)
REDIM QStack(INT(LOG(last) / LOG(2) * 2 + 12))
stackptr = 0
DO
DO
pivot = thearray((last + first) \ 2).z
pivot = thearray(INT(RND * (last - first) + 1) + first).z
i = first: j = last
DO
DO WHILE thearray(i).z < pivot
i = i + 1
LOOP
DO WHILE thearray(j).z > pivot
j = j - 1
LOOP
IF i > j THEN EXIT DO
IF i < j THEN SWAP thearray(i), thearray(j)
i = i + 1: j = j - 1
LOOP WHILE i <= j
IF i < last THEN
QStack(stackptr) = i
QStack(stackptr + 1) = last
stackptr = stackptr + 2
END IF
last = j
LOOP WHILE first < last
IF stackptr = 0 THEN EXIT DO
stackptr = stackptr - 2
first = QStack(stackptr)
last = QStack(stackptr + 1)
LOOP
ERASE QStack
END SUB
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment