Sanctum 2021

[STxAxTIC]

Hello all,

I recently ran the code for Sanctum (various versions floating around on forums) and realized my local copy is a whole lot newer, so it's time for an update post on this. I also made the mistake of fiddling with the code a few days ago, and of course fell into the abyss, and had to take the code in a new direction to find my way out. I may or may not keep (all of) the results, but I figured it would be worth sharing what exists now.

For those who remember more recent versions of this program, everything is now gone. The land, the trees, the air, (I sound like Churchill right now), the snowmen, all the planets, the black hole, the different layers of ground and hell, all gone gone gone. ASCII plotting, gone.

Here is some of what's going on:

Terrain model:
* Terrain is no longer flat, but is procedurally generated (same seed creates same map).
* Created by choosing pseudo-random extreme points and using relaxation algorithm (to basically solve Laplace's equation treating peaks as charges).
* Contains several pre-flattened plateaus for specialized use (nothing specific implemented yet).

Terrain volume:
* Surface supported by layer of dirt and sand.
* Low spots are filled with water.

Terrain surface:
* Surface features generated and relaxed in analogy to terrain model.
* Elevation-specific coloring.
* Elevation-specific plant-life: Parametric clover, Fractal fern, Grass

Sun and Moon:
* As an experimental feature, the sun and moon are always visible if above the horizon. (There is at least one GOTO in the code because of this. It won't last.)
* When observed form below water level, the sun and moon lose their color.
* The sun/moon phases are loosely tied to your system clock.
* If you're lucky, you'll see a solar eclipse.

Weather:
* Clouds occur in different stratified layers. Different speeds, heights, etc.
* Rain falls from randomly-chosen clouds.
* Weather patterns move and adjust height to pass over mountains, etc.
* Tornadoes will mess you up.

Fish:
* If you look in the deepest water, toward the middle, you will see fish.
* Each view of a fish is actually trimmed from what is best described as a three-dimensional sprite sheet.
* At a given moment, the view of the fish is determined by its velocity.
*** This successful proof-of-concept demonstrates motion of asymmetric things like birds, planes, etc. No longer limited to spheres and UFOs.

Movement/controls:
* Player follows the main terrain mesh while walking.
* Recommended "posture" is WSAD plus Numpad. (Mouse is disabled but works if you find and uncomment the code.)
* Use the Z key to zoom, as if using a telescope. Thought this feature was cute, will probably keep it.
* Press F to throw a breakable thing. Looks like a potion I guess.

Very crude building system:
* Press B to spawn a block. The block will fall to the ground, crudely.
* Press B again to stack a block on top of another block.
* Make stairs or primitive towers this way.
* You can stand blocks like they're part of the terrain.
* Super primitive, no need to tell me about floating blocks.

As usual, this project is perpetually unfinished. This is all done using LINE and CIRCLE, and maybe I've done *all* I can in this area without going the way of textures and the like. Let me know what kind of FPS you get. (I stay around 60, which is the target.)

Code: QB64: [Select]

1. Option _Explicit
2.  
3. Do Until _ScreenExists: Loop
4. _Title "Sanctum 2021"
5.  
6. '$ExeIcon:'sanctum.ico'
7.  
8. ' Hardware.
9.  
10. 'Screen _NewImage(640, 480, 32)
11. Screen _NewImage(800, 600, 32)
12. 'Screen _NewImage(1024, 768, 32)
13.  
14. _FullScreen , _Smooth
15. _MouseHide
16.  
17. ' Performance.
18. Dim Shared As Integer FPSTarget
19. FPSTarget = 60
20.  
21. ' Color constants.
22. Const Aquamarine = _RGB32(127, 255, 212)
23. Const Black = _RGB32(0, 0, 0)
24. Const Blue = _RGB32(0, 0, 255)
25. Const BlueViolet = _RGB32(138, 43, 226)
26. Const Chocolate = _RGB32(210, 105, 30)
27. Const Cyan = _RGB32(0, 255, 255)
28. Const DarkBlue = _RGB32(0, 0, 139)
29. Const DarkGoldenRod = _RGB32(184, 134, 11)
30. Const DarkGray = _RGB32(169, 169, 169)
31. Const DarkKhaki = _RGB32(189, 183, 107)
32. Const DeepPink = _RGB32(255, 20, 147)
33. Const DodgerBlue = _RGB32(30, 144, 255)
34. Const ForestGreen = _RGB32(34, 139, 34)
35. Const Gray = _RGB32(128, 128, 128)
36. Const Green = _RGB32(0, 128, 0)
37. Const Indigo = _RGB32(75, 0, 130)
38. Const Ivory = _RGB32(255, 255, 240)
39. Const LightSeaGreen = _RGB32(32, 178, 170)
40. Const Lime = _RGB32(0, 255, 0)
41. Const LimeGreen = _RGB32(50, 205, 50)
42. Const Magenta = _RGB32(255, 0, 255)
43. Const PaleGoldenRod = _RGB32(238, 232, 170)
44. Const Purple = _RGB32(128, 0, 128)
45. Const Red = _RGB32(255, 0, 0)
46. Const RoyalBlue = _RGB32(65, 105, 225)
47. Const SaddleBrown = _RGB32(139, 69, 19)
48. Const Sienna = _RGB32(160, 82, 45)
49. Const SlateGray = _RGB32(112, 128, 144)
50. Const Snow = _RGB32(200, 200, 200) '''(255, 250, 250)
51. Const Sunglow = _RGB32(255, 207, 72)
52. Const SunsetOrange = _RGB32(253, 94, 83)
53. Const Teal = _RGB32(0, 128, 128)
54. Const White = _RGB32(255, 255, 255)
55. Const Yellow = _RGB32(255, 255, 0)
56.  
57. ' Mathematical constants.
58. Const pi = 4 * Atn(1)
59. Const ee = Exp(1)
60.  
61. ' Divine numbers.
62. Dim Shared bignumber As Long
63. Dim Shared WorldSeed As Long
64. bignumber = 10 ^ 7
65. WorldSeed = 3 'Int(Timer)
66.  
67. ' Fundamental types.
68.  
69. Type Vector3
70.     x As Double
71.     y As Double
72.     z As Double
73. End Type
74.  
75. Type Vector2
76.     u As Double
77.     v As Double
78. End Type
79.  
80. Type Camera
81.     Position As Vector3
82.     Velocity As Vector3
83.     Acceleration As Vector3
84.     Shade As _Unsigned Long
85. End Type
86.  
87. Type GroupElement
88.     Identity As Long
89.     Label As String
90.     Pointer As Long
91.     Lagger As Long
92.     Volume As Vector3
93.     FirstVector As Long
94.     LastVector As Long
95.     Centroid As Vector3
96.     Velocity As Vector3
97.     Visible As Integer
98.     Distance2 As Double
99.     PlotMode As Integer
100.     FrameLength As Long
101.     ActiveFrame As Integer
102. End Type
103.  
104. Type ClusterElement
105.     Identity As Long
106.     Pointer As Long
107.     Lagger As Long
108.     FirstGroup As Long
109.     LastGroup As Long
110.     Centroid As Vector3
111.     Velocity As Vector3
112.     Acceleration As Vector3
113.     Visible As Integer
114.     MotionType As Integer
115.     Framed As Integer
116.     DeathTimer As Long
117. End Type
118.  
119. ' World-specific types.
120.  
121. Type StrataElement
122.     Height As Double
123.     Label As String
124.     Shade As _Unsigned Long
125. End Type
126.  
127. Type PlateauElement
128.     Location As Vector3
129.     Radius As Double
130. End Type
131.  
132. ' Vectors to specify points.
133. Dim Shared vec3Dpos(bignumber) As Vector3 ' Absolute position
134. Dim Shared vec3Dvel(UBound(vec3Dpos)) As Vector3 ' Linear velocity
135. Dim Shared vec3Dvis(UBound(vec3Dpos)) As Integer ' Visibility toggle
136. Dim Shared vec2D(UBound(vec3Dpos)) As Vector2 ' Projection onto 2D plane
137. Dim Shared vec3Dcolor(UBound(vec3Dpos)) As Long ' Original color
138. Dim Shared vec2Dcolor(UBound(vec3Dpos)) As Long ' Projected color
139.  
140. ' A collection of vectors is a Group.
141. Dim Shared Group(UBound(vec3Dpos) / 10) As GroupElement
142. Dim Shared GroupIdTicker As Long
143. GroupIdTicker = 0
144.  
145. ' Groups will eventually be sorted based on distance^2.
146. Dim Shared SortedGroups(1000) As Long
147. Dim Shared SortedGroupsCount As Integer
148.  
149. ' A collection of groups is a Cluster.
150. Dim Shared ClusterIdTicker As Long
151. Dim Shared ClusterFillCounter As Integer
152. Dim Shared Cluster(UBound(Group) / 10) As ClusterElement
153. ClusterIdTicker = 0
154. ClusterFillCounter = 0
155.  
156. ' Main terrain setup. This is a surface z=f(x,y).
157. Dim Shared WorldMesh(180, 180) As Double
158. Dim Shared WorldMeshAddress(UBound(WorldMesh, 1), UBound(WorldMesh, 2)) As Long
159.  
160. ' Terrain elements are formally groups whose size and density are specified here.
161. Dim Shared BlockSize As Integer
162. Dim Shared BlockStep As Integer
163. BlockSize = 40
164. BlockStep = Int(BlockSize / 8)
165.  
166. ' World features.
167. Dim Shared Strata(5) As StrataElement
168. Dim Shared CloudLayer(5) As StrataElement
169. Dim Shared Plateau(5) As PlateauElement
170. Dim Shared SunClusterAddress As Long
171. Dim Shared MoonClusterAddress As Long
172.  
173. ' Fixed paths. Primary ticks are one per second, with total cycle of one day.
174. Dim Shared FixedPath(500, 86400) As Vector3
175. Dim Shared FixedPathIndexTicker As Long
176. FixedPathIndexTicker = 0
177.  
178. ' Three-space basis vectors.
179. Dim Shared As Double xhat(3), yhat(3), zhat(3)
180. xhat(1) = 1: xhat(2) = 0: xhat(3) = 0
181. yhat(1) = 0: yhat(2) = 1: yhat(3) = 0
182. zhat(1) = 0: zhat(2) = 0: zhat(3) = 1
183.  
184. ' Camera orientation vectors.
185. Dim Shared As Double uhat(3), vhat(3), nhat(3)
186.  
187. ' Camera position.
188. Dim Shared PlayerCamera As Camera
189.  
190. ' Field-of-view distance.
191. Dim Shared fovd As Double
192. fovd = -192
193.  
194. ' Clipping planes.
195. Dim Shared As Double nearplane(4), farplane(4), rightplane(4), leftplane(4), topplane(4), bottomplane(4)
196. nearplane(4) = 1
197. farplane(4) = -256
198. rightplane(4) = -BlockSize / 2
199. leftplane(4) = -BlockSize / 2
200. topplane(4) = -BlockSize / 2
201. bottomplane(4) = -BlockSize / 2
202.  
203. ' Temporary counters.
204. Dim Shared NumClusterVisible As Long
205. Dim Shared NumVectorVisible As Long
206. Dim Shared NumGroupVisible As Long
207.  
208. ' Interface.
209. Dim Shared ToggleAnimate As Integer
210. Dim Shared FPSReport As Integer
211. Dim Shared ClosestGroup As Long
212.  
213. ' Prime and start main loop.
214. Randomize WorldSeed
215. Call InitWorld
216. Call CreateWorld
217. Call InitCamera
218. Call MainLoop
219. End
220.  
221. ' Subs and Functions
222.  
223. Sub MainLoop
224.     Dim fps As Integer
225.     Dim fpstimer As Long
226.     Dim tt As Long
227.     fps = 0
228.     fpstimer = Int(Timer)
229.  
230.     Do
231.         Call PlayerDynamics
232.         Call ComputeVisibleScene
233.         Call PlotWorld
234.         Call DisplayHUD
235.         Call DisplayMiniMap
236.         Call KeyDownProcess
237.         Call KeyHitProcess
238.  
239.         fps = fps + 1
240.         tt = Timer
241.         If (tt = fpstimer + 1) Then
242.             fpstimer = tt
243.             FPSReport = fps
244.             fps = 0
245.         End If
246.  
247.         _Display
248.         _Limit FPSTarget + 1
249.     Loop
250. End Sub
251.  
252. Sub InitWorld
253.     Dim k As Integer
254.     Dim As Double u, v, w
255.  
256.     k = 0
257.     k = k + 1: Strata(k).Height = -50: Strata(k).Label = "Water": Strata(k).Shade = RoyalBlue
258.     k = k + 1: Strata(k).Height = 0: Strata(k).Label = "Meadow": Strata(k).Shade = ForestGreen
259.     k = k + 1: Strata(k).Height = 50: Strata(k).Label = "Grassland": Strata(k).Shade = DarkKhaki
260.     k = k + 1: Strata(k).Height = 100: Strata(k).Label = "Rocky Terrain": Strata(k).Shade = DarkGoldenRod
261.     k = k + 1: Strata(k).Height = 150: Strata(k).Label = "Snowy Terrain": Strata(k).Shade = White
262.  
263.     k = 0
264.     k = k + 1: CloudLayer(k).Height = 140: CloudLayer(k).Label = "Dark Cloud": CloudLayer(k).Shade = SlateGray
265.     k = k + 1: CloudLayer(k).Height = 160: CloudLayer(k).Label = "Gray Cloud": CloudLayer(k).Shade = Gray
266.     k = k + 1: CloudLayer(k).Height = 180: CloudLayer(k).Label = "Azul Cloud": CloudLayer(k).Shade = DarkBlue
267.     k = k + 1: CloudLayer(k).Height = 200: CloudLayer(k).Label = "Heavy Cloud": CloudLayer(k).Shade = Snow
268.     k = k + 1: CloudLayer(k).Height = 220: CloudLayer(k).Label = "Icy Cloud": CloudLayer(k).Shade = Ivory
269.  
270.     u = Rnd * 2 * pi
271.     w = Sqr((UBound(WorldMesh, 1) / 2) ^ 2 + (UBound(WorldMesh, 2) / 2) ^ 2)
272.     For k = 1 To UBound(Plateau)
273.         Select Case k
274.             Case 1 ' Water
275.                 u = u + pi / 2
276.                 v = (w / 2) * (.8 + Rnd * .5)
277.                 Plateau(k).Location.x = Int(v * Cos(u))
278.                 Plateau(k).Location.y = Int(v * Sin(u))
279.                 Plateau(k).Location.z = -250
280.             Case 2 ' Meadow
281.                 Plateau(k).Location.x = 0
282.                 Plateau(k).Location.y = 0
283.                 Plateau(k).Location.z = Strata(k).Height
284.             Case Else
285.                 u = u + pi / 2
286.                 v = (w / 2) * (.8 + Rnd * .5)
287.                 Plateau(k).Location.x = Int(v * Cos(u))
288.                 Plateau(k).Location.y = Int(v * Sin(u))
289.                 Plateau(k).Location.z = Strata(k).Height
290.         End Select
291.         Plateau(k).Radius = 15
292.     Next
293. End Sub
294.  
295. Sub CreateWorld
296.     Dim g As Long
297.     Dim k As Integer
298.     ' Initialize and populate list.
299.     k = 0
300.     k = k + 1: Call TextCenter(".:. Let there be light .:.", k * 16, DarkKhaki)
301.     k = k + 1: Call TextCenter("(Initialize linked list)", k * 16, ForestGreen)
302.     g = NewGroup&(0, 0, 0, 0, 1, 0, 0)
303.     k = k + 2: Call TextCenter(".:. Let there be a firmament .:.", k * 16, DarkKhaki)
304.     k = k + 1: Call TextCenter("(Using seed " + LTrim$(RTrim$(Str$(WorldSeed))) + ")", k * 16, ForestGreen)
305.     k = k + 1: Call TextCenter("(Generate random terrain)", k * 16, ForestGreen)
306.     g = CreateTerrainGroups&(g)
307.     k = k + 2: Call TextCenter(".:. Let the dry land appear; bring forth the grass .:.", k * 16, DarkKhaki)
308.     k = k + 1: Call TextCenter("(Relax terrain mesh)", k * 16, ForestGreen)
309.     k = k + 1: Call TextCenter("(Fill terrain volumes)", k * 16, ForestGreen)
310.     k = k + 1: Call TextCenter("(Cover terrain surfaces)", k * 16, ForestGreen)
311.     g = CreateTerrainVectors&(g)
312.     g = CreateTerrainVolume&(g)
313.     g = CreateClover&(g)
314.     g = CreateFern&(g)
315.     g = CreateGrass&(g)
316.     k = k + 2: Call TextCenter(".:. Divide the day from the night .:.", k * 16, DarkKhaki)
317.     k = k + 1: Call TextCenter("(Create celestial objects)", k * 16, ForestGreen)
318.     k = k + 1: Call TextCenter("(Create weather events)", k * 16, ForestGreen)
319.     g = CreateSun&(g)
320.     g = CreateMoon&(g)
321.     g = CreateTornado&(g)
322.     g = CreateWeather&(g)
323.     k = k + 2: Call TextCenter(".:. Let waters bring forth .:.", k * 16, DarkKhaki)
324.     k = k + 1: Call TextCenter("(Create fish)", k * 16, ForestGreen)
325.     g = CreateFish&(g)
326.     k = k + 2: Call TextCenter(".:. Let us make man .:.", k * 16, DarkKhaki)
327.     k = k + 1: Call TextCenter("(Initialize player)", k * 16, ForestGreen)
328.     k = k + 2: Call TextCenter(".:. ...blessed the seventh day and Sanctified it .:.", k * 16, DarkKhaki)
329.     k = k + 1: Call TextCenter("(Rest)", k * 16, ForestGreen)
330.     k = k + 3: Call TextCenter("PRESS ANY KEY", k * 16, Sunglow)
331.     Sleep
332.     _KeyClear
333. End Sub
334.  
335. ' High-order clusters and groups.
336.  
337. Function CreateTerrainGroups& (LagAddressIn As Long)
338.     Dim g As Long
339.     Dim As Integer i, j, k
340.     Dim As Integer ii, jj
341.     Dim As Double u, v, w
342.     g = LagAddressIn
343.  
344.     ' Create world mesh and set extreme points.
345.     Dim tempworldmesh1(UBound(WorldMesh, 1), UBound(WorldMesh, 2))
346.     Dim tempworldmesh2(UBound(WorldMesh, 1), UBound(WorldMesh, 2), 2)
347.  
348.     u = 1 + .5 * (Rnd - .5)
349.     v = 1 + .5 * (Rnd - .5)
350.     For i = 1 To UBound(WorldMesh, 1)
351.         For j = 1 To UBound(WorldMesh, 2)
352.  
353.             ' Overall slant of world.
354.             tempworldmesh2(i, j, 1) = (u * i + v * j - UBound(WorldMesh, 1) / 2 - UBound(WorldMesh, 2) / 2)
355.  
356.             ' Peaks and valleys.
357.             Select Case Rnd
358.                 Case Is < .005
359.                     tempworldmesh2(i, j, 1) = tempworldmesh2(i, j, 1) - (100 + Rnd * 100)
360.                     tempworldmesh2(i, j, 2) = 1 ' fixed
361.                 Case Is > .995
362.                     tempworldmesh2(i, j, 1) = tempworldmesh2(i, j, 1) + (100 + Rnd * 300)
363.                     tempworldmesh2(i, j, 2) = 1 ' fixed
364.                 Case Else
365.                     tempworldmesh2(i, j, 1) = tempworldmesh2(i, j, 1) + 0
366.                     tempworldmesh2(i, j, 2) = 0 'free
367.             End Select
368.  
369.             ' Plateaus.
370.             For k = 1 To UBound(Plateau)
371.                 ii = i - Plateau(k).Location.x - UBound(WorldMesh, 1) / 2
372.                 jj = j - Plateau(k).Location.y - UBound(WorldMesh, 2) / 2
373.                 If (ii ^ 2 + jj ^ 2 < Plateau(k).Radius ^ 2) Then
374.                     tempworldmesh2(i, j, 1) = Plateau(k).Location.z
375.                     tempworldmesh2(i, j, 2) = 1 ' fixed
376.                 End If
377.             Next
378.         Next
379.     Next
380.  
381.     ' Relax the world mesh to generate terrain.
382.     Dim SmoothFactor As Integer
383.     SmoothFactor = 30
384.     For k = SmoothFactor To 1 Step -1
385.         For i = 1 To UBound(WorldMesh, 1)
386.             For j = 1 To UBound(WorldMesh, 2)
387.                 tempworldmesh1(i, j) = tempworldmesh2(i, j, 1)
388.                 ' Before last iteration, allow extreme points to relax.
389.                 If (k = 1) Then tempworldmesh2(i, j, 2) = 0
390.             Next
391.         Next
392.         For i = 2 To UBound(WorldMesh, 1) - 1
393.             For j = 2 To UBound(WorldMesh, 2) - 1
394.                 If (tempworldmesh2(i, j, 2) = 0) Then
395.                     tempworldmesh2(i, j, 1) = (1 / 4) * (tempworldmesh1(i - 1, j) + tempworldmesh1(i + 1, j) + tempworldmesh1(i, j - 1) + tempworldmesh1(i, j + 1))
396.                 End If
397.             Next
398.         Next
399.     Next
400.     For i = 1 To UBound(WorldMesh, 1)
401.         For j = 1 To UBound(WorldMesh, 2)
402.             WorldMesh(i, j) = tempworldmesh2(i, j, 1)
403.         Next
404.     Next
405.  
406.     ' Create terrain groups.
407.     Dim g0 As Long
408.     For i = 1 To UBound(WorldMesh, 1)
409.         For j = 1 To UBound(WorldMesh, 2)
410.             u = BlockSize * (i - (UBound(WorldMesh, 1) / 2))
411.             v = BlockSize * (j - (UBound(WorldMesh, 2) / 2))
412.             w = WorldMesh(i, j)
413.             ' Store first address.
414.             If ((i = 1) And (j = 1)) Then g0 = g
415.             g = NewGroup&(g, u, v, w, 10, 0, 0)
416.             Group(g).Label = TerrainHeightLabel$(w)
417.             Group(g).Volume.x = BlockSize
418.             Group(g).Volume.y = BlockSize
419.             Group(g).Volume.z = Sqr(BlockSize * BlockSize + BlockSize * BlockSize)
420.             Group(g).PlotMode = 0
421.             WorldMeshAddress(i, j) = g
422.         Next
423.         Call ClusterPinch(g)
424.     Next
425.     Call ClusterPinch(g)
426.  
427.     CreateTerrainGroups& = g0
428. End Function
429.  
430. Function CreateTerrainVectors& (LagAddressIn As Long)
431.     Dim g As Long
432.     Dim As Integer i, j, k
433.     Dim As Integer ii, jj
434.     Dim Smoothfactor As Integer
435.     g = LagAddressIn
436.  
437.     ' Create fine-grain block mesh to relax terrain.
438.     Dim vindex As Long
439.     Dim BlockBins As Integer
440.     BlockBins = BlockSize / BlockStep
441.     Dim blockmesh1(BlockBins, BlockBins)
442.     Dim blockmesh2(BlockBins, BlockBins, 2)
443.     vindex = Group(Group(g).Lagger).LastVector
444.     For i = 1 To UBound(WorldMesh, 1)
445.         For j = 1 To UBound(WorldMesh, 2)
446.  
447.             g = WorldMeshAddress(i, j)
448.             Group(g).FirstVector = vindex + 1
449.  
450.             ' For each world mesh location, use the block mesh whose boundary heights are determined by neighbors.
451.             For ii = 1 To UBound(blockmesh2, 1)
452.                 For jj = 1 To UBound(blockmesh2, 2)
453.  
454.                     ' Lock boundaries.
455.                     If (ii = 1) Or (ii = UBound(blockmesh2, 1)) Then
456.                         blockmesh2(ii, jj, 2) = 1
457.                     End If
458.                     If (jj = 1) Or (jj = UBound(blockmesh2, 2)) Then
459.                         blockmesh2(ii, jj, 2) = 1
460.                     End If
461.  
462.                     ' Set boundary values.
463.                     If (i > 1) Then
464.                         If (ii = 1) Then
465.                             blockmesh2(ii, jj, 1) = -WorldMesh(i, j) + (1 / 2) * (WorldMesh(i, j) + WorldMesh(i - 1, j))
466.                         End If
467.                     End If
468.                     If (j > 1) Then
469.                         If (jj = 1) Then
470.                             blockmesh2(ii, jj, 1) = -WorldMesh(i, j) + (1 / 2) * (WorldMesh(i, j) + WorldMesh(i, j - 1))
471.                         End If
472.                     End If
473.                     If (i < UBound(WorldMesh, 1)) Then
474.                         If (ii = UBound(blockmesh2, 1)) Then
475.                             blockmesh2(ii, jj, 1) = -WorldMesh(i, j) + (1 / 2) * (WorldMesh(i, j) + WorldMesh(i + 1, j))
476.                         End If
477.                     End If
478.                     If (j < UBound(WorldMesh, 2)) Then
479.                         If (jj = UBound(blockmesh2, 2)) Then
480.                             blockmesh2(ii, jj, 1) = -WorldMesh(i, j) + (1 / 2) * (WorldMesh(i, j) + WorldMesh(i, j + 1))
481.                         End If
482.                     End If
483.  
484.                     ' Set extreme points.
485.                     If ((ii > 1) And (ii < UBound(blockmesh2, 1)) And (jj > 1) And (jj < UBound(blockmesh2, 1))) Then
486.                         Select Case Rnd
487.                             Case Is < .01
488.                                 blockmesh2(ii, jj, 1) = -Rnd * 20
489.                                 blockmesh2(ii, jj, 2) = 1 ' fixed
490.                             Case Is > .99
491.                                 blockmesh2(ii, jj, 1) = Rnd * 20
492.                                 blockmesh2(ii, jj, 2) = 1 ' fixed
493.                             Case Else
494.                                 blockmesh2(ii, jj, 1) = 0
495.                                 blockmesh2(ii, jj, 2) = 0 'free
496.                         End Select
497.                     End If
498.  
499.                     ' Copy mesh.
500.                     blockmesh1(ii, jj) = blockmesh2(ii, jj, 1)
501.  
502.                 Next
503.             Next
504.  
505.             ' Relax mesh body.
506.             Smoothfactor = 30
507.             For k = Smoothfactor To 1 Step -1
508.                 For ii = 2 To UBound(blockmesh1, 1) - 1
509.                     For jj = 2 To UBound(blockmesh1, 2) - 1
510.                         ' Before last iteration, allow extreme points to relax.
511.                         If (k = 5) Then blockmesh2(ii, jj, 2) = 0
512.                         If (blockmesh2(ii, jj, 2) = 0) Then
513.                             blockmesh2(ii, jj, 1) = (1 / 4) * (blockmesh1(ii - 1, jj) + blockmesh1(ii + 1, jj) + blockmesh1(ii, jj - 1) + blockmesh1(ii, jj + 1))
514.                         End If
515.                     Next
516.                 Next
517.  
518.                 ' Upate mesh with relaxed version.
519.                 For ii = 1 To UBound(blockmesh1, 1)
520.                     For jj = 1 To UBound(blockmesh1, 2)
521.                         blockmesh1(ii, jj) = blockmesh2(ii, jj, 1)
522.                     Next
523.                 Next
524.             Next
525.  
526.             ' Relax mesh boundaries once.
527.             For ii = 2 To UBound(blockmesh1, 1) - 1
528.                 jj = 1
529.                 blockmesh2(ii, jj, 1) = (1 / 3) * (blockmesh1(ii - 1, jj) + blockmesh1(ii + 1, jj) + blockmesh1(ii, jj + 1))
530.                 jj = UBound(blockmesh1, 2)
531.                 blockmesh2(ii, jj, 1) = (1 / 3) * (blockmesh1(ii - 1, jj) + blockmesh1(ii + 1, jj) + blockmesh1(ii, jj - 1))
532.             Next
533.             For jj = 2 To UBound(blockmesh1, 2) - 1
534.                 ii = 1
535.                 blockmesh2(ii, jj, 1) = (1 / 3) * (blockmesh1(ii + 1, jj) + blockmesh1(ii, jj - 1) + blockmesh1(ii, jj + 1))
536.                 ii = UBound(blockmesh1, 1)
537.                 blockmesh2(ii, jj, 1) = (1 / 3) * (blockmesh1(ii - 1, jj) + blockmesh1(ii, jj - 1) + blockmesh1(ii, jj + 1))
538.             Next
539.  
540.             ii = 1
541.             jj = 1
542.             blockmesh2(ii, jj, 1) = (1 / 2) * (blockmesh1(ii + 1, jj) + blockmesh1(ii, jj + 1))
543.  
544.             ii = UBound(blockmesh1, 1)
545.             jj = UBound(blockmesh1, 2)
546.             blockmesh2(ii, jj, 1) = (1 / 2) * (blockmesh1(ii - 1, jj) + blockmesh1(ii, jj - 1))
547.  
548.             ii = 1
549.             jj = UBound(blockmesh1, 2)
550.             blockmesh2(ii, jj, 1) = (1 / 2) * (blockmesh1(ii + 1, jj) + blockmesh1(ii, jj - 1))
551.  
552.             ii = UBound(blockmesh1, 1)
553.             jj = 1
554.             blockmesh2(ii, jj, 1) = (1 / 2) * (blockmesh1(ii - 1, jj) + blockmesh1(ii, jj + 1))
555.  
556.             ' Upate mesh with relaxed version.
557.             For ii = 1 To UBound(blockmesh1, 1)
558.                 For jj = 1 To UBound(blockmesh1, 2)
559.                     blockmesh1(ii, jj) = blockmesh2(ii, jj, 1)
560.                 Next
561.             Next
562.  
563.             ' Set particle positions relative to group center. Add random fuzz.
564.             Dim cc As _Unsigned Long
565.             Dim dd As _Unsigned Long
566.             For ii = 1 To UBound(blockmesh1, 1)
567.                 For jj = 1 To UBound(blockmesh1, 2)
568.                     vindex = vindex + 1
569.                     vec3Dpos(vindex).x = BlockStep * ii - BlockSize / 2 + 3 * (Rnd - .5)
570.                     vec3Dpos(vindex).y = BlockStep * jj - BlockSize / 2 + 3 * (Rnd - .5)
571.                     vec3Dpos(vindex).z = blockmesh1(ii, jj)
572.                     cc = TerrainHeightShade~&(WorldMesh(i, j) + blockmesh1(ii, jj))
573.                     dd = TerrainHeightShade~&(WorldMesh(i, j) + blockmesh1(ii, jj) + BlockSize)
574.                     vec3Dcolor(vindex) = ShadeMix~&(cc, ShadeMix~&(cc, dd, blockmesh1(ii, jj) / 10), .5)
575.                 Next
576.             Next
577.  
578.             Group(g).LastVector = vindex + 1 ''' why on earth is this +1?
579.         Next
580.     Next
581.  
582.     CreateTerrainVectors& = g
583. End Function
584.  
585. Function CreateTerrainVolume& (LagAddressIn As Long)
586.     Dim g As Long
587.     Dim As Integer i, j
588.     Dim k As Long
589.     Dim As Double u, v, z
590.     Dim groupcount As Integer
591.     Dim clustertick As Integer
592.     g = LagAddressIn
593.     groupcount = 0
594.     clustertick = 0
595.     For i = 1 To UBound(WorldMesh, 1)
596.         For j = 1 To UBound(WorldMesh, 2)
597.             z = WorldMesh(i, j) + BlockSize / 2
598.             If (z < 0) Then
599.                 groupcount = groupcount + 1
600.                 u = BlockSize * (i - (UBound(WorldMesh, 1) / 2))
601.                 v = BlockSize * (j - (UBound(WorldMesh, 2) / 2))
602.                 g = NewCube&(g, "Water", 50, u, v, WorldMesh(i, j) - z / 2, BlockSize, BlockSize, -z, Blue, RoyalBlue, DarkBlue, 0, 0)
603.                 For k = Group(g).FirstVector To Group(g).LastVector
604.                     vec3Dvel(k).x = (Rnd - .5) * .20
605.                     vec3Dvel(k).y = (Rnd - .5) * .20
606.                     vec3Dvel(k).z = 0
607.                 Next
608.             End If
609.             clustertick = clustertick + 1
610.             If (clustertick = 12) Then
611.                 clustertick = 0
612.                 If (groupcount > 0) Then
613.                     groupcount = 0
614.                     Call ClusterPinch(g)
615.                 End If
616.             End If
617.         Next
618.         Call ClusterPinch(g)
619.     Next
620.     Call ClusterPinch(g)
621.  
622.     groupcount = 0
623.     clustertick = 0
624.     For i = 1 To UBound(WorldMesh, 1)
625.         For j = 1 To UBound(WorldMesh, 2)
626.             z = WorldMesh(i, j) + BlockSize / 2
627.             If (z > 0) Then
628.                 groupcount = groupcount + 1
629.                 u = BlockSize * (i - (UBound(WorldMesh, 1) / 2))
630.                 v = BlockSize * (j - (UBound(WorldMesh, 2) / 2))
631.                 g = NewCube&(g, "Dirt and Sand", 20, u, v, WorldMesh(i, j) / 2 - BlockSize / 4, BlockSize, BlockSize, WorldMesh(i, j), SaddleBrown, DarkKhaki, Sienna, 0, 0)
632.                 g = NewCube&(g, "Dirt and Sand", 20, u, v, -50, BlockSize, BlockSize, 80, SaddleBrown, DarkKhaki, Sienna, 0, 0)
633.             End If
634.             clustertick = clustertick + 1
635.             If (clustertick = 12) Then
636.                 clustertick = 0
637.                 If (groupcount > 0) Then
638.                     groupcount = 0
639.                     Call ClusterPinch(g)
640.                 End If
641.             End If
642.         Next
643.         Call ClusterPinch(g)
644.     Next
645.     Call ClusterPinch(g)
646.  
647.     groupcount = 0
648.     clustertick = 0
649.     For i = 1 To UBound(WorldMesh, 1)
650.         For j = 1 To UBound(WorldMesh, 2)
651.             groupcount = groupcount + 1
652.             u = BlockSize * (i - (UBound(WorldMesh, 1) / 2))
653.             v = BlockSize * (j - (UBound(WorldMesh, 2) / 2))
654.             z = WorldMesh(i, j)
655.             If (z < 0) Then z = 0
656.             g = NewCube&(g, "Atmospheric Dust", 30, u, v, 100 + BlockSize * (3 - 1 / 2) + z, BlockSize, BlockSize, BlockSize * 3, DarkGray, White, Snow, 0, 0)
657.             clustertick = clustertick + 1
658.             If (clustertick = 12) Then
659.                 clustertick = 0
660.                 If (groupcount > 0) Then
661.                     groupcount = 0
662.                     Call ClusterPinch(g)
663.                 End If
664.             End If
665.         Next
666.         Call ClusterPinch(g)
667.     Next
668.     Call ClusterPinch(g)
669.  
670.     CreateTerrainVolume& = g
671. End Function
672.  
673. Function CreateTornado& (LagAddressIn As Long)
674.     Dim As Integer n, k
675.     Dim As Double u, v, w, x0, y0, z0
676.     Dim As Long p, g
677.     Dim wi As Integer
678.     Dim wj As Integer
679.     g = LagAddressIn
680.     For n = 1 To 4
681.         u = Rnd * 2 * pi
682.         FixedPathIndexTicker = FixedPathIndexTicker + 1
683.         For p = 1 To 86400
684.             x0 = BlockSize * 30 * Cos(u + 2 * pi * (6 * 30) * (p - 1) / 86400)
685.             y0 = BlockSize * 30 * Sin(u + 2 * pi * (6 * 30) * (p - 1) / 86400)
686.             FixedPath(FixedPathIndexTicker, p).x = x0
687.             FixedPath(FixedPathIndexTicker, p).y = y0
688.             wi = 1 + Int(x0 / BlockSize + UBound(WorldMesh, 1) / 2)
689.             wj = 1 + Int(y0 / BlockSize + UBound(WorldMesh, 2) / 2)
690.             z0 = WorldMesh(wi, wj)
691.             If (z0 < 0) Then z0 = 0
692.             FixedPath(FixedPathIndexTicker, p).z = z0 + 50
693.         Next
694.         For k = 1 To 30
695.             u = Rnd * 100
696.             v = Rnd * u / 3
697.             w = Rnd * 2 * pi
698.             g = NewCube&(g, "Tornado", 35, v * Cos(w), v * Sin(w), u, 15, 15, 15, DarkGray, SunsetOrange, DarkGoldenRod, FixedPathIndexTicker, 0)
699.             Call SetParticleVelocity(g, -Sin(w), Cos(w), 0)
700.         Next
701.         Call ClusterPinch(g)
702.     Next
703.     CreateTornado& = g
704. End Function
705.  
706. Function CreateWeather& (LagAddressIn As Long)
707.     Dim As Integer n, k
708.     Dim As Double u, v, w, x0, y0, z0, tallness
709.     Dim As Long p, g
710.     Dim wi As Integer
711.     Dim wj As Integer
712.     g = LagAddressIn
713.     For n = 1 To 100
714.         FixedPathIndexTicker = FixedPathIndexTicker + 1
715.         u = Rnd * 2 * pi
716.         v = Rnd * .7 * BlockSize * Sqr((UBound(WorldMesh, 1) / 2) ^ 2 + (UBound(WorldMesh, 2) / 2) ^ 2)
717.         w = pi / 2
718.         tallness = Rnd * (CloudLayer(UBound(CloudLayer)).Height - CloudLayer(1).Height)
719.         For p = 1 To 86400
720.             x0 = v * Cos(u + 2 * pi * (1 * 30) * (p - 1) / 86400 + w)
721.             y0 = v * Sin(u + 4 * pi * (1 * 30) * (p - 1) / 86400)
722.             FixedPath(FixedPathIndexTicker, p).x = x0
723.             FixedPath(FixedPathIndexTicker, p).y = y0
724.             wi = 1 + Int(x0 / BlockSize + UBound(WorldMesh, 1) / 2)
725.             wj = 1 + Int(y0 / BlockSize + UBound(WorldMesh, 2) / 2)
726.             z0 = WorldMesh(wi, wj)
727.             If (z0 < 0) Then z0 = 0
728.             z0 = z0 + CloudLayer(1).Height + tallness
729.             FixedPath(FixedPathIndexTicker, p).z = z0
730.         Next
731.         For k = 1 To 20 '30
732.             u = Rnd * 80
733.             v = u
734.             w = Rnd * 2 * pi
735.             z0 = z0 + 10 * (Rnd - .5)
736.             g = NewCube&(g, CloudHeightLabel$(z0), 20, v * Cos(w), v * Sin(w), z0, BlockSize / 2, BlockSize / 2, BlockSize / 2, Red, Red, Red, FixedPathIndexTicker, 0)
737.             Call SetParticleVelocity(g, .01 * (Rnd - .5), .01 * (Rnd - .5), 0)
738.             For p = Group(g).FirstVector To Group(g).LastVector
739.                 vec3Dcolor(p) = CloudHeightShade~&(Group(g).Centroid.z + vec3Dpos(p).z)
740.             Next
741.             Group(g).PlotMode = 0
742.  
743.             If (Rnd < .2) Then
744.                 z0 = Group(g).Centroid.z
745.                 g = NewCube&(g, "Rain", 20, v * Cos(w), v * Sin(w), z0 / 2 - BlockSize / 2, BlockSize / 2, BlockSize / 2, z0, Blue, RoyalBlue, DodgerBlue, 0, 0)
746.                 Call SetParticleVelocity(g, 0, 0, -1)
747.             End If
748.  
749.         Next
750.         Call ClusterPinch(g)
751.     Next
752.     CreateWeather& = g
753. End Function
754.  
755. Function CreateClover& (LagAddressIn As Long)
756.     Dim As Long g, vindex
757.     Dim As Integer i, j
758.     Dim As Double x, y, z, u, t
759.     Dim As Integer pedals
760.     Dim As Double scale
761.     Dim As Double height
762.     g = LagAddressIn
763.     For i = 1 To UBound(WorldMesh, 1)
764.         For j = 1 To UBound(WorldMesh, 2)
765.             z = WorldMesh(i, j)
766.             If (TerrainHeightIndex(z) = 1) Then
767.                 If (Rnd < .1) Then
768.                     x = (Rnd - .5) * BlockSize + BlockSize * (i - (UBound(WorldMesh, 1) / 2))
769.                     y = (Rnd - .5) * BlockSize + BlockSize * (j - (UBound(WorldMesh, 2) / 2))
770.                     scale = 1 / (4 + Rnd * 3)
771.                     g = NewGroup&(g, x, y, z, 12, 0, 0)
772.                     Group(g).Label = "Clover"
773.                     Group(g).Volume.x = BlockSize
774.                     Group(g).Volume.y = BlockSize
775.                     Group(g).Volume.z = BlockSize
776.                     vindex = Group(Group(g).Lagger).LastVector
777.                     Group(g).FirstVector = vindex + 1
778.                     Group(g).PlotMode = 1
779.                     pedals = 2 + Int(Rnd * 4)
780.                     height = 2 + Rnd
781.                     t = Rnd * 2 * pi
782.                     For u = 0 To 2 * pi Step .1
783.                         vindex = vindex + 1
784.                         vec3Dpos(vindex).x = scale * ((Group(g).Volume.x) * (0 + Cos(pedals * u) * Cos(u))) * Cos(t)
785.                         vec3Dpos(vindex).y = scale * ((Group(g).Volume.y) * (0 + Cos(pedals * u) * Cos(u))) * Sin(t)
786.                         vec3Dpos(vindex).z = scale * ((Group(g).Volume.z) * (height + Cos(pedals * u) * Sin(u)))
787.                         Select Case pedals
788.                             Case 3
789.                                 vec3Dcolor(vindex) = Magenta
790.                             Case Else
791.                                 vec3Dcolor(vindex) = Lime
792.                         End Select
793.                     Next
794.                     For u = (Group(g).Volume.z) * height To 0 Step -(Group(g).Volume.z) * height / 10
795.                         vindex = vindex + 1
796.                         vec3Dpos(vindex).x = scale * (0 + (Rnd - .5))
797.                         vec3Dpos(vindex).y = scale * (0 + (Rnd - .5))
798.                         vec3Dpos(vindex).z = scale * (u)
799.                         vec3Dcolor(vindex) = LimeGreen
800.                     Next
801.                     Group(g).LastVector = vindex '''+ 1 ''' why on earth is this +1?
802.                     Call ClusterPinch(g)
803.                 End If
804.             End If
805.         Next
806.     Next
807.     CreateClover& = g
808. End Function
809.  
810. Function CreateGrass& (LagAddressIn As Long)
811.     Dim As Long g, vindex
812.     Dim As Integer i, j, k
813.     Dim As Double x0, y0, x, y, z, u, t
814.     Dim As Double scale
815.     Dim As Double height
816.     g = LagAddressIn
817.     For i = 1 To UBound(WorldMesh, 1)
818.         For j = 1 To UBound(WorldMesh, 2)
819.             z = WorldMesh(i, j)
820.             If (TerrainHeightIndex(z) = 2) Then
821.                 For k = 1 To 5
822.                     If (Rnd < .5) Then
823.                         x = (Rnd - .5) * BlockSize + BlockSize * (i - (UBound(WorldMesh, 1) / 2))
824.                         y = (Rnd - .5) * BlockSize + BlockSize * (j - (UBound(WorldMesh, 2) / 2))
825.                         scale = 1 / (4 + Rnd * 3)
826.                         g = NewGroup&(g, x, y, z, 16, 0, 0)
827.                         Group(g).Label = "Grass"
828.                         Group(g).Volume.x = BlockSize
829.                         Group(g).Volume.y = BlockSize
830.                         Group(g).Volume.z = BlockSize
831.                         vindex = Group(Group(g).Lagger).LastVector
832.                         Group(g).FirstVector = vindex + 1
833.                         Group(g).PlotMode = 1
834.                         height = 1 + Rnd
835.                         t = Rnd * 2 * pi
836.                         x0 = BlockSize * 1 * (Rnd - .5)
837.                         y0 = BlockSize * 1 * (Rnd - .5)
838.                         For u = (Group(g).Volume.z) * height To 0 Step -(Group(g).Volume.z) * height / 5
839.                             vindex = vindex + 1
840.                             vec3Dpos(vindex).x = scale * (x0 + (Rnd - .5))
841.                             vec3Dpos(vindex).y = scale * (y0 + (Rnd - .5))
842.                             vec3Dpos(vindex).z = scale * (u)
843.                             vec3Dcolor(vindex) = ShadeMix~&(DarkGoldenRod, Sienna, Rnd)
844.                         Next
845.                         Group(g).LastVector = vindex '''+ 1 ''' why on earth is this +1?
846.                     End If
847.                 Next
848.             End If
849.         Next
850.         Call ClusterPinch(g)
851.     Next
852.     CreateGrass& = g
853. End Function
854.  
855. Function CreateFern& (LagAddressIn As Long)
856.     Dim As Long g, vindex
857.     Dim As Integer i, j, k
858.     Dim As Double xx, yy, zz, x, y, z, t
859.     Dim As Double scale
860.     g = LagAddressIn
861.     For i = 1 To UBound(WorldMesh, 1)
862.         For j = 1 To UBound(WorldMesh, 2)
863.             z = WorldMesh(i, j)
864.             If (TerrainHeightIndex(z) = 1) Then
865.                 If (Rnd < .1) Then
866.                     x = (Rnd - .5) * BlockSize + BlockSize * (i - (UBound(WorldMesh, 1) / 2))
867.                     y = (Rnd - .5) * BlockSize + BlockSize * (j - (UBound(WorldMesh, 2) / 2))
868.                     scale = .05 + Rnd * .05
869.                     g = NewGroup&(g, x, y, z, 12, 0, 0)
870.                     Group(g).Label = "Fern"
871.                     Group(g).Volume.x = BlockSize
872.                     Group(g).Volume.y = BlockSize
873.                     Group(g).Volume.z = BlockSize
874.                     vindex = Group(Group(g).Lagger).LastVector
875.                     Group(g).FirstVector = vindex + 1
876.                     Group(g).PlotMode = 2
877.                     t = Rnd * 2 * pi
878.                     xx = 0
879.                     yy = xx
880.                     zz = 0
881.                     For k = 1 To 100
882.                         Select Case Rnd * 100
883.                             Case Is < 1
884.                                 xx = 0
885.                                 zz = .16 * zz
886.                             Case Is < 86
887.                                 xx = .85 * xx + .04 * zz
888.                                 zz = -.04 * xx + .85 * zz + 1.6
889.                             Case Is < 93
890.                                 xx = .2 * xx - .26 * zz
891.                                 zz = .23 * xx + .22 * zz + 1.6
892.                             Case Else
893.                                 xx = -.15 * xx + .28 * zz
894.                                 zz = .26 * xx + .24 * zz + .44
895.                         End Select
896.                         yy = xx
897.                         vindex = vindex + 1
898.                         vec3Dpos(vindex).x = scale * Group(g).Volume.x * xx * Cos(t)
899.                         vec3Dpos(vindex).y = scale * Group(g).Volume.y * yy * Sin(t)
900.                         vec3Dpos(vindex).z = scale * Group(g).Volume.z * zz
901.                         vec3Dcolor(vindex) = Lime
902.                     Next
903.                     Group(g).LastVector = vindex '''+ 1 ''' why on earth is this +1?
904.                     Call ClusterPinch(g)
905.                 End If
906.             End If
907.         Next
908.     Next
909.     CreateFern& = g
910. End Function
911.  
912. Function CreateSun& (LagAddressIn As Long)
913.     Dim As Integer k
914.     Dim As Double xx, yy, zz, x0, y0, z0, phase
915.     Dim As Long p, g
916.     g = LagAddressIn
917.     FixedPathIndexTicker = FixedPathIndexTicker + 1
918.     For p = 1 To 86400
919.         phase = -2 * pi * (24) * (p - 1) / 86400 - pi / 2
920.         x0 = 5000 * Cos(phase)
921.         y0 = 0
922.         z0 = 3000 * Sin(phase)
923.         FixedPath(FixedPathIndexTicker, p).x = x0
924.         FixedPath(FixedPathIndexTicker, p).y = y0
925.         FixedPath(FixedPathIndexTicker, p).z = z0
926.     Next
927.     For k = 1 To 30
928.         Do
929.             xx = (Rnd - .5) * 6 * BlockSize
930.             yy = (Rnd - .5) * 6 * BlockSize
931.             zz = (Rnd - .5) * 6 * BlockSize
932.         Loop Until ((xx ^ 2 + yy ^ 2 + zz ^ 2) < (.5 * 6 * BlockSize) ^ 2)
933.         g = NewCube&(g, "Sun", 50, xx, yy, zz, BlockSize * 6, BlockSize * 6, BlockSize * 6, Red, Red, Red, FixedPathIndexTicker, 0)
934.         For p = Group(g).FirstVector To Group(g).LastVector
935.             vec3Dcolor(p) = ShadeMix~&(Sunglow, SunsetOrange, Rnd)
936.         Next
937.         Call SetParticleVelocity(g, .5 * (Rnd - .5), .5 * (Rnd - .5), .5 * (Rnd - .5))
938.         Group(g).PlotMode = 0
939.     Next
940.     SunClusterAddress = ClusterIdTicker
941.     Call ClusterPinch(g)
942.     CreateSun& = g
943. End Function
944.  
945. Function CreateMoon& (LagAddressIn As Long)
946.     Dim As Integer k
947.     Dim As Double xx, yy, zz, x0, y0, z0, phase
948.     Dim As Long p, g
949.     g = LagAddressIn
950.     FixedPathIndexTicker = FixedPathIndexTicker + 1
951.     For p = 1 To 86400
952.         phase = -2 * pi * (48) * (p - 1) / 86400 + pi / 2
953.         x0 = 0
954.         y0 = 4000 * Cos(phase)
955.         z0 = 2000 * Sin(phase)
956.         FixedPath(FixedPathIndexTicker, p).x = x0
957.         FixedPath(FixedPathIndexTicker, p).y = y0
958.         FixedPath(FixedPathIndexTicker, p).z = z0
959.     Next
960.     For k = 1 To 30
961.         Do
962.             xx = (Rnd - .5) * 5 * BlockSize
963.             yy = (Rnd - .5) * 5 * BlockSize
964.             zz = (Rnd - .5) * 5 * BlockSize
965.         Loop Until ((xx ^ 2 + yy ^ 2 + zz ^ 2) < (.5 * 5 * BlockSize) ^ 2)
966.         g = NewCube&(g, "Moon", 50, xx, yy, zz, 5 * BlockSize, 5 * BlockSize, 5 * BlockSize, Gray, DarkGray, SlateGray, FixedPathIndexTicker, 0)
967.         Group(g).PlotMode = 0
968.     Next
969.     MoonClusterAddress = ClusterIdTicker
970.     Call ClusterPinch(g)
971.     CreateMoon& = g
972. End Function
973.  
974. Function CreateFish& (LagAddressIn As Long)
975.     Dim As Integer n, m, wi, wj
976.     Dim As Double u, v, x0, y0, z0
977.     Dim As Long p, g, p0
978.     g = LagAddressIn
979.     For n = 1 To 12
980.         u = Rnd * 2 * pi
981.         FixedPathIndexTicker = FixedPathIndexTicker + 1
982.         For p = 1 To 86400
983.             x0 = BlockSize * Plateau(1).Location.x + BlockSize * (4 + Cos(2 * pi * n / 12)) * Cos(u + 2 * pi * (24 * 30) * (p - 1) / 86400)
984.             y0 = BlockSize * Plateau(1).Location.y + BlockSize * (4 + Cos(2 * pi * n / 12)) * Sin(u + 2 * pi * (24 * 30) * (p - 1) / 86400)
985.             FixedPath(FixedPathIndexTicker, p).x = x0
986.             FixedPath(FixedPathIndexTicker, p).y = y0
987.             wi = 1 + Int(x0 / BlockSize + UBound(WorldMesh, 1) / 2)
988.             wj = 1 + Int(y0 / BlockSize + UBound(WorldMesh, 2) / 2)
989.             z0 = WorldMesh(wi, wj) + 100 + 80 * Cos(2 * pi * n / 12) * Cos(2 * pi * (24 * 30) * (p - 1) / 86400)
990.             FixedPath(FixedPathIndexTicker, p).z = z0
991.         Next
992.         ' In the following group, there are 48 frames with 36 vectors per frame. The +1 offset is fishy, no pun.
993.         g = NewCube&(g, "Fish", 36 * (48 + 1), 0, 0, 0, BlockSize / 4, BlockSize / 4, BlockSize / 4, LimeGreen, SunsetOrange, DarkGoldenRod, FixedPathIndexTicker, 1)
994.         Group(g).FrameLength = 36
995.         u = 0
996.         For p = Group(g).FirstVector To Group(g).FirstVector + Group(g).FrameLength - 1
997.             u = u + 2 * pi / Group(g).FrameLength
998.             vec3Dpos(p).x = Group(g).Volume.x * (Cos(u) - Sin(u) ^ 2 / Sqr(2))
999.             vec3Dpos(p).y = 0
1000.             vec3Dpos(p).z = Group(g).Volume.z * (Cos(u) * Sin(u))
1001.         Next
1002.         v = 0
1003.         For m = 1 To 48
1004.             v = v - 2 * pi / 48
1005.             p0 = 0
1006.             For p = Group(g).FirstVector + Group(g).FrameLength * (m) To Group(g).FirstVector + Group(g).FrameLength * (m + 1) - 1
1007.                 vec3Dpos(p).x = Cos(v) * vec3Dpos(Group(g).FirstVector + p0).x + Sin(v) * vec3Dpos(Group(g).FirstVector + p0).y
1008.                 vec3Dpos(p).y = -Sin(v) * vec3Dpos(Group(g).FirstVector + p0).x + Cos(v) * vec3Dpos(Group(g).FirstVector + p0).y
1009.                 vec3Dpos(p).z = vec3Dpos(Group(g).FirstVector + p0).z
1010.                 p0 = p0 + 1
1011.             Next
1012.         Next
1013.         Call ClusterPinch(g)
1014.     Next
1015.     CreateFish& = g
1016. End Function
1017.  
1018. Sub InitCamera
1019.     ToggleAnimate = 1
1020.     PlayerCamera.Position.x = 0
1021.     PlayerCamera.Position.y = 0
1022.     PlayerCamera.Position.z = 100 + 40 + WorldMesh(UBound(WorldMesh, 1) / 2, UBound(WorldMesh, 2) / 2)
1023.     PlayerCamera.Velocity.x = 0
1024.     PlayerCamera.Velocity.y = 0
1025.     PlayerCamera.Velocity.z = .1
1026.     PlayerCamera.Acceleration.x = 0
1027.     PlayerCamera.Acceleration.y = 0
1028.     PlayerCamera.Acceleration.z = -.5
1029.     uhat(1) = 1: uhat(2) = 0: uhat(3) = 0
1030.     vhat(1) = 0: vhat(2) = 0: vhat(3) = 1
1031.     Call CalculateScreenVectors
1032. End Sub
1033.  
1034. Sub RegulateCamera
1035.     Dim As Double dx, dy, t
1036.     dx = -nhat(1)
1037.     dy = -nhat(2)
1038.     If ((dx > 0) And (dy > 0)) Then t = -pi / 2 + (Atn(dy / dx))
1039.     If ((dx < 0) And (dy > 0)) Then t = -pi / 2 + pi + (Atn(dy / dx))
1040.     If ((dx < 0) And (dy < 0)) Then t = -pi / 2 + pi + (Atn(dy / dx))
1041.     If ((dx > 0) And (dy < 0)) Then t = -pi / 2 + 2 * pi + (Atn(dy / dx))
1042.     uhat(1) = Cos(t): uhat(2) = Sin(t): uhat(3) = 0
1043.     vhat(1) = 0: vhat(2) = 0: vhat(3) = 1
1044.     Call CalculateScreenVectors
1045. End Sub
1046.  
1047. ' Terrain tools.
1048.  
1049. Function TerrainHeightIndex (z0 As Double)
1050.     Dim j As Integer
1051.     Dim h0 As Integer
1052.     h0 = -1
1053.     For j = 1 To UBound(Strata)
1054.         If (z0 <= Strata(j).Height) Then
1055.             h0 = j - 1
1056.             Exit For
1057.         End If
1058.     Next
1059.     If (h0 = -1) Then h0 = UBound(Strata)
1060.     TerrainHeightIndex = h0
1061. End Function
1062.  
1063. Function TerrainHeightShade~& (z0 As Double)
1064.     Dim j As Integer
1065.     Dim h0 As Integer
1066.     h0 = -1
1067.     For j = 1 To UBound(Strata)
1068.         If (z0 <= Strata(j).Height) Then
1069.             h0 = j - 1
1070.             Exit For
1071.         End If
1072.     Next
1073.     If (h0 = -1) Then h0 = UBound(Strata)
1074.     Dim u As Double
1075.     Dim v As Double
1076.     Dim alpha As Double
1077.     Dim sh1 As _Unsigned Long
1078.     Dim sh2 As _Unsigned Long
1079.     Select Case h0
1080.         Case 0
1081.             sh1 = Strata(1).Shade
1082.             sh2 = Strata(1).Shade
1083.             alpha = 0
1084.         Case UBound(Strata)
1085.             sh1 = Strata(h0).Shade
1086.             sh2 = Strata(h0).Shade
1087.             alpha = 0
1088.         Case Else
1089.             sh1 = Strata(h0).Shade
1090.             sh2 = Strata(h0 + 1).Shade
1091.             u = z0 - Strata(h0).Height
1092.             v = Strata(h0 + 1).Height - Strata(h0).Height
1093.             alpha = u / v
1094.     End Select
1095.     TerrainHeightShade~& = ShadeMix~&(sh1, sh2, alpha)
1096. End Function
1097.  
1098. Function TerrainHeightLabel$ (z0 As Double)
1099.     Dim TheReturn As String
1100.     Dim j As Integer
1101.     Dim h0 As Integer
1102.     h0 = -1
1103.     For j = 1 To UBound(Strata)
1104.         If (z0 <= Strata(j).Height) Then
1105.             h0 = j
1106.             Exit For
1107.         End If
1108.     Next
1109.     If (h0 = -1) Then h0 = UBound(Strata)
1110.     Select Case h0
1111.         Case 0
1112.             TheReturn = Strata(1).Label
1113.         Case UBound(Strata)
1114.             TheReturn = Strata(h0).Label
1115.         Case Else
1116.             TheReturn = Strata(h0).Label
1117.     End Select
1118.     TerrainHeightLabel$ = TheReturn
1119. End Function
1120.  
1121. Function CloudHeightShade~& (z0 As Double)
1122.     Dim j As Integer
1123.     Dim h0 As Integer
1124.     h0 = -1
1125.     For j = 1 To UBound(CloudLayer)
1126.         If (z0 <= CloudLayer(j).Height) Then
1127.             h0 = j - 1
1128.             Exit For
1129.         End If
1130.     Next
1131.     If (h0 = -1) Then h0 = UBound(CloudLayer)
1132.     Dim u As Double
1133.     Dim v As Double
1134.     Dim alpha As Double
1135.     Dim sh1 As _Unsigned Long
1136.     Dim sh2 As _Unsigned Long
1137.     Select Case h0
1138.         Case 0
1139.             sh1 = CloudLayer(1).Shade
1140.             sh2 = CloudLayer(1).Shade
1141.             alpha = 0
1142.         Case UBound(CloudLayer)
1143.             sh1 = CloudLayer(h0).Shade
1144.             sh2 = CloudLayer(h0).Shade
1145.             alpha = 0
1146.         Case Else
1147.             sh1 = CloudLayer(h0).Shade
1148.             sh2 = CloudLayer(h0 + 1).Shade
1149.             u = z0 - CloudLayer(h0).Height
1150.             v = CloudLayer(h0 + 1).Height - CloudLayer(h0).Height
1151.             alpha = u / v
1152.     End Select
1153.     CloudHeightShade~& = ShadeMix~&(sh1, sh2, alpha)
1154. End Function
1155.  
1156. Function CloudHeightLabel$ (z0 As Double)
1157.     Dim TheReturn As String
1158.     Dim j As Integer
1159.     Dim h0 As Integer
1160.     h0 = -1
1161.     For j = 1 To UBound(CloudLayer)
1162.         If (z0 <= CloudLayer(j).Height) Then
1163.             h0 = j
1164.             Exit For
1165.         End If
1166.     Next
1167.     If (h0 = -1) Then h0 = UBound(CloudLayer)
1168.     Select Case h0
1169.         Case 0
1170.             TheReturn = CloudLayer(1).Label
1171.         Case UBound(CloudLayer)
1172.             TheReturn = CloudLayer(h0).Label
1173.         Case Else
1174.             TheReturn = CloudLayer(h0).Label
1175.     End Select
1176.     CloudHeightLabel$ = TheReturn
1177. End Function
1178.  
1179. ' Low-order groups.
1180.  
1181. Function NewCube& (LagAddressIn As Long, TheName As String, Weight As Integer, PosX As Double, PosY As Double, PosZ As Double, VolX As Double, VolY As Double, VolZ As Double, ShadeA As _Unsigned Long, ShadeB As _Unsigned Long, ShadeC As _Unsigned Long, TheDynamic As Integer, Framing As Integer)
1182.     Dim k As Integer
1183.     Dim g As Long
1184.     Dim q As Long
1185.     Dim vindex As Long
1186.     q = LagAddressIn
1187.     vindex = Group(q).LastVector
1188.     g = NewGroup&(q, PosX, PosY, PosZ, 64, TheDynamic, Framing)
1189.     Group(g).Label = TheName
1190.     Group(g).Volume.x = VolX
1191.     Group(g).Volume.y = VolY
1192.     Group(g).Volume.z = VolZ
1193.     Group(g).FirstVector = vindex + 1
1194.     Group(g).PlotMode = 1
1195.     For k = 1 To Weight
1196.         vindex = vindex + 1
1197.         vec3Dpos(vindex).x = (Rnd - .5) * VolX
1198.         vec3Dpos(vindex).y = (Rnd - .5) * VolY
1199.         vec3Dpos(vindex).z = (Rnd - .5) * VolZ
1200.         If (Rnd > .5) Then
1201.             vec3Dcolor(vindex) = ShadeA
1202.         Else
1203.             If (Rnd > .5) Then
1204.                 vec3Dcolor(vindex) = ShadeB
1205.             Else
1206.                 vec3Dcolor(vindex) = ShadeC
1207.             End If
1208.         End If
1209.     Next
1210.     Group(g).LastVector = vindex
1211.     NewCube& = g
1212. End Function
1213.  
1214. Function NewWireCube& (LagAddressIn As Long, TheName As String, PosX As Double, PosY As Double, PosZ As Double, VolX As Double, VolY As Double, VolZ As Double, ShadeA As _Unsigned Long, TheDynamic As Integer)
1215.     Dim g As Long
1216.     Dim q As Long
1217.     Dim vindex As Long
1218.     q = LagAddressIn
1219.     vindex = Group(q).LastVector
1220.     g = NewGroup&(q, PosX, PosY, PosZ, 64, TheDynamic, 0)
1221.     Group(g).Label = TheName
1222.     Group(g).Volume.x = VolX
1223.     Group(g).Volume.y = VolY
1224.     Group(g).Volume.z = VolZ
1225.     Group(g).FirstVector = vindex + 1
1226.     Group(g).PlotMode = -1
1227.  
1228.     vindex = vindex + 1
1229.     vec3Dpos(vindex).x = (0 - .5) * VolX
1230.     vec3Dpos(vindex).y = (0 - .5) * VolY
1231.     vec3Dpos(vindex).z = (0 - .5) * VolZ
1232.     vec3Dcolor(vindex) = ShadeA
1233.     vindex = vindex + 1
1234.     vec3Dpos(vindex).x = (1 - .5) * VolX
1235.     vec3Dpos(vindex).y = (0 - .5) * VolY
1236.     vec3Dpos(vindex).z = (0 - .5) * VolZ
1237.     vec3Dcolor(vindex) = ShadeA
1238.     vindex = vindex + 1
1239.     vec3Dpos(vindex).x = (0 - .5) * VolX
1240.     vec3Dpos(vindex).y = (1 - .5) * VolY
1241.     vec3Dpos(vindex).z = (0 - .5) * VolZ
1242.     vec3Dcolor(vindex) = ShadeA
1243.     vindex = vindex + 1
1244.     vec3Dpos(vindex).x = (1 - .5) * VolX
1245.     vec3Dpos(vindex).y = (1 - .5) * VolY
1246.     vec3Dpos(vindex).z = (0 - .5) * VolZ
1247.     vec3Dcolor(vindex) = ShadeA
1248.  
1249.     vindex = vindex + 1
1250.     vec3Dpos(vindex).x = (0 - .5) * VolX
1251.     vec3Dpos(vindex).y = (0 - .5) * VolY
1252.     vec3Dpos(vindex).z = (1 - .5) * VolZ
1253.     vec3Dcolor(vindex) = ShadeA
1254.     vindex = vindex + 1
1255.     vec3Dpos(vindex).x = (1 - .5) * VolX
1256.     vec3Dpos(vindex).y = (0 - .5) * VolY
1257.     vec3Dpos(vindex).z = (1 - .5) * VolZ
1258.     vec3Dcolor(vindex) = ShadeA
1259.     vindex = vindex + 1
1260.     vec3Dpos(vindex).x = (0 - .5) * VolX
1261.     vec3Dpos(vindex).y = (1 - .5) * VolY
1262.     vec3Dpos(vindex).z = (1 - .5) * VolZ
1263.     vec3Dcolor(vindex) = ShadeA
1264.     vindex = vindex + 1
1265.     vec3Dpos(vindex).x = (1 - .5) * VolX
1266.     vec3Dpos(vindex).y = (1 - .5) * VolY
1267.     vec3Dpos(vindex).z = (1 - .5) * VolZ
1268.     vec3Dcolor(vindex) = ShadeA
1269.  
1270.     Group(g).LastVector = vindex
1271.     NewWireCube& = g
1272. End Function
1273.  
1274. ' Linked list utility.
1275.  
1276. Function LatestGroupIdentity& (StartingID As Long)
1277.     Dim TheReturn As Long
1278.     Dim As Long p, q
1279.     p = StartingID
1280.     If (p = 0) Then
1281.         q = 0
1282.     Else
1283.         Do
1284.             q = p
1285.             p = Group(q).Pointer
1286.             If (p = -999) Then Exit Do
1287.         Loop
1288.     End If
1289.     TheReturn = q
1290.     LatestGroupIdentity& = TheReturn
1291. End Function
1292.  
1293. Function LatestClusterIdentity& (StartingID As Long)
1294.     Dim TheReturn As Long
1295.     Dim As Long p, q
1296.     p = StartingID
1297.     If (p = 0) Then
1298.         q = 0
1299.     Else
1300.         Do
1301.             q = p
1302.             p = Cluster(q).Pointer
1303.             If (p = -999) Then Exit Do
1304.         Loop
1305.     End If
1306.     TheReturn = q
1307.     LatestClusterIdentity& = TheReturn
1308. End Function
1309.  
1310. Function NewGroup& (LagAddressIn As Long, CenterX As Double, CenterY As Double, CenterZ As Double, ClusterSize As Integer, TheDynamic As Integer, Framing As Integer)
1311.     Dim As Long g0
1312.     g0 = LatestGroupIdentity&(LagAddressIn)
1313.     GroupIdTicker = GroupIdTicker + 1
1314.     Group(GroupIdTicker).Identity = GroupIdTicker
1315.     Group(GroupIdTicker).Pointer = -999
1316.     Group(GroupIdTicker).Lagger = g0
1317.     Group(GroupIdTicker).Centroid.x = CenterX
1318.     Group(GroupIdTicker).Centroid.y = CenterY
1319.     Group(GroupIdTicker).Centroid.z = CenterZ
1320.     Group(GroupIdTicker).FrameLength = 0
1321.     Group(GroupIdTicker).ActiveFrame = 0
1322.     If (Group(GroupIdTicker).Lagger <> 0) Then
1323.         Group(g0).Pointer = GroupIdTicker
1324.     End If
1325.  
1326.     ' Adjust corresponding cluster.
1327.     ClusterFillCounter = ClusterFillCounter + 1
1328.     If (ClusterFillCounter = 1) Then
1329.         Call NewCluster(1, Group(GroupIdTicker).Identity, TheDynamic, Framing) '''
1330.     End If
1331.     If (ClusterFillCounter = ClusterSize) Then
1332.         Call ClusterPinch(Group(GroupIdTicker).Identity)
1333.     End If
1334.  
1335.     NewGroup& = Group(GroupIdTicker).Identity
1336. End Function
1337.  
1338.  
1339. Sub NewCluster (ClusterLagIn As Long, FirstGroupIn As Long, TheDynamic As Integer, Framing As Integer)
1340.     Dim As Long k0
1341.     If (ClusterIdTicker = 0) Then
1342.         k0 = -1
1343.     Else
1344.         k0 = LatestClusterIdentity&(ClusterLagIn)
1345.     End If
1346.     ClusterIdTicker = ClusterIdTicker + 1
1347.     Cluster(ClusterIdTicker).Identity = ClusterIdTicker
1348.     Cluster(ClusterIdTicker).Pointer = -999
1349.     Cluster(ClusterIdTicker).Lagger = k0
1350.     Cluster(ClusterIdTicker).FirstGroup = FirstGroupIn
1351.     Cluster(ClusterIdTicker).MotionType = TheDynamic
1352.     Cluster(ClusterIdTicker).Framed = Framing
1353.     If (ClusterIdTicker > 1) Then Cluster(k0).Pointer = ClusterIdTicker
1354. End Sub
1355.  
1356.  
1357.  
1358. Sub RemoveGroup (TheAddressIn As Long)
1359.     Dim As Long g, p, l, k, ci
1360.     Dim As Integer f
1361.     g = TheAddressIn
1362.  
1363.     f = 0
1364.     k = 1
1365.     Do
1366.         If (Cluster(k).FirstGroup = g) And (Cluster(k).LastGroup <> g) Then
1367.             f = 1
1368.             ci = k
1369.             Exit Do
1370.         End If
1371.         If (Cluster(k).FirstGroup <> g) And (Cluster(k).LastGroup = g) Then
1372.             f = 2
1373.             ci = k
1374.             Exit Do
1375.         End If
1376.         If ((Cluster(k).LastGroup = g) And (Cluster(k).LastGroup = g)) Then
1377.             f = 3
1378.             ci = k
1379.             Exit Do
1380.         End If
1381.         k = Cluster(k).Pointer
1382.         If (k = -999) Then Exit Do
1383.     Loop
1384.  
1385.     Select Case f
1386.         Case 0
1387.             p = Group(g).Pointer
1388.             l = Group(g).Lagger
1389.             Group(l).Pointer = p
1390.             If (p <> -999) Then
1391.                 Group(p).Lagger = l
1392.             End If
1393.  
1394.         Case 1
1395.             p = Group(g).Pointer
1396.             l = Group(g).Lagger
1397.             Group(l).Pointer = p
1398.             If (p <> -999) Then
1399.                 Group(p).Lagger = l
1400.             End If
1401.  
1402.             Cluster(ci).FirstGroup = p
1403.             Call ClusterCentroidCalc(ci)
1404.         Case 2
1405.             p = Group(g).Pointer
1406.             l = Group(g).Lagger
1407.             Group(l).Pointer = p
1408.             If (p <> -999) Then
1409.                 Group(p).Lagger = l
1410.             End If
1411.  
1412.             Cluster(ci).LastGroup = l
1413.             Call ClusterCentroidCalc(ci)
1414.         Case 3
1415.             p = Group(g).Pointer
1416.             l = Group(g).Lagger
1417.             Group(l).Pointer = p
1418.             If (p <> -999) Then
1419.                 Group(p).Lagger = l
1420.             End If
1421.  
1422.             Call RemoveCluster(ci)
1423.     End Select
1424. End Sub
1425.  
1426. Sub RemoveCluster (TheAddressIn As Long)
1427.     Dim As Long k, p, l
1428.     k = TheAddressIn
1429.     p = Cluster(k).Pointer
1430.     l = Cluster(k).Lagger
1431.     If (l <> -1) Then
1432.         Cluster(l).Pointer = p
1433.     End If
1434.     If (p <> -999) Then
1435.         Cluster(p).Lagger = l
1436.     End If
1437. End Sub
1438.  
1439. Sub ClusterPinch (TheLastGroup As Long)
1440.     ClusterFillCounter = 0
1441.     Cluster(ClusterIdTicker).LastGroup = TheLastGroup
1442.     Call ClusterCentroidCalc(ClusterIdTicker)
1443. End Sub
1444.  
1445. Sub ClusterCentroidCalc (TheCluster As Long)
1446.     Dim As Long g
1447.     Dim As Integer n
1448.     Cluster(TheCluster).Centroid.x = 0
1449.     Cluster(TheCluster).Centroid.y = 0
1450.     Cluster(TheCluster).Centroid.z = 0
1451.     g = Cluster(TheCluster).FirstGroup
1452.     n = 0
1453.     Do
1454.         Cluster(TheCluster).Centroid.x = Cluster(TheCluster).Centroid.x + Group(g).Centroid.x
1455.         Cluster(TheCluster).Centroid.y = Cluster(TheCluster).Centroid.y + Group(g).Centroid.y
1456.         Cluster(TheCluster).Centroid.z = Cluster(TheCluster).Centroid.z + Group(g).Centroid.z
1457.         n = n + 1
1458.         If (g = Cluster(TheCluster).LastGroup) Then Exit Do
1459.         g = Group(g).Pointer
1460.     Loop
1461.     Cluster(TheCluster).Centroid.x = Cluster(TheCluster).Centroid.x / n
1462.     Cluster(TheCluster).Centroid.y = Cluster(TheCluster).Centroid.y / n
1463.     Cluster(TheCluster).Centroid.z = Cluster(TheCluster).Centroid.z / n
1464. End Sub
1465.  
1466. ' Player Dynamics
1467.  
1468. Sub PlayerDynamics
1469.     If (ToggleAnimate = 1) Then
1470.  
1471.         ' Player kinematics
1472.         PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + PlayerCamera.Acceleration.x
1473.         PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + PlayerCamera.Acceleration.y
1474.         PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + PlayerCamera.Acceleration.z
1475.         PlayerCamera.Velocity.x = .95 * PlayerCamera.Velocity.x
1476.         PlayerCamera.Velocity.y = .95 * PlayerCamera.Velocity.y
1477.         PlayerCamera.Velocity.z = .95 * PlayerCamera.Velocity.z
1478.         PlayerCamera.Position.x = PlayerCamera.Position.x + PlayerCamera.Velocity.x
1479.         PlayerCamera.Position.y = PlayerCamera.Position.y + PlayerCamera.Velocity.y
1480.         PlayerCamera.Position.z = PlayerCamera.Position.z + PlayerCamera.Velocity.z
1481.  
1482.         ' Terrain traversal.
1483.         Dim As Double qi, qj
1484.         Dim As Integer wi, wj
1485.         qi = (PlayerCamera.Position.x) / BlockSize + UBound(WorldMesh, 1) / 2
1486.         qj = (PlayerCamera.Position.y) / BlockSize + UBound(WorldMesh, 2) / 2
1487.         wi = 1 + Int(qi)
1488.         wj = 1 + Int(qj)
1489.         If (wi < 1) Then wi = 1
1490.         If (wj < 1) Then wj = 1
1491.         If (wi > UBound(WorldMesh, 1)) Then wi = UBound(WorldMesh, 1)
1492.         If (wj > UBound(WorldMesh, 2)) Then wj = UBound(WorldMesh, 2)
1493.         If (PlayerCamera.Velocity.z = 0) Then
1494.             PlayerCamera.Position.z = PlayerCamera.Position.z + .15 * ((40 + WorldMesh(wi, wj) - PlayerCamera.Position.z))
1495.         End If
1496.  
1497.         ' Collision with ground after jump.
1498.         If ((PlayerCamera.Velocity.z <> 0) And (PlayerCamera.Position.z < (40 + WorldMesh(wi, wj)))) Then
1499.             PlayerCamera.Acceleration.z = 0
1500.             PlayerCamera.Velocity.z = 0
1501.         End If
1502.  
1503.         ' Collision with tornado.
1504.         If (Group(ClosestGroup).Label = "Tornado") Then
1505.             PlayerCamera.Velocity.x = (Rnd - .5) * 20
1506.             PlayerCamera.Velocity.y = (Rnd - .5) * 20
1507.             PlayerCamera.Velocity.z = 20
1508.             PlayerCamera.Acceleration.z = -.5
1509.         End If
1510.  
1511.         'Un-zoom camera.
1512.         If ((fovd <> -192) And (_KeyDown(90) = 0) And (_KeyDown(122) = 0)) Then
1513.             fovd = Int(.5 * (fovd - 192)) + 1
1514.             farplane(4) = -256 'Int(.5 * (farplane(4) - 256))
1515.             Call CalculateClippingPlanes(_Width, _Height)
1516.         End If
1517.  
1518.     End If
1519. End Sub
1520.  
1521. ' Compute Visible Scene
1522.  
1523. Sub ComputeVisibleScene
1524.     Dim As Long g, k
1525.     Dim As Double dx, dy, dz
1526.     Dim closestdist2 As Double
1527.     Dim fp42 As Double
1528.     Dim dist2 As Double
1529.     Dim GroupInView As Integer
1530.     ClosestGroup = 1
1531.     closestdist2 = 10000000
1532.     fp42 = farplane(4) * farplane(4)
1533.  
1534.     k = 1
1535.     Do
1536.         dx = Cluster(k).Centroid.x - PlayerCamera.Position.x
1537.         dy = Cluster(k).Centroid.y - PlayerCamera.Position.y
1538.         dz = Cluster(k).Centroid.z - PlayerCamera.Position.z
1539.         dist2 = dx * dx + dy * dy + dz * dz
1540.         '''
1541.         If k = SunClusterAddress And Cluster(k).Centroid.z > 0 Then GoTo 100
1542.         If k = MoonClusterAddress And Cluster(k).Centroid.z > 0 Then GoTo 100
1543.         '''
1544.         If (dist2 > 600 * 600) Then
1545.             Cluster(k).Visible = 0
1546.             If ((Cluster(k).MotionType <> 0) And (ToggleAnimate = 1)) Then
1547.                 Call EvolveCluster(k)
1548.             End If
1549.         Else
1550.             '''
1551.            100
1552.             '''
1553.             Cluster(k).Visible = 1
1554.             g = Cluster(k).FirstGroup
1555.             If ((Cluster(k).MotionType <> 0) And (ToggleAnimate = 1)) Then
1556.                 Call EvolveCluster(k)
1557.             End If
1558.             Do
1559.                 dx = Group(g).Centroid.x - PlayerCamera.Position.x
1560.                 dy = Group(g).Centroid.y - PlayerCamera.Position.y
1561.                 dz = Group(g).Centroid.z - PlayerCamera.Position.z
1562.                 dist2 = dx * dx + dy * dy + dz * dz
1563.                 Group(g).Visible = 0
1564.                 '''
1565.                 If k = SunClusterAddress Then GoTo 200
1566.                 If k = MoonClusterAddress Then GoTo 200
1567.                 '''
1568.  
1569.                 If (dist2 < fp42) Then
1570.                     '''
1571.                    200
1572.                     '''
1573.                     GroupInView = 1
1574.                     If dx * nearplane(1) + dy * nearplane(2) + dz * nearplane(3) - nearplane(4) < 0 Then GroupInView = 0
1575.                     'IF dx * farplane(1) + dy * farplane(2) + dz * farplane(3) - farplane(4) < 0 THEN groupinview = 0 ''' Redundant
1576.                     If dx * rightplane(1) + dy * rightplane(2) + dz * rightplane(3) - rightplane(4) < 0 Then GroupInView = 0
1577.                     If dx * leftplane(1) + dy * leftplane(2) + dz * leftplane(3) - leftplane(4) < 0 Then GroupInView = 0
1578.                     If dx * topplane(1) + dy * topplane(2) + dz * topplane(3) - topplane(4) < 0 Then GroupInView = 0
1579.                     If dx * bottomplane(1) + dy * bottomplane(2) + dz * bottomplane(3) - bottomplane(4) < 0 Then GroupInView = 0
1580.                     If (GroupInView = 1) Then
1581.                         Group(g).Visible = 1
1582.                         If (dist2 < closestdist2) Then
1583.                             closestdist2 = dist2
1584.                             ClosestGroup = g
1585.                         End If
1586.                         Group(g).Distance2 = dist2
1587.                         If (ToggleAnimate = 1) And (Group(g).FrameLength = 0) Then Call EvolveVectors(g)
1588.  
1589.                         '''
1590.                         If k = SunClusterAddress Or k = MoonClusterAddress Then
1591.                             If PlayerCamera.Position.z < -40 Then
1592.                                 Call ProjectGroup(g, Group(g).FirstVector, Group(g).LastVector, 1)
1593.                             Else
1594.                                 Call ProjectGroup(g, Group(g).FirstVector, Group(g).LastVector, 0)
1595.                             End If
1596.                         Else
1597.                             If Group(g).FrameLength <> 0 And Group(g).ActiveFrame <> 0 Then
1598.                                 Call ProjectGroup(g, Group(g).FirstVector + Group(g).ActiveFrame * Group(g).FrameLength, Group(g).FirstVector + Group(g).ActiveFrame * Group(g).FrameLength + Group(g).FrameLength, 1)
1599.                             Else
1600.                                 Call ProjectGroup(g, Group(g).FirstVector, Group(g).LastVector, 1)
1601.                             End If
1602.                         End If
1603.                         '''
1604.  
1605.                     End If
1606.                 End If
1607.                 If (g = Cluster(k).LastGroup) Then Exit Do
1608.                 g = Group(g).Pointer
1609.             Loop
1610.         End If
1611.  
1612.         k = Cluster(k).Pointer
1613.         If (k = -999) Then Exit Do
1614.     Loop
1615. End Sub
1616.  
1617. Sub CalculateScreenVectors
1618.     Dim As Double mag
1619.     mag = 1 / Sqr(uhat(1) * uhat(1) + uhat(2) * uhat(2) + uhat(3) * uhat(3))
1620.     uhat(1) = uhat(1) * mag: uhat(2) = uhat(2) * mag: uhat(3) = uhat(3) * mag
1621.     mag = 1 / Sqr(vhat(1) * vhat(1) + vhat(2) * vhat(2) + vhat(3) * vhat(3))
1622.     vhat(1) = vhat(1) * mag: vhat(2) = vhat(2) * mag: vhat(3) = vhat(3) * mag
1623.     nhat(1) = uhat(2) * vhat(3) - uhat(3) * vhat(2)
1624.     nhat(2) = uhat(3) * vhat(1) - uhat(1) * vhat(3)
1625.     nhat(3) = uhat(1) * vhat(2) - uhat(2) * vhat(1)
1626.     Call CalculateClippingPlanes(_Width, _Height)
1627. End Sub
1628.  
1629. Sub CalculateClippingPlanes (TheWidth As Double, TheHeight As Double)
1630.     Dim As Double h2, w2, h2f, w2f, h2w2, mag
1631.     h2 = TheHeight * .5
1632.     w2 = TheWidth * .5
1633.     h2f = h2 * fovd
1634.     w2f = w2 * fovd
1635.     h2w2 = h2 * w2
1636.     nearplane(1) = -nhat(1)
1637.     nearplane(2) = -nhat(2)
1638.     nearplane(3) = -nhat(3)
1639.     farplane(1) = nhat(1)
1640.     farplane(2) = nhat(2)
1641.     farplane(3) = nhat(3)
1642.     rightplane(1) = h2f * uhat(1) - h2w2 * nhat(1)
1643.     rightplane(2) = h2f * uhat(2) - h2w2 * nhat(2)
1644.     rightplane(3) = h2f * uhat(3) - h2w2 * nhat(3)
1645.     mag = 1 / Sqr(rightplane(1) * rightplane(1) + rightplane(2) * rightplane(2) + rightplane(3) * rightplane(3))
1646.     rightplane(1) = rightplane(1) * mag
1647.     rightplane(2) = rightplane(2) * mag
1648.     rightplane(3) = rightplane(3) * mag
1649.     leftplane(1) = -h2f * uhat(1) - h2w2 * nhat(1)
1650.     leftplane(2) = -h2f * uhat(2) - h2w2 * nhat(2)
1651.     leftplane(3) = -h2f * uhat(3) - h2w2 * nhat(3)
1652.     mag = 1 / Sqr(leftplane(1) * leftplane(1) + leftplane(2) * leftplane(2) + leftplane(3) * leftplane(3))
1653.     leftplane(1) = leftplane(1) * mag
1654.     leftplane(2) = leftplane(2) * mag
1655.     leftplane(3) = leftplane(3) * mag
1656.     topplane(1) = w2f * vhat(1) - h2w2 * nhat(1)
1657.     topplane(2) = w2f * vhat(2) - h2w2 * nhat(2)
1658.     topplane(3) = w2f * vhat(3) - h2w2 * nhat(3)
1659.     mag = 1 / Sqr(topplane(1) * topplane(1) + topplane(2) * topplane(2) + topplane(3) * topplane(3))
1660.     topplane(1) = topplane(1) * mag
1661.     topplane(2) = topplane(2) * mag
1662.     topplane(3) = topplane(3) * mag
1663.     bottomplane(1) = -w2f * vhat(1) - h2w2 * nhat(1)
1664.     bottomplane(2) = -w2f * vhat(2) - h2w2 * nhat(2)
1665.     bottomplane(3) = -w2f * vhat(3) - h2w2 * nhat(3)
1666.     mag = 1 / Sqr(bottomplane(1) * bottomplane(1) + bottomplane(2) * bottomplane(2) + bottomplane(3) * bottomplane(3))
1667.     bottomplane(1) = bottomplane(1) * mag
1668.     bottomplane(2) = bottomplane(2) * mag
1669.     bottomplane(3) = bottomplane(3) * mag
1670. End Sub
1671.  
1672. Sub ProjectGroup (TheGroup As Long, LowIndex As Long, HighIndex As Long, GraySwitch As Integer)
1673.     Dim As Vector3 vec(UBound(vec3Dpos))
1674.     Dim As Integer vectorinview
1675.     Dim As Double vec3ddotnhat
1676.     Dim i As Long
1677.     Dim f As Integer
1678.     For i = LowIndex To HighIndex
1679.         vec(i).x = Group(TheGroup).Centroid.x + vec3Dpos(i).x - PlayerCamera.Position.x
1680.         vec(i).y = Group(TheGroup).Centroid.y + vec3Dpos(i).y - PlayerCamera.Position.y
1681.         vec(i).z = Group(TheGroup).Centroid.z + vec3Dpos(i).z - PlayerCamera.Position.z
1682.         f = -1
1683.         vec3Dvis(i) = 0
1684.         vectorinview = 1
1685.         If vec(i).x * nearplane(1) + vec(i).y * nearplane(2) + vec(i).z * nearplane(3) - nearplane(4) < 0 Then vectorinview = 0
1686.         'IF vec(i).x * farplane(1) + vec(i).y * farplane(2) + vec(i).z* farplane(3) - farplane(4) < 0 THEN vectorinview = 0
1687.         If vec(i).x * farplane(1) + vec(i).y * farplane(2) + vec(i).z * farplane(3) - farplane(4) * .85 < 0 Then f = 1
1688.         'IF vec(i).x * rightplane(1) + vec(i).y * rightplane(2) + vec(i).z * rightplane(3) - rightplane(4) < 0 THEN vectorinview = 0
1689.         'IF vec(i).x * leftplane(1) + vec(i).y * leftplane(2) + vec(i).z * leftplane(3) - leftplane(4) < 0 THEN vectorinview = 0
1690.         'IF vec(i).x * topplane(1) + vec(i).y * topplane(2) + vec(i).z * topplane(3) - topplane(4) < 0 THEN vectorinview = 0
1691.         'IF vec(i).x * bottomplane(1) + vec(i).y * bottomplane(2) + vec(i).z* bottomplane(3) - bottomplane(4) < 0 THEN vectorinview = 0
1692.         If (vectorinview = 1) Then
1693.             vec3Dvis(i) = 1
1694.             vec3ddotnhat = vec(i).x * nhat(1) + vec(i).y * nhat(2) + vec(i).z * nhat(3)
1695.             vec2D(i).u = (vec(i).x * uhat(1) + vec(i).y * uhat(2) + vec(i).z * uhat(3)) * fovd / vec3ddotnhat
1696.             vec2D(i).v = (vec(i).x * vhat(1) + vec(i).y * vhat(2) + vec(i).z * vhat(3)) * fovd / vec3ddotnhat
1697.             If ((GraySwitch = 1) And (f = 1)) Then
1698.                 vec2Dcolor(i) = Gray
1699.             Else
1700.                 vec2Dcolor(i) = vec3Dcolor(i)
1701.             End If
1702.         End If
1703.     Next
1704. End Sub
1705.  
1706. Sub EvolveCluster (TheCluster As Long)
1707.     Dim u As Long
1708.     Dim k As Long
1709.     Dim As Single xx, yy, zz ' Needs to be single otherwise the fish flip flop. wtf?
1710.     Dim As Double x0, y0 ', z0
1711.     Dim As Double dx, dy, dz
1712.     Dim As Double t
1713.     Dim As Double v
1714.     'Dim xx, yy, zz, x0, y0, dx, dy, dz, t, v As Double
1715.     Select Case Cluster(TheCluster).MotionType
1716.         Case 0
1717.             ' Do nothing.
1718.  
1719.         Case -1
1720.             ' Freefall and explode.
1721.             Cluster(TheCluster).Velocity.x = Cluster(TheCluster).Velocity.x + Cluster(TheCluster).Acceleration.x
1722.             Cluster(TheCluster).Velocity.y = Cluster(TheCluster).Velocity.y + Cluster(TheCluster).Acceleration.y
1723.             Cluster(TheCluster).Velocity.z = Cluster(TheCluster).Velocity.z + Cluster(TheCluster).Acceleration.z
1724.             dx = Cluster(TheCluster).Velocity.x
1725.             dy = Cluster(TheCluster).Velocity.y
1726.             dz = Cluster(TheCluster).Velocity.z
1727.             If ((dx <> 0) Or (dy <> 0) Or (dz <> 0)) Then
1728.                 Call TranslateCluster(TheCluster, dx, dy, dz)
1729.             End If
1730.             Dim wi As Integer
1731.             Dim wj As Integer
1732.             wi = 1 + Int((Cluster(TheCluster).Centroid.x) / BlockSize + UBound(WorldMesh, 1) / 2)
1733.             wj = 1 + Int((Cluster(TheCluster).Centroid.y) / BlockSize + UBound(WorldMesh, 2) / 2)
1734.             If (Cluster(TheCluster).Centroid.z <= WorldMesh(wi, wj)) Then
1735.                 Cluster(TheCluster).Acceleration.x = 0
1736.                 Cluster(TheCluster).Acceleration.y = 0
1737.                 Cluster(TheCluster).Acceleration.z = 0
1738.                 Cluster(TheCluster).Velocity.x = 0
1739.                 Cluster(TheCluster).Velocity.y = 0
1740.                 Cluster(TheCluster).Velocity.z = 0
1741.                 Cluster(TheCluster).MotionType = -9
1742.                 Cluster(TheCluster).DeathTimer = Timer + 2
1743.                 k = Cluster(TheCluster).FirstGroup
1744.                 Do
1745.                     Group(k).Volume.x = BlockSize * 3
1746.                     Group(k).Volume.y = BlockSize * 3
1747.                     Group(k).Volume.z = BlockSize * 3
1748.                     For u = Group(k).FirstVector To Group(k).LastVector
1749.                         vec3Dvel(u).x = (Rnd - .5) * .8
1750.                         vec3Dvel(u).y = (Rnd - .5) * .8
1751.                         vec3Dvel(u).z = (Rnd - 0) * .8
1752.                     Next
1753.                     If (k = Cluster(TheCluster).LastGroup) Then Exit Do
1754.                     k = Group(k).Pointer
1755.                 Loop
1756.             End If
1757.  
1758.         Case -2
1759.             ' Freefall and stack.
1760.             Cluster(TheCluster).Velocity.x = Cluster(TheCluster).Velocity.x + Cluster(TheCluster).Acceleration.x
1761.             Cluster(TheCluster).Velocity.y = Cluster(TheCluster).Velocity.y + Cluster(TheCluster).Acceleration.y
1762.             Cluster(TheCluster).Velocity.z = Cluster(TheCluster).Velocity.z + Cluster(TheCluster).Acceleration.z
1763.             dx = Cluster(TheCluster).Velocity.x
1764.             dy = Cluster(TheCluster).Velocity.y
1765.             dz = Cluster(TheCluster).Velocity.z
1766.             If ((dx <> 0) Or (dy <> 0) Or (dz <> 0)) Then
1767.                 Call TranslateCluster(TheCluster, dx, dy, dz)
1768.             End If
1769.             wi = 1 + Int((Cluster(TheCluster).Centroid.x) / BlockSize + UBound(WorldMesh, 1) / 2)
1770.             wj = 1 + Int((Cluster(TheCluster).Centroid.y) / BlockSize + UBound(WorldMesh, 2) / 2)
1771.             If (Cluster(TheCluster).Centroid.z <= WorldMesh(wi, wj)) Then
1772.                 Cluster(TheCluster).Acceleration.x = 0
1773.                 Cluster(TheCluster).Acceleration.y = 0
1774.                 Cluster(TheCluster).Acceleration.z = 0
1775.                 Cluster(TheCluster).Velocity.x = 0
1776.                 Cluster(TheCluster).Velocity.y = 0
1777.                 Cluster(TheCluster).Velocity.z = 0
1778.                 Cluster(TheCluster).MotionType = 0
1779.                 WorldMesh(wi, wj) = WorldMesh(wi, wj) + BlockSize / 3
1780.             End If
1781.  
1782.         Case -9
1783.             If (Timer >= Cluster(TheCluster).DeathTimer) Then
1784.                 Call RemoveCluster(TheCluster)
1785.             End If
1786.  
1787.         Case Else
1788.             ' Fixed path.
1789.             ' Note: This chunk of code is subject to the midnight bug.
1790.             t = Timer
1791.             u = Int(t)
1792.             v = t - u
1793.             xx = v * FixedPath(Cluster(TheCluster).MotionType, u).x + (1 - v) * FixedPath(Cluster(TheCluster).MotionType, u - 1).x
1794.             yy = v * FixedPath(Cluster(TheCluster).MotionType, u).y + (1 - v) * FixedPath(Cluster(TheCluster).MotionType, u - 1).y
1795.             zz = v * FixedPath(Cluster(TheCluster).MotionType, u).z + (1 - v) * FixedPath(Cluster(TheCluster).MotionType, u - 1).z
1796.  
1797.             ' Choose frame based on derived velocity vector.
1798.             If (Cluster(TheCluster).Framed = 1) Then
1799.                 k = Cluster(TheCluster).FirstGroup
1800.                 Do
1801.                     If (Group(k).FrameLength <> 0) Then
1802.                         x0 = Group(k).Centroid.x
1803.                         y0 = Group(k).Centroid.y
1804.                         'z0 = Group(k).Centroid.z
1805.                         dx = xx - x0
1806.                         dy = yy - y0
1807.                         'dz = zz - z0
1808.                         If ((dx > 0) And (dy > 0)) Then Group(k).ActiveFrame = 1 + Int(((48 / (2 * pi)) * (Atn(dy / dx))))
1809.                         If ((dx < 0) And (dy > 0)) Then Group(k).ActiveFrame = 1 + 24 + Int(((48 / (2 * pi)) * (Atn(dy / dx))))
1810.                         If ((dx < 0) And (dy < 0)) Then Group(k).ActiveFrame = 1 + 24 + Int(((48 / (2 * pi)) * (Atn(dy / dx))))
1811.                         If ((dx > 0) And (dy < 0)) Then Group(k).ActiveFrame = 1 + 48 + Int(((48 / (2 * pi)) * (Atn(dy / dx))))
1812.                     End If
1813.                     If (k = Cluster(TheCluster).LastGroup) Then Exit Do
1814.                     k = Group(k).Pointer
1815.                 Loop
1816.             End If
1817.  
1818.             Call PlaceCluster(TheCluster, xx, yy, zz)
1819.  
1820.     End Select
1821. End Sub
1822.  
1823. Sub PlaceCluster (TheCluster As Long, xc As Double, yc As Double, zc As Double)
1824.     Dim As Long g
1825.     Dim As Double x0, y0, z0
1826.     x0 = Cluster(TheCluster).Centroid.x
1827.     y0 = Cluster(TheCluster).Centroid.y
1828.     z0 = Cluster(TheCluster).Centroid.z
1829.     Cluster(TheCluster).Centroid.x = xc
1830.     Cluster(TheCluster).Centroid.y = yc
1831.     Cluster(TheCluster).Centroid.z = zc
1832.     g = Cluster(TheCluster).FirstGroup
1833.     Do
1834.         Group(g).Centroid.x = Group(g).Centroid.x + xc - x0
1835.         Group(g).Centroid.y = Group(g).Centroid.y + yc - y0
1836.         Group(g).Centroid.z = Group(g).Centroid.z + zc - z0
1837.         If (g = Cluster(TheCluster).LastGroup) Then Exit Do
1838.         g = Group(g).Pointer
1839.     Loop
1840. End Sub
1841.  
1842. Sub TranslateCluster (TheCluster As Long, dx As Double, dy As Double, dz As Double)
1843.     Dim As Long g
1844.     g = Cluster(TheCluster).FirstGroup
1845.     Do
1846.         Group(g).Centroid.x = Group(g).Centroid.x + dx
1847.         Group(g).Centroid.y = Group(g).Centroid.y + dy
1848.         Group(g).Centroid.z = Group(g).Centroid.z + dz
1849.         If (g = Cluster(TheCluster).LastGroup) Then Exit Do
1850.         g = Group(g).Pointer
1851.     Loop
1852.     Cluster(TheCluster).Centroid.x = Cluster(TheCluster).Centroid.x + dx
1853.     Cluster(TheCluster).Centroid.y = Cluster(TheCluster).Centroid.y + dy
1854.     Cluster(TheCluster).Centroid.z = Cluster(TheCluster).Centroid.z + dz
1855. End Sub
1856.  
1857. Sub EvolveVectors (TheGroup As Long)
1858.     Dim As Long g
1859.     Dim As Double xdim, ydim, zdim
1860.     Dim As Double dx, dy, dz
1861.     Dim As Double px, py, pz
1862.  
1863.     xdim = Group(TheGroup).Volume.x
1864.     ydim = Group(TheGroup).Volume.y
1865.     zdim = Group(TheGroup).Volume.z
1866.  
1867.     For g = Group(TheGroup).FirstVector To Group(TheGroup).LastVector
1868.  
1869.         ' Position update with periodic boundaries inside group volume.
1870.         dx = vec3Dvel(g).x
1871.         dy = vec3Dvel(g).y
1872.         dz = vec3Dvel(g).z
1873.         If (dx <> 0) Then
1874.             px = vec3Dpos(g).x + dx
1875.             If Abs(px) > xdim / 2 Then
1876.                 If (px > xdim / 2) Then
1877.                     px = -xdim / 2
1878.                 Else
1879.                     px = xdim / 2
1880.                 End If
1881.             End If
1882.             vec3Dpos(g).x = px
1883.         End If
1884.         If (dy <> 0) Then
1885.             py = vec3Dpos(g).y + dy
1886.             If Abs(py) > ydim / 2 Then
1887.                 If (py > ydim / 2) Then
1888.                     py = -ydim / 2
1889.                 Else
1890.                     py = ydim / 2
1891.                 End If
1892.             End If
1893.             vec3Dpos(g).y = py
1894.         End If
1895.         If (dz <> 0) Then
1896.             pz = vec3Dpos(g).z + dz
1897.             If Abs(pz) > zdim / 2 Then
1898.                 If (pz > zdim / 2) Then
1899.                     pz = -zdim / 2
1900.                 Else
1901.                     pz = zdim / 2
1902.                 End If
1903.             End If
1904.             vec3Dpos(g).z = pz
1905.         End If
1906.     Next
1907. End Sub
1908.  
1909. Sub SetParticleVelocity (TheGroup As Long, vx As Double, vy As Double, vz As Double)
1910.     Dim As Long j, m, n
1911.     m = Group(TheGroup).FirstVector
1912.     n = Group(TheGroup).LastVector
1913.     For j = m To n
1914.         vec3Dvel(j).x = vx
1915.         vec3Dvel(j).y = vy
1916.         vec3Dvel(j).z = vz
1917.     Next
1918. End Sub
1919.  
1920. ' Sorting
1921.  
1922. Sub QuickSort (LowLimit As Long, HighLimit As Long)
1923.     Dim As Long piv
1924.     If (LowLimit < HighLimit) Then
1925.         piv = Partition(LowLimit, HighLimit)
1926.         Call QuickSort(LowLimit, piv - 1)
1927.         Call QuickSort(piv + 1, HighLimit)
1928.     End If
1929. End Sub
1930.  
1931. Function Partition (LowLimit As Long, HighLimit As Long)
1932.     Dim As Long i, j
1933.     Dim As Double pivot, tmp
1934.     pivot = Group(SortedGroups(HighLimit)).Distance2
1935.     i = LowLimit - 1
1936.  
1937.     For j = LowLimit To HighLimit - 1
1938.         tmp = Group(SortedGroups(j)).Distance2 - pivot
1939.         If (tmp >= 0) Then
1940.             i = i + 1
1941.             Swap SortedGroups(i), SortedGroups(j)
1942.         End If
1943.     Next
1944.     Swap SortedGroups(i + 1), SortedGroups(HighLimit)
1945.     Partition = i + 1
1946. End Function
1947.  
1948. 'Sub BubbleSort
1949. '    ' Antiquated but works fine.
1950. '    Dim As Integer i, j
1951. '    Dim As Double u, v
1952. '    For j = SortedGroupsCount To 1 Step -1
1953. '        For i = 2 To SortedGroupsCount
1954. '            u = Group(SortedGroups(i - 1)).Distance2
1955. '            v = Group(SortedGroups(i)).Distance2
1956. '            If (u < v) Then
1957. '                Swap SortedGroups(i - 1), SortedGroups(i)
1958. '            End If
1959. '        Next
1960. '    Next
1961. 'End Sub
1962.  
1963. ' Graphics
1964.  
1965. Sub PlotWorld
1966.     Dim As Long g, k, p
1967.     Dim j As Integer
1968.     Dim lowlim, highlim As Long
1969.     Dim x1 As Double
1970.     Dim y1 As Double
1971.     Dim x2 As Double
1972.     Dim y2 As Double
1973.     Dim clrtmp As _Unsigned Long
1974.     Dim ThePlotMode As Integer
1975.  
1976.     NumClusterVisible = 0
1977.     NumVectorVisible = 0
1978.  
1979.     SortedGroupsCount = 0
1980.     k = 1
1981.     Do
1982.         If (Cluster(k).Visible = 1) Then
1983.             NumClusterVisible = NumClusterVisible + 1
1984.             g = Cluster(k).FirstGroup
1985.             Do
1986.                 If (Group(g).Visible = 1) Then
1987.                     SortedGroupsCount = SortedGroupsCount + 1
1988.                     SortedGroups(SortedGroupsCount) = g
1989.                 End If
1990.                 If (g = Cluster(k).LastGroup) Then Exit Do
1991.                 g = Group(g).Pointer
1992.             Loop
1993.         End If
1994.         k = Cluster(k).Pointer
1995.         If (k = -999) Then Exit Do
1996.     Loop
1997.     NumGroupVisible = SortedGroupsCount
1998.  
1999.     Call QuickSort(1, SortedGroupsCount)
2000.     'Call BubbleSort
2001.  
2002.     PlayerCamera.Shade = ShadeMix~&(PlayerCamera.Shade, _RGB32(_Red32(vec3Dcolor(Group(ClosestGroup).FirstVector)), _Green32(vec3Dcolor(Group(ClosestGroup).FirstVector)), _Blue32(vec3Dcolor(Group(ClosestGroup).FirstVector)), 200), .01)
2003.     PlayerCamera.Shade = ShadeMix~&(PlayerCamera.Shade, _RGB32(0, 0, 0, 255), .01)
2004.     Cls
2005.     Line (0, 0)-(_Width, _Height), PlayerCamera.Shade, BF
2006.  
2007.     For j = 1 To SortedGroupsCount
2008.         g = SortedGroups(j)
2009.         ThePlotMode = Group(g).PlotMode
2010.  
2011.         If (ThePlotMode = -1) Then ' Wire cube
2012.             Dim x3 As Double
2013.             Dim y3 As Double
2014.             Dim x4 As Double
2015.             Dim y4 As Double
2016.             p = Group(g).FirstVector
2017.             clrtmp = vec2Dcolor(p)
2018.             x1 = vec2D(p).u: y1 = vec2D(p).v: x2 = vec2D(p + 1).u: y2 = vec2D(p + 1).v: x3 = vec2D(p + 2).u: y3 = vec2D(p + 2).v: x4 = vec2D(p + 4).u: y4 = vec2D(p + 4).v
2019.             Call CLine(x1, y1, x2, y2, clrtmp)
2020.             Call CLine(x1, y1, x3, y3, clrtmp)
2021.             Call CLine(x1, y1, x4, y4, clrtmp)
2022.             x1 = vec2D(p + 3).u: y1 = vec2D(p + 3).v: x2 = vec2D(p + 1).u: y2 = vec2D(p + 1).v: x3 = vec2D(p + 2).u: y3 = vec2D(p + 2).v: x4 = vec2D(p + 7).u: y4 = vec2D(p + 7).v
2023.             Call CLine(x1, y1, x2, y2, clrtmp)
2024.             Call CLine(x1, y1, x3, y3, clrtmp)
2025.             Call CLine(x1, y1, x4, y4, clrtmp)
2026.             x1 = vec2D(p + 5).u: y1 = vec2D(p + 5).v: x2 = vec2D(p + 4).u: y2 = vec2D(p + 4).v: x3 = vec2D(p + 7).u: y3 = vec2D(p + 7).v: x4 = vec2D(p + 1).u: y4 = vec2D(p + 1).v
2027.             Call CLine(x1, y1, x2, y2, clrtmp)
2028.             Call CLine(x1, y1, x3, y3, clrtmp)
2029.             Call CLine(x1, y1, x4, y4, clrtmp)
2030.             x1 = vec2D(p + 6).u: y1 = vec2D(p + 6).v: x2 = vec2D(p + 4).u: y2 = vec2D(p + 4).v: x3 = vec2D(p + 7).u: y3 = vec2D(p + 7).v: x4 = vec2D(p + 2).u: y4 = vec2D(p + 2).v
2031.             Call CLine(x1, y1, x2, y2, clrtmp)
2032.             Call CLine(x1, y1, x3, y3, clrtmp)
2033.             Call CLine(x1, y1, x4, y4, clrtmp)
2034.         End If
2035.  
2036.         If Group(g).ActiveFrame = 0 Then
2037.             lowlim = Group(g).FirstVector
2038.             highlim = Group(g).LastVector - 1
2039.         Else
2040.             lowlim = Group(g).FirstVector + Group(g).FrameLength * (Group(g).ActiveFrame)
2041.             highlim = Group(g).FirstVector + Group(g).FrameLength * (Group(g).ActiveFrame + 1) - 2
2042.         End If
2043.  
2044.         For p = lowlim To highlim
2045.             If (vec3Dvis(p) = 1) Then
2046.                 NumVectorVisible = NumVectorVisible + 1
2047.                 If (g = ClosestGroup) Then
2048.                     clrtmp = Yellow
2049.                 Else
2050.                     clrtmp = vec2Dcolor(p)
2051.                 End If
2052.                 Select Case ThePlotMode
2053.                     Case 0
2054.                         x1 = vec2D(p).u
2055.                         y1 = vec2D(p).v
2056.                         Call BlockPoint(x1, y1, clrtmp)
2057.                     Case 1
2058.                         x1 = vec2D(p).u
2059.                         y1 = vec2D(p).v
2060.                         x2 = vec2D(p + 1).u
2061.                         y2 = vec2D(p + 1).v
2062.                         If (((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1)) < 225) Then
2063.                             'Call cline(x1, y1, x2, y2, clrtmp)
2064.                             Call LineSmooth(x1, y1, x2, y2, clrtmp)
2065.                         Else
2066.                             Call CCircle(x1, y1, 1, clrtmp)
2067.                             '''
2068.                             'If p = highlim Then Call CCircle(x2, y2, 1, clrtmp)
2069.                             '''
2070.                         End If
2071.                     Case 2
2072.                         x1 = vec2D(p).u
2073.                         y1 = vec2D(p).v
2074.                         Call CCircle(x1, y1, 1, clrtmp)
2075.                 End Select
2076.             End If
2077.         Next
2078.     Next
2079.  
2080. End Sub
2081.  
2082. Sub DisplayHUD
2083.     Dim a As String
2084.     Call LineSmooth(0, 0, 25 * (xhat(1) * uhat(1) + xhat(2) * uhat(2) + xhat(3) * uhat(3)), 25 * (xhat(1) * vhat(1) + xhat(2) * vhat(2) + xhat(3) * vhat(3)), _RGB32(255, 0, 0, 150))
2085.     Call LineSmooth(0, 0, 25 * (yhat(1) * uhat(1) + yhat(2) * uhat(2) + yhat(3) * uhat(3)), 25 * (yhat(1) * vhat(1) + yhat(2) * vhat(2) + yhat(3) * vhat(3)), _RGB32(0, 255, 0, 150))
2086.     Call LineSmooth(0, 0, 25 * (zhat(1) * uhat(1) + zhat(2) * uhat(2) + zhat(3) * uhat(3)), 25 * (zhat(1) * vhat(1) + zhat(2) * vhat(2) + zhat(3) * vhat(3)), _RGB32(30, 144, 255, 150))
2087.     Call TextCenter(" Closest ", (1) * 16, LimeGreen)
2088.     a = " " + Group(ClosestGroup).Label + " "
2089.     Color DarkKhaki
2090.     _PrintString (_Width / 2 - (Len(a) / 2) * 8, 2 * 16), a
2091.     Color LimeGreen
2092.     _PrintString ((1) * 8, _Height - (4) * 16), "   Movement   "
2093.     Color DarkKhaki
2094.     _PrintString ((1) * 8, _Height - (3) * 16), "  W  &/or  " + Chr$(30) + "  "
2095.     _PrintString ((1) * 8, _Height - (2) * 16), "A S D    " + Chr$(17) + " " + Chr$(31) + " " + Chr$(16)
2096.     Color LimeGreen
2097.     _PrintString (_Width - (13) * 8, _Height - (4) * 16), "Orientation "
2098.     Color DarkKhaki
2099.     _PrintString (_Width - (13) * 8, _Height - (3) * 16), " Keypad 1-9 "
2100.     If ((nhat(3) <> 0) Or (uhat(3) <> 0)) Then Color Red Else Color Gray
2101.     _PrintString (_Width - (13) * 8, _Height - (2) * 16), "  5=Level   "
2102.     Color LimeGreen
2103.     _PrintString ((1) * 8, (1) * 16), "- Report -"
2104.     Color DarkKhaki
2105.     _PrintString ((1) * 8, (2) * 16), "FPS: " + LTrim$(RTrim$(Str$(FPSReport))) + "/" + LTrim$(RTrim$(Str$(FPSTarget)))
2106.     _PrintString ((1) * 8, (3) * 16), "Particles: " + LTrim$(RTrim$(Str$(NumVectorVisible)))
2107.     '_PrintString ((1) * 8, (5) * 16), "Clusters: " + LTrim$(RTrim$(Str$(NumClusterVisible)))
2108.     '_PrintString ((1) * 8, (4) * 16), "Groups: " + LTrim$(RTrim$(Str$(NumGroupVisible)))
2109.     Color LimeGreen
2110.     _PrintString ((1) * 8, (10) * 16), "Abilities"
2111.     Color DarkKhaki
2112.     _PrintString ((1) * 8, (11) * 16), "F = throw"
2113.     _PrintString ((1) * 8, (12) * 16), "B = build"
2114.     _PrintString ((1) * 8, (13) * 16), "N = scramble"
2115.     _PrintString ((1) * 8, (14) * 16), "K = delete"
2116.     _PrintString ((1) * 8, (15) * 16), "Z = zoom"
2117.     Color LimeGreen
2118.     Call TextCenter(" SPACE = Ascend ", _Height - (2) * 16, LimeGreen)
2119. End Sub
2120.  
2121. Sub TextCenter (TheText As String, TheHeight As Integer, TheShade As _Unsigned Long)
2122.     Color TheShade
2123.     _PrintString (_Width / 2 - (Len(TheText) / 2) * 8, TheHeight), TheText
2124. End Sub
2125.  
2126. Sub DisplayMiniMap
2127.     Dim As Integer i, j, wi, wj
2128.     Dim As Double dx, dy, u, v
2129.     Dim As String a
2130.     Dim As _Unsigned Long Shade
2131.     wi = 1 + Int((PlayerCamera.Position.x) / BlockSize + UBound(WorldMesh, 1) / 2)
2132.     wj = 1 + Int((PlayerCamera.Position.y) / BlockSize + UBound(WorldMesh, 2) / 2)
2133.     u = _Width / 2 - UBound(WorldMesh, 1)
2134.     v = _Height / 2 - UBound(WorldMesh, 2)
2135.     For i = 1 To UBound(WorldMesh, 1)
2136.         For j = 1 To UBound(WorldMesh, 2)
2137.             Shade = TerrainHeightShade~&(WorldMesh(i, j))
2138.             Call CPset(i + u, j + v, _RGB32(_Red32(Shade), _Green32(Shade), _Blue32(Shade), 150))
2139.         Next
2140.     Next
2141.     Call CCircle(wi + u, wj + v, 2, Red)
2142.     Call LineSmooth(wi + u, wj + v, wi + u - 5 * nhat(1) * Sqr((fovd / -192)), wj + v - 5 * nhat(2) * Sqr((fovd / -192)), White)
2143.     Color DarkKhaki, PlayerCamera.Shade
2144.     _PrintString (_Width - UBound(WorldMesh, 1), UBound(WorldMesh, 2)), "x:" + LTrim$(RTrim$(Str$(Int(PlayerCamera.Position.x)))) + " " + "y:" + LTrim$(RTrim$(Str$(Int(PlayerCamera.Position.y)))) + " " + "z:" + LTrim$(RTrim$(Str$(Int(PlayerCamera.Position.z))))
2145.     dx = -nhat(1)
2146.     dy = -nhat(2)
2147.     If ((dx > 0) And (dy > 0)) Then a = LTrim$(RTrim$(Str$(1 + Int(((180 / pi) * (Atn(dy / dx))))))) + Chr$(248)
2148.     If ((dx < 0) And (dy > 0)) Then a = LTrim$(RTrim$(Str$(1 + 180 + Int(((180 / pi) * (Atn(dy / dx))))))) + Chr$(248)
2149.     If ((dx < 0) And (dy < 0)) Then a = LTrim$(RTrim$(Str$(1 + 180 + Int(((180 / pi) * (Atn(dy / dx))))))) + Chr$(248)
2150.     If ((dx > 0) And (dy < 0)) Then a = LTrim$(RTrim$(Str$(1 + 360 + Int(((180 / pi) * (Atn(dy / dx))))))) + Chr$(248)
2151.     _PrintString (_Width - Len(a) * 8, UBound(WorldMesh, 2) - 16), a
2152. End Sub
2153.  
2154. ' Interface
2155.  
2156. Sub KeyDownProcess
2157.     Dim As Double modifier
2158.     modifier = 0.05
2159.  
2160.     If (_KeyDown(32) <> 0) Then ' Space
2161.         PlayerCamera.Velocity.z = 5
2162.         PlayerCamera.Acceleration.z = -.5
2163.     End If
2164.     If ((_KeyDown(87) <> 0) Or (_KeyDown(119) <> 0) Or (_KeyDown(18432) <> 0)) Then ' W or w or upparrow
2165.         Call StrafeCameraNhat(-1, -1, 0)
2166.         If ((nhat(3) <> 0) Or (uhat(3) <> 0)) Then Call RegulateCamera
2167.         If (ToggleAnimate = 1) Then
2168.             PlayerCamera.Velocity.x = PlayerCamera.Velocity.x - modifier * nhat(1)
2169.             PlayerCamera.Velocity.y = PlayerCamera.Velocity.y - modifier * nhat(2)
2170.             'PlayerCamera.Velocity.z = PlayerCamera.Velocity.z - modifier * nhat(3)
2171.         End If
2172.     End If
2173.     If ((_KeyDown(83) <> 0) Or (_KeyDown(115) <> 0) Or (_KeyDown(20480) <> 0)) Then ' S or s or downarrow
2174.         Call StrafeCameraNhat(1, 1, 0)
2175.         If ((nhat(3) <> 0) Or (uhat(3) <> 0)) Then Call RegulateCamera
2176.         If (ToggleAnimate = 1) Then
2177.             PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + modifier * nhat(1)
2178.             PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + modifier * nhat(2)
2179.             'PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + modifier * nhat(3)
2180.         End If
2181.     End If
2182.     If ((_KeyDown(65) <> 0) Or (_KeyDown(97) <> 0)) Then ' A or a
2183.         If ((nhat(3) <> 0) Or (uhat(3) <> 0)) Then Call RegulateCamera
2184.         Call StrafeCameraUhat(-1, -1, -1)
2185.         If (ToggleAnimate = 1) Then
2186.             PlayerCamera.Velocity.x = PlayerCamera.Velocity.x - modifier * uhat(1)
2187.             PlayerCamera.Velocity.y = PlayerCamera.Velocity.y - modifier * uhat(2)
2188.             'PlayerCamera.Velocity.z = PlayerCamera.Velocity.z - modifier * uhat(3)
2189.         End If
2190.     End If
2191.     If ((_KeyDown(68) <> 0) Or (_KeyDown(100) <> 0)) Then ' D or d
2192.         If ((nhat(3) <> 0) Or (uhat(3) <> 0)) Then Call RegulateCamera
2193.         Call StrafeCameraUhat(1, 1, 1)
2194.         If (ToggleAnimate = 1) Then
2195.             PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + modifier * uhat(1)
2196.             PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + modifier * uhat(2)
2197.             'PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + modifier * uhat(3)
2198.         End If
2199.     End If
2200.     'If ((_KeyDown(81) <> 0) Or (_KeyDown(113) <> 0)) Then ' Q or q
2201.     '    Call StrafeCameraVhat(1, 1, 1)
2202.     '    If (ToggleAnimate = 1) Then
2203.     '        PlayerCamera.Velocity.x = PlayerCamera.Velocity.x - modifier * vhat(1)
2204.     '        PlayerCamera.Velocity.y = PlayerCamera.Velocity.y - modifier * vhat(2)
2205.     '        PlayerCamera.Velocity.z = PlayerCamera.Velocity.z - modifier * vhat(3)
2206.     '    End If
2207.     'End If
2208.     'If ((_KeyDown(69) <> 0) Or (_KeyDown(101) <> 0)) Then ' E or e
2209.     '    Call StrafeCameraVhat(-1, -1, -1)
2210.     '    If (ToggleAnimate = 1) Then
2211.     '        PlayerCamera.Velocity.x = PlayerCamera.Velocity.x + modifier * vhat(1)
2212.     '        PlayerCamera.Velocity.y = PlayerCamera.Velocity.y + modifier * vhat(2)
2213.     '        PlayerCamera.Velocity.z = PlayerCamera.Velocity.z + modifier * vhat(3)
2214.     '    End If
2215.     'End If
2216.     If ((_KeyDown(90) <> 0) Or (_KeyDown(122) <> 0)) Then ' Z or z.
2217.         fovd = fovd - 5
2218.         If (fovd < -600) Then
2219.             fovd = -600
2220.         Else
2221.             farplane(4) = farplane(4) - 5
2222.         End If
2223.         Call CalculateClippingPlanes(.5 * _Width, .5 * _Height)
2224.     End If
2225.  
2226.     modifier = 0.0333
2227.     If (_KeyDown(19200) <> 0) Or (_KeyDown(52) <> 0) Then Call RotateUhat(-modifier, -modifier, -modifier): Call CalculateScreenVectors ' 4
2228.     If (_KeyDown(19712) <> 0) Or (_KeyDown(54) <> 0) Then Call RotateUhat(modifier, modifier, modifier): Call CalculateScreenVectors ' 6
2229.     If (_KeyDown(56) <> 0) Then Call RotateVhat(modifier, modifier, modifier): Call CalculateScreenVectors ' 8
2230.     If (_KeyDown(50) <> 0) Then Call RotateVhat(-modifier, -modifier, -modifier): Call CalculateScreenVectors ' 2
2231.     If (_KeyDown(55) <> 0) Then Call RotateUV(-modifier, -modifier, -modifier) ' 7
2232.     If (_KeyDown(57) <> 0) Then Call RotateUV(modifier, modifier, modifier) ' 9
2233.     If (_KeyDown(49) <> 0) Then Call RotateUhat(-modifier, -modifier, -modifier): Call CalculateScreenVectors: Call RotateUV(-modifier, -modifier, -modifier) ' 1
2234.     If (_KeyDown(51) <> 0) Then Call RotateUhat(modifier, modifier, modifier): Call CalculateScreenVectors: Call RotateUV(modifier, modifier, modifier) ' 3
2235.  
2236.     'modifier = 0.0222
2237.     'Do While _MouseInput
2238.     '    If (_MouseMovementX > 0) Then Call RotateUhat(modifier, modifier, modifier): Call CalculateScreenVectors
2239.     '    If (_MouseMovementX < 0) Then Call RotateUhat(-modifier, -modifier, -modifier): Call CalculateScreenVectors
2240.     '    If (_MouseMovementY > 0) Then Call RotateVhat(modifier, modifier, modifier): Call CalculateScreenVectors
2241.     '    If (_MouseMovementY < 0) Then Call RotateVhat(-modifier, -modifier, -modifier): Call CalculateScreenVectors
2242.     'Loop
2243. End Sub
2244.  
2245. Sub KeyHitProcess
2246.     Dim As Long g, p
2247.     Dim As Double x0, y0, z0
2248.     Dim As Integer kh
2249.     kh = _KeyHit
2250.     If (kh <> 0) Then
2251.         Select Case kh
2252.             Case 27 ' Quit
2253.                 System
2254.  
2255.             Case 53 ' 5
2256.                 Call RegulateCamera
2257.  
2258.             Case Asc("b"), Asc("B")
2259.                 x0 = (PlayerCamera.Position.x - 40 * nhat(1))
2260.                 y0 = (PlayerCamera.Position.y - 40 * nhat(2))
2261.                 z0 = (PlayerCamera.Position.z - 40 * nhat(3))
2262.                 x0 = x0 - x0 Mod BlockSize / 3
2263.                 y0 = y0 - y0 Mod BlockSize / 3
2264.                 z0 = z0 - z0 Mod BlockSize / 3
2265.                 g = LatestGroupIdentity&(1)
2266.                 g = NewCube&(g, "Custom block", 100, x0, y0, z0, BlockSize / 3, BlockSize / 3, BlockSize / 3, Lime, Purple, Teal, -2, 0)
2267.                 g = NewWireCube&(g, "Custom block", x0, y0, z0, BlockSize / 3, BlockSize / 3, BlockSize / 3, Lime, -2)
2268.                 Cluster(ClusterIdTicker).Acceleration.x = 0
2269.                 Cluster(ClusterIdTicker).Acceleration.y = 0
2270.                 Cluster(ClusterIdTicker).Acceleration.z = -.15
2271.                 Call ClusterPinch(g)
2272.  
2273.             Case Asc("f"), Asc("F")
2274.                 x0 = (PlayerCamera.Position.x - 40 * nhat(1))
2275.                 y0 = (PlayerCamera.Position.y - 40 * nhat(2))
2276.                 z0 = (PlayerCamera.Position.z - 40 * nhat(3))
2277.                 g = LatestGroupIdentity&(1)
2278.                 g = NewCube&(g, "Potion", 150, x0, y0, z0, 10, 10, 10, Red, Purple, Teal, -1, 0)
2279.                 g = NewCube&(g, "Potion", 50, x0, y0, z0 + 10, 2, 2, 10, Blue, Purple, Teal, -1, 0)
2280.                 Cluster(ClusterIdTicker).Acceleration.x = 0
2281.                 Cluster(ClusterIdTicker).Acceleration.y = 0
2282.                 Cluster(ClusterIdTicker).Acceleration.z = -.15
2283.                 Cluster(ClusterIdTicker).Velocity.x = -5 * nhat(1)
2284.                 Cluster(ClusterIdTicker).Velocity.y = -5 * nhat(2)
2285.                 Cluster(ClusterIdTicker).Velocity.z = -5 * nhat(3)
2286.                 Call ClusterPinch(g)
2287.  
2288.             Case Asc("n"), Asc("N")
2289.                 For p = Group(ClosestGroup).FirstVector To Group(ClosestGroup).LastVector
2290.                     vec3Dvel(p).x = (Rnd - .5) * .20
2291.                     vec3Dvel(p).y = (Rnd - .5) * .20
2292.                     vec3Dvel(p).z = (Rnd - .5) * .20
2293.                 Next
2294.  
2295.             Case Asc("k"), Asc("K")
2296.                 Call RemoveGroup(ClosestGroup)
2297.  
2298.             Case Asc("t"), Asc("T")
2299.                 ToggleAnimate = -ToggleAnimate
2300.         End Select
2301.     End If
2302.     _KeyClear
2303. End Sub
2304.  
2305. ' Plotting and color tools.
2306.  
2307. Sub CLine (x0 As Double, y0 As Double, x1 As Double, y1 As Double, shade As _Unsigned Long)
2308.     Line (_Width / 2 + x0, -y0 + _Height / 2)-(_Width / 2 + x1, -y1 + _Height / 2), shade
2309. End Sub
2310.  
2311. Sub CPset (x0, y0, shade As _Unsigned Long)
2312.     PSet (_Width / 2 + x0, -y0 + _Height / 2), shade
2313. End Sub
2314.  
2315. Sub CCircle (x0 As Double, y0 As Double, rad As Double, shade As _Unsigned Long)
2316.     Circle (_Width / 2 + x0, -y0 + _Height / 2), rad, shade
2317. End Sub
2318.  
2319. Sub BlockPoint (x0 As Double, y0 As Double, shade As _Unsigned Long)
2320.     Line (_Width / 2 + x0 - 3, -y0 + _Height / 2 - 3)-(_Width / 2 + x0 + 3, -y0 + _Height / 2 + 3), _RGB32(_Red32(shade), _Green32(shade), _Blue32(shade), 200), BF
2321. End Sub
2322.  
2323. Function ShadeMix~& (shade0 As _Unsigned Long, shade1 As _Unsigned Long, weight As Double)
2324.     ShadeMix~& = _RGB32((1 - weight) * _Red32(shade0) + weight * _Red32(shade1), (1 - weight) * _Green32(shade0) + weight * _Green32(shade1), (1 - weight) * _Blue32(shade0) + weight * _Blue32(shade1))
2325. End Function
2326.  
2327. Sub LineSmooth (x0, y0, x1, y1, c As _Unsigned Long)
2328.     ' source: https://en.wikipedia.org/w/index.php?title=Xiaolin_Wu%27s_line_algorithm&oldid=852445548
2329.     ' translated: FellippeHeitor @ qb64.org
2330.     ' updated slightly for this project
2331.  
2332.     Dim plX As Integer, plY As Integer, plI
2333.  
2334.     Dim steep As _Byte
2335.     steep = Abs(y1 - y0) > Abs(x1 - x0)
2336.  
2337.     If steep Then
2338.         Swap x0, y0
2339.         Swap x1, y1
2340.     End If
2341.  
2342.     If x0 > x1 Then
2343.         Swap x0, x1
2344.         Swap y0, y1
2345.     End If
2346.  
2347.     Dim dx, dy, gradient
2348.     dx = x1 - x0
2349.     dy = y1 - y0
2350.     gradient = dy / dx
2351.  
2352.     If dx = 0 Then
2353.         gradient = 1
2354.     End If
2355.  
2356.     'handle first endpoint
2357.     Dim xend, yend, xgap, xpxl1, ypxl1
2358.     xend = _Round(x0)
2359.     yend = y0 + gradient * (xend - x0)
2360.     xgap = (1 - ((x0 + .5) - Int(x0 + .5)))
2361.     xpxl1 = xend 'this will be used in the main loop
2362.     ypxl1 = Int(yend)
2363.     If steep Then
2364.         plX = ypxl1
2365.         plY = xpxl1
2366.         plI = (1 - (yend - Int(yend))) * xgap
2367.         GoSub plot
2368.  
2369.         plX = ypxl1 + 1
2370.         plY = xpxl1
2371.         plI = (yend - Int(yend)) * xgap
2372.         GoSub plot
2373.     Else
2374.         plX = xpxl1
2375.         plY = ypxl1
2376.         plI = (1 - (yend - Int(yend))) * xgap
2377.         GoSub plot
2378.  
2379.         plX = xpxl1
2380.         plY = ypxl1 + 1
2381.         plI = (yend - Int(yend)) * xgap
2382.         GoSub plot
2383.     End If
2384.  
2385.     Dim intery
2386.     intery = yend + gradient 'first y-intersection for the main loop
2387.  
2388.     'handle second endpoint
2389.     Dim xpxl2, ypxl2
2390.     xend = _Round(x1)
2391.     yend = y1 + gradient * (xend - x1)
2392.     xgap = ((x1 + .5) - Int(x1 + .5))
2393.     xpxl2 = xend 'this will be used in the main loop
2394.     ypxl2 = Int(yend)
2395.     If steep Then
2396.         plX = ypxl2
2397.         plY = xpxl2
2398.         plI = (1 - (yend - Int(yend))) * xgap
2399.         GoSub plot
2400.  
2401.         plX = ypxl2 + 1
2402.         plY = xpxl2
2403.         plI = (yend - Int(yend)) * xgap
2404.         GoSub plot
2405.     Else
2406.         plX = xpxl2
2407.         plY = ypxl2
2408.         plI = (1 - (yend - Int(yend))) * xgap
2409.         GoSub plot
2410.  
2411.         plX = xpxl2
2412.         plY = ypxl2 + 1
2413.         plI = (yend - Int(yend)) * xgap
2414.         GoSub plot
2415.     End If
2416.  
2417.     'main loop
2418.     Dim x
2419.     If steep Then
2420.         For x = xpxl1 + 1 To xpxl2 - 1
2421.             plX = Int(intery)
2422.             plY = x
2423.             plI = (1 - (intery - Int(intery)))
2424.             GoSub plot
2425.  
2426.             plX = Int(intery) + 1
2427.             plY = x
2428.             plI = (intery - Int(intery))
2429.             GoSub plot
2430.  
2431.             intery = intery + gradient
2432.         Next
2433.     Else
2434.         For x = xpxl1 + 1 To xpxl2 - 1
2435.             plX = x
2436.             plY = Int(intery)
2437.             plI = (1 - (intery - Int(intery)))
2438.             GoSub plot
2439.  
2440.             plX = x
2441.             plY = Int(intery) + 1
2442.             plI = (intery - Int(intery))
2443.             GoSub plot
2444.  
2445.             intery = intery + gradient
2446.         Next
2447.     End If
2448.  
2449.     Exit Sub
2450.  
2451.     plot:
2452.     ' Change to regular PSET for standard coordinate orientation.
2453.     Call CPset(plX, plY, _RGB32(_Red32(c), _Green32(c), _Blue32(c), plI * _Alpha32(c)))
2454.     Return
2455. End Sub
2456.  
2457. ' Camera transformation
2458.  
2459. Sub RotateUhat (dx As Double, dy As Double, dz As Double)
2460.     uhat(1) = uhat(1) + nhat(1) * dx
2461.     uhat(2) = uhat(2) + nhat(2) * dy
2462.     uhat(3) = uhat(3) + nhat(3) * dz
2463. End Sub
2464.  
2465. Sub RotateVhat (dx As Double, dy As Double, dz As Double)
2466.     vhat(1) = vhat(1) + nhat(1) * dx
2467.     vhat(2) = vhat(2) + nhat(2) * dy
2468.     vhat(3) = vhat(3) + nhat(3) * dz
2469. End Sub
2470.  
2471. Sub RotateUV (dx As Double, dy As Double, dz As Double)
2472.     Dim As Double v1, v2, v3
2473.     v1 = vhat(1)
2474.     v2 = vhat(2)
2475.     v3 = vhat(3)
2476.     vhat(1) = v1 + uhat(1) * dx
2477.     vhat(2) = v2 + uhat(2) * dy
2478.     vhat(3) = v3 + uhat(3) * dz
2479.     uhat(1) = uhat(1) - v1 * dx
2480.     uhat(2) = uhat(2) - v2 * dy
2481.     uhat(3) = uhat(3) - v3 * dz
2482. End Sub
2483.  
2484. Sub StrafeCameraUhat (dx As Double, dy As Double, dz As Double)
2485.     PlayerCamera.Position.x = PlayerCamera.Position.x + uhat(1) * dx
2486.     PlayerCamera.Position.y = PlayerCamera.Position.y + uhat(2) * dy
2487.     PlayerCamera.Position.z = PlayerCamera.Position.z + uhat(3) * dz
2488. End Sub
2489.  
2490. Sub StrafeCameraVhat (dx As Double, dy As Double, dz As Double)
2491.     PlayerCamera.Position.x = PlayerCamera.Position.x + vhat(1) * dx
2492.     PlayerCamera.Position.y = PlayerCamera.Position.y + vhat(2) * dy
2493.     PlayerCamera.Position.z = PlayerCamera.Position.z + vhat(3) * dz
2494. End Sub
2495.  
2496. Sub StrafeCameraNhat (dx As Double, dy As Double, dz As Double)
2497.     PlayerCamera.Position.x = PlayerCamera.Position.x + nhat(1) * dx
2498.     PlayerCamera.Position.y = PlayerCamera.Position.y + nhat(2) * dy
2499.     PlayerCamera.Position.z = PlayerCamera.Position.z + nhat(3) * dz
2500. End Sub
2501.  
2502. '''
2503.  

EDIT: Attached screenshot of looking straight up, about to capture an eclipse. 

[Cobalt]

man hits me up with 'Out of Memory' right out the door. yet task manager only shows 1gig in use.

[keybone]

That's awesome.  :-0
btw it works for me,

[Cobalt]

Ok, works with 64bit version.
Frame rate was less than stellar though. still ran fairly well but never came close to 60.

[Petr]

Very nice work! 29 - 31 FPS here. I go to play it again.