ya3dd2.bas

'-----------< Yet Another 3D Demo/Engine v2.0 >---------
'By Dennis Hotson ([email protected])
'
'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