Author Topic: Moon Lander reprise by request  (Read 4393 times)

0 Members and 1 Guest are viewing this topic.

This topic contains a post which is marked as Best Answer. Press here if you would like to see it.

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Moon Lander reprise by request
« on: March 01, 2020, 08:59:43 pm »
November 28, 2020
Found bug.  Program crashes at Warp 9.  Zip updated, not the code below.

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Moon Lander reprise by request
« Reply #1 on: March 01, 2020, 09:49:44 pm »
Deja vu again! This has to be your signature program Richard Frost.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Moon Lander reprise by request
« Reply #2 on: March 02, 2020, 12:03:40 am »
I am having trouble with this version. I've blacked out my computer twice, first trying Lander source with files in zip then with L64.exe. So I comment out checking off and get the following error message, when I continue after warning, I do get stuff running but I think that file needs to be read properly.
Lander error message.PNG
* Lander error message.PNG (Filesize: 30.89 KB, Dimensions: 838x544, Views: 93)

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Moon Lander reprise by request
« Reply #3 on: March 02, 2020, 12:23:51 am »
Worked alright over here.
ss.png
* ss.png (Filesize: 69.31 KB, Dimensions: 1366x768, Views: 104)
You're not done when it works, you're done when it's right.

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: Moon Lander reprise by request
« Reply #4 on: March 02, 2020, 12:34:30 am »
There was an error in the initial upload in the settings.dat file - a line missing.

Please unzip the corrected attachment.

Sorry I'm so sloppy.  Seems everything I upload has to be fixed before it works.

It works better if you plug it in.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Moon Lander reprise by request
« Reply #5 on: March 02, 2020, 12:43:14 am »
Good, not just me. Might want to fix source in original post too.

Marked as best answer by Richard Frost on March 04, 2020, 04:02:27 pm

Offline Richard Frost

  • Seasoned Forum Regular
  • Posts: 316
  • Needle nardle noo. - Peter Sellers
    • View Profile
Re: Moon Lander reprise by request
« Reply #6 on: March 04, 2020, 09:00:38 pm »
Forgot to put astro.ico, the icon, in the zip.  Added.

Code modified to handle EOF problem in reading lander.set.  Used really big hammer.

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