Physics Engine

[TerryRitchie]

Here's an attempt I made at a physics engine a while back. Move the mouse around inside the window. The program still has a few quirks.

Code: QB64: [Select]

1. CONST FALSE = 0, TRUE = NOT FALSE
2. CONST TIMESTEP = 1 / 30 '          total engine updates per second - should match any _LIMIT FPS in program
3. CONST BALLS = 25
4. CONST ROUND = 0, SQUARE = 1
5. CONST SWIDTH = 800
6. CONST SHEIGHT = 600
7. CONST FIXED = TRUE
8. CONST NONFIXED = FALSE
9.  
10. TYPE OBJECT
11.     Inuse AS INTEGER '         is object currently in use (TRUE / FALSE)
12.     Xpos AS SINGLE '           x position of object
13.     Ypos AS SINGLE '           y position of object
14.     Xvel AS SINGLE '           horizontal velocity of object
15.     Yvel AS SINGLE '           vertical velocity of object
16.     Radius AS SINGLE '         radius of object
17.     Gravity AS SINGLE '        object is affected by gravity (0 = no gravity, >0 gravity present)
18.     Friction AS SINGLE '       object has friction (0 = no friction, >0 friction present, use small increments of .1)
19.     Attract AS SINGLE '        amount of attraction to another object (0 = no attraction, <0 = repulsion, >0 = attraction)
20.     AttractedTo AS INTEGER '   handle of object attracted to
21.     Elastic AS SINGLE '        object has elastic collisions
22.     Fixed AS INTEGER '         object is in a fixed position (TRUE / FALSE)
23.     MaxSpeed AS SINGLE '       object's maximum speed
24.     Shape AS INTEGER '         object's shape (0 for circle, 1 for square)
25. END TYPE
26.  
27. REDIM Object(0) AS OBJECT '    array to hold objects
28. DIM Ball%(BALLS)
29. DIM Bcolor~&(BALLS)
30. DIM Count%
31. DIM rndRadius!, rndXpos!, rndYpos!, rndXvel!, rndYvel!
32. DIM Dummy%
33. DIM Paddle%
34. DIM OldMouseX%, OldMouseY%
35.  
36. SCREEN _NEWIMAGE(SWIDTH, SHEIGHT, 32)
37. CLS
38. _SCREENMOVE _MIDDLE
39.  
40. RANDOMIZE TIMER
41. FOR Count% = 1 TO BALLS '                                                      create random ball objects
42.     rndRadius! = INT(RND(1) * 20) + 10
43.     Bcolor~&(Count%) = _RGB32(INT(RND(1) * 256), INT(RND(1) * 256), INT(RND(1) * 256))
44.     Ball%(Count%) = DEFINEOBJECT(ROUND, rndRadius!)
45.     APPLYFRICTION Ball%(Count%), .01
46.     APPLYMAXSPEED Ball%(Count%), 100
47.     APPLYELASTIC Ball%(Count%), 1
48.     rndXpos! = INT(RND(1) * (SWIDTH - 1 - OBJECTRADIUS(Ball%(Count%)) * 2)) + OBJECTRADIUS(Ball%(Count%))
49.     rndYpos! = INT(RND(1) * (SHEIGHT - 1 - OBJECTRADIUS(Ball%(Count%)) * 2)) + OBJECTRADIUS(Ball%(Count%))
50.     rndXvel! = (RND(1) - RND(1)) '* 3
51.     rndYvel! = (RND(1) - RND(1)) '* 3
52.     PUTOBJECT Ball%(Count%), rndXpos!, rndYpos!, rndXvel!, rndYvel!, NONFIXED ' define where ball resides
53. NEXT Count%
54.  
55. Paddle% = DEFINEOBJECT(ROUND, 40) '                                            create a fixed ball with radius of 40
56. APPLYELASTIC Paddle%, .1 '                                                     give a slightly bouncy surface
57. PUTOBJECT Paddle%, SWIDTH / 2 - 1, SHEIGHT / 2 - 1, 0, 0, FIXED '              define where object resides
58. _MOUSEHIDE
59. _MOUSEMOVE SWIDTH / 2 - 1, SHEIGHT / 2 - 1
60.  
61. DO
62.     _LIMIT 30 ' we limit simulation to 30FPS - note that TIMESTEP constant should match this to avoid tunneling through objects
63.     CLS
64.     WHILE _MOUSEINPUT: WEND '                                                  get latest mouse information
65.     SETOBJECTX Paddle%, _MOUSEX '                                              set paddle object X location
66.     SETOBJECTY Paddle%, _MOUSEY '                                              set paddle object Y location
67.     SETOBJECTXVEL Paddle%, OBJECTX(Paddle%) - OldMouseX% '                     set paddle object X velocity
68.     SETOBJECTYVEL Paddle%, OBJECTY(Paddle%) - OldMouseY% '                     set paddle object Y velocity
69.     OldMouseX% = OBJECTX(Paddle%) '                                            remember paddle X position
70.     OldMouseY% = OBJECTY(Paddle%) '                                            remember paddle Y location
71.     FOR Count% = 1 TO BALLS '
72.         Dummy% = INTERACTION(Ball%(Count%)) '                                  check this ball's interaction with all other objects
73.         IF OBJECTX(Ball%(Count%)) < OBJECTRADIUS(Ball%(Count%)) THEN '         keep balls constrained to screen
74.             SETOBJECTXVEL Ball%(Count%), -OBJECTXVEL(Ball%(Count%))
75.             SETOBJECTX Ball%(Count%), OBJECTRADIUS(Ball%(Count%))
76.         END IF
77.         IF OBJECTX(Ball%(Count%)) > SWIDTH - OBJECTRADIUS(Ball%(Count%)) THEN
78.             SETOBJECTXVEL Ball%(Count%), -OBJECTXVEL(Ball%(Count%))
79.             SETOBJECTX Ball%(Count%), SWIDTH - OBJECTRADIUS(Ball%(Count%))
80.         END IF
81.         IF OBJECTY(Ball%(Count%)) < OBJECTRADIUS(Ball%(Count%)) THEN
82.             SETOBJECTYVEL Ball%(Count%), -OBJECTYVEL(Ball%(Count%))
83.             SETOBJECTY Ball%(Count%), OBJECTRADIUS(Ball%(Count%))
84.         END IF
85.         IF OBJECTY(Ball%(Count%)) > SHEIGHT - OBJECTRADIUS(Ball%(Count%)) THEN
86.             SETOBJECTYVEL Ball%(Count%), -OBJECTYVEL(Ball%(Count%))
87.             SETOBJECTY Ball%(Count%), SHEIGHT - OBJECTRADIUS(Ball%(Count%))
88.         END IF
89.         CIRCLE (OBJECTX(Ball%(Count%)), OBJECTY(Ball%(Count%))), OBJECTRADIUS(Ball%(Count%)), Bcolor~&(Count%)
90.         PAINT (OBJECTX(Ball%(Count%)), OBJECTY(Ball%(Count%))), Bcolor~&(Count%), Bcolor~&(Count%)
91.     NEXT Count%
92.     CIRCLE (OBJECTX(Paddle%), OBJECTY(Paddle%)), OBJECTRADIUS(Paddle%), _RGB32(255, 255, 255)
93.     PAINT (OBJECTX(Paddle%), OBJECTY(Paddle%)), _RGB32(255, 255, 255), _RGB32(255, 255, 255)
94.     _DISPLAY
95. LOOP UNTIL INKEY$ <> ""
96. SYSTEM
97.  
98. '------------------------------------------------------------------------------
99.  
100. FUNCTION OBJECTYVEL (Handle%)
101.  
102. '**
103. '** returns the Y velocity of an object
104. '**
105.  
106. SHARED Object() AS OBJECT
107.  
108. OBJECTYVEL = Object(Handle%).Yvel
109.  
110. END FUNCTION
111.  
112. '------------------------------------------------------------------------------
113.  
114. SUB SETOBJECTY (Handle%, Ypos!)
115.  
116. '**
117. '** returns the Y location of an object
118. '**
119.  
120. SHARED Object() AS OBJECT
121.  
122. Object(Handle%).Ypos = Ypos!
123.  
124. END SUB
125.  
126. '------------------------------------------------------------------------------
127.  
128. SUB SETOBJECTYVEL (Handle%, Yvel!)
129.  
130. '**
131. '** sets the Y velocity of an object
132. '**
133.  
134. SHARED Object() AS OBJECT
135.  
136. Object(Handle%).Yvel = Yvel!
137.  
138. END SUB
139.  
140. '------------------------------------------------------------------------------
141.  
142. SUB SETOBJECTX (Handle%, Xpos!)
143.  
144. '**
145. '** sets the X location of an object
146. '**
147.  
148. SHARED Object() AS OBJECT
149.  
150. Object(Handle%).Xpos = Xpos!
151.  
152. END SUB
153.  
154. '------------------------------------------------------------------------------
155.  
156. FUNCTION OBJECTXVEL (Handle%)
157.  
158. '**
159. '** returns the X velocity of an object
160. '**
161.  
162. SHARED Object() AS OBJECT
163.  
164. OBJECTXVEL = Object(Handle%).Xvel
165.  
166. END FUNCTION
167.  
168. '------------------------------------------------------------------------------
169.  
170. SUB SETOBJECTXVEL (Handle%, Xvel!)
171.  
172. '**
173. '** sets the X velocity of an object
174. '**
175.  
176. SHARED Object() AS OBJECT
177.  
178. Object(Handle%).Xvel = Xvel!
179.  
180. END SUB
181.  
182. '------------------------------------------------------------------------------
183.  
184. FUNCTION DEFINEOBJECT (Shape%, Radius!)
185.  
186. '**
187. '** defines an object (very basic, not finished yet)
188. '**
189.  
190. SHARED Object() AS OBJECT
191.  
192. DIM ob%
193.  
194. ob% = UBOUND(Object) + 1
195. REDIM _PRESERVE Object(ob%) AS OBJECT
196.  
197. Object(ob%).Inuse = -1
198. Object(ob%).Xpos = 0
199. Object(ob%).Ypos = 0
200. Object(ob%).Xvel = 0
201. Object(ob%).Yvel = 0
202. Object(ob%).Radius = Radius!
203. Object(ob%).Gravity = 0
204. Object(ob%).Friction = 0
205. Object(ob%).Attract = 0
206. Object(ob%).AttractedTo = 0
207. Object(ob%).Elastic = 1
208. Object(ob%).Fixed = 0
209. Object(ob%).MaxSpeed = 100
210. Object(ob%).Shape = Shape%
211.  
212. DEFINEOBJECT = ob%
213.  
214. END FUNCTION
215.  
216. '------------------------------------------------------------------------------
217.  
218. FUNCTION OBJECTRADIUS (Handle%)
219.  
220. '**
221. '** returns the radius of an object
222. '**
223.  
224. SHARED Object() AS OBJECT
225.  
226. OBJECTRADIUS = Object(Handle%).Radius
227.  
228. END FUNCTION
229.  
230. '------------------------------------------------------------------------------
231.  
232. FUNCTION OBJECTY (Handle%)
233.  
234. '**
235. '** returns the Y location of an object
236. '**
237.  
238. SHARED Object() AS OBJECT
239.  
240. OBJECTY = Object(Handle%).Ypos
241.  
242. END FUNCTION
243.  
244. '------------------------------------------------------------------------------
245.  
246. FUNCTION OBJECTX (Handle%)
247.  
248. '**
249. '** returns the X location of an object
250. '**
251.  
252. SHARED Object() AS OBJECT
253.  
254. OBJECTX = Object(Handle%).Xpos
255.  
256. END FUNCTION
257.  
258. '------------------------------------------------------------------------------
259.  
260. SUB APPLYMAXSPEED (Handle%, Maxspeed!)
261.  
262. '**
263. '** sets the maximum speed of an object (setting too low causes 45 degree movement, need to investigate)
264. '**
265.  
266. SHARED Object() AS OBJECT
267.  
268. Object(Handle%).MaxSpeed = Maxspeed!
269.  
270. END SUB
271.  
272. '------------------------------------------------------------------------------
273.  
274. SUB APPLYELASTIC (Handle%, Elastic!)
275.  
276. '**
277. '** sets the elastic property of an object (setting too low allows tunneling, need to investigate)
278. '**
279.  
280. SHARED Object() AS OBJECT
281.  
282. Object(Handle%).Elastic = Elastic!
283.  
284. END SUB
285.  
286. '------------------------------------------------------------------------------
287.  
288. SUB APPLYATTRACTION (Handle%, HandleTo%, Attract!)
289.  
290. '**
291. '** sets the attration to another object
292. '**
293.  
294. SHARED Object() AS OBJECT
295.  
296. Object(Handle%).Attract = Attract!
297. Object(Handle%).AttractedTo = HandleTo%
298.  
299. END SUB
300.  
301. '------------------------------------------------------------------------------
302.  
303. SUB APPLYFRICTION (Handle%, Friction!)
304.  
305. '**
306. '** sets the friction amount for an object
307. '**
308.  
309. SHARED Object() AS OBJECT
310.  
311. Object(Handle%).Friction = Friction!
312.  
313. END SUB
314.  
315. '------------------------------------------------------------------------------
316.  
317. SUB APPLYGRAVITY (Handle%, Gravity!)
318.  
319. '**
320. '** sets the amount of gravity on an object
321. '**
322.  
323. SHARED Object() AS OBJECT
324.  
325. Object(Handle%).Gravity = Gravity!
326.  
327. END SUB
328.  
329. '------------------------------------------------------------------------------
330.  
331. SUB PUTOBJECT (Handle%, Xpos!, Ypos!, Xvel!, Yvel!, Fixed%)
332.  
333. '**
334. '** defines where object resides
335. '**
336.  
337. SHARED Object() AS OBJECT
338.  
339. Object(Handle%).Xpos = Xpos!
340. Object(Handle%).Ypos = Ypos!
341. Object(Handle%).Xvel = Xvel!
342. Object(Handle%).Yvel = Yvel!
343. Object(Handle%).Fixed = Fixed%
344.  
345. END SUB
346.  
347. '------------------------------------------------------------------------------
348.  
349. FUNCTION INTERACTION (H1%)
350.  
351. '**
352. '** Checks the interaction between objects for a collision then calculates
353. '** the new object position based on those calculations.
354. '**
355. '** H1% - handle of object to test for collision
356. '**
357. '** Returns: 0 (FALSE) if no collision occured
358. '**         >0 the object that was collided with
359. '**
360. '** Function also updates gravity, friction and repulsion/attraction between the two objects.
361. '**
362. '** Note: this function is far from complete. Variables need to be updated with variables names and
363. '**       types identifiers that make sense.
364. '**
365.  
366.  
367. SHARED Object() AS OBJECT
368.  
369. DIM Diameter! '                                   the radius of object 1 plus the radius of object 2
370. DIM Distance! '                                   the distance from the center point of object 1 to the center point of object 2
371. DIM FrictionScale! '                              amount of frictional force to add to an object
372. DIM Xdifference! '                                the distance between object 1 X position and object 2 X position
373. DIM Ydifference! '                                the distance between object 1 Y position and onject 2 Y position
374. DIM H1Xvel!, H1Yvel!, H1Xpos!, H1Ypos! '          object 1's X and Y velocities and X and Y positions
375. DIM H2Xvel!, H2Yvel!, H2Xpos!, H2Ypos! '          object 2's X and Y velocities and X and Y positions
376. DIM cH1Xvel!, cH1Yvel!, cH1Xpos!, cH1Ypos! '      object 1's X and Y velocities and X and Y positions
377. DIM cH2Xvel!, cH2Yvel!, cH2Xpos!, cH2Ypos! '      object 2's X and Y velocities and X and Y positions
378. DIM CoefA!, CoefB!, CoefC! '                      object collision time coefficients
379. DIM TouchTime! '                                  actual time when object's touched
380. DIM MomentumX!, MomentumY! '                      momentum loss of objects when collision occurred
381. DIM OB! '                                         center line velocity vector
382. DIM Elastic! '                                    amount of elasticity applied to objects
383.  
384. IF Object(H1%).Fixed THEN EXIT FUNCTION '                                                if object is in a fixed position no need to continue
385.  
386. FOR H2% = 1 TO UBOUND(Object) '                                                          cycle through all defined objects
387.     IF (H2% <> H1%) AND Object(H2%).Inuse THEN '                                         object can't check itself or objects not in use
388.  
389.         diam = Object(H1%).Radius + Object(H2%).Radius '                                 calculate the length of both object radii
390.  
391.         '** update object position
392.  
393.         u = MIN(Object(H1%).MaxSpeed, MAX(Object(H1%).Xvel, -Object(H1%).MaxSpeed)) '    set maximum X velocity of object if needed
394.         v = MIN(Object(H1%).MaxSpeed, MAX(Object(H1%).Yvel, -Object(H1%).MaxSpeed)) '    set maximum Y velocity of object if needed
395.         x = Object(H1%).Xpos + TIMESTEP * u '                                            update object's X position
396.         y = Object(H1%).Ypos + TIMESTEP * v '                                            update object's Y position
397.  
398.         ' ** Gravity and Friction
399.  
400.         u = Object(H1%).Xvel '                                                           get object's X velocity
401.         v = Object(H1%).Yvel '                                                           get object's Y velocity
402.         fricscale = 1 - Object(H1%).Friction / SQR(1 + u ^ 2 + v ^ 2) '                  calculate the amount of friction needed (if any)
403.         Object(H1%).Xvel = fricscale * u '                                               apply friction amount to object's X velocity
404.         Object(H1%).Yvel = fricscale * v + Object(H1%).Gravity '                         apply friction and gravity amounts tp object's Y velocity
405.  
406.         '** check for collision
407.  
408.         xi = x '                                                                         copy object's updated X position
409.         yi = y '                                                                         copy object's updated Y position
410.         xj = Object(H2%).Xpos '                                                          get 2nd object's X position
411.         yj = Object(H2%).Ypos '                                                          get 2nd object's Y position
412.         dx = xi - xj '                                                                   calculate X distance between objects
413.         dy = yi - yj '                                                                   calculate Y distance between objetcs
414.         dist = SQR(dx ^ 2 + dy ^ 2) '                                                    calculate center to center distance between objects
415.         IF dist < diam THEN '                                                            is center to center distance less than diameter?
416.             INTERACTION = H2% '                                                          yes, return object that was collided with
417.  
418.             '** get object vectors
419.  
420.             ui = Object(H1%).Xvel '                                                      get object's X velocity
421.             vi = Object(H1%).Yvel '                                                      get object's Y velocity
422.             uj = Object(H2%).Xvel '                                                      get 2nd object's X velocity
423.             vj = Object(H2%).Yvel '                                                      get 2nd object's Y velocity
424.  
425.             '** move backwards in time until the two objects are just touching
426.  
427.             CoefA = (ui - uj) ^ 2 + (vi - vj) ^ 2 '                                      calculate time coefficiants of actual objects touching
428.             CoefB = 2 * ((ui - uj) * (xi - xj) + (vi - vj) * (yi - yj))
429.             CoefC = (xi - xj) ^ 2 + (yi - yj) ^ 2 - diam ^ 2
430.             IF CoefA = 0 THEN
431.                 t = -CoefC / CoefB
432.             ELSE
433.                 IF TIMESTEP >= 0 THEN
434.                     t = (-CoefB - SQR(CoefB ^ 2 - 4 * CoefA * CoefC)) / (2 * CoefA)
435.                 ELSE
436.                     t = (-CoefB + SQR(CoefB ^ 2 - 4 * CoefA * CoefC)) / (2 * CoefA)
437.                 END IF
438.             END IF
439.             xi = xi + t * ui '                                                           move object's X location to this point in time
440.             yi = yi + t * vi '                                                           move object's Y location to this point in time
441.             xj = xj + t * uj '                                                           move 2nd object's X location to this point in time
442.             yj = yj + t * vj '                                                           move 2nd object's Y location to this point in time
443.  
444.             '** center of momentum coordinates
445.  
446.             mx = (ui + uj) / 2 '                                                         calculate horizontal loss of momentum between objects
447.             my = (vi + vj) / 2 '                                                         calculate vertical loss of momentum between objects
448.             ui = ui - mx '                                                               update object's X velocity based on momentum loss
449.             vi = vi - my '                                                               update object's Y velocity based on momentum loss
450.             uj = uj - mx '                                                               update 2nd object's X velocity based on momentum loss
451.             vj = vj - my '                                                               update 2nd object's Y velocity based on momentum loss
452.  
453.             '** new center to center line
454.  
455.             dx = xi - xj '                                                               calculate X distance between objects
456.             dy = yi - yj '                                                               calculate Y distance between objects
457.             dist = SQR(dx ^ 2 + dy ^ 2) '                                                calculate center to center distance between objects
458.             dx = dx / dist '
459.             dy = dy / dist
460.  
461.             '** reflect object veolcity vectors in center to center line
462.  
463.             OB = -(dx * ui + dy * vi)
464.             ui = ui + 2 * OB * dx
465.             vi = vi + 2 * OB * dy
466.             OB = -(dx * uj + dy * vj)
467.             uj = uj + 2 * OB * dx
468.             vj = vj + 2 * OB * dy
469.  
470.             '** back to moving coordinates with elastic velocity change
471.  
472.             e = SQR(Object(H1%).Elastic)
473.             ui = e * (ui + mx)
474.             vi = e * (vi + my)
475.             uj = e * (uj + mx)
476.             vj = e * (vj + my)
477.  
478.             '** move to new bounced position
479.  
480.             xi = xi - t * ui
481.             yi = yi - t * vi
482.             xj = xj - t * uj
483.             yj = yj - t * vj
484.  
485.             '** set object velocities
486.  
487.             Object(H1%).Xvel = ui
488.             Object(H1%).Yvel = vi
489.  
490.             '** set 2nd object velocities and position if allowed to respond to first object
491.  
492.             IF NOT Object(H2%).Fixed THEN
493.                 Object(H2%).Xvel = uj
494.                 Object(H2%).Yvel = vj
495.                 Object(H2%).Xpos = xj
496.                 Object(H2%).Ypos = yj
497.             END IF
498.  
499.             '** set object position
500.  
501.             x = xi
502.             y = yi
503.         END IF
504.  
505.         '** attrack/repel the two objects to/against each other
506.  
507.         IF (Object(H1%).Attract <> 0) AND (Object(H1%).AttractedTo = H2%) THEN
508.             xm = Object(H2%).Xpos - x
509.             ym = Object(H2%).Ypos - y
510.             dist = xm ^ 2 + ym ^ 2
511.             dist = MAX(dist, Object(H1%).Radius ^ 2)
512.             Object(H1%).Xvel = Object(H1%).Attract * xm / dist + Object(H1%).Xvel
513.             Object(H1%).Yvel = Object(H1%).Attract * ym / dist + Object(H1%).Yvel
514.             Object(H2%).Xvel = Object(H1%).Attract * xm / dist + Object(H2%).Xvel
515.             Object(H2%).Yvel = -Object(H1%).Attract * ym / dist + Object(H2%).Yvel
516.         END IF
517.  
518.         '** save position of object
519.  
520.         Object(H1%).Xpos = x
521.         Object(H1%).Ypos = y
522.  
523.     END IF
524. NEXT H2%
525.  
526. END FUNCTION
527.  
528. '------------------------------------------------------------------------------
529.  
530. FUNCTION MIN (Num1!, Num2!)
531.  
532. '**
533. '** returns the smallest number passed in
534. '**
535.  
536. IF Num1! < Num2! THEN
537.     MIN = Num1!
538. ELSE
539.     MIN = Num2!
540. END IF
541.  
542. END FUNCTION
543.  
544. '------------------------------------------------------------------------------
545.  
546. FUNCTION MAX (Num1!, Num2!)
547.  
548. '**
549. '** returns the largest number passed in
550. '**
551.  
552. IF Num1! > Num2! THEN
553.     MAX = Num1!
554. ELSE
555.     MAX = Num2!
556. END IF
557.  
558. END FUNCTION
559.  

Here is a simplified version of it with the source of the idea cited in the code.

Code: QB64: [Select]

1. 'Most of the math in this code was realized from the following source:
2. 'http://smallbasic.com/program/?PMT149
3.  
4. CONST FALSE = 0, TRUE = NOT FALSE
5. CONST SWIDTH = 800, SHEIGHT = 600
6. CONST GRAVITY = 0 '   puck feels the affect of gravity. Higher numbers equal more gravity
7. CONST FRICTION = 0 '  puck had added friction. Use small increments of .1
8. CONST FOLLOW = 0
9. CONST ATTRACT = 0 '   puck is attracted to paddle. Higher numbers equal more attraction
10. CONST TIMESTEP = 1
11. CONST SHAPE = 0
12. CONST ELASTIC = 1
13.  
14. TYPE OBJECT
15.     Xpos AS SINGLE
16.     Ypos AS SINGLE
17.     Xvel AS SINGLE
18.     Yvel AS SINGLE
19.     Radius AS INTEGER
20. END TYPE
21.  
22. DIM Puck AS OBJECT
23. DIM Paddle AS OBJECT
24. DIM OldXpos!
25. DIM OldYpos!
26.  
27. SCREEN _NEWIMAGE(SWIDTH, SHEIGHT, 32)
28. CLS
29. _MOUSEHIDE
30. Puck.Xpos = SWIDTH \ 2 - 1
31. Puck.Ypos = SHEIGHT \ 2 - 1
32. Puck.Xvel = 0
33. Puck.Yvel = 0
34. Puck.Radius = 20
35. Paddle.Xpos = SWIDTH \ 2 - 1
36. Paddle.Ypos = SHEIGHT - SHEIGHT \ 4
37. Paddle.Xvel = 0
38. Paddle.Yvel = 0
39. Paddle.Radius = 40
40. _MOUSEMOVE Paddle.Xpos, Paddle.Ypos
41.  
42. diam = Paddle.Radius + Puck.Radius
43.  
44. DO
45.     _LIMIT 60
46.     CLS
47.  
48.     '** get paddle position based on mouse position
49.  
50.     WHILE _MOUSEINPUT: WEND
51.     Paddle.Xpos = _MOUSEX
52.     Paddle.Ypos = _MOUSEY
53.  
54.     '** calculate paddle velocities based on movement from last position
55.  
56.     Paddle.Xvel = Paddle.Xpos - OldXpos!
57.     Paddle.Yvel = Paddle.Ypos - OldYpos!
58.     OldXpos! = Paddle.Xpos
59.     OldYpos! = Paddle.Ypos
60.  
61.     '** update puck position
62.  
63.     u = MIN(100, MAX(Puck.Xvel, -100))
64.     v = MIN(100, MAX(Puck.Yvel, -100))
65.     x = Puck.Xpos + TIMESTEP * u
66.     y = Puck.Ypos + TIMESTEP * v
67.     IF x < Puck.Radius THEN
68.         Puck.Xvel = -Puck.Xvel
69.         x = Puck.Radius
70.     END IF
71.  
72.     '** check for edge bounces
73.  
74.     IF x > SWIDTH - Puck.Radius THEN
75.         Puck.Xvel = -Puck.Xvel
76.         x = SWIDTH - Puck.Radius
77.     END IF
78.     IF y < Puck.Radius THEN
79.         Puck.Yvel = -Puck.Yvel
80.         y = Puck.Radius
81.     END IF
82.     IF y > SHEIGHT - Puck.Radius THEN
83.         Puck.Yvel = -Puck.Yvel
84.         y = SHEIGHT - Puck.Radius
85.     END IF
86.  
87.     ' ** Gravity, Friction and Follow paddle
88.  
89.     xm = Paddle.Xpos - x
90.     ym = Paddle.Ypos - y
91.     dist = xm ^ 2 + ym ^ 2
92.     dist = MAX(dist, Puck.Radius * Puck.Radius)
93.     'dist = dist * SQR(dist)
94.     u = Puck.Xvel
95.     v = Puck.Yvel
96.     fricscale = 1 - FRICTION / SQR(1 + u ^ 2 + v ^ 2)
97.     Puck.Xvel = FOLLOW * xm / dist + fricscale * u
98.     Puck.Yvel = FOLLOW * ym / dist + fricscale * v + GRAVITY
99.  
100.     '** check for collision
101.  
102.     xi = x
103.     yi = y
104.     xj = Paddle.Xpos
105.     yj = Paddle.Ypos
106.     dx = xi - xj
107.     dy = yi - yj
108.     dist = SQR(dx ^ 2 + dy ^ 2)
109.     IF dist < diam THEN
110.         iscollision = TRUE
111.  
112.         '** get puck vectors
113.  
114.         ui = Puck.Xvel
115.         vi = Puck.Yvel
116.         uj = Paddle.Xvel
117.         vj = Paddle.Yvel
118.  
119.         '** move backwards (forwards if TIMESTEP < 0) in time until puck and paddle are just touching
120.  
121.         coefa = (ui - uj) ^ 2 + (vi - vj) ^ 2
122.         coefb = 2 * ((ui - uj) * (xi - xj) + (vi - vj) * (yi - yj))
123.         coefc = (xi - xj) ^ 2 + (yi - yj) ^ 2 - diam ^ 2
124.         IF coefa = 0 THEN
125.             t = -coefc / coefb
126.         ELSE
127.             IF TIMESTEP >= 0 THEN
128.                 t = (-coefb - SQR(coefb ^ 2 - 4 * coefa * coefc)) / (2 * coefa)
129.             ELSE
130.                 t = (-coefb + SQR(coefb ^ 2 - 4 * coefa * coefc)) / (2 * coefa)
131.             END IF
132.         END IF
133.         xi = xi + t * ui
134.         yi = yi + t * vi
135.         xj = xj + t * uj
136.         yj = yj + t * vj
137.  
138.         '** center of momentum coordinates
139.  
140.         mx = (ui + uj) / 2
141.         my = (vi + vj) / 2
142.         ui = ui - mx
143.         vi = vi - my
144.         uj = uj - mx
145.         vj = vj - my
146.  
147.         '** new center to center line
148.  
149.         dx = xi - xj
150.         dy = yi - yj
151.         dist = SQR(dx ^ 2 + dy ^ 2)
152.         dx = dx / dist
153.         dy = dy / dist
154.  
155.         '** reflect puck veolcity vectors in center to center line
156.  
157.         OB = -(dx * ui + dy * vi)
158.         ui = ui + 2 * OB * dx
159.         vi = vi + 2 * OB * dy
160.         OB = -(dx * uj + dy * vj)
161.         uj = uj + 2 * OB * dx
162.         vj = vj + 2 * OB * dy
163.  
164.         '** back to moving coordinates with elastic velocity change
165.  
166.         e = SQR(ELASTIC)
167.         ui = e * (ui + mx)
168.         vi = e * (vi + my)
169.         uj = e * (uj + mx)
170.         vj = e * (vj + my)
171.  
172.         '** move to new bounced position
173.  
174.         xi = xi - t * ui
175.         yi = yi - t * vi
176.         xj = xj - t * uj
177.         yj = yj - t * vj
178.  
179.         '** set puck velocities
180.  
181.         Puck.Xvel = ui
182.         Puck.Yvel = vi
183.  
184.         '** set paddle velocities and position if allowed to respond to puck
185.  
186.         'Paddle.Xvel = uj
187.         'Paddle.Yvel = vj
188.         'Paddle.Xpos = xj
189.         'Paddle.Ypos = yj
190.  
191.         '** set puck position
192.  
193.         x = xi
194.         y = yi
195.     END IF
196.  
197.     '** attrack/repel puck and paddle to each other
198.  
199.     IF ATTRACT <> 0 THEN
200.         xm = Paddle.Xpos - x
201.         ym = Paddle.Ypos - y
202.         dist = xm ^ 2 + ym ^ 2
203.         dist = MAX(dist, Puck.Radius ^ 2) ' *******  may be wrong?
204.         'dist = dist * SQR(dist)
205.         Puck.Xvel = ATTRACT * xm / dist + Puck.Xvel
206.         Puck.Yvel = ATTRACT * ym / dist + Puck.Yvel
207.         Paddle.Xvel = ATTRACT * xm / dist + Paddle.Xvel
208.         Paddle.Yvel = -ATTRACT * ym / dist + Paddle.Yvel
209.     END IF
210.  
211.     '** save position of puck
212.  
213.     Puck.Xpos = x
214.     Puck.Ypos = y
215.  
216.     '** draw puck and paddle
217.  
218.     CIRCLE (x, y), Puck.Radius, _RGB32(127, 127, 127)
219.     CIRCLE (Paddle.Xpos, Paddle.Ypos), Paddle.Radius, _RGB32(255, 255, 255)
220.  
221.     '** draw right angle between puck and paddle
222.  
223.     'LINE (Paddle.Xpos, Paddle.Ypos)-(Puck.Xpos, Puck.Ypos), _RGB32(64, 64, 64)
224.     'LINE -(Puck.Xpos, Paddle.Ypos), _RGB32(64, 64, 64)
225.     'LINE -(Paddle.Xpos, Paddle.Ypos), _RGB32(64, 64, 64)
226.     'LINE (Puck.Xpos, Paddle.Ypos)-(Puck.Xpos + (SGN(Paddle.Xpos - Puck.Xpos) * 10), Paddle.Ypos + (SGN(Puck.Ypos - Paddle.Ypos) * 10)), _RGB32(64, 64, 64), B
227.  
228.     '** play collision sound
229.  
230.     'IF iscollision THEN
231.     'play sound here
232.     'END IF
233.  
234.     '** update the display with changes
235.  
236.     _DISPLAY
237.  
238. LOOP
239.  
240. '------------------------------------------------------------------------------
241.  
242. FUNCTION MIN (Num1!, Num2!)
243.  
244. IF Num1! < Num2! THEN
245.     MIN = Num1!
246. ELSE
247.     MIN = Num2!
248. END IF
249.  
250. END FUNCTION
251.  
252. '------------------------------------------------------------------------------
253.  
254. FUNCTION MAX (Num1!, Num2!)
255.  
256. IF Num1! > Num2! THEN
257.     MAX = Num1!
258. ELSE
259.     MAX = Num2!
260. END IF
261.  
262. END FUNCTION
263.  

[johnno56]

Very nicely done indeed... Cool.

[Petr]

Perfect!

[bplus]

Holly Son of the Universal Machine!

That might just be what I needed to finish my Pool Game!

          :-) )  yea!

[johnno56]

Pool? Did some just say, "Pool"?

[TempodiBasic]

Hi
interesting and fine...

[Qwerkey]

Terry, I tried substituting ROUND with SQUARE for object type but everything remained as circles.  Did I miss something or is it to do with "'** defines an object (very basic, not finished yet)" ie you haven't put it anything to do with squares yet?  Richard

[OldMoses]

I would have to study the code to even tell if it's over my head, but....

That was fun! :D

[TerryRitchie]

Math is not my strong suit. I understand it but putting it to practical use for things such as 3D visualization has always eluded me. In the second code listing I cite the source for inspiration.

[TerryRitchie]

Holly Son of the Universal Machine!

That might just be what I needed to finish my Pool Game!

          :-) )  yea!

LOL, I missed this post. I hope you can use/modify the code to your needs. Seems perfect for pool!

My original thought was to somehow include this code in my sprite library, giving sprites the ability to interact much like the 2D engine in Angry Birds.

[bplus]

Yes, pool will likely be revisited, my own 2D collisions did OK with bouncing balls but complete disaster with pool.

Terry have you played with Boids? maybe that's what Angry Birds are?

[TerryRitchie]

Box2D is the engine used by Angry Birds. I've never heard of Boids and from research it appears to be an artificial life program, generating paths for flocks of birds for instance.

[johnno56]

This may be a stupid question.... Box2D and "this" Physics Engine did not just 'appear'. I would like to know 'how' those 'physical models' (for want of a better phrase)  were converted into QB64 etc? Reason: If I wanted to 'add' another feature I would either have to suggest it and wait for someone to make it or someone could show me how it's done and I could do it myself... (I am not saying that I have anything to 'add', it's just a 'what if' kind of thing...)

J

[TerryRitchie]

In the case of my engine I used the source code of the program I cited in the second listing. Even though the original source is written in another language I can usually get the main gist of the code enough to rewrite it in QB64. Once I have an idea of what is going on math-wise, I then play around with the code to achieve my desired result.

The entire source of Box2D is available at their web site, however it's written in C++, a language I very poorly comprehend when dealing with code as involved as a 2D physics engine. C++'s constructs are my weak point.

Many graphics engines come into being because of a need. The Unreal engine due to Epic creating the Unreal game back in the 90's. Box2D came about from a group of programmers getting together at a gaming conference and wanting to build something better. The Doom engine, Half-life Engine, Quake Engine, Unity, etc.. all had a specific need to fill. I feel QB64 needs a 2D (or even 3D) engine (library) however I won't be able to deliver that given my weak math skills. We have the talent here to pull it off, but first there must be a defined need for it, a driving force if you will.

Unfortunately, people that are skilled enough in math to write something as complex as a physics engine are going to apply their talent for a much larger audience than we have here.

It can be done though. Check out this code by Galleon done years ago with QB64. It's a Portals clone!

[FellippeHeitor]

Very entertaining physics demo with the bouncing balls, Terry.

The Portals clone by Galleon is amazing, I hadn't seen it before.

It requires _MOUSEMOVEMENTX and _MOUSEMOVEMENTY which haven't yet gotten fixed since the switch to OpenGL, so here's a fixed version that can be compiled with the latest version of QB64:

Code: QB64: [Select]

1. 'CONTROLS:
2. 'Left Mouse Button: Fire a blue portal
3. 'Right Mouse Button: Fire an orange portal
4. 'Mouse Movement: Look around
5. 'W,A,S,D: Move forward, left, back and right
6. 'Space: Jump
7.  
8. DEFDBL A-Z
9.  
10. DIM SHARED ScreenX AS LONG
11. DIM SHARED ScreenY AS LONG
12.  
13. 'Note: Unplayable at higher resolutions! (Try it at 160x120 for realtime speed)
14. ScreenX = 320
15. ScreenY = 240
16.  
17. RANDOMIZE TIMER
18.  
19. _TITLE "PORTALS QB64"
20.  
21.  
22. DIM SHARED portal(1 TO 2) AS INTEGER
23. 'indexes to currently open portals (if any!)
24.  
25. '[8](256) standard textures in standard orientations
26. '[10](1024) special references/modifiers
27.  
28. TYPE SpecialType
29.     Effect AS INTEGER
30.     '"this" box
31.     X AS LONG
32.     Y AS LONG
33.     Z AS LONG
34.     '"this" side/vector
35.     dX AS LONG '1,0,-1
36.     dY AS LONG '1,0,-1
37.     dZ AS LONG '1,0,-1
38.     '"reference" box
39.     X2 AS INTEGER
40.     Y2 AS INTEGER
41.     Z2 AS INTEGER
42.     '"reference" side/vector
43.     dX2 AS INTEGER '1,0,-1
44.     dY2 AS INTEGER '1,0,-1
45.     dZ2 AS INTEGER '1,0,-1
46. END TYPE
47. DIM SHARED Special(1023) AS SpecialType
48.  
49.  
50.  
51.  
52. DIM SHARED vax, vay
53.  
54.  
55. DIM SHARED KeyDown(255) AS LONG
56.  
57. DIM SHARED LastTime
58. DIM SHARED ElapsedTime 'how many seconds have elapsed since the last main loop
59.  
60. TYPE ObjectType
61.     X AS DOUBLE
62.     Y AS DOUBLE
63.     Z AS DOUBLE
64.     Height AS DOUBLE
65.     dX AS DOUBLE
66.     dY AS DOUBLE
67.     dZ AS DOUBLE
68. END TYPE
69.  
70. DIM Plr AS ObjectType
71. Plr.X = 50
72. Plr.Y = 50
73. Plr.Z = 50
74. Plr.Height = 0.85
75.  
76.  
77. DIM SHARED UX AS LONG, UY AS LONG, UZ AS LONG 'start of ray
78. DIM SHARED UdX AS LONG, UdY AS LONG, UdZ AS LONG 'vector to scan
79. DIM SHARED UDis AS LONG
80. DIM SHARED USGNdX AS LONG, USGNdY AS LONG, USGNdZ AS LONG '0=negative, 1=zero or positive
81. DIM SHARED USpeedX AS LONG, USpeedY AS LONG, USpeedZ AS LONG, UMinSpeed AS LONG
82. DIM SHARED UABSdX AS LONG, UABSdY AS LONG, UABSdZ AS LONG '0=negative, 1=zero or positive
83. DIM SHARED UCrossed AS LONG
84. DIM SHARED URayDepth AS LONG, UMaxDepth AS LONG
85. DIM SHARED UBoxType AS LONG
86. UMaxDepth = 8
87. DIM SHARED Ui AS LONG
88. DIM SHARED Ulr AS LONG, Udu AS LONG
89. DIM SHARED UdX2 AS LONG, UdY2 AS LONG, UdZ2 AS LONG
90. DIM SHARED UdX3 AS LONG, UdY3 AS LONG, UdZ3 AS LONG
91.  
92.  
93.  
94.  
95.  
96. DIM SHARED MapLimit AS LONG
97. MapLimit = 100
98. DIM SHARED Map(0 TO MapLimit, 0 TO MapLimit, 0 TO MapLimit) AS _UNSIGNED INTEGER
99.  
100. SCREEN _NEWIMAGE(ScreenX, ScreenY, 32)
101. _DONTBLEND
102. DIM ScrBuf(-1 TO ScreenX * ScreenY - 1) AS LONG
103. GET (0, 0)-(ScreenX - 1, ScreenY - 1), ScrBuf()
104.  
105.  
106.  
107.  
108.  
109. FOR i = 1 TO 5
110.     texi = _LOADIMAGE(".\portals\cube" + LTRIM$(STR$(i)) + ".bmp", 32)
111.     _SOURCE texi
112.     TexX = _WIDTH(texi) - 1
113.     TexY = _HEIGHT(texi) - 1
114.  
115.     UTexX& = TexX
116.     UTexY& = TexY
117.  
118.     IF i = 1 THEN DIM Tex(TexX, TexY, 1 TO 5) AS LONG
119.  
120.     FOR y = 0 TO TexY
121.         FOR x = 0 TO TexX
122.             Tex(x, y, i) = POINT(x, y)
123.         NEXT
124.     NEXT
125.     _FREEIMAGE texi
126. NEXT
127. _SOURCE 0
128.  
129.  
130.  
131. FOR i = 1 TO 5
132.     texi = _LOADIMAGE(".\portals\wall" + LTRIM$(STR$(i)) + ".bmp", 32)
133.     _SOURCE texi
134.     TexX = _WIDTH(texi) - 1
135.     TexY = _HEIGHT(texi) - 1
136.  
137.     UTexX& = TexX
138.     UTexY& = TexY
139.  
140.     IF i = 1 THEN DIM Tex2(TexX, TexY, 1 TO 5) AS LONG
141.     FOR y = 0 TO TexY: FOR x = 0 TO TexX: Tex2(x, y, i) = POINT(x, y): NEXT: NEXT
142.     _FREEIMAGE texi
143. NEXT
144. _SOURCE 0
145.  
146.  
147. FOR i = 1 TO 5
148.     texi = _LOADIMAGE(".\portals\but" + LTRIM$(STR$(i)) + ".bmp", 32)
149.     _SOURCE texi
150.     TexX = _WIDTH(texi) - 1
151.     TexY = _HEIGHT(texi) - 1
152.  
153.     UTexX& = TexX
154.     UTexY& = TexY
155.  
156.     IF i = 1 THEN DIM Tex3(TexX, TexY, 1 TO 5) AS LONG
157.  
158.     FOR y = 0 TO TexY
159.         FOR x = 0 TO TexX
160.             Tex3(x, y, i) = POINT(x, y)
161.         NEXT
162.     NEXT
163.     _FREEIMAGE texi
164. NEXT
165. _SOURCE 0
166.  
167.  
168.  
169.  
170.  
171.  
172.  
173.  
174. texi = _LOADIMAGE(".\portals\p_floor.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
175. DIM t_floor(TexX, TexY, 1 TO 1) AS LONG
176. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_floor(x, y, 1) = POINT(x, y): NEXT: NEXT
177. _FREEIMAGE texi: _SOURCE 0
178.  
179. texi = _LOADIMAGE(".\portals\p_walla.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
180. DIM t_walla(TexX, TexY, 1 TO 1) AS LONG
181. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_walla(x, y, 1) = POINT(x, y): NEXT: NEXT
182. _FREEIMAGE texi: _SOURCE 0
183.  
184. texi = _LOADIMAGE(".\portals\p_wallb.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
185. DIM t_wallb(TexX, TexY, 1 TO 1) AS LONG
186. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_wallb(x, y, 1) = POINT(x, y): NEXT: NEXT
187. _FREEIMAGE texi: _SOURCE 0
188.  
189. texi = _LOADIMAGE(".\portals\p_roof.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
190. DIM t_roof(TexX, TexY, 1 TO 1) AS LONG
191. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_roof(x, y, 1) = POINT(x, y): NEXT: NEXT
192. _FREEIMAGE texi: _SOURCE 0
193.  
194. texi = _LOADIMAGE(".\portals\p_buta.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
195. DIM t_buta(TexX, TexY, 1 TO 1) AS LONG
196. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_buta(x, y, 1) = POINT(x, y): NEXT: NEXT
197. _FREEIMAGE texi: _SOURCE 0
198.  
199. texi = _LOADIMAGE(".\portals\p_butb.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
200. DIM t_butb(TexX, TexY, 1 TO 1) AS LONG
201. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_butb(x, y, 1) = POINT(x, y): NEXT: NEXT
202. _FREEIMAGE texi: _SOURCE 0
203.  
204.  
205. texi = _LOADIMAGE(".\portals\p_s_box.bmp", 32): _SOURCE texi: TexX = _WIDTH(texi) - 1: TexY = _HEIGHT(texi) - 1: UTexX& = TexX: UTexY& = TexY
206. DIM t_s_box(TexX, TexY, 1 TO 1) AS LONG
207. FOR y = 0 TO TexY: FOR x = 0 TO TexX: t_s_box(x, y, 1) = POINT(x, y): NEXT: NEXT
208. _FREEIMAGE texi: _SOURCE 0
209.  
210.  
211.  
212.  
213. DIM SHARED FovX AS DOUBLE, FovY AS DOUBLE
214. FovX = 75
215. FovY = ScreenY / ScreenX * FovX
216.  
217.  
218. DIM PixSinX(ScreenX - 1)
219. DIM PixSinY(ScreenY - 1)
220.  
221. DIM PixX(ScreenX * ScreenY - 1) AS LONG
222. DIM PixY(ScreenX * ScreenY - 1) AS LONG
223. DIM PixZ(ScreenX * ScreenY - 1) AS LONG
224.  
225. DIM SHARED deg2rad AS DOUBLE
226. deg2rad = 3.151592654 / 180
227.  
228. ay = -FovY / 2
229. ayi = FovY / ScreenY
230. FOR sy = ScreenY - 1 TO 0 STEP -1
231.     a2 = ay * deg2rad
232.     PixSinY(sy) = SIN(a2)
233.     ay = ay + ayi
234. NEXT
235.  
236. ax = -FovX / 2
237. axi = FovX / ScreenX
238. FOR sx = 0 TO ScreenX - 1
239.     a1 = ax * deg2rad
240.     PixSinX(sx) = SIN(a1)
241.     ax = ax + axi
242. NEXT
243.  
244. FOR sy = ScreenY - 1 TO 0 STEP -1
245.     FOR sx = 0 TO ScreenX - 1
246.         x = PixSinX(sx)
247.         y = PixSinY(sy)
248.         z = 1
249.         l = SQR(x * x + y * y + z * z)
250.         x = x / l
251.         y = y / l
252.         z = z / l
253.         PixX(sy * ScreenX + sx) = x * 16384#
254.         PixY(sy * ScreenX + sx) = y * 16384#
255.         PixZ(sy * ScreenX + sx) = z * 16384#
256.     NEXT
257. NEXT
258.  
259.  
260.  
261. 'lets try a 2d test to see if we are getting anywhere with this, then a proper 3d test
262. 'to test anything we need a map
263.  
264.  
265. 'FOR x = -10 TO 10
266. 'Map(x + 50, 50, -10 + 50) = 1
267. 'Map(x + 50, 50, 10 + 50) = 1
268. 'NEXT
269. 'FOR z = -10 TO 10
270. 'Map(-10 + 50, 50, z + 50) = 1
271. 'Map(10 + 50, 50, z + 50) = 1
272. 'NEXT
273.  
274.  
275. 'floor n roof
276. 'FOR x = 0 TO MapLimit
277. 'FOR z = 0 TO MapLimit
278. '  Map(x, 49, z) = 1
279. 'Map(x, 60, z) = 1
280. 'NEXT
281. 'NEXT
282.  
283. FOR x = 0 TO MapLimit
284.     FOR y = 0 TO MapLimit
285.         FOR z = 0 TO MapLimit
286.             Map(x, y, z) = 1
287.             'IF y = 49 AND RND * 10 < 1 THEN Map(x, y, z) = 3
288.             '      IF RND * 20 < 1 THEN Map(x, y, z) = 4
289.         NEXT
290.     NEXT
291. NEXT
292.  
293.  
294. FOR x = 0 TO MapLimit: FOR z = 0 TO MapLimit
295.         Map(x, 49, z) = 10
296.         IF RND * 50 < 1 THEN Map(x, 49, z) = 14
297. NEXT: NEXT
298. FOR x = 0 TO MapLimit: FOR z = 0 TO MapLimit
299.         Map(x, 50, z) = 11
300. NEXT: NEXT
301. FOR x = 0 TO MapLimit: FOR z = 0 TO MapLimit
302.         Map(x, 51, z) = 12
303.         IF RND * 20 < 1 THEN Map(x, 51, z) = 15
304. NEXT: NEXT
305.  
306. FOR x = 0 TO MapLimit: FOR z = 0 TO MapLimit
307.         Map(x, 52, z) = 11
308. NEXT: NEXT
309. FOR x = 0 TO MapLimit: FOR z = 0 TO MapLimit
310.         Map(x, 53, z) = 12
311. NEXT: NEXT
312. FOR x = 0 TO MapLimit: FOR z = 0 TO MapLimit
313.         Map(x, 54, z) = 13
314. NEXT: NEXT
315.  
316.  
317.  
318. FOR x = -5 TO 5
319.     FOR y = 0 TO 3
320.         FOR z = -5 TO 5
321.             Map(50 + x, 50 + y, 50 + z) = 0
322.         NEXT
323.     NEXT
324. NEXT
325.  
326. Map(50 - 6, 50, 50) = 2
327.  
328.  
329. 'Map(50, 50 + 0, 50 - 6) = 2 + 1024
330.  
331. 'Special(1).dX = 0
332. 'Special(1).dY = 0
333. 'Special(1).dZ = 1
334. 'Special(1).X = 50
335. 'Special(1).Y = 52
336. 'Special(1).Z = 50 - 4
337.  
338.  
339.  
340.  
341.  
342. 'FOR i = 1 TO 250
343. '  xx = RND * 10
344. 'yy = RND * 10
345. 'zz = RND * 10
346. 'Map(46 + xx, 50 + yy, 48 + zz) = 1
347. 'NEXT
348.  
349. FOR i = 1 TO 50
350.     xx = rnd2(4)
351.     yy = INT(RND * 5)
352.     zz = rnd2(4)
353.  
354.     IF Map(50 + xx, 50 + yy - 1, 50 + zz) THEN Map(50 + xx, 50 + yy, 50 + zz) = 2
355.  
356. NEXT
357.  
358.  
359. 'Map(46, 50, 48) = 4
360.  
361. 'Map(46, 50, 52) = 4
362.  
363.  
364.  
365.  
366.  
367.  
368.  
369.  
370. vax = 0
371. vay = 0
372.  
373.  
374. DIM SHARED sX AS LONG
375. DIM SHARED sY AS LONG
376.  
377.  
378.  
379.  
380. starttime = TIMER(0.001)
381.  
382. LastTime = TIMER(0.001)
383. DO
384.     _LIMIT 60
385.  
386.     Uvaxs& = SIN(vax * deg2rad) * 16384&: Uvaxc& = COS(vax * deg2rad) * 16384&
387.     Uvays& = SIN(vay * deg2rad) * 16384&: Uvayc& = COS(vay * deg2rad) * 16384&
388.  
389.     DIM SHARED PixOff AS LONG
390.  
391.  
392.     ay = -FovY / 2
393.     ayi = FovY / ScreenY
394.  
395.  
396.  
397.  
398.     Upx1& = Plr.X * 16384#
399.     Upy1& = (Plr.Y + Plr.Height) * 16384#
400.     Upz1& = Plr.Z * 16384#
401.  
402.     '$CHECKING:OFF
403.  
404.     FOR sY = ScreenY - 1 TO 0 STEP -1
405.         siny = PixSinY(sY)
406.  
407.         PixOff = sY * ScreenX
408.         FOR sX = 0 TO ScreenX - 1
409.  
410.             x& = PixX(PixOff)
411.             y& = PixY(PixOff)
412.             z& = PixZ(PixOff)
413.  
414.  
415.  
416.             UdY& = (Uvays& * z&) \ 16384 + (Uvayc& * y&) \ 16384
417.             z& = (Uvayc& * z&) \ 16384 - (Uvays& * y&) \ 16384
418.  
419.             UdX& = (Uvaxs& * z&) \ 16384 + (Uvaxc& * x&) \ 16384
420.             UdZ& = (Uvaxc& * z&) \ 16384 - (Uvaxs& * x&) \ 16384
421.  
422.             UX& = Upx1&
423.             UY& = Upy1&
424.             UZ& = Upz1&
425.  
426.  
427.  
428.             'copy from here
429.  
430.             IF UdX& >= 0 THEN USGNdX = 1 ELSE USGNdX = 0
431.             IF UdY& >= 0 THEN USGNdY = 1 ELSE USGNdY = 0
432.             IF UdZ& >= 0 THEN USGNdZ = 1 ELSE USGNdZ = 0
433.  
434.             UABSdX& = ABS(UdX&)
435.             UABSdY& = ABS(UdY&)
436.             UABSdZ& = ABS(UdZ&)
437.  
438.             UDis& = 0
439.  
440.             URayDepth = 0
441.  
442.             main_1: 'remove this line when possible
443.  
444.             DO
445.  
446.                 'calculate x,y,z distance to next 'cube'
447.                 IF USGNdX THEN
448.                     UDistx& = 16384 - (UX& AND 16383)
449.                     IF UDistx& = 0 THEN UDistx& = 16384
450.                 ELSE
451.                     UDistx& = (UX& AND 16383) + 1
452.                 END IF
453.                 IF USGNdY THEN
454.                     UDisty& = 16384 - (UY& AND 16383)
455.                     IF UDisty& = 0 THEN UDisty& = 16384
456.                 ELSE
457.                     UDisty& = (UY& AND 16383) + 1
458.                 END IF
459.                 IF USGNdZ THEN
460.                     UDistz& = 16384 - (UZ& AND 16383)
461.                     IF UDistz& = 0 THEN UDistz& = 16384
462.                 ELSE
463.                     UDistz& = (UZ& AND 16383) + 1
464.                 END IF
465.  
466.                 IF UABSdX& <> 0 THEN USpeedX& = (UDistx& * 16384) \ UABSdX& ELSE USpeedX& = 2147483647
467.                 IF UABSdY& <> 0 THEN USpeedY& = (UDisty& * 16384) \ UABSdY& ELSE USpeedY& = 2147483647
468.                 IF UABSdZ& <> 0 THEN USpeedZ& = (UDistz& * 16384) \ UABSdZ& ELSE USpeedZ& = 2147483647
469.  
470.                 'advance minimal speed + microstep(to cater for floating point errors only)
471.                 UCrossed& = 1
472.                 UMinSpeed& = USpeedX&
473.                 IF USpeedY& < UMinSpeed& THEN UMinSpeed& = USpeedY&: UCrossed& = 2
474.                 IF USpeedZ& < UMinSpeed& THEN UMinSpeed& = USpeedZ&: UCrossed& = 3
475.                 UMinSpeed& = UMinSpeed& + 1
476.                 UDis& = UDis& + UMinSpeed&
477.  
478.                 UX& = UX& + (UdX& * UMinSpeed&) \ 16384
479.                 UY& = UY& + (UdY& * UMinSpeed&) \ 16384
480.                 UZ& = UZ& + (UdZ& * UMinSpeed&) \ 16384
481.  
482.                 UBoxType& = Map(UX& \ 16384, UY& \ 16384, UZ& \ 16384)
483.             LOOP UNTIL UBoxType&
484.  
485.  
486.             IF UBoxType > 255 THEN
487.  
488.                 URayDepth = URayDepth + 1
489.                 IF URayDepth > UMaxDepth THEN
490.                     ScrBuf(PixOff) = 0
491.                     GOTO 3
492.                 END IF
493.  
494.                 Ui = UBoxType \ 256
495.  
496.  
497.                 IF UCrossed = 1 THEN
498.                     IF USGNdX THEN
499.                         Ulr = 16383 - (UZ& AND 16383): Udu = UY& AND 16383
500.                         UdX2 = -UdZ: UdY2 = UdY: UdZ2 = UdX
501.                     ELSE
502.                         Ulr = UZ& AND 16383: Udu = UY& AND 16383
503.                         UdX2 = UdZ: UdY2 = UdY: UdZ2 = -UdX
504.                     END IF
505.                 END IF
506.  
507.                 IF UCrossed = 2 THEN
508.                     IF USGNdY THEN
509.                         Ulr = UX& AND 16383: Udu = 16383 - (UZ& AND 16383)
510.                         UdX2 = UdX: UdY2 = -UdZ: UdZ2 = UdY
511.                     ELSE
512.                         Ulr = UX& AND 16383: Udu = UZ& AND 16383
513.                         UdX2 = UdX: UdY2 = UdZ: UdZ2 = -UdY
514.                     END IF
515.                 END IF
516.  
517.  
518.                 IF UCrossed = 3 THEN
519.                     IF USGNdZ THEN
520.                         Ulr = UX& AND 16383: Udu = UY& AND 16383
521.                         UdX2 = UdX: UdY2 = UdY: UdZ2 = UdZ
522.                     ELSE
523.                         Ulr = 16383 - (UX& AND 16383): Udu = UY& AND 16383
524.                         UdX2 = -UdX: UdY2 = UdY: UdZ2 = -UdZ
525.                     END IF
526.                 END IF
527.  
528.                 x = (Ulr / 16384) - 0.5
529.                 y = (Udu / 16384) - 0.5
530.                 ll = x * x + y * y
531.  
532.                 IF ll > .25 THEN UBoxType = UBoxType AND 255: GOTO 77
533.  
534.  
535.                 IF ll > .23 THEN 'ring
536.                     IF Ui = 1 THEN c& = _RGB(64, 128, 255) ELSE c& = _RGB(255, 128, 64)
537.                     GOTO 770
538.                 END IF
539.  
540.                 IF Ui = 1 THEN
541.                     IF portal(2) = 0 THEN
542.                         c& = _RGB(32, 64, 128)
543.                         GOTO 770
544.                     ELSE
545.  
546.                     END IF
547.                 END IF
548.  
549.                 IF Ui = 2 THEN
550.                     IF portal(1) = 0 THEN
551.                         c& = _RGB(128, 64, 32)
552.                         GOTO 770
553.                     ELSE
554.  
555.                     END IF
556.                 END IF
557.  
558.  
559.                 IF Ui = 1 THEN Ui = 2 ELSE Ui = 1
560.                 '      LOCATE 1, 1
561.                 '       PRINT UdX, UdY, UdZ
562.  
563.                 '        PRINT UdX2, UdY2, UdZ2
564.                 '        UDisPLAY
565.                 '        SLEEP
566.  
567.                 'assume top down vantage
568.  
569.  
570.                 '        UDisPLAY
571.                 '       SLEEP
572.  
573.  
574.  
575.  
576.  
577.                 UX = Special(Ui).X
578.                 UZ = Special(Ui).Z
579.                 UY = Special(Ui).Y
580.  
581.                 UdX3 = Special(Ui).dX
582.                 UdY3 = Special(Ui).dY
583.                 UdZ3 = Special(Ui).dZ
584.  
585.                 IF UdX3 THEN
586.                     IF UdX3 >= 0 THEN
587.                         UX = UX + 16383
588.                         UZ = UZ + 16383 - Ulr
589.                         UY = UY + Udu
590.                         UdX = UdZ2
591.                         UdY = UdY2
592.                         UdZ = -UdX2
593.                     ELSE
594.                         UX = UX
595.                         UZ = UZ + Ulr
596.                         UY = UY + Udu
597.                         UdX = -UdZ2
598.                         UdY = UdY2
599.                         UdZ = UdX2
600.                     END IF
601.                 END IF
602.  
603.  
604.  
605.                 IF UdZ3 THEN
606.                     IF UdZ3 >= 0 THEN
607.                         UX = UX + Ulr
608.                         UZ = UZ + 16383
609.                         UY = UY + Udu
610.                         UdX = UdX2
611.                         UdY = UdY2
612.                         UdZ = UdZ2
613.                     ELSE
614.                         UX = UX + 16383 - Ulr
615.                         UZ = UZ
616.                         UY = UY + Udu
617.                         UdX = -UdX2
618.                         UdY = UdY2
619.                         UdZ = -UdZ2
620.                     END IF
621.                 END IF
622.  
623.  
624.  
625.  
626.                 '        UX& = Special(Ui).X * 16384# + Ulr
627.                 '        UZ& = Special(Ui).Z * 16384# + Udu
628.                 '        UY& = Special(Ui).Y * 16384#
629.  
630.  
631.                 '        UdX = UdX2
632.                 '        UdZ = UdY2
633.                 '        UdY = -UdZ2
634.  
635.  
636.                 IF UdY3 THEN
637.                     IF UdY3 >= 0 THEN
638.                         UX = UX + Ulr
639.                         UZ = UZ + 16383 - Udu
640.                         UY = UY + 16383
641.                         UdX = UdX2
642.                         UdY = UdZ2
643.                         UdZ = -UdY2
644.                     ELSE
645.                         UX = UX + Ulr
646.                         UZ = UZ + Udu
647.                         UY = UY
648.                         UdX = UdX2
649.                         UdY = -UdZ2
650.                         UdZ = UdY2
651.                     END IF
652.                 END IF
653.  
654.  
655.  
656.  
657.                 IF UdY& >= 0 THEN USGNdY = 1 ELSE USGNdY = 0
658.                 IF UdX& >= 0 THEN USGNdX = 1 ELSE USGNdX = 0
659.                 IF UdZ& >= 0 THEN USGNdZ = 1 ELSE USGNdZ = 0
660.                 UABSdX& = ABS(UdX&)
661.                 UABSdY& = ABS(UdY&)
662.                 UABSdZ& = ABS(UdZ&)
663.                 UDis& = 0
664.                 GOTO main_1
665.  
666.  
667.  
668.             END IF
669.  
670.  
671.  
672.             'renderer specific code follows
673.            77
674.  
675.  
676.  
677.  
678.             IF UBoxType& = 4 THEN
679.                 URayDepth = URayDepth + 1
680.  
681.                 IF URayDepth > UMaxDepth THEN
682.                     ScrBuf(PixOff) = 0
683.                     GOTO 3
684.                 END IF
685.  
686.  
687.                 IF UCrossed = 2 THEN
688.  
689.                     UdY& = -UdY&
690.                     IF UdY& >= 0 THEN USGNdY = 1 ELSE USGNdY = 0
691.                     UDis& = 0
692.                     GOTO main_1
693.                 END IF
694.  
695.  
696.                 IF UCrossed = 1 THEN
697.  
698.                     UdX& = -UdX&
699.                     IF UdX& >= 0 THEN USGNdX = 1 ELSE USGNdX = 0
700.                     UDis& = 0
701.                     GOTO main_1
702.                 END IF
703.  
704.                 IF UCrossed = 3 THEN
705.  
706.                     UdZ& = -UdZ&
707.                     IF UdZ& >= 0 THEN USGNdZ = 1 ELSE USGNdZ = 0
708.                     UDis& = 0
709.                     GOTO main_1
710.                 END IF
711.  
712.             END IF
713.  
714.  
715.             DIM SHARED tx AS LONG, ty AS LONG
716.  
717.             DIM SHARED disx1 AS LONG
718.             DIM SHARED disx2 AS LONG
719.             DIM SHARED disy1 AS LONG
720.             DIM SHARED disy2 AS LONG
721.             DIM SHARED disz1 AS LONG
722.             DIM SHARED disz2 AS LONG
723.  
724.  
725.  
726.  
727.  
728.  
729.  
730.  
731.  
732.             IF UCrossed = 1 THEN 'x
733.                 IF USGNdX THEN
734.                     'hit lhs
735.                     disz2 = 16384 - (UZ& AND 16383)
736.                     tx = disz2
737.                     disy1 = UY& AND 16383
738.                     ty = disy1
739.                 ELSE
740.                     'hit rhs
741.                     disz1 = UZ& AND 16383
742.                     tx = disz1
743.                     disy1 = UY& AND 16383
744.                     ty = disy1
745.                 END IF
746.             END IF
747.  
748.             IF UCrossed = 3 THEN 'z
749.                 IF USGNdZ THEN
750.                     'hit bottom
751.                     disx1 = UX& AND 16383
752.                     tx = disx1
753.                     disy1 = UY& AND 16383
754.                     ty = disy1
755.                 ELSE
756.                     'hit top
757.                     disx2 = 16384 - (UX& AND 16383)
758.                     tx = disx2
759.                     disy1 = UY& AND 16383
760.                     ty = disy1
761.                 END IF
762.             END IF
763.  
764.             IF UCrossed = 2 THEN
765.  
766.                 disx1 = UX& AND 16383
767.                 disz1 = UZ& AND 16383
768.                 tx = disx1
769.                 ty = disz1
770.  
771.                 '        tx = 16384
772.                 '       ty = 16384
773.  
774.                 '        IF USGNdY THEN
775.                 '          tx = px - INT(px)
776.                 '          ty = pz - INT(pz)
777.                 '        ELSE
778.                 '          tx = px - INT(px)
779.                 '          ty = pz - INT(pz)
780.                 '        END IF
781.             END IF
782.  
783.  
784.  
785.  
786.             m& = (UDis& \ 16384) + 1 '(for low res)
787.             ''''m& = (UDis& \ 65536) + 1 '(for high res)
788.             IF m& > 5 THEN m& = 5
789.  
790.  
791.             '      c& = Tex(tx * TexX, ty * Texy, m&)
792.             '      PRINT ty
793.             '      SLEEP
794.  
795.  
796.  
797.             IF UBoxType& = 2 THEN c& = Tex((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, m&)
798.             IF UBoxType& = 1 THEN c& = Tex2((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, m&)
799.             IF UBoxType& = 3 THEN c& = Tex3((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, m&)
800.  
801.             IF UBoxType& = 10 THEN c& = t_floor((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
802.             IF UBoxType& = 11 THEN c& = t_walla((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
803.             IF UBoxType& = 12 THEN c& = t_wallb((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
804.             IF UBoxType& = 13 THEN c& = t_roof((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
805.             IF UBoxType& = 14 THEN
806.                 IF TIMER AND 1 THEN
807.                     c& = t_buta((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
808.                 ELSE
809.                     c& = t_butb((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
810.                 END IF
811.  
812.             END IF
813.             IF UBoxType& = 15 THEN c& = t_s_box((tx * UTexX&) \ 16384, (ty * UTexY&) \ 16384, 1)
814.  
815.  
816.             'lighting algorithm under development
817.  
818.             c& = c& AND &HFFFFFF
819.             r& = (c& \ 65536) AND 255
820.             g& = (c& \ 256) AND 255
821.             b& = c& AND 255
822.  
823.             '     IF URayDepth <> 0 THEN b& = b& + URayDepth * 32: IF b& > 255 THEN b& = 255
824.  
825.             l& = 16383 - (UDis& \ 30)
826.             '      IF l& < 0 THEN l& = 0
827.  
828.             '      '      l = 1 - (UDis& / 16384) / 10
829.  
830.             c& = ((r& * l&) \ 16384) * 65536 + ((g& * l&) \ 16384) * 256 + ((b& * l&) \ 16384) + &HFF000000
831.             '      c& = _RGB32(r& * l& \ 16384, g& * l& \ 16384, b& * l& \ 16384)
832.  
833.  
834.             770
835.             ScrBuf(PixOff) = c&
836.  
837.             3
838.             PixOff = PixOff + 1
839.         NEXT
840.     NEXT
841.  
842.     '$CHECKING:ON
843.  
844.  
845.  
846.     PUT (0, 0), ScrBuf()
847.     '  PSET (_MOUSEX, _MOUSEY), _RGB(255, 255, 255)
848.     'LOCATE 1, 1
849.     'PRINT CINT(frames / (TIMER(0.001) - starttime))
850.  
851.     PSET (ScreenX \ 2, ScreenY \ 2), _RGB(255, 255, 255)
852.  
853.     FOR x& = 1 TO 10
854.         i& = INP(&H60)
855.         IF (i& AND 128) THEN KeyDown(i& XOR 128) = 0
856.         IF (i& AND 128) = 0 THEN KeyDown(i&) = -1
857.     NEXT
858.     'PRINT i&
859.  
860.     'PRINT vax
861.     _DISPLAY
862.     CLS
863.  
864.  
865.     v = TIMER(0.001)
866.     ElapsedTime = v - LastTime
867.     LastTime = v
868.  
869.     DO WHILE _MOUSEINPUT
870.         mx = _MOUSEX
871.         mouseMovementX = mx - oldMX
872.         oldMX = mx
873.         my = _MOUSEY
874.         mouseMovementY = my - oldMY
875.         oldMY = my
876.  
877.         vax = vax + (ABS(mouseMovementX / 4) ^ 1.2) * SGN(mouseMovementX)
878.         vay = vay - (ABS(mouseMovementY / 4) ^ 1.2) * SGN(mouseMovementY)
879.         IF vay > 90 THEN vay = 90
880.         IF vay < -90 THEN vay = -90
881.  
882.         FOR p = 1 TO 2
883.             IF _MOUSEBUTTON(p) THEN
884.  
885.                 UX = Plr.X * 16384#
886.                 UY = (Plr.Y + Plr.Height) * 16384#
887.                 UZ = Plr.Z * 16384#
888.                 x& = 0
889.                 y& = 0
890.                 z& = 1 * 16384#
891.                 Uvaxs& = SIN(vax * deg2rad) * 16384&: Uvaxc& = COS(vax * deg2rad) * 16384&
892.                 Uvays& = SIN(vay * deg2rad) * 16384&: Uvayc& = COS(vay * deg2rad) * 16384&
893.                 UdY& = (Uvays& * z&) \ 16384 + (Uvayc& * y&) \ 16384
894.                 z& = (Uvayc& * z&) \ 16384 - (Uvays& * y&) \ 16384
895.                 UdX& = (Uvaxs& * z&) \ 16384 + (Uvaxc& * x&) \ 16384
896.                 UdZ& = (Uvaxc& * z&) \ 16384 - (Uvaxs& * x&) \ 16384
897.                 RayCheck
898.  
899.                 IF UBoxType& <> 2 THEN
900.  
901.                     'remove previous portal?
902.                     IF portal(p) THEN
903.  
904.                         Ui = portal(p)
905.                         UX2 = Special(Ui).X \ 16384: UY2 = Special(Ui).Y \ 16384: UZ2 = Special(Ui).Z \ 16384
906.  
907.                         Map(UX2, UY2, UZ2) = Map(UX2, UY2, UZ2) AND 255
908.  
909.  
910.                     END IF
911.  
912.                     Ui = p
913.  
914.                     Map(UX \ 16384, UY \ 16384, UZ \ 16384) = UBoxType + Ui * 256
915.  
916.                     Special(Ui).Effect = Ui
917.  
918.                     'store box position
919.                     Special(Ui).X = (UX \ 16384) * 16384
920.                     Special(Ui).Y = (UY \ 16384) * 16384
921.                     Special(Ui).Z = (UZ \ 16384) * 16384
922.                     'store side vector containing effect
923.                     dx = 0: dy = 0: dz = 0
924.                     IF UCrossed = 1 THEN IF USGNdX THEN dx = -1 ELSE dx = 1
925.                     IF UCrossed = 2 THEN IF USGNdY THEN dy = -1 ELSE dy = 1
926.                     IF UCrossed = 3 THEN IF USGNdZ THEN dz = -1 ELSE dz = 1
927.                     Special(Ui).dX = dx: Special(Ui).dY = dy: Special(Ui).dZ = dz
928.  
929.                     portal(p) = Ui
930.  
931.                 END IF
932.  
933.  
934.  
935.  
936.  
937.  
938.             END IF
939.         NEXT
940.  
941.  
942.  
943.     LOOP
944.  
945.  
946.  
947.  
948.     '  vay = vay - (_MOUSEY - ScreenY \ 2) \ 20
949.     '  IF vay > 90 THEN vay = 90
950.     '  IF vay < -90 THEN vay = -90
951.     '  vax = vax + (_MOUSEX - ScreenX \ 2) \ 10
952.  
953.     'x = _MOUSEX - ScreenX \ 2
954.     'vax = x * 2
955.  
956.     'y = (_MOUSEY - ScreenY \ 2) / (ScreenY / 2)
957.     'y = y * 90
958.     'vay = -y
959.  
960.  
961.     k$ = INKEY$
962.  
963.  
964.     'DO: LOOP UNTIL INKEY$ = ""
965.  
966.  
967.  
968.     et = TIMER(0.001) - LastTime
969.     IF et > 1 THEN et = 1
970.     LastTime = TIMER(0.001)
971.  
972.  
973.     '  CLS
974.     IF k$ = "6" THEN vax = vax + 20
975.     IF k$ = "4" THEN vax = vax - 20
976.  
977.  
978.     '  DEF SEG = 0
979.     '  sh& = PEEK(&H417)
980.  
981.     x = Plr.X: y = Plr.Y: z = Plr.Z
982.     dx = 0: dy = -1: dz = 0
983.     UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#: UX = x * 16384#: UY = y * 16384#: UZ = z * 16384#
984.     RayCheck
985.     height = UDis / 16384#
986.  
987.  
988.  
989.  
990.     move = 0
991.     x = 0: y = 0: z = 0
992.     IF KeyDown(17) OR KeyDown(72) THEN move = 1: z = 1
993.     IF KeyDown(31) OR KeyDown(80) THEN move = 1: z = -1
994.     IF KeyDown(30) OR KeyDown(75) THEN move = 1: x = -1
995.     IF KeyDown(32) OR KeyDown(77) THEN move = 1: x = 1
996.  
997.  
998.     IF move THEN
999.  
1000.         '    x = 0: y = 0: z = 1 'forward vector
1001.         '    IF k$ = "s" THEN z = -1
1002.  
1003.         a1 = vax * deg2rad: a2 = vay * deg2rad
1004.         x1 = SIN(a1) * z + COS(a1) * x
1005.         z1 = COS(a1) * z - SIN(a1) * x
1006.         x = x1: z = z1
1007.  
1008.         x = x * ElapsedTime * 15 'est 0.1 * ???
1009.         z = z * ElapsedTime * 15
1010.  
1011.  
1012.  
1013.         cs = SQR(Plr.dX * Plr.dX + Plr.dZ * Plr.dZ)
1014.         '1. add new vector
1015.         Plr.dX = Plr.dX + x
1016.         Plr.dZ = Plr.dZ + z
1017.         ns = SQR(Plr.dX * Plr.dX + Plr.dZ * Plr.dZ)
1018.  
1019.         '2. limit as necessary
1020.         IF ns > 3 AND ns > cs THEN
1021.             Plr.dX = (Plr.dX / ns) * 3
1022.             Plr.dZ = (Plr.dZ / ns) * 3
1023.         END IF
1024.  
1025.  
1026.         '    odx = Plr.dX
1027.         '    odz = Plr.dZ
1028.         '    cs = SQR(Plr.dX * Plr.dX + Plr.dZ * Plr.dZ)
1029.         '    Plr.dX = Plr.dX + x
1030.         '    Plr.dZ = Plr.dZ + z
1031.         ''    ns = SQR(Plr.dX * Plr.dX + Plr.dZ * Plr.dZ)
1032.         '   IF ns > cs AND ns > 3 THEN 'still doesn;t work (try qtr turn)
1033.         '     Plr.dX = odx
1034.         '   Plr.dZ = odz
1035.         ' END IF
1036.  
1037.  
1038.     ELSE
1039.  
1040.         'trying to stop friction
1041.         IF height < 0.05 THEN
1042.             Plr.dX = Plr.dX / (1 + ElapsedTime * 10)
1043.             Plr.dZ = Plr.dZ / (1 + ElapsedTime * 10)
1044.         END IF
1045.  
1046.     END IF
1047.  
1048.  
1049.  
1050.  
1051.  
1052.  
1053.  
1054.     'move player
1055.  
1056.     'add gravity to player vector
1057.  
1058.  
1059.  
1060.  
1061.  
1062.  
1063.  
1064.  
1065.  
1066.  
1067.  
1068.     IF KeyDown(57) THEN
1069.         IF height < 0.05 THEN
1070.             Plr.dY = 1.75
1071.         END IF
1072.     END IF
1073.  
1074.     '  IF height > 0.01 THEN
1075.     y = Plr.dY
1076.     ApplyGravity y
1077.     Plr.dY = y
1078.     '  END IF
1079.  
1080.  
1081.     'portal transition checking
1082.  
1083.     ElapsedTimeold = ElapsedTime
1084.     ElapsedTime = ElapsedTime / 100
1085.     FOR ggg = 1 TO 100
1086.  
1087.  
1088.         x = Plr.X: y = Plr.Y: z = Plr.Z
1089.         l = SQR(Plr.dX * Plr.dX + Plr.dY * Plr.dY + Plr.dZ * Plr.dZ)
1090.         IF l THEN
1091.             dx = Plr.dX / l: dy = Plr.dY / l: dz = Plr.dZ / l
1092.             UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1093.             UX = x * 16384#: UY = y * 16384#: UZ = z * 16384#
1094.             RayCheck
1095.             IF UBoxType > 255 THEN 'portal
1096.                 length = UDis / 16384#
1097.                 l = l * ElapsedTime
1098.                 IF l > length - 0.01 THEN
1099.                     'replace plane isolated vector with real movement vector
1100.                     l = SQR(Plr.dX * Plr.dX + Plr.dY * Plr.dY + Plr.dZ * Plr.dZ)
1101.                     dx = Plr.dX / l: dy = Plr.dY / l: dz = Plr.dZ / l
1102.                     UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1103.                     IF RayFunnel THEN
1104.                         x = UX / 16384#: y = UY / 16384#: z = UZ / 16384#
1105.                         dx = UdX / 16384#: dy = UdY / 16384#: dz = UdZ / 16384#
1106.                         Plr.X = x: Plr.Y = y: Plr.Z = z
1107.                         Plr.dX = dx * l: Plr.dY = dy * l: Plr.dZ = dz * l
1108.                     END IF
1109.                     GOTO skip_movement
1110.                 END IF
1111.             END IF
1112.         END IF
1113.  
1114.         IF Plr.dX THEN
1115.             x = Plr.X: y = Plr.Y: z = Plr.Z
1116.             dx = SGN(Plr.dX): dy = 0: dz = 0
1117.             UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1118.             UX = x * 16384#: UY = y * 16384#: UZ = z * 16384#
1119.             RayCheck
1120.  
1121.             length = UDis / 16384#
1122.             x = ABS(Plr.dX * ElapsedTime)
1123.             IF x > length - 0.01 THEN
1124.  
1125.                 IF UBoxType > 255 THEN 'portal
1126.                     'replace plane isolated vector with real movement vector
1127.                     l = SQR(Plr.dX * Plr.dX + Plr.dY * Plr.dY + Plr.dZ * Plr.dZ)
1128.                     dx = Plr.dX / l: dy = Plr.dY / l: dz = Plr.dZ / l
1129.                     UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1130.                     IF RayFunnel THEN
1131.                         x = UX / 16384#: y = UY / 16384#: z = UZ / 16384#
1132.                         dx = UdX / 16384#: dy = UdY / 16384#: dz = UdZ / 16384#
1133.                         Plr.X = x: Plr.Y = y: Plr.Z = z
1134.                         Plr.dX = dx * l: Plr.dY = dy * l: Plr.dZ = dz * l
1135.                     END IF
1136.                     GOTO skip_movement
1137.                 END IF
1138.  
1139.                 x = length - 0.01
1140.                 IF x < 0 THEN x = 0
1141.             END IF
1142.             Plr.X = Plr.X + x * SGN(Plr.dX)
1143.         END IF
1144.  
1145.         IF Plr.dZ THEN
1146.             x = Plr.X: y = Plr.Y: z = Plr.Z
1147.             dx = 0: dy = 0: dz = SGN(Plr.dZ)
1148.             UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1149.             UX = x * 16384#: UY = y * 16384#: UZ = z * 16384#
1150.             RayCheck
1151.             length = UDis / 16384#
1152.             z = ABS(Plr.dZ * ElapsedTime)
1153.             IF z > length - 0.01 THEN
1154.  
1155.                 IF UBoxType > 255 THEN 'portal
1156.                     'replace plane isolated vector with real movement vector
1157.                     l = SQR(Plr.dX * Plr.dX + Plr.dY * Plr.dY + Plr.dZ * Plr.dZ)
1158.                     dx = Plr.dX / l: dy = Plr.dY / l: dz = Plr.dZ / l
1159.                     UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1160.                     IF RayFunnel THEN
1161.                         x = UX / 16384#: y = UY / 16384#: z = UZ / 16384#
1162.                         dx = UdX / 16384#: dy = UdY / 16384#: dz = UdZ / 16384#
1163.                         Plr.X = x: Plr.Y = y: Plr.Z = z
1164.                         Plr.dX = dx * l: Plr.dY = dy * l: Plr.dZ = dz * l
1165.                     END IF
1166.                     GOTO skip_movement
1167.                 END IF
1168.  
1169.                 z = length - 0.01
1170.                 IF z < 0 THEN z = 0
1171.             END IF
1172.             Plr.Z = Plr.Z + z * SGN(Plr.dZ)
1173.         END IF
1174.  
1175.  
1176.         IF Plr.dY THEN
1177.             x = Plr.X: y = Plr.Y: z = Plr.Z
1178.             dx = 0: dy = SGN(Plr.dY): dz = 0
1179.             UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1180.             UX = x * 16384#: UY = y * 16384#: UZ = z * 16384#
1181.             RayCheck
1182.             length = UDis / 16384#
1183.             y = ABS(Plr.dY * ElapsedTime)
1184.  
1185.             IF y > length - 0.01 THEN
1186.  
1187.                 IF UBoxType > 255 THEN 'portal
1188.                     'replace plane isolated vector with real movement vector
1189.                     l = SQR(Plr.dX * Plr.dX + Plr.dY * Plr.dY + Plr.dZ * Plr.dZ)
1190.                     dx = Plr.dX / l: dy = Plr.dY / l: dz = Plr.dZ / l
1191.                     UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1192.                     IF RayFunnel THEN
1193.                         x = UX / 16384#: y = UY / 16384#: z = UZ / 16384#
1194.                         dx = UdX / 16384#: dy = UdY / 16384#: dz = UdZ / 16384#
1195.                         Plr.X = x: Plr.Y = y: Plr.Z = z
1196.                         Plr.dX = dx * l: Plr.dY = dy * l: Plr.dZ = dz * l
1197.                     END IF
1198.                     GOTO skip_movement
1199.                 END IF
1200.  
1201.                 y = length - 0.01
1202.                 IF y < 0 THEN y = 0
1203.             END IF
1204.             IF y = 0 THEN Plr.dY = 0
1205.             Plr.Y = Plr.Y + y * SGN(Plr.dY)
1206.         END IF
1207.  
1208.         skip_movement:
1209.  
1210.     NEXT
1211.     ElapsedTime = ElapsedTime * 100
1212.  
1213.     11112
1214.  
1215.     GOTO shit
1216.  
1217.  
1218.  
1219.  
1220.     l = SQR(Plr.dX * Plr.dX + Plr.dY * Plr.dY + Plr.dZ * Plr.dZ)
1221.     IF l > 0 THEN 'only if moving
1222.         dx = Plr.dX / l: dy = Plr.dY / l: dz = Plr.dZ / l
1223.         x = Plr.X: y = Plr.Y: z = Plr.Z
1224.         UdX = dx * 16384#: UdY = dy * 16384#: UdZ = dz * 16384#
1225.         UX = x * 16384#: UY = y * 16384#: UZ = z * 16384#
1226.         RayCheck
1227.         l2 = UDis / 16384#
1228.  
1229.         l = l * ElapsedTime
1230.  
1231.         IF l >= l2 + 0.1 THEN
1232.  
1233.             l2 = l2 - 0.1
1234.             IF l2 < 0.1 THEN GOTO 8
1235.             '      x = x * l2
1236.             '      y = y * l2
1237.             '      z = z * l2
1238.  
1239.             '     Plr.X = Plr.X + x
1240.             '     Plr.Y = Plr.Y + y
1241.             '     Plr.Z = Plr.Z + z
1242.  
1243.             8
1244.         ELSE
1245.  
1246.             Plr.X = Plr.X + Plr.dX * ElapsedTime
1247.             Plr.Y = Plr.Y + Plr.dY * ElapsedTime
1248.             Plr.Z = Plr.Z + Plr.dZ * ElapsedTime
1249.  
1250.         END IF
1251.  
1252.     END IF
1253.  
1254.  
1255.  
1256.     'IF k$ = " " THEN
1257.     '   PlrY = PlrY + 1.3
1258.     'END IF
1259.  
1260.     '  GOTO 11
1261.     'freefall
1262.     '  x = 0: y = -1: z = 0 'fall vector
1263.     '  'cast a test ray
1264.     '  Upx1& = PlrX * 16384#
1265.     '  Upy1& = PlrY * 16384#
1266.     '  Upz1& = PlrZ * 16384#
1267.     '  UdX& = x * 16384#
1268.     '  UdY& = y * 16384#
1269.     '  UdZ& = z * 16384#
1270.     '  testray& = 1
1271.     '  GOSUB testray_entry
1272.     '  s = 3
1273.     '  mydis& = s * et * 16384#
1274.     '  IF UDis& > mydis& THEN
1275.     '    PlrX = PlrX + x * s * et
1276.     '    PlrY = PlrY + y * s * et
1277.     '    PlrZ = PlrZ + z * s * et
1278.     '  END IF
1279.  
1280.     ' 11
1281.  
1282.  
1283.  
1284.     shit:
1285.  
1286.     '    PosZ = PosZ - 0.1
1287.  
1288.  
1289.     frames = frames + 1
1290.  
1291.     IF k$ = "f" THEN
1292.         starttime = TIMER(0.001)
1293.         frames = 0
1294.     END IF
1295.  
1296.  
1297.  
1298. LOOP
1299.  
1300.  
1301. FUNCTION rnd2& (limit&)
1302.     rnd2& = INT(RND * (limit& * 2 + 1)) - limit&
1303. END FUNCTION
1304.  
1305. SUB ApplyGravity (y)
1306.     'quote:
1307.     'http://en.wikipedia.org/wiki/Gravitation
1308.     'The strength of the gravitational field is numerically equal to the acceleration of objects under its influence, and its value at the Earth's surface, denoted g, is approximately expressed below as the standard average.
1309.     'g = 9.81 m/s2 = 32.2 ft/s2
1310.     'This means that, ignoring air resistance, an object falling freely near the Earth's surface increases its velocity with 9.81 m/s (32.2 ft/s or 22 mph) for each second of its descent.
1311.  
1312.     y = y - (9.81 / 2) * ElapsedTime
1313.  
1314.     'With air resistance acting upon an object that has been dropped,
1315.     'the object will eventually reach a terminal velocity,
1316.     'around 56 m/s (200 km/h or 120 mph) for a human body.
1317.     IF y < -(56 / 2) THEN y = -(56 / 2)
1318.  
1319. END SUB
1320.  
1321. SUB MoveObject (o AS ObjectType)
1322.     o.X = o.X + o.dX
1323.     o.Y = o.Y + o.dY
1324.     o.Z = o.Z + o.dZ
1325. END SUB
1326.  
1327. SUB RayCheck
1328.  
1329.     IF UdX& >= 0 THEN USGNdX = 1 ELSE USGNdX = 0
1330.     IF UdY& >= 0 THEN USGNdY = 1 ELSE USGNdY = 0
1331.     IF UdZ& >= 0 THEN USGNdZ = 1 ELSE USGNdZ = 0
1332.  
1333.     UABSdX& = ABS(UdX&)
1334.     UABSdY& = ABS(UdY&)
1335.     UABSdZ& = ABS(UdZ&)
1336.  
1337.     UDis& = 0
1338.  
1339.     URayDepth = 0
1340.  
1341.     'main_1: 'remove this line when possible
1342.  
1343.     DO
1344.  
1345.         'calculate x,y,z distance to next 'cube'
1346.         IF USGNdX THEN
1347.             UDistx& = 16384 - (UX& AND 16383)
1348.             IF UDistx& = 0 THEN UDistx& = 16384
1349.         ELSE
1350.             UDistx& = (UX& AND 16383) + 1
1351.         END IF
1352.         IF USGNdY THEN
1353.             UDisty& = 16384 - (UY& AND 16383)
1354.             IF UDisty& = 0 THEN UDisty& = 16384
1355.         ELSE
1356.             UDisty& = (UY& AND 16383) + 1
1357.         END IF
1358.         IF USGNdZ THEN
1359.             UDistz& = 16384 - (UZ& AND 16383)
1360.             IF UDistz& = 0 THEN UDistz& = 16384
1361.         ELSE
1362.             UDistz& = (UZ& AND 16383) + 1
1363.         END IF
1364.  
1365.         IF UABSdX& <> 0 THEN USpeedX& = (UDistx& * 16384) \ UABSdX& ELSE USpeedX& = 2147483647
1366.         IF UABSdY& <> 0 THEN USpeedY& = (UDisty& * 16384) \ UABSdY& ELSE USpeedY& = 2147483647
1367.         IF UABSdZ& <> 0 THEN USpeedZ& = (UDistz& * 16384) \ UABSdZ& ELSE USpeedZ& = 2147483647
1368.  
1369.         'advance minimal speed + microstep(to cater for floating point errors only)
1370.         UCrossed& = 1
1371.         UMinSpeed& = USpeedX&
1372.         IF USpeedY& < UMinSpeed& THEN UMinSpeed& = USpeedY&: UCrossed& = 2
1373.         IF USpeedZ& < UMinSpeed& THEN UMinSpeed& = USpeedZ&: UCrossed& = 3
1374.         UMinSpeed& = UMinSpeed& + 1
1375.         UDis& = UDis& + UMinSpeed&
1376.  
1377.         UX& = UX& + (UdX& * UMinSpeed&) \ 16384
1378.         UY& = UY& + (UdY& * UMinSpeed&) \ 16384
1379.         UZ& = UZ& + (UdZ& * UMinSpeed&) \ 16384
1380.  
1381.         UBoxType& = Map(UX& \ 16384, UY& \ 16384, UZ& \ 16384)
1382.  
1383.     LOOP UNTIL UBoxType&
1384.  
1385. END SUB
1386.  
1387.  
1388. FUNCTION scankey% (scancode%)
1389.     i% = INP(&H60)
1390.     IF (i% AND 128) THEN keyflags%(i% XOR 128) = 0
1391.     IF (i% AND 128) = 0 THEN keyflags%(i%) = -1
1392.     scankey% = keyflags%(scancode%)
1393. END FUNCTION
1394.  
1395.  
1396. FUNCTION RayFunnel&
1397.  
1398.     Ui = UBoxType \ 256
1399.  
1400.     vax2 = vax
1401.     vay2 = vay
1402.  
1403.     IF UCrossed = 1 THEN
1404.         IF USGNdX THEN
1405.             Ulr = 16383 - (UZ& AND 16383): Udu = UY& AND 16383
1406.             UdX2 = -UdZ: UdY2 = UdY: UdZ2 = UdX
1407.             vax2 = vax2 - 90
1408.         ELSE
1409.             Ulr = UZ& AND 16383: Udu = UY& AND 16383
1410.             UdX2 = UdZ: UdY2 = UdY: UdZ2 = -UdX
1411.             vax2 = vax2 + 90
1412.         END IF
1413.     END IF
1414.     IF UCrossed = 2 THEN
1415.         IF USGNdY THEN
1416.             Ulr = UX& AND 16383: Udu = 16383 - (UZ& AND 16383)
1417.             UdX2 = UdX: UdY2 = -UdZ: UdZ2 = UdY
1418.         ELSE
1419.             Ulr = UX& AND 16383: Udu = UZ& AND 16383
1420.             UdX2 = UdX: UdY2 = UdZ: UdZ2 = -UdY
1421.         END IF
1422.     END IF
1423.     IF UCrossed = 3 THEN
1424.         IF USGNdZ THEN
1425.             Ulr = UX& AND 16383: Udu = UY& AND 16383
1426.             UdX2 = UdX: UdY2 = UdY: UdZ2 = UdZ
1427.             vax2 = vax2
1428.         ELSE
1429.             Ulr = 16383 - (UX& AND 16383): Udu = UY& AND 16383
1430.             UdX2 = -UdX: UdY2 = UdY: UdZ2 = -UdZ
1431.             vax2 = vax2 - 180
1432.         END IF
1433.     END IF
1434.  
1435.     IF Ui = 1 THEN
1436.         IF portal(2) = 0 THEN
1437.             EXIT FUNCTION
1438.         END IF
1439.     END IF
1440.  
1441.     IF Ui = 2 THEN
1442.         IF portal(1) = 0 THEN
1443.             EXIT FUNCTION
1444.         END IF
1445.     END IF
1446.  
1447.     IF Ui = 1 THEN Ui = 2 ELSE Ui = 1
1448.  
1449.     UX = Special(Ui).X
1450.     UZ = Special(Ui).Z
1451.     UY = Special(Ui).Y
1452.     UdX3 = Special(Ui).dX
1453.     UdY3 = Special(Ui).dY
1454.     UdZ3 = Special(Ui).dZ
1455.  
1456.     IF UdX3 THEN
1457.         IF UdX3 >= 0 THEN
1458.             UX = UX + 16384
1459.             UZ = UZ + 16383 - Ulr
1460.             UY = UY + Udu
1461.             UdX = UdZ2
1462.             UdY = UdY2
1463.             UdZ = -UdX2
1464.             vax = vax2 + 90
1465.             IF UCrossed = 2 THEN vax = 90
1466.         ELSE
1467.             UX = UX - 1
1468.             UZ = UZ + Ulr
1469.             UY = UY + Udu
1470.             UdX = -UdZ2
1471.             UdY = UdY2
1472.             UdZ = UdX2
1473.             vax = vax2 - 90
1474.             IF UCrossed = 2 THEN vax = -90
1475.         END IF
1476.     END IF
1477.     IF UdZ3 THEN
1478.         IF UdZ3 >= 0 THEN
1479.             UX = UX + Ulr
1480.             UZ = UZ + 16384
1481.             UY = UY + Udu
1482.             UdX = UdX2
1483.             UdY = UdY2
1484.             UdZ = UdZ2
1485.             vax = vax2
1486.             IF UCrossed = 2 THEN vax = 0
1487.         ELSE
1488.             UX = UX + 16383 - Ulr
1489.             UZ = UZ - 1
1490.             UY = UY + Udu
1491.             UdX = -UdX2
1492.             UdY = UdY2
1493.             UdZ = -UdZ2
1494.             vax = vax2 + 180
1495.             IF UCrossed = 2 THEN vax = 180
1496.         END IF
1497.     END IF
1498.     IF UdY3 THEN
1499.         IF UdY3 >= 0 THEN
1500.             UX = UX + Ulr
1501.             UZ = UZ + 16383 - Udu
1502.             UY = UY + 16384
1503.             UdX = UdX2
1504.             UdY = UdZ2
1505.             UdZ = -UdY2
1506.         ELSE
1507.             UX = UX + Ulr
1508.             UZ = UZ + Udu
1509.             UY = UY - 1
1510.             UdX = UdX2
1511.             UdY = -UdZ2
1512.             UdZ = UdY2
1513.         END IF
1514.     END IF
1515.  
1516.     IF UdY& >= 0 THEN USGNdY = 1 ELSE USGNdY = 0
1517.     IF UdX& >= 0 THEN USGNdX = 1 ELSE USGNdX = 0
1518.     IF UdZ& >= 0 THEN USGNdZ = 1 ELSE USGNdZ = 0
1519.     UABSdX& = ABS(UdX&)
1520.     UABSdY& = ABS(UdY&)
1521.     UABSdZ& = ABS(UdZ&)
1522.  
1523.     RayFunnel = 1
1524. END FUNCTION