Moon Lander by Richard Frost

[Qwerkey]

Moon Lander

Author: @Richard Frost
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=1022.0
Version: May 15, 2020
Tags: [Graphics], [Skill]

Description:
Lunar Lander based on a 1974 program running on a DEC PDP/11 with GT40 vector display terminal at the University of Alberta.  Initially written in QB4.5 (hence the convoluted code to save space), upgraded to use some QB64 features.  Updated May 15, 2020 -  More effects (at warp speeds) and cookies!

Controls:
The multifarious keyboard controls are given by pressing F1 (Help) when the program is run.

Source Code:

Code: QB64: [Select]

1. ' Moon Lander by rfrost@mail.com
2.  
3. $EXEICON:'.\astro.ico'
4. $RESIZE:SMOOTH
5.  
6. DEFINT A-Z
7. DIM SHARED a '                                                        angle of craft
8. DIM SHARED a51i '                                                     Area 51 initializations
9. DIM SHARED APdisengage '                                              AutoPilot disengage
10. DIM SHARED ASO '                                                      ascent stage only
11. DIM SHARED auto '                                                     autopilot
12. DIM SHARED background '                                               for instrument panel
13. DIM SHARED bh '                                                       black hole
14. DIM SHARED bhx, bhy '                                                 black hole
15. DIM SHARED bbit '                                                     blinking bit synced to time
16. DIM SHARED bolthit, bolthitf, boltx '                                 Deathstar hit vehicle, feature
17. DIM SHARED borgl, borgr, borgt '                                      left right top, distance
18. DIM SHARED bstyle1, bstyle2 '                                         Borg matrix/lines/Moire
19. DIM SHARED bw '                                                       black and white
20. DIM SHARED c '                                                        usually color
21. DIM SHARED canvas& '                                                  primary screen
22. DIM SHARED cbh '                                                      constant black holes
23. DIM SHARED center '                                                   varies according to gs (graphics start)
24. DIM SHARED chs '                                                      parachute size
25. DIM SHARED contact '                                                  landed
26. DIM SHARED convo '                                                    conversation active LM/CM
27. DIM SHARED cpal '                                                     color palette, normal/green/b&w (32 color kludge/fun)
28. DIM SHARED craft '                                                    color
29. DIM SHARED crash '                                                    layer of debris
30. DIM SHARED cwd, cwsi, cwsd '                                          car wash distance, angles
31. DIM SHARED cybilltime! '                                              time on screen
32. DIM SHARED darkstarc '                                                deathstar color set
33. DIM SHARED darkstars '                                                deathstar spin rate
34. DIM SHARED darkstart '                                                   "      thickness
35. DIM SHARED dead$ '                                                    end condition
36. DIM SHARED debug$ '                                                   messages to God
37. DIM SHARED demo '                                                     ground features compressed
38. DIM SHARED doclock '                                                  it's Howdy Doody time
39. DIM SHARED dosbox '                                                   flag
40. DIM SHARED dsinit '                                                   deathstar
41. DIM SHARED eou '                                                      end of universe
42. DIM SHARED fb$ '                                                      landing feedback/analysis
43. DIM SHARED flx '                                                      US/USSR flag position
44. DIM SHARED fuel, fuel! '                                              color of, quantity left
45. DIM SHARED gh, glmin, glmax '                                         ground height, level
46. DIM SHARED grav! '                                                    gravity
47. DIM SHARED gs '                                                       flight area x start
48. DIM SHARED gstyle '                                                   ground style
49. DIM SHARED inpause '                                                  flag
50. DIM SHARED invincible '                                               impervious to threats
51. DIM SHARED iscd '                                                     don't attempt to write!
52. DIM SHARED jitter '                                                   shift-T to control
53. DIM SHARED LEDc '                                                     color
54. DIM SHARED LEDtri '                                                   tri-color flag
55. DIM SHARED level '                                                    surface is
56. DIM SHARED LGMc '                                                     Little Green Man color
57. DIM SHARED liftoff '                                                  AS only
58. DIM SHARED lmsl '                                                     LM shield/laser color
59. DIM SHARED lob '                                                      landed on Borg
60. DIM SHARED lockfuel '                                                 cheat!
61. DIM SHARED lp, rp, xp, th1, th2 '                                     pads, radar, thrusters
62. DIM SHARED magic '                                                    cheat! (instant landing)
63. DIM SHARED mdelay '                                                   PgUp/PgDn controlled
64. DIM SHARED msflag '                                                   making surfaces
65. DIM SHARED mstar '                                                    make stars
66. DIM SHARED nation '                                                   1 US, 2 USSR (flags & fireworks)
67. DIM SHARED ok '                                                       at landing, to plant flag
68. DIM SHARED okrick '                                                   diagnostics
69. DIM SHARED osc '                                                      on screen count
70. DIM SHARED oscar '                                                    semaphore land/sea flags
71. DIM SHARED panelinit '                                                replot flag
72. DIM SHARED paraf '                                                    parachute flag
73. DIM SHARED pload '                                                    panel load flag
74. DIM SHARED porb '                                                     pointers/bargraphs
75. DIM SHARED ptk '                                                      points to kill (gasoline) ExplodeLM
76. DIM SHARED px!, py! '                                                 vehicle position on screen
77. DIM SHARED ra '                                                       random angle
78. DIM SHARED radarf '                                                   radar on/off
79. DIM SHARED rads '                                                     Luna radiation
80. DIM SHARED radiationdeath '                                           flag
81. DIM SHARED rdtime! '                                                  fun with high res screen (my picture)
82. DIM SHARED regen '                                                    all star files
83. DIM SHARED rfx, rfy '                                                 craft jigger
84. DIM SHARED rick '                                                     debug flag
85. DIM SHARED rmin, dmin '                                               stars
86. DIM SHARED settings$ '                                                lander.set
87. DIM SHARED sf '                                                       surface feature
88. DIM SHARED shield '                                                   flag
89. DIM SHARED shoot '                                                    flag
90. DIM SHARED showmap '                                                  locations of things shown at top
91. DIM SHARED sia '                                                      shells in air
92. DIM SHARED skyoff '                                                   for faster performance
93. DIM SHARED starship '                                                 Enterprise (double shift twice)
94. DIM SHARED ufof '                                                     for ufo
95. DIM SHARED sspinit1, sspinit2 '                                       Surveyor
96. DIM SHARED starfiles '                                                use stars1,2 or 3 (few/med/lots)
97. DIM SHARED starinit '                                                 flag
98. DIM SHARED shipi&, shipx '                                            starship
99. DIM SHARED starstatus '                                               0 off, 1 on, 234 more info
100. DIM SHARED suri '                                                     surface index
101. DIM SHARED sx0, sy0 '                                                 LM radar/laser location
102. DIM SHARED sx1, sy1 '                                                 LM left landing pad
103. DIM SHARED sx2, sy2 '                                                 LM right landing pad
104. DIM SHARED temp '                                                     temperature
105. DIM SHARED thrust! '                                                  0 - 100
106. DIM SHARED tilef '                                                    tile variation
107. DIM SHARED vx!, vy! '                                                 LM velocity
108. DIM SHARED wa1
109. DIM SHARED warp! '                                                    vx! >= 100
110. DIM SHARED wi, wi2 '                                                  width (distance between pads)
111. DIM SHARED wx!, wy! '                                                 vehicle position on screen
112. DIM SHARED x '                                                        = suri + px!
113. DIM SHARED xoff '                                                     offset for v=5-20, Surv & Etna
114. DIM SHARED zoom '                                                     starfield
115.  
116. DIM SHARED blue, green, gunmetal, red, gasoline, gray2, white, gray
117. DIM SHARED dred, gold, black2, orange, blue2, yellow, white2
118.  
119. DIM SHARED q1, q2, q3, q4, h, t, th, tsix, aspect!, pf! '             constants
120.  
121. q1 = 6400: q2 = 860: q3 = 639: q4 = 349: h = 100: th = 200: t = 10: tsix = 360
122. pf! = .5: aspect! = 1.4: grav! = 1.6
123.  
124. qt = 2000 '                                                           3 arrays below weren't loading properly with q2
125. DIM SHARED LMx(qt), LMy(qt), LMc(qt) '                                LM+exhaust x,y,color
126.  
127. DIM SHARED LMrx(1400), LMry(1400) '                                   LM+exhaust x,y after rotation
128. DIM SHARED LMoc(705), LMci(3) '                                       LM colors,original colors, index
129. DIM SHARED c!(360), s!(360) '                                         sines and cosines
130. DIM SHARED ex(6), ey(6), exv(6), eyv(6), ei(6), ek(6), exl(6) '       sky objects
131. DIM SHARED f$(40) '                                                   support files
132. DIM SHARED mes$(1), omes$(1), sm!(1) '                                messages at screen top
133. DIM SHARED sf(10, 2), sf$(10) '                                       surface features start/end/middle
134. DIM SHARED shx(20), shy(20), sha(20) '                                shells (IBM weapons) x,y,angle
135. DIM SHARED shvx(20), shvy(20), shd(20) '                              velocity, distance
136. DIM SHARED rtl!(2), rtlc(2) '                                         radiation/temperature/lightning
137. DIM SHARED gh(6400) '                                                 ground height
138.  
139. DIM clocka(2) '                                                       clock angles
140. DIM cmp&(30) '                                                        CM patterns
141. DIM convo$(50) '                                                      LM/CM
142. DIM SHARED gbuff(800) '                                               DS liftoff
143. DIM skyset1(t), skyset2(t) '                                          skycrud
144. DIM SHARED p(127, 13), p2(127, 7) '                                   vga and cga fonts
145. DIM SHARED tflags(30)
146.  
147. begin:
148. GOSUB init1
149. DO
150.     GOSUB init2
151.     WHILE LEN(INKEY$): WEND '                                         clear keyboard buffer
152.     DO: _LIMIT mdelay
153.         GOSUB Autopilot
154.         GOSUB Plotscreen
155.         GOSUB KeyAndMouse
156.         IF restart THEN GOTO begin '                                  restore defaults
157.         IF warp! < 1 THEN GOSUB CheckHit
158.     LOOP UNTIL contact OR LEN(dead$)
159.     GOSUB CheckDead
160.     IF contact THEN
161.         Evaluate savea, a + ma '                                      landing feedback contact/currentø
162.         wu2! = TIMER + 1
163.         GOSUB pause '                                                 landed, Enter for liftoff
164.         IF restart THEN GOTO begin '                                  restore defaults
165.         IF k <> 60 THEN GOSUB CheckDead '                             F2 demo restart
166.     END IF
167. LOOP
168.  
169. CheckDead:
170. z$ = LEFT$(LEFT$(dead$, 1) + " ", 1)
171. IF INSTR(" CBE", z$) = 0 THEN '                                       not Crashed, Borg, Eaten by BH
172.     ExplodeLM
173.     contact = 0
174. END IF
175. dead$ = ""
176. RETURN
177.  
178. Autopilot:
179. aboveborg = 0
180. IF (ek(2) = -1) OR (ek(2) > h) THEN borgt = 0
181. IF (skyoff = 0) AND (sy1 < borgt) AND (px! > borgl) AND (px! < borgr) THEN aboveborg = 1
182. super = 0
183. IF vert OR hover THEN
184.     GOSUB GetAlt
185.     i! = alt! / 8 + pf! '                                             thrust target
186.     IF jitter AND (alt! < t) THEN i! = i! * 2 '                       optional, faster
187.     IF aboveborg THEN i! = 1
188.     GOSUB idealthrust
189.     thrust! = sbest!
190.     super = -(sbest! > h) '                                           add side thusters
191.     IF thrust! > h THEN thrust! = h
192. END IF
193. IF thrust! < 0 THEN thrust! = 0
194. RETURN
195.  
196. CutOrOutOfFuel:
197. IF fuel! = 0 THEN shield = 0 '                                        shields need fuel
198. IF cut = 0 THEN
199.     cut = 1
200.     cvy! = vy!
201.     ctime! = TIMER
202.     tfollow = 0 '                                                     terrain following
203.     thrust! = 0
204. END IF
205. RETURN
206.  
207. idealthrust: '                                                        for hover or descend
208. IF (alt! < pf!) AND (jitter = 0) THEN i! = .05 '                      soft landing
209. IF hover THEN i! = hoverc '                                           target
210. hoverc = hoverc - SGN(hoverc) '                                       up/down
211. fmin! = q1 '                                                          conventient large number (6400)
212. ma! = (vmass + fuel!) / th '                                          mass (actually 54% fuel)
213. ts! = s!((a + 270) MOD tsix) / ma! / power
214. IF jitter THEN us! = RND * t + 1 ELSE us! = .1
215. IF powerloss THEN us! = h
216. FOR z! = 0 TO (h + t) STEP us! '                                      find best thrust 0-110
217.     fo! = z! * ts!
218.     aa! = ABS(vy! + grav! + fo! - i!)
219.     IF aa! < fmin! THEN fmin! = aa!: sbest! = z!
220.     IF aa! > fmin! THEN EXIT FOR
221. NEXT z!
222. RETURN
223.  
224. GoSkyObject:
225. IF (ek(p) <> -1) AND (contact = 0) THEN
226.     auto = 0
227.     a = -ma
228.     wa = -ma
229.     lock1 = 0
230.     suri = ex(p) - center
231.     GOSUB slimit
232.     IF p > 2 THEN ey(p) = th '                                        BH, worm, comet, alien
233.     px! = center
234.     IF p = 2 THEN py! = 130 '                                         above Borg
235.     vx! = exv(p)
236.     eyv(p) = 0
237. END IF
238. RETURN
239.  
240. KeyAndMouse:
241. DO WHILE _MOUSEINPUT
242.     lb = ABS(_MOUSEBUTTON(1))
243.     rb = ABS(_MOUSEBUTTON(2))
244.     IF mouseswap THEN SWAP lb, rb '                                   whatever floats your boat
245.     IF TIMER < ignoreuntil! THEN lb = 0: rb = 0 '                     2 lines for debouncing
246.     IF lb OR rb THEN ignoreuntil! = TIMER + .25
247.     ww = wa '                                                         stash current wanted angle
248.     wa = wa + lb - rb '                                               want angle
249.     IF wa <> ww THEN '                                                if changed
250.         IF inpause THEN i$ = CHR$(13): GOTO gotit '                   either button to cause liftoff
251.         apd = 1 '                                                     autopilot disconnect warning
252.         auto = 0 '                                                    autopilot
253.         GOTO endk '                                                   don't bother checking keys
254.     END IF
255.     mw = mw + _MOUSEWHEEL
256. LOOP
257. IF mw <> 0 THEN '                                                     wheel moved
258.     thrust! = INT(thrust!) - mw
259.     IF thrust! < 0 THEN thrust! = 0
260.     IF thrust! > h THEN thrust! = h
261.     apd = 1 '                                                         autopilot disconnect warning
262.     auto = 0 '                                                        autopilot
263.     hover = 0 '                                                       hover off
264.     vert = 0 '                                                        vertical control off
265.     mw = 0 '                                                          zap
266.     GOTO endk '                                                       don't bother checking keys
267. END IF
268.  
269. DEF SEG = 0
270. status = PEEK(&H417) '                                                7ins 6caps 5num 4scrl 3alt 2ctrl 1ls 0rs
271.  
272. IF ((status AND 1) > 0) AND ((status AND 2) > 0) THEN '               both shift (cookie!)
273.     IF rdtime! > 0 THEN starship = 1 '                                must have pressed shift-shift twice, another cookie
274.     rdtime! = TIMER + 5 '                                             Rick display time
275. END IF
276.  
277. IF status AND 8 THEN start1! = TIMER: mpass& = 0 '                    alt, reset speed timer
278.  
279. IF status AND 4 THEN '                                                ctrl
280.     i$ = RIGHT$(" " + INKEY$, 1)
281.     kk = ASC(i$)
282.     IF (kk = 3) OR (kk = 19) THEN '                                   c or s
283.         nfile:
284.         image = image + 1
285.         f$ = "CAP" + RIGHT$("0000" + LTRIM$(STR$(image)), 3) + ".BMP"
286.         IF _FILEEXISTS(f$) THEN GOTO nfile
287.         SaveImage f$
288.         IF _FILEEXISTS(f$) THEN mes$(1) = "Screen captured to " + f$
289.         GOTO endk
290.     END IF
291. END IF
292.  
293. i$ = INKEY$ '                                                         consult human
294. li = LEN(i$)
295. IF li = 0 THEN RETURN
296.  
297. IF i$ = "|" THEN MakeStarFiles '                                      takes hours!
298.  
299. k = ASC(RIGHT$(i$, 1))
300. IF k = 27 THEN Quit
301. IF inpause AND (k = 32) THEN
302.     k = 13 '                                                          transform spacebar to Enter
303.     i$ = RIGHT$(CHR$(0) + CHR$(k), li) '                              gentlemen, we can rebuild him
304. END IF
305.  
306. gotit:
307. IF (i$ = "\") AND (shx(0) = 0) AND (contact = 0) THEN '               LM drops bomb
308.     IF (cwd < 50) AND (sy1 > 300) THEN dead$ = "Smooth move, Exlax!" 'kill self in car wash
309.     sia = sia + 1 '                                                   shells in air
310.     shvx(0) = vx! + 3 + RND * t
311.     shvy(0) = 0
312.     shx(0) = suri + sx0
313.     shy(0) = sy0
314.     shd(0) = 1
315. END IF
316.  
317. IF i$ = "[" THEN bw = bw XOR 1: Setcolor '                            crude method for b&w
318. IF i$ = "]" THEN
319.     ufof = ufof XOR 1
320.     mes$(0) = "UFO " + OnOff$(ufof)
321.     IF ufof THEN
322.         GOSUB SkyStuff
323.         p = 6: GOSUB GoSkyObject
324.     END IF
325. END IF
326.  
327. IF i$ = "=" THEN GOSUB lmshow '                                       show LM data - pointless but amusing
328. IF i$ = "'" THEN pdiv = (pdiv + 1) MOD 4 '                            Henon speed, also slows down thrust display
329. IF radiationdeath THEN i$ = "": RETURN '                              you're dead and cannot pass this point
330.  
331. IF i$ = "`" THEN '                                                    Deathstar size - thought a smaller one wouuld be faster - it is - not by much
332.     dsinit = 0
333.     dstype = 2 + (MID$(f$(37), 6, 1) = "m")
334.     MID$(f$(37), 6, 1) = MID$("sm", dstype, 1)
335. END IF
336. IF i$ = "~" THEN darkstarc = darkstarc XOR 1 '                        color
337. IF i$ = "@" THEN darkstart = darkstart XOR 1 '                        thickness
338.  
339. IF inpause THEN '                                                     hit "p" or landed
340.     IF i$ = "b" THEN '                                                Big Dipper
341.         rmin = 9 '                                                    right ascension
342.         dmin = 30 '                                                   declination
343.         starinit = 0
344.         RETURN
345.     END IF
346.     IF li = 2 THEN '                                                  arrow keys move stars
347.         rdol = rmin + dmin '                                          detect change
348.         rmin = rmin + (k = 75) - (k = 77) '                           left right
349.         rmin = (rmin + 24) MOD 24 '                                   RA limit 0 - 24
350.         dmin = dmin - (k = 80) * t + (k = 72) * t '                   declination up down
351.         IF dmin = h THEN dmin = -80 '                                 limit -90 - 90
352.         IF dmin = -h THEN dmin = 80
353.         IF (rmin + dmin) <> rdol THEN starinit = 0 '                  changed, replot stars
354.     END IF
355. END IF
356. IF li = 2 THEN GOTO is2 '                                             extended key
357.  
358. IF i$ = "_" THEN '                                                    star twinkle
359.     twinkle = twinkle XOR 1
360.     mes$(0) = "STAR TWINKLE " + OnOff$(twinkle)
361. END IF
362. IF i$ = ";" THEN fpl = 1 '                                            force power loss
363. IF k = 9 THEN ex(1) = (suri + px!) - SGN(exv(1)) * h '                TAB summon DS
364. p = INSTR(")!@#$%^&*(", i$)
365. IF p AND (contact = 0) THEN GetSurface p - 1 '                        shifted-number for 1 of 10 surfaces
366. p = INSTR("01234", i$) '                                              stars off/on/info
367. IF p THEN starstatus = p - 1
368. IF k = 8 THEN '                                                       backspace, random star position
369.     rmin = INT(RND * 24) '                                            random RA
370.     dmin = (INT(RND * 18) - 9) * t '                                  random dec
371.     starinit = 0
372. END IF
373. IF i$ = "." THEN
374.     tfollow = tfollow XOR 1
375.     auto = 0
376.     vert = 1
377.     mes$(0) = "TERRAIN FOLLOWING " + OnOff$(tfollow)
378. END IF
379. p = (i$ = "<") - (i$ = ">") '                                         jump left/right
380. IF (contact = 0) AND (p <> 0) THEN
381.     suri = suri + 40 * p '                                            surface index
382.     GOSUB slimit '                                                    limit suri
383.     IF lock1 THEN hover = 1: lock1 = 0
384. END IF
385. IF (i$ = "+") AND (zoom < 2) THEN zoom = zoom + 1: starinit = 0
386. IF (i$ = "-") AND (zoom > 0) THEN zoom = zoom - 1: starinit = 0
387. IF i$ = "?" THEN rick = rick XOR 1 '                                  show speed of processing graph
388. IF okrick AND (i$ = "U") THEN tilef = (tilef + 1) MOD 3 '             alternate tilings
389. IF i$ = "/" THEN
390.     cpal = (cpal + 1) MOD 4 '                                         cycle green/black & white/normal monitor
391.     mes$(0) = "": mes$(1) = ""
392.     IF cpal = 1 THEN mes$(0) = "GT40 mode"
393.     IF cpal = 2 THEN mes$(1) = "Hyperion mode!"
394.     IF cpal = 3 THEN mes$(1) = "Do not adjust your set.  We control the horizontal and the vertical!"
395. END IF
396. IF k = 32 THEN '                                                      cycle thru features
397.     IF lock1 > 0 THEN '                                               on auto, landing zone selected, abort landing
398.         abort = 1
399.         mes$(0) = "ABORT!"
400.         IF vx! = 0 THEN vx! = .01
401.         RETURN
402.     END IF
403.     IF convo THEN '                                                   or speed up rendesvous
404.         sct! = .2
405.         sc! = TIMER
406.         RETURN
407.     END IF
408.  
409.     IF skyoff THEN tmod = t ELSE tmod = 16
410.     jf = (jf + 1) MOD tmod
411.     '          01234567890123456
412.     i$ = MID$("mtsiHg5wleObBWoR", jf + 1, 1) '                        cycle thru ground and sky features
413.     k = ASC(i$)
414.     IF demo AND (jf = 7) THEN i$ = "e" '                              skip LGM in demo, because it's on the grave
415. END IF
416.  
417. p = INSTR("RObBWo", i$) '                                             jump to CM, deathstar, etc.
418. IF p AND (skyoff = 0) THEN p = p - 1: GOSUB GoSkyObject
419.  
420. IF i$ = "A" THEN
421.     lam = lam XOR 1 '                                                 land at McDonalds
422.     IF lam AND (auto = 0) THEN i$ = "a" '                             turn on autopilot
423. END IF
424. IF i$ = "a" THEN '                                                    autopilot
425.     abort = 0 '                                                       in case it was on
426.     tfollow = 0
427.     auto = auto XOR 1 '                                               toggle
428.     IF auto AND (radarf = 0) THEN radarf = 2
429.     IF auto = 0 THEN hover = 1 '                                      be nice, help user
430.     pt! = TIMER '                                                     restart countdown
431. END IF
432. IF i$ = "c" THEN GOSUB CutOrOutOfFuel
433. IF i$ = "C" THEN doclock = doclock XOR 1
434. IF i$ = "d" THEN dump = dump XOR 1 '                                  fuel
435. IF i$ = "D" THEN restart = 1 '                                        restart with defaults
436. IF (i$ = "E") AND (starstatus > 0) THEN '                             end of universe
437.     IF eou = 0 THEN eou = -1 ELSE eou = eou + 1 '                     restart or speedup
438. END IF
439. IF i$ = "F" THEN
440.     fuel! = h
441.     lockfuel = 1
442. END IF
443. IF i$ = "f" THEN lockfuel = lockfuel XOR 1 '                          THIS cheat the GT40 had, using toggle switches!
444. IF i$ = "G" THEN gstyle = (gstyle + 1) MOD 6 '                        ground style
445. IF i$ = "h" THEN hover = hover XOR 1: apd = 1 '                       apd=autopilot disconnect warning
446. IF i$ = "I" THEN
447.     invincible = ABS(invincible) XOR 1
448.     mes$(0) = "INVINCIBLE MODE " + OnOff$(invincible)
449.     GOSUB ReadLM '                                                    to change thrusters
450. END IF
451. IF i$ = "j" THEN
452.     darkstars = (darkstars + 1) MOD 5
453.     mes$(0) = "Deathstar rotation" + STR$(darkstars)
454. END IF
455. IF i$ = "k" THEN '                                                    kill threats or, if none, shoot at ground feature
456.     firel = 1 '                                                       fire laser
457.     FOR z = 1 TO 20 '                                                 IBM shells
458.         shd(z) = 1
459.     NEXT z
460. END IF
461. IF i$ = "L" THEN GetSurface -1 '                                      level ground
462. IF (i$ = "M") AND ((contact + inpause) = 0) THEN '                    laser level & land
463.     magic = magic + 1
464. END IF
465. IF (i$ = "n") AND inpause THEN nation = ((nation - 1) XOR 1) + 1 '    flag 1 US, 2 USSR
466. IF i$ = "p" THEN GOSUB pause '                                        pause LM movement
467. IF (i$ = "P") AND (contact = 0) AND (warp! < 1) AND (paraf = 0) THEN
468.     paraf = 1 '                                                       parachute!
469.     chs = 0
470.     a = 0
471.     GOSUB CutOrOutOfFuel
472. END IF
473. IF i$ = "q" THEN Quit
474. IF i$ = "Q" THEN
475.     oscar = oscar XOR 1 '                                            land or sea flags for LGM
476.     IF oscar THEN z$ = "SEA" ELSE z$ = "LAND"
477.     mes$(0) = "LGM flags: " + z$
478. END IF
479. IF i$ = "r" THEN
480.     IF cut THEN '                                                     restart engine
481.         cut = 0
482.         hover = 1
483.         power = opower
484.         powerloss = 0
485.     ELSE
486.         IF auto = 0 THEN
487.             radarf = (radarf + 1) MOD 3
488.             mes$(0) = "Radar " + MID$("OFFON FAT", radarf * 3 + 1, 3)
489.         END IF
490.     END IF
491. END IF
492. IF i$ = "S" THEN MakeSur: restart = 1 '                               generate new surfaces
493. IF i$ = "T" THEN jitter = jitter XOR 1 '                              thrust computation
494. IF i$ = "u" THEN '                                                    instrument panel on/off
495.     zz = gs
496.     gs = (SGN(gs) XOR 1) * 85 '                                       graphics start
497.  
498.     panelinit = 0
499.     pif = -1
500.  
501.     z = (gs + 30) - px!
502.     IF (gs > 0) AND (z > 0) THEN
503.         px! = px! + z
504.         suri = suri - z
505.         GOSUB slimit
506.     END IF
507. END IF
508. IF i$ = "v" THEN '                                                    vertical automatic
509.     IF tfollow THEN
510.         tfollow = 0
511.         mes$(0) = "TERRAIN FOLLOWING OFF"
512.     END IF
513.     vert = vert XOR 1
514.     apd = 1 '                                                         autopilot disconnect warning
515. END IF
516. IF i$ = "x" THEN starinit = 0: starfiles = (starfiles + 1) MOD 3 '    star density
517. IF i$ = "X" THEN starinit = 0: regen = 1: Stars '                     regenerate single star file
518. IF i$ = "y" THEN
519.     mouseswap = mouseswap XOR 1
520.     IF mouseswap THEN z$ = "reversed" ELSE z$ = "normal"
521.     mes$(0) = "Mouse buttons " + z$
522. END IF
523. IF i$ = "Y" THEN min = 3: sec = 45 '                                  black hole at 3:50
524. IF (i$ = "z") AND (crash = 0) THEN
525.     mes$(0) = "" '
526.     mes$(1) = "" '                                                    erase radiation messages
527.     dead$ = "SELF-DESTRUCT"
528. END IF
529.  
530. IF i$ = "}" THEN
531.     GOSUB CutOrOutOfFuel
532.     sgs = gs: gs = 0
533.     srf = radarf: radarf = 0
534.     GOSUB Plotscreen
535.     dissolve
536.     dead$ = " "
537.     gs = sgs: radarf = srf
538. END IF
539.  
540. '          1234567890
541. p = INSTR("5wlemtsiHg", i$) '                                         jump to feature
542. IF p AND (contact = 0) THEN
543.     sf = p
544.     IF demo AND sf = 9 THEN sf = t
545.     IF (sf(sf, 1) >= suri) AND (sf(sf, 0) < (suri + q3)) THEN '       already in vicinity of IBM
546.         IF sf = 8 THEN shoot = 1 '                                    tell IBM to fire
547.         IF demo THEN '                                                IBM at special location in demo mode, deal with it
548.             px! = sf(sf, 2) - 3130
549.             suri = 3130
550.         END IF
551.     ELSE
552.         px! = center '                                                move ship to screen center
553.         suri = sf(sf, 0) - center - 30 - (sf = 9) * h '               move ground to IBM
554.     END IF
555.     a = -ma '                                                         angle = -malfunction angle
556.     abort = 0
557.     wa = -ma '                                                        want angle
558.     lock1 = 0 '                                                       radar lock
559.     tmt! = 0 '                                                        to move total
560.     vx! = 0 '                                                         not moving
561.     warp! = 0 '                                                       cancel warp
562. END IF
563. GOTO endk '                                                           done with ordinary keys
564.  
565. is2: '                                                                extended key
566. z = mdelay '                                                          master delay
567. mdelay = mdelay - (k = 73) + (k = 81) '                               PgUp/PgDn
568. IF mdelay < 1 THEN mdelay = 1
569. IF mdelay <> z THEN '                                                 changed
570.     mes$(0) = "_LIMIT " + OnOff$(SGN(mdelay))
571.     IF mdelay THEN mes$(0) = mes$(0) + LTRIM$(STR$(mdelay))
572. END IF
573. IF status AND 3 THEN '                                                left or right shift
574.     IF k = 72 THEN k = 201 '                                          LM up
575.     IF k = 75 THEN k = 203 '                                          LM left
576.     IF k = 77 THEN k = 204 '                                          LM right
577. END IF
578. IF (inpause = 0) AND ((k = 72) OR (k = 80)) THEN '                    up and down arrow
579.     apd = 1 '                                                         autopilot disconnect
580.     hover = 0
581.     vert = 0
582.     thrust! = thrust! + (k = 80) - (k = 72) '                         true = -1
583. END IF
584. thrust! = INT(thrust! * t) / t '                                      t = 10
585. IF (hover = 0) AND (vert = 0) THEN thrust! = INT(thrust!)
586. IF thrust! > h THEN thrust! = h
587. IF (dump = 0) AND (fuel! > 0) AND (contact = 0) THEN '                side thrust/angle
588.     IF inpause = 0 THEN wa = a - (k = 75) + (k = 77) '                                    left/right arrows
589.     IF ABS(wa) > 99 THEN wa = 99 * SGN(wa) '                          want angle, limit 99
590.     IF a <> wa THEN apd = 1 '                                         autopilot disconnect
591. END IF
592. IF k = 59 THEN '                                                      F1 help
593.     mHelp
594.     start1! = TIMER: mpass& = 0 '                                     reset speed timer
595. END IF
596. IF k = 60 THEN '                                                      F2 demo
597.     demo = demo XOR 1
598.     GOSUB init2
599.     cbh = demo '                                                      constant black holes
600. END IF
601. IF k = 61 THEN '                                                      F3, sky feature toggle
602.     skyoff = skyoff XOR 1
603.     IF skyoff = 0 THEN convo = 0
604.     mes$(0) = "SKY OBJECTS " + OnOff$(1 - skyoff)
605. END IF
606. IF k = 62 THEN '                                                      F4 endless bh
607.     cbh = cbh XOR 1
608.     exv(3) = 0
609.     mes$(0) = "CONSTANT BLACK HOLES " + OnOff$(cbh)
610. END IF
611. IF k = 63 THEN '                                                      F5 instrument background
612.     f5toggle = f5toggle XOR 1
613.     IF f5toggle = 0 THEN background = background XOR 1
614.     IF f5toggle = 1 THEN porb = porb XOR 1
615.     pload = 0
616. END IF
617. IF (k = 64) AND ((ASO + inpause) = 0) THEN '                          F6 seperate AS/DS
618.     GOSUB liftoff
619.     RETURN
620. END IF
621. IF k = 65 THEN showmap = showmap XOR 1 '                              F7 map
622. IF k = 66 THEN '                                                      F8 shields
623.     shield = shield XOR 1
624.     geof = shield * t
625. END IF
626. IF k = 67 THEN '                                                      F9 LED color
627.     z$ = RIGHT$("0" + LTRIM$(STR$(LEDc)), 2)
628.     z = INSTR(LED$, z$): IF z = 11 THEN z = -1
629.     LEDc = VAL(MID$(LED$, z + 2, 2))
630.     LEDtri = 0
631. END IF
632. IF k = 68 THEN '                                                      F10 LED tri-color
633.     LEDtri = LEDtri XOR 1
634.     IF LEDtri THEN LEDc = green
635. END IF
636. IF k = 71 THEN rmin = 0: dmin = 0: starinit = 0 '                     Home, star RA/dec to 0
637.  
638. endk:
639. IF k = 201 THEN hoverc = hoverc - t '                                 move up
640. IF k = 203 AND (left = 0) THEN left = 16 '                            move left
641. IF k = 204 AND (right = 0) THEN right = 16 '                          move right
642. IF apd OR (k = 201) OR (k = 203) OR (k = 204) THEN '                  blink AUTO
643.     IF auto THEN APdisengage = 20 '                                   blink 20 times
644.     auto = 0 '                                                        turn it off
645.     apd = 0 '                                                         reset flag
646. END IF
647. RETURN
648.  
649. pause:
650. IF inpause THEN RETURN '                                              already doing this....
651. dead$ = ""
652. inpause = 1
653. pt! = TIMER '                                                         for demo mode
654. wu! = pt! + 1 '                                                       delay before planting flag
655. DO: _LIMIT mdelay
656.     GOSUB KeyAndMouse
657.     IF k = 60 THEN RETURN '                                           F2 demo
658.     IF (i$ > "") AND (INSTR("zD", i$)) THEN RETURN '                  self-destruct or restart
659.     GOSUB Plotscreen
660.     IF LEN(dead$) THEN RETURN
661.     IF auto AND contact THEN '                                        countdown to blast off
662.         IF TIMER < pt! THEN pt! = TIMER '                             midnite crossing fix
663.         z! = TIMER - pt!
664.         z = t - z!
665.         IF z < 0 THEN z = 0
666.         TextOnLM$ = LTRIM$(STR$(z))
667.         IF z! > t THEN i$ = CHR$(13) '                                like pressing the key
668.     END IF
669.     GOSUB CalcFuel
670. LOOP UNTIL (i$ = CHR$(13)) OR (i$ = "p")
671. ctime! = TIMER
672. fb$ = "" '                                                            feedback
673. inpause = 0
674. c = (contact = 1) AND (crash = 0) AND (liftoff = 0) AND (ABS(a) < 31)
675. IF c THEN GOSUB liftoff
676. RETURN
677.  
678. CalculateMotion:
679. i = 0
680. IF (power = opower) AND (RND < .0003) THEN
681.     i = ((auto + contact + liftoff + vert) = 0) AND ((min * 60 + sec) > t)
682. END IF
683. IF fpl OR i THEN '                                                    force power loss
684.     fpl = 0
685.     powerloss = t + RND * t + ASO * 30 '                              10 TO 20%, 50% ASO
686.     power = opower + powerloss / h * opower
687.     mes$(0) = LTRIM$(STR$(powerloss)) + "% POWER LOSS - DUMP FUEL!"
688. END IF
689.  
690. IF lob THEN px! = px! + exv(2) '                                      landed on Borg
691. IF contact OR inpause THEN GOTO other
692.  
693. ta = ((a + ma) + 270) MOD tsix '                                       temp angle = a+malfunction angle
694. ma! = (vmass + fuel!) / th '                                          actually 54% fuel
695. fo! = ((thrust! + super * 5) / ma!) / power '                         f = ma
696. IF fuel! = 0 THEN fo! = 0 '                                           nix any force if running on empty
697. fx! = fo! * c!(ta) / 2
698. IF dump AND (ABS(a) < 5) THEN fx! = 0
699. fy! = fo! * s!(ta) + grav! '                                          thrust + gravity
700. IF warp! > 0 THEN fx! = fx! * (warp! * 2 + 1) '                       get thru warp msgs faster
701. vx! = vx! - fx!
702. IF a <> 0 THEN vx! = vx! + (RND - pf!) / h '                          help get to integer vx
703. IF ABS(vx!) < .01 THEN vx! = 0
704. avx = ABS(vx!)
705. IF (avx > 5) AND (avx < 20) THEN xoff = vx! ELSE xoff = 0
706. IF cut AND (magic = 0) THEN
707.     cel! = TIMER - ctime! '                                           time since cut
708.     vy! = cvy! + grav! * (cel! * cel!) '                              v = at^2  velocity = acceleration times time squared
709.     fy! = 0 '                                                         null y force since it's a different situation
710. END IF
711. vy! = vy! + fy!
712. IF warp! >= 1 THEN vy! = 0
713.  
714. px! = px! + vx! - lob * exv(2)
715. py! = py! + vy!
716.  
717. IF (liftoff = 0) AND (py! < 55) THEN '                                stop going off screen top
718.     IF convo = 0 THEN mes$(0) = "Too high - reduce thrust!"
719.     py! = 55
720.     vy! = 0
721. END IF
722.  
723. other:
724. GOSUB CalcFuel
725. IF liftoff AND (lob = 0) THEN RETURN
726. nomove = demo AND (((suri \ q3) + 1) = 5)
727.  
728. zz = px! - center
729. z! = ABS(vx!)
730.  
731. IF (nomove = 0) AND ((rlink > 0) OR (z! < 3) OR (z! > 20)) THEN
732.     dx! = px! - center
733.     px! = center
734.     tmt! = tmt! + dx!
735. ELSE
736.     zq = 0 '                                                          was 30 woof woof
737.     c1 = (px! <= (gs + zq))
738.     c2 = (px! >= (q3 - zq))
739.     IF c1 OR c2 THEN
740.         IF c1 THEN z = q3 - zq ELSE z = gs + zq
741.         z = z - px!
742.         tmt! = tmt! - z
743.         px! = px! + z
744.     ELSEIF (zz <> 0) AND (ABS(vx!) <= 5) AND (nomove = 0) THEN
745.         z = zz \ 2 + 1
746.         tmt! = tmt! + z
747.         px! = px! - z
748.     END IF
749. END IF
750. IF ABS(tmt!) >= q3 THEN tmt! = SGN(tmt!) * q3 - 1
751.  
752. IF left THEN '                                                        jog left (shift left arrow)
753.     IF left = 16 THEN sv! = vx!
754.     IF left > 8 THEN a = 4 ELSE a = -4
755.     left = left - 1
756.     IF left = 0 THEN a = 0: vx! = sv!
757. END IF
758. IF right THEN '                                                       jog right (shift right arrow)
759.     IF right = 16 THEN sv! = vx!
760.     IF right > 8 THEN a = -4 ELSE a = 4
761.     right = right - 1
762.     IF right = 0 THEN a = 0: vx! = sv!
763. END IF
764. RETURN
765.  
766. CalcFuel:
767. IF cut THEN thrust! = 0
768. IF lockfuel = 0 THEN
769.     ta = ABS(a): IF ta > 5 THEN ta = 5 '                              main angle, up to 5
770.     z! = (ta + super + ABS(fst)) * t '                                plus 10% for thrusters
771.     used! = (thrust! + z!) / 8000
772.     IF ASO THEN used! = used! * 2 '                                   burn faster for AS
773.     IF inpause THEN used! = 0
774.     IF shield THEN used! = used! + .001
775.     fuel! = fuel! - used! * 4
776.     IF fuel! <= 0 THEN fuel! = 0: GOSUB CutOrOutOfFuel
777. END IF
778. RETURN
779.  
780. Plotscreen:
781. IF bit! = 0 THEN bit! = TIMER + pf!
782. IF TIMER > bit! THEN
783.     bbit = bbit XOR 1 '                                               toggles twice per second, used all over - instruments, IBM hazard lights, clock colon, LGM ear wiggle
784.     bit! = 0
785. END IF
786.  
787. bolthit = 0
788. bolthitf = 0
789. IF (crash = 0) AND (ABS(vx!) >= h) THEN warp! = ABS(vx!) / h ELSE warp! = 0
790. IF warp! >= 1 THEN paraf = 0 '                                        reckon parachute can be dropped at warp speeds
791.  
792. ' change styles every 10/30 seconds
793. IF style! = 0 THEN style! = TIMER + t
794. IF style! > 86400 THEN style! = 1 '                                   midnite xing
795. IF TIMER > style! THEN
796.     bstyle1 = (bstyle1 + 1) MOD 3 '                                   Borg guts every 10s
797.     IF bstyle1 = 0 THEN bstyle2 = bstyle2 XOR 1 '                     Borg exhaust
798.     style! = 0
799. END IF
800.  
801. IF (starstatus > 0) AND (eou = 0) AND (vert = 0) AND (RND > .9999) THEN '  stars on+not already falling+WHY?+rarely
802.     mes$(0) = "THE SKY IS FALLING!  THE SKY IS FALLING!"
803.     eou = 1
804. END IF
805. GOSUB CalculateMotion
806.  
807. IF gs THEN '                                                          graphics start not 0, instruments are visible
808.     VIEW
809.     pif = (pif + 1) MOD (pdiv + 1)
810.     IF pif THEN timemachine ELSE GOSUB Instruments '                  INSTRUMENTS
811. END IF
812. IF starstatus THEN
813.     VIEW SCREEN(gs, SGN(LEN(mes$(0))) * 20)-(q3, q4)
814.     Stars '                                                           STARS
815.     VIEW SCREEN(gs, 0)-(q3, q4)
816. ELSE
817.     VIEW SCREEN(gs, 0)-(q3, q4)
818.     CLS
819. END IF
820.  
821. IF LEN(mes$(0)) THEN
822.     VIEW SCREEN(gs, 0)-(q3, 20)
823.     CLS
824.     VIEW SCREEN(gs, 0)-(q3, q4)
825. END IF
826.  
827. Info '                                                                INFO show timed messages at top, if any
828. IF warp! < 1 THEN '                                                   no sky features except star streaks at warp speeds
829.     IF skyoff = 0 THEN GOSUB SkyStuff '                               CM/DS/Bo/BH/Wo/Co
830.     GOSUB PlotGround '                                                GROUND/FEATURES
831.     Shells '                                                          SHELLS
832.     IF (invincible = 0) AND (shield = 0) AND (skyoff = 0) THEN GOSUB FiveWaysToDie
833. END IF
834. IF platform THEN PUT (pminx, pminy), gbuff(), OR '                    falling descent stage
835. IF LEN(dead$) = 0 THEN GOSUB PlotVehicle '                            VEHICLE
836. IF (warp! < 1) AND showmap AND (crash = 0) THEN
837.     VIEW
838.     Map '                                                             LM, ground & sky features
839.     VIEW SCREEN(gs, 0)-(q3, q4)
840. END IF
841. IF bolthit THEN '                                                     lightning zap from Deathstar
842.     boltc = boltc + 1 + (boltc = 9999)
843.     rtl!(2) = TIMER + 5
844.     rtlc(2) = boltc
845.     IF ((invincible + shield) = 0) AND (boltc >= t) THEN dead$ = "Zapped!" '   by EPCOR!"
846. END IF
847.  
848. IF okrick AND (LEN(debug$) > 0) THEN LOCATE 1, 12: PRINT debug$;
849. timemachine
850.  
851. RETURN
852.  
853. SkyStuff:
854. IF (min = 3) AND (sec = 50) THEN '                                    Tree-fiddy! (Southpark), do black hole
855.     ex(3) = suri + t
856.     ey(3) = h
857.     exv(3) = t
858.     eyv(3) = 1
859. END IF
860.  
861. IF cmleaving THEN
862.     exv(0) = exv(0) + 2
863.     IF exv(0) = 0 THEN exv(0) = 1
864. END IF
865.  
866. RESTORE skycrud
867. IF eou THEN mi = 2 ELSE mi = 5 '                                      end of universe, no celestial events
868. FOR i = 0 TO mi '                                                     0CM 1DS 2Borg 3BH 4Worm 5Comet 6Al
869.     READ g$, skyset1(i), skyset2(i)
870. NEXT i
871.  
872. FOR i = 0 TO mi + ufof '                                              0CM 1DS 2Borg 3BH 4Worm 5Comet 6Alien
873.     xplus = skyset1(i): xminus = skyset2(i)
874.     IF (i = 3) AND cbh THEN ek(i) = 0 '                               constant black hole
875.     IF ek(i) = -1 THEN GOTO ni2
876.  
877.     IF (ey(i) > (q4 + 50)) OR (ey(i) < -50) OR (exv(i) = 0) THEN
878.         ei(i) = 0 '                                                   ini
879.         ek(i) = 9999
880.         nx:
881.         ex(i) = RND * q1
882.         IF ABS(ex(i) - (px! + suri)) < q3 THEN GOTO nx '              start away from craft
883.         IF ABS(ex(i) - px!) < q3 THEN GOTO nx '                       start away from craft
884.         IF i = 2 THEN ex(i) = (ex(1) + 3200) MOD q1
885.         ey(i) = 120 + RND * h '                                       random y 120-220
886.         IF i = 0 THEN ey(i) = 22 '                                    CM
887.         IF i = 1 THEN ey(i) = 170 '                                   DS
888.         IF i = 2 THEN ey(i) = th '                                    Borg
889.         '              0 1 2 3 4 5
890.         '              CMDeBoBHWoCoAl
891.         c1 = VAL(MID$("04010210120502", i * 2 + 1, 2)) '              min x velocity
892.         c2 = VAL(MID$("09030210171005", i * 2 + 1, 2)) '              max x velocity
893.         exv(i) = RND * (c2 - c1) + c1 '                               random in range
894.         IF RND > pf! THEN exv(i) = -exv(i)
895.  
896.         z = VAL(MID$("00000003020100", i * 2 + 1, 2)) '               top range y velocity
897.         eyv(i) = 0
898.         IF z THEN eyv(i) = RND * (z - 1) + 1 '                        random in range
899.  
900.         IF RND > pf! THEN exv(i) = -exv(i)
901.         IF RND > pf! THEN eyv(i) = -eyv(i)
902.         IF (i = 3) AND cbh THEN
903.             IF RND > pf! THEN
904.                 ex(i) = suri - t
905.                 exv(i) = t
906.             ELSE
907.                 ex(i) = suri + q3 + t
908.                 exv(i) = -t
909.             END IF
910.         END IF
911.     END IF
912.  
913.     ex(i) = ex(i) + exv(i)
914.     ey(i) = ey(i) + eyv(i)
915.  
916.     IF ex(i) < 0 THEN
917.         IF (i = 0) AND cmleaving THEN
918.             ek(i) = -1: cmleaving = 0
919.         ELSE
920.             ex(i) = ex(i) + q1
921.         END IF
922.     END IF
923.     IF ex(i) > q1 THEN
924.         IF (i = 0) AND cmleaving THEN
925.             ek(i) = -1: cmleaving = 0
926.         ELSE
927.             ex(i) = ex(i) - q1
928.         END IF
929.     END IF
930.  
931.     exl(i) = localize(ex(i), xplus, xminus)
932.     IF (i = 3) AND cbh AND (exl(i) = 9999) THEN exv(i) = 0
933.  
934.     IF ek(i) <> -1 THEN ek(i) = 9999
935.     IF exl(i) <> 9999 THEN
936.         dx! = ABS(px! - exl(i))
937.         dy! = ABS(py! - ey(i))
938.         ek(i) = SQR(dx! * dx! + dy! * dy!)
939.  
940.         IF i = 0 THEN GOSUB CommandModule
941.         IF i = 1 THEN DeathStar exl(i), f$(37)
942.         IF i = 2 THEN Borg exl(i), ey(i)
943.         IF i = 3 THEN
944.             IF (LEN(mes$(0)) = 0) AND (showmap = 0) AND (cbh = 0) THEN
945.                 mes$(0) = "DANGER, WILL ROBINSON, DANGER!"
946.             END IF
947.             IF sas = 0 THEN BlackHole 0
948.             sas = 0
949.         END IF
950.         IF i = 4 THEN WormHole
951.         IF i = 5 THEN
952.             tx = localize(ex(5), 0, 0)
953.             ty = ey(5)
954.             Comet tx, ty
955.         END IF
956.         IF i = 6 THEN '                                               traditional alien - too silly
957.             j = RND * h - h \ 2
958.             z = ey(6) + j
959.             IF (RND > .9) AND (z > h) AND (z < 250) THEN
960.                 ey(6) = z
961.                 alien = alien XOR 1
962.                 ex(6) = ex(6) + 20 * SGN(alien - pf!)
963.             END IF
964.             UFO exl(6), ey(6), exv(6)
965.         END IF
966.     END IF
967.     ni2:
968. NEXT i
969. RETURN
970.  
971. FiveWaysToDie:
972. IF (ek(2) >= 0) AND (ek(2) < 20) THEN '                               Borg
973.     wu! = TIMER + 5
974.     DO: _LIMIT mdelay
975.         CLS
976.         mes$(0) = "YOU ARE BORG"
977.         Info
978.         Borg exl(2), ey(2)
979.         FOR i = 1 TO rp
980.             p = POINT(LMrx(i), LMry(i))
981.             IF p = black2 THEN c = green ELSE c = black2
982.             PSET (LMrx(i), LMry(i)), c
983.         NEXT i
984.         timemachine
985.     LOOP UNTIL TIMER > wu!
986.     dead$ = "BORG"
987. END IF
988.  
989. IF (ek(3) >= 0) AND (ek(3) < 30) THEN '                               black hole
990.     dead$ = "EATEN"
991.     BlackHoleDoom
992. END IF
993.  
994. IF (ek(4) >= 0) AND (ek(4) < 30) THEN '                               wormhole
995.     wu! = TIMER + 5
996.     spx! = exl(4)
997.     spy! = ey(4)
998.     exv(4) = 0
999.     eyv(4) = 0
1000.     wradar = radarf
1001.     radarf = 1
1002.     cut = 1
1003.     DO: _LIMIT mdelay
1004.         CLS
1005.         fb$ = ""
1006.         mes$(0) = "HOLY CRAP, BATMAN!"
1007.         mes$(1) = ""
1008.         Info
1009.         a = RND * 359
1010.         px! = spx! + (RND - pf!) * 20
1011.         py! = spy! + (RND - pf!) * 5
1012.         WormHole
1013.         LMdistort '                                                   optional
1014.         GOSUB PlotVehicle
1015.         timemachine
1016.     LOOP UNTIL TIMER > wu!
1017.     radarf = wradar
1018.     dead$ = "BATMAN"
1019. END IF
1020.  
1021. IF (ek(5) >= 0) AND (ek(5) < 15) THEN dead$ = "HIT BY COMET"
1022. IF ufof AND (ek(6) >= 0) AND (ek(6) < 45) THEN dead$ = "HIT BY ALIEN"
1023. RETURN
1024.  
1025. GetAlt:
1026. alt! = (gety(-(rxm + wi2)) - ((sy1 + sy2) \ 2)) / 5
1027. RETURN
1028.  
1029. Instruments:
1030. osc = 8
1031. IF gs THEN LoadPanel '                                                graphics start not zero, instrument panel is on
1032. IF (warp! > 0) AND (contact = 0) THEN
1033.     IF warp! >= t THEN
1034.         dead$ = "WARP 10"
1035.         RETURN
1036.     END IF
1037.     RESTORE warp
1038.     FOR i = 1 TO INT(warp!)
1039.         READ z$
1040.     NEXT i
1041.     w$ = LTRIM$(STR$(INT(warp! * h) / h))
1042.     IF LEN(w$) = 1 THEN w$ = w$ + ".00"
1043.     IF LEN(w$) = 3 THEN w$ = w$ + "0"
1044.     mes$(0) = "WARP " + w$ + " - " + z$
1045.     IF gs AND ((TIMER MOD t) > 5) THEN
1046.         Henonp f
1047.         Wave '                                                        osc = 5 if commented out
1048.         AuHoVe auto, hover, vert, lam
1049.         GOTO clock
1050.     END IF
1051. END IF
1052.  
1053. IF gs = 0 THEN RETURN '                                               graphics start of 0 means the instrument panel is off
1054.  
1055. IF panelinit = 0 THEN
1056.     IF crash THEN f = 15 ELSE f = ((f + 1) MOD 5) + t '               title graphic/face
1057. END IF
1058.  
1059. Henonp f '                                                            title graphic
1060.  
1061. LINE (0, 0)-(gs - 1, 3), blue2, BF '                                  clear map area
1062.  
1063. IF pdiv THEN '                                                        instrument update frequency 1-4, mainly a way to slow down erratic thrust display
1064.     j = 0
1065.     FOR i = 1 TO 18 '                                                 my name in Morse
1066.         p = VAL(MID$("002032023222300032", i, 1)) '                   Frost
1067.         IF p < 3 THEN LINE (14 + j, 2)-(14 + j + p, 2), white
1068.         j = j + p + 2
1069.     NEXT i
1070. END IF
1071.  
1072. IF (contact + auto + hover + vert + liftoff) = 0 THEN
1073.     IF (vy! > .6) AND (-fy! < 0) THEN PrintVGA CHR$(24), 5, 241, red, black2
1074.     IF (vy! < .4) AND (-fy! > -.01) THEN PrintVGA CHR$(25), 5, 250, yellow, black2
1075. END IF
1076.  
1077. AuHoVe auto, hover, vert, lam
1078.  
1079. IF tfollow THEN '                                                     terrain following!
1080.     FOR ty = glmax - 20 TO glmax
1081.         FOR tx = 0 TO gs - 1
1082.             IF POINT(tx, ty) = blue THEN PSET (tx, ty), red '         red bg
1083.         NEXT tx
1084.     NEXT ty
1085.     FOR i = 0 TO 4 '                                                  TF
1086.         p& = VAL("&H" + MID$("E744464444", i * 2 + 1, 2))
1087.         LINE (2, 339 + i)-(10, 339 + i), green, , p& * 128
1088.     NEXT i
1089. END IF
1090.  
1091. osc = 0
1092. c = LEDc
1093. IF (sbest! >= h) OR powerloss THEN c = red
1094. z! = thrust!: IF z! > h THEN z! = h '                                 200 at liftoff, show 100
1095. PrepAndShowLED z!, 3, 1 '                                             thrust osc1
1096. PrintCGA "T", 5, -1, c, -blue, 0 '                                    T is for flame
1097. i = LEDc: j = black
1098. IF jitter THEN SWAP i, j '                                            thrust calc type
1099. LINE (4, 231)-(5, 232), i, B '                                        left light  (on = slow)
1100. LINE (13, 231)-(14, 232), j, B '                                      right light (on = fast)
1101. Bar z! / h, 0
1102.  
1103. c = dcolor(vy!, 2, 3, 1) '                                            vy osc2
1104. z! = vy!
1105. IF ABS(z!) > 99.97 THEN z! = 99.99
1106. PrepAndShowLED z!, 3, 2
1107. PrintCGA "V", 5, -1, c, -blue2, 0
1108. z! = (z! + 3) / 6
1109. Bar z!, 1
1110.  
1111. c = dcolor(vx!, 2, 3, 1) '                                            vx osc3
1112. IF warp! THEN
1113.     z! = warp!
1114. ELSE
1115.     z! = vx! + rfs!
1116. END IF
1117. PrepAndShowLED z!, 3, 2
1118. PrintCGA "H", 5, -1, c, -blue, 0
1119. z! = (z! + 3) / 6
1120. Bar z!, 1
1121.  
1122. GOSUB GetAlt '                                                        alt osc4
1123. IF contact AND (alt! > 0) THEN alt! = 0
1124. c = dcolor(alt!, t, 3, -1)
1125. PrepAndShowLED alt!, 4, 1
1126. PrintCGA "A", 5, -1, c, -blue2, 0
1127. IF warp! OR (radarf = 0) THEN z! = 0 ELSE z! = alt! / 60
1128. Bar z!, 0
1129.  
1130. c = dcolor(fuel!, t, 5, -1) '                                         fuel osc5
1131. PrepAndShowLED fuel!, 4, 1
1132. PrintCGA "F", 5, -1, c, -blue, 0
1133. z! = fuel! / h
1134. Bar z!, 0
1135.  
1136. clock:
1137. IF TIMER < start2! THEN start2! = TIMER '                             midnite crossing
1138. IF crash = 0 THEN el! = el! + (TIMER - start2!) '                     elapsed time
1139. start2! = TIMER
1140. IF el! >= 1 THEN
1141.     WHILE el! >= 1 '                                                  catch-up
1142.         el! = el! - 1
1143.         sec = (sec + 1) MOD 60
1144.         IF sec = 0 THEN min = (min + 1) MOD 99
1145.     WEND
1146.     IF sec MOD 5 = 0 THEN '                                           change title graphic
1147.         IF crash THEN f = 15 ELSE f = ((f + 1) MOD 5) + t
1148.     END IF
1149. END IF
1150. z$ = RIGHT$("0" + LTRIM$(STR$(min)), 2) + RIGHT$("0" + LTRIM$(STR$(sec)), 2)
1151. osc = 6
1152. LEDdisplay z$ '                                                       clock osc6
1153.  
1154. i = suri + px!
1155. j = ABS(i - sf(5, 2))
1156. k = sf(5, 2) + (q1 - i)
1157. IF j <= 3200 THEN dtm! = j ELSE dtm! = k
1158. PrepAndShowLED dtm!, 4, 0 '                                           dtm osc7
1159. PrepAndShowLED CSNG(speed), 4, 0 '                                    speed osc8
1160. ShowAngle a '                                                         angle osc9
1161. panelinit = 1
1162. RETURN
1163.  
1164. LMcolors: '                                                           optional
1165. IF contact OR (vx! = 0) THEN lbit = 0
1166. IF (contact + vx!) = 0 THEN
1167.     v1 = RND * 3
1168.     v2 = RND * 3
1169.     SWAP LMci(v1), LMci(v2)
1170. END IF
1171. FOR i = 1 TO rp '                                                     right pad
1172.     oc = LMoc(i)
1173.     LMc(i) = oc
1174.     IF (oc = craft) OR (oc = red) THEN '                              shadow
1175.         zx = LMrx(i) - px! + 2 - xoff * (inpause = 0)
1176.         zy = LMry(i) - py!
1177.         IF (oc = craft) AND ((warp! > 0) OR (zy > zx)) THEN
1178.             tc = gray2
1179.         ELSE
1180.             tc = oc
1181.         END IF
1182.         LMc(i) = tc
1183.     END IF
1184.     IF (i < 279) AND (LMoc(i) = black2) THEN '                        Ascent stage cycle
1185.         lbit = (lbit + 5) MOD 4
1186.         LMc(i) = LMci(lbit)
1187.     END IF
1188. NEXT i
1189. lbit = lbit - (vx! > 0) * 2 + ASO * t
1190. RETURN
1191.  
1192. PlotVehicle:
1193. IF warp! < 1 THEN
1194.     wda = 0
1195. ELSE
1196.     px! = wx!: py! = wy!
1197.     wda = warp! * 5 * s!((px! + 40) MOD tsix)
1198. END IF
1199.  
1200. IF crash THEN
1201.     FOR i = 1 TO rp
1202.         PSET (LMrx(i), LMry(i)), LMc(i)
1203.     NEXT i
1204.     GOTO endproc
1205. END IF
1206.  
1207. IF bolthit = 0 THEN GOSUB LMcolors
1208.  
1209. i = sf(4, 2) - 50 '                                                   left of volcano
1210. j = sf(4, 2) + 50 '                                                   right of volcano
1211. k = suri + px! '                                                      LM position
1212. IF (k > i) AND (k < j) THEN '                                         in the locality?
1213.     c = 0 '                                                           count
1214.     FOR ty = py! + 8 TO py! + 18 '                                    leg/nozzle area
1215.         FOR tx = px! - 17 TO px! + 17
1216.             p = POINT(tx, ty) '                                       what color is the pixel?
1217.             c = c - (p = orange) '                                    hot lava
1218.         NEXT tx
1219.     NEXT ty
1220.     ' LINE (px! - 17, py! + 8)-(px! + 17, py! + 18), yellow, B '      diagnostics
1221.     IF c THEN '                                                       contacted some lava
1222.         FOR i = rp TO 1 STEP -1 '                                     from the bottom
1223.             IF LMoc(i) = craft THEN '                                 is normal color?
1224.                 LMoc(i) = red '                                       make red
1225.                 nred = nred + 1 '                                     keep track of count
1226.                 c = c - 1
1227.                 IF c = 0 THEN EXIT FOR '                              enough
1228.             END IF
1229.         NEXT i
1230.     END IF
1231. END IF
1232.  
1233. IF nred = 0 THEN '                                                    number red
1234.     temp = 0
1235.     rtlc(1) = 0
1236. ELSE
1237.     IF ASO THEN z = 115 ELSE z = 223 '                                max that COULD be normal
1238.     otemp = temp
1239.     temp = (nred * h / z) MOD 101 '                                   temperature
1240.     rtlc(1) = temp
1241.     IF temp > otemp THEN rtl!(1) = TIMER + 5
1242.     c = 24 '                                                          gasoline
1243.     IF temp > 30 THEN c = 32 '                                        dark red
1244.     IF temp > 60 THEN c = 4 '                                         red
1245.     IF temp = h THEN c = 15 '                                         white
1246.     IF bw = 0 THEN PALETTE gasoline, c
1247.     IF (temp = h) AND (invincible = 0) THEN dead$ = "FRIED BY VOLCANO"
1248.     FOR i = 0 TO 20 '                                                 cool down some
1249.         j = RND * rp
1250.         IF LMoc(j) = red THEN LMoc(j) = craft: nred = nred - 1
1251.     NEXT i
1252. END IF
1253.  
1254. n = rp '                                                              last pixel = right pad
1255. IF fuel! > 0 THEN GOSUB Exhaust '                                     maybe vehicle only
1256.  
1257. IF n > maxn THEN maxn = n
1258.  
1259. ta = a + ma '                                                         temp a = a + malfunction
1260. zz = ta * -(ABS(ta) > 4) '                                            rotate beyond 5 degrees
1261. ta = (zz + wda + tsix) MOD tsix '                                             keep in array bounds
1262. c! = c!(ta) '                                                         cosine
1263. s! = s!(ta) '                                                         sine
1264. ta = zz '                                                             angle to use
1265.  
1266. rfx = 0 '                                                             optional craft jitter
1267. rfy = 0
1268. rfs! = 0 '                                                            random change in vx
1269. IF (jitter = 1) AND (cut = 0) THEN '                                  not slow or engine cut
1270.     IF (RND > .9) AND (a = 0) THEN '                                  a = angle
1271.         IF RND > pf! THEN rfx = 1 ELSE rfx = -1 '                     half right, half left
1272.         rfs! = rfx * .01 * (INT(RND * 9) + 1) '                       how much? .01 - .09
1273.     END IF
1274.     IF RND > .9 THEN '                                                y jitter, 1 chance in 10
1275.         IF RND > pf! THEN rfy = 1 ELSE rfy = -1 '                     half down, half up
1276.     END IF
1277. END IF
1278.  
1279. IF doclock THEN
1280.     i = VAL(MID$(TIME$, 1, 2))
1281.     j = VAL(MID$(TIME$, 4, 2))
1282.     k = VAL(MID$(TIME$, 7, 2))
1283.     clocka(0) = (i + j / 60) * 30 '                                   hour hand
1284.     clocka(1) = j * 6 '                                               minute hand
1285.     clocka(2) = k * 6 '                                               seconds
1286.     FOR z = 0 TO 2 '                                                  prep for radians
1287.         clocka(z) = (clocka(z) + 270) MOD tsix
1288.     NEXT z
1289.     ao = 0 '                                                          angle offset
1290. ELSE
1291.     ao = (ao + 1) MOD 361
1292. END IF
1293.  
1294. tvx = SGN(vx!): IF tvx = 0 THEN tvx = 1
1295. tao = ao * tvx
1296. sco = sco XOR 1
1297. IF doclock THEN sco = 0
1298. IF sco THEN tc = red ELSE tc = lmsl
1299. z3 = tsix + (shield = 0) * 361
1300. FOR z2 = 0 TO z3
1301.     a2 = (z2 + tao * 5 + tsix0) MOD tsix
1302.     tx = px! + 50 * c!(a2) * aspect!
1303.     ty = py! + 50 * s!(a2)
1304.     IF ty < gety(tx) THEN
1305.         IF (z2 MOD 30) = 0 THEN
1306.             CIRCLE (tx, ty), 1, tc, , , .75
1307.             IF geof THEN
1308.                 FOR i = z2 - 120 TO z2 STEP 30
1309.                     j = (i + tsix) MOD tsix
1310.                     tx2 = px! + 60 * c!(j) * aspect!
1311.                     ty2 = py! + 60 * s!(j)
1312.                     LINE (tx, ty)-(tx2, ty2), tc
1313.                 NEXT i
1314.             END IF
1315.         END IF
1316.         IF doclock THEN
1317.             FOR i = 0 TO 2
1318.                 IF a2 = clocka(i) THEN
1319.                     c = VAL(MID$("021404", i * 2 + 1, 2))
1320.                     CIRCLE (tx, ty), 4 - i, c, , , .75
1321.                     PAINT (tx, ty), c, c
1322.                 END IF
1323.             NEXT i
1324.         END IF
1325.     END IF
1326. NEXT z2
1327.  
1328. FOR i = 1 TO rp '                                                     rp = craft right pad
1329.     LMrx(i) = px! + LMx(i) * c! + LMy(i) * s! + rfx '                 x rotated
1330.     LMry(i) = py! - LMx(i) * s! + LMy(i) * c! + rfy '                 y rotated
1331.     IF LMry(i) > glmax THEN LMry(i) = glmax '                         not below ground
1332.     IF i = xp THEN sx0 = LMrx(i): sy0 = LMry(i) '                     save radar loc
1333.     IF i = lp THEN sx1 = LMrx(i): sy1 = LMry(i) '                     save left pad loc
1334.     IF i = rp THEN sx2 = LMrx(i): sy2 = LMry(i) '                     save right pad loc
1335.     IF bolthit THEN LMc(i) = white
1336.     PSET (LMrx(i), LMry(i)), LMc(i)
1337. NEXT i
1338.  
1339. IF fuel! < 95 THEN GOSUB flevel
1340.  
1341. eflag = 0 '                                                           determine flame climb
1342. fx1 = 0 ' initialize for deflect
1343. fx2 = 0
1344. phg = (sx1 + sx2) \ 2 + ta * 2 '                                      point hit ground
1345.  
1346. tty! = py! + 26
1347.  
1348. FOR i = rp + 1 TO n '                                                 flame/fuel dump
1349.     x = px! + LMx(i) * c! + LMy(i) * s! + rfx '                       x rotated
1350.     y = py! - LMx(i) * s! + LMy(i) * c! + rfy '                       y rotated
1351.     c = LMc(i) '                                                      fuel dump/flame
1352.     IF warp! < 1 THEN GOSUB deflect '                                 deflect off ground
1353.     c = ABS(c) '                                                      color
1354.     PSET (x, y), c '                                                  flame particle
1355.     IF i <= n3 THEN '                                                 main exhaust
1356.         IF (i MOD t) = 1 THEN '                                       every 10th pixel
1357.             LINE (x - 1, y)-(x + 1, y), c '                           make "+"
1358.             LINE (x, y - 1)-(x, y + 1), c
1359.         END IF
1360.     END IF
1361. NEXT i
1362.  
1363. IF rfx AND dump AND (a = 0) THEN vx! = vx! + rfs! '                   make jitter real
1364. IF rfx AND (dump = 0) AND (a <> 0) THEN vx! = vx! + rfs!
1365.  
1366. endproc:
1367.  
1368. IF doclock THEN TextOnLM$ = LEFT$(TIME$, 5)
1369. IF LEN(TextOnLM$) THEN GOSUB TextOnLM
1370.  
1371. GOSUB radar
1372.  
1373. fc = 0 '                                                              LGM flame count
1374. IF (sf(3, 1) >= suri) AND (sf(3, 0) < (suri + q3)) THEN
1375.     x1 = sf(3, 0) - suri
1376.     y1 = gety(x1) - 14
1377.     FOR x = x1 + 5 TO x1 + 15
1378.         FOR y = y1 - 9 TO y1 + 12
1379.             IF POINT(x, y) = yellow THEN fc = fc + 1
1380.         NEXT y
1381.     NEXT x
1382. END IF
1383.  
1384. GOSUB KillThreats
1385.      
1386. geof = geof - 1 - (geof = 0)
1387.  
1388. IF ok AND (TIMER > wu2!) AND (INSTR(mes$(0), "IN CAR") = 0) THEN FlagandFireworks
1389.  
1390. mpass& = mpass& + 1
1391. IF TIMER <= start1! THEN start1! = TIMER: mpass& = 1
1392. speed = ((TIMER - start1!) / mpass&) * h * t
1393.  
1394. IF rick THEN GraphSpeed
1395.  
1396. IF magic = 1 THEN '                                                   magic landing, 1st step laser the surface to level
1397.     sf = 0
1398.     z = suri + px!
1399.     IF z > q1 THEN z = z - q1
1400.     sf(0, 0) = z - 35 '                                               cut out a swath 70 units wide
1401.     sf(0, 1) = z + 35
1402.     GOSUB lsurface '                                                  apply laser
1403.     a = 0 '                                                           angle
1404.     auto = 0 '                                                        autopilot
1405.     vx! = 0 '                                                         cancel any x velocity
1406.     vy! = 0 '                                                         cancel any y velocity
1407.     py! = 331 + ASO * 9 '                                             ground has been cut to the lowest
1408.     cut = 1 '                                                         signal engine off
1409.     magic = 2
1410. END IF
1411.  
1412. '                                                                     kill surface feature
1413. IF firel AND ksf AND (contact = 0) AND (sf(sf, 2) > 0) THEN
1414.     GOSUB lsurface
1415. END IF
1416. firel = ks '                                                          ks = keep shooting
1417.  
1418. '                                                                     terrain following
1419. IF tfollow AND (contact = 0) AND (dump = 0) AND (liftoff = 0) THEN
1420.     hover = 1
1421.     hp = q1
1422.     svx = SGN(vx!)
1423.     IF svx < 0 THEN tx = sx1 ELSE tx = sx2
1424.     la = ABS(vx!) * t
1425.     IF la < t THEN la = t
1426.     IF la > h THEN la = h
1427.     FOR i = -(wi + 5) TO la
1428.         j = tx + i * svx
1429.         k = j
1430.         IF k < 0 THEN k = k + q1
1431.         IF k > q1 THEN k = k - q1
1432.         z = gety(k)
1433.         IF z < hp THEN hp = z: sx = j
1434.     NEXT i
1435.     cx = ABS(sx - tx)
1436.     IF cx THEN
1437.         cy = hp - t - ABS(a / 2) - sy1
1438.         st! = cy / cx * (ABS(vx!) + 1)
1439.         IF st! > 2 THEN st! = 2
1440.         IF st! < -t THEN st = -t
1441.         fst = -SGN(st!) * 2
1442.         py! = py! + st!
1443.         IF py! < 250 THEN py! = 250
1444.     END IF
1445. END IF
1446. IF paraf THEN
1447.     IF py! > 150 THEN mes$(0) = "Parachutes don't work in a vacuum!"
1448.     Parachute
1449. END IF
1450.  
1451. RETURN
1452.  
1453. TextOnLM:
1454. IF (ASO = 0) AND (ABS(ta) < t) THEN
1455.     lt = LEN(TextOnLM$)
1456.     tx = px! - lt * 2 + rfx
1457.     ty = py! + rfy
1458.     IF ty > 340 THEN ty = 340
1459.     TinyFont TextOnLM$, tx, ty, white
1460. END IF
1461. TextOnLM$ = ""
1462. RETURN
1463.  
1464. KillThreats:
1465. killed = 0
1466. FOR i = 0 TO 20 '                                                     shells
1467.     c1 = shield AND (shx(i) > 0) AND (shd(i) < 70) '                  shield on and shell close to LM
1468.     c2 = firel AND (shx(i) > 0) '                                     fire laser and shell in air
1469.     IF c1 OR c2 THEN
1470.         killed = 1 '                                                  found something to kill
1471.         tx = shx(i) - suri
1472.         ty = shy(i)
1473.         GOSUB LMfl '                                                  fl = fire laser
1474.         IF LEN(dead$) THEN RETURN
1475.         ExplodeShell i
1476.     END IF
1477. NEXT i
1478.  
1479. ks = 0
1480. FOR i = 1 TO 6
1481.     IF skyoff OR (ek(i) = -1) THEN GOTO ni3
1482.     '                   CM DS BO BH WO Co
1483.     IF firel AND (exl(i) > gs) AND (exl(i) < q3) THEN
1484.         killed = 1
1485.         ks = 1
1486.         tx = exl(i)
1487.         ty = ey(i)
1488.         IF laserb = 0 THEN laserb = 5
1489.         IF laserb > 0 THEN
1490.             GOSUB LMfl
1491.             IF LEN(dead$) THEN RETURN
1492.             k = (5 - laserb) * 4
1493.             IF i > 1 THEN
1494.                 CIRCLE (tx, ty), k, yellow
1495.                 PAINT (tx, ty), yellow, yellow
1496.             END IF
1497.             laserb = laserb - 1
1498.         END IF
1499.         IF laserb = 0 THEN
1500.             ks = 0
1501.             IF i = 1 THEN
1502.                 mes$(1) = "The Dark Side has cookies!"
1503.             ELSE
1504.                 FOR a2 = 0 TO tsix STEP 2
1505.                     x2 = tx + RND * h * c!(a2) * aspect!
1506.                     y2 = ty + RND * h * s!(a2)
1507.                     LINE (tx, ty)-(x2, y2), gold
1508.                 NEXT a2
1509.                 ek(i) = -1
1510.                 exv(i) = 0
1511.                 exl(i) = -1
1512.                 IF (i = 2) AND lob THEN dead$ = "SELF-DESTRUCT"
1513.             END IF
1514.         END IF
1515.     END IF
1516.     ni3:
1517. NEXT i
1518. IF killed THEN ksf = 0 ELSE ksf = 1
1519. RETURN
1520.  
1521. lsurface: '                                                           laser surface feature
1522. z = (RND > .9) OR (magic = 1) '                                       1 out of 10 destroys, magic always
1523. FOR i = sf(sf, 0) TO sf(sf, 1)
1524.     tx = i - suri
1525.     IF tx < 0 THEN tx = tx + q1
1526.     ty = gety(tx)
1527.     IF sf <> 3 THEN ty = ty + RND * (q4 - ty)
1528.     IF i MOD 2 THEN GOSUB LMfl '                                      fire laser
1529.     IF z THEN gh(i) = glmax '                                         level
1530. NEXT i
1531. IF z THEN
1532.     Smooth sf(sf, 0) - 1 '                                            smooth transition from where the ground has been leveled, left side
1533.     Smooth sf(sf, 1) '                                                                                                        , right side
1534.     sf(sf, 2) = -1
1535. END IF
1536. RETURN
1537.  
1538. LMfl: '                                                               fire laser
1539. IF (cwd < 50) AND (sy1 > szs) THEN '                                  in car wash?
1540.     dead$ = "REFLECTED LASER"
1541.     cwd = 999
1542.     firel = 0
1543.     laserb = 0
1544.     ks = 0
1545.     RETURN
1546. END IF
1547. FOR zx = -1 TO 1
1548.     FOR zy = -1 TO 1
1549.         LINE (sx0 + zx, sy0 + zy)-(tx, ty), lmsl
1550.     NEXT zy
1551. NEXT zx
1552. geof = t
1553. RETURN
1554.  
1555. flevel: '                                                             make fuel level when angle > 4
1556. IF ASO THEN RETURN '                                                  no fuel shown with AS
1557. ptk = (h - fuel!) * 2.7 '                                             pixels to kill
1558. z = ptk '                                                             ptk used by ExplodeLM
1559. x1 = px! - 16
1560. x2 = px! + 14
1561. y1 = py! - 15
1562. y2 = py! + 15
1563. FOR y = y1 TO y2
1564.     FOR x = x1 TO x2
1565.         IF POINT(x, y) = fuel THEN
1566.             PSET (x, y), black2
1567.             z = z - 1
1568.         END IF
1569.     NEXT x
1570.     IF z <= 0 THEN EXIT FOR
1571. NEXT y
1572. RETURN
1573.  
1574. deflect: '                                                            flame bounce
1575. oz = gety(-x)
1576. IF deflectat > 0 THEN oz = deflectat
1577. z = oz
1578.  
1579. '       dump           side t      st in pause
1580. IF (c = fuel) OR (c = -yellow) OR (c = -blue) THEN
1581.     IF (fx1 > 0) AND (x < fx1) THEN z = 0
1582.     IF (fx2 > 0) AND (x > fx2) THEN z = 0
1583.     rf1 = RND * t + 1
1584.     rf2 = RND * 20 - t
1585.     IF y >= (z - 1) THEN '                                            yep, deflect it
1586.         IF x < sx1 THEN
1587.             IF fx1 = 0 THEN fx1 = x: fy1 = LMry(th1)
1588.             x = fx1 + rf1
1589.             y = fy1 + rf2
1590.         ELSE
1591.             IF fx2 = 0 THEN fx2 = x: fy2 = LMry(th2)
1592.             x = fx2 - rf1
1593.             y = fy2 + rf2
1594.         END IF
1595.     END IF
1596.     RETURN
1597. END IF
1598.  
1599. IF y >= (z - 1) THEN '                                                yep, deflect it
1600.     IF sy1 < borgt THEN ky1 = 1: GOTO isborg
1601.     IF eflag = 0 THEN '                                               limit flame climbing
1602.         eflag = 1 '                                                   only once per position
1603.         xmin2 = phg - thrust! * 1.5 '                                 point hit ground
1604.         xmax2 = phg + thrust! * 1.5
1605.         u1 = 0 '                                                      up count l of nozzle
1606.         u2 = 0 '                                                      up count r of nozzle
1607.         wu1 = 0 '                                                     worst l up count
1608.         wu2 = 0 '                                                     worst r up count
1609.         ky1 = 0 '                                                     keep y
1610.         ky2 = 0 '                                                     keep y
1611.         FOR zz = phg TO phg - h STEP -1 '                             from LM center left
1612.             z2 = gety(-zz): IF zz = phg THEN lz = z2
1613.             k1 = z2 - lz
1614.             lz = z2
1615.             IF k1 > 0 THEN '                                          down
1616.                 u1 = 0
1617.             ELSE
1618.                 u1 = u1 - k1 '                                        up
1619.                 IF u1 > wu1 THEN wu1 = u1 '                           worst up
1620.             END IF
1621.             IF u1 > 20 THEN xmin2 = zz + 2: EXIT FOR
1622.             IF ABS(k1) > 20 THEN ky1 = 1 '                            90 degrees TMA etc
1623.         NEXT zz
1624.         FOR zz = phg TO phg + h '                                     from LM center right
1625.             z2 = gety(-zz): IF zz = phg THEN lz = z2
1626.             k2 = z2 - lz
1627.             lz = z2
1628.             IF k2 > 0 THEN '                                          down
1629.                 u2 = 0
1630.             ELSE
1631.                 u2 = u2 - k2 '                                        up
1632.                 IF u2 > wu2 THEN wu2 = u2 '                           worst up
1633.             END IF
1634.             IF u2 > 20 THEN xmax2 = zz - 2: EXIT FOR
1635.             IF ABS(k2) > 20 THEN ky2 = 1 '                            90 degrees TMA etc
1636.         NEXT zz
1637.     END IF
1638.  
1639.     isborg:
1640.     r = thrust! * 2 + (RND - pf!) * 80
1641.     x = (phg - r) + RND * (r * 2)
1642.     k = ABS(x - phg + a * 2) / 4
1643.  
1644.     tx = x + suri '                                                   McDonalds
1645.     IF (tx >= sf(5, 0)) AND (tx <= sf(5, 1)) AND (py! > 250) THEN
1646.         ky1 = 0: ky2 = 0
1647.     END IF
1648.  
1649.     IF (ky1 = 1) OR (ky2 = 1) THEN '                                  keep
1650.         y = z - RND * k - 1: RETURN
1651.     END IF
1652.  
1653.     x2 = (RND - pf!) * 20
1654.     IF x < xmin2 THEN x = xmin2 + RND * (xmax2 - xmin2) + x2
1655.     IF x > xmax2 THEN x = xmin2 + RND * (xmax2 - xmin2) - x2
1656.  
1657.     IF (platform > 0) AND (ABS(px! - (pminx + 17)) < 20) THEN
1658.         y = y - platform
1659.     ELSE
1660.         y = gety(-x) - RND * k - 1
1661.     END IF
1662.  
1663.     IF (deflectat > 0) AND (y > deflectat) THEN y = deflectat - (y - deflectat)
1664. END IF
1665. RETURN
1666.  
1667. CWceiling: '                                                          car wash
1668. cwd = ABS((suri + px!) - sf(2, 2)) '                                  car wash distance
1669. IF ASO THEN szs = 323 ELSE szs = 340 '                                safe zone start
1670. IF (cwd < 69) AND (sy1 > 304) THEN '                                  lower than top of building
1671.     IF sy1 >= q4 THEN '                                               touched down inside
1672.         cc1 = -1
1673.     ELSEIF sy2 >= q4 THEN '                                           touched down inside
1674.         cc2 = -1
1675.     ELSEIF sy1 > szs THEN '                                           in safe zone
1676.         cc1 = 0
1677.         cc2 = 0
1678.         IF cwd < 50 THEN mes$(0) = "Washee washee no starchee!"
1679.     ELSE
1680.         IF (sy1 > (szs - t)) AND (sy1 <= szs) THEN '                  bouncing off ceiling
1681.             cc1 = 0
1682.             cc2 = 0
1683.             vy! = 1
1684.             py! = py! + 2
1685.             'hover = 1
1686.         END IF
1687.     END IF
1688. END IF
1689. RETURN
1690.  
1691. CheckHit: '                                                           contact with ground
1692. cc1 = ((sy1 + 1) >= gety(-sx1)) '                                     left pad
1693. cc2 = ((sy2 + 1) >= gety(-sx2)) '                                     right pad
1694. mingx = 0
1695. mingy = q1
1696. FOR zx = sx1 TO sx2 '                                                 check between pads
1697.     zy = sy1 - 2
1698.     p = POINT(zx, zy)
1699.     IF p = gray THEN '                                                got 1
1700.         ty = gety(-zx)
1701.         IF ty < mingy THEN mingx = zx: mingy = ty
1702.     END IF
1703. NEXT zx
1704. IF mingx THEN
1705.     i = mingx - sx1
1706.     j = sx2 - mingx
1707.     IF i < j THEN cc1 = -1 ELSE cc2 = -1
1708. END IF
1709.  
1710. GOSUB CWceiling '                                                     car wash
1711. IF vy! < 0 THEN RETURN '                                              going UP
1712.  
1713. IF cc1 OR cc2 THEN '                                                  pad(s) on ground
1714.     contact = 1
1715.     tmt! = 0
1716.     py! = py! + rfy '                                                 no time to correct jitter
1717.     TexOnLM$ = ""
1718.     warp! = 0
1719.     GOSUB CutOrOutOfFuel
1720.  
1721.     IF (vy! > 0) AND ABS(sy1 - (ey(2) - 40)) < t THEN
1722.         lob = 1 '                                                     landed on Borg
1723.         vx! = vx! - exv(2)
1724.     END IF
1725.  
1726.     IF (ABS(vx!) > t) OR (vy! > 20) THEN
1727.         dead$ = "HIGH SPEED IMPACT!"
1728.         RETURN
1729.     END IF
1730.  
1731.     dp = 8 + (h - fuel!) \ 25 '                                       8 - 12
1732.     IF (vy! > dp) OR (ABS(vx!) > 8) THEN '                            too fast given load
1733.         crash = 1
1734.         panelinit = 0
1735.         shield = 0
1736.         dead$ = "CRASHED"
1737.         z = ABS(vx!) * t + ABS(vy!) * t
1738.         FOR i = 1 TO rp '                                             create layer of debris
1739.             LMrx(i) = LMrx(i) + RND * z - (z \ 2)
1740.             LMry(i) = gety(LMrx(i)) - RND * 2 - 1
1741.         NEXT i
1742.         IF bw = 0 THEN
1743.             PALETTE green, 0 '                                            blank instruments
1744.             PALETTE yellow, 0
1745.         END IF
1746.         RETURN
1747.     END IF
1748.  
1749.     IF (vy! > 3) OR (ABS(vx!) > 3) THEN fb$ = "vehicle damaged"
1750.  
1751.     IF (vy! > 4) OR (ABS(vx!) > 4) THEN
1752.         fb$ = "vehicle severely damaged"
1753.         LMdistort '                                                   randomly vary structure
1754.         vsd = 1 '                                                     vehicle severely damaged
1755.     END IF
1756.  
1757.     savea = a + ma
1758.  
1759.     IF lob THEN '                                                     landed on Borg
1760.         a = 0
1761.         IF sx1 < borgl THEN a = 45
1762.         IF sx2 > borgr THEN a = -45
1763.         py! = py! - t * (ABS(a) = 45)
1764.         RETURN
1765.     END IF
1766.  
1767.     '                                                                 optional, allow ANY part of pad
1768.     IF cc1 THEN cd = -1: cpx = sx2: cpy = sy2 + 1
1769.     IF cc2 THEN cd = 1: cpx = sx1: cpy = sy1 + 1
1770.     FOR i = 1 TO 4
1771.         cpx = cpx + cd
1772.         IF (cpy >= gety(-cpx)) THEN
1773.             IF cc1 THEN cc2 = 1 ELSE cc1 = 1
1774.         END IF
1775.     NEXT i
1776.  
1777.     IF NOT (cc1 AND cc2) THEN '                                       only 1 pad down
1778.         npass = 0
1779.         DO: _LIMIT mdelay * 2 '                                       settle LM
1780.             a = a + (cc1 - cc2)
1781.             pa:
1782.             npass = npass + 1
1783.             IF npass > 150 THEN EXIT DO
1784.             GOSUB Plotscreen '                                        show change
1785.             IF LEN(dead$) THEN EXIT DO
1786.             IF ABS(a) > 40 THEN
1787.                 a = 180 '                                             upside down
1788.                 py! = glmax - ny
1789.                 LMdistort '                                           optional
1790.                 EXIT DO
1791.             END IF
1792.             IF cc1 AND (sy1 < gety(-sx1)) THEN py! = py! + 1: GOTO pa
1793.             IF cc2 AND (sy2 < gety(-sx2)) THEN py! = py! + 1: GOTO pa
1794.             cc3 = ((sy1 + 1) >= gety(-sx1))
1795.             cc4 = ((sy2 + 1) >= gety(-sx2))
1796.             IF ABS(a) > 80 THEN py! = glmax - wi2
1797.  
1798.             z = gety(INT(px!)) - py! - ny + 5
1799.             IF (z < 0) AND (paraf = 0) THEN
1800.                 dead$ = "PUNCTURE DAMAGE"
1801.                 RETURN
1802.             END IF
1803.         LOOP UNTIL (cc1 AND cc4) OR (cc2 AND cc3)
1804.     END IF
1805. END IF
1806. RETURN
1807.  
1808. slimit: '                                                             surface index bounds
1809. z = 0
1810. IF suri < 0 THEN z = q1
1811. IF suri >= q1 THEN z = -q1
1812. suri = suri + z
1813. IF lock1 THEN lock1 = lock1 + z
1814. RETURN
1815.  
1816. radar: '                                                              autopilot landing here too
1817. IF contact OR liftoff THEN RETURN
1818. z = SGN(vx!): IF z = 0 THEN z = 1
1819. IF z = -1 THEN sbl = -280 ELSE sbl = 220
1820. bt = (bt MOD 4) + 1
1821. div = ABS(alt!) \ 2 + bt
1822.  
1823. IF right OR left THEN tvx! = sv! ELSE tvx! = vx!
1824. IF ABS(tvx!) > 99 THEN tvx! = 99 * SGN(tvx!)
1825. IF (tfollow = 0) AND (aboveborg OR ((radarf = 0) AND (auto = 0))) THEN tvx! = 0
1826. bl = sbl * ABS(tvx!) + (sx1 - sx2)
1827. IF ABS(bl) > ABS(sbl) THEN bl = sbl
1828. IF auto = 0 THEN lock1 = 0
1829. IF lock1 = 0 THEN rxm = sx2 + bl ELSE rxm = lock1 - suri
1830.  
1831. level = 1
1832. FOR j = 0 TO wi '                                                     width (distance between pads)
1833.     tx = rxm + j
1834.     ty = gety(-tx)
1835.     IF aboveborg AND (sx1 >= borgl) AND (sx2 <= borgr) THEN ty = borgt
1836.     IF j = 0 THEN cmp = ty
1837.     IF ABS(cmp - ty) > 1 THEN level = 0
1838. NEXT j
1839.  
1840. IF level THEN
1841.     IF auto AND (lock1 = 0) THEN '                                    automatic yet no current lock
1842.         lock1 = suri + rxm - SGN(rxm) * 2 * (vx! <> 0) '              lock onto level ground
1843.     END IF
1844.     rbeam = green '                                                   radar beam color
1845. ELSE
1846.     lock1 = 0 '                                                       not level, cancel lock
1847.     rbeam = red '                                                     radar beam color
1848. END IF
1849.  
1850. rpass = rpass XOR 1
1851. IF level AND (vx! = 0) THEN
1852.     div = div \ 2
1853.     IF div < 1 THEN div = 1
1854.     IF rpass THEN rbeam = 0
1855. END IF
1856.  
1857. FOR i = 0 TO (wi + 1) STEP 5
1858.     IF vx! > 0 THEN tx = rxm + i ELSE tx = rxm + wi - i
1859.     IF aboveborg THEN
1860.         tx = sx1 + i
1861.         ty = borgt
1862.     ELSE
1863.         ty = gety(tx)
1864.     END IF
1865.     IF (warp! < 1) AND (ty > sy0) AND (radarf > 0) THEN GOSUB rbeam
1866. NEXT i
1867.  
1868. IF auto = 0 THEN GOTO end6
1869. IF aboveborg OR (abort = 0) THEN GOTO skipit
1870.  
1871. abort:
1872. hover = 1
1873. hoverc = 0
1874. lock1 = 0
1875.  
1876. i = (py! > 120) '                                                     too low
1877. j = NOT ((vx! = 0) AND (level = 1)) AND (ABS(vx!) < (ideal! - .05)) ' too slow
1878. k = (ABS(vx!) > (ideal! + .05)) '                                     too fast
1879. IF i THEN wa = -ma: hoverc = -3
1880. IF j THEN wa = 4 * -z + ma
1881. IF k THEN
1882.     wa = ABS(vx!) * z - ma
1883.     IF ABS(wa) > 20 THEN wa = 20 * z
1884. END IF
1885. IF i OR j OR k THEN abort = 1: GOTO end6
1886. abort = 0
1887.  
1888. skipit:
1889. IF lam THEN '                                                         land at McDonalds
1890.     dis = ABS((suri + rxm) - sf(5, 2))
1891.     IF dis > 80 THEN level = 0: lock1 = 0
1892. END IF
1893. wa = -ma ' want angle = -malfunction angle
1894.  
1895. IF dflag THEN dump = 0: dflag = 0
1896. IF level = 0 THEN '                                                   locked onto a target
1897.     abort = 1
1898. ELSE
1899.     ddd = ABS(px! - rxm)
1900.     IF (ddd < 120) AND (lock1 > 0) AND (auto = 1) AND (fuel! > 70) THEN
1901.         dump = 1
1902.         dflag = 1
1903.     END IF
1904.     IF ddd < h THEN '                                                 100 clicks away
1905.         hover = 0 '                                                   stop hovering
1906.         vert = 1 '                                                    start moving down
1907.         dist = sx1 - rxm '                                            distance to target
1908.         thv! = ABS(dist) / 27 '                                       to horizontal velocity
1909.         IF thv! < .08 THEN mu = 1 ELSE mu = 4
1910.         IF thv! < .01 THEN mu = 0
1911.         IF aboveborg = 0 THEN
1912.             IF ABS(vx!) > thv! THEN wa = wa + mu * z
1913.         END IF
1914.     END IF
1915. END IF
1916. end6:
1917. GOSUB angle
1918. RETURN
1919.  
1920. rbeam:
1921. dx! = (tx - sx0) / div
1922. dy! = (ty - sy0) / div
1923. FOR j = 1 TO q1
1924.     tx = sx0 + j * dx!
1925.     ty = sy0 + j * dy!
1926.     my = gety(-tx)
1927.     IF ty >= my THEN
1928.         IF (tx < rxm) OR (tx > (rxm + wi + 1)) THEN level = 0: rbeam = red
1929.         EXIT FOR
1930.     END IF
1931.     IF i AND (rbeam > 0) THEN
1932.         PSET (tx, ty), rbeam
1933.         IF radarf = 2 THEN PSET (tx + 1, ty), rbeam
1934.     END IF
1935. NEXT j
1936. RETURN
1937.  
1938. angle:
1939. IF dump THEN RETURN
1940. cf = 0
1941. IF a <> wa THEN '                                                     current angle, wanted angle
1942.     w = a '                                                           was = angle
1943.     a = a + SGN(wa - a)
1944.     change = a - w
1945.     IF change THEN
1946.         cf = 1
1947.         a1 = ABS(w + ma)
1948.         a2 = ABS(a + ma)
1949.         IF (a1 > 4) OR (a2 > 4) THEN wan = 3 '                        activate up/down
1950.     END IF
1951. END IF
1952.      
1953. IF liftoff OR ((auto = 0) AND (vert = 1) AND (ma = 0)) THEN RETURN
1954. cp = (a <> 0) AND (RND < .01) '                                       clear problem
1955.  
1956. IF cf OR cp THEN
1957.     IF cp OR (RND < .01) THEN
1958.         z = ma
1959.         IF cp THEN ma = 0 ELSE ma = a
1960.         IF ma <> z THEN '                                             new malfunction angle
1961.             IF ma THEN
1962.                 z$ = LTRIM$(STR$(-ma))
1963.                 IF ma < 0 THEN z$ = "+" + z$
1964.                 mes$(0) = "DANGER! STUCK THRUSTER " + z$
1965.                 IF auto THEN a = a - ma: wa = a - ma '                immediate correct
1966.             ELSE
1967.                 mes$(0) = "THRUSTERS OK"
1968.                 IF auto THEN a = a + z: wa = a + z '                  immediate correct
1969.             END IF
1970.         END IF
1971.     END IF
1972. END IF
1973. RETURN
1974.  
1975. Exhaust:
1976. IF inpause THEN tflame = blue ELSE tflame = flame
1977.  
1978. IF cut THEN thrust! = 0
1979. d = thrust! - (RND * 20 - t) * (thrust! > 0)
1980. x = (LMx(lp) + LMx(rp)) \ 2 '                                         halfway between pads
1981.  
1982. IF ASO THEN '                                                         ascent stage only
1983.     i = 30 '                                                          divisor for exhaust width
1984.     j = 1 '                                                           throwing x off up to this amount
1985.     k = 3 '                                                           flame decrement
1986.     y = ny + 1 '                                                      starting y
1987. ELSE
1988.     i = 20 '                                                          divisor for exhaust width
1989.     j = 2 '                                                           throwing x off up to this amount
1990.     k = 2 '                                                           flame decrement
1991.     y = ny - 3 '                                                      starting y
1992. END IF
1993.  
1994. WHILE d > 0 '                                                         until thrust decremented to 0
1995.     p = d \ i
1996.     FOR z = -1 TO 1 STEP 2
1997.         FOR jj = 0 TO 3
1998.             n = n + 1 '                                               add to vehicle daa
1999.             IF n > 1400 THEN END '                                    beyond array size
2000.             LMx(n) = x + p * z + RND * (j * 2) - j
2001.             LMy(n) = y + RND * 2
2002.             IF (powerloss > 0) AND (RND < .3) THEN zz = orange ELSE zz = tflame
2003.             LMc(n) = zz '                                             yellow normally, blue during pause
2004.             IF RND > .95 THEN '                                        some way off plume for realism
2005.                 LMx(n) = LMx(n) - RND * 80 + 40
2006.                 LMy(n) = LMy(n) + 5
2007.             END IF
2008.         NEXT jj
2009.     NEXT z
2010.     y = y + 1 '                                                       next flame row
2011.     d = d - k '                                                       decrement temp thrust
2012. WEND
2013. n3 = n '                                                              main/side thrusters
2014.  
2015. '                                                                     if there's a thruster malfunction, may have both thrusters active
2016. IF (ma = 0) OR (a = 0) OR (SGN(a) = SGN(ma)) THEN
2017.     ta = a + ma
2018.     pass = 1
2019. ELSE
2020.     ta = a
2021.     pass = 2
2022. END IF
2023. IF dump THEN ta = t
2024.  
2025. dors: '                                                               dump fuel or sideways motion
2026. IF liftoff THEN ta = 0
2027. IF rfx AND (dump = 0) THEN ta = rfs! * 50
2028. IF (contact = 1) AND (dump = 0) THEN ta = 0: wan = 0: super = 0
2029. IF ta <> 0 THEN
2030.     IF ta < 0 THEN th0 = th1: z! = -2
2031.     IF ta > 0 THEN th0 = th2: z! = 2
2032.     zz = ta: IF zz > t THEN ta = t
2033.     tt = ABS(zz * 4 + 4 * SGN(ta))
2034.     IF ABS(zz) > 20 THEN tt = t
2035.     DO
2036.         n = n + 1
2037.         LMx(n) = LMx(th0) + z! + RND * 2 - 1
2038.         LMy(n) = LMy(th0) + (RND * 2 - 1) * (ABS(ta) > 2)
2039.         IF dump THEN
2040.             tc = fuel
2041.             z = 20 - 20 * s!(90 + (LMx(n) - LMx(th0)) * 1.8)
2042.             IF a = 180 THEN z = -z
2043.             LMy(n) = LMy(n) + z
2044.         ELSE
2045.             tc = -tflame
2046.         END IF
2047.         LMc(n) = tc
2048.         tt = tt - 1
2049.         z! = z! * 1.15
2050.     LOOP UNTIL (tt = 0) OR (ABS(z!) > 40)
2051.     IF dump THEN
2052.         ta = -ta
2053.         IF lockfuel = 0 THEN fuel! = fuel! - .1 + (fuel! > 5) * 2
2054.         IF ta = -t THEN GOTO dors
2055.         IF fuel! < 1 THEN dump = 0
2056.     END IF
2057. END IF
2058. pass = pass - 1
2059. IF pass THEN ta = ma: GOTO dors
2060. noside:
2061.  
2062. '                                                                     super - use side thrusters to augment main thrust when more than
2063. '                                                                     100% thrust is called for
2064. IF dump THEN RETURN
2065. IF fst OR super OR (wan > 0) THEN '                                   up/down to change angle beyond 5 degrees
2066.     IF change > 0 THEN th1d = -1: th2d = 1
2067.     IF change < 0 THEN th2d = -1: th1d = 1
2068.     IF super THEN th1d = 1: th2d = 1
2069.     IF fst THEN th1d = fst: th2d = fst: fst = 0
2070.     FOR z = 0 TO 6
2071.         n = n + 1
2072.         LMx(n) = LMx(th1) + RND * 2
2073.         LMy(n) = LMy(th1) + th1d * (z + RND * 2) + 2
2074.         LMc(n) = tflame '                                             blue flame in pause
2075.         n = n + 1 '                                                   other thruster opposite
2076.         LMx(n) = LMx(th2) + RND * 2 - 2
2077.         LMy(n) = LMy(th2) + th2d * (z + RND * 2) + 2
2078.         LMc(n) = tflame
2079.     NEXT z
2080.     wan = wan - 1
2081.     IF wan = 1 THEN change = -change
2082. END IF
2083.  
2084. RETURN
2085.  
2086. init1: '                                                              only done once
2087. DATA convo,f1,f2,lmx1,lmy1,lmc1,lmx2,lmy2,lmc2
2088. DATA h1,h2,h3,h4,h5,h6,cybill,surv2,cm,rad,af2,sf2,panel
2089. DATA sd,sl,s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,panel0,panel1
2090. DATA dstarm,stars,lanblank,alien
2091.  
2092. RESTORE init1
2093. IF _FILEEXISTS("rick.") THEN okrick = 1
2094. tc$ = UCASE$(COMMAND$ + "   ")
2095. IF LEFT$(tc$, 1) = "/" THEN tc$ = "   "
2096. IF INSTR(tc$, "DOS") THEN dosbox = 0 '                                use large star file
2097. IF INSTR(tc$, "BOX") THEN dosbox = 1 '                                use small star file
2098. IF INSTR(tc$, "CD ") THEN iscd = 1 '                                  simulate CD
2099. IF INSTR(tc$, "UFO ") THEN ufof = 1 '
2100. IF _FILEEXISTS("cd.dat") THEN iscd = 1 '                              include/create this file for CD/DVD distribution (read only)
2101.  
2102. z = 0
2103. FOR i = 1 TO 40
2104.     READ f$(i)
2105.     IF i = 38 THEN '                                                  stars
2106.         j = 2 - dosbox '                                              1=small, 2=medium, 3=huge
2107.         f$(i) = f$(i) + CHR$(48 + j)
2108.     END IF
2109.     IF i THEN
2110.         f$(i) = f$(i) + ".dat" '                                      try lowercase first
2111.         IF _FILEEXISTS(f$(i)) = 0 THEN
2112.             f$(i) = UCASE$(f$(i)) '                                   try uppercase (Linux cares!)
2113.             IF _FILEEXISTS(f$(i)) = 0 THEN
2114.                 z = z + 1
2115.                 IF z = 1 THEN CLS
2116.                 PRINT f$(i)
2117.             END IF
2118.         END IF
2119.     END IF
2120. NEXT i
2121. IF z THEN
2122.     PRINT
2123.     PRINT "Above file(s) missing"
2124.     SLEEP
2125.     SYSTEM
2126. END IF
2127.  
2128. s& = VARSEG(p(0, 0))
2129. o& = VARPTR(p(0, 0))
2130. DEF SEG = s&
2131. BLOAD "F1.dat", o&
2132. z$ = "386C6C38" '                                                    degree symbol
2133. FOR i = 0 TO 3
2134.     p(0, i) = VAL("&H" + MID$(z$, i * 2 + 1, 2))
2135. NEXT i
2136.  
2137. s& = VARSEG(p2(0, 0))
2138. o& = VARPTR(p2(0, 0))
2139. DEF SEG = s&
2140. BLOAD "F2.dat", o&
2141.  
2142. canvas& = _NEWIMAGE(640, 350, 9)
2143. SCREEN canvas&
2144. _ALLOWFULLSCREEN _STRETCH , OFF
2145. _SCREENMOVE _MIDDLE
2146. _MOUSEHIDE
2147. _MOUSEMOVE 1, 1
2148. _TITLE "Lander"
2149. RANDOMIZE TIMER
2150. auto = 0 '                                                            full automatic
2151. background = 1 '                                                      textured LED displays
2152. cbh = 0 '                                                             constant black holes
2153. darkstars = 1 '                                                       spin
2154. darkstart = 1 '                                                       thickness of lines
2155. demo = 0 '                                                            cram onto one page
2156. doclock = 0 '                                                         shield effect
2157. gh = 9
2158. gs = 85 '                                                             graphics start
2159. glmax = q4 '                                                          ground level max
2160. glmin = glmax - 49 '                                                  ground level min
2161. gs = 85 '                                                             graphics start (flying area)
2162. 'gstyle = 5
2163. invincible = 1 '                                                      easier for beginner, thrusters gold
2164. jitter = 1 '                                                          thrust calc
2165. LED$ = "021404120115" '                                               color sequence - gr ye re or gun wh
2166. LEDc = green '
2167. LEDtri = 0 '                                                          off
2168. mdelay = t '                                                          master delay
2169. opower = 62 '                                                         original thrust factor
2170. pdiv = 0 '                                                            instrument update
2171. radarf = 1
2172. restart = 0 '                                                         shift-d load defaults
2173. segs$ = "abcdefg" '                                                   for 7 segment displays
2174. settings$ = "LANDER.SET"
2175. shield = 0 '                                                          Star Trek!
2176. showmap = 0 '                                                         silly legend at top
2177. skyoff = 1 '                                                          DS, BH, Wo, Co
2178. starfiles = 1 '                                                       dat1, dat2, dat3
2179. starstatus = 1 '                                                      show stars only, no names/info
2180. twinkle = 0
2181. zoom = 1 '                                                            starfield 6 hours 45 degrees
2182.  
2183. black = 0: blue = 1: green = 2: gunmetal = 3: red = 4: gasoline = 5
2184. gray2 = 6: white = 7: gray = 8: dred = 9: gold = 10: black2 = 11
2185. orange = 12: blue2 = 13: yellow = 14: white2 = 15
2186.  
2187. craft = white: flame = yellow: fuel = gasoline: LEDc = green
2188. LMci(0) = gray2 '                                                     ASO shifting colors
2189. LMci(1) = gold
2190. LMci(2) = gray2
2191. LMci(3) = black2
2192.  
2193. IF _FILEEXISTS(settings$) THEN
2194.     OPEN settings$ FOR INPUT AS #1
2195.     nflags = 0
2196.     DO
2197.         IF EOF(1) THEN EXIT DO
2198.         INPUT #1, g$
2199.         IF EOF(1) THEN EXIT DO
2200.         nflags = nflags + 1
2201.         INPUT #1, tflags(nflags)
2202.     LOOP
2203.     CLOSE #1
2204. END IF
2205.  
2206. auto = tflags(1)
2207. background = tflags(2)
2208. cbh = tflags(3)
2209. demo = tflags(4)
2210. doclock = tflags(5)
2211. invincible = tflags(6)
2212. jitter = tflags(7)
2213. LEDc = tflags(8)
2214. LEDtri = tflags(9)
2215. radarf = tflags(10)
2216. shield = tflags(11)
2217. showmap = tflags(12)
2218. starstatus = tflags(13)
2219. zoom = tflags(14)
2220. skyoff = tflags(15)
2221. gstyle = tflags(16)
2222. mouseswap = tflags(17)
2223. porb = tflags(18)
2224. starfiles = tflags(19)
2225. mdelay = tflags(20)
2226. fsf = tflags(21)
2227.  
2228. IF fsf THEN
2229.     _FULLSCREEN
2230. ELSE
2231.     IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFF
2232. END IF
2233.  
2234. FOR i = 0 TO tsix '                                                    table faster
2235.     s!(i) = SIN(_D2R(i))
2236.     c!(i) = COS(_D2R(i))
2237. NEXT i
2238.  
2239. clines = 0
2240. OPEN f$(1) FOR INPUT AS #1 '                                          convo.dat, LM/CM chatter
2241. WHILE NOT (EOF(1))
2242.     clines = clines + 1
2243.     LINE INPUT #1, convo$(clines)
2244. WEND
2245. CLOSE #1
2246.  
2247. s& = VARSEG(cmp&(0)) '                                                Command Module
2248. o& = VARPTR(cmp&(0))
2249. DEF SEG = s& '                                                        cm.dat
2250. BLOAD f$(18), o&
2251.  
2252. IF (RND > .95) AND (okrick = 0) AND (INSTR(COMMAND$, "NOS") = 0) THEN MakeSur
2253.  
2254. start1! = TIMER
2255. RETURN
2256.  
2257. init2: '                                                              each cycle
2258. a = 0 '                                                               angle
2259. a51i = 0
2260. ASO = 0 '                                                             ascent stage only = false
2261. boltc = 0 '                                                           lightning count
2262. center = 362
2263. contact = 0 '                                                         with ground
2264. convo = 0 '                                                           with CM
2265. crash = 0
2266. cut = 0 '                                                             engine
2267. dump = 0 '                                                            fuel
2268. eou = 0 '                                                             end of universe
2269. fb$ = "" '                                                            landing feedback
2270. flx = 0 '                                                             where to plot flag
2271. fuel! = h
2272. hover = 1 '                                                           start safe
2273. ideal! = 2.7 '                                                        autopilot speed
2274. inpause = 0
2275. jf = -1 '                                                             jump to feature
2276. LGMc = 1 '                                                            little green man color
2277. lmsl = blue '                                                         LM shield & laser
2278. lob = 0 '                                                             landed on Borg
2279. lock1 = 0 '                                                           radar tracking
2280. lockfuel = 0
2281. ma = 0 '                                                              malfunction angle
2282. magic = 0 '                                                           landing
2283. mes$(0) = "" '                                                        messages ^ landing eval
2284. mes$(1) = "" '                                                        radiation, landing comments
2285. ok = 0 '                                                              landing status
2286. panelinit = 0 '                                                       instruments
2287. paraf = 0 '                                                           parachute flag
2288. pif = -1 '                                                            counter for instruments
2289. platform = 0 '                                                        for detached DS
2290. power = opower '                                                      thrust factor
2291. powerloss = 0 '                                                       random malfunction
2292. px! = 320 '                                                           vehicle x
2293. py! = 70 '                                                            vehicle y
2294. radiationdeath = 0 '                                                  rads > 1000
2295. rads = 0 '                                                            radiation count
2296. rlink = 0 '                                                           LM/CM radio link
2297. rmin = RND * 23 '                                                     stars right ascension 0 - 23
2298. dmin = (INT(RND * 18) - 9) * t '                                      stars declination -90 to 90
2299. sia = 0 '                                                             shells in air
2300. sspinit1 = 0
2301. sspinit2 = 0
2302. starinit = 0
2303. tfollow = 0 '                                                         terrain following
2304. tmt! = 0 '                                                            to move total
2305. wa = 0 '                                                              wanted angle
2306. vert = 1 '                                                            vertical autopilot on
2307. vsd = 0 '                                                             vehicle severely damaged
2308.  
2309. Setcolor
2310. GetSurface gh
2311.  
2312. IF demo THEN
2313.     auto = 0
2314.     px! = sf(6, 2) - 3130 '                                           TMA
2315.     py! = 130
2316.     sf = 6 '                                                          surface feature
2317.     suri = 3130 '                                                     surface index
2318.     vx! = 0 '                                                         not moving
2319.     vy! = 0
2320. ELSE
2321.     a = RND + t
2322.     IF RND > pf! THEN a = -a
2323.     sf = 4
2324.     suri = RND * q1
2325.     px! = 320
2326.     thrust! = 95
2327.     vx! = SGN(a) * 5
2328.     vy! = RND + 1
2329. END IF
2330.  
2331. ERASE exv, ei, ek, rtl!, rtlc, shx, shd
2332.  
2333. mes$(0) = "F1 FOR HELP AND INFORMATION"
2334. IF ufof > 0 THEN mes$(1) = "Alien on the loose!" '                    10% active
2335. IF LEDtri THEN LEDc = green
2336. GOSUB ReadLM
2337. start2! = TIMER '                                                     elapsed time clock
2338. sec = 0
2339. min = 0
2340. RETURN
2341.  
2342. PlotGround:
2343. IF crash = 0 THEN
2344.     surd = SGN(tmt!) '                                                direction
2345.     tomo = INT(ABS(tmt!)) '                                           to move
2346.     IF tomo > (q3 - gs) THEN tomo = q3 - gs
2347.     tmt! = tmt! - tomo * surd '                                       to move total
2348.     suri = suri + tomo * surd '                                       surface index
2349.     GOSUB slimit '                                                    limit values to 0-6399
2350. END IF
2351.          
2352. IF gh = -1 THEN '                                                     ground height = flat
2353.     LINE (gs, q4)-(q3, q4), gray
2354.     GOTO stuff
2355. END IF
2356.  
2357. FOR x = gs TO q3 '                                                    graphics start to 639
2358.     z = (suri + x) MOD q1
2359.     tc = gray
2360.     IF (z >= sf(5, 0)) AND (z <= sf(5, 1)) THEN
2361.         PSET (x, glmax), tc '                                         optional McD fix
2362.     ELSE
2363.         IF (z >= sf(7, 0)) AND (z <= sf(7, 1)) THEN '                 Surveyor
2364.             y = glmax
2365.         ELSE
2366.             y = gety(x)
2367.         END IF
2368.         SELECT CASE gstyle
2369.             CASE IS = 0 '                                             solid
2370.                 LINE (x, y)-(x, glmax), tc
2371.             CASE IS = 5 '                                             solid
2372.                 LINE (x, y)-(x, glmax), tc
2373.             CASE IS = 1 '                                             fancy
2374.                 LINE (x, glmax)-(x, y), black2
2375.                 LINE -(x, glmax), tc, , z + y
2376.                 PSET (x, y), tc
2377.             CASE IS = 2
2378.                 LINE (x, y)-(x, glmax), tc
2379.                 ty = y + 5
2380.                 IF ty < glmax THEN
2381.                     LINE (x, ty)-(x, glmax - 1), black, , &HFEFE
2382.                 END IF
2383.             CASE ELSE '                                               minimal or tiling
2384.                 LINE (x, glmax)-(x, y), black2
2385.                 LINE -(x, y + 3), tc
2386.         END SELECT
2387.     END IF
2388. NEXT x
2389.  
2390. IF gstyle > 3 THEN Tile
2391.  
2392. stuff:
2393. FOR i = 1 TO t
2394.     ' Surv before IBM+TMA, IBM before TMA, LGM last
2395.     '              1 2 3 4 5 6 7 8 9 0
2396.     j = VAL(MID$("01070802040506091003", (i - 1) * 2 + 1, 2))
2397.     z = VAL(MID$("80000080000080000000", (j - 1) * 2 + 1, 2))
2398.     fb = sf(j, 0) - z
2399.     fe = sf(j, 1) + z
2400.     c1 = (fe >= (suri + gs)) AND (fb <= (suri + q3))
2401.     c2 = ((fe + q1) >= (suri + gs)) AND ((fb + q1) <= (suri + q3))
2402.     IF c1 OR c2 THEN
2403.         sf = 0
2404.         IF sf(j, 2) = -1 THEN GOTO nf
2405.         sf = j
2406.         x = sf(sf, 0) - suri
2407.         z = sf(sf, 1) - suri
2408.  
2409.         IF (j = 1) AND (x < 0) AND (suri > 3000) THEN x = x + q1: z = z + q1
2410.         bolthitf = (skyoff = 0) AND (boltx >= x) AND (boltx <= z) AND (exl(1) <> 9999)
2411.         IF j = 1 THEN
2412.             Area51 f$(40)
2413.             IF (cut = 0) AND (LEFT$(mes$(1), 7) = "AREA 51") THEN
2414.                 GOSUB CutOrOutOfFuel
2415.             END IF
2416.         END IF
2417.         IF j = 2 THEN CarWash
2418.         IF j = 3 THEN LGM fc
2419.         IF j = 4 THEN Volcano
2420.         IF j = 5 THEN McD
2421.         IF j = 6 THEN TMA
2422.         IF j = 7 THEN Surveyor
2423.         IF j = 8 THEN IBM
2424.         IF j = 9 THEN Hollywood
2425.         IF j = t THEN Grave x, fb$
2426.     END IF
2427.     nf:
2428. NEXT i
2429. RETURN
2430.  
2431. CommandModule: '                                                      27 * 9
2432. IF ek(0) = -1 THEN RETURN
2433. cminview = 1
2434. tx = localize(ex(0), 14, 14)
2435. IF tx = 999 THEN cminview = 0: GOTO nocm
2436. x1 = tx - 14
2437. x2 = tx + 14
2438.  
2439. VIEW SCREEN(gs + 1, 0)-(q3, q4) '                                     protect panel
2440. LINE (x1 + 0, 18)-(x1 + 26, 26), black2, BF
2441. FOR z = 1 TO 27
2442.     LINE (x1 + z, 17)-(x1 + z, 26), white, , cmp&(z)
2443. NEXT z
2444.  
2445. CMshadow tx, x1, x2 '                                                 optional
2446.  
2447. sd! = ABS(exv(0)) - ABS(vx!) '                                        speed diff
2448. dbc = ABS(px! - tx)
2449.  
2450. IF (py! < h) AND (dbc < 50) AND (ABS(sd!) < .06) THEN
2451.     rlink = t
2452.     LINE (LMrx(1), LMry(1))-(tx + 8, 27), green, , RND * &H7FFF
2453.     IF (cmleaving + convo) = 0 THEN
2454.         mes$(0) = "Establishing link with Campbell soup cans and string"
2455.         sct! = 2
2456.         convo = 1
2457.     END IF
2458.     IF sc! = 0 THEN sc! = TIMER + sct! '                              start conversation in xs
2459.     IF TIMER > sc! THEN
2460.         convo = convo + 1
2461.         IF convo > (clines + 1) THEN
2462.             sc! = 0
2463.             convo = 0
2464.             cmleaving = 1
2465.         ELSE
2466.             mes$(0) = convo$(convo)
2467.             sc! = TIMER + sct!
2468.         END IF
2469.     END IF
2470. END IF
2471.      
2472. nocm:
2473. rlink = rlink - 1 - (rlink = 0) '                                     allows brief radio interruption
2474. IF rlink = 0 THEN '                                                   lost awhile ago
2475.     IF convo THEN mes$(0) = " " '                                     clear current dialogue
2476.     convo = 0 '                                                       stop conversation
2477.     sc! = 0 '                                                         talk timer
2478. END IF
2479.  
2480. IF cmleaving AND cminview THEN '                                      CM exhaust
2481.     ty = 22
2482.     LINE (x1, ty - 2)-(x1, ty + 2), yellow
2483.     LINE -(x1 - 15, ty), yellow
2484.     LINE -(x1, ty - 2), yellow
2485. END IF
2486. RETURN
2487.  
2488. liftoff: '                                                            forced seperation or surface launch
2489. IF (contact OR liftoff) AND (cwd < 69) AND (py! > 322) THEN
2490.     dead$ = "HIT CAR WASH"
2491.     RETURN
2492. END IF
2493.  
2494. IF contact THEN vx! = 0
2495. IF lob THEN vx! = exv(2): a = 0 '                                     landed on Borg
2496.  
2497. goy = -h '                                                            AS go y
2498. IF ASO THEN '                                                         ascent stage only
2499.     IF fuel! = 0 THEN RETURN
2500.     thrust! = h
2501.     falling = 0
2502.     platform = 0
2503.     IF lob THEN pminy = borgt
2504. ELSE
2505.     power = opower
2506.     thrust! = th '                                                    simulate explosive seperation
2507.     platform = 22 '                                                   deflect flame from DS
2508.     IF contact THEN
2509.         falling = 0 '                                                 DS already on surface
2510.     ELSE
2511.         falling = 1 '                                                 DS in air
2512.         goy = py! - 20 '                                              go y - not to screen top
2513.     END IF
2514.     LINE (gs, 30)-(q3, q4), 0, BF '                                   erase "space" area
2515.     pminx = q1: pmaxx = -pminx
2516.     pminy = q1: pmaxy = -pmaxy
2517.     FOR i = 279 TO rp '                                               draw descent stage
2518.         c = LMc(i)
2519.         IF c < 0 THEN c = fuel
2520.         PSET (LMrx(i), LMry(i)), c
2521.         IF LMrx(i) < pminx THEN pminx = LMrx(i)
2522.         IF LMrx(i) > pmaxx THEN pmaxx = LMrx(i)
2523.         IF LMry(i) < pminy THEN pminy = LMry(i)
2524.         IF LMry(i) > pmaxy THEN pmaxy = LMry(i)
2525.     NEXT i
2526.     GOSUB flevel
2527.     IF platform > 0 THEN deflectat = pminy
2528.     zz = pmaxy - pminy
2529.     GET (pminx, pminy)-(pmaxx, pmaxy), gbuff() '                      save descent stage
2530.     LINE (gs, 30)-(q3, q4), 0, BF '                                   erase "space" area
2531.  
2532.     ta = (a + tsix) MOD tsix
2533.     px! = px! - t * s!(ta)
2534.     py! = py! - 15 * c!(ta) '                                         explosive seperation
2535. END IF
2536.  
2537. wASO = ASO
2538. ASO = 1
2539. GOSUB ReadLM
2540. IF wASO = 0 THEN fuel! = h
2541. IF vsd THEN LMdistort
2542.  
2543. IF contact THEN
2544.     dropvx! = 0
2545.     IF lob AND (ABS(px! - center) > 2) THEN dropvx! = exv(1)
2546.     dropvy! = 0
2547. ELSE
2548.     dropvx! = vx!
2549.     dropvy! = vy!
2550. END IF
2551.  
2552. IF lob OR (contact = 0) THEN
2553.     wa = 0
2554. ELSE
2555.     wa = SGN(-exv(0)) * 20 '                                          want angle
2556.     IF wa = 0 THEN wa = -20
2557. END IF
2558.  
2559. sauto = auto: auto = 1
2560. contact = 0
2561. cut = 0
2562. dump = 0
2563. hover = 0
2564. liftoff = 1
2565. lminx = pminx
2566. lock1 = 0
2567. lockfuel = 0
2568. lpass = 0
2569. IF wASO = 0 THEN ma = 0
2570. mes$(0) = ""
2571. mes$(1) = ""
2572. np = 0
2573. paraf = 0
2574. pcontact = 0
2575. powerloss = 0
2576. psuri = suri
2577. py! = py! - 2 '                                                       fool CheckHit
2578. svert = vert
2579. vert = 0
2580.  
2581. DO: _LIMIT mdelay * 1.5
2582.     IF py! < 280 THEN GOSUB angle '                                   make a=wa (angle=wanted)
2583.     GOSUB Plotscreen
2584.     np = np + 1
2585.     IF np >= t THEN GOSUB CheckHit
2586.     z = (sy1 + sy2) / 2 - 2
2587.     IF (deflectat > 0) AND (z > deflectat) AND (z > deflectat) THEN contact = 1
2588.     IF contact THEN dead$ = "NOT YOUR DAY": EXIT DO
2589.     lpass = lpass + 1
2590.     IF thrust! = th THEN thrust! = h
2591.     IF vsd THEN '                                                     very severe damage
2592.         thrust! = h - (lpass + RND) '                                 slowly drop power
2593.         IF thrust! < 50 THEN thrust! = 50 + RND
2594.         IF RND > .95 THEN
2595.             dead$ = "STRUCTURAL FAILURE"
2596.             EXIT DO
2597.         END IF
2598.     END IF
2599.     GOSUB KeyAndMouse
2600.     IF LEN(dead$) THEN GOTO endl
2601.     IF lob OR ((platform > 0) AND (falling = 1)) THEN
2602.         pminx = pminx + dropvx!
2603.         pmaxx = pmaxx + dropvx!
2604.         pminy = pminy + dropvy!
2605.         pmaxy = pmaxy + dropvy!
2606.         IF lob = 0 THEN
2607.             dropvy! = dropvy! + .6
2608.             dropy! = gety(-(pminx + nx))
2609.             IF pmaxy < dropy! THEN
2610.                 lminx = pminx
2611.                 lminy = dropy! - zz
2612.                 deflectat = pminy
2613.             ELSE
2614.                 pminx = lminx
2615.                 pminy = lminy
2616.                 psuri = suri
2617.                 pcontact = 1
2618.                 falling = 0
2619.             END IF
2620.         END IF
2621.     ELSE
2622.         pminx = lminx + (psuri - suri)
2623.     END IF
2624.     IF cut THEN lpass = 0
2625.     IF wASO THEN
2626.         IF (py! <= goy) AND (cut = 0) THEN EXIT DO
2627.     ELSE
2628.         IF pcontact OR (pminx < gs) OR (pminx > 580) THEN EXIT DO
2629.         IF (cut = 0) AND (py! <= goy) THEN
2630.             hover = 1
2631.             GOSUB Autopilot
2632.             IF falling = 0 THEN EXIT DO
2633.         END IF
2634.     END IF
2635. LOOP UNTIL (alt! > h) OR LEN(dead$)
2636.  
2637. endl:
2638. auto = sauto
2639. crash = 0
2640. deflectat = 0
2641. liftoff = 0
2642. lock1 = 0
2643. platform = 0
2644. vert = svert
2645. RETURN
2646.  
2647. ReadLM:
2648. LMbloads
2649. IF ASO THEN '                                                         ascent stage only
2650.     lp = 294
2651.     nx = 16
2652.     ny = 9
2653.     rp = 302
2654.     th1 = 170
2655.     th2 = 198
2656.     vmass = 60
2657. ELSE '                                                                AS&DS 34*36
2658.     lp = 696 '                                                        left pad
2659.     nx = 17 '                                                         center x (for rotating)
2660.     ny = 18 '                                                         center y
2661.     rp = 705 '                                                        right pad
2662.     th1 = 449 '                                                       left thruster
2663.     th2 = 483 '                                                       right thruster
2664.     vmass = h '                                                       full mass
2665. END IF
2666.  
2667. nred = 0 '                                                            number red (volcanic heating)
2668. temp = 0 '                                                            temperature
2669. IF bw = 0 THEN PALETTE gasoline, 24
2670. xp = 97 ' radar
2671. wi = LMx(rp) - LMx(lp) + 1 '                                          width
2672. wi2 = wi \ 2
2673.  
2674. IF invincible THEN c = gold ELSE c = gray '                           thruster color
2675. FOR i = 1 TO rp
2676.     LMx(i) = LMx(i) - nx
2677.     LMy(i) = LMy(i) - ny
2678.     IF (LMc(i) = gray) OR (LMc(i) = gold) THEN LMc(i) = c '           thrusters
2679.     IF LMc(i) < 0 THEN LMc(i) = fuel '                                fuel
2680.     LMoc(i) = LMc(i)
2681. NEXT i
2682. GOSUB LMcolors
2683. RETURN
2684. ' --------------------------------------------------------------------------
2685. d1:
2686. DATA 27,"Elapsed time"
2687. DATA 36,"Distance to McD"
2688. DATA 45,"CPU"
2689. DATA 54,"Rads/temperature"
2690. DATA 86,"Fuel"
2691. DATA 126,"Altitude"
2692. DATA 166,"Horizontal velocity"
2693. DATA 206,"Vertical velocity"
2694. DATA 244,"Main thrust"
2695. DATA 277,"Sideways thrust"
2696. DATA 307,"Autopilot (full)"
2697. DATA 322,"Hover control"
2698. DATA 337,"Vertical automatic"
2699.  
2700. DATA "Scored on vertical & horizontal speed:"
2701. DATA "0.00 - 0.50 Excellent"
2702. DATA "0.51 - 1.00 Good"
2703. DATA "1.01 - 2.00 Fair"
2704. DATA "2.01 - 3.00 Poor"
2705. DATA ""
2706. DATA "Landing surface should be near flat,"
2707. DATA with required ending angle under 5ø.
2708. DATA ""
2709. DATA Based on a 1974 program running on a
2710. DATA DEC PDP/11 with GT40 vector display
2711. DATA terminal at the University of Alberta.
2712. DATA The graphic at top left is usually a Henon
2713. DATA "plot, dealing with the stability of orbits."
2714. DATA The face appearing in TMA-1 when it shoots
2715. DATA "is Cybill Shepherd. If you land on TMA-1,"
2716. DATA it displays a Mandelbrot. The semaphores
2717. DATA "use proper flag positions, and the Morse"
2718. DATA code in the McDonalds sign is real too.
2719. DATA "Little Green Man can be turned into a pile"
2720. DATA of ashes.  Beware the beach balls of IBM!
2721. DATA ""
2722. DATA F2 for a demo mode showing most features.
2723. DATA ""
2724. DATA "Esc or <: Back to Lander   > Next page"
2725.  
2726. d2:
2727. DATA "ud        main thrust"
2728. DATA "<>        side thrust/angle"
2729. DATA "Shift ud  move up"
2730. DATA "Shift <>  move left/right"
2731. DATA "<>        ground back/forward"
2732. DATA "space     abort/feature cycle"
2733. DATA "Bkspace   random star position"
2734. DATA "Esc       quit"
2735. DATA "01234     stars off/on/info"
2736. DATA "aA        autopilot on/off/McD"
2737. DATA "b         goto Borg"
2738. DATA "B         goto black hole"
2739. DATA "c         cut engine"
2740. DATA "C         clock(s) on/off"
2741. DATA "d         dump fuel"
2742. DATA "D         restart with defaults"
2743. DATA "fF        fuel lock/unlimited"
2744. DATA "G         new ground"
2745. DATA "h         hover"
2746. DATA "I         invincible mode"
2747. DATA "k         kill (fire laser)"
2748. DATA "wlemtsiHg goto surface feature"
2749. DATA "L         level ground"
2750. DATA "M         Magic landing!"
2751. DATA "n         nation (flag)"
2752. DATA "o         goto comet"
2753. DATA "O         goto EPCOR"
2754. DATA "p         pause"
2755. DATA "P         parachute"
2756. DATA "r         radar"
2757. DATA "R         rendesvous with CM"
2758. DATA "T         thrust accuracy"
2759. DATA "u         instruments"
2760. DATA "v         vertical automatic"
2761. DATA "y         swap mouse buttons"
2762. DATA "z         self-destruct"
2763. DATA ".         terrain following"
2764. DATA "F2        demo mode (compressed)"
2765. DATA "F3        sky features"
2766. DATA "F4        constant black holes"
2767. DATA "F5        panel/instruments"
2768. DATA "F6        drop descent stage"
2769. DATA "F7        map at top"
2770. DATA "F8        shields (uses fuel)"
2771. DATA "F9/F10    LED color/tri-color"
2772. DATA "PgDn/Up   slower/faster"
2773. DATA "< Previous page   > Next page"
2774.  
2775. d3:
2776. DATA "/  green/amber/b&w/regular screen"
2777. DATA "+  zoom in starfield"
2778. DATA "-  zoom out starfield"
2779. DATA "\  drop bomb"
2780. DATA ".  terrain following"
2781. DATA "_  star twinkle"
2782. DATA "j  DeathStar rotation"
2783. DATA "|  generate all star files (hours!)"
2784. DATA "x  more/less stars"
2785. DATA "X  regenerate current star file"
2786. DATA "Q  oscar (LGM flag colors)"
2787. DATA "=  show LM data"
2788. DATA "[  crude black & white"
2789. DATA "]  UFO toggle"
2790. DATA "U  ground tiling style"
2791. DATA "ctrl-c or -s: SCREEN capture"
2792. DATA "alt-Enter: fullscreen toggle"
2793. DATA ""
2794. DATA "< Previous page   > Next page"
2795.  
2796. d4:
2797. DATA "      Programmed by:   R. Frost"
2798. DATA "                       Edmonton, Alberta, Canada"
2799. DATA ""
2800. DATA "                       rfrost@mail.com "
2801. DATA ""
2802. DATA ""
2803. DATA " 1) 2001 A Space Odyssey: TMA-1, HAL, CM/LM chatter"
2804. DATA " 2) Star Trek: warp messages, phasers, shield, Borg"
2805. DATA " 3) Lost in Space: black hole warning"
2806. DATA " 4) Southpark: black hole at 3:50 (Tree-fiddy! - Chef)"
2807. DATA " 5) Simpsons: LGM saying he has semaphore flags"
2808. DATA " 6) Rocky & Bullwinkle: a hall of Montezuma (car wash)"
2809. DATA " 7) Bonanza: car wash traverse generates a Hop Sing quote"
2810. DATA " 8) SCTV: CM/LM chatter"
2811. DATA " 9) a McDonalds on the Moon, and an instrument for it"
2812. DATA "10) Little Green Man wiggles ears & reacts to LM exhaust"
2813. DATA "11) pirate books & movies: CM/LM chatter"
2814. DATA "12) Command Module leaves you stranded"
2815. DATA "13) a Steve Martin quote precedes black hole death"
2816. DATA "14) half the time the USSR flag is planted"
2817. DATA "15) Cybil Shepherd's face appears in TMA-1 when it fires"
2818. DATA "16) Halley's Comet is renamed Halle Berry"
2819. DATA "17) digital, analog, and binary clocks!"
2820. DATA "18) End Of The Universe is signaled by Chicken Little"
2821. DATA "19) Mt. Etna spews volcanic cheese"
2822. DATA "20) a parachute that doesn't work in a vacuum"
2823. DATA "21) Area 51 is the first level landing zone"
2824. DATA "22) IBM weapon is a fishing float or beach ball"
2825. DATA ""
2826. DATA "< Previous page   Esc or >: Back to Lander"
2827.  
2828. leds:
2829. DATA a,0,-2,1,-2
2830. DATA b,1,-2,1,-1
2831. DATA c,1,-1,1,0
2832. DATA d,0,0,1,0
2833. DATA e,0,-1,0,0
2834. DATA f,0,-2,0,-1
2835. DATA g,0,-1,1,-1
2836.        
2837. DATA 0,abcdef,1,bc,2,abged,3,abgcd,4,fgbc,5,acdfg,6,acdefg,7,abc,8,abcdefg,9,abcdfg,10,g,11,def
2838.  
2839. features:
2840. '               x   y  lz
2841. DATA "Area 51",65,40,45
2842. DATA "Car Wash",100,44,130
2843. DATA "Little Green Man",12,0,70
2844. DATA "Etna",10,49,20
2845. DATA "McDonalds",38,0,80
2846. DATA "TMA-1",45,71,80
2847. DATA "Surveyor",28,0,80
2848. DATA "IBM",50,45,90
2849. DATA "Hollywood",170,0,0
2850. DATA "a grave",68,49,98
2851.  
2852. MorseData:
2853. DATA a,.-,b,-...,c,-.-.,d,-..,e,.,f,..-.,g,--.
2854. DATA h,....,i,..,j,.---,k,-.-,l,.-..,m,--,n,-.
2855. DATA o,---,p,.--.,q,--.-,r,-.-,s,...,t,-,u,..-
2856. DATA v,...-,w,.--,x,-..-,y,-.--,z,--..,1,.----,2,..---
2857. DATA 3,...--,4,....-,5,.....,6,-...,7,--..,8,---..,9,----.
2858. DATA 0,-----,!,..--.,$,...-..-,&,.-...
2859.  
2860. warp:
2861. DATA "The Rockwell warranty is now void"
2862. DATA "Hope we don't collide with Klingons!"
2863. DATA "You need a vacation, Jim!  - Bones!"
2864. DATA "It's a long way to Tipperary!"
2865. DATA "Do we know this universe?  - Spock"
2866. DATA "My miniskirt is getting shorter! - Uhuru"
2867. DATA "Da engines kanna tayke much more! - Scotty"
2868. DATA "Keptin, are you insane? - Chekhov"
2869. DATA "Hit 10 and we die!"
2870.  
2871. radcomments:
2872. DATA "has caused genetic damage"
2873. DATA "causes glowing in the dark"
2874. DATA "5 years"
2875. DATA "1 year"
2876. DATA "6 months"
2877. DATA "1 month"
2878. DATA "1 week"
2879. DATA "8 hours"
2880. DATA "5 minutes"
2881. DATA "has killed you - press Esc"
2882.  
2883. skycrud:
2884. DATA CM,14,14
2885. DATA DS,150,150
2886. DATA BO,58,46
2887. DATA BH,200,200
2888. DATA Wo,90,90
2889. DATA Co,20,100
2890. DATA AL,40,40
2891. DATA ZZ,1,1
2892.  
2893. semadata:
2894. DATA a 1,225,180
2895. DATA b 2,270,180
2896. DATA c 3,315,180
2897. DATA d 4,0,180
2898. DATA e 5,180,45
2899. DATA f 6,180,90
2900. DATA g 7,180,135
2901. DATA h 8,270,225
2902. DATA i 9,225,315
2903. DATA j,0,90
2904. DATA k 0,225,0
2905. DATA l,225,45
2906. DATA m,225,90
2907. DATA n,225,135
2908. DATA o,270,315
2909. DATA p,270,0
2910. DATA q,270,45
2911. DATA r,270,90
2912. DATA s,270,135
2913. DATA t,315,0
2914. DATA u,315,45
2915. DATA v,0,135
2916. DATA w,45,90
2917. DATA x,45,135
2918. DATA y,315,90
2919. DATA z,135,90
2920. DATA " ",180,180
2921. DATA !,0,0
2922.  
2923. say:
2924. DATA "The time is 1234"
2925. DATA "Welcome to the Moon"
2926. DATA "I am a little green man"
2927. DATA "I have semaphore flags"
2928. DATA "R Frost is a nerd!"
2929. DATA "abcdefghijklmnopqrstuvwxyz"
2930. DATA end
2931.  
2932. BigM: '                                                               37 * 16
2933. DATA "          X               X          "
2934. DATA "         X X             X X         "
2935. DATA "        X   X           X   X        "
2936. DATA "       X     X         X     X       "
2937. DATA "      X       X       X       X      "
2938. DATA "     X         X     X         X     "
2939. DATA "     X         X     X         X     "
2940. DATA "    X           X   X           X    "
2941. DATA "    X           X   X           X    "
2942. DATA "   X             X X             X   "
2943. DATA "   X             X X             X   "
2944. DATA "  X              XXX              X  "
2945. DATA " X                                 X "
2946. DATA " X                                 X "
2947. DATA "X                                   X"
2948. DATA "X                                   X"
2949. DATA x
2950. '     1234567890123456789012345678901234567
2951. '              1         2         3
2952. tinyfontd:
2953. DATA 0,7,5,5,5,7
2954. DATA 1,2,6,2,2,7
2955. DATA 2,7,1,7,4,7
2956. DATA 3,7,1,7,1,7
2957. DATA 4,5,5,7,1,1
2958. DATA 5,7,4,7,1,7
2959. DATA 6,7,4,7,5,7
2960. DATA 7,7,1,1,1,1
2961. DATA 8,7,5,7,5,7
2962. DATA 9,7,5,7,1,7
2963. DATA .,0,0,0,0,2
2964. DATA -,0,0,1,0,0
2965. DATA ":",0,2,0,2,0
2966. DATA " ",0,0,0,0,0
2967.  
2968. lmshow:
2969. VIEW
2970. FOR pass = 1 TO 2
2971.     CLS
2972.     FOR i = 1 TO rp
2973.         x = (LMx(i) + 17 - ASO) * 16 + 30 + (pass = 2)
2974.         y = (LMy(i) + 18 - ASO * 9) * 8 + t
2975.         IF pass = 1 THEN z$ = LTRIM$(STR$(LMc(i))) ELSE z$ = RIGHT$("  " + STR$(i), 3)
2976.         IF LEN(z$) = 1 THEN z$ = "0" + z$
2977.         c = LMc(i)
2978.         TinyFont z$, x + 3, y + 3, c
2979.     NEXT i
2980.     FOR i = 1 TO 35 '                                                 line of numbers at top
2981.         z$ = RIGHT$(" " + LTRIM$(STR$(i)), 2)
2982.         TinyFont z$, (i - 1) * 16 + 33, 4, gray
2983.         x = (i - 1) * 16 + 30 + 16
2984.         LINE (x, 0)-(x, 320), red
2985.     NEXT i
2986.     FOR i = 1 TO 36 '                                                 columb of numbers at left
2987.         z$ = RIGHT$(" " + LTRIM$(STR$(i)), 2)
2988.         TinyFont z$, 8, i * 8 + 13, gray
2989.         y = i * 8 + t + 8 + 1
2990.         LINE (0, y)-(q3, y), red
2991.     NEXT i
2992.     LINE (0, 0)-(q3, 320), red, B
2993.     _DISPLAY
2994.     SLEEP
2995. NEXT pass
2996. RETURN
2997. ' -------------------------------------------------------------------------------------------------------x
2998. SUB mHelp
2999.     VIEW: CLS
3000.     hp = 1
3001.     DO
3002.         CLS
3003.         IF hp = 1 THEN GOSUB Help1
3004.         IF hp = 2 THEN GOSUB Help2
3005.         IF hp = 3 THEN GOSUB Help3
3006.         IF hp = 4 THEN GOSUB credits
3007.         timemachine
3008.         DO: _LIMIT 30
3009.             i$ = INKEY$
3010.         LOOP UNTIL LEN(i$)
3011.         IF LEN(i$) = 1 THEN k = ASC(i$) ELSE k = ASC(RIGHT$(i$, 1))
3012.         hp = hp + (k = 75) - (k = 77)
3013.         IF (k = 27) OR (hp < 1) OR (hp > 4) THEN EXIT DO
3014.     LOOP
3015.     CLS
3016.     EXIT SUB
3017.     ' --------------------------------------------------------------------------
3018.     ReadAndReplace:
3019.     READ z$
3020.     z = INSTR(z$, "ground")
3021.     p = INSTR(z$, "<"): IF (p > 0) AND (z = 0) THEN MID$(z$, p, 1) = CHR$(27)
3022.     p = INSTR(z$, ">"): IF (p > 0) AND (z = 0) THEN MID$(z$, p, 1) = CHR$(26)
3023.     RETURN
3024.     ' --------------------------------------------------------------------------
3025.     Help1:
3026.     RESTORE d1
3027.     REDIM gbuff2(8000)
3028.     s& = VARSEG(gbuff2(0))
3029.     o& = VARPTR(gbuff2(0))
3030.     DEF SEG = s&
3031.     BLOAD "PANEL.DAT", o&
3032.     PUT (0, 0), gbuff2(0)
3033.     REDIM gbuff2(0)
3034.     LINE (85, 0)-(260, q4), gray, BF
3035.     FOR i = 1 TO 13 '                                                 define the panel first
3036.         READ ty, z$
3037.         IF i < 5 THEN
3038.             sprint2 z$, 90, ty, white, 0
3039.         ELSE
3040.             IF i = 9 THEN z$ = CHR$(24) + CHR$(25) + z$ '             up & down arrow keys
3041.             IF i = 10 THEN z$ = CHR$(27) + CHR$(26) + z$ '            left & right arrow keys
3042.             sprint z$, 90, ty, white, 0
3043.             IF (i = 9) OR (i = 10) THEN sprint LEFT$(z$, 2), 90, ty, red, 0
3044.             IF i > 10 THEN sprint LEFT$(z$, 1), 90, ty, red, 0
3045.         END IF
3046.     NEXT i
3047.     LINE (261, 0)-(639, q4), blue2, BF '                              summary of program
3048.     ty = 11: c = white
3049.     FOR i = 1 TO 25
3050.         GOSUB ReadAndReplace
3051.         p = INSTR(z$, "*auto")
3052.         IF p THEN qm$ = CHR$(34): MID$(z$, p, 6) = qm$ + "auto" + qm$
3053.         sprint z$, 275, ty, c, 0
3054.         ty = ty + 9 - (z$ <> "") * 5
3055.     NEXT i
3056.     RETURN
3057.     ' --------------------------------------------------------------------------
3058.     Help2:
3059.     RESTORE d2
3060.     c1 = gray
3061.     c2 = black
3062.     z$ = "KEYBOARD COMMANDS"
3063.     GOSUB pageprep
3064.     tx = 40: ty = 26
3065.     FOR i = 1 TO 46
3066.         GOSUB ReadAndReplace
3067.         p = INSTR(z$, "ud")
3068.         IF p THEN MID$(z$, p, 2) = CHR$(24) + CHR$(25)
3069.         IF i = 3 THEN MID$(z$, 8, 1) = " "
3070.         e = INSTR(z$, "main t") + INSTR(z$, "side t")
3071.         IF e THEN c = green ELSE c = white
3072.         IF INSTR("ahv", LEFT$(z$, 1)) THEN c = gasoline
3073.         sprint2 z$, tx, ty, c, 0
3074.         ty = ty + 11: IF ty > 276 THEN tx = 340: ty = 26
3075.     NEXT i
3076.     LINE (50, 300)-(585, 300), 0
3077.     LINE (55, 302)-(590, 302), 0
3078.     GOSUB ReadAndReplace
3079.     sprint2 "When landed or paused, arrow keys move stars", 135, 282, white, 0
3080.     ty = 310
3081.     sprint z$, 350, ty, white, 0
3082.     sprint "essential", 50, ty, green, 0
3083.     sprint "other flight", 150, ty, gasoline, 0
3084.     RETURN
3085.  
3086.     Help3:
3087.     RESTORE d3
3088.     c1 = gray
3089.     c2 = black
3090.     z$ = "MORE KEYBOARD COMMANDS"
3091.     GOSUB pageprep
3092.     tx = 200: ty = 36: c2 = blue
3093.     FOR i = 1 TO 19
3094.         GOSUB ReadAndReplace
3095.         IF i = 19 THEN ty = 310: c2 = black
3096.         sprint z$, tx, ty, white, c2
3097.         ty = ty + 15
3098.     NEXT i
3099.  
3100.     LINE (50, 300)-(585, 300), 0
3101.     LINE (55, 302)-(590, 302), 0
3102.     RETURN
3103.     ' --------------------------------------------------------------------------
3104.     credits:
3105.     RESTORE d4
3106.     c1 = dred
3107.     c2 = white
3108.     z$ = "AUTHOR & HUMOUR SUMMARY"
3109.     GOSUB pageprep: x1 = 86: ty = 40
3110.     FOR i = 1 TO 30
3111.         GOSUB ReadAndReplace
3112.         IF i = 30 THEN
3113.             x1 = 320 - LEN(z$) * 4 - 8
3114.             x2 = 320 + LEN(z$) * 4 + 8
3115.             ty = 330
3116.             LINE (x1, ty)-(x2, ty + 11), dred, BF
3117.         END IF
3118.         sprint2 z$, x1 + 8, ty, c2, 0
3119.         ty = ty + t
3120.     NEXT i
3121.     RETURN
3122.     ' --------------------------------------------------------------------------
3123.     pageprep:
3124.     CLS: PAINT (1, 1), c1
3125.     x1 = 30: y1 = 5: x2 = 610: y2 = 345
3126.     FOR q = 2 TO 20 STEP 4
3127.         LINE (x1 - q, y1 + q)-(x2 + q, y2 - q), c1, B
3128.         LINE (x1 - q + 1, y1 + q + 1)-(x2 + q + 1, y2 - q + 1), c2, B
3129.     NEXT q
3130.     z = LEN(z$) + 2: x1 = 320 - z * 4: x2 = 320 + z * 4
3131.     LINE (x1, 9)-(x2, 22), c1, BF
3132.     sprint z$, x1 + 8, t, white, -c2
3133.     RETURN
3134. END SUB
3135. ' -------------------------------------------------------------------------------------------------------x
3136. SUB sprint (z$, tx, ty, c1, c2) '                                     VGA font
3137.     FOR i = 1 TO LEN(z$)
3138.         d = ASC(MID$(z$, i, 1))
3139.         IF d = 248 THEN d = 0 '                                       degree symbol
3140.         x = tx + (i - 1) * 8
3141.         FOR byte = 0 TO 13
3142.             y = ty + byte
3143.             p& = (p(d, byte) AND 255) * 128
3144.             IF c2 >= 0 THEN LINE (x + 1, y)-(x + 8, y), c2, , p&
3145.             LINE (x, y)-(x + 7, y), c1, , p&
3146.         NEXT byte
3147.     NEXT i
3148. END SUB
3149. ' -------------------------------------------------------------------------------------------------------x
3150. SUB sprint2 (c$, tx, ty, c1, c2) '                                    CGA font
3151.     FOR i = 1 TO LEN(c$)
3152.         d = ASC(MID$(c$, i, 1))
3153.         IF d = 248 THEN d = 0 '                                       degree symbol
3154.         FOR k = 0 TO 7
3155.             tx2 = tx + (i - 1) * 8 + k
3156.             ty2 = ty + 2
3157.             p& = p2(d, k)
3158.             IF c2 >= 0 THEN
3159.                 LINE (tx2 + 1, ty2 + 1)-(tx2 + 1, ty2 + 9), c2, , p&
3160.             END IF
3161.             LINE (tx2, ty2)-(tx2, ty2 + 8), c1, , p&
3162.         NEXT k
3163.     NEXT i
3164. END SUB
3165. ' -------------------------------------------------------------------------------------------------------x
3166. SUB AuHoVe (auto, hover, vert, lam)
3167.     FOR i = 0 TO 2
3168.         z$ = MID$(" AUTOHOVER VERT", i * 5 + 1, 5)
3169.         IF i = 0 THEN k = auto
3170.         IF i = 1 THEN k = hover
3171.         IF i = 2 THEN k = vert
3172.  
3173.         ty = 307 + i * 15
3174.         PrintCGA z$, 4, ty, gunmetal, black2, 0
3175.  
3176.         IF k THEN
3177.             c1 = green
3178.             c2 = black2
3179.         ELSE
3180.             c1 = black2
3181.             c2 = red
3182.         END IF
3183.  
3184.         IF crash THEN c1 = black2: c2 = black2
3185.  
3186.         IF lam AND k AND (i = 0) THEN c1 = gold '                     land at McD
3187.  
3188.         PrintCGA "ON ", 57, ty - 4, c1, -1, 0
3189.  
3190.         '                                                             blink OFF to indicate a keyboard command turned it off
3191.         IF (i = 0) AND (APdisengage > 0) AND (c2 = red) THEN
3192.             c2 = (APdisengage MOD 2) * red
3193.             APdisengage = APdisengage - 1
3194.         END IF
3195.         PrintCGA "OFF", 57, ty + 3, c2, -1, 0
3196.  
3197.         tx1 = 48: ty1 = ty + 5 '                                      switches
3198.         IF i = 1 THEN c = blue2 ELSE c = blue '                       background
3199.         IF k THEN ta = 285 ELSE ta = 75 '                             up & down angles
3200.         tx2 = tx1 + 5 * c!(ta)
3201.         ty2 = ty1 + 5 * s!(ta)
3202.         FOR k = 0 TO 1
3203.             LINE (tx1 + 2, ty1)-(tx2 + k + 2, ty2), white '           plot switch
3204.         NEXT k
3205.         LINE (tx1 + 1, ty1)-(tx2 + 1, ty2), black2 '                  outline left
3206.         LINE (tx1 + 3, ty1)-(tx2 + 4, ty2), black2 '                  outline right
3207.     NEXT i
3208. END SUB
3209. ' -------------------------------------------------------------------------------------------------------x
3210. SUB Bar (xdat!, cl)
3211.     xmax = gs - t '                                                   graphics start - ten
3212.     xmin = xmax - 50
3213.     ymax = 273 - osc * 39
3214.     ymin = ymax - t
3215.     'xcen = xmin + (xmax - xmin) / 2 '                                center line
3216.     xbar = xmin + xdat! * (xmax - xmin) '                             data
3217.     IF xbar < xmin THEN xbar = xmin '                                 limit min
3218.     IF xbar > xmax THEN xbar = xmax '                                 limit max
3219.  
3220.     IF porb THEN '                                                    led bar
3221.         IF LEDtri = 0 THEN c = LEDc
3222.         IF cl THEN '                                                  center line
3223.             LINE (xbar - 1, ymin + 4)-(xbar + 1, ymin + 7), c, BF
3224.         ELSE
3225.             LINE (xmin, ymin + 5)-(xbar, ymin + 7), c, BF
3226.         END IF
3227.     ELSE '                                                            mechanical pointer
3228.         IF (osc = 4) AND (radarf = 0) THEN '                          altitude with radar off
3229.             tc1 = gray
3230.             tc2 = black
3231.         ELSE '                                                        normal
3232.             tc1 = white
3233.             tc2 = white
3234.         END IF
3235.         LINE (xbar, ymin + 4)-(xbar - 4, ymin + 8), tc1
3236.         LINE -(xbar + 4, ymin + 8), tc1
3237.         LINE -(xbar, ymin + 4), tc1
3238.         PAINT (xbar, ymin + 5), tc2, tc1
3239.     END IF
3240. END SUB
3241. ' -------------------------------------------------------------------------------------------------------x
3242. SUB BlackHole (freeze) STATIC
3243.     IF ei(3) = 0 THEN
3244.         DIM tc(2)
3245.         ei(3) = 1
3246.         l! = aspect!
3247.         tx = 30 + RND * 40
3248.         IF RND > .7 THEN tx = tx + RND * h
3249.         IF RND > .7 THEN tx = tx + RND * h '                          intentional repeat
3250.         v! = tx / l!
3251.         s1! = l! / t: r = RND * 90: ri = RND * 8 + 2
3252.         bc = bc + 1 + (bc = 6) * 7
3253.         z$ = "020105040906010613070603091301070605121404" '           colors
3254.         FOR i = 0 TO 2
3255.             tc(i) = VAL(MID$(z$, bc * 6 + i * 2 + 1, 2))
3256.         NEXT i
3257.         d1 = RND * 2 + 1
3258.         d2 = RND * 2 + 1
3259.     END IF
3260.  
3261.     x0 = localize(ex(3), 0, 0)
3262.     y0 = ey(3)
3263.  
3264.     tri = ri
3265.     IF freeze THEN tri = tri \ 2 '                                    rotation increment
3266.     r = (r + tri) MOD tsix '                                           rotation
3267.     dtlt! = -30 - 30 * ABS(c!((r * 3 + 50) MOD tsix)) '                tilt
3268.     dtlti = (dtlt! + tsix) MOD tsix
3269.     crot! = c!(r)
3270.     srot! = s!(r)
3271.     ctlt! = c!(dtlti) / d1
3272.     stlt! = s!(dtlti) / d2
3273.     co = (co + 1) MOD tsix
3274.  
3275.     bhx = 0: bhy = bhx
3276.     FOR pass = 0 TO 1 '                                               90 degrees apart
3277.         FOR za! = -l! TO l! STEP s1!
3278.             pd = 0 '                                                  pen up
3279.             FOR zb! = -l! TO l! STEP s1!
3280.                 x1! = za!
3281.                 y1! = zb!
3282.                 IF pass THEN SWAP x1!, y1!
3283.                 x! = x1! * crot! + y1! * srot!
3284.                 y! = y1! * crot! - x1! * srot!
3285.                 q! = -.8 / (x1! * x1! + y1! * y1!) + .8
3286.                 z! = q! * ctlt! - y! * stlt!
3287.                 y! = y! * ctlt! + q! * stlt!
3288.                 s! = (l! * 2) / ((l! * 2) + y!)
3289.                 xx = x0 + x! * v! * s!
3290.                 yy = y0 - z! * v! * s!
3291.                 x! = za! * 1.8: x! = x! * x!
3292.                 y! = zb! * 1.8: y! = y! * y!
3293.                 tc = tc((x! + y! + co) MOD 3)
3294.                 IF pd THEN LINE -(xx, yy), tc ELSE PSET (xx, yy)
3295.                 c1 = (xx > -120) AND (xx < 770)
3296.                 c2 = (yy > -120) AND (yy < 470)
3297.                 IF c1 AND c2 THEN '                                   on screen
3298.                     bh = 1
3299.                     IF (ABS(za!) < .1) AND (yy > bhy) THEN
3300.                         bhx = xx
3301.                         bhy = yy
3302.                     END IF
3303.                 END IF
3304.                 pd = 1 '                                              pen down
3305.             NEXT zb!
3306.         NEXT za!
3307.     NEXT pass
3308. END SUB
3309. ' -------------------------------------------------------------------------------------------------------x
3310. SUB BlackHoleDoom '                                                   fall in while shrinking
3311.     fb$ = "" '                                                        silence feedback, if any
3312.     sgs = gs '                                                        save graphics start (going to kill panel here)
3313.     gs = 0 '                                                          kills panel
3314.     VIEW
3315.     DIM LMxi!(q2), LMyi!(q2)
3316.     FOR i = 1 TO rp '                                                 rp=right pad (end of LM data)
3317.         LMxi!(i) = (exl(3) - LMrx(i)) / 50
3318.         LMyi!(i) = ((ey(3) + bhy) \ 2 - LMry(i)) / 50
3319.     NEXT i
3320.     FOR pass = 1 TO 50
3321.         CLS
3322.         mes$(0) = "Let's get SMALL! - Steve Martin"
3323.         FOR i = 1 TO rp
3324.             x = LMrx(i) + LMxi!(i) * pass
3325.             y = LMry(i) + LMyi!(i) * pass
3326.             c = LMc(i)
3327.             IF (c = gasoline) AND (RND > pf!) THEN c = 0
3328.             PSET (x, y), c
3329.         NEXT i
3330.         GOSUB ibd
3331.         wu! = TIMER + .1
3332.         DO: _LIMIT mdelay
3333.             GOSUB ibd
3334.             i$ = INKEY$
3335.             IF (i$ = "q") OR (i$ = CHR$(27)) THEN Quit
3336.         LOOP UNTIL TIMER > wu!
3337.     NEXT pass
3338.     mes$(0) = dead$
3339.     mes$(1) = ""
3340.     gs = sgs
3341.     EXIT SUB
3342.  
3343.     ibd:
3344.     Info
3345.     BlackHole 1
3346.     timemachine
3347.     RETURN
3348. END SUB
3349. ' -------------------------------------------------------------------------------------------------------x
3350. SUB CMshadow (tx2, x1, x2)
3351.     z = (TIMER MOD 17) + 1 '                                          rotation 1
3352.     IF z < t THEN
3353.         LINE (tx2 - 4, 17 + z)-(tx2 - 1, 17 + z), white
3354.     END IF
3355.     z = ((z + 8) MOD 17) + 1 '                                        rotation 2
3356.     IF z < t THEN
3357.         LINE (tx2 + 6, 17 + z)-(tx2 + 8, 17 + z), white
3358.     END IF
3359.     FOR tx = x1 TO x2 '                                               shadow
3360.         FOR ty = 17 TO 26
3361.             pp = POINT(tx, ty)
3362.             zx = tx - x1 - (x2 - x1) \ 2
3363.             zy = ty - 22
3364.             IF (pp = white) AND (zy > (zx + 4)) THEN PSET (tx, ty), gray2
3365.         NEXT ty
3366.     NEXT tx
3367. END SUB
3368. ' -------------------------------------------------------------------------------------------------------x
3369. FUNCTION dcolor (v!, z1, z2, d) '                                     determine color for various displays
3370.     dcolor = LEDc '                                                   normal
3371.     IF liftoff = 0 THEN
3372.         tv! = ABS(v!)
3373.         IF d = 1 THEN '                                               problem higher
3374.             IF tv! > z1 THEN dcolor = yellow '                        warning
3375.             IF tv! > z2 THEN dcolor = red '                           serious warning
3376.         ELSE '                                                        problem lower
3377.             IF tv! < z1 THEN dcolor = yellow '                        warning
3378.             IF tv! < z2 THEN dcolor = red '                           serious warning
3379.         END IF
3380.     END IF
3381. END FUNCTION
3382. ' -------------------------------------------------------------------------------------------------------x
3383. SUB Evaluate (savea, z) '                                             landing analysis
3384.     IF (ABS(z) > 4) AND (crash = 0) THEN
3385.         IF ABS(savea) > 4 THEN
3386.             z$ = "contact angle " + LTRIM$(STR$(-savea)) + CHR$(248)
3387.             GOSUB tackon
3388.         END IF
3389.         IF ABS(z) > 4 THEN
3390.             z$ = "ending angle " + LTRIM$(STR$(-(z))) + CHR$(248)
3391.             GOSUB tackon
3392.         END IF
3393.     END IF
3394.  
3395.     IF ABS(vx!) > 3 THEN z$ = "horizontal velocity": GOSUB tackon
3396.     IF ABS(vy!) > 3 THEN z$ = "vertical velocity": GOSUB tackon
3397.     ok = -(LEN(fb$) = 0)
3398.     z! = ABS(vx!)
3399.     IF (z! <= 3) AND (vy! <= 3) THEN score = 5: z$ = "Poor"
3400.     IF (z! <= 2) AND (vy! <= 2) THEN score = 4: z$ = "Fair"
3401.     IF (z! <= 1) AND (vy! <= 1) THEN score = 3: z$ = "Good"
3402.     IF (z! <= pf!) AND (vy! <= pf!) THEN score = 2: z$ = "Excellent"
3403.     IF (z! < .1) AND (vy! < .1) THEN score = 1: z$ = "Fantastic"
3404.     IF magic THEN z$ = "Magic"
3405.     IF ok = 0 THEN z$ = "Bad"
3406.     z$ = z$ + " landing"
3407.     IF crash THEN fb$ = "": z$ = "CRASHED"
3408.  
3409.     IF lob THEN
3410.         z$ = z$ + " on Borg": GOSUB tackon
3411.         GOTO eother
3412.     END IF
3413.  
3414.     v$ = "" '                                                         verb
3415.     n$ = "" '                                                         noun
3416.     ldis = q1 '                                                       last distance
3417.  
3418.     FOR i = 1 TO t '                                                  5wlemtsihg
3419.         tx = sf(i, 2) - suri '                                        point of interest middle
3420.         IF tx < 0 THEN tx = tx + q1
3421.         poi$ = sf$(i) '                                               name of poi
3422.         dis = ABS(px! - tx)
3423.         IF (poi$ = "") OR (dis > ldis) THEN GOTO ni
3424.         ldis = dis
3425.         IF dis < h THEN
3426.             n$ = poi$
3427.             don = (sf(i, 2) - sf(i, 0)) + wi2 '                       distance to be "on"
3428.             IF dis < don THEN
3429.                 '        pad  349              LGM        Surveyor
3430.                 IF (ABS(sy1 - q4) < 20) AND (i <> 3) AND (i <> 7) THEN
3431.                     v$ = "in"
3432.                 ELSE
3433.                     v$ = "on"
3434.                 END IF
3435.             ELSE
3436.                 v$ = "at"
3437.             END IF
3438.             IF ok THEN
3439.                 IF (i = 1) THEN mes$(1) = "MIB will visit you shortly!"
3440.                 IF (i = 3) AND (LGMc = gray) THEN n$ = "the ashes of " + n$
3441.                 IF (i = 4) AND (v$ = "on") THEN mes$(1) = "On a volcano?  Are you crazy?"
3442.                 IF (i = 5) THEN mes$(1) = "Buzz wants a Happy Meal!"
3443.                 IF (i = t) AND (v$ = "on") THEN
3444.                     mes$(1) = "Rude to land on a tombstone!"
3445.                 END IF
3446.             END IF
3447.         END IF
3448.         ni:
3449.     NEXT i
3450.  
3451.     z$ = RTRIM$(z$ + " " + v$ + " " + n$): GOSUB tackon
3452.  
3453.     IF v$ = "in" THEN '                                               handle oddball cases
3454.         IF n$ = sf$(6) THEN mes$(1) = "The aliens will not be pleased!"
3455.         IF n$ = sf$(8) THEN mes$(1) = "Merged with the machine!"
3456.         IF n$ = sf$(t) THEN mes$(1) = "Desecration of a grave!"
3457.     END IF
3458.  
3459.     eother:
3460.     IF fuel! = 0 THEN z$ = "ran out of fuel!": GOSUB tackon
3461.     EXIT SUB
3462.  
3463.     tackon:
3464.     IF LEN(fb$) THEN z$ = ", " + z$
3465.     fb$ = fb$ + z$
3466.     RETURN
3467. END SUB
3468. ' -------------------------------------------------------------------------------------------------------x
3469. SUB ExplodeLM
3470.     DIM LMxi!(q2), LMyi!(q2)
3471.     CountFuel = 0
3472.     FOR i = 1 TO rp '                                                 for each pixel, a direction
3473.         ta = RND * tsix '                                              pick an angle, any angle
3474.         IF contact THEN ta = RND * 180 + 180 '                        upward only if on ground
3475.         tf = RND * 20 + 2 '                                           force
3476.         LMxi!(i) = tf * c!(ta) '                                      x increment
3477.         LMyi!(i) = tf * s!(ta)
3478.         IF LMc(i) = fuel THEN '                                       color
3479.             CountFuel = CountFuel + 1
3480.             IF CountFuel < ptk THEN LMc(i) = 0 '                      points to kill
3481.         END IF
3482.     NEXT i
3483.     contact = 0
3484.     fb$ = "" '                                                        eval feedback
3485.     sgs = gs
3486.     gs = 0 '                                                          full screen
3487.     VIEW
3488.     FOR pass = 1 TO 40 '                                              expanding debris
3489.         CLS
3490.         mes$(0) = dead$
3491.         mes$(1) = ""
3492.         Info '                                                        say why exploding
3493.         FOR i = 1 TO rp
3494.             LMrx(i) = LMrx(i) + LMxi!(i)
3495.             LMry(i) = LMry(i) + LMyi!(i)
3496.             LMyi!(i) = LMyi!(i) - grav! * (warp! = 0)
3497.             x = (LMrx(i) - h) * aspect!
3498.             y = LMry(i)
3499.             s = i MOD 5 '                                             size
3500.             LINE (x, y)-(x + s, y + s), LMc(i), BF
3501.             z1 = ((RND * t) - 5) * 3
3502.             z2 = ((RND * t) - 5) * 3
3503.             LINE (x + z1, y + z2)-(x + z1 + s, y + z2 + s), LMc(i), BF
3504.         NEXT i
3505.         LINE (0, 0)-(q3, q4), 0, B '                                  erase ugly border
3506.         timemachine
3507.         w! = TIMER + .02: WHILE TIMER < w!: WEND
3508.     NEXT pass
3509.     gs = sgs
3510. END SUB
3511. ' -------------------------------------------------------------------------------------------------------x
3512. SUB ExplodeShell (s) '                                                not contact - when LM fires at them
3513.     tx = shx(s) - suri
3514.     ty = shy(s)
3515.     LINE (tx - 5, ty - 5)-(tx + 5, ty + 5), black2, BF '              erase shell
3516.  
3517.     FOR d = t TO 30 STEP 2 '                                          distance
3518.         FOR z = 0 TO 40 - d '                                         particles at above distance
3519.             ang = RND * tsix '                                         angle
3520.             tx2 = tx + d * c!(ang) * aspect!
3521.             ty2 = ty + d * s!(ang)
3522.             bit = bit XOR 1
3523.             IF bit THEN c = red ELSE c = yellow
3524.             PSET (tx2, ty2), c
3525.         NEXT z
3526.     NEXT d
3527.     shx(s) = 0
3528.     shd(s) = q1 '                                                     6400, any large number
3529.     sia = sia - 1 '                                                   shells in air
3530. END SUB
3531. ' -------------------------------------------------------------------------------------------------------x
3532. SUB GetSurface (gh) '                                                 load surface array
3533.     DIM lz(t) '                                                       landing zones
3534.     f$ = "s" + LTRIM$(STR$(gh)) + ".dat" '                            0 - 10
3535.     IF gh < 0 THEN f$ = "SL.DAT" '                                    l for level
3536.     IF demo THEN f$ = "SD.DAT" '                                      d for demo
3537.     CLOSE #6
3538.     OPEN f$ FOR RANDOM AS #6 LEN = 2
3539.     FOR i = 0 TO 6399
3540.         GET #6, i + 1, gh(i)
3541.     NEXT i
3542.     FOR i = 1 TO t '                                                  create landing zones
3543.         IF demo THEN '                                                compress onto 1 page
3544.             lz(i) = 3050 + (i - 1) * 80
3545.         ELSE
3546.             lz(i) = 320 + (i - 1) * (q3 + 1) '                        1 per page
3547.         END IF
3548.     NEXT i
3549.     IF demo THEN '                                                    all on one page
3550.         SWAP lz(9), lz(t) '                                           move grave 1 page left
3551.         SWAP lz(2), lz(4) '                                           move car wash 2 pages right
3552.     END IF
3553.     RESTORE features
3554.     FOR i = 1 TO t
3555.         READ sf$(i), x, y, lz '                                       sf = special feature
3556.         sf(i, 0) = lz(i) - x \ 2 '                                    start
3557.         IF demo AND (i = 9) THEN sf(i, 0) = 3750 '                    Hollywood
3558.         sf(i, 1) = sf(i, 0) + x '                                     end
3559.         sf(i, 2) = sf(i, 0) + x \ 2 '                                 middle
3560.     NEXT i
3561.     IF demo THEN '                                                    move LGM to top of grave
3562.         sf(3, 0) = sf(t, 0) + 14 '                                    x left
3563.         sf(3, 1) = sf(t, 1) + 14 '                                    x right
3564.         sf(3, 2) = sf(t, 2) + 14 '                                    x middle
3565.     END IF
3566.     sspinit2 = 0
3567. END SUB
3568. ' -------------------------------------------------------------------------------------------------------x
3569. FUNCTION gety (x) '                                                   ground level for given x
3570.     ax = ABS(x)
3571.     xx = (suri + ax) MOD q1
3572.     IF sy1 > 310 THEN
3573.         c1 = (xx >= sf(2, 0)) '                                       car wash start
3574.         c2 = (xx <= sf(2, 1)) '                                       car wash end
3575.         IF c1 AND c2 THEN
3576.             IF ASO THEN z = 320 ELSE z = 338 '                        safe zone start different with ascent stage only
3577.             IF sy1 > z THEN
3578.                 gety = q4 '                                           349, max y
3579.                 EXIT FUNCTION
3580.             END IF
3581.         END IF
3582.     END IF
3583.     IF x < 0 THEN
3584.         c1 = (ek(2) <> -1) AND (ek(2) < h)
3585.         c2 = (skyoff = 0) AND (sy1 < borgt) AND (ax > borgl) AND (ax < borgr)
3586.         IF c1 AND c2 THEN
3587.             gety = borgt
3588.             EXIT FUNCTION
3589.         END IF
3590.     END IF
3591.     gety = gh(xx)
3592. END FUNCTION
3593. ' -------------------------------------------------------------------------------------------------------x
3594. SUB Hollywood
3595.     FOR i = 1 TO 9
3596.         tx = x + i * 16
3597.         ty = gety(tx) - 14
3598.         PrintVGA MID$("HOLLYWOOD", i, 1), tx - 4, ty, white, black
3599.         LINE (tx, ty + 9)-(tx, ty + 22), gray2
3600.     NEXT i
3601. END SUB
3602. ' -------------------------------------------------------------------------------------------------------x
3603. SUB IBM STATIC
3604.     DIM a(1)
3605.     x0 = x
3606.     y0 = 304
3607.     IF bolthitf THEN tc = white ELSE tc = gasoline '                  lightning bolt from deathstar
3608.     LINE (x0, y0)-(x0 + 50, y0 + 45), tc, BF '                        entire area
3609.     LINE (x0, y0)-(x0 + 50, y0 + 45), gray, B '                       outline
3610.  
3611.     LINE (x0, y0 - 1)-(x0, y0 - 30), gray2 '                          light towers
3612.     LINE (x0 + 50, y0 - 1)-(x0 + 50, y0 - 30), gray2
3613.  
3614.     IF bbit THEN '                                                    global seconds toggle
3615.         PSET (x0, y0 - 30), red '                                     lights on towers
3616.         PSET (x0 + 50, y0 - 30), red
3617.         ltoggle = ltoggle XOR 1
3618.         IF ltoggle THEN
3619.             PSET (x0, y0 - 31), red
3620.             PSET (x0 + 50, y0 - 31), red
3621.             LINE (x0 - 2, y0 - 30)-STEP(4, 0), red
3622.             LINE (x0 + 48, y0 - 30)-STEP(4, 0), red
3623.         END IF
3624.     END IF
3625.  
3626.     IF a(0) = 0 THEN a(0) = 30: a(1) = 150 '                          initial marker positions
3627.     IF RND > pf! THEN '                                               reel mark direction&speed
3628.         tdir = SGN(RND - pf!) * INT(RND * 4 + 2)
3629.         IF RND > .8 THEN tdir = 0 '                                   sometimes not moving
3630.     END IF
3631.     LINE (x0 + 6, y0 + 15)-(x0 + 19, y0 + 21), black2 '               tape
3632.     LINE -(x0 + 33, y0 + 21), black2
3633.     LINE -(x0 + 44, y0 + 15), black2
3634.     LINE (x0 + 24, y0 + 19)-STEP(3, 1), dred, BF '                    head
3635.     FOR i = 0 TO 1 '                                                  reels/rollers
3636.         a(i) = (a(i) + t * tdir + tsix) MOD tsix '                      marker angle
3637.         x = x0 + 13 + i * 24
3638.         y = y0 + 11
3639.         FOR d! = 5 TO 9
3640.             CIRCLE (x, y), d!, white, , , .73 '                       reel
3641.             CIRCLE (x, y), d!, white, , , .68
3642.         NEXT d!
3643.         x1 = x + 3 * s!(a(i)) * grav!
3644.         y1 = y + 3 * c!(a(i))
3645.         x2 = x + 6 * s!(a(i)) * grav!
3646.         y2 = y + 6 * c!(a(i))
3647.         LINE (x1, y1)-(x2, y2), black2 '                              rotation marker
3648.         FOR d = 0 TO 4 '                                              hub
3649.             CIRCLE (x, y), d, dred, , , .73
3650.         NEXT d
3651.     NEXT i
3652.  
3653.     IF sia > 0 THEN '                                                 shells in air = building gets MEAN title
3654.         PrintLines "HAL", 0, 47, x0 + 1, y0 + 39, red, white, 1, 2
3655.     ELSE
3656.         PrintLines "IBM", 0, 47, x0, y0 + 39, blue, white, 1, 2
3657.     END IF
3658.  
3659.     '                                                                 binary clock
3660.     z$ = TIME$ '                                                      hh:mm:ss
3661.     z$ = LEFT$(z$, 2) + MID$(z$, 4, 2) + RIGHT$(z$, 2) '              hhmmss
3662.     FOR i = 1 TO 6
3663.         v = VAL(MID$(z$, i, 1)) '                                     value
3664.         x = x0 + i * 5 + 2 - (i > 2) * 5 - (i > 4) * 5 '              column
3665.         z = VAL(MID$("132323", i, 1)) '                               rows for this column
3666.         FOR j = 0 TO z
3667.             IF v AND 1 THEN c = red ELSE c = black2 '                 red = on
3668.             v = v \ 2
3669.             y = glmax - 2 - j * 2
3670.             LINE (x - 1, y)-(x + 1, y), c, B '                        show bit
3671.         NEXT j
3672.     NEXT i
3673.  
3674.     IF ttf! < -2 THEN fat! = TIMER + 10
3675.     ttf! = fat! - TIMER '                                             time to fire
3676.     IF fat! > 86400 THEN fat! = t: ttf! = 0
3677.  
3678.     IF (ttf! > 0) AND (ttf! < 1) THEN '                               optional radar
3679.         sky = (sky + 1) MOD tsix
3680.         x1 = x0 + 25
3681.         FOR sky2 = 0 TO 180 STEP 5
3682.             zz = (sky + sky2) MOD 180
3683.             x2 = x1 + q2 * c!(zz)
3684.             y2 = (y0 - 1) - q2 * s!(zz) - 1
3685.             LINE (x1, y0 - 1)-(x2, y2), red, , &H1111
3686.         NEXT sky2
3687.     END IF
3688.  
3689.     IF pat1& = 0 THEN pat1& = &H5555: pat2& = &HAAAA
3690.     SWAP pat1&, pat2& '                                               countdown to firing
3691.     z! = ttf!: IF z! < 0 THEN z! = 0
3692.     tx = x0 + z! / t * 48
3693.     IF tx > (x0 + 48) THEN tx = xo + 48 '                             crude fix for a midnite crossing
3694.     ty = y0 + 1
3695.     LINE (x0 + 1, ty)-(tx, ty), black2, , pat1&
3696.     LINE (x0 + 1, ty)-(tx, ty), red, , pat2&
3697.  
3698.     IF (sia < 20) AND (shoot OR (ttf! <= 0)) THEN '                   initialize shell
3699.         shoot = 0
3700.         FOR s = 1 TO 20
3701.             IF shx(s) = 0 THEN
3702.                 sia = sia + 1 '                                       shells in air
3703.                 shx(s) = suri + x0 + 25
3704.                 shy(s) = 320
3705.                 shellv = (-32 + (RND - pf!) * t) * t '                velocity
3706.                 ta = 0
3707.                 IF RND > .1 THEN '                                    smart 10%
3708.                     IF RND > pf! THEN
3709.                         ta = -RND * 25
3710.                     ELSE
3711.                         ta = RND * 50 '                               above or below
3712.                     END IF
3713.                     ta = ta + (RND - pf!) * 4 '                       vary it a little
3714.                 END IF
3715.                 dx = px! - shx(s) + suri
3716.                 dy = shy(s) - py!
3717.                 IF dy = 0 THEN dy = 1
3718.                 shella = _R2D(ATN(dx / dy)) + (90 - 5 * SGN(dx) + ta)
3719.                 IF py! > 280 THEN
3720.                     shella = 90 + (RND - pf!) * 40
3721.                     shellv = shellv * .75
3722.                 END IF
3723.                 shella = (shella + tsix) MOD tsix
3724.                 shvx(s) = (shellv / t) * c!(shella)
3725.                 shvy(s) = (shellv / t) * s!(shella)
3726.                 shd(s) = q1
3727.                 EXIT FOR
3728.             END IF
3729.         NEXT s
3730.     END IF
3731. END SUB
3732. ' -------------------------------------------------------------------------------------------------------x
3733. SUB Info STATIC '                                                     show messages
3734.     DIM lenmes(1)
3735.     IF LEN(fb$) THEN mes$(0) = UCASE$(fb$): sm!(0) = mTIMER
3736.  
3737.     FOR i = 0 TO 1
3738.         IF mes$(i) <> omes$(i) THEN sm!(i) = 0
3739.         lenmes(i) = LEN(mes$(i))
3740.         IF lenmes(i) AND (sm!(i) = 0) THEN
3741.             sm!(i) = TIMER
3742.             omes$(i) = mes$(i)
3743.         END IF
3744.         el! = TIMER - sm!(i)
3745.         IF el! > 5 THEN mes$(i) = "": sm!(i) = 0
3746.     NEXT i
3747.     tcenter = (q3 + gs) \ 2 '                                         center of "space" area
3748.     IF lenmes(0) THEN
3749.         c1 = white2: c2 = gray
3750.         z$ = LTRIM$(mes$(0))
3751.         l3$ = LEFT$(z$, 3)
3752.         IF l3$ = "CM:" THEN c1 = red '                                rendesvous chatter
3753.         IF l3$ = "DAN" THEN c1 = red '                                Danger, Will Robinson
3754.         IF c1 = red THEN c2 = black2
3755.         IF (convo > 0) OR (INSTR("EstWARRad", l3$) > 0) THEN
3756.             PrintVGA z$, tcenter - lenmes(0) * 4, 5, c1, -1
3757.         ELSE
3758.             IF lenmes(0) > (34 - (gs = 0) * 5) THEN
3759.                 tcol = (tcol + 4) MOD (lenmes(0) * t)
3760.                 z$ = SPACE$(4) + z$
3761.                 PrintLines z$, tcol, tcol + 40 * 16, gs, 20, c1, c2, 2, 2
3762.             ELSE
3763.                 tx = tcenter - LEN(z$) * 8
3764.                 'LINE (gs, 6)-(q3, 17), 0, BF
3765.                 PrintLines z$, 0, lenmes(0) * 16 - 1, tx, 20, c1, c2, 2, 2
3766.             END IF
3767.         END IF
3768.     END IF
3769.  
3770.     IF lenmes(1) THEN '                                               subordinate msg
3771.         IF lenmes(0) THEN ty = 30 ELSE ty = 5
3772.         PrintVGA mes$(1), tcenter - lenmes(1) * 4, ty, red, dred
3773.     END IF
3774.  
3775.     IF (invincible = 0) AND (rads >= h) AND (TIMER < rtl!(0)) THEN
3776.         z = rads \ h
3777.         IF z >= t THEN radiationdeath = 1: z = t '                    >= ten
3778.         IF z <= t THEN '                                              <= ten
3779.             RESTORE radcomments
3780.             FOR i = 1 TO z
3781.                 READ z$
3782.             NEXT i
3783.             IF VAL(LEFT$(z$, 1)) THEN '                               does it start with a #?
3784.                 z$ = "ensures your death within " + z$ '              yes, tack on phrase
3785.             END IF
3786.             mes$(1) = "Radiation exposure " + z$ + "!"
3787.         END IF
3788.     END IF
3789. END SUB
3790. ' -------------------------------------------------------------------------------------------------------x
3791. SUB LEDdisplay (t$) STATIC
3792.     IF LEDinit = 0 THEN
3793.         DIM segment(6, 3), number$(11)
3794.         RESTORE leds
3795.         FOR i = 0 TO 6
3796.             READ g$
3797.             FOR j = 0 TO 3
3798.                 READ segment(i, j)
3799.             NEXT j
3800.         NEXT i
3801.         FOR i = 0 TO 11
3802.             READ g$, number$(i)
3803.         NEXT i
3804.         LEDinit = 1
3805.     END IF
3806.  
3807.     IF (osc < 6) OR (osc = t) THEN '                                  fuel,alt,h,v,thrust,angle
3808.         tc = c: IF LEDtri = 0 THEN tc = LEDc
3809.         IF osc = t THEN '                                             angle
3810.             segx = 14: segy = 14 '                                    segment size
3811.             tx = 92 - LEN(t$) * segx * 2
3812.             ty = 298
3813.         ELSE
3814.             tl = (LEN(t$) - SGN(INSTR(t$, "."))) * 16
3815.             tx = gs - tl
3816.             ty = 296 - osc * 39
3817.             segx = 8: segy = 8
3818.         END IF
3819.     ELSE '                                                            6clock 7dtm 8speed 9rads
3820.         IF osc = 9 THEN tc = red ELSE tc = orange
3821.         IF crash THEN tc = white2
3822.         tx = 50
3823.         ty = 35 + (osc - 6) * 9
3824.         IF osc = 9 THEN ty = 62
3825.         segx = 4: segy = 3
3826.     END IF
3827.  
3828.     IF crash AND (osc <> 6) THEN EXIT SUB '                           allow clock
3829.  
3830.     dpp = 0 '                                                         decimal point
3831.     FOR si = 1 TO LEN(t$)
3832.         z$ = MID$(t$, si, 1)
3833.         IF z$ = "." THEN '                                            plot sub can't handle decimal
3834.             tx1 = tx + (si - 1) * 16 - 5
3835.             LINE (tx1, ty - 1)-(tx1 + 1, ty), tc, BF
3836.             dpp = 1
3837.         ELSE
3838.             z = VAL(z$)
3839.             IF z$ = "-" THEN z = t
3840.             IF z$ = "L" THEN z = 11 '                                 "L" for lock fuel and level ground
3841.             IF z$ <> " " THEN GOSUB leddigit
3842.         END IF
3843.     NEXT si
3844.  
3845.     IF osc = 6 THEN '                                                 colon for clock
3846.         IF crash THEN bbit = 1
3847.         PSET (tx + 14, ty - 4), tc * bbit
3848.         PSET (tx + 14, ty - 2), tc * bbit
3849.     END IF
3850.     EXIT SUB
3851.  
3852.     leddigit:
3853.     FOR i = 1 TO LEN(number$(z))
3854.         seg$ = MID$(number$(z), i, 1)
3855.         IF INSTR("abcdefg", z$) THEN seg$ = z$ '                      for wave effect
3856.         segn = ASC(seg$) - 97
3857.         x0 = tx + (si - 1 - dpp) * (segx * 2)
3858.         x1 = x0 + segment(segn, 0) * segx
3859.         y1 = ty + segment(segn, 1) * segy
3860.         x2 = x0 + segment(segn, 2) * segx
3861.         y2 = ty + segment(segn, 3) * segy
3862.         IF x1 < x2 THEN
3863.             LINE (x1 + 1, y1)-(x2 - 1, y1), tc '                      horizontal
3864.             IF osc = t THEN '                                         angle (very thick)
3865.                 LINE (x1 + 2, y1 - 1)-(x2 - 2, y1 - 1), tc
3866.                 LINE (x1 + 2, y1 + 1)-(x2 - 2, y1 + 1), tc
3867.             END IF
3868.         ELSE
3869.             LINE (x1, y1 + 1)-(x1, y2 - 1), tc '                      vertical
3870.             IF osc = t THEN '                                         angle (very thick)
3871.                 LINE (x1 - 1, y1 + 2)-(x1 - 1, y2 - 2), tc
3872.                 LINE (x1 + 1, y1 + 2)-(x1 + 1, y2 - 2), tc
3873.             END IF
3874.         END IF
3875.     NEXT i
3876.     RETURN
3877. END SUB
3878. ' -------------------------------------------------------------------------------------------------------x
3879. SUB LMbloads
3880.     p = ASO * 3 + 4
3881.  
3882.     s& = VARSEG(LMx(0))
3883.     o& = VARPTR(LMx(0))
3884.     DEF SEG = s&
3885.     BLOAD f$(p), o&
3886.  
3887.     s& = VARSEG(LMy(0))
3888.     o& = VARPTR(LMy(0))
3889.     DEF SEG = s&
3890.     BLOAD f$(p + 1), o&
3891.  
3892.     s& = VARSEG(LMc(0))
3893.     o& = VARPTR(LMc(0))
3894.     DEF SEG = s&
3895.     BLOAD f$(p + 2), o&
3896. END SUB
3897. ' -------------------------------------------------------------------------------------------------------x
3898. SUB LMdistort
3899.     FOR i = 1 TO rp
3900.         IF (LMc(i) = craft) AND (RND > .6) THEN
3901.             LMx(i) = LMx(i) + RND * 3 - 1
3902.             LMy(i) = LMy(i) + RND * 3 - 1
3903.         END IF
3904.     NEXT i
3905. END SUB
3906. ' -------------------------------------------------------------------------------------------------------x
3907. SUB LoadPanel STATIC
3908.     IF pload = 0 THEN
3909.         z = 12500
3910.         REDIM pb(z)
3911.         tf$ = "PANEL" + CHR$(48 + background) + ".DAT"
3912.         s& = VARSEG(pb(0))
3913.         o& = VARPTR(pb(0))
3914.         DEF SEG = s&
3915.         BLOAD tf$, o&
3916.         pload = 1
3917.     END IF
3918.     PUT (0, 67), pb(), PSET
3919. END SUB
3920. ' -------------------------------------------------------------------------------------------------------x
3921. FUNCTION localize (tx, p, m)
3922.     z0 = 9999 '                                                       assume out of range
3923.     z1 = suri - m '                                                   surface index - minus
3924.     z2 = suri + p + q3 '                                              surface index + plus
3925.     FOR z = -1 TO 1 '                                                 page before, current, next
3926.         zx = tx + z * q1
3927.         IF (zx <= z2) AND (zx >= z1) THEN z0 = tx - suri + q1 * z
3928.     NEXT z
3929.     localize = z0 '                                                   return 9999 or calculated
3930. END FUNCTION
3931. ' -------------------------------------------------------------------------------------------------------x
3932. SUB Map
3933.     LINE (0, 0)-(gs - 1, 1), blue2, BF
3934.     FOR i = 1 TO 17 + ufof
3935.         IF i <= t THEN '                                              surface features
3936.             tx = sf(i, 2)
3937.             IF tx = -1 THEN GOTO skipf '                              destroyed
3938.             tc = blue
3939.             z$ = sf$(i) '                                             surface feature name
3940.             IF i = 3 THEN z$ = "LGM" '                                shorten some names
3941.             IF i = 5 THEN z$ = "McD"
3942.             IF i = 7 THEN z$ = "SSC"
3943.             GOTO wubba
3944.         END IF
3945.         IF i = (17 + ufof) THEN
3946.             tc = white
3947.             tx = (suri + px!) MOD (q1 + 1)
3948.             z$ = "LM"
3949.         ELSE '                                                        sky feature
3950.             IF skyoff THEN GOTO skipf
3951.             j = i - 11
3952.             IF (ek(j) = -1) OR eou THEN GOTO skipf '                  destroyed or not present
3953.             IF j THEN tc = red ELSE tc = green '                      CM green, rest red
3954.             tx = ex(j)
3955.             '                     1    2    3    4    5    6
3956.             '                 12345123451234512345123451234512345
3957.             z$ = RTRIM$(MID$("CM   EPCORBorg BH   Worm CometAlien", j * 5 + 1, 5))
3958.             IF j = 0 THEN z$ = z$ + STR$(exv(0)) '                    CM + velocity
3959.         END IF
3960.  
3961.         wubba:
3962.         tx = tx \ t
3963.         LINE (tx, 0)-(tx + 1, 1), tc, BF
3964.         zz = LEN(mes$(0)) + LEN(mes$(1)) - (liftoff = 1) '            quash names when messages active and during liftoff
3965.         IF (zz = 0) AND (tx > (gs + 6)) THEN PrintLines z$, 0, LEN(z$) * 8, tx - 6, 16, tc, -99, 0, 1
3966.         skipf:
3967.     NEXT i
3968. END SUB
3969. ' -------------------------------------------------------------------------------------------------------x
3970. SUB McD STATIC '                                                      37 * 16
3971.     IF McDi = 0 THEN '                                                initialize
3972.         z$ = "    Burger, fries & Coke only $1.99!"
3973.         FOR i = 1 TO LEN(z$) '                                        Morse code
3974.             c$ = MID$(z$, i, 1)
3975.             RESTORE MorseData
3976.             FOR j = 1 TO 39
3977.                 READ d$, x$
3978.                 IF d$ = LCASE$(c$) THEN m$ = m$ + x$ + " "
3979.             NEXT j
3980.         NEXT i
3981.         McDi = 1
3982.     END IF
3983.  
3984.     mp = (mp + 4) MOD 320 '                                           show ad in text
3985.     x2 = x + 38
3986.     IF bolthitf THEN tc = white ELSE tc = gold
3987.     LINE (x, glmax)-(x2, glmax - 19), tc, BF '                        clear sign area
3988.     PrintLines z$, mp, mp + 37, x, glmax - 1, red, black2, 1, 1
3989.  
3990.     FOR mx = x TO x2 - 1 '                                            arch & red neon
3991.         my = gety(mx)
3992.         arch = (arch + 1) MOD t
3993.         IF arch < 2 THEN tc = red ELSE tc = gold
3994.         IF bolthitf THEN tc = white
3995.         IF mx > x THEN LINE (mx, my)-(mx, my + 2), tc
3996.         tmx = x + x2 - mx - 2
3997.         IF tmx > x THEN LINE (tmx, glmax - 19)-(tmx + 2, glmax - 18), tc, BF
3998.     NEXT mx
3999.  
4000.     y = glmax - 1 '                                                   show ad in Morse
4001.     i = 0
4002.     z = (z MOD LEN(m$)) + 1
4003.     DO
4004.         j = ((z + i) MOD LEN(m$)) + 1
4005.         i = i + 1
4006.         p = INSTR(".- ", MID$(m$, j, 1)) - 1
4007.         IF p < 2 THEN LINE (x, y)-(x + p * 2, y), black2
4008.         x = x + (p + 1) * 2
4009.     LOOP UNTIL (x + 2) > x2
4010. END SUB
4011. ' -------------------------------------------------------------------------------------------------------x
4012. FUNCTION OnOff$ (v)
4013.     OnOff$ = MID$("OFFON ", v * 3 + 1, 3)
4014. END FUNCTION
4015. ' -------------------------------------------------------------------------------------------------------x
4016. SUB PrepAndShowLED (t!, nd, dp) STATIC
4017.     osc = osc + 1
4018.     IF dp = t THEN dp = 0: osc = 9
4019.  
4020.     ti = FIX(t!)
4021.     z! = ABS(t! - ti)
4022.     s$ = SPACE$(6)
4023.     IF (t! < 0) AND (ti = 0) THEN
4024.         t1$ = RIGHT$(s$ + "-" + LTRIM$(STR$(ti)), nd)
4025.     ELSE
4026.         t1$ = RIGHT$(s$ + LTRIM$(STR$(ti)), nd)
4027.     END IF
4028.  
4029.     t2a$ = LTRIM$(STR$(INT(z! * (t ^ dp))))
4030.     IF LEN(t2a$) < dp THEN t2a$ = RIGHT$("000" + t2a$, dp)
4031.     t2$ = LEFT$(LTRIM$(t2a$) + "0000", dp)
4032.     IF dp = 0 THEN z$ = t1$ ELSE z$ = t1$ + "." + t2$
4033.  
4034.     IF z$ = " -0.00" THEN z$ = "  0.00"
4035.  
4036.     IF (osc = 9) AND (t! = 0) THEN '                                  usually count for rads, lightning
4037.         cylon = (cylon + 1) MOD 6 '                                   when blank, cycle a "-"
4038.         zz = VAL(MID$("123432", cylon + 1, 1))
4039.         z$ = "    "
4040.         MID$(z$, zz, 1) = "-"
4041.     END IF
4042.  
4043.     IF osc = 4 THEN
4044.         IF (liftoff = 0) AND level THEN MID$(z$, 1, 1) = "L" '        altitude
4045.         IF radarf = 0 THEN z$ = " ----"
4046.     END IF
4047.  
4048.     IF (osc = 5) AND lockfuel THEN MID$(z$, 1, 1) = "L" '             fuel
4049.  
4050.     IF warp! > 0 THEN
4051.         IF osc = 4 THEN z$ = " ----" '                                suppress altitude
4052.         IF osc = 7 THEN z$ = "----" '                                 distance to McDonalds
4053.     END IF
4054.  
4055.     LEDdisplay z$
4056. END SUB
4057. ' -------------------------------------------------------------------------------------------------------x
4058. SUB PrintCGA (c$, x, y, tc1, tc2, compress) STATIC '                  CGA font, 8 * 8
4059.     c1 = tc1
4060.     c2 = tc2
4061.     IF y = -1 THEN '                                                  single char panel stuff - F for Fuel, etc.
4062.         c2 = -1
4063.         y = 263 - osc * 39
4064.         tx1 = x - 3
4065.         tx2 = x + 11
4066.         ty1 = y
4067.         ty2 = y + t
4068.         IF bbit AND (LEDc = green) AND (radarf > 0) AND (contact = 0) AND ((c1 = red) OR (c1 = yellow)) THEN
4069.             LINE (tx1 + 1, ty1 + 1)-(tx2 - 1, ty2 - 1), c1, BF
4070.             c1 = black2
4071.         ELSE
4072.             IF (osc = 4) AND (radarf = 0) THEN c1 = gray ELSE c1 = white
4073.         END IF
4074.     END IF
4075.  
4076.     IF y + 9 > glmax THEN EXIT SUB
4077.     tx = x + 1
4078.  
4079.     FOR i = 1 TO LEN(c$)
4080.         d = ASC(MID$(c$, i, 1))
4081.         FOR k = 0 TO 7
4082.             IF p2(d, k) OR (compress = 0) THEN
4083.                 IF c2 >= 0 THEN
4084.                     LINE (tx + 1, y + 2)-(tx + 1, y + t), c2, , p2(d, k)
4085.                 END IF
4086.                 LINE (tx, y + 1)-(tx, y + 9), c1, , p2(d, k)
4087.                 tx = tx + 1
4088.             END IF
4089.         NEXT k
4090.     NEXT i
4091. END SUB
4092. ' -------------------------------------------------------------------------------------------------------x
4093. SUB PrintLines (d$, i1, i2, x1, y1, c1, c2, sd, s) STATIC
4094.     ' chars, index1, index2, x,y, color 1, color 2, shadow distance,size
4095.     slant = -(c2 < -20)
4096.     FOR i = i1 TO i2 - 1
4097.         z = i \ (8 * s) + 1
4098.         IF z > LEN(d$) THEN d = 32 ELSE d = ASC(MID$(d$, z, 1))
4099.         IF d = 248 THEN d = 0 '                                       degree symbol
4100.         m& = _SHL(1, (7 - (i \ s) MOD 8))
4101.         p& = 0
4102.         FOR j = 0 TO 13
4103.             p& = p& * 2 + SGN((p(d, 13 - j) AND m&))
4104.         NEXT j
4105.         IF c2 = -99 THEN '                                            vertical
4106.             ty1 = y1 + (i - i1)
4107.             ty2 = ty1 - slant * 13
4108.             LINE (x1, ty1)-(x1 + 13, ty2), c1, , p& * 2
4109.         ELSE '                                                        horizontal
4110.             tx1 = x1 + i - i1 + 1
4111.             tx2 = tx1 + slant * 15
4112.             ty2 = y1 - 15
4113.             LINE (tx1, y1)-(tx2, ty2), c1, , p&
4114.             IF c2 >= 0 THEN LINE (tx1 + sd, y1)-(tx2 + sd, ty2), c2, , p&
4115.         END IF
4116.     NEXT i
4117. END SUB
4118. ' -------------------------------------------------------------------------------------------------------x
4119. SUB PrintVGA (z$, tx, ty, c1, c2) '                                   VGA font, 8 * 14
4120.     PrintLines z$, 0, LEN(z$) * 8 - 1, tx, ty + 13, c1, c2, 1, 1
4121. END SUB
4122. ' -------------------------------------------------------------------------------------------------------x
4123. SUB Setcolor
4124.     '          b g g r g g w g d g b o b y w
4125.     '          l r u e a y h y r o k r 2 e h
4126.     '          1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
4127.     IF bw THEN '
4128.         z$ = "070707075607070756070007565656" '                       black and white (because I can!)
4129.     ELSE
4130.         z$ = "010249042456075632380052085407" '                       color
4131.         'z$ = "010249322456075632380052085407" '                       color
4132.     END IF
4133.     FOR i = 0 TO 14
4134.         PALETTE i + 1, VAL(MID$(z$, i * 2 + 1, 2))
4135.     NEXT i
4136. END SUB
4137. ' -------------------------------------------------------------------------------------------------------x
4138. SUB Shells STATIC
4139.     FOR s = 0 TO 20 '                                                 0 element is bomb, others from IBM
4140.         IF shx(s) = 0 THEN GOTO nextshell '                           never active or already exploded
4141.         shvy(s) = shvy(s) + grav! '                                   gravity
4142.         shx(s) = shx(s) + shvx(s)
4143.         shy(s) = shy(s) + shvy(s)
4144.         tsx = shx(s) - suri
4145.         tsy = shy(s)
4146.  
4147.         IF (s > 0) AND (crash = 0) THEN
4148.             dx! = tsx - px!
4149.             dy! = (tsy - py!) * aspect!
4150.             shd(s) = SQR(dx! * dx! + dy! * dy!)
4151.             IF (invincible = 0) AND (shd(s) < 20) THEN
4152.                 dead$ = "HAL KILLED YOU"
4153.                 EXIT SUB
4154.             END IF
4155.         END IF
4156.  
4157.         IF (tsy > 0) AND (shvy(s) > 0) AND ((tsy + shvy(s)) > gety(tsx)) THEN
4158.             tsy = gety(tsx)
4159.             FOR a2 = 0 TO tsix STEP 30 '                               explode, make star
4160.                 bit = bit XOR 1 '                                     toggle
4161.                 d2 = bit * t + t / 2
4162.                 x2 = tsx + d2 * c!(a2) * aspect!
4163.                 y2 = tsy + d2 * s!(a2)
4164.                 IF a2 THEN LINE -(x2, y2), gold ELSE PSET (x2, y2), gold
4165.             NEXT a2
4166.             PAINT (tsx, tsy), gold, gold
4167.             shx(s) = 0
4168.             sia = sia - 1
4169.             IF s = 0 THEN GOSUB makecrater
4170.         ELSE '                                                        show shell
4171.             IF shvx(s) < 0 THEN ai = -30 ELSE ai = 30 '               spin
4172.             sha(s) = (sha(s) + ai + tsix) MOD tsix
4173.             ss = 3 + (s = 0) * 2
4174.             FOR i = 0 TO 1
4175.                 IF i THEN cc = red ELSE cc = gold
4176.                 a1 = (sha(s) + i * 180) MOD tsix '                     angle 1
4177.                 a2 = a1 + 150 '                                       angle 2
4178.                 ex = tsx + ss * c!(a1) * aspect! '                    1 of the endpoints
4179.                 ey = tsy + ss * s!(a1) '                              a line from an endpoint to
4180.                 FOR j = a1 TO a2 STEP t '                             each point on the half circle
4181.                     zk = j MOD tsix '                                  seemed easier than a paint
4182.                     zx = tsx + ss * c!(zk) * aspect!
4183.                     zy = tsy + ss * s!(zk)
4184.                     LINE (zx, zy)-(ex, ey), cc
4185.                 NEXT j
4186.             NEXT i
4187.         END IF
4188.         nextshell:
4189.     NEXT s
4190.     EXIT SUB
4191.  
4192.     makecrater:
4193.     dd = ABS(sf(sf, 2) - suri - tsx) '                                distance to current surface feature
4194.     IF dd < t THEN sf(sf, 2) = -1 '                                   under ten from a surface feature, kill feature
4195.  
4196.     zz = 40 '                                                         distance +- impact
4197.     r1 = RND * 40
4198.     r2 = RND * 40 + 40
4199.     FOR crx = -zz TO zz
4200.         ta = (crx * 2 + 270) MOD tsix '                                angle
4201.         tx = tsx + crx
4202.         ty = gety(tc) - r1 - r2 * s!(ta)
4203.         IF ty > glmax THEN ty = glmax
4204.         ti = ((suri + tx + q1) MOD q1)
4205.         gh(ti) = ty
4206.         IF iscd = 0 THEN PUT #6, ti + 1, ty
4207.     NEXT crx
4208.  
4209.     ti = (suri + tsx - zz - 1 + q1) MOD q1
4210.     Smooth ti
4211.     ti = (suri + tsx + zz) MOD q1
4212.     Smooth ti
4213.     RETURN
4214. END SUB
4215. ' -------------------------------------------------------------------------------------------------------x
4216. SUB ShowAngle (a)
4217.     zc = dcolor(CSNG(a), 0, 4, 1)
4218.     c = zc
4219.     IF (bbit = 0) AND (contact = 0) THEN c = black '                  blink
4220.     IF a = 0 THEN z$ = "  "
4221.     IF a > 0 THEN z$ = CHR$(17) + " " '                               point left
4222.     IF a < 0 THEN z$ = " " + CHR$(16) '                               point right
4223.     PrintVGA z$, 7, 270, c, black2
4224.     IF LEDtri THEN c = zc ELSE c = LEDc
4225.     osc = t
4226.     a$ = LTRIM$(STR$(-a))
4227.     LEDdisplay a$
4228. END SUB
4229. ' -------------------------------------------------------------------------------------------------------x
4230. SUB Surveyor STATIC
4231.     DIM SSp&(1, 26), x(1), y(1)
4232.     IF sspinit1 = 0 THEN
4233.         s& = VARSEG(SSp&(0, 0))
4234.         o& = VARPTR(SSp&(0, 0))
4235.         DEF SEG = s&
4236.         BLOAD f$(17), o& '                                            surv2.dat
4237.         sc = white
4238.         sspinit1 = 1
4239.     END IF
4240.  
4241.     x0 = x
4242.     ti = suri + x0 - 1
4243.     IF ti > q1 THEN ti = ti - q1
4244.     y0 = gh(ti)
4245.  
4246.     FOR i = 0 TO 26
4247.         tx = x0 + i
4248.         LINE (tx, y0 - 21)-(tx, y0 - 5), sc, , SSp&(0, i)
4249.         LINE (tx, y0 - 16)-(tx, y0 - 0), sc, , SSp&(1, i)
4250.     NEXT i
4251.  
4252.     '                                                                 modify ground to include Surveyor
4253.     IF (x0 >= gs) AND (x0 < 604) AND (sspinit2 = 0) THEN
4254.         FOR tx = x0 TO x0 + 32
4255.             FOR ty = y0 - 20 TO glmax
4256.                 IF POINT(tx, ty) = sc THEN
4257.                     z = (suri + tx) MOD q1
4258.                     gh(z) = ty
4259.                     EXIT FOR
4260.                 END IF
4261.             NEXT ty
4262.         NEXT tx
4263.         sspinit2 = 1
4264.     END IF
4265.  
4266.     FOR tx = x0 TO x0 + 26 '                                          optional shadow
4267.         FOR ty = y0 - 21 TO y0
4268.             p = POINT(tx, ty)
4269.             IF p = sc THEN
4270.                 zx = tx - (x0 + 13)
4271.                 zy = ty - (y0 - t)
4272.                 IF zy > (zx + 4) THEN PSET (tx, ty), gray
4273.             END IF
4274.         NEXT ty
4275.     NEXT tx
4276.  
4277.     attack = 0
4278.     sdd = q1
4279.     FOR i = 180 TO 355 STEP 5 '                                       rays
4280.         ra = i + RND * 5
4281.         z = 25 + RND * t
4282.         FOR j = 0 TO 1
4283.             x(j) = (x + t) + z * c!(ra) * aspect!
4284.             y(j) = y0 + z * s!(ra) - 1
4285.             z = z + RND * 30 + t
4286.         NEXT j
4287.         xs! = (x(1) - x(0)) / 20
4288.         ys! = (y(1) - y(0)) / 20
4289.         FOR j = 0 TO 19
4290.             tx = x(0) + j * xs!
4291.             ty = y(0) + j * ys!
4292.             x! = px! - tx
4293.             y! = (py! - ty) * aspect!
4294.             dd = SQR(x! * x! + y! * y!)
4295.             IF dd < sdd THEN sdd = dd
4296.             IF (shield = 0) OR (dd > 70) OR (j = 0) THEN PSET (tx, ty), gunmetal
4297.             IF shield AND ((dd = 70) OR ((j = 0) AND (dd < 70))) THEN
4298.                 LINE (sx0 + xoff, sy0 + vy!)-(tx, ty), lmsl
4299.                 IF RND < .7 THEN
4300.                     PSET STEP(0, 0), red
4301.                 ELSE
4302.                     LINE (tx - 1, ty)-(tx + 1, ty), red
4303.                     LINE (tx, ty - 1)-(tx, ty + 1), red
4304.                 END IF
4305.                 EXIT FOR
4306.             END IF
4307.         NEXT j
4308.         IF sdd < 20 THEN attack = 1
4309.     NEXT i
4310.     IF attack AND (crash = 0) AND (shield = 0) THEN
4311.         oldr = rads
4312.         rads = rads + RND * t + 1
4313.         IF rads > 9999 THEN rads = 9999
4314.         IF rads > oldr THEN
4315.             rtl!(0) = TIMER + 5
4316.             rtlc(0) = rads
4317.             panelinit = 0
4318.         END IF
4319.     END IF
4320. END SUB
4321. ' -------------------------------------------------------------------------------------------------------x
4322. SUB Tile STATIC
4323.     IF tinit = 0 THEN
4324.         s = 7
4325.         DIM t(1, s, s)
4326.         FOR i = 0 TO 1
4327.             FOR j = 0 TO 1
4328.                 FOR k = 0 TO 90 STEP t
4329.                     ta = k + j * 180
4330.                     tx = j * s + (s \ 2) * c!(ta)
4331.                     ty = j * s + (s \ 2) * s!(ta)
4332.                     IF i THEN ty = s - ty
4333.                     t(i, tx, ty) = 1
4334.                 NEXT k
4335.             NEXT j
4336.         NEXT i
4337.         tinit = 1
4338.     END IF
4339.  
4340.     IF gstyle = 4 THEN tc = gray ELSE tc = black2
4341.     FOR xo = gs TO q3 STEP s
4342.         FOR yo = glmax TO (glmin - 50) STEP -s
4343.             SELECT CASE tilef
4344.                 CASE IS = 0
4345.                     bp = gety(xo) + yo
4346.                     z1 = bp MOD 128
4347.                     z2 = (bp MOD 12) + 1
4348.                     td = p(z1, z2)
4349.                     kk = SGN(td AND _SHL(1, (bp MOD 8)))
4350.                 CASE IS = 1
4351.                     bp = SQR(xo * yo)
4352.                     z1 = bp MOD 128
4353.                     z2 = (bp MOD 12) + 1
4354.                     td = p(z1, z2)
4355.                     kk = SGN(td AND _SHL(1, (bp MOD 8)))
4356.                 CASE IS = 2
4357.                     kk = RND '
4358.             END SELECT
4359.             FOR i = 0 TO s
4360.                 tx = xo + i
4361.                 yy = gety(tx) + 1
4362.                 FOR j = 0 TO s
4363.                     ty = yo - j
4364.                     IF ty <= yy THEN EXIT FOR
4365.                     IF t(kk, i, j) THEN
4366.                         zz = tx + suri
4367.                         c1 = (sf(5, 2) = -1) OR (zz < sf(5, 0)) OR (zz > sf(5, 1)) '     McD
4368.                         c2 = (sf(7, 2) = -1) OR (zz < sf(7, 0)) OR (zz > sf(7, 1)) '     Surv
4369.                         IF c1 AND c2 THEN PSET (tx, ty), tc
4370.                     END IF
4371.                 NEXT j
4372.             NEXT i
4373.         NEXT yo
4374.     NEXT xo
4375. END SUB
4376. ' -------------------------------------------------------------------------------------------------------x
4377. SUB TMA STATIC
4378.     DIM tmaa!(10), tmab!(10), tmac(10)
4379.     IF ok AND (INSTR(fb$, "on TMA") > 0) THEN '                       landed, do Mandelbrot instead of moire
4380.         Mandel
4381.         GOTO tmaother
4382.     END IF
4383.     IF zdc = 0 THEN '                                                 then initialize
4384.         nc = RND * 2 + 1 '                                            use 2-3 colors
4385.         lc = -1 '                                                     last color, prevent repeats
4386.         FOR z = 0 TO nc
4387.             tmaa!(z) = RND + 4
4388.             tmab!(z) = (RND - pf!) / 8
4389.             DO
4390.                 c = RND * 14 + 1
4391.                 IF c = gray2 THEN c = gray '                          stars use gray2
4392.                 IF c = white2 THEN c = white '                        stars use white2
4393.                 IF c <> lc THEN lc = c: EXIT DO
4394.             LOOP
4395.             tmac(z) = c
4396.         NEXT z
4397.     END IF
4398.  
4399.     zdc = (zdc + 1) MOD 50
4400.     FOR z = 0 TO 2
4401.         tmaa!(z) = tmaa!(z) + tmab!(z)
4402.     NEXT z
4403.     y0 = glmax - 72
4404.     y1 = y0 + 1
4405.     y2 = glmax - 1
4406.     LINE (x, glmax)-(x + 46, glmax), gray
4407.  
4408.     FOR gx = x TO x + 45
4409.         x2! = gx / tmaa!(0)
4410.         x2! = x2! * x2!
4411.         FOR gy = y1 TO y2
4412.             y2! = gy / tmaa!(0)
4413.             y2! = y2! * y2!
4414.             tcc = ABS((x2! + y2!) / tmaa!(1)) MOD (nc + 1)
4415.             PSET (gx, gy), tmac(tcc)
4416.         NEXT gy
4417.     NEXT gx
4418.  
4419.     IF TIMER < cybilltime! THEN CybillPix f$(16) ELSE gotpix = 0
4420.  
4421.     tmaother:
4422.     IF bolthitf THEN LINE (x, y0)-(x + 45, glmax), white, BF
4423.  
4424.     FOR s = 0 TO 20 '                                                 shells
4425.         IF (shx(s) > 0) AND (shd(s) < 80) THEN
4426.             tarx = shx(s) - suri
4427.             tary = shy(s)
4428.             IF (s > 0) OR (shy(s) > 200) THEN
4429.                 GOSUB tmafl
4430.                 ExplodeShell s '                                      show it exploded
4431.             END IF
4432.         END IF
4433.     NEXT s
4434.  
4435.     FOR i = 2 TO 6 '                                                  not DS!
4436.         IF (ek(i) > 0) AND (ek(i) < 30) THEN
4437.             tarx = exl(i) '                                           where to shoot
4438.             tary = ey(i)
4439.             GOSUB tmafl '                                             fire laser
4440.             ek(i) = 0
4441.             ex(i) = 0 '                                               mark destroyed
4442.             exv(i) = 0
4443.         END IF
4444.     NEXT i
4445.     EXIT SUB
4446.  
4447.     tmafl: '                                                          fire laser
4448.     FOR gx = x TO x + 45 STEP 2 '                                     along top of TMA1
4449.         LINE (gx, y1 - 1)-(tarx, tary), blue '                        nice blue
4450.     NEXT gx
4451.     IF gotpix = 0 THEN '                                              not showing Cybill
4452.         cybilltime! = TIMER + 2 '                                     keep on screen for 2 sec
4453.         gotpix = 1 '                                                  flag onscreen
4454.     END IF
4455.     RETURN
4456. END SUB
4457. ' -------------------------------------------------------------------------------------------------------x
4458. SUB Wave STATIC '                                                     funny effect for warp speeds
4459.     tdg = (tdg MOD 4) + 1
4460.     FOR i = 1 TO 22
4461.         '               1234567890123456789012
4462.         '               TTTTHHHHHVVVVVAAAAFFFF
4463.         osc = VAL(MID$("1111222223333344445555", i, 1))
4464.         wll = VAL(MID$("45555", osc, 1))
4465.         adg = (tdg + wll) MOD 4 + 1 - (wll = 4)
4466.         z$ = MID$("agdgagdg", adg, wll)
4467.         LEDdisplay z$
4468.     NEXT i
4469. END SUB
4470. ' -------------------------------------------------------------------------------------------------------x
4471. SUB WormHole STATIC
4472.     IF eou THEN EXIT SUB '                                            end of universe
4473.  
4474.     IF ei(4) = 0 THEN
4475.         nc:
4476.         c1 = RND * 14 + 1
4477.         c2 = RND * 14 + 1
4478.         IF c1 = c2 THEN GOTO nc
4479.         IF (c1 = black2) OR (c1 = gray) THEN GOTO nc
4480.         IF (c2 = black2) OR (c2 = gray) THEN GOTO nc
4481.         ei(4) = 1
4482.     END IF
4483.  
4484.     tx = localize(ex(4), 0, 0)
4485.     wy = ey(4)
4486.     ba = (ba + 30) MOD tsix
4487.     FOR ta = 0 TO 720 STEP 2
4488.         FOR d = 0 TO 3
4489.             baa = (ta + ba + d * 90) MOD tsix
4490.             tx1 = tx + ta / 8 * c!(baa)
4491.             ty1 = wy + ta / 40 * s!(baa)
4492.             IF d MOD 2 THEN c = c1 ELSE c = c2
4493.             PSET (tx1, ty1), c
4494.         NEXT d
4495.     NEXT ta
4496. END SUB
4497. ' -------------------------------------------------------------------------------------------------------x
4498. SUB LGM (fc) STATIC '                                                 little green man
4499.  
4500.     x = x - 5
4501.     IF LGMc = gray THEN '                                             LGM toasted - show pile of ashes
4502.         y1 = gety(x + t) - 1
4503.         FOR y = 0 TO 5
4504.             LINE (x + y, y1 - y)-(x + 15 - y, y1 - y), gray
4505.             p = VAL(MID$("162341", y + 1, 1))
4506.             PSET (x + y + p, y1 - y), black2
4507.             PSET (x + y + p + 3, y1 - y), black2
4508.         NEXT y
4509.         EXIT SUB
4510.     END IF
4511.  
4512.     IF sema$ = "" THEN '                                              initialize
4513.         DIM a(28, 1) '                                                angles
4514.         RESTORE semadata
4515.         FOR i = 1 TO 28 '                                             read angles
4516.             READ z$, a(i, 0), a(i, 1)
4517.         NEXT i
4518.         DO
4519.             READ z$
4520.             IF z$ = "end" THEN EXIT DO
4521.             sema$ = sema$ + " " + z$ + " "
4522.         LOOP
4523.         lc$ = CHR$(255): i = 0 '                                      lc = last character, i = index
4524.     END IF
4525.  
4526.     IF crash THEN LGMc = dred '                                       white2 as many other colors g1
4527.     IF TIMER < sema! THEN sema! = TIMER '                             midnite crossing fix
4528.     IF (TIMER - sema!) > semat! THEN '                                signal next letter
4529.         sema! = TIMER
4530.         IF fc = 0 THEN '                                              flame count
4531.             semat! = .3
4532.             tsema$ = sema$
4533.             IF si > 0 THEN i = si - 1: si = 0
4534.         ELSE
4535.             semat! = .2 '                                             0.2 seconds between letters
4536.             IF fc < 5 THEN '                                          flame count
4537.                 IF tsema$ <> "help  " THEN tsema$ = "!"
4538.                 toast = 0
4539.             ELSE
4540.                 tsema$ = "help  "
4541.                 toast = toast + 1
4542.                 IF toast > 2 THEN toast = 0: LGMc = LGMc + 1
4543.             END IF
4544.         END IF
4545.         i = (i MOD LEN(tsema$)) + 1
4546.         p = INSTR(tsema$, "time is")
4547.         IF p THEN
4548.             z$ = MID$(TIME$, 1, 2) + MID$(TIME$, 4, 2)
4549.             MID$(tsema$, p + 8, 4) = z$
4550.         END IF
4551.         y1 = gety(x) - 14
4552.         IF demo THEN y1 = 286
4553.         c$ = MID$(tsema$, i, 1)
4554.         d = ASC(LCASE$(c$)) - 96
4555.         IF d < 1 THEN d = 27
4556.         IF c$ = "!" THEN d = 28
4557.         p = INSTR("1234567890", c$): IF p THEN d = p - (c$ = "0")
4558.         IF oscar THEN
4559.             c1 = red
4560.             c2 = gold
4561.         ELSE
4562.             c1 = blue
4563.             c2 = white
4564.         END IF
4565.         IF (c$ <> " ") AND (c$ = lc$) THEN SWAP c1, c2
4566.         lc$ = c$
4567.     END IF
4568.  
4569.     c = VAL(MID$("021412040906110015", (LGMc - 1) * 2 + 1, 2))
4570.     IF bolthitf THEN c = white
4571.     IF c = black2 THEN co = gray2 ELSE co = black2
4572.     CIRCLE (x + t, y1 - 6), 4, c '                                    head
4573.     PAINT (x + t, y1 - 6), c, c '                                     fill in head
4574.     PSET (x + 8, y1 - 7), co '                                        left eye
4575.     PSET (x + 12, y1 - 7), co '                                       right eye
4576.     LINE (x + 9, y1 - 5)-(x + 11, y1 - 5), co '                       mouth
4577.     LINE (x + 5, y1)-(x + 15, y1 + 12), c, BF '                       body
4578.     IF c = black2 THEN
4579.         CIRCLE (x + t, y1 - 6), 5, co '                               eye
4580.         LINE (x + 5, y1)-(x + 15, y1 + 12), co, B '                   body
4581.     END IF
4582.  
4583.     IF (d = 27) AND (c <> black2) AND (fc = 0) THEN '                 wiggle ears
4584.         x2 = x + 5 - bbit
4585.         x3 = x + 14 + bbit
4586.         y2 = y1 - 8 + bbit
4587.         LINE (x2, y2)-(x2 + 1, y2 + 1), c, BF
4588.         LINE (x3, y2)-(x3 + 1, y2 + 1), c, BF
4589.     END IF
4590.  
4591.     IF fc THEN '                                                      optional flame effect
4592.         IF fc > t THEN di = 4 ELSE di = t '                           flame count
4593.         FOR tx = x + 5 TO x + 15
4594.             FOR ty = y1 - 9 TO y1 + 12
4595.                 p = POINT(tx, ty)
4596.                 z = (z + 1) MOD q1
4597.                 IF p = c THEN
4598.                     tc = (ty + tx + z) MOD di
4599.                     IF tc = 0 THEN PSET (tx, ty), gold
4600.                     IF tc = 1 THEN PSET (tx, ty), black2
4601.                 END IF
4602.             NEXT ty
4603.         NEXT tx
4604.     END IF
4605.  
4606.     IF c = black2 THEN c = gray2
4607.     FOR j = 0 TO 1 '                                                  arms & flags
4608.         a1 = a(d, j) - 90
4609.         x2 = x + j * 20
4610.         x3 = x2 + 26 * COS(_D2R(a1))
4611.         y2 = y1 + 25 * SIN(_D2R(a1))
4612.         LINE (x2, y1)-(x3, y2), c '                                   arm
4613.         IF j = 0 THEN s = 1: IF INSTR("wxz", c$) THEN s = -s
4614.         IF j = 1 THEN s = -1: IF INSTR("hio89", c$) THEN s = -s
4615.         FOR q = 0 TO 3
4616.             a1 = a1 - 90 * s
4617.             x4 = x3 + t * COS(_D2R(a1))
4618.             y4 = y2 + t * SIN(_D2R(a1))
4619.             LINE -(x4, y4), gunmetal
4620.             IF q = 1 THEN
4621.                 sx = x4: sy = y4
4622.                 r! = _D2R(a1 - 45 * s)
4623.                 rx = x3 + 5 * COS(r!)
4624.                 ry = y2 + 5 * SIN(r!)
4625.             END IF
4626.             IF q = 3 THEN
4627.                 r! = _D2R(a1 - 45 * s)
4628.                 yx = x3 + 5 * COS(r!)
4629.                 yy = y2 + 5 * SIN(r!)
4630.             END IF
4631.             x3 = x4: y2 = y4
4632.         NEXT q
4633.         LINE -(sx, sy), gunmetal
4634.         PAINT (rx, ry), c1, gunmetal
4635.         PAINT (yx, yy), c2, gunmetal
4636.     NEXT j
4637.  
4638.     IF c$ = UCASE$(c$) THEN
4639.         x2 = x + 5 + SGN(INSTR("ACDHJMNOPSUV0123456789", c$)) '       letter centering
4640.         y2 = y1 + 2
4641.     ELSE
4642.         x2 = x + 6 - SGN(INSTR("ijlnv", c$)) '                        as above
4643.         y2 = y1 - SGN(INSTR("gjpqy", c$)) + 2
4644.     END IF
4645.  
4646.     IF LGMc = 4 THEN tc = gold ELSE tc = red
4647.     CALL PrintVGA(c$, x2, y2, tc, black2)
4648. END SUB
4649. ' -------------------------------------------------------------------------------------------------------x
4650. SUB Stars STATIC
4651.  
4652.     ' - starstatus  0 off, 1 on, 2+names, 3+RA & Dec & grid, 4+Mag
4653.     ' - encodes magnitude into xy array by making negative
4654.     ' - stars1 1797, stars2 16571, stars3 87470
4655.  
4656.     IF sinit = 0 THEN
4657.         sinit = 1
4658.         qq = 18000
4659.         DIM starx(qq), stary(qq), starn(30), star$(2, 50)
4660.         starmax = qq: namemax = 100
4661.         gc = blue '                                                   grid color
4662.         sc = gray2 '                                                  star info color
4663.     END IF
4664.     nh = 12 / (zoom + 1) '                                            hours (RA)
4665.     nd = 90 / (zoom + 1) '                                            degrees (Dec)
4666.  
4667.     IF eou <> 0 THEN '                                                End of Universe
4668.         alldown = 1
4669.         FOR star = 1 TO nstars
4670.             sy = stary(star)
4671.             ay = ABS(sy)
4672.             IF ay < q4 THEN '                                         less than screen bottom
4673.                 stary(star) = stary(star) + SGN(stary(star))
4674.                 alldown = 0 '                                         not done
4675.             END IF
4676.         NEXT star
4677.         IF alldown THEN CLS: EXIT SUB
4678.     END IF
4679.  
4680.     IF regen = 0 THEN CLS
4681.     tss = starstatus
4682.     IF starinit = 0 THEN
4683.         starinit = 1
4684.         eou = 0 '                                                     End of Universe
4685.         alldown = 0
4686.         nstars = 0
4687.         named = 0
4688.         rmax! = rmin + nh '                                           hours
4689.         dmax! = dmin + nd '                                           degrees
4690.         n1& = 0
4691.         isred1 = 0: isred2 = 0
4692.         rmin$ = RIGHT$("00" + LTRIM$(STR$(rmin)), 2) '                0 - 24
4693.         dmin$ = RIGHT$("000" + LTRIM$(STR$(dmin)), 3) '               -90 to 90
4694.         zz$ = LTRIM$(STR$(starfiles)) + rmin$ + dmin$ + ".dat"
4695.         IF (warp! >= 1) AND (starfiles = 2) THEN tfs = 1 ELSE tfs = starfiles
4696.         SELECT CASE tfs
4697.             CASE IS = 0
4698.                 th! = 5.07 + zoom: tf$ = "stars1.dat": d$ = ".\dat1\": nl& = 1797
4699.             CASE IS = 1
4700.                 th! = 7.07 + zoom: tf$ = "stars2.dat": d$ = ".\dat2\": nl& = 16571
4701.             CASE IS = 2
4702.                 th! = 8.07 + zoom: tf$ = "stars3.dat": d$ = ".\dat3\": nl& = 87470
4703.         END SELECT
4704.         IF okrick = 0 THEN d$ = "" '                                 ugh, all star files in same directory
4705.         tf1$ = d$ + "si" + zz$: f1$ = tf1$: f1$ = FileCheck$(f1$)
4706.         tf2$ = d$ + "sx" + zz$: f2$ = tf2$: f1$ = FileCheck$(f2$)
4707.         tf3$ = d$ + "sy" + zz$: f3$ = tf3$: f1$ = FileCheck$(f3$)
4708.         isstari = (f1$ <> "") AND (f2$ <> "") AND (f3$ <> "")
4709.         IF regen THEN isstari = 0
4710.         IF isstari THEN
4711.             GOSUB readstar
4712.             GOTO plot
4713.         END IF
4714.         regen = 0
4715.         FOR i = 0 TO qq
4716.             starx(i) = 0
4717.             stary(i) = 0
4718.         NEXT i
4719.         tf = FREEFILE
4720.         OPEN tf$ FOR INPUT AS #tf
4721.         DO
4722.             INPUT #tf, r!, d!, m!, dis$, n$
4723.             n1& = n1& + 1
4724.             IF (starfiles > -1) AND ((n1& MOD h) = 1) THEN
4725.                 zz1 = h + t '                                         hundred + 10 = 110
4726.                 zz2 = zz1 + n1& / nl& * 500
4727.                 LINE (gs, 0)-(639, 40), black, BF
4728.                 LINE (zz1, t)-(zz1 + 500, 13), red, B
4729.                 LINE (zz1, t)-(zz2, 13), red, BF
4730.                 PrintCGA "Loading stars...", 300, 14, red, black, 0
4731.                 PrintCGA tf1$, 110, 14, red, black, 0
4732.                 IF mstar > 0 THEN '                                   regenerating all starfiles, show progress
4733.                     zz2 = zz1 + mstar / 1368 * 500
4734.                     LINE (zz1, 27)-(zz1 + 500, 30), red, B
4735.                     LINE (zz1, 27)-(zz2, 30), red, BF
4736.                 END IF
4737.                 timemachine
4738.             END IF
4739.  
4740.             sa = (LEFT$(n$, 1) = "*") '                               show always (low mag)
4741.             tt! = th! '                                               temp threshold
4742.             IF ABS(d!) > 70 THEN tt! = tt! + 2
4743.             IF ABS(d!) > 80 THEN tt! = tt! + 2
4744.             abd = ABS(d!): tt! = tt! - (abd > 70) - (abd > 80)
4745.             IF sa OR (m! <= tt!) THEN '                               show always or bright
4746.                 FOR z1 = 0 TO 1 '                                     why why why?
4747.                     FOR z2 = 0 TO 1
4748.                         tr! = r! + z1 * 24
4749.                         td! = d! + z2 * 180
4750.                         IF (tr! > rmin) AND (tr! < rmax!) AND (td! > dmin) AND (td! < dmax!) THEN sr = z1: sd = z2
4751.                     NEXT z2
4752.                 NEXT z1
4753.                 tx = q3 - (r! - rmin + sr * 24) / nh * q3
4754.                 ty = q4 - (d! - dmin + sd * 180) / nd * q4
4755.                 IF (tx > 0) AND (tx < q3) AND (ty > 0) AND (ty < q4) THEN
4756.                     IF m! <= 3 THEN tx = -tx
4757.                     IF m! <= 2 THEN ty = -ty
4758.                     nstars = nstars + 1
4759.                     starx(nstars) = tx
4760.                     stary(nstars) = ty
4761.                     IF sa THEN n$ = RIGHT$(n$, LEN(n$) - 1) '         show always, remove asterisk
4762.                     IF LEN(n$) AND (sa OR (m! < 2)) AND (named < namemax) THEN
4763.                         named = named + 1
4764.                         starn(named) = nstars
4765.                         star$(0, named) = n$
4766.                         IF n$ = "Antares" THEN isred1 = nstars
4767.                         IF n$ = "Mira" THEN isred2 = nstars
4768.                         star$(1, named) = LTRIM$(STR$(m!)) + " " + dis$ ' + "P " + y$ + "L"
4769.                         star$(2, named) = LTRIM$(STR$(r!)) + " " + LTRIM$(STR$(d!))
4770.                     END IF
4771.                 END IF
4772.             END IF
4773.         LOOP UNTIL EOF(tf) OR (nstars = starmax)
4774.         CLOSE #tf
4775.     END IF
4776.  
4777.     IF isstari = 0 THEN GOSUB writestar
4778.     plot:
4779.     CLS
4780.     tss = starstatus
4781.     IF auto AND (gstyle = 0) THEN tss = 4
4782.  
4783.     IF tss > 2 THEN '                                                 optional grids
4784.         FOR i = 0 TO nh '                                             vertical lines
4785.             tx = (i / nh * q3) MOD (q3 + 1)
4786.             LINE (tx, 0)-(tx, q4), gc, , &H1111
4787.             z = rmax! - i: z = z + (z > 23) * 24 '                    optional labeling
4788.             TinyFont STR$(z), tx - 2, 0, -gc
4789.         NEXT i
4790.         z! = nd / t
4791.         FOR de! = 0 TO z! '                                           horizontal lines
4792.             ty = q4 - ((de! / z! * q4) MOD (q4 + 1))
4793.             LINE (gs, ty)-(q3, ty), gc, , &H1111
4794.             z = dmin + de! * t '                                      optional lableling
4795.             z = z + ((z > 90) - (z < -90)) * 180
4796.             z$ = STR$(z)
4797.             TinyFont z$, q3 - LEN(z$) * 4 - 2, ty + 2, -gc
4798.         NEXT de!
4799.     END IF
4800.  
4801.     FOR star = 1 TO nstars
4802.         stx = starx(star): ax = ABS(stx)
4803.         sty = stary(star): ay = ABS(sty)
4804.         IF warp! THEN
4805.             tx = ax + SGN(-vx!) * warp! * 2
4806.             IF ay < glmax THEN LINE (ax, ay)-(tx, ay), gray2
4807.             IF tx < 1 THEN tx = tx + (q3 + 1)
4808.             IF tx > q3 THEN tx = tx - (q3 + 1)
4809.             starx(star) = tx * SGN(stx + .01)
4810.         ELSE
4811.             m = 3 + (stx < 0) + (sty < 0) '                           magnitude
4812.             IF m < 3 THEN tc = white2 ELSE tc = gray2 '               slightly different brightness
4813.             IF twinkle AND (RND > .9) AND (tc = white2) THEN tc = gray2
4814.             IF star = isred1 THEN tc = red '                          Mira and Antares
4815.             IF star = isred2 THEN tc = red
4816.             IF m = 1 THEN '                                           small cross if < 2
4817.                 LINE (ax - 1, ay)-(ax + 1, ay), tc
4818.                 LINE (ax, ay - 1)-(ax, ay + 1), tc
4819.             ELSE '                                                    bright or dim point
4820.                 PSET (ax, ay), tc
4821.             END IF
4822.             ' IF (star MOD 37) = 0 THEN TinyFont STR$(star), ax, ay, sc ' diagnostic
4823.             FOR i = 1 TO named '                                      show names & info
4824.                 IF star = starn(i) THEN
4825.                     FOR j = 0 TO tss - 2
4826.                         IF j THEN
4827.                             ty = ay + j * 9 + (j = 2) * 3 + 1
4828.                             TinyFont star$(j, i), ax, ty, sc
4829.                         ELSE
4830.                             PrintCGA star$(j, i), ax, ay + j * 9, sc, -1, 1
4831.                         END IF
4832.                     NEXT j
4833.                 END IF
4834.             NEXT i
4835.         END IF
4836.     NEXT star
4837.     IF rick THEN '                                                    show counts
4838.         z$ = LTRIM$(STR$(starfiles)) + STR$(nstars) + STR$(starmax) + STR$(named) + STR$(th!)
4839.         TinyFont z$, 86, 20, red
4840.     END IF
4841.     EXIT SUB
4842.  
4843.     readstar:
4844.     tf = FREEFILE
4845.     OPEN tf1$ FOR INPUT AS #tf
4846.     INPUT #tf, nstars, named, isred1, isred2
4847.     n1 = nstars
4848.     FOR i = 1 TO named
4849.         INPUT #tf, starn(i)
4850.         FOR j = 0 TO 2
4851.             INPUT #tf, star$(j, i)
4852.         NEXT j
4853.     NEXT i
4854.     CLOSE #tf
4855.     OPEN tf2$ FOR BINARY AS #tf
4856.     GET #tf, , starx()
4857.     CLOSE #tf
4858.     OPEN tf3$ FOR BINARY AS #tf
4859.     GET #tf, , stary()
4860.     CLOSE #tf
4861.     RETURN
4862.     ' -----------------------------------------------------------------------------------
4863.     writestar:
4864.     tf = FREEFILE
4865.     OPEN tf1$ FOR OUTPUT AS #tf
4866.     PRINT #tf, nstars; ","; named; ","; isred1; ","; isred2
4867.     FOR i = 1 TO named
4868.         PRINT #tf, starn(i);
4869.         FOR j = 0 TO 2
4870.             PRINT #tf, ","; star$(j, i);
4871.         NEXT j
4872.         PRINT #tf, CHR$(13);
4873.     NEXT i
4874.     CLOSE #tf
4875.  
4876.     OPEN tf2$ FOR BINARY AS #tf
4877.     PUT #tf, , starx()
4878.     CLOSE #tf
4879.  
4880.     OPEN tf3$ FOR BINARY AS #tf
4881.     PUT #tf, , stary()
4882.     CLOSE #tf
4883.     RETURN
4884. END SUB
4885. ' -------------------------------------------------------------------------------------------------------x
4886. SUB Borg (lbx, bmy) STATIC
4887.     IF borginit = 0 THEN
4888.         z$ = SPACE$(t) + "WE ARE THE BORG - RESISTANCE IS FUTILE" + SPACE$(50)
4889.         moire = 0: moired = 1: xn = 19: yn = 8: zz = 13: p0 = &HAAAA
4890.         DIM mat$(yn)
4891.         FOR i = 1 TO yn
4892.             mat$(i) = STRING$(xn, ASC("0"))
4893.         NEXT i
4894.         borginit = 1 '                                                      direction for guts
4895.     END IF
4896.     p1 = &H5555: p2 = &HAAAA
4897.  
4898.     borgt = bmy - 40 '                                                top
4899.     borgl = lbx - 40 '                                                left side
4900.     borgr = lbx + 52 '                                                right side
4901.  
4902.     x1 = lbx - 46: y1 = bmy - 34: x2 = lbx + 46: y2 = bmy + 34
4903.  
4904.     FOR i = 0 TO zz
4905.         tx1 = x1 + i: tx2 = x2 + i: ty1 = y1 - i: ty2 = y2 - i
4906.         IF (tx1 + 2) < gs THEN SWAP p1, p2
4907.         LINE (tx1, ty1)-(tx1, ty2), black2 '                          left
4908.         LINE (tx1, ty1)-(tx1, ty2), dred, , p0
4909.         LINE (tx1 + 2, ty2)-(tx2, ty2), black2 '                      bottom
4910.         LINE (tx1 + 2, ty2)-(tx2, ty2), dred, , p1
4911.     NEXT i
4912.     FOR i = 0 TO zz
4913.         tx2 = x2 + i: ty1 = y1 - i + 2: ty2 = y2 - i
4914.         LINE (tx2, ty1)-(tx2, ty2), red '                             right
4915.         tx1 = x1 + i: tx2 = x2 + i: ty1 = y1 - i
4916.         LINE (tx1, ty1)-(tx2, ty1), red '                             top
4917.     NEXT i
4918.     LINE (x2 + 1, y1)-(x2 + zz, y1 - zz + 1), black2 '                top right diag
4919.     LINE (x1 + 1, y2)-(x1 + zz, y2 - zz + 1), black2 '                bottom left diag
4920.  
4921.     x1 = x1 + 8: y1 = y1 + 1: y2 = y2 - 8 '                           inside of craft
4922.  
4923.     LINE (x1 + 4, y1)-(x2 - 1, y2 - 4), black2, BF '                  blank interior
4924.     SELECT CASE bstyle1
4925.         CASE IS = 0 '                                                 ala Matrix
4926.             '                                                         84 60
4927.             FOR y = 0 TO yn - 1
4928.                 mat$(y) = mat$(y + 1)
4929.             NEXT y
4930.             FOR x = 1 TO xn
4931.                 MID$(mat$(yn), x, 1) = CHR$(48 + RND)
4932.             NEXT x
4933.             FOR y = 0 TO yn
4934.                 ty = y1 + y * 6
4935.                 TinyFont mat$(y), x1 + 5, ty + 1, blue
4936.             NEXT y
4937.         CASE IS = 1 '                                                 Moire
4938.             moire = moire + moired
4939.             IF ABS(moire) > t THEN moired = -moired
4940.             FOR ty = y1 TO y2
4941.                 FOR tx = x1 TO x2 - 1
4942.                     z1! = tx / (moire + 40): z1! = z1! * z1!
4943.                     z2! = ty / (moire + 40): z2! = z2! * z1!
4944.                     IF ((z1! + z2!) MOD 4) THEN
4945.                         IF ((z1! + z2!) MOD 2) THEN tc = blue ELSE tc = dred
4946.                         PSET (tx, ty), tc
4947.                     END IF
4948.                 NEXT tx
4949.             NEXT ty
4950.         CASE IS = 2 '                                                 boxes
4951.             x2 = x2 - 3: xs = x2 - x1: ys = y2 - y1
4952.             FOR z = 1 TO h
4953.                 bx1 = x1 + RND * xs + 2
4954.                 by1 = y1 + RND * ys + 2
4955.                 bx2 = bx1 + (RND - pf!) * xs / z * t + 2
4956.                 by2 = by1 + (RND - pf!) * ys / z * t + 2
4957.                 IF bx2 < x1 THEN bx2 = x1
4958.                 IF bx2 > x2 THEN bx2 = x2
4959.                 IF by2 < y1 THEN by2 = y1
4960.                 IF by2 > y2 THEN by2 = y2
4961.                 c = 1 + SGN(z MOD 2) * 12
4962.                 IF RND > .95 THEN c = gunmetal
4963.                 LINE (bx1, by1)-(bx2, by2), c, B
4964.             NEXT z
4965.     END SELECT
4966.  
4967.     FOR k = -30 TO 30 STEP 15 '                                   exhaust, 5 flames
4968.         bit = bit XOR 1 '                                         alternate
4969.         FOR i = 0 TO 20
4970.             ba1 = (ba1 + i) MOD tsix
4971.             zzz = ((20 - i) / 4) * SIN(_D2R(ba1))
4972.             ty0 = y2 + i + 8 + bit + 1
4973.             tx1 = lbx - zzz + k
4974.             tx2 = lbx + zzz + k
4975.             LINE (tx1, ty0)-(tx2, ty0), blue, , RND * &H7FFF
4976.         NEXT i
4977.     NEXT k
4978.     '                                                                 scroll Borg message along top and right side of craft
4979.     ti = (ti MOD (50 * 16)) + 8 '                                     index into text, speed 1-??
4980.     tx1 = lbx - 46 - 3
4981.     ty1 = bmy - 31
4982.  
4983.     PrintLines z$, ti, ti + 90, tx1, ty1 - 1, black2, -88, 2, 2 '     top
4984.     PrintLines z$, ti, ti + 90, tx1, ty1 - 0, white2, -88, 2, 2
4985.  
4986.     tx1 = lbx + 46 - 2: ty1 = bmy - 32 '                              right
4987.     PrintLines z$, ti + 91, ti + 91 + 67, tx1, ty1, black2, -99, 2, 2
4988.  
4989. END SUB
4990. ' -------------------------------------------------------------------------------------------------------x
4991. SUB Volcano STATIC
4992.  
4993.     IF vinit = 0 THEN
4994.         q = q3 * 2 '                                                  640*2=1280
4995.         DIM vox!(q), voy!(q), vxi!(q), vyi!(q)
4996.         vinit = 1
4997.     END IF
4998.  
4999.     vx = sf(4, 2)
5000.     IF ABS((TIMER MOD t) - (RND * t)) > 5 THEN
5001.         FOR i = 0 TO q
5002.             IF vyi!(i) < -3 THEN k! = .6 ELSE k! = .8 '               kill some
5003.             IF (vox!(i) = 0) OR (RND > k!) THEN '                     dead or kill
5004.                 vox!(i) = vx + RND * t - 5 '                          initial x
5005.                 voy!(i) = gety(INT(vox!(i) - suri)) - 1 '             initial y
5006.                 ta = RND * 40 + 70 '                                  angle
5007.                 r! = _D2R(ta)
5008.                 vxi!(i) = (RND * t + 1) * COS(r!) '                   x velocity
5009.                 vyi!(i) = (RND * t + 2) * SIN(r!) '                   y velocity
5010.             END IF
5011.         NEXT i
5012.     END IF
5013.  
5014.     FOR i = 0 TO q
5015.         tx = vox!(i) - suri '                                         local x
5016.         ty = voy!(i) '                                                local y
5017.         IF shield THEN z = 0: GOSUB protect
5018.         IF ty > q4 THEN '                                             off screen
5019.             vox!(i) = 0 '                                             flag for init
5020.         ELSE
5021.             IF (tx >= gs) AND (tx <= q3) THEN
5022.                 IF vyi!(i) < -(RND * 4) THEN
5023.                     c = gunmetal
5024.                     IF (ty > gety(tx)) AND (gstyle = 0) THEN c = black ' black on white
5025.                 ELSE
5026.                     c = orange
5027.                 END IF
5028.                 PSET (tx, ty), c
5029.                 IF i MOD 2 THEN LINE -STEP(RND * 2 - 1, RND * 2 - 1), c
5030.             END IF
5031.         END IF
5032.         vyi!(i) = vyi!(i) - .25 '                                     decelerate
5033.         vox!(i) = vox!(i) - vxi!(i) '                                 new x
5034.         voy!(i) = voy!(i) - vyi!(i) '                                 new y
5035.     NEXT i
5036.     EXIT SUB
5037.  
5038.     protect:
5039.     dx! = px! - tx '                                                  distance x
5040.     dy! = (py! - ty) * aspect! '                                      distance y
5041.     dd = SQR(dx! * dx! + dy! * dy!) '                                 distance
5042.     IF dd < 70 THEN '                                                 at shield
5043.         z = 1
5044.         vyi!(i) = 0
5045.         ty = ty - SGN(dy!)
5046.         GOTO protect
5047.     END IF
5048.     IF z THEN '                                                       laser
5049.         vxi!(i) = SGN(dx!) * (5 + RND * 5)
5050.         LINE (sx0 + xoff, sy0 + vy!)-(tx, ty), lmsl
5051.     END IF
5052.     RETURN
5053. END SUB
5054. ' -------------------------------------------------------------------------------------------------------x
5055. SUB Mandel '                                                          appears in TMA-1 when landed on
5056.     xd! = .044
5057.     yd! = .036
5058.     zz! = TIMER * 4
5059.     LINE (x, glmax - 1)-(x + 45, glmax - 71), black2, BF
5060.     FOR xx = 0 TO 23
5061.         FOR yy = 0 TO 70
5062.             MandelX! = -2 + yy * yd!
5063.             MandelY! = -1 + xx * xd!
5064.             Real# = 0
5065.             Imag# = 0
5066.             Itera = 20
5067.             DO
5068.                 Itera = Itera - 1
5069.                 hold# = Imag#
5070.                 Imag# = (Real# * Imag#) * 2 + MandelY!
5071.                 Real# = Real# * Real# - hold# * hold# + MandelX!
5072.                 Size# = (Real# * Real# + Imag# * Imag#) - 4
5073.             LOOP UNTIL (Itera = 0) OR (Size# > 0)
5074.             IF Size# > 0 THEN
5075.                 tc = (Itera + zz!) MOD 15 + 1
5076.                 ty = glmax - 71 + yy
5077.                 PSET (x + xx, ty), tc '                               left half
5078.                 PSET (x + 45 - xx, ty), tc '                          right half
5079.             END IF
5080.         NEXT yy
5081.     NEXT xx
5082. END SUB
5083. ' -------------------------------------------------------------------------------------------------------x
5084. SUB CarWash
5085.     DIM cwpat&(7)
5086.     cwpat&(0) = &HFFFF
5087.     cwpat&(1) = &H1111
5088.     cwpat&(2) = &H2222
5089.     cwpat&(3) = &H4444
5090.     cwpat&(4) = &H8888
5091.     cwpat&(5) = cwpat&(3)
5092.     cwpat&(6) = cwpat&(2)
5093.     cwpat&(7) = cwpat&(1)
5094.  
5095.     x1 = x + 1
5096.     x2 = x1 + 99
5097.     y0 = 305
5098.     IF bolthitf THEN tc = white ELSE tc = gunmetal
5099.     LINE (x, y0 - 19)-(x2, y0 - 1), tc, BF '                          sign background
5100.     PrintCGA "MONTEZUMA", x + 14, 286, orange, black2, 0
5101.  
5102.     IF bbit THEN
5103.         c1 = green
5104.         c2 = blue
5105.         c3 = green
5106.     ELSE
5107.         c1 = black2
5108.         c2 = -1
5109.         c3 = gunmetal
5110.     END IF
5111.     PrintCGA "Car Wash", x + 17, 294, c1, c2, 0
5112.     LINE (x, y0 - 19)-(x2, y0 - 1), c3, B
5113.  
5114.     IF bolthitf THEN tc = white ELSE tc = blue2
5115.     LINE (x, y0)-(x2, q4), tc, BF '                                   spray zone
5116.     LINE (x1, y0)-(x1, q4), white, , cwpat&(1) '                      left side &H1111
5117.     LINE (x2, y0)-(x2, q4), white, , cwpat&(1) '                      right side
5118.  
5119.     IF cwsi = 0 THEN cwsi = 1 '                                       spray angle increment
5120.     cwsd = cwsd + cwsi '                                              spray direction
5121.     IF (cwsd = 0) OR (cwsd = t) THEN cwsi = -cwsi '                   hit limits, reverse
5122.     FOR z = 1 TO 5
5123.         x1 = x + z * t + 24
5124.         FOR i = -4 TO 4 STEP 2
5125.             td = cwsd - 5 + i
5126.             IF z MOD 2 = 0 THEN
5127.                 td = -td
5128.                 up = 0 '                                              use pattern
5129.             ELSE
5130.                 iz = (iz + 1) MOD th
5131.                 up = iz MOD 7 + 1
5132.             END IF
5133.             ra = (90 + td * 3) MOD tsix
5134.             tx = 64 * c!(ra) * 1.1
5135.             ty = y0 + 64 * s!(ra)
5136.             LINE (x1, y0)-(x1 + tx, ty), gunmetal, , cwpat&(up) '     along top
5137.             LINE (x + 0, y0)-(x1 + tx \ 2, ty), gunmetal, , cwpat&(up) ' tl
5138.             LINE (x + h, y0)-(x1 + tx \ 2, ty), gunmetal, , cwpat&(up) ' tr
5139.             tx = x1 + 20 * c!(ra) * 1.2
5140.             ty = q4 - 20 * s!(ra) \ 2
5141.             LINE (x1, q4)-(tx, ty), white '                           bottom
5142.         NEXT i
5143.         iz = iz + 1
5144.     NEXT z
5145. END SUB
5146. ' -------------------------------------------------------------------------------------------------------x
5147. SUB DeathStar (dtx, tf$) STATIC
5148.     IF dsinit = 0 THEN
5149.         DIM tc(1)
5150.         xc = 320: yc = 175: dty = 170
5151.         IF INSTR(tf$, "rs") THEN
5152.             xs = 100: ys = 73: bs = ys + 6: rs = 4020 '               small
5153.         ELSE
5154.             xs = 130: ys = 110: bs = ys - t: rs = 8000 '              large
5155.         END IF
5156.         wx1 = xc - xs: wx2 = xc + xs
5157.         wy1 = yc - ys: wy2 = yc + ys
5158.         CLOSE #8
5159.         REDIM buff&(rs)
5160.         OPEN tf$ FOR BINARY AS #8
5161.         dsinit = 1
5162.     END IF
5163.  
5164.     IF darkstarc = 0 THEN c1 = black2: c2 = blue: c3 = blue2
5165.     IF darkstarc = 1 THEN c1 = gunmetal: c2 = red: c3 = dred
5166.     tc(0) = c2: tc(1) = c3
5167.  
5168.     CIRCLE (dtx, dty + 6), xs, black2 '                               define area
5169.     FOR z = -1 TO 1 STEP 2 '                                          circle may be barely on screen
5170.         PAINT (dtx + z * (xs - 1), dty), c1, black2 '                 far left & far right
5171.     NEXT z
5172.  
5173.     xx = dtx - xc
5174.     yy = dty - yc
5175.     zz = (zz + darkstars) MOD 49 '                                   0-48 images
5176.     rn& = zz * rs * 4 + 1
5177.     GET #8, rn&, buff&()
5178.     n = -1
5179.     FOR i = wx1 TO wx2
5180.         tx = xx + i
5181.         IF tx > q3 THEN GOTO bork
5182.         FOR j = wy1 TO wy2 STEP 15
5183.             FOR k = 0 TO 1
5184.                 n = n + 1
5185.                 IF (buff&(n) > 0) AND (tx >= gs) THEN
5186.                     LINE (tx, j)-(tx, j + 15), tc(k), , buff&(n)
5187.                     IF darkstart THEN LINE (tx, j + 1)-(tx, j + 16), tc(k), , buff&(n)
5188.                 END IF
5189.             NEXT k
5190.         NEXT j
5191.     NEXT i
5192.     bork:
5193.     GOSUB Title
5194.  
5195.     boltx = q1 '                                                      handy large value
5196.  
5197.     IF RND > .7 THEN '                                                lightning bolt
5198.         a! = 90 + (RND * 20) - t '                                    starting angle
5199.         r! = bs '                                                     starting radius
5200.         bolty = q1 '                                                  handy large value
5201.         FOR i = -h TO h '                                             -100 to 100
5202.             tx = dtx + i
5203.             ty = gety(tx)
5204.             IF ty <= bolty THEN
5205.                 IF (bolty = q1) OR (RND > .8) THEN boltx = tx
5206.                 bolty = ty
5207.             END IF
5208.         NEXT i
5209.         DO
5210.             xx = dtx + r! * COS(_D2R(a!)) * aspect!
5211.             yy = dty + r! * SIN(_D2R(a!))
5212.             IF yy > q4 THEN EXIT DO '                                 q4 = 349
5213.             a! = a! + RND * 2 - 1 + SGN(xx - boltx) * .05
5214.             r! = r! + RND * 2.18 - 1
5215.             IF r! < bs THEN r! = bs
5216.             GOSUB dot
5217.         LOOP
5218.     END IF
5219.  
5220.     nc = RND * 3 '                                                    "internal" lightning
5221.     FOR s = 0 TO nc
5222.         DO
5223.             a! = RND * tsix
5224.         LOOP UNTIL ABS(a! - 90) > 20
5225.         td = bs \ 2 + RND * bs \ 2
5226.         IF RND > .8 THEN td = RND * bs
5227.         r! = td
5228.         qq = 6
5229.         DO
5230.             xx = dtx + r! * COS(_D2R(a!)) * aspect!
5231.             yy = dty + r! * SIN(_D2R(a!))
5232.             GOSUB dot
5233.             a! = a! + RND * 2.15 - 1
5234.             r! = r! - RND * 2.18 + qq
5235.             qq = qq - 1 - (qq = 1)
5236.         LOOP UNTIL r! < td
5237.     NEXT s
5238.     EXIT SUB
5239.  
5240.     dot:
5241.     dx! = px! - xx
5242.     dy! = py! - yy
5243.     dd! = SQR(dx! * dx! + dy! * dy!)
5244.     tcc = 1 - (RND > pf!) * 14
5245.     IF (shield = 0) AND (dd! < 15) THEN bolthit = 1
5246.     IF shield AND (dd! <= 70) THEN
5247.         tcc = green
5248.         IF RND > .95 THEN LINE (sx0 + xoff, sy0 + vy!)-(xx, yy), red
5249.     END IF
5250.     PSET (xx, yy), tcc
5251.     RETURN
5252.  
5253.     Title:
5254.     IF atu = 0 THEN atu = t: ati = 1
5255.     atu = atu + ati
5256.     IF (atu = t) OR (atu = 25) THEN ati = -ati
5257.     t$ = "EPCOR"
5258.     FOR i = 1 TO LEN(t$)
5259.         z$ = MID$(t$, i, 1)
5260.         aa = -90 + (i - 3) * atu
5261.         tx = dtx + bs * COS(_D2R(aa)) * aspect! - 5
5262.         ty = dty + bs * SIN(_D2R(aa))
5263.         PrintVGA z$, tx, ty, c3, white
5264.     NEXT i
5265.     RETURN
5266. END SUB
5267. ' -------------------------------------------------------------------------------------------------------x
5268. SUB Parachute STATIC
5269.     IF contact THEN
5270.         cy! = cy! + 5
5271.         IF cy! > 500 THEN cy! = 500: chs = 1: paraf = 0
5272.         chs = chs - 1
5273.     ELSE
5274.         cy! = py! - h
5275.         IF (py! > 120) AND (chs < 40) THEN chs = chs + 2
5276.     END IF
5277.     FOR ta = 0 TO tsix
5278.         r! = _D2R(ta) / 2
5279.         tx = px! + chs * COS(r!) * 2
5280.         ty = cy! - chs * SIN(r!)
5281.         PSET (tx, ty), gray2
5282.         IF (ta / 20) MOD 2 THEN tc = red ELSE tc = white2
5283.         LINE -(tx, cy!), tc
5284.         IF (ta MOD 40) = 0 THEN LINE -(px! - ASO, cy! + 82 + ASO * t), gray2
5285.     NEXT ta
5286. END SUB
5287. ' -------------------------------------------------------------------------------------------------------x
5288. SUB Comet (comx, comy)
5289.     IF crash THEN tc = white ELSE tc = green
5290.     FOR i = 0 TO 1
5291.         CIRCLE (comx, comy), i + 1, tc, , , .78
5292.         c$ = MID$("HalleBerry", i * 5 + 1, 5)
5293.         tx = comx + t
5294.         ty = comy + i * 8
5295.         IF (tx > gs) AND (tx < 590) AND (ty > 0) AND (ty < 330) THEN PrintCGA c$, tx, ty, white2, gunmetal, 0
5296.     NEXT i
5297.     FOR ta = -t TO t STEP 5 '                                         tail, -10 to 10
5298.         zz = 50 + RND * tw '                                          vary tail length
5299.         r! = _D2R(140 + ta * 4)
5300.         x1 = comx + 3 * COS(r!) '                                     tail start
5301.         y1 = comy + 3 * SIN(r!)
5302.         r! = _D2R(140 + ta \ 2)
5303.         x2 = comx + zz * COS(r!) '                                    tail end
5304.         y2 = comy + zz * SIN(r!)
5305.         LINE (x1, y1)-(x2, y2), white2, , RND * &H7FFF
5306.     NEXT ta
5307. END SUB
5308. ' -------------------------------------------------------------------------------------------------------x
5309. SUB CybillPix (pfile$) STATIC
5310.     IF cpinit = 0 THEN
5311.         z = 1225
5312.         DIM cbuff(z)
5313.         s& = VARSEG(cbuff(0))
5314.         o& = VARPTR(cbuff(0))
5315.         DEF SEG = s&
5316.         BLOAD pfile$, o&
5317.         cpinit = 1
5318.     END IF
5319.     IF ((x + 5) >= gs) AND (x < 600) THEN PUT (x + 5, 289), cbuff(), PSET
5320. END SUB
5321. ' -------------------------------------------------------------------------------------------------------x
5322. SUB Quit
5323.     SCREEN 0, 0, 0, 0
5324.     CLS
5325.     CLOSE
5326.     IF iscd THEN SYSTEM
5327.  
5328.     OPEN settings$ FOR OUTPUT AS #1
5329.     z = auto: d$ = "auto": GOSUB pconfig '                            1 full autopilot
5330.     z = background: d$ = "panel": GOSUB pconfig '                     2 instrument panel
5331.     z = cbh: d$ = "cbh": GOSUB pconfig '                              3 constant black holes
5332.     z = demo: d$ = "skyf": GOSUB pconfig '                            4 0 off 1 all features
5333.     z = doclock: d$ = "clock": GOSUB pconfig '                        5 clock display on DS
5334.     z = invincible: d$ = "invincible": GOSUB pconfig '                6 invincible
5335.     z = jitter: d$ = "thrust": GOSUB pconfig '                        7 thrust calculation
5336.     z = LEDc: d$ = "ledc": GOSUB pconfig '                            8 LED color
5337.     z = LEDtri: d$ = "ledtri": GOSUB pconfig '                        9 LED tri-color
5338.     z = radarf: d$ = "radar": GOSUB pconfig '                         10 radar visible
5339.     z = shield: d$ = "shield": GOSUB pconfig '                        11 Star Trek!
5340.     z = showmap: d$ = "map": GOSUB pconfig '                          12 feature locations at screen top
5341.     z = starstatus: d$ = "stari": GOSUB pconfig '                     13 0off 1names 2info 3info 4grid
5342.     z = zoom: d$ = "starz": GOSUB pconfig '                           14 starfield
5343.     z = skyoff: d$ = "skys": GOSUB pconfig '                          15 sky objects
5344.     z = gstyle: d$ = "gstyle": GOSUB pconfig '                        16 ground type
5345.     z = mouseswap: d$ = "mouse": GOSUB pconfig '                      17 mouse buttons
5346.     z = porb: d$ = "porb": GOSUB pconfig '                            18 pointers or bars for instruments
5347.     z = starfiles: d$ = "stars": GOSUB pconfig '                      19 star quantity
5348.     z = mdelay: d$ = "speed": GOSUB pconfig '                         20 system speed
5349.     z = SGN(_FULLSCREEN): d$ = "fullscreen": GOSUB pconfig '          21 fullscreen
5350.  
5351.     CLOSE
5352.     SYSTEM
5353.  
5354.     pconfig:
5355.     PRINT #1, d$; ","; z
5356.     RETURN
5357. END SUB
5358. ' -------------------------------------------------------------------------------------------------------x
5359. SUB Henonp (f) STATIC
5360.  
5361.     IF henoni = 0 THEN
5362.         z = 20000
5363.         DIM tb(z)
5364.         henoni = 1
5365.     END IF
5366.  
5367.     s& = VARSEG(tb(0)) '                                              for BLOADING images
5368.     o& = VARPTR(tb(0))
5369.     DEF SEG = s&
5370.  
5371.     IF crash THEN GOTO nosp
5372.     wts = (wts + 1) MOD 3 '                                           what to show
5373.     FOR pass = 1 TO 2
5374.         FOR i = 0 TO 2
5375.             IF ((i = wts) OR (pass = 2)) AND (TIMER < rtl!(i)) THEN
5376.                 SELECT CASE i
5377.                     CASE IS = 0 '                                     radiation
5378.                         BLOAD f$(19), o& '                            rad.dat
5379.                         PUT (0, 0), tb(0), PSET
5380.                         gotblank = 0
5381.                     CASE IS = 1 '                                     thermometer
5382.                         GOSUB loadblank
5383.                         LINE (20, 28)-(26, 56), 0, BF '               shadow
5384.                         LINE (20, 26)-(24, 56), 0, BF '               erase old
5385.                         LINE (20, 26)-(24, 56), red, B '              outline
5386.                         CIRCLE (23, 60), 5, 0 '                       bulb shadow
5387.                         CIRCLE (24, 60), 5, 0 '                       bulb shadow
5388.                         CIRCLE (22, 59), 5, red '                     bulb
5389.                         PAINT (22, 59), red, red '                    bulb fill
5390.                         ty = 56 - rtlc(1) / 100 * 30 '                reading
5391.                         LINE (20, ty)-(24, 56), red, BF
5392.                     CASE IS = 2 '                                     lightning
5393.                         GOSUB loadblank
5394.                         uc = uc XOR 1
5395.                         IF uc THEN tc = yellow ELSE tc = gold
5396.                         PSET (17, 27)
5397.                         LINE -(33, 27), tc
5398.                         LINE -(24, 43), tc
5399.                         LINE -(29, 43), tc
5400.                         LINE -(16, 63), tc
5401.                         LINE -(21, 47), tc
5402.                         LINE -(13, 47), tc
5403.                         LINE -(17, 27), tc
5404.                         PAINT (22, 47), tc, tc
5405.                 END SELECT
5406.                 z = rtlc(i) '                                         0rads 1temperature 2bolts
5407.                 lf = -1
5408.                 PrepAndShowLED CSNG(z), 4, 10
5409.                 EXIT SUB
5410.             END IF
5411.         NEXT i
5412.     NEXT pass
5413.  
5414.     nosp: '                                                           no special = Henon plots
5415.     IF f <> lf THEN
5416.         tf$ = f$(f)
5417.         BLOAD tf$, o&
5418.         gotblank = 0
5419.         lf = f
5420.     END IF
5421.     hc = (hc + 1) MOD 13 '                                            h1-h5 contain 13 images each
5422.     IF crash THEN hc = 0 '                                            h6.dat only has one page
5423.     PUT (0, 0), tb(hc * 1500), PSET '                                 includes
5424.     PrepAndShowLED 0, 4, 0
5425.     EXIT SUB
5426.  
5427.     loadblank: '                                                      not really blank - has program name
5428.     IF gotblank = 0 THEN '                                               and clock/McD/speed/count box
5429.         BLOAD f$(39), o& '                                            is lanblank.dat
5430.         gotblank = 1
5431.     END IF
5432.     PUT (0, 0), tb(0), PSET
5433.     RETURN
5434. END SUB
5435. ' -------------------------------------------------------------------------------------------------------x
5436. SUB Grave (x, fb$) STATIC
5437.     tx1 = x: IF tx1 < gs THEN tx1 = gs
5438.     tx2 = x + 68: IF tx2 > q3 THEN tx2 = q3
5439.     IF tx1 >= tx2 THEN EXIT SUB
5440.     VIEW SCREEN(tx1, 300)-(tx2, q4)
5441.     IF bolthitf THEN
5442.         tc = white: tc2 = white
5443.     ELSE
5444.         tc = gray: tc2 = gasoline
5445.     END IF
5446.     LINE (x, 300)-(x + 68, q4), tc, BF
5447.     LINE (x + 2, 302)-(x + 66, 347), black2, B
5448.     FOR x1 = 0 TO 1
5449.         FOR y1 = 0 TO 1
5450.             x2 = x + x1 * 68 - 4
5451.             y2 = 300 + y1 * 42 - 1
5452.             LINE (x2, y2)-(x2 + 9, y2 + 9), tc2, BF
5453.             LINE (x2, y2)-(x2 + 9, y2 + 9), black2, B
5454.         NEXT y1
5455.     NEXT x1
5456.  
5457.     FOR z = 0 TO 1
5458.         LINE (x + z, 300 + z)-(x + 68 - z, q4 - z), tc2, B
5459.     NEXT z
5460.  
5461.     IF INSTR(fb$, "g on a ") = 0 THEN
5462.         z$ = "  JFK      R.I.P. 1917 1963"
5463.     ELSE
5464.         IF (TIMER MOD 10) < 5 THEN
5465.             z$ = "B FROST    R.I.P. 1952 2006"
5466.         ELSE
5467.             z$ = "R FROST    R.I.P. 1957 2019"
5468.         END IF
5469.     END IF
5470.  
5471.     PrintVGA LEFT$(z$, 7), x + 5, 317, black2, white2
5472.  
5473.     FOR i = 0 TO 1
5474.         d$ = MID$(z$, i * 9 + 10, 9)
5475.         c1 = black2: c2 = gasoline
5476.         FOR j = 1 TO 9
5477.             c$ = MID$(d$, j, 1)
5478.             ta = (ta + 23) MOD tsix
5479.             zz = (3 + 3 * SIN(ta * ATN(1) / 45)) * i
5480.             tx = x + (j - 2) * 6 + 12
5481.             ty = 304 + i * 24 + zz
5482.             PrintCGA c$, tx, ty, c1, c2, 0
5483.         NEXT j
5484.     NEXT i
5485.     VIEW SCREEN(gs, 0)-(q3, q4)
5486. END SUB
5487. ' -------------------------------------------------------------------------------------------------------x
5488. SUB FlagandFireworks STATIC
5489.     IF fmax = 0 THEN
5490.         fs = 60: fq = 600: fmax = fs
5491.         DIM flagb(fq)
5492.         DIM ve!(fs), ho!(fs), pe(fs), x!(fs), y!(fs), c(fs)
5493.     END IF
5494.  
5495.     IF flx = 0 THEN '                                                 initialize
5496.         z = SGN(sf(sf, 2) - (px! + suri)) '                           to plant flag opposite feature
5497.         IF z = 0 THEN z = -1 '                                        optional, prevent middle
5498.         FOR i = -1 TO 1 STEP 2 '                                      check sides
5499.             tx = px! + i * z * 22
5500.             ty = gety(-tx)
5501.             '                                                         prevent PUT beyond 580 for grave in demo mode
5502.             IF (tx < 580) AND (ABS(ty - sy1) < t) THEN
5503.                 flx = tx
5504.                 fly = ty
5505.                 rev = 0
5506.                 IF nation = 1 THEN nation = 2 ELSE nation = 1
5507.                 initfw = 0
5508.                 EXIT SUB
5509.             END IF
5510.         NEXT i
5511.         EXIT SUB
5512.     END IF
5513.  
5514.     IF liftoff THEN GOTO pflag
5515.  
5516.     IF initfw = 0 THEN '                                              fireworks launch & init
5517.         ve! = RND * 5 + 16 - lob * 8 '                                vertical velocity
5518.         ho! = RND * 5 + 2 '                                           horizontal velocity
5519.         x!(0) = px! '                                                 initial x, middle of craft
5520.         y!(0) = py! - 15 + ASO * 7 '                                  initial y, top of craft
5521.         ea = -(RND * t) '                                             explode at 0-10
5522.         IF lho! > 0 THEN ho! = -ho! '                                 reverse direction half the time
5523.         lho! = ho!
5524.         DO '                                                          launch
5525.             x!(0) = x!(0) + ho! / t '                                 t = 10
5526.             y!(0) = y!(0) - ve! / t
5527.             ve! = ve! - .1 '                                          slow down
5528.             PSET (x!(0), y!(0)), yellow '                             launch track
5529.         LOOP UNTIL ve! < ea '                                         explode
5530.         FOR i = 1 TO fmax
5531.             z = nation - 1
5532.             z = z * 6 + (i MOD (3 - z)) * 2 + 1 '                     color index
5533.             '                rewhblreye
5534.             c(i) = VAL(MID$("0415010414", z, 2)) '                    color
5535.             z! = RND * 5 + 1 '                                        velocity
5536.             ta = (i * 6) MOD tsix '                                    angle
5537.             ve!(i) = z! * c!(ta) '                                    vertical velocity
5538.             ho!(i) = z! * s!(ta) * 1.8 '                              horizontal velocity
5539.             x!(i) = x!(0) + ho!(i) * 2 + xe! '                        start of arm
5540.             y!(i) = y!(0) + ve!(i) * 2 + ye!
5541.             pe(i) = RND * 5 + t '                                     persistance of arm
5542.         NEXT i
5543.         initfw = 1 '                                                  mark initialized
5544.     END IF
5545.  
5546.     f = 1 '                                                           assume done
5547.     FOR q = 0 TO 1 '                                                  show shell exploding
5548.         FOR i = 1 TO fmax '                                           arms
5549.             IF pe(i) THEN '                                           persistance of arm
5550.                 f = 0 '                                               not done
5551.                 pe(i) = pe(i) - 1 '                                   persistance
5552.                 x!(i) = x!(i) + ho!(i)
5553.                 y!(i) = y!(i) + ve!(i)
5554.                 ve!(i) = ve!(i) + .4 '                                gravity modifies vertical
5555.                 IF RND > .1 THEN
5556.                     LINE (x!(i), y!(i))-(x!(i) + RND, y!(i) + RND), c(i), B
5557.                 END IF
5558.             END IF
5559.         NEXT i
5560.     NEXT q
5561.     IF f THEN initfw = 0 '                                            end of this one, start another
5562.  
5563.     pflag:
5564.     IF sn <> nation THEN '                                            new, or user changed it
5565.         sn = nation '                                                 save current nation
5566.         s& = VARSEG(flagb(0)) '                                       segment
5567.         o& = VARPTR(flagb(0)) '                                       offset
5568.         DEF SEG = s& '                                                set segment
5569.         BLOAD f$(19 + nation), o& '                                   load array 20=USA 21=USSR
5570.         sx = 0
5571.         rev = 0
5572.     END IF
5573.  
5574.     REDIM f2(600) '                                                   FLAG
5575.     ty = fly - 80
5576.     LINE (flx - 1, fly)-(flx - 1, ty), white '                        pole
5577.     zx = flx - rev * 71
5578.     GET (zx, ty)-(zx + 70, ty + 32), f2() '                           was flx
5579.     PUT (zx, ty), flagb(), PSET '                                     flag
5580.  
5581.     '                                                                 optional move flag to left of pole
5582.     IF (flx < px!) AND (rev = 0) AND (liftoff = 0) THEN
5583.         FOR rx = 0 TO 69
5584.             FOR ry = 0 TO 32
5585.                 p = POINT(flx + rx, ty + ry)
5586.                 PSET (flx - rx - 2, ty + ry), p
5587.             NEXT ry
5588.         NEXT rx
5589.         PUT (flx, ty), f2(), PSET '                                   restore original area
5590.         GET (flx - 71, ty)-(flx - 2, ty + 32), flagb() '              get new
5591.         rev = 1
5592.         zx = flx - 71
5593.     END IF
5594.     REDIM f2(0)
5595.  
5596.     sx = sx + t '                                                     optional unfurl flag
5597.     IF sx > 70 THEN sx = 70
5598.     IF sx < 70 THEN
5599.         IF rev THEN
5600.             LINE (zx, ty)-(zx + 71 - sx, ty + 32), 0, BF
5601.         ELSE
5602.             LINE (zx + sx, ty)-(zx + 71, ty + 32), 0, BF
5603.         END IF
5604.     END IF
5605. END SUB
5606. ' -------------------------------------------------------------------------------------------------------x
5607. SUB MakeSur
5608.     IF iscd THEN EXIT SUB
5609.     DIM z!(t), a1(t), v1(t), lz(t)
5610.     msflag = 1
5611.     VIEW
5612.     CLS
5613.     FOR gh = -2 TO 9 '                                                -2 demo, -1 flat, 0-9 rocks
5614.         z$ = "Creating surfaces" + STR$(gh + 3) + " of 12"
5615.         LINE (s, 0)-(q3, 20), 0, BF
5616.         PrintVGA z$, 320 - LEN(z$) * 4, 2, white, black
5617.         timemachine
5618.  
5619.         IF INKEY$ = CHR$(27) THEN Quit
5620.         f$ = "S" + LTRIM$(STR$(gh))
5621.         IF gh = -2 THEN f$ = "sd"
5622.         IF gh = -1 THEN f$ = "sl"
5623.         f$ = f$ + ".DAT"
5624.         CLOSE #6
5625.         OPEN f$ FOR RANDOM AS #6 LEN = 2
5626.         FOR i = 1 TO q1 '                                             6400, 10 pages
5627.             PUT #6, i, glmax
5628.         NEXT i
5629.         IF gh < 0 THEN GOTO keepflat
5630.         FOR i = 1 TO 4 '                                              make sine waves
5631.             z!(i) = RND * 36 / 550
5632.             a1(i) = RND * tsix
5633.             v1(i) = RND * gh * 2
5634.         NEXT i
5635.         FOR i = 0 TO q1
5636.             z! = 0
5637.             FOR j = 1 TO 4
5638.                 y! = v1(j) * SIN((i - a1(j)) * z!(j))
5639.                 z! = z! + y! * 4
5640.             NEXT j
5641.             IF (i > 5320) AND (i < 5560) THEN z! = z! / 4 - 40 '      make Hollywood higher
5642.             z = glmax - ABS(z!)
5643.             IF z < glmin THEN z = glmin
5644.             PUT #6, i + 1, z
5645.         NEXT i
5646.         Smooth 5319
5647.         Smooth 5559
5648.         keepflat:
5649.         IF gh = -2 THEN tz = 3130 ELSE tz = 2240
5650.         FOR i = -51 TO 51 '                                           volcano
5651.             z = glmax - (51 - ABS(i))
5652.             PUT #6, tz + i, z
5653.         NEXT i
5654.         Smooth 2240 - 50
5655.         Smooth 2240 + 50
5656.         z = 302
5657.         FOR i = -5 TO 5 '                                             volcano top
5658.             PUT #6, tz + i, z
5659.         NEXT i
5660.         IF gh > -1 THEN '                                             ground height not flat, add rocks/small craters
5661.             FOR i = -1 TO 1 STEP 2 '                                  up or down
5662.                 rocks = RND * h + h '                                 rocks & indentations
5663.                 FOR j = 1 TO rocks
5664.                     rx = RND * 6380 + t
5665.                     zz = RND * 4 + 1
5666.                     FOR k = -zz TO zz
5667.                         GET #6, rx + k, z
5668.                         z = z - zz * i + ABS(k) * i
5669.                         IF z < glmin THEN z = glmin
5670.                         IF z > glmax THEN z = glmax
5671.                         PUT #6, rx + k, z
5672.                     NEXT k
5673.                 NEXT j
5674.             NEXT i
5675.         END IF
5676.         Smooth q1 - 1 '                                               6399 - 0 transition
5677.  
5678.         FOR i = 1 TO t '                                              create landing zones
5679.             IF gh = -2 THEN '                                         compress onto 1 page
5680.                 lz(i) = 3050 + (i - 1) * 80
5681.             ELSE
5682.                 lz(i) = 320 + (i - 1) * (q3 + 1) '                    1 per page
5683.             END IF
5684.         NEXT i
5685.         IF gh = -2 THEN '                                             demo terrain
5686.             SWAP lz(9), lz(t) '                                       move grave 1 page left
5687.             SWAP lz(2), lz(4) '                                       move car wash 2 pages right
5688.         END IF
5689.  
5690.         hs = 0
5691.         RESTORE features
5692.         FOR i = 1 TO t '                                              10 features, create landing zones beside each
5693.             READ z$, x, y, lz
5694.             sf(i, 0) = lz(i) - x \ 2 '                                start
5695.             sf(i, 1) = sf(i, 0) + x '                                 end
5696.             sf(i, 2) = (sf(i, 0) + sf(i, 1)) \ 2 '                    middle
5697.             IF i = 4 THEN GOTO isvolcano
5698.             FOR x2 = -lz TO lz
5699.                 z = hs * (y = 0) * (i <> 5)
5700.                 IF i = 3 THEN z = 40 '                                LGM
5701.                 IF i = 4 THEN z = 50 - ABS(x2) / 2
5702.                 IF gh <> -2 THEN
5703.                     z = glmax - z
5704.                     PUT #6, sf(i, 2) + x2, z
5705.                 END IF
5706.             NEXT x2
5707.             FOR x2 = sf(i, 0) TO sf(i, 1) '                           target
5708.                 GET #6, x2 + 1, z
5709.                 z = z + y * (y <> 0)
5710.                 PUT #6, x2 + 1, z
5711.             NEXT x2
5712.             IF gh <> -2 THEN
5713.                 Smooth sf(i, 2) - lz
5714.                 Smooth sf(i, 2) + lz
5715.             END IF
5716.             isvolcano:
5717.         NEXT i
5718.  
5719.         Smooth sf(1, 0) '                                             Area 51
5720.         Smooth sf(1, 1)
5721.  
5722.         RESTORE BigM '                                                McDonalds
5723.         y = 0
5724.         DO
5725.             READ z$
5726.             IF z$ = "x" THEN EXIT DO
5727.             y = y + 1
5728.             FOR x = 1 TO LEN(z$)
5729.                 IF MID$(z$, x, 1) = "X" THEN
5730.                     z = glmax + y - 38
5731.                     PUT #6, sf(5, 0) + x + 1, z
5732.                 END IF
5733.             NEXT x
5734.         LOOP
5735.  
5736.         suri = 0
5737.         FOR i = 1 TO q1 '                                             optional, show progress
5738.             GET #6, i + 1, y
5739.             y = gh * 25 + y / 6 + 20
5740.             PSET (i \ t, y), 1
5741.         NEXT i
5742.     NEXT gh
5743.     msflag = 0
5744. END SUB
5745. ' -------------------------------------------------------------------------------------------------------x
5746. SUB Area51 (tf$) STATIC
5747.     IF a51i = 0 THEN
5748.         pi! = _D2R(180)
5749.         zz! = ATN(1) / 45 * 3
5750.         ac1 = red
5751.         ac2 = white2
5752.         fc$ = "0105030709101412"
5753.         a51i = 1
5754.     END IF
5755.  
5756.     IF bolthitf THEN GOTO aother
5757.  
5758.     tx = x + 33
5759.     FOR i = 20 TO h STEP 5
5760.         z = (z + 2) MOD 45
5761.         FOR j = 0 TO 1
5762.             SWAP ac1, ac2
5763.             FOR k = 0 TO 3
5764.                 aa = k * 45 + z
5765.                 a1! = _D2R(aa) - zz!
5766.                 a2! = _D2R(aa) + zz!
5767.                 IF j THEN
5768.                     a1! = pi! - a1!
5769.                     a2! = pi! - a2!
5770.                 END IF
5771.                 IF a1! < 0 THEN a1! = 0
5772.                 IF a2! < 0 THEN a2! = 0
5773.                 IF a2! < a1! THEN SWAP a1!, a2!
5774.                 CIRCLE (tx, 308), i, ac1, a1!, a2!
5775.             NEXT k
5776.         NEXT j
5777.     NEXT i
5778.  
5779.     IF invincible THEN GOTO aother
5780.     dx! = px! - tx
5781.     dy! = 280 - py!
5782.     IF (ABS(dx!) < 81) AND (ABS(dy!) < 61) AND (liftoff = 0) THEN
5783.         IF contact = 0 THEN mes$(1) = "AREA 51 ELEVATOR ACTIVATED"
5784.         _DELAY .1
5785.         FOR tx2 = sx1 TO sx2 STEP 1
5786.             LINE (tx2, sy1 + 2)-(tx, 309), gray
5787.         NEXT tx2
5788.         IF sy1 > 310 THEN
5789.             LINE (sx1 - 1, sy1 + 2)-(tx, 309), black
5790.             LINE (sx2 + 1, sy1 + 2)-(tx, 309), black
5791.         END IF
5792.         px! = px! - SGN(dx!)
5793.         IF ABS(dx!) < 2 THEN
5794.             IF py! > 280 THEN j = 0 ELSE j = 2
5795.         ELSE
5796.             IF py! > 280 THEN j = -2 ELSE j = 1
5797.         END IF
5798.         py! = py! + j
5799.         a = 0
5800.         thrust! = 0
5801.         vx! = 0
5802.         vy! = 0
5803.         b2b = 1
5804.         GOTO bingo
5805.     END IF
5806.  
5807.     aother:
5808.     IF bb2! = 0 THEN bb2! = TIMER + 2
5809.     IF TIMER > bb2! THEN
5810.         bb2! = TIMER + 2
5811.         b2b = 1 - b2b
5812.     END IF
5813.  
5814.     bingo:
5815.     IF contact THEN b2b = 1
5816.     IF b2b THEN
5817.         IF bolthitf THEN tc = white ELSE tc = dred
5818.         FOR i = 1 TO 4
5819.             tx = x + i * t + 3
5820.             PrintVGA MID$("AREA", i, 1), tx, 313, white2, tc
5821.         NEXT i
5822.         FOR nu = 0 TO 1
5823.             FOR ty = 0 TO 4
5824.                 bp = VAL("&H" + MID$("26227E8E2E", nu * 5 + ty + 1, 1))
5825.                 sp = 1
5826.                 FOR tx = 1 TO 4
5827.                     IF bp AND 1 THEN
5828.                         tx2 = x + 52 - tx * 4 - nu * 16
5829.                         ty2 = 309 + ty * 5 + 15
5830.                         LINE (tx2, ty2)-STEP(3, 4), tc, BF
5831.                         IF sp THEN sp = 0: LINE (tx2 + 4, ty2)-STEP(0, 4), white2
5832.                     END IF
5833.                     bp = bp \ 2
5834.                 NEXT tx
5835.             NEXT ty
5836.         NEXT nu
5837.     ELSE
5838.         OPEN tf$ FOR INPUT AS #5 '                                    alien.dat (head)
5839.         zc = (zc + 1) MOD 8 '                                         color
5840.         FOR i = 1 TO 32
5841.             LINE INPUT #5, z$
5842.             FOR j = 1 TO LEN(z$)
5843.                 c$ = MID$(z$, j, 1)
5844.                 IF c$ <> "." THEN '                                   . = transparent
5845.                     IF c$ = " " THEN
5846.                         tc = VAL(MID$(fc$, zc * 2 + 1, 2))
5847.                         IF bolthitf THEN tc = white
5848.                     ELSEIF c$ = "r" THEN '                            spooky eyes
5849.                         tc = red
5850.                     ELSE
5851.                         tc = black2 '                                 eyes/nose/mouth
5852.                     END IF
5853.                     x2 = x + j + t
5854.                     y2 = 312 + i
5855.                     PSET (x2, y2), tc
5856.                 END IF
5857.             NEXT j
5858.         NEXT i
5859.         CLOSE #5
5860.     END IF
5861. END SUB
5862. ' -------------------------------------------------------------------------------------------------------x
5863. SUB UFO (tx0, ty0, txi) STATIC '                                      so pathetic a graphic that it's funny, maybe
5864.     aa = (aa + 5) MOD tsix
5865.     tx = tx0 + t * COS(_D2R(aa))
5866.     ty = ty0 + t * SIN(_D2R(aa))
5867.     FOR i = 0 TO 55
5868.         CIRCLE (tx, ty), i, gunmetal, , , .15
5869.     NEXT i
5870.     FOR i = 8 TO 15
5871.         IF i MOD 2 THEN tc = orange ELSE tc = black2
5872.         CIRCLE (tx, ty - 12), i, tc, , , .35
5873.     NEXT i
5874.     tc = VAL(MID$("020414", (ty MOD 3) * 2 + 1, 2))
5875.     p = (p + 1) MOD 5
5876.     IF txi < 0 THEN tp = 4 - p ELSE tp = p
5877.     FOR z = -2 TO 2
5878.         tx2 = tx + z * 16
5879.         CIRCLE (tx2, ty), 5 - ABS(z), black2, , , .7
5880.         IF tp = (z + 2) THEN tc2 = tc ELSE tc2 = black2
5881.         PAINT (tx2, ty), tc2, black2
5882.         CIRCLE (tx2, ty), 5 - ABS(z), tc2, , , .7
5883.     NEXT z
5884.     LINE (tx - 30, ty + 8)-(tx - 35, ty + 20), orange '               legs
5885.     LINE (tx - 37, ty + 20)-(tx - 31, ty + 20), orange
5886.     LINE (tx + 30, ty + 8)-(tx + 35, ty + 20), orange '               pads
5887.     LINE (tx + 32, ty + 20)-(tx + 38, ty + 20), orange
5888. END SUB
5889. ' -------------------------------------------------------------------------------------------------------x
5890. SUB TinyFont (d$, tx, ty, tc) STATIC '                                3*5
5891.     IF fontinit = 0 THEN '                                            initialize
5892.         DIM sp(13, 4)
5893.         RESTORE tinyfontd
5894.         FOR n = 0 TO 13
5895.             READ g$
5896.             FOR i = 0 TO 4
5897.                 READ z
5898.                 sp(n, i) = z * 4096
5899.             NEXT i
5900.         NEXT n
5901.         fontinit = 1
5902.     END IF
5903.  
5904.     FOR z = 1 TO LEN(d$)
5905.         z$ = MID$(d$, z, 1)
5906.         zz = INSTR(".-: ", z$)
5907.         IF zz THEN d = zz + 9 ELSE d = VAL(z$)
5908.         IF (tc = 1) AND (RND > .9) THEN ttc = 3 ELSE ttc = tc '       Borg effect (some bright)
5909.         FOR i = 0 TO 4
5910.             x2 = tx + z * 4 + j - 4
5911.             LINE (x2, ty + i)-(x2 + 4, ty + i), ABS(ttc), , sp(d, i)
5912.         NEXT i
5913.     NEXT z
5914. END SUB
5915. ' -------------------------------------------------------------------------------------------------------x
5916. SUB GraphSpeed STATIC
5917.     IF speedi = 0 THEN
5918.         spq = t: psp = 500
5919.         DIM spt!(spq)
5920.         DIM pspeed(psp)
5921.         DIM m(3) AS _MEM
5922.         m(0) = _MEM(spt!(0))
5923.         m(1) = _MEM(spt!(1))
5924.         m(2) = _MEM(pspeed(0))
5925.         m(3) = _MEM(pspeed(1))
5926.         speedi = 1
5927.     END IF
5928.  
5929.     IF spt! = 0 THEN
5930.         spt! = TIMER
5931.         zmin! = h
5932.         zran! = 2
5933.         sphac = psp + 1
5934.     ELSE
5935.         _MEMCOPY m(1), m(1).OFFSET, 4 * spq TO m(0), m(0).OFFSET
5936.         _MEMCOPY m(3), m(3).OFFSET, 2 * psp TO m(2), m(2).OFFSET
5937.  
5938.         IF spt! > TIMER THEN spt! = TIMER
5939.         spt!(spq) = (TIMER - spt!) * h * t
5940.         spt! = TIMER
5941.         z! = 0
5942.         FOR i = 1 TO spq
5943.             z! = z! + spt!(i)
5944.         NEXT i
5945.         pspeed(psp) = z! / spq
5946.         spmin = q1: spmax = -spmin
5947.         sphac = sphac - 1 - (sphac = 0)
5948.  
5949.         IF rick = 0 THEN EXIT SUB
5950.  
5951.         FOR i = sphac TO psp
5952.             spx = 113 + i
5953.             spy = zmin! + (pspeed(i) - zmin!) / zran!
5954.             IF i = sphac THEN
5955.                 PSET (spx, spy), orange
5956.             ELSE
5957.                 LINE -(spx, spy), orange
5958.             END IF
5959.             IF pspeed(i) <= spmin THEN spmin = pspeed(i): spminx = spx: spminy = spy
5960.             IF pspeed(i) >= spmax THEN spmax = pspeed(i): spmaxx = spx: spmaxy = spy
5961.         NEXT i
5962.  
5963.         spsta = FIX(spmin / h) * h
5964.         spend = INT(spmax / h + pf!) * h
5965.         spend = spend - (spend = spsta) * h
5966.         FOR i = spsta TO spend STEP h
5967.             spy = zmin! + (i - zmin!) / zran!
5968.             LINE (110, spy)-(614, spy), green, , &H1111
5969.             z$ = RIGHT$("  " + STR$(i), 4)
5970.             TinyFont z$, 87, spy - 2, orange
5971.             TinyFont z$, 620, spy - 2, orange
5972.         NEXT i
5973.  
5974.         z$ = LTRIM$(STR$(spmin))
5975.         ty = spminy - 15
5976.         TinyFont z$, spminx + 5, ty, orange
5977.         LINE (spminx, ty + 5)-(spminx, ty - 5), orange
5978.  
5979.         z$ = LTRIM$(STR$(spmax))
5980.         ty = spmaxy + 15
5981.         IF ty > q4 THEN ty = q4 - 20
5982.         TinyFont z$, spmaxx + 5, ty, orange
5983.         LINE (spmaxx, ty)-(spmaxx, ty + t), orange
5984.     END IF
5985. END SUB
5986. ' -------------------------------------------------------------------------------------------------------x
5987. SUB Smooth (p1)
5988.     p2 = p1 + 1
5989.     zz = t
5990.     i1 = (p1 - zz + q1) MOD q1
5991.     i2 = (p2 + zz + q1) MOD q1
5992.     IF msflag THEN '                                                  making surfaces, array not valid
5993.         GET #6, i1 + 1, y1
5994.         GET #6, i2 + 1, y2
5995.     ELSE
5996.         y1 = gh(i1)
5997.         y2 = gh(i2)
5998.     END IF
5999.     m! = (y1 + y2) / 2
6000.     d! = (y1 - y2) / zz / 2
6001.     FOR x = 1 TO zz
6002.         s! = d! * (zz - x)
6003.         i1 = (p2 + zz - x + q1) MOD q1
6004.         i2 = (p1 - zz + x + q1) MOD q1
6005.         gh(i1) = m! - s!
6006.         gh(i2) = m! + s!
6007.         IF iscd = 0 THEN
6008.             PUT #6, i1 + 1, gh(i1)
6009.             PUT #6, i2 + 1, gh(i2)
6010.         END IF
6011.     NEXT x
6012. END SUB
6013. ' -------------------------------------------------------------------------------------------------------x
6014. SUB SaveImage (f$) '                                                  this sub from qb64.org website (modified)
6015.     IF iscd THEN EXIT SUB
6016.     VIEW SCREEN(0, 0)-(q3, q4)
6017.     bpp& = 8
6018.     tx& = 640
6019.     ty& = 350
6020.     '       XXXX   1XXXX
6021.     '     12345678901234
6022.     b$ = "BM????_RGF????" + MKL$(40) + MKL$(tx&) + MKL$(ty&) + MKI$(1) + MKI$(bpp&) + MKL$(0) + "????" + STRING$(16, 0) 'partial BMP header info(???? to be filled later)
6023.     FOR c& = 0 TO 255 '                                               read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
6024.         cv& = _PALETTECOLOR(c&, 0) '                                  color attribute to read
6025.         b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
6026.     NEXT
6027.     MID$(b$, 11, 4) = MKL$(LEN(b$)) '                                 image pixel data offset (BMP header)
6028.     IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
6029.     FOR py& = ty& - 1 TO 0 STEP -1
6030.         z$ = ""
6031.         FOR px& = 0 TO tx& - 1
6032.             c& = POINT(px&, py&) '                                    2 bit values are large LONG values
6033.             z$ = z$ + CHR$(ABS(c&) MOD 256)
6034.         NEXT px&
6035.         d$ = d$ + z$ + padder$
6036.     NEXT py&
6037.     MID$(b$, 35, 4) = MKL$(LEN(d$)) '                                 image size (BMP header)
6038.     b$ = b$ + d$ '                                                    total file data bytes to create file
6039.     MID$(b$, 3, 4) = MKL$(LEN(b$)) '                                  size of data file (BMP header)
6040.     f& = FREEFILE
6041.     OPEN f$ FOR OUTPUT AS #f&: CLOSE #f& '                            erases an existing file
6042.     OPEN f$ FOR BINARY AS #f&
6043.     PUT #f&, , b$
6044.     CLOSE #f&
6045.     VIEW SCREEN(gs, 0)-(q3, q4)
6046. END SUB
6047. ' -------------------------------------------------------------------------------------------------------x
6048. SUB MakeStarFiles '                                                   takes a LONG time
6049.     IF iscd THEN EXIT SUB
6050.     savestarfiles = starfiles
6051.     ts$ = TIME$
6052.     mstar = 0
6053.     FOR starfiles = 0 TO 2
6054.         FOR rmin = 0 TO 23
6055.             FOR dmin = -90 TO 90 STEP 10
6056.                 mstar = mstar + 1 '                                   for progress bar
6057.                 starinit = 0
6058.                 regen = 1
6059.                 Stars
6060.                 IF INKEY$ = CHR$(27) THEN SYSTEM '                    Esc aborts
6061.             NEXT dmin
6062.         NEXT rmin
6063.     NEXT starfiles
6064.     mstar = 0
6065.     sprint ts$, 200, 100, red, black
6066.     sprint TIME$, 200, 120, red, black
6067.     timemachine
6068.     SLEEP '                                                           lets user see how LONG it took
6069.     starfiles = savestarfiles: starinit = 0: rmin = 0: dmin = 0
6070. END SUB
6071. ' -------------------------------------------------------------------------------------------------------x
6072. SUB dissolve STATIC '                                                 called with }
6073.     DIM Buffer AS _MEM
6074.     Buffer = _MEMIMAGE(0)
6075.     np = 0
6076.     DO
6077.         FOR y = _HEIGHT - 8 TO 0 STEP -1
6078.             FOR x = 0 TO _WIDTH
6079.                 f& = y * _WIDTH + x
6080.                 t& = f& + INT(RND * 2 + 4) * _WIDTH
6081.                 d = _MEMGET(Buffer, Buffer.OFFSET + f&, _UNSIGNED _BYTE)
6082.                 _MEMPUT Buffer, Buffer.OFFSET + t&, d AS _UNSIGNED _BYTE
6083.             NEXT x
6084.         NEXT y
6085.         IF np = 0 THEN
6086.             FOR x = 0 TO _WIDTH * 4
6087.                 _MEMPUT Buffer, Buffer.OFFSET + x, 0 AS _UNSIGNED _BYTE
6088.                 o2& = _WIDTH * _HEIGHT - 1 - x
6089.                 _MEMPUT Buffer, Buffer.OFFSET + o2&, 0 AS _UNSIGNED _BYTE
6090.             NEXT x
6091.         END IF
6092.         timemachine
6093.         np = np + 1
6094.         IF INKEY$ = CHR$(27) THEN SYSTEM
6095.     LOOP UNTIL np > 120
6096.     _MEMFREE Buffer
6097. END SUB
6098. ' -------------------------------------------------------------------------------------------------------x
6099. SUB timemachine '                                                     xlate to 32 bit color for green screen, warp effects
6100.     DIM oc&(15)
6101.     FOR i = 0 TO 15
6102.         OUT &H3C7, i
6103.         tred = INP(&H3C9) * 4: tgrn = INP(&H3C9) * 4: tblu = INP(&H3C9) * 4
6104.         coav = (tred + tgrn + tblu) \ 3
6105.         IF cpal = 0 THEN
6106.             oc&(i) = _RGB32(tred, tgrn, tblu) '                       regular color
6107.         ELSEIF cpal = 1 THEN
6108.             oc&(i) = _RGB32(0, coav, 0) '                             shades of green
6109.         ELSEIF cpal = 2 THEN
6110.             oc&(i) = _RGB32(coav, coav \ 2, 0) '                      shades of orange
6111.         ELSE
6112.             oc&(i) = _RGB32(coav, coav, coav) '                       black and white
6113.         END IF
6114.     NEXT i
6115.  
6116.     DIM m AS _MEM
6117.     m = _MEMIMAGE(canvas&)
6118.     DO: _LIMIT q4 '                                                   349 (h/100 too little, slows down program!)
6119.         tempimage& = _NEWIMAGE(640, 350, 32)
6120.     LOOP UNTIL tempimage& < -1 '                                      try until valid (can fail to make screen)
6121.     SCREEN tempimage&
6122.     FOR y = 0 TO q4 '                                                 replot each pixel of old to new screen
6123.         FOR x = 0 TO q3
6124.             a& = y * 640 + x
6125.             dd = _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE)
6126.             PSET (x, y), oc&(dd)
6127.         NEXT x
6128.     NEXT y
6129.     IF (LEN(dead$) = 0) AND (warp! >= 1) THEN
6130.         VIEW SCREEN(gs, SGN(LEN(mes$(0))) * 20)-(q3, q4) '            protect instrument panel, top line if message active
6131.         IF warp! >= 9 THEN contour ELSE warpx
6132.         VIEW SCREEN(gs, 0)-(q3, q4) '                                 back to normal, only instrument panel protected
6133.     END IF
6134.  
6135.     IF (rdtime! > 0) AND (TIMER < rdtime!) AND _FILEEXISTS("rick.jpg") THEN
6136.         i& = _LOADIMAGE("rick.jpg") '                                 87 * 93 pix of author
6137.         IF i& < -1 THEN
6138.             tx = _WIDTH - 87
6139.             _PUTIMAGE (tx, 0)-(tx + 87, 93), i&, 0
6140.             _FREEIMAGE i&
6141.             _PRINTSTRING (tx + 24, 100), "What?"
6142.         END IF
6143.     END IF
6144.  
6145.     IF starship AND _FILEEXISTS("starship.jpg") THEN
6146.         IF shipi& = 0 THEN shipi& = _LOADIMAGE("starship.jpg") '      296 * 91
6147.         shipx = shipx + 4
6148.         ty1 = py! - 50: ty2 = ty1 + 91
6149.         shipo = shipx - 100
6150.         q = 2
6151.         gs = 0
6152.         IF shipi& < -1 THEN _PUTIMAGE (shipo, ty1 \ q)-(shipo + 296 \ q, ty2 \ q), shipi&, 0
6153.         IF shipx > 750 THEN shipx = 0: starship = 0
6154.     END IF
6155.  
6156.     _DISPLAY '                                                        show new image
6157.     SCREEN canvas& '                                                  back to old mode so the rest of the program can run
6158.     _MEMFREE m '                                                      would run out of memory otherwise
6159.     _FREEIMAGE tempimage&
6160.  
6161. END SUB
6162. ' -------------------------------------------------------------------------------------------------------x
6163. SUB warpx STATIC
6164.     wa1 = (wa1 + 5) MOD tsix
6165.     wa2 = wa1
6166.     wx! = 320 + 70 * s!(wa1)
6167.     wy! = 175 + 70 * c!(wa1)
6168.     wc1 = 200
6169.     FOR wd1 = 64 TO 600 STEP 8
6170.         wa2 = wa2 + 2
6171.         wc1 = (wc1 + 27) MOD 512
6172.         wc2 = ABS(wc1 - 256)
6173.         wc& = _RGB32(wc2, 1, 1)
6174.         wd2 = 20 * s!((ABS(wa1 - 256) * 5) MOD tsix)
6175.         wd3 = wd1 + wd2
6176.         FOR z = 0 TO 4
6177.             wde = (wa2 + 90 * z) MOD tsix
6178.             wtx = wx! + wd3 * s!(wde)
6179.             wty = wy! + wd3 * c!(wde)
6180.             IF z = 0 THEN PSET (wtx, wty), wc& ELSE LINE -(wtx, wty), wc&
6181.         NEXT z
6182.     NEXT wd1
6183. END SUB
6184. ' -------------------------------------------------------------------------------------------------------x
6185. SUB contour STATIC
6186.     wa1 = (wa1 + 5) MOD tsix
6187.     wx! = 320 + 70 * s!(wa1)
6188.     wy! = 175 + 70 * c!(wa1)
6189.     DIM distance(360), elevation(360), active(10), angle(10)
6190.     e0 = 320
6191.     n = 6: GOSUB genang
6192.     FOR i = 1 TO n
6193.         angle = angle(i)
6194.         angle = (angle + tsix) MOD tsix
6195.         active(i) = angle
6196.         distance(angle) = 50 + RND * 150
6197.         elevation(angle) = 100 + RND * 150
6198.     NEXT i
6199.     n = n + 1
6200.     active(n) = active(1)
6201.     distance(active(n)) = distance(active(1))
6202.     elevation(active(n)) = elevation(active(1))
6203.     FOR i = 1 TO n
6204.         angle1 = active(i - 1)
6205.         angle2 = active(i)
6206.         ddif! = distance(angle2) - distance(angle1)
6207.         edif! = elevation(angle2) - elevation(angle1)
6208.         IF i = n THEN angle2 = angle2 + tsix
6209.         a! = 0: ai! = 90 / (angle2 - angle1)
6210.         FOR z = INT(angle1) TO angle2
6211.             na = z MOD tsix
6212.             a! = a! + ai!
6213.             z! = s!(a!) * s!(a!)
6214.             distance(na) = distance(angle1) + ddif! * z!
6215.             elevation(na) = elevation(angle1) + edif! * z!
6216.         NEXT z
6217.     NEXT i
6218.     FOR el = -200 TO 220
6219.         zz = 155 * s!((ABS(el) * 3) MOD tsix) + 100
6220.         bb = bb XOR 1
6221.         IF bb THEN c& = _RGB32(0, 0, zz) ELSE c& = _RGB32(zz, 0, 0)
6222.         FOR mangle = 0 TO tsix
6223.             angle = mangle MOD tsix
6224.             distance = distance(angle)
6225.             elevation = elevation(angle)
6226.             epf! = distance / (e0 - elevation)
6227.             d! = distance - ((el - elevation) * epf!)
6228.             tx = px! + d! * c!(angle)
6229.             ty = py! - d! * s!(angle)
6230.             IF mangle THEN LINE -(tx, ty), c& ELSE PSET (tx, ty), c&
6231.         NEXT mangle
6232.     NEXT el
6233.     EXIT SUB
6234.  
6235.     genang:
6236.     zz = 420 / n
6237.     FOR i = 2 TO n
6238.         ta = (i - 2) * zz + INT(RND * 10) - 5 + 30
6239.         angle(i) = INT(ta MOD tsix)
6240.     NEXT i
6241.     sort:
6242.     sorted = 1
6243.     FOR i = 1 TO n - 1
6244.         a1 = angle(i)
6245.         a2 = angle(i + 1)
6246.         IF a1 > a2 THEN sorted = 0: SWAP angle(i), angle(i + 1)
6247.     NEXT i
6248.     IF sorted = 0 THEN GOTO sort
6249.     FOR i = 1 TO n - 1
6250.         a1 = angle(i)
6251.         a2 = angle(i + 1)
6252.         IF (a2 - a1) < 20 THEN GOTO genang
6253.     NEXT i
6254.     RETURN
6255. END SUB
6256. ' -------------------------------------------------------------------------------------------------------x
6257. FUNCTION FileCheck$ (f$)
6258.     i = 0
6259.     IF _FILEEXISTS(LCASE$(f$)) THEN f$ = LCASE$(f$): i = 1
6260.     IF _FILEEXISTS(UCASE$(f$)) THEN f$ = UCASE$(f$): i = 1
6261.     IF i = 0 THEN f$ = ""
6262.     FileCheck$ = f$
6263. END FUNCTION
6264. ' -------------------------------------------------------------------------------------------------------x
6265.  

 

                                                                                                                                          (98 downloads previously)