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

Richard Frost · « **on:** March 01, 2020, 09:20:41 pm »

Code: QB64: [Select]

$EXEICON:'astro.ico'
$RESIZE:SMOOTH
$CHECKING:OFF
 
' bugs: synch LM with skyobject when moving off screen
' todo: make star position lines proper (curve)
' ideas: when McD bombed, replace with KFC, Starbucks, somehow add Microsoft, Apple, FB, Amazon
 
DEFINT A-Z
 
' declares retained for documentation
DECLARE FUNCTION dcolor (z!, i, j, z)  '                              color for good, caution, danger
DECLARE FUNCTION gety (x)              '                              surface height
DECLARE FUNCTION localize(i,j,k)       '                              real x to local x
DECLARE FUNCTION OnOff$ (z)            '                              On/Off text
                 
DECLARE SUB Area51 (tf$)               '                              first landing area
DECLARE SUB AuHoVe (i, j, k, z)        '                              auto/hover/vertical switches
DECLARE SUB Bar (z!,i)                 '                              LED bargraph
DECLARE SUB BlackHole (z)              '                              garbage disposal unit
DECLARE SUB BlackHoleDoom ()           '                              absorb LM
DECLARE SUB Borg (tx, ty)              '                              Star Trek!
DECLARE SUB CarWash                    '                              Montezuma Car Wash
DECLARE SUB CMshadow (tx,x1,x2)        '                              Sun top right
DECLARE SUB Comet (tx,ty)              '                              Halle Berry
DECLARE SUB CybillPix (tf$)            '                              Shepherd pix for TMA kill
DECLARE SUB DeathStar (tx, tf$)        '                              Star Wars / EPCOR
DECLARE SUB Evaluate (i, j)            '                              the landing
DECLARE SUB ExplodeLM ()               '                              expanding ring of debris
DECLARE SUB ExplodeShell (z)           '                              lasered by LM or TMA1
DECLARE SUB FlagandFireworks           '                              US & Soviet Onion flags
DECLARE SUB GetSurface (z)             '                              load sd(emo),sl(evel),s0-10.dat
DECLARE SUB GraphSpeed ()              '                              diagnostics
DECLARE SUB Grave (tx, z$)             '                              JFK, usually
DECLARE SUB Henonp (tf)                '                              color cycling title graphic
DECLARE SUB Hollywood ()               '                              area 9 sign
DECLARE SUB IBM ()                     '                              with tape drive & binary clock
DECLARE SUB Info ()                    '                              messages at top of screen
DECLARE SUB LEDdisplay (z$)            '                              simulate a Seiko watch
DECLARE SUB LGM (flame)                '                              little green man flame count
DECLARE SUB LMbloads ()                '                              x,y,c
DECLARE SUB LMdistort ()               '                              crash
DECLARE SUB LoadPanel ()               '                              instrument panel
DECLARE SUB MakeSur ()                 '                              create surfaces (demo,level,0-10)
DECLARE SUB Mandel ()                  '                              in TMA when landed on
DECLARE SUB Map ()                     '                              dots/text at top
DECLARE SUB McD ()                     '                              burger Emporium
DECLARE SUB mHelp()                    '                              3 help pages
DECLARE SUB PrepAndShowLED (t!,i,j)    '                              7 segment displays
DECLARE SUB Quit ()                    '                              vamoose
DECLARE SUB Shells ()                  '                              IBM weapons
DECLARE SUB ShowAngle (angle)          '                              angle/side thrust
DECLARE SUB Parachute ()               '                              funny!
DECLARE SUB PrintLines (z$,i,j,x,y,c1,c2,k,z) '                       called by PrintVGA
DECLARE SUB PrintCGA (z$,x,y,i,j,k)    '                              8 * 8 font
DECLARE SUB PrintVGA (z$,x,y,i,j)      '                              8 * 14 font
DECLARE SUB SaveImage(f$)              '                              screen capture
DECLARE SUB Setcolor()                 '                              load palettes
DECLARE SUB Smooth (p)                 '                              smooth ground transitions
DECLARE SUB sprint (z$, tx, ty, c1, c2)   '                           redundant?
DECLARE SUB sprint2 (c$, x, y, c1, c2)    '                           redundant?
DECLARE SUB stars (twinkle)            '                              load/plot stars
DECLARE SUB TinyFont (d$, tx, ty, tc)  '                              tiny 3*5 font
DECLARE SUB Surveyor ()                '                              radioactive robot
DECLARE SUB Tile ()                    '                              ground effect
DECLARE SUB TMA ()                     '                              w/ circle patterns/Mandel/Shepard
DECLARE SUB UFO (tx, ty, z)            '                              traditional flying saucer
DECLARE SUB Volcano ()                 '                              Mt. Etna/Cheddar
DECLARE SUB WormHole ()                '                              killer spirals
DECLARE SUB Wave ()                    '                              warp speed instrument distortion
 
DIM SHARED a '                                                        angle of craft
DIM SHARED a51i '                                                     Area 51 initializations
DIM SHARED APdisengage '                                              AutoPilot disengage
DIM SHARED ASO '                                                      ascent stage only
DIM SHARED auto '                                                     autopilot
DIM SHARED background '                                               for instrument panel
DIM SHARED bh '                                                       black hole
DIM SHARED bhx, bhy '                                                 black hole
DIM SHARED bbit '                                                     blinking bit synced to time
DIM SHARED bolthit, bolthitf, boltx '                                 Deathstar hit vehicle, feature
DIM SHARED borgl, borgr, borgt '                                      left right top, distance
DIM SHARED bstyle1, bstyle2 '                                         Borg matrix/lines/Moire
DIM SHARED bw '                                                       black and white
DIM SHARED c '                                                        usually color
DIM SHARED canvas& '                                                  primary screen
DIM SHARED cbh '                                                      constant black holes
DIM SHARED center '                                                   varies according to gs (graphics start)
DIM SHARED chs '                                                      parachute size
DIM SHARED contact '                                                  landed
DIM SHARED convo '                                                    conversation active LM/CM
DIM SHARED cpal '                                                     color palette, normal/green/b&w (32 color kludge/fun)
DIM SHARED craft '                                                    color
DIM SHARED crash '                                                    layer of debris
DIM SHARED cwd, cwsi, cwsd '                                          car wash distance, angles
DIM SHARED cybilltime! '                                              time on screen
DIM SHARED darkstarc '                                                deathstar color set
DIM SHARED darkstars '                                                deathstar spin rate
DIM SHARED darkstart '                                                   "      thickness
DIM SHARED dead$ '                                                    end condition
DIM SHARED debug$ '                                                   messages to God
DIM SHARED demo '                                                     ground features compressed
DIM SHARED doclock '                                                  it's Howdy Doody time
DIM SHARED dosbox '                                                   flag
DIM SHARED dsinit '                                                   deathstar
DIM SHARED eou '                                                      end of universe
DIM SHARED fb$ '                                                      landing feedback/analysis
DIM SHARED flx '                                                      US/USSR flag position
DIM SHARED fuel, fuel! '                                              color of, quantity left
DIM SHARED gh, glmin, glmax '                                         ground height, level
DIM SHARED grav! '                                                    gravity
DIM SHARED gs '                                                       flight area x start
DIM SHARED gstyle '                                                   ground style
DIM SHARED inpause '                                                  flag
DIM SHARED invincible '                                               impervious to threats
DIM SHARED iscd '                                                     don't attempt to write!
DIM SHARED jitter '                                                   shift-T to control
DIM SHARED LEDc '                                                     color
DIM SHARED LEDtri '                                                   tri-color flag
DIM SHARED level '                                                    surface is
DIM SHARED LGMc '                                                     Little Green Man color
DIM SHARED liftoff '                                                  AS only
DIM SHARED lmsl '                                                     LM shield/laser color
DIM SHARED lob '                                                      landed on Borg
DIM SHARED lockfuel '                                                 cheat!
DIM SHARED lp, rp, xp, th1, th2 '                                     pads, radar, thrusters
DIM SHARED magic '                                                    cheat! (instant landing)
DIM SHARED mdelay '                                                   PgUp/PgDn controlled
DIM SHARED msflag '                                                   making surfaces
DIM SHARED mstar '                                                    make stars
DIM SHARED nation '                                                   1 US, 2 USSR (flags & fireworks)
DIM SHARED ok '                                                       at landing, to plant flag
DIM SHARED okrick '                                                   diagnostics
DIM SHARED osc '                                                      on screen count
DIM SHARED oscar '                                                    semaphore land/sea flags
DIM SHARED panelinit '                                                replot flag
DIM SHARED paraf '                                                    parachute flag
DIM SHARED pload '                                                    panel load flag
DIM SHARED porb '                                                     pointers/bargraphs
DIM SHARED ptk '                                                      points to kill (gasoline) ExplodeLM
DIM SHARED px!, py! '                                                 vehicle position on screen
DIM SHARED ra '                                                       random angle
DIM SHARED radarf '                                                   radar on/off
DIM SHARED rads '                                                     Luna radiation
DIM SHARED radiationdeath '                                           flag
DIM SHARED regen '                                                    all star files
DIM SHARED rfx, rfy '                                                 craft jigger
DIM SHARED rick '                                                     debug flag
DIM SHARED rmin, dmin '                                               stars
DIM SHARED settings$ '                                                lander.set
DIM SHARED sf '                                                       surface feature
DIM SHARED shield '                                                   flag
DIM SHARED shoot '                                                    flag
DIM SHARED showmap '                                                  locations of things shown at top
DIM SHARED sia '                                                      shells in air
DIM SHARED skyoff '                                                   for faster performance
DIM SHARED ufof '                                                     for ufo
DIM SHARED sspinit1, sspinit2 '                                       Surveyor
DIM SHARED starfiles '                                                use stars1,2 or 3 (few/med/lots)
DIM SHARED starinit '                                                 flag
DIM SHARED starstatus '                                               0 off, 1 on, 234 more info
DIM SHARED suri '                                                     surface index
DIM SHARED sx0, sy0 '                                                 LM radar/laser location
DIM SHARED sx1, sy1 '                                                 LM left landing pad
DIM SHARED sx2, sy2 '                                                 LM right landing pad
DIM SHARED temp '                                                     temperature
DIM SHARED thrust! '                                                  0 - 100
DIM SHARED tilef '                                                    tile variation
DIM SHARED vx!, vy! '                                                 LM velocity
DIM SHARED wa1
DIM SHARED warp! '                                                    vx! >= 100
DIM SHARED wi, wi2 '                                                  width (distance between pads)
DIM SHARED wx!, wy! '                                                 vehicle position on screen
DIM SHARED x '                                                        = suri + px!
DIM SHARED xoff '                                                     offset for v=5-20, Surv & Etna
DIM SHARED zoom '                                                     starfield
 
DIM SHARED blue, green, gunmetal, red, gasoline, gray2, white, gray
DIM SHARED dred, gold, black2, orange, blue2, yellow, white2
 
DIM SHARED q1, q2, q3, q4, h, t, th, tsix, aspect!, pf! '             constants
 
q1 = 6400: q2 = 860: q3 = 639: q4 = 349: h = 100: th = 200: t = 10: tsix = 360
pf! = .5: aspect! = 1.4: grav! = 1.6
 
qt = 2000 '                                                           3 arrays below weren't loading properly with q2
DIM SHARED LMx(qt), LMy(qt), LMc(qt) '                                LM+exhaust x,y,color
 
DIM SHARED LMrx(1400), LMry(1400) '                                   LM+exhaust x,y after rotation
DIM SHARED LMoc(705), LMci(3) '                                       LM colors,original colors, index
DIM SHARED c!(360), s!(360) '                                         sines and cosines
DIM SHARED ex(6), ey(6), exv(6), eyv(6), ei(6), ek(6), exl(6) '       sky objects
DIM SHARED f$(40) '                                                   support files
DIM SHARED mes$(1), omes$(1), sm!(1) '                                messages at screen top
DIM SHARED sf(10, 2), sf$(10) '                                       surface features start/end/middle
DIM SHARED shx(20), shy(20), sha(20) '                                shells (IBM weapons) x,y,angle
DIM SHARED shvx(20), shvy(20), shd(20) '                              velocity, distance
DIM SHARED rtl!(2), rtlc(2) '                                         radiation/temperature/lightning
DIM SHARED gh(6400) '                                                 ground height
'DIM SHARED gc(6400) '                                                ground color
 
DIM clocka(2) '                                                       clock angles
DIM cmp&(30) '                                                        CM patterns
DIM convo$(50) '                                                      LM/CM
DIM SHARED gbuff(800) '                                               DS liftoff
DIM skyset1(t), skyset2(t) '                                          skycrud
DIM SHARED p(127, 13), p2(127, 7) '                                   vga and cga fonts
 
begin:
GOSUB init1
DO
    GOSUB init2
    WHILE LEN(INKEY$): WEND '                                         clear keyboard buffer
    DO: _LIMIT mdelay
        GOSUB Autopilot
        GOSUB Plotscreen
        GOSUB KeyAndMouse
        IF restart THEN GOTO begin '                                  restore defaults
        IF warp! < 1 THEN GOSUB CheckHit
    LOOP UNTIL contact OR LEN(dead$)
    GOSUB CheckDead
    IF contact THEN
        Evaluate savea, a + ma '                                      landing feedback contact/currentø
        wu2! = TIMER + 1
        GOSUB pause '                                                 landed, Enter for liftoff
        IF restart THEN GOTO begin '                                  restore defaults
        IF k <> 60 THEN GOSUB CheckDead '                             F2 demo restart
    END IF
LOOP
 
CheckDead:
z$ = LEFT$(LEFT$(dead$, 1) + " ", 1)
IF INSTR(" CBE", z$) = 0 THEN '                                       not Crashed, Borg, Eaten by BH
    ExplodeLM
    contact = 0
END IF
dead$ = ""
RETURN
 
Autopilot:
aboveborg = 0
IF (ek(2) = -1) OR (ek(2) > h) THEN borgt = 0
IF (skyoff = 0) AND (sy1 < borgt) AND (px! > borgl) AND (px! < borgr) THEN aboveborg = 1
super = 0
IF vert OR hover THEN
    GOSUB GetAlt
    i! = alt! / 8 + pf! '                                             thrust target
    IF jitter AND (alt! < t) THEN i! = i! * 2 '                       optional, faster
    IF aboveborg THEN i! = 1
    GOSUB idealthrust
    thrust! = sbest!
    super = -(sbest! > h) '                                           add side thusters
    'IF warp! >= 1 THEN super = 0
    IF thrust! > h THEN thrust! = h
END IF
IF thrust! < 0 THEN thrust! = 0
RETURN
 
CutOrOutOfFuel:
IF fuel! = 0 THEN shield = 0 '                                        shields need fuel
IF cut = 0 THEN
    cut = 1
    cvy! = vy!
    ctime! = TIMER
    tfollow = 0 '                                                     terrain following
    thrust! = 0
END IF
RETURN
 
idealthrust: '                                                        for hover or descend
IF (alt! < pf!) AND (jitter = 0) THEN i! = .05 '                      soft landing
IF hover THEN i! = hoverc '                                           target
hoverc = hoverc - SGN(hoverc) '                                       up/down
fmin! = q1 '                                                          conventient large number (6400)
ma! = (vmass + fuel!) / th '                                          mass (actually 54% fuel)
ts! = s!((a + 270) MOD tsix) / ma! / power
IF jitter THEN us! = RND * t + 1 ELSE us! = .1
IF powerloss THEN us! = h
FOR z! = 0 TO (h + t) STEP us! '                                      find best thrust 0-110
    fo! = z! * ts!
    aa! = ABS(vy! + grav! + fo! - i!)
    IF aa! < fmin! THEN fmin! = aa!: sbest! = z!
    IF aa! > fmin! THEN EXIT FOR
NEXT z!
RETURN
 
GoSkyObject:
IF (ek(p) <> -1) AND (contact = 0) THEN
    auto = 0
    a = -ma
    wa = -ma
    lock1 = 0
    suri = ex(p) - center
    GOSUB slimit
    IF p > 2 THEN ey(p) = th '                                        BH, worm, comet, alien
    px! = center
    IF p = 2 THEN py! = 130 '                                         above Borg
    vx! = exv(p)
    eyv(p) = 0
END IF
RETURN
 
KeyAndMouse:
DO WHILE _MOUSEINPUT
    lb = ABS(_MOUSEBUTTON(1))
    rb = ABS(_MOUSEBUTTON(2))
    IF mouseswap THEN SWAP lb, rb '                                   whatever floats your boat
    IF TIMER < ignoreuntil! THEN lb = 0: rb = 0 '                     2 lines for debouncing
    IF lb OR rb THEN ignoreuntil! = TIMER + .25
    ww = wa '                                                         stash current wanted angle
    wa = wa + lb - rb '                                               want angle
    IF wa <> ww THEN '                                                if changed
        IF inpause THEN i$ = CHR$(13): GOTO gotit '                   either button to cause liftoff
        apd = 1 '                                                     autopilot disconnect warning
        auto = 0 '                                                    autopilot
        GOTO endk '                                                   don't bother checking keys
    END IF
    mw = mw + _MOUSEWHEEL
LOOP
IF mw <> 0 THEN '                                                     wheel moved
    thrust! = INT(thrust!) - mw
    IF thrust! < 0 THEN thrust! = 0
    IF thrust! > h THEN thrust! = h
    apd = 1 '                                                         autopilot disconnect warning
    auto = 0 '                                                        autopilot
    hover = 0 '                                                       hover off
    vert = 0 '                                                        vertical control off
    mw = 0 '                                                          zap
    GOTO endk '                                                       don't bother checking keys
END IF
 
DEF SEG = 0
status = PEEK(&H417) '                                                7ins 6caps 5num 4scrl 3alt 2ctrl 1ls 0rs
IF ((status AND 1) > 0) AND ((status AND 2) > 0) THEN vx! = 901 '     both shift
IF status AND 8 THEN start1! = TIMER: mpass& = 0 '                    alt, reset speed timer
 
IF status AND 4 THEN '                                                ctrl
    i$ = RIGHT$(" " + INKEY$, 1)
    kk = ASC(i$)
    IF (kk = 3) OR (kk = 19) THEN '                                   c or s
        nfile:
        image = image + 1
        f$ = "CAP" + RIGHT$("0000" + LTRIM$(STR$(image)), 3) + ".BMP"
        IF _FILEEXISTS(f$) THEN GOTO nfile
        SaveImage f$
        IF _FILEEXISTS(f$) THEN mes$(1) = "Screen captured to " + f$
        GOTO endk
    END IF
END IF
 
i$ = INKEY$ '                                                         consult human
li = LEN(i$)
IF li = 0 THEN RETURN
 
IF i$ = "|" THEN MakeStarFiles '                                      takes hours!
 
k = ASC(RIGHT$(i$, 1))
IF k = 27 THEN Quit
IF inpause AND (k = 32) THEN
    k = 13 '                                                          transform spacebar to Enter
    i$ = RIGHT$(CHR$(0) + CHR$(k), li) '                              gentlemen, we can rebuild him
END IF
 
gotit:
IF (i$ = "\") AND (shx(0) = 0) AND (contact = 0) THEN '               LM drops bomb
    IF (cwd < 50) AND (sy1 > 300) THEN dead$ = "Smooth move, Exlax!" 'kill self in car wash
    sia = sia + 1 '                                                   shells in air
    shvx(0) = vx! + 3 + RND * t
    shvy(0) = 0
    shx(0) = suri + sx0
    shy(0) = sy0
    shd(0) = 1
END IF
 
IF i$ = "[" THEN bw = bw XOR 1: Setcolor '                            crude method for b&w
IF i$ = "]" THEN
    ufof = ufof XOR 1
    mes$(0) = "UFO " + OnOff$(ufof)
    IF ufof THEN
        GOSUB SkyStuff
        p = 6: GOSUB GoSkyObject
    END IF
END IF
 
IF i$ = "=" THEN GOSUB lmshow '                                       show LM data - pointless but amusing
IF i$ = "'" THEN pdiv = (pdiv + 1) MOD 4 '                            Henon speed, also slows down thrust display
IF radiationdeath THEN i$ = "": RETURN '                              you're dead and cannot pass this point
 
IF i$ = "`" THEN '                                                    Deathstar size - thought a smaller one wouuld be faster - it is - not by much
    dsinit = 0
    dstype = 2 + (MID$(f$(37), 6, 1) = "m")
    MID$(f$(37), 6, 1) = MID$("sm", dstype, 1)
END IF
IF i$ = "~" THEN darkstarc = darkstarc XOR 1 '                        color
IF i$ = "@" THEN darkstart = darkstart XOR 1 '                        thickness
 
IF inpause THEN '                                                     hit "p" or landed
    IF i$ = "b" THEN '                                                Big Dipper
        rmin = 9 '                                                    right ascension
        dmin = 30 '                                                   declination
        starinit = 0
        RETURN
    END IF
    IF li = 2 THEN '                                                  arrow keys move stars
        rdol = rmin + dmin '                                          detect change
        rmin = rmin + (k = 75) - (k = 77) '                           left right
        rmin = (rmin + 24) MOD 24 '                                   RA limit 0 - 24
        dmin = dmin - (k = 80) * t + (k = 72) * t '                   declination up down
        IF dmin = h THEN dmin = -80 '                                 limit -90 - 90
        IF dmin = -h THEN dmin = 80
        IF (rmin + dmin) <> rdol THEN starinit = 0 '                  changed, replot stars
    END IF
END IF
IF li = 2 THEN GOTO is2 '                                             extended key
 
IF i$ = "_" THEN '                                                    star twinkle
    twinkle = twinkle XOR 1
    mes$(0) = "STAR TWINKLE " + OnOff$(twinkle)
END IF
IF i$ = ";" THEN fpl = 1 '                                            force power loss
IF k = 9 THEN ex(1) = (suri + px!) - SGN(exv(1)) * h '                TAB summon DS
p = INSTR(")!@#$%^&*(", i$)
IF p AND (contact = 0) THEN GetSurface p - 1 '                        shifted-number for 1 of 10 surfaces
p = INSTR("01234", i$) '                                              stars off/on/info
IF p THEN starstatus = p - 1
IF k = 8 THEN '                                                       backspace, random star position
    rmin = INT(RND * 24) '                                            random RA
    dmin = (INT(RND * 18) - 9) * t '                                  random dec
    starinit = 0
END IF
IF i$ = "." THEN
    tfollow = tfollow XOR 1
    auto = 0
    vert = 1
    mes$(0) = "TERRAIN FOLLOWING " + OnOff$(tfollow)
END IF
p = (i$ = "<") - (i$ = ">") '                                         jump left/right
IF (contact = 0) AND (p <> 0) THEN
    suri = suri + 40 * p '                                            surface index
    GOSUB slimit '                                                    limit suri
    IF lock1 THEN hover = 1: lock1 = 0
END IF
IF (i$ = "+") AND (zoom < 2) THEN zoom = zoom + 1: starinit = 0
IF (i$ = "-") AND (zoom > 0) THEN zoom = zoom - 1: starinit = 0
IF i$ = "?" THEN rick = rick XOR 1 '                                  show speed of processing graph
IF okrick AND (i$ = "U") THEN tilef = (tilef + 1) MOD 3 '             alternate tilings
IF i$ = "/" THEN
    cpal = (cpal + 1) MOD 3 '                                         cycle green/black & white/normal monitor
    mes$(0) = "": mes$(1) = ""
    IF cpal = 1 THEN mes$(0) = "GT40 mode"
    IF cpal = 2 THEN mes$(1) = "Do not adjust your set.  We control the horizontal and the vertical!"
END IF
IF k = 32 THEN '                                                      cycle thru features
    IF lock1 > 0 THEN '                                               on auto, landing zone selected, abort landing
        abort = 1
        mes$(0) = "ABORT!"
        IF vx! = 0 THEN vx! = .01
        RETURN
    END IF
    IF convo THEN '                                                   or speed up rendesvous
        sct! = .2
        sc! = TIMER
        RETURN
    END IF
 
    IF skyoff THEN tmod = t ELSE tmod = 16
    jf = (jf + 1) MOD tmod
    '          01234567890123456
    i$ = MID$("mtsiHg5wleObBWoR", jf + 1, 1) '                        cycle thru ground and sky features
    k = ASC(i$)
    IF demo AND (jf = 7) THEN i$ = "e" '                              skip LGM in demo, because it's on the grave
END IF
 
p = INSTR("RObBWo", i$) '                                             jump to CM, deathstar, etc.
IF p AND (skyoff = 0) THEN p = p - 1: GOSUB GoSkyObject
 
IF i$ = "A" THEN
    lam = lam XOR 1 '                                                 land at McDonalds
    IF lam AND (auto = 0) THEN i$ = "a" '                             turn on autopilot
END IF
IF i$ = "a" THEN '                                                    autopilot
    abort = 0 '                                                       in case it was on
    tfollow = 0
    auto = auto XOR 1 '                                               toggle
    IF auto AND (radarf = 0) THEN radarf = 2
    IF auto = 0 THEN hover = 1 '                                      be nice, help user
    pt! = TIMER '                                                     restart countdown
END IF
IF i$ = "c" THEN GOSUB CutOrOutOfFuel
IF i$ = "C" THEN doclock = doclock XOR 1
IF i$ = "d" THEN dump = dump XOR 1 '                                  fuel
IF i$ = "D" THEN restart = 1 '                                        restart with defaults
IF (i$ = "E") AND (starstatus > 0) THEN '                             end of universe
    IF eou = 0 THEN eou = -1 ELSE eou = eou + 1 '                     restart or speedup
END IF
IF i$ = "F" THEN
    fuel! = h
    lockfuel = 1
END IF
IF i$ = "f" THEN lockfuel = lockfuel XOR 1 '                          THIS cheat the GT40 had, using toggle switches!
IF i$ = "G" THEN gstyle = (gstyle + 1) MOD 6 '                        ground style
IF i$ = "h" THEN hover = hover XOR 1: apd = 1 '                       apd=autopilot disconnect warning
IF i$ = "I" THEN
    invincible = ABS(invincible) XOR 1
    mes$(0) = "INVINCIBLE MODE " + OnOff$(invincible)
    GOSUB ReadLM '                                                    to change thrusters
END IF
IF i$ = "j" THEN
    darkstars = (darkstars + 1) MOD 5
    mes$(0) = "Deathstar rotation" + STR$(darkstars)
END IF
IF i$ = "k" THEN '                                                    kill threats or, if none, shoot at ground feature
    firel = 1 '                                                       fire laser
    FOR z = 1 TO 20 '                                                 IBM shells
        shd(z) = 1
    NEXT z
END IF
IF i$ = "L" THEN GetSurface -1 '                                      level ground
IF (i$ = "M") AND ((contact + inpause) = 0) THEN '                    laser level & land
    magic = magic + 1
END IF
IF (i$ = "n") AND inpause THEN nation = ((nation - 1) XOR 1) + 1 '    flag 1 US, 2 USSR
IF i$ = "p" THEN GOSUB pause '                                        pause LM movement
IF (i$ = "P") AND (contact = 0) AND (warp! < 1) AND (paraf = 0) THEN
    paraf = 1 '                                                       parachute!
    chs = 0
    a = 0
    GOSUB CutOrOutOfFuel
END IF
IF i$ = "q" THEN Quit
IF i$ = "Q" THEN
    oscar = oscar XOR 1 '                                            land or sea flags for LGM
    IF oscar THEN z$ = "SEA" ELSE z$ = "LAND"
    mes$(0) = "LGM flags: " + z$
END IF
IF i$ = "r" THEN
    IF cut THEN '                                                     restart engine
        cut = 0
        hover = 1
        power = opower
        powerloss = 0
    ELSE
        IF auto = 0 THEN
            radarf = (radarf + 1) MOD 3
            mes$(0) = "Radar " + MID$("OFFON FAT", radarf * 3 + 1, 3)
        END IF
    END IF
END IF
IF i$ = "S" THEN MakeSur: restart = 1 '                               generate new surfaces
IF i$ = "T" THEN jitter = jitter XOR 1 '                              thrust computation
IF i$ = "u" THEN '                                                    instrument panel on/off
    zz = gs
    gs = (SGN(gs) XOR 1) * 85 '                                       graphics start
 
    panelinit = 0
    pif = -1
 
    z = (gs + 30) - px!
    IF (gs > 0) AND (z > 0) THEN
        px! = px! + z
        suri = suri - z
        GOSUB slimit
    END IF
END IF
IF i$ = "v" THEN '                                                    vertical automatic
    IF tfollow THEN
        tfollow = 0
        mes$(0) = "TERRAIN FOLLOWING OFF"
    END IF
    vert = vert XOR 1
    apd = 1 '                                                         autopilot disconnect warning
END IF
IF i$ = "x" THEN starinit = 0: starfiles = (starfiles + 1) MOD 3 '    star density
IF i$ = "X" THEN starinit = 0: regen = 1: Stars '                     regenerate single star file
IF i$ = "y" THEN
    mouseswap = mouseswap XOR 1
    IF mouseswap THEN z$ = "reversed" ELSE z$ = "normal"
    mes$(0) = "Mouse buttons " + z$
END IF
IF i$ = "Y" THEN min = 3: sec = 45 '                                  black hole at 3:50
IF (i$ = "z") AND (crash = 0) THEN
    mes$(0) = "" '
    mes$(1) = "" '                                                    erase radiation messages
    dead$ = "SELF-DESTRUCT"
END IF
 
IF i$ = "}" THEN
    GOSUB CutOrOutOfFuel
    sgs = gs: gs = 0
    srf = radarf: radarf = 0
    GOSUB Plotscreen
    dissolve
    dead$ = " "
    gs = sgs: radarf = srf
END IF
 
'          1234567890
p = INSTR("5wlemtsiHg", i$) '                                         jump to feature
IF p AND (contact = 0) THEN
    sf = p
    IF demo AND sf = 9 THEN sf = t
    IF (sf(sf, 1) >= suri) AND (sf(sf, 0) < (suri + q3)) THEN '       already in vicinity of IBM
        IF sf = 8 THEN shoot = 1 '                                    tell IBM to fire
        IF demo THEN '                                                IBM at special location in demo mode, deal with it
            px! = sf(sf, 2) - 3130
            suri = 3130
        END IF
    ELSE
        px! = center '                                                move ship to screen center
        suri = sf(sf, 0) - center - 30 - (sf = 9) * h '               move ground to IBM
    END IF
    a = -ma '                                                         angle = -malfunction angle
    abort = 0
    wa = -ma '                                                        want angle
    lock1 = 0 '                                                       radar lock
    tmt! = 0 '                                                        to move total
    vx! = 0 '                                                         not moving
    warp! = 0 '                                                       cancel warp
END IF
GOTO endk '                                                           done with ordinary keys
 
is2: '                                                                extended key
z = mdelay '                                                          master delay
mdelay = mdelay - (k = 73) + (k = 81) '                               PgUp/PgDn
IF mdelay < 1 THEN mdelay = 1
IF mdelay <> z THEN '                                                 changed
    mes$(0) = "_LIMIT " + OnOff$(SGN(mdelay))
    IF mdelay THEN mes$(0) = mes$(0) + LTRIM$(STR$(mdelay))
END IF
IF status AND 3 THEN '                                                left or right shift
    IF k = 72 THEN k = 201 '                                          LM up
    IF k = 75 THEN k = 203 '                                          LM left
    IF k = 77 THEN k = 204 '                                          LM right
END IF
IF (inpause = 0) AND ((k = 72) OR (k = 80)) THEN '                    up and down arrow
    apd = 1 '                                                         autopilot disconnect
    hover = 0
    vert = 0
    thrust! = thrust! + (k = 80) - (k = 72) '                         true = -1
END IF
thrust! = INT(thrust! * t) / t '                                      t = 10
IF (hover = 0) AND (vert = 0) THEN thrust! = INT(thrust!)
IF thrust! > h THEN thrust! = h
IF (dump = 0) AND (fuel! > 0) AND (contact = 0) THEN '                side thrust/angle
    IF inpause = 0 THEN wa = a - (k = 75) + (k = 77) '                                    left/right arrows
    IF ABS(wa) > 99 THEN wa = 99 * SGN(wa) '                          want angle, limit 99
    IF a <> wa THEN apd = 1 '                                         autopilot disconnect
END IF
IF k = 59 THEN '                                                      F1 help
    mHelp
    start1! = TIMER: mpass& = 0 '                                     reset speed timer
END IF
IF k = 60 THEN '                                                      F2 demo
    demo = demo XOR 1
    GOSUB init2
    cbh = demo '                                                      constant black holes
END IF
IF k = 61 THEN '                                                      F3, sky feature toggle
    skyoff = skyoff XOR 1
    IF skyoff = 0 THEN convo = 0
    mes$(0) = "SKY OBJECTS " + OnOff$(1 - skyoff)
END IF
IF k = 62 THEN '                                                      F4 endless bh
    cbh = cbh XOR 1
    exv(3) = 0
    mes$(0) = "CONSTANT BLACK HOLES " + OnOff$(cbh)
END IF
IF k = 63 THEN '                                                      F5 instrument background
    f5toggle = f5toggle XOR 1
    IF f5toggle = 0 THEN background = background XOR 1
    IF f5toggle = 1 THEN porb = porb XOR 1
    pload = 0
END IF
IF (k = 64) AND ((ASO + inpause) = 0) THEN '                          F6 seperate AS/DS
    GOSUB liftoff
    RETURN
END IF
IF k = 65 THEN showmap = showmap XOR 1 '                              F7 map
IF k = 66 THEN '                                                      F8 shields
    shield = shield XOR 1
    geof = shield * t
END IF
IF k = 67 THEN '                                                      F9 LED color
    z$ = RIGHT$("0" + LTRIM$(STR$(LEDc)), 2)
    z = INSTR(LED$, z$): IF z = 11 THEN z = -1
    LEDc = VAL(MID$(LED$, z + 2, 2))
    LEDtri = 0
END IF
IF k = 68 THEN '                                                      F10 LED tri-color
    LEDtri = LEDtri XOR 1
    IF LEDtri THEN LEDc = green
END IF
IF k = 71 THEN rmin = 0: dmin = 0: starinit = 0 '                     Home, star RA/dec to 0
 
endk:
IF k = 201 THEN hoverc = hoverc - t '                                 move up
IF k = 203 AND (left = 0) THEN left = 16 '                            move left
IF k = 204 AND (right = 0) THEN right = 16 '                          move right
IF apd OR (k = 201) OR (k = 203) OR (k = 204) THEN '                  blink AUTO
    IF auto THEN APdisengage = 20 '                                   blink 20 times
    auto = 0 '                                                        turn it off
    apd = 0 '                                                         reset flag
END IF
RETURN
 
pause:
IF inpause THEN RETURN '                                              already doing this....
dead$ = ""
inpause = 1
pt! = TIMER '                                                         for demo mode
wu! = pt! + 1 '                                                       delay before planting flag
DO: _LIMIT mdelay
    GOSUB KeyAndMouse
    IF k = 60 THEN RETURN '                                           F2 demo
    IF (i$ > "") AND (INSTR("zD", i$)) THEN RETURN '                  self-destruct or restart
    GOSUB Plotscreen
    IF LEN(dead$) THEN RETURN
    IF auto AND contact THEN '                                        countdown to blast off
        IF TIMER < pt! THEN pt! = TIMER '                             midnite crossing fix
        z! = TIMER - pt!
        z = t - z!
        IF z < 0 THEN z = 0
        TextOnLM$ = LTRIM$(STR$(z))
        IF z! > t THEN i$ = CHR$(13) '                                like pressing the key
    END IF
    GOSUB CalcFuel
LOOP UNTIL (i$ = CHR$(13)) OR (i$ = "p")
ctime! = TIMER
fb$ = "" '                                                            feedback
inpause = 0
c = (contact = 1) AND (crash = 0) AND (liftoff = 0) AND (ABS(a) < 31)
IF c THEN GOSUB liftoff
RETURN
 
CalculateMotion:
i = 0
IF (power = opower) AND (RND < .0003) THEN
    i = ((auto + contact + liftoff + vert) = 0) AND ((min * 60 + sec) > t)
END IF
IF fpl OR i THEN '                                                    force power loss
    fpl = 0
    powerloss = t + RND * t + ASO * 30 '                              10 TO 20%, 50% ASO
    power = opower + powerloss / h * opower
    mes$(0) = LTRIM$(STR$(powerloss)) + "% POWER LOSS - DUMP FUEL!"
END IF
 
IF lob THEN px! = px! + exv(2) '                                      landed on Borg
IF contact OR inpause THEN GOTO other
 
ta = ((a + ma) + 270) MOD tsix '                                       temp angle = a+malfunction angle
ma! = (vmass + fuel!) / th '                                          actually 54% fuel
fo! = ((thrust! + super * 5) / ma!) / power '                         f = ma
IF fuel! = 0 THEN fo! = 0 '                                           nix any force if running on empty
fx! = fo! * c!(ta) / 2
IF dump AND (ABS(a) < 5) THEN fx! = 0
fy! = fo! * s!(ta) + grav! '                                          thrust + gravity
IF warp! > 0 THEN fx! = fx! * (warp! * 2 + 1) '                       get thru warp msgs faster
vx! = vx! - fx!
IF a <> 0 THEN vx! = vx! + (RND - pf!) / h '                          help get to integer vx
IF ABS(vx!) < .01 THEN vx! = 0
avx = ABS(vx!)
IF (avx > 5) AND (avx < 20) THEN xoff = vx! ELSE xoff = 0
IF cut AND (magic = 0) THEN
    cel! = TIMER - ctime! '                                           time since cut
    vy! = cvy! + grav! * (cel! * cel!) '                              v = at^2  velocity = acceleration times time squared
    fy! = 0 '                                                         null y force since it's a different situation
END IF
vy! = vy! + fy!
IF warp! >= 1 THEN vy! = 0
 
px! = px! + vx! - lob * exv(2)
py! = py! + vy!
 
IF (liftoff = 0) AND (py! < 55) THEN '                                stop going off screen top
    IF convo = 0 THEN mes$(0) = "Too high - reduce thrust!"
    py! = 55
    vy! = 0
END IF
 
other:
GOSUB CalcFuel
IF liftoff AND (lob = 0) THEN RETURN
nomove = demo AND (((suri \ q3) + 1) = 5)
 
zz = px! - center
z! = ABS(vx!)
 
IF (nomove = 0) AND ((rlink > 0) OR (z! < 3) OR (z! > 20)) THEN
    dx! = px! - center
    px! = center
    tmt! = tmt! + dx!
ELSE
    zq = 0 '                                                          was 30 woof woof
    c1 = (px! <= (gs + zq))
    c2 = (px! >= (q3 - zq))
    IF c1 OR c2 THEN
        IF c1 THEN z = q3 - zq ELSE z = gs + zq
        z = z - px!
        tmt! = tmt! - z
        px! = px! + z
    ELSEIF (zz <> 0) AND (ABS(vx!) <= 5) AND (nomove = 0) THEN
        z = zz \ 2 + 1
        tmt! = tmt! + z
        px! = px! - z
    END IF
END IF
IF ABS(tmt!) >= q3 THEN tmt! = SGN(tmt!) * q3 - 1
 
IF left THEN '                                                        jog left (shift left arrow)
    IF left = 16 THEN sv! = vx!
    IF left > 8 THEN a = 4 ELSE a = -4
    left = left - 1
    IF left = 0 THEN a = 0: vx! = sv!
END IF
IF right THEN '                                                       jog right (shift right arrow)
    IF right = 16 THEN sv! = vx!
    IF right > 8 THEN a = -4 ELSE a = 4
    right = right - 1
    IF right = 0 THEN a = 0: vx! = sv!
END IF
RETURN
 
CalcFuel:
IF cut THEN thrust! = 0
IF lockfuel = 0 THEN
    ta = ABS(a): IF ta > 5 THEN ta = 5 '                              main angle, up to 5
    z! = (ta + super + ABS(fst)) * t '                                plus 10% for thrusters
    used! = (thrust! + z!) / 8000
    IF ASO THEN used! = used! * 2 '                                   burn faster for AS
    IF inpause THEN used! = 0
    IF shield THEN used! = used! + .001
    fuel! = fuel! - used! * 4
    IF fuel! <= 0 THEN fuel! = 0: GOSUB CutOrOutOfFuel
END IF
RETURN
 
Plotscreen:
IF bit! = 0 THEN bit! = TIMER + pf!
IF TIMER > bit! THEN
    bbit = bbit XOR 1 '                                               toggles twice per second, used all over - instruments, IBM hazard lights, clock colon, LGM ear wiggle
    bit! = 0
END IF
 
bolthit = 0
bolthitf = 0
IF (crash = 0) AND (ABS(vx!) >= h) THEN warp! = ABS(vx!) / h ELSE warp! = 0
IF warp! >= 1 THEN paraf = 0 '                                        reckon parachute can be dropped at warp speeds
 
' change styles every 10/30 seconds
IF style! = 0 THEN style! = TIMER + t
IF style! > 86400 THEN style! = 1 '                                   midnite xing
IF TIMER > style! THEN
    bstyle1 = (bstyle1 + 1) MOD 3 '                                   Borg guts every 10s
    IF bstyle1 = 0 THEN bstyle2 = bstyle2 XOR 1 '                     Borg exhaust
    style! = 0
END IF
 
IF (starstatus > 0) AND (eou = 0) AND (vert = 0) AND (RND > .9999) THEN '  stars on+not already falling+WHY?+rarely
    mes$(0) = "THE SKY IS FALLING!  THE SKY IS FALLING!"
    eou = 1
END IF
GOSUB CalculateMotion
 
IF gs THEN '                                                          graphics start not 0, instruments are visible
    VIEW
    pif = (pif + 1) MOD (pdiv + 1)
    IF pif THEN timemachine ELSE GOSUB Instruments '                  INSTRUMENTS
END IF
IF starstatus THEN
    VIEW SCREEN(gs, SGN(LEN(mes$(0))) * 20)-(q3, q4)
    Stars '                                                           STARS
    VIEW SCREEN(gs, 0)-(q3, q4)
ELSE
    VIEW SCREEN(gs, 0)-(q3, q4)
    CLS
END IF
 
IF LEN(mes$(0)) THEN
    VIEW SCREEN(gs, 0)-(q3, 20)
    CLS
    VIEW SCREEN(gs, 0)-(q3, q4)
END IF
 
Info '                                                                INFO show timed messages at top, if any
'VIEW SCREEN(gs, 0)-(q3, q4)
IF warp! < 1 THEN '                                                   no sky features except star streaks at warp speeds
    IF skyoff = 0 THEN GOSUB SkyStuff '                               CM/DS/Bo/BH/Wo/Co
    GOSUB PlotGround '                                                GROUND/FEATURES
    Shells '                                                          SHELLS
    IF (invincible = 0) AND (shield = 0) AND (skyoff = 0) THEN GOSUB FiveWaysToDie
END IF
IF platform THEN PUT (pminx, pminy), gbuff(), OR '                    falling descent stage
IF LEN(dead$) = 0 THEN GOSUB PlotVehicle '                            VEHICLE
IF (warp! < 1) AND showmap AND (crash = 0) THEN
    VIEW
    Map '                                                             LM, ground & sky features
    VIEW SCREEN(gs, 0)-(q3, q4)
END IF
IF bolthit THEN '                                                     lightning zap from Deathstar
    boltc = boltc + 1 + (boltc = 9999)
    rtl!(2) = TIMER + 5
    rtlc(2) = boltc
    IF ((invincible + shield) = 0) AND (boltc >= t) THEN dead$ = "Zapped!" '   by EPCOR!"
END IF
 
IF okrick AND (LEN(debug$) > 0) THEN LOCATE 1, 12: PRINT debug$;
timemachine
 
RETURN
 
SkyStuff:
IF (min = 3) AND (sec = 50) THEN '                                    Tree-fiddy! (Southpark), do black hole
    ex(3) = suri + t
    ey(3) = h
    exv(3) = t
    eyv(3) = 1
END IF
 
IF cmleaving THEN
    exv(0) = exv(0) + 2
    IF exv(0) = 0 THEN exv(0) = 1
END IF
 
RESTORE skycrud
IF eou THEN mi = 2 ELSE mi = 5 '                                      end of universe, no celestial events
FOR i = 0 TO mi '                                                     0CM 1DS 2Borg 3BH 4Worm 5Comet 6Al
    READ g$, skyset1(i), skyset2(i)
NEXT i
 
FOR i = 0 TO mi + ufof '                                              0CM 1DS 2Borg 3BH 4Worm 5Comet 6Alien
    xplus = skyset1(i): xminus = skyset2(i)
    IF (i = 3) AND cbh THEN ek(i) = 0 '                               constant black hole
    IF ek(i) = -1 THEN GOTO ni2
 
    IF (ey(i) > (q4 + 50)) OR (ey(i) < -50) OR (exv(i) = 0) THEN
        ei(i) = 0 '                                                   ini
        ek(i) = 9999
        nx:
        ex(i) = RND * q1
        IF ABS(ex(i) - (px! + suri)) < q3 THEN GOTO nx '              start away from craft
        IF ABS(ex(i) - px!) < q3 THEN GOTO nx '                       start away from craft
        IF i = 2 THEN ex(i) = (ex(1) + 3200) MOD q1
        ey(i) = 120 + RND * h '                                       random y 120-220
        IF i = 0 THEN ey(i) = 22 '                                    CM
        IF i = 1 THEN ey(i) = 170 '                                   DS
        IF i = 2 THEN ey(i) = th '                                    Borg
        '              0 1 2 3 4 5
        '              CMDeBoBHWoCoAl
        c1 = VAL(MID$("04010210120502", i * 2 + 1, 2)) '              min x velocity
        c2 = VAL(MID$("09030210171005", i * 2 + 1, 2)) '              max x velocity
        exv(i) = RND * (c2 - c1) + c1 '                               random in range
        IF RND > pf! THEN exv(i) = -exv(i)
 
        z = VAL(MID$("00000003020100", i * 2 + 1, 2)) '               top range y velocity
        eyv(i) = 0
        IF z THEN eyv(i) = RND * (z - 1) + 1 '                        random in range
 
        IF RND > pf! THEN exv(i) = -exv(i)
        IF RND > pf! THEN eyv(i) = -eyv(i)
        IF (i = 3) AND cbh THEN
            IF RND > pf! THEN
                ex(i) = suri - t
                exv(i) = t
            ELSE
                ex(i) = suri + q3 + t
                exv(i) = -t
            END IF
        END IF
    END IF
 
    ex(i) = ex(i) + exv(i)
    ey(i) = ey(i) + eyv(i)
 
    IF ex(i) < 0 THEN
        IF (i = 0) AND cmleaving THEN
            ek(i) = -1: cmleaving = 0
        ELSE
            ex(i) = ex(i) + q1
        END IF
    END IF
    IF ex(i) > q1 THEN
        IF (i = 0) AND cmleaving THEN
            ek(i) = -1: cmleaving = 0
        ELSE
            ex(i) = ex(i) - q1
        END IF
    END IF
 
    exl(i) = localize(ex(i), xplus, xminus)
    IF (i = 3) AND cbh AND (exl(i) = 9999) THEN exv(i) = 0
 
    IF ek(i) <> -1 THEN ek(i) = 9999
    IF exl(i) <> 9999 THEN
        dx! = ABS(px! - exl(i))
        dy! = ABS(py! - ey(i))
        ek(i) = SQR(dx! * dx! + dy! * dy!)
 
        IF i = 0 THEN GOSUB CommandModule
        IF i = 1 THEN DeathStar exl(i), f$(37)
        IF i = 2 THEN Borg exl(i), ey(i)
        IF i = 3 THEN
            IF (LEN(mes$(0)) = 0) AND (showmap = 0) AND (cbh = 0) THEN
                mes$(0) = "DANGER, WILL ROBINSON, DANGER!"
            END IF
            IF sas = 0 THEN BlackHole 0
            sas = 0
        END IF
        IF i = 4 THEN WormHole
        IF i = 5 THEN
            tx = localize(ex(5), 0, 0)
            ty = ey(5)
            Comet tx, ty
        END IF
        IF i = 6 THEN '                                               traditional alien - too silly
            j = RND * h - h \ 2
            z = ey(6) + j
            IF (RND > .9) AND (z > h) AND (z < 250) THEN
                ey(6) = z
                alien = alien XOR 1
                ex(6) = ex(6) + 20 * SGN(alien - pf!)
            END IF
            UFO exl(6), ey(6), exv(6)
        END IF
    END IF
    ni2:
NEXT i
RETURN
 
FiveWaysToDie:
IF (ek(2) >= 0) AND (ek(2) < 20) THEN '                               Borg
    wu! = TIMER + 5
    DO: _LIMIT mdelay
        CLS
        mes$(0) = "YOU ARE BORG"
        Info
        Borg exl(2), ey(2)
        FOR i = 1 TO rp
            p = POINT(LMrx(i), LMry(i))
            IF p = black2 THEN c = green ELSE c = black2
            PSET (LMrx(i), LMry(i)), c
        NEXT i
        timemachine
    LOOP UNTIL TIMER > wu!
    dead$ = "BORG"
END IF
 
IF (ek(3) >= 0) AND (ek(3) < 30) THEN '                               black hole
    dead$ = "EATEN"
    BlackHoleDoom
END IF
 
IF (ek(4) >= 0) AND (ek(4) < 30) THEN '                               wormhole
    wu! = TIMER + 5
    spx! = exl(4)
    spy! = ey(4)
    exv(4) = 0
    eyv(4) = 0
    wradar = radarf
    radarf = 1
    cut = 1
    DO: _LIMIT mdelay
        CLS
        fb$ = ""
        mes$(0) = "HOLY CRAP, BATMAN!"
        mes$(1) = ""
        Info
        a = RND * 359
        px! = spx! + (RND - pf!) * 20
        py! = spy! + (RND - pf!) * 5
        WormHole
        LMdistort '                                                   optional
        GOSUB PlotVehicle
        timemachine
    LOOP UNTIL TIMER > wu!
    radarf = wradar
    dead$ = "BATMAN"
END IF
 
IF (ek(5) >= 0) AND (ek(5) < 15) THEN dead$ = "HIT BY COMET"
IF ufof AND (ek(6) >= 0) AND (ek(6) < 45) THEN dead$ = "HIT BY ALIEN"
RETURN
 
GetAlt:
alt! = (gety(-(rxm + wi2)) - ((sy1 + sy2) \ 2)) / 5
RETURN
 
Instruments:
osc = 8
IF gs THEN LoadPanel '                                                graphics start not zero, instrument panel is on
IF (warp! > 0) AND (contact = 0) THEN
    IF warp! >= t THEN
        dead$ = "WARP 10"
        RETURN
    END IF
    RESTORE warp
    FOR i = 1 TO INT(warp!)
        READ z$
    NEXT i
    w$ = LTRIM$(STR$(INT(warp! * h) / h))
    IF LEN(w$) = 1 THEN w$ = w$ + ".00"
    IF LEN(w$) = 3 THEN w$ = w$ + "0"
    mes$(0) = "WARP " + w$ + " - " + z$
    IF gs AND ((TIMER MOD t) > 5) THEN
        Henonp f
        Wave '                                                        osc = 5 if commented out
        AuHoVe auto, hover, vert, lam
        GOTO clock
    END IF
END IF
 
IF gs = 0 THEN RETURN '                                               graphics start of 0 means the instrument panel is off
 
IF panelinit = 0 THEN
    IF crash THEN f = 15 ELSE f = ((f + 1) MOD 5) + t '               title graphic/face
END IF
 
Henonp f '                                                            title graphic
 
LINE (0, 0)-(gs - 1, 3), blue2, BF '                                  clear map area
 
IF pdiv THEN '                                                        instrument update frequency 1-4, mainly a way to slow down erratic thrust display
    j = 0
    FOR i = 1 TO 18 '                                                 my name in Morse
        p = VAL(MID$("002032023222300032", i, 1)) '                   Frost
        IF p < 3 THEN LINE (14 + j, 2)-(14 + j + p, 2), white
        j = j + p + 2
    NEXT i
END IF
 
IF (contact + auto + hover + vert + liftoff) = 0 THEN
    IF (vy! > .6) AND (-fy! < 0) THEN PrintVGA CHR$(24), 5, 241, red, black2
    IF (vy! < .4) AND (-fy! > -.01) THEN PrintVGA CHR$(25), 5, 250, yellow, black2
END IF
 
AuHoVe auto, hover, vert, lam
 
IF tfollow THEN '                                                     terrain following!
    FOR ty = glmax - 20 TO glmax
        FOR tx = 0 TO gs - 1
            IF POINT(tx, ty) = blue THEN PSET (tx, ty), red '         red bg
        NEXT tx
    NEXT ty
    FOR i = 0 TO 4 '                                                  TF
        p& = VAL("&H" + MID$("E744464444", i * 2 + 1, 2))
        LINE (2, 339 + i)-(10, 339 + i), green, , p& * 128
    NEXT i
END IF
 
osc = 0
c = LEDc
IF (sbest! >= h) OR powerloss THEN c = red
z! = thrust!: IF z! > h THEN z! = h '                                 200 at liftoff, show 100
PrepAndShowLED z!, 3, 1 '                                             thrust osc1
PrintCGA "T", 5, -1, c, -blue, 0 '                                    T is for flame
i = LEDc: j = black
IF jitter THEN SWAP i, j '                                            thrust calc type
LINE (4, 231)-(5, 232), i, B '                                        left light  (on = slow)
LINE (13, 231)-(14, 232), j, B '                                      right light (on = fast)
Bar z! / h, 0
 
c = dcolor(vy!, 2, 3, 1) '                                            vy osc2
z! = vy!
IF ABS(z!) > 99.97 THEN z! = 99.99
PrepAndShowLED z!, 3, 2
PrintCGA "V", 5, -1, c, -blue2, 0
z! = (z! + 3) / 6
Bar z!, 1
 
c = dcolor(vx!, 2, 3, 1) '                                            vx osc3
IF warp! THEN
    z! = warp!
ELSE
    z! = vx! + rfs!
END IF
PrepAndShowLED z!, 3, 2
PrintCGA "H", 5, -1, c, -blue, 0
z! = (z! + 3) / 6
Bar z!, 1
 
GOSUB GetAlt '                                                        alt osc4
IF contact AND (alt! > 0) THEN alt! = 0
c = dcolor(alt!, t, 3, -1)
PrepAndShowLED alt!, 4, 1
PrintCGA "A", 5, -1, c, -blue2, 0
IF warp! OR (radarf = 0) THEN z! = 0 ELSE z! = alt! / 60
Bar z!, 0
 
'IF rick = 1 THEN
'zz = ((suri + px!) MOD q1) \ (q3 + 1) + 1
'TinyFont LTRIM$(STR$(zz)), 11, 125, LEDc '                           optional area
'TinyFont LTRIM$(STR$(gh)), 11, 131, LEDc '                             "     ground
'END IF
 
c = dcolor(fuel!, t, 5, -1) '                                         fuel osc5
PrepAndShowLED fuel!, 4, 1
PrintCGA "F", 5, -1, c, -blue, 0
z! = fuel! / h
Bar z!, 0
 
clock:
IF TIMER < start2! THEN start2! = TIMER '                             midnite crossing
IF crash = 0 THEN el! = el! + (TIMER - start2!) '                     elapsed time
start2! = TIMER
IF el! >= 1 THEN
    WHILE el! >= 1 '                                                  catch-up
        el! = el! - 1
        sec = (sec + 1) MOD 60
        IF sec = 0 THEN min = (min + 1) MOD 99
    WEND
    IF sec MOD 5 = 0 THEN '                                           change title graphic
        IF crash THEN f = 15 ELSE f = ((f + 1) MOD 5) + t
    END IF
END IF
z$ = RIGHT$("0" + LTRIM$(STR$(min)), 2) + RIGHT$("0" + LTRIM$(STR$(sec)), 2)
osc = 6
LEDdisplay z$ '                                                       clock osc6
 
i = suri + px!
j = ABS(i - sf(5, 2))
k = sf(5, 2) + (q1 - i)
IF j <= 3200 THEN dtm! = j ELSE dtm! = k
PrepAndShowLED dtm!, 4, 0 '                                           dtm osc7
PrepAndShowLED CSNG(speed), 4, 0 '                                    speed osc8
 
ShowAngle a '                                                         angle osc9
 
'IF rick > 0 THEN '                                                   show stats
'   FOR i = -2 TO 0
'       z$ = STR$(FRE(i))
'       IF i = -2 THEN z$ = " " + MID$(f$(38), 6, 1) + z$  ' star file
'       TinyFont z$, 3, 295 + i * 6, gunmetal
'   NEXT i
'   PrintCGA MID$("DOSBOX", dosbox * 3 + 1, 3), 3, 270, red, black, 0
'END IF
 
panelinit = 1
RETURN
 
LMcolors: '                                                           optional
IF contact OR (vx! = 0) THEN lbit = 0
IF (contact + vx!) = 0 THEN
    v1 = RND * 3
    v2 = RND * 3
    SWAP LMci(v1), LMci(v2)
END IF
FOR i = 1 TO rp '                                                     right pad
    oc = LMoc(i)
    LMc(i) = oc
    IF (oc = craft) OR (oc = red) THEN '                              shadow
        zx = LMrx(i) - px! + 2 - xoff * (inpause = 0)
        zy = LMry(i) - py!
        IF (oc = craft) AND ((warp! > 0) OR (zy > zx)) THEN
            tc = gray2
        ELSE
            tc = oc
        END IF
        LMc(i) = tc
    END IF
    IF (i < 279) AND (LMoc(i) = black2) THEN '                        Ascent stage cycle
        lbit = (lbit + 5) MOD 4
        LMc(i) = LMci(lbit)
    END IF
NEXT i
lbit = lbit - (vx! > 0) * 2 + ASO * t
RETURN
 
PlotVehicle:
IF warp! < 1 THEN
    wda = 0
ELSE
    px! = wx!: py! = wy!
    wda = warp! * 5 * s!((px! + 40) MOD tsix)
END IF
 
IF crash THEN
    FOR i = 1 TO rp
        PSET (LMrx(i), LMry(i)), LMc(i)
    NEXT i
    GOTO endproc
END IF
 
IF bolthit = 0 THEN GOSUB LMcolors
 
i = sf(4, 2) - 50 '                                                   left of volcano
j = sf(4, 2) + 50 '                                                   right of volcano
k = suri + px! '                                                      LM position
IF (k > i) AND (k < j) THEN '                                         in the locality?
    c = 0 '                                                           count
    FOR ty = py! + 8 TO py! + 18 '                                    leg/nozzle area
        FOR tx = px! - 17 TO px! + 17
            p = POINT(tx, ty) '                                       what color is the pixel?
            c = c - (p = orange) '                                    hot lava
        NEXT tx
    NEXT ty
    ' LINE (px! - 17, py! + 8)-(px! + 17, py! + 18), yellow, B '      diagnostics
    IF c THEN '                                                       contacted some lava
        FOR i = rp TO 1 STEP -1 '                                     from the bottom
            IF LMoc(i) = craft THEN '                                 is normal color?
                LMoc(i) = red '                                       make red
                nred = nred + 1 '                                     keep track of count
                c = c - 1
                IF c = 0 THEN EXIT FOR '                              enough
            END IF
        NEXT i
    END IF
END IF
 
IF nred = 0 THEN '                                                    number red
    temp = 0
    rtlc(1) = 0
ELSE
    IF ASO THEN z = 115 ELSE z = 223 '                                max that COULD be normal
    otemp = temp
    temp = (nred * h / z) MOD 101 '                                   temperature
    rtlc(1) = temp
    IF temp > otemp THEN rtl!(1) = TIMER + 5
    c = 24 '                                                          gasoline
    IF temp > 30 THEN c = 32 '                                        dark red
    IF temp > 60 THEN c = 4 '                                         red
    IF temp = h THEN c = 15 '                                         white
    IF bw = 0 THEN PALETTE gasoline, c
    IF (temp = h) AND (invincible = 0) THEN dead$ = "FRIED BY VOLCANO"
    FOR i = 0 TO 20 '                                                 cool down some
        j = RND * rp
        IF LMoc(j) = red THEN LMoc(j) = craft: nred = nred - 1
    NEXT i
END IF
 
n = rp '                                                              last pixel = right pad
IF fuel! > 0 THEN GOSUB Exhaust '                                     maybe vehicle only
 
IF n > maxn THEN maxn = n
'IF maxn > 1400 THEN END '                                             beyond array size
'debug$ = LTRIM$(STR$(maxn))
 
ta = a + ma '                                                         temp a = a + malfunction
zz = ta * -(ABS(ta) > 4) '                                            rotate beyond 5 degrees
ta = (zz + wda + tsix) MOD tsix '                                             keep in array bounds
c! = c!(ta) '                                                         cosine
s! = s!(ta) '                                                         sine
ta = zz '                                                             angle to use
 
rfx = 0 '                                                             optional craft jitter
rfy = 0
rfs! = 0 '                                                            random change in vx
IF (jitter = 1) AND (cut = 0) THEN '                                  not slow or engine cut
    IF (RND > .9) AND (a = 0) THEN '                                  a = angle
        IF RND > pf! THEN rfx = 1 ELSE rfx = -1 '                     half right, half left
        rfs! = rfx * .01 * (INT(RND * 9) + 1) '                       how much? .01 - .09
    END IF
    IF RND > .9 THEN '                                                y jitter, 1 chance in 10
        IF RND > pf! THEN rfy = 1 ELSE rfy = -1 '                     half down, half up
    END IF
END IF
 
IF doclock THEN
    i = VAL(MID$(TIME$, 1, 2))
    j = VAL(MID$(TIME$, 4, 2))
    k = VAL(MID$(TIME$, 7, 2))
    clocka(0) = (i + j / 60) * 30 '                                   hour hand
    clocka(1) = j * 6 '                                               minute hand
    clocka(2) = k * 6 '                                               seconds
    FOR z = 0 TO 2 '                                                  prep for radians
        clocka(z) = (clocka(z) + 270) MOD tsix
    NEXT z
    ao = 0 '                                                          angle offset
ELSE
    ao = (ao + 1) MOD 361
END IF
 
tvx = SGN(vx!): IF tvx = 0 THEN tvx = 1
tao = ao * tvx
sco = sco XOR 1
IF doclock THEN sco = 0
IF sco THEN tc = red ELSE tc = lmsl
z3 = tsix + (shield = 0) * 361
FOR z2 = 0 TO z3
    a2 = (z2 + tao * 5 + tsix0) MOD tsix
    tx = px! + 50 * c!(a2) * aspect!
    ty = py! + 50 * s!(a2)
    IF ty < gety(tx) THEN
        IF (z2 MOD 30) = 0 THEN
            CIRCLE (tx, ty), 1, tc, , , .75
            IF geof THEN
                FOR i = z2 - 120 TO z2 STEP 30
                    j = (i + tsix) MOD tsix
                    tx2 = px! + 60 * c!(j) * aspect!
                    ty2 = py! + 60 * s!(j)
                    LINE (tx, ty)-(tx2, ty2), tc
                NEXT i
            END IF
        END IF
        IF doclock THEN
            FOR i = 0 TO 2
                IF a2 = clocka(i) THEN
                    c = VAL(MID$("021404", i * 2 + 1, 2))
                    CIRCLE (tx, ty), 4 - i, c, , , .75
                    PAINT (tx, ty), c, c
                END IF
            NEXT i
        END IF
    END IF
NEXT z2
 
FOR i = 1 TO rp '                                                     rp = craft right pad
    LMrx(i) = px! + LMx(i) * c! + LMy(i) * s! + rfx '                 x rotated
    LMry(i) = py! - LMx(i) * s! + LMy(i) * c! + rfy '                 y rotated
    IF LMry(i) > glmax THEN LMry(i) = glmax '                         not below ground
    IF i = xp THEN sx0 = LMrx(i): sy0 = LMry(i) '                     save radar loc
    IF i = lp THEN sx1 = LMrx(i): sy1 = LMry(i) '                     save left pad loc
    IF i = rp THEN sx2 = LMrx(i): sy2 = LMry(i) '                     save right pad loc
    IF bolthit THEN LMc(i) = white
    PSET (LMrx(i), LMry(i)), LMc(i)
NEXT i
 
'PSET (sx3, sy3), green '                                             eh?
'FOR ii = -1 TO 1
'FOR jj = -1 TO 1
'PSET (sx3 + ii, sy3 + jj), green
'NEXT jj
'NEXT ii
IF fuel! < 95 THEN GOSUB flevel
  
eflag = 0 '                                                           determine flame climb
fx1 = 0 ' initialize for deflect
fx2 = 0
phg = (sx1 + sx2) \ 2 + ta * 2 '                                      point hit ground
 
tty! = py! + 26
 
FOR i = rp + 1 TO n '                                                 flame/fuel dump
    x = px! + LMx(i) * c! + LMy(i) * s! + rfx '                       x rotated
    y = py! - LMx(i) * s! + LMy(i) * c! + rfy '                       y rotated
    c = LMc(i) '                                                      fuel dump/flame
    IF warp! < 1 THEN GOSUB deflect '                                 deflect off ground
    c = ABS(c) '                                                      color
    PSET (x, y), c '                                                  flame particle
    IF i <= n3 THEN '                                                 main exhaust
        IF (i MOD t) = 1 THEN '                                       every 10th pixel
            LINE (x - 1, y)-(x + 1, y), c '                           make "+"
            LINE (x, y - 1)-(x, y + 1), c
        END IF
    END IF
NEXT i
 
IF rfx AND dump AND (a = 0) THEN vx! = vx! + rfs! '                   make jitter real
IF rfx AND (dump = 0) AND (a <> 0) THEN vx! = vx! + rfs!
 
endproc:
 
IF doclock THEN TextOnLM$ = LEFT$(TIME$, 5)
'IF showspeed THEN TextOnLM$ = LTRIM$(STR$(speed))
IF LEN(TextOnLM$) THEN GOSUB TextOnLM
 
GOSUB radar
 
fc = 0 '                                                              LGM flame count
IF (sf(3, 1) >= suri) AND (sf(3, 0) < (suri + q3)) THEN
    x1 = sf(3, 0) - suri
    y1 = gety(x1) - 14
    FOR x = x1 + 5 TO x1 + 15
        FOR y = y1 - 9 TO y1 + 12
            IF POINT(x, y) = yellow THEN fc = fc + 1
        NEXT y
    NEXT x
END IF
 
GOSUB KillThreats
     
geof = geof - 1 - (geof = 0)
 
IF ok AND (TIMER > wu2!) AND (INSTR(mes$(0), "IN CAR") = 0) THEN FlagandFireworks
 
mpass& = mpass& + 1
IF TIMER <= start1! THEN start1! = TIMER: mpass& = 1
speed = ((TIMER - start1!) / mpass&) * h * t
 
IF rick THEN GraphSpeed
 
IF magic = 1 THEN '                                                   magic landing, 1st step laser the surface to level
    sf = 0
    z = suri + px!
    IF z > q1 THEN z = z - q1
    sf(0, 0) = z - 35 '                                               cut out a swath 70 units wide
    sf(0, 1) = z + 35
    GOSUB lsurface '                                                  apply laser
    a = 0 '                                                           angle
    auto = 0 '                                                        autopilot
    vx! = 0 '                                                         cancel any x velocity
    vy! = 0 '                                                         cancel any y velocity
    py! = 331 + ASO * 9 '                                             ground has been cut to the lowest
    cut = 1 '                                                         signal engine off
    magic = 2
END IF
 
'                                                                     kill surface feature
IF firel AND ksf AND (contact = 0) AND (sf(sf, 2) > 0) THEN
    GOSUB lsurface
END IF
firel = ks '                                                          ks = keep shooting
 
'                                                                     terrain following
IF tfollow AND (contact = 0) AND (dump = 0) AND (liftoff = 0) THEN
    hover = 1
    hp = q1
    svx = SGN(vx!)
    IF svx < 0 THEN tx = sx1 ELSE tx = sx2
    la = ABS(vx!) * t
    IF la < t THEN la = t
    IF la > h THEN la = h
    FOR i = -(wi + 5) TO la
        j = tx + i * svx
        k = j
        IF k < 0 THEN k = k + q1
        IF k > q1 THEN k = k - q1
        z = gety(k)
        IF z < hp THEN hp = z: sx = j
    NEXT i
    cx = ABS(sx - tx)
    IF cx THEN
        cy = hp - t - ABS(a / 2) - sy1
        st! = cy / cx * (ABS(vx!) + 1)
        IF st! > 2 THEN st! = 2
        IF st! < -t THEN st = -t
        fst = -SGN(st!) * 2
        py! = py! + st!
        IF py! < 250 THEN py! = 250
    END IF
END IF
IF paraf THEN
    IF py! > 150 THEN mes$(0) = "Parachutes don't work in a vacuum!"
    Parachute
END IF
 
RETURN
  
TextOnLM:
IF (ASO = 0) AND (ABS(ta) < t) THEN
    lt = LEN(TextOnLM$)
    tx = px! - lt * 2 + rfx
    ty = py! + rfy
    IF ty > 340 THEN ty = 340
    TinyFont TextOnLM$, tx, ty, white
END IF
TextOnLM$ = ""
RETURN
 
KillThreats:
killed = 0
FOR i = 0 TO 20 '                                                     shells
    c1 = shield AND (shx(i) > 0) AND (shd(i) < 70) '                  shield on and shell close to LM
    c2 = firel AND (shx(i) > 0) '                                     fire laser and shell in air
    IF c1 OR c2 THEN
        killed = 1 '                                                  found something to kill
        tx = shx(i) - suri
        ty = shy(i)
        GOSUB LMfl '                                                  fl = fire laser
        IF LEN(dead$) THEN RETURN
        ExplodeShell i
    END IF
NEXT i
 
ks = 0
FOR i = 1 TO 6
    IF skyoff OR (ek(i) = -1) THEN GOTO ni3
    '                   CM DS BO BH WO Co
    '   kd = VAL(MID$(" 80150120 50 50 50", i * 3 + 1, 3))
    '   c1 = shield AND c0 AND (ek(i) < kd)
    '   IF (i = 2) AND (sy1 < borgt) THEN c1 = 0
    '   c2 = firel AND c0
    IF firel AND (exl(i) > gs) AND (exl(i) < q3) THEN
        killed = 1
        ks = 1
        tx = exl(i)
        ty = ey(i)
        IF laserb = 0 THEN laserb = 5
        IF laserb > 0 THEN
            GOSUB LMfl
            IF LEN(dead$) THEN RETURN
            k = (5 - laserb) * 4
            IF i > 1 THEN
                CIRCLE (tx, ty), k, yellow
                PAINT (tx, ty), yellow, yellow
            END IF
            laserb = laserb - 1
        END IF
        IF laserb = 0 THEN
            ks = 0
            IF i = 1 THEN
                mes$(1) = "The Dark Side has cookies!"
            ELSE
                FOR a2 = 0 TO tsix STEP 2
                    x2 = tx + RND * h * c!(a2) * aspect!
                    y2 = ty + RND * h * s!(a2)
                    LINE (tx, ty)-(x2, y2), gold
                NEXT a2
                ek(i) = -1
                exv(i) = 0
                exl(i) = -1
                IF (i = 2) AND lob THEN dead$ = "SELF-DESTRUCT"
            END IF
        END IF
    END IF
    ni3:
NEXT i
IF killed THEN ksf = 0 ELSE ksf = 1
RETURN
 
lsurface: '                                                           laser surface feature
z = (RND > .9) OR (magic = 1) '                                       1 out of 10 destroys, magic always
FOR i = sf(sf, 0) TO sf(sf, 1)
    tx = i - suri
    IF tx < 0 THEN tx = tx + q1
    ty = gety(tx)
    IF sf <> 3 THEN ty = ty + RND * (q4 - ty)
    IF i MOD 2 THEN GOSUB LMfl '                                      fire laser
    IF z THEN gh(i) = glmax '                                         level
NEXT i
IF z THEN
    Smooth sf(sf, 0) - 1 '                                            smooth transition from where the ground has been leveled, left side
    Smooth sf(sf, 1) '                                                                                                            , right side
    sf(sf, 2) = -1
END IF
RETURN
 
LMfl: '                                                               fire laser
IF (cwd < 50) AND (sy1 > szs) THEN '                                  in car wash?
    dead$ = "REFLECTED LASER"
    cwd = 999
    firel = 0
    laserb = 0
    ks = 0
    RETURN
END IF
FOR zx = -1 TO 1
    FOR zy = -1 TO 1
        LINE (sx0 + zx, sy0 + zy)-(tx, ty), lmsl
    NEXT zy
NEXT zx
geof = t
RETURN
 
flevel: '                                                             make fuel level when angle > 4
IF ASO THEN RETURN '                                                  no fuel shown with AS
ptk = (h - fuel!) * 2.7 '                                             pixels to kill
z = ptk '                                                             ptk used by ExplodeLM
x1 = px! - 16
x2 = px! + 14
y1 = py! - 15
y2 = py! + 15
'LINE (x1, y1)-(x2, y2), red, B
FOR y = y1 TO y2
    FOR x = x1 TO x2
        IF POINT(x, y) = fuel THEN
            PSET (x, y), black2
            z = z - 1
        END IF
    NEXT x
    IF z <= 0 THEN EXIT FOR
NEXT y
RETURN
 
deflect: '                                                            flame bounce
oz = gety(-x)
IF deflectat > 0 THEN oz = deflectat
z = oz
 
'       dump           side t      st in pause
IF (c = fuel) OR (c = -yellow) OR (c = -blue) THEN
    IF (fx1 > 0) AND (x < fx1) THEN z = 0
    IF (fx2 > 0) AND (x > fx2) THEN z = 0
    rf1 = RND * t + 1
    rf2 = RND * 20 - t
    IF y >= (z - 1) THEN '                                            yep, deflect it
        IF x < sx1 THEN
            IF fx1 = 0 THEN fx1 = x: fy1 = LMry(th1)
            x = fx1 + rf1
            y = fy1 + rf2
        ELSE
            IF fx2 = 0 THEN fx2 = x: fy2 = LMry(th2)
            x = fx2 - rf1
            y = fy2 + rf2
        END IF
    END IF
    RETURN
END IF
 
IF y >= (z - 1) THEN '                                                yep, deflect it
    IF sy1 < borgt THEN ky1 = 1: GOTO isborg
    '  IF aboveborg THEN ky1 = 1: GOTO isborg
    IF eflag = 0 THEN '                                               limit flame climbing
        eflag = 1 '                                                   only once per position
        xmin2 = phg - thrust! * 1.5 '                                 point hit ground
        xmax2 = phg + thrust! * 1.5
        u1 = 0 '                                                      up count l of nozzle
        u2 = 0 '                                                      up count r of nozzle
        wu1 = 0 '                                                     worst l up count
        wu2 = 0 '                                                     worst r up count
        ky1 = 0 '                                                     keep y
        ky2 = 0 '                                                     keep y
        FOR zz = phg TO phg - h STEP -1 '                             from LM center left
            z2 = gety(-zz): IF zz = phg THEN lz = z2
            k1 = z2 - lz
            lz = z2
            IF k1 > 0 THEN '                                          down
                u1 = 0
            ELSE
                u1 = u1 - k1 '                                        up
                IF u1 > wu1 THEN wu1 = u1 '                           worst up
            END IF
            IF u1 > 20 THEN xmin2 = zz + 2: EXIT FOR
            IF ABS(k1) > 20 THEN ky1 = 1 '                            90 degrees TMA etc
        NEXT zz
        FOR zz = phg TO phg + h '                                     from LM center right
            z2 = gety(-zz): IF zz = phg THEN lz = z2
            k2 = z2 - lz
            lz = z2
            IF k2 > 0 THEN '                                          down
                u2 = 0
            ELSE
                u2 = u2 - k2 '                                        up
                IF u2 > wu2 THEN wu2 = u2 '                           worst up
            END IF
            IF u2 > 20 THEN xmax2 = zz - 2: EXIT FOR
            IF ABS(k2) > 20 THEN ky2 = 1 '                            90 degrees TMA etc
        NEXT zz
    END IF
 
    isborg:
    r = thrust! * 2 + (RND - pf!) * 80
    x = (phg - r) + RND * (r * 2)
    k = ABS(x - phg + a * 2) / 4
 
    tx = x + suri '                                                   McDonalds
    IF (tx >= sf(5, 0)) AND (tx <= sf(5, 1)) AND (py! > 250) THEN
        ky1 = 0: ky2 = 0
    END IF
 
    IF (ky1 = 1) OR (ky2 = 1) THEN '                                  keep
        y = z - RND * k - 1: RETURN
    END IF
 
    x2 = (RND - pf!) * 20
    IF x < xmin2 THEN x = xmin2 + RND * (xmax2 - xmin2) + x2
    IF x > xmax2 THEN x = xmin2 + RND * (xmax2 - xmin2) - x2
 
    IF (platform > 0) AND (ABS(px! - (pminx + 17)) < 20) THEN
        y = y - platform
    ELSE
        y = gety(-x) - RND * k - 1
    END IF
 
    IF (deflectat > 0) AND (y > deflectat) THEN y = deflectat - (y - deflectat)
END IF
RETURN
 
CWceiling: '                                                          car wash
cwd = ABS((suri + px!) - sf(2, 2)) '                                  car wash distance
IF ASO THEN szs = 323 ELSE szs = 340 '                                safe zone start
IF (cwd < 69) AND (sy1 > 304) THEN '                                  lower than top of building
    IF sy1 >= q4 THEN '                                               touched down inside
        cc1 = -1
    ELSEIF sy2 >= q4 THEN '                                           touched down inside
        cc2 = -1
    ELSEIF sy1 > szs THEN '                                           in safe zone
        cc1 = 0
        cc2 = 0
        IF cwd < 50 THEN mes$(0) = "Washee washee no starchee!"
    ELSE
        IF (sy1 > (szs - t)) AND (sy1 <= szs) THEN '                  bouncing off ceiling
            cc1 = 0
            cc2 = 0
            vy! = 1
            py! = py! + 2
            'hover = 1
        END IF
    END IF
END IF
RETURN
 
CheckHit: '                                                           contact with ground
cc1 = ((sy1 + 1) >= gety(-sx1)) '                                     left pad
cc2 = ((sy2 + 1) >= gety(-sx2)) '                                     right pad
mingx = 0
mingy = q1
FOR zx = sx1 TO sx2 '                                                 check between pads
    zy = sy1 - 2
    p = POINT(zx, zy)
    IF p = gray THEN '                                                got 1
        ty = gety(-zx)
        IF ty < mingy THEN mingx = zx: mingy = ty
    END IF
NEXT zx
IF mingx THEN
    i = mingx - sx1
    j = sx2 - mingx
    IF i < j THEN cc1 = -1 ELSE cc2 = -1
END IF
 
GOSUB CWceiling '                                                     car wash
IF vy! < 0 THEN RETURN '                                              going UP
 
IF cc1 OR cc2 THEN '                                                  pad(s) on ground
    contact = 1
    tmt! = 0
    py! = py! + rfy '                                                 no time to correct jitter
    TexOnLM$ = ""
    warp! = 0
    GOSUB CutOrOutOfFuel
 
    IF (vy! > 0) AND ABS(sy1 - (ey(2) - 40)) < t THEN
        lob = 1 '                                                     landed on Borg
        vx! = vx! - exv(2)
    END IF
 
    IF (ABS(vx!) > t) OR (vy! > 20) THEN
        dead$ = "HIGH SPEED IMPACT!"
        RETURN
    END IF
 
    dp = 8 + (h - fuel!) \ 25 '                                       8 - 12
    IF (vy! > dp) OR (ABS(vx!) > 8) THEN '                            too fast given load
        crash = 1
        panelinit = 0
        shield = 0
        dead$ = "CRASHED"
        z = ABS(vx!) * t + ABS(vy!) * t
        FOR i = 1 TO rp '                                             create layer of debris
            LMrx(i) = LMrx(i) + RND * z - (z \ 2)
            LMry(i) = gety(LMrx(i)) - RND * 2 - 1
        NEXT i
        IF bw = 0 THEN
            PALETTE green, 0 '                                            blank instruments
            'PALETTE red, 32
            PALETTE yellow, 0
        END IF
        RETURN
    END IF
 
    IF (vy! > 3) OR (ABS(vx!) > 3) THEN fb$ = "vehicle damaged"
 
    IF (vy! > 4) OR (ABS(vx!) > 4) THEN
        fb$ = "vehicle severely damaged"
        LMdistort '                                                   randomly vary structure
        vsd = 1 '                                                     vehicle severely damaged
    END IF
 
    savea = a + ma
 
    IF lob THEN '                                                     landed on Borg
        a = 0
        IF sx1 < borgl THEN a = 45
        IF sx2 > borgr THEN a = -45
        py! = py! - t * (ABS(a) = 45)
        RETURN
    END IF
 
    '                                                                 optional, allow ANY part of pad
    IF cc1 THEN cd = -1: cpx = sx2: cpy = sy2 + 1
    IF cc2 THEN cd = 1: cpx = sx1: cpy = sy1 + 1
    FOR i = 1 TO 4
        cpx = cpx + cd
        IF (cpy >= gety(-cpx)) THEN
            IF cc1 THEN cc2 = 1 ELSE cc1 = 1
        END IF
    NEXT i
 
    IF NOT (cc1 AND cc2) THEN '                                       only 1 pad down
        npass = 0
        DO: _LIMIT mdelay * 2 '                                       settle LM
            a = a + (cc1 - cc2)
            pa:
            npass = npass + 1
            IF npass > 150 THEN EXIT DO
            GOSUB Plotscreen '                                        show change
            IF LEN(dead$) THEN EXIT DO
            IF ABS(a) > 40 THEN
                a = 180 '                                             upside down
                py! = glmax - ny
                LMdistort '                                           optional
                EXIT DO
            END IF
            IF cc1 AND (sy1 < gety(-sx1)) THEN py! = py! + 1: GOTO pa
            IF cc2 AND (sy2 < gety(-sx2)) THEN py! = py! + 1: GOTO pa
            cc3 = ((sy1 + 1) >= gety(-sx1))
            cc4 = ((sy2 + 1) >= gety(-sx2))
            IF ABS(a) > 80 THEN py! = glmax - wi2
 
            z = gety(INT(px!)) - py! - ny + 5
            IF (z < 0) AND (paraf = 0) THEN
                dead$ = "PUNCTURE DAMAGE"
                RETURN
            END IF
        LOOP UNTIL (cc1 AND cc4) OR (cc2 AND cc3)
    END IF
END IF
RETURN
 
slimit: '                                                             surface index bounds
z = 0
IF suri < 0 THEN z = q1
IF suri >= q1 THEN z = -q1
suri = suri + z
IF lock1 THEN lock1 = lock1 + z
RETURN
 
radar: '                                                              autopilot landing here too
IF contact OR liftoff THEN RETURN
z = SGN(vx!): IF z = 0 THEN z = 1
IF z = -1 THEN sbl = -280 ELSE sbl = 220
bt = (bt MOD 4) + 1
div = ABS(alt!) \ 2 + bt
 
IF right OR left THEN tvx! = sv! ELSE tvx! = vx!
IF ABS(tvx!) > 99 THEN tvx! = 99 * SGN(tvx!)
IF (tfollow = 0) AND (aboveborg OR ((radarf = 0) AND (auto = 0))) THEN tvx! = 0
bl = sbl * ABS(tvx!) + (sx1 - sx2)
IF ABS(bl) > ABS(sbl) THEN bl = sbl
IF auto = 0 THEN lock1 = 0
IF lock1 = 0 THEN rxm = sx2 + bl ELSE rxm = lock1 - suri
 
level = 1
FOR j = 0 TO wi '                                                     width (distance between pads)
    tx = rxm + j
    ty = gety(-tx)
    IF aboveborg AND (sx1 >= borgl) AND (sx2 <= borgr) THEN ty = borgt
    IF j = 0 THEN cmp = ty
    IF ABS(cmp - ty) > 1 THEN level = 0
NEXT j
 
IF level THEN
    IF auto AND (lock1 = 0) THEN '                                    automatic yet no current lock
        lock1 = suri + rxm - SGN(rxm) * 2 * (vx! <> 0) '              lock onto level ground
    END IF
    rbeam = green '                                                   radar beam color
ELSE
    lock1 = 0 '                                                       not level, cancel lock
    rbeam = red '                                                     radar beam color
END IF
 
'IF lock1 <> olock1 THEN
'   LOCATE 2, 10: PRINT lock1; olock1;
'   timemachine
'   WHILE INKEY$ = "": WEND
'   olock1 = lock1
'END IF
 
rpass = rpass XOR 1
IF level AND (vx! = 0) THEN
    div = div \ 2
    IF div < 1 THEN div = 1
    IF rpass THEN rbeam = 0
END IF
 
FOR i = 0 TO (wi + 1) STEP 5
    IF vx! > 0 THEN tx = rxm + i ELSE tx = rxm + wi - i
    IF aboveborg THEN
        tx = sx1 + i
        ty = borgt
    ELSE
        ty = gety(tx)
    END IF
    IF (warp! < 1) AND (ty > sy0) AND (radarf > 0) THEN GOSUB rbeam
NEXT i
 
IF auto = 0 THEN GOTO end6
IF aboveborg OR (abort = 0) THEN GOTO skipit
 
abort:
hover = 1
hoverc = 0
lock1 = 0
 
i = (py! > 120) '                                                     too low
j = NOT ((vx! = 0) AND (level = 1)) AND (ABS(vx!) < (ideal! - .05)) ' too slow
k = (ABS(vx!) > (ideal! + .05)) '                                     too fast
IF i THEN wa = -ma: hoverc = -3
IF j THEN wa = 4 * -z + ma
IF k THEN
    wa = ABS(vx!) * z - ma
    IF ABS(wa) > 20 THEN wa = 20 * z
END IF
IF i OR j OR k THEN abort = 1: GOTO end6
abort = 0
 
skipit:
IF lam THEN '                                                         land at McDonalds
    dis = ABS((suri + rxm) - sf(5, 2))
    IF dis > 80 THEN level = 0: lock1 = 0
END IF
wa = -ma ' want angle = -malfunction angle
 
IF dflag THEN dump = 0: dflag = 0
IF level = 0 THEN '                                                   locked onto a target
    abort = 1
ELSE
    ddd = ABS(px! - rxm)
    IF (ddd < 120) AND (lock1 > 0) AND (auto = 1) AND (fuel! > 70) THEN
        dump = 1
        dflag = 1
    END IF
    IF ddd < h THEN '                                                 100 clicks away
        hover = 0 '                                                   stop hovering
        vert = 1 '                                                    start moving down
        dist = sx1 - rxm '                                            distance to target
        thv! = ABS(dist) / 27 '                                       to horizontal velocity
        IF thv! < .08 THEN mu = 1 ELSE mu = 4
        IF thv! < .01 THEN mu = 0
        IF aboveborg = 0 THEN
            ' IF okrick THEN
            '     LOCATE 3, 11: PRINT dist;
            '     LOCATE 4, 11: PRINT vx!;
            ' END IF
            ' IF (SGN(vx!) = SGN(dist)) OR (ABS(vx!) > thv!) THEN wa = wa + mu * z
            IF ABS(vx!) > thv! THEN wa = wa + mu * z
        END IF
    END IF
END IF
end6:
GOSUB angle
RETURN
 
rbeam:
dx! = (tx - sx0) / div
dy! = (ty - sy0) / div
FOR j = 1 TO q1
    tx = sx0 + j * dx!
    ty = sy0 + j * dy!
    my = gety(-tx)
    IF ty >= my THEN
        IF (tx < rxm) OR (tx > (rxm + wi + 1)) THEN level = 0: rbeam = red
        EXIT FOR
    END IF
    IF i AND (rbeam > 0) THEN
        PSET (tx, ty), rbeam
        IF radarf = 2 THEN PSET (tx + 1, ty), rbeam
    END IF
NEXT j
RETURN
 
angle:
IF dump THEN RETURN
cf = 0
IF a <> wa THEN '                                                     current angle, wanted angle
    w = a '                                                           was = angle
    a = a + SGN(wa - a)
    change = a - w
    IF change THEN
        cf = 1
        a1 = ABS(w + ma)
        a2 = ABS(a + ma)
        IF (a1 > 4) OR (a2 > 4) THEN wan = 3 '                        activate up/down
    END IF
END IF
     
IF liftoff OR ((auto = 0) AND (vert = 1) AND (ma = 0)) THEN RETURN
cp = (a <> 0) AND (RND < .01) '                                       clear problem
 
IF cf OR cp THEN
    IF cp OR (RND < .01) THEN
        z = ma
        IF cp THEN ma = 0 ELSE ma = a
        IF ma <> z THEN '                                             new malfunction angle
            IF ma THEN
                z$ = LTRIM$(STR$(-ma))
                IF ma < 0 THEN z$ = "+" + z$
                mes$(0) = "DANGER! STUCK THRUSTER " + z$
                IF auto THEN a = a - ma: wa = a - ma '                immediate correct
            ELSE
                mes$(0) = "THRUSTERS OK"
                IF auto THEN a = a + z: wa = a + z '                  immediate correct
            END IF
        END IF
    END IF
END IF
RETURN
 
Exhaust:
IF inpause THEN tflame = blue ELSE tflame = flame
 
IF cut THEN thrust! = 0
d = thrust! - (RND * 20 - t) * (thrust! > 0)
x = (LMx(lp) + LMx(rp)) \ 2 '                                         halfway between pads
 
IF ASO THEN '                                                         ascent stage only
    i = 30 '                                                          divisor for exhaust width
    j = 1 '                                                           throwing x off up to this amount
    k = 3 '                                                           flame decrement
    y = ny + 1 '                                                      starting y
ELSE
    i = 20 '                                                          divisor for exhaust width
    j = 2 '                                                           throwing x off up to this amount
    k = 2 '                                                           flame decrement
    y = ny - 3 '                                                      starting y
END IF
 
WHILE d > 0 '                                                         until thrust decremented to 0
    p = d \ i
    FOR z = -1 TO 1 STEP 2
        FOR jj = 0 TO 3
            n = n + 1 '                                               add to vehicle daa
            IF n > 1400 THEN END '                                    beyond array size
            LMx(n) = x + p * z + RND * (j * 2) - j
            LMy(n) = y + RND * 2
            IF (powerloss > 0) AND (RND < .3) THEN zz = orange ELSE zz = tflame
            LMc(n) = zz '                                             yellow normally, blue during pause
            IF RND > .95 THEN '                                        some way off plume for realism
                LMx(n) = LMx(n) - RND * 80 + 40
                LMy(n) = LMy(n) + 5
            END IF
        NEXT jj
    NEXT z
    y = y + 1 '                                                       next flame row
    d = d - k '                                                       decrement temp thrust
WEND
n3 = n '                                                              main/side thrusters
 
'                                                                     if there's a thruster malfunction, may have both thrusters active
IF (ma = 0) OR (a = 0) OR (SGN(a) = SGN(ma)) THEN
    ta = a + ma
    pass = 1
ELSE
    ta = a
    pass = 2
END IF
IF dump THEN ta = t
 
dors: '                                                               dump fuel or sideways motion
IF liftoff THEN ta = 0
IF rfx AND (dump = 0) THEN ta = rfs! * 50
IF (contact = 1) AND (dump = 0) THEN ta = 0: wan = 0: super = 0
IF ta <> 0 THEN
    IF ta < 0 THEN th0 = th1: z! = -2
    IF ta > 0 THEN th0 = th2: z! = 2
    zz = ta: IF zz > t THEN ta = t
    tt = ABS(zz * 4 + 4 * SGN(ta))
    IF ABS(zz) > 20 THEN tt = t
    DO
        n = n + 1
        LMx(n) = LMx(th0) + z! + RND * 2 - 1
        LMy(n) = LMy(th0) + (RND * 2 - 1) * (ABS(ta) > 2)
        IF dump THEN
            tc = fuel
            z = 20 - 20 * s!(90 + (LMx(n) - LMx(th0)) * 1.8)
            IF a = 180 THEN z = -z
            LMy(n) = LMy(n) + z
        ELSE
            tc = -tflame
        END IF
        LMc(n) = tc
        tt = tt - 1
        z! = z! * 1.15
    LOOP UNTIL (tt = 0) OR (ABS(z!) > 40)
    IF dump THEN
        ta = -ta
        IF lockfuel = 0 THEN fuel! = fuel! - .1 + (fuel! > 5) * 2
        IF ta = -t THEN GOTO dors
        IF fuel! < 1 THEN dump = 0
    END IF
END IF
pass = pass - 1
IF pass THEN ta = ma: GOTO dors
noside:
 
'                                                                     super - use side thrusters to augment main thrust when more than
'                                                                     100% thrust is called for
IF dump THEN RETURN
IF fst OR super OR (wan > 0) THEN '                                   up/down to change angle beyond 5 degrees
    IF change > 0 THEN th1d = -1: th2d = 1
    IF change < 0 THEN th2d = -1: th1d = 1
    IF super THEN th1d = 1: th2d = 1
    IF fst THEN th1d = fst: th2d = fst: fst = 0
    FOR z = 0 TO 6
        n = n + 1
        LMx(n) = LMx(th1) + RND * 2
        LMy(n) = LMy(th1) + th1d * (z + RND * 2) + 2
        LMc(n) = tflame '                                             blue flame in pause
        n = n + 1 '                                                   other thruster opposite
        LMx(n) = LMx(th2) + RND * 2 - 2
        LMy(n) = LMy(th2) + th2d * (z + RND * 2) + 2
        LMc(n) = tflame
    NEXT z
    wan = wan - 1
    IF wan = 1 THEN change = -change
END IF
 
RETURN
 
init1: '                                                              only done once
DATA convo,f1,f2,lmx1,lmy1,lmc1,lmx2,lmy2,lmc2
DATA h1,h2,h3,h4,h5,h6,cybill,surv2,cm,rad,af2,sf2,panel
DATA sd,sl,s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,panel0,panel1
DATA dstarm,stars,lanblank,alien
 
RESTORE init1
IF _FILEEXISTS("rick.") THEN okrick = 1
tc$ = UCASE$(COMMAND$ + "   ")
IF LEFT$(tc$, 1) = "/" THEN tc$ = "   "
IF INSTR(tc$, "DOS") THEN dosbox = 0 '                                use large star file
IF INSTR(tc$, "BOX") THEN dosbox = 1 '                                use small star file
IF INSTR(tc$, "CD ") THEN iscd = 1 '                                  simulate CD
IF INSTR(tc$, "UFO ") THEN ufof = 1 '
IF _FILEEXISTS("cd.dat") THEN iscd = 1 '                              include/create this file for CD/DVD distribution (read only)
 
z = 0
FOR i = 1 TO 40
    READ f$(i)
    IF i = 38 THEN '                                                  stars
        j = 2 - dosbox '                                              1=small, 2=medium, 3=huge
        f$(i) = f$(i) + CHR$(48 + j)
    END IF
    IF i THEN
        f$(i) = f$(i) + ".dat" '                                      try lowercase first
        IF _FILEEXISTS(f$(i)) = 0 THEN
            f$(i) = UCASE$(f$(i)) '                                   try uppercase (Linux cares!)
            IF _FILEEXISTS(f$(i)) = 0 THEN
                z = z + 1
                IF z = 1 THEN CLS
                PRINT f$(i)
            END IF
        END IF
    END IF
NEXT i
IF z THEN
    PRINT
    PRINT "Above file(s) missing"
    SLEEP
    SYSTEM
END IF
 
s& = VARSEG(p(0, 0))
o& = VARPTR(p(0, 0))
DEF SEG = s&
BLOAD "F1.dat", o&
z$ = "386C6C38" '                                                    degree symbol
FOR i = 0 TO 3
    p(0, i) = VAL("&H" + MID$(z$, i * 2 + 1, 2))
NEXT i
 
s& = VARSEG(p2(0, 0))
o& = VARPTR(p2(0, 0))
DEF SEG = s&
BLOAD "F2.dat", o&
 
canvas& = _NEWIMAGE(640, 350, 9)
SCREEN canvas&
_ALLOWFULLSCREEN _STRETCH , OFF
_SCREENMOVE _MIDDLE
_MOUSEHIDE
_MOUSEMOVE 1, 1
_TITLE "Lander"
RANDOMIZE TIMER
auto = 0 '                                                            full automatic
background = 1 '                                                      textured LED displays
cbh = 0 '                                                             constant black holes
darkstars = 1 '                                                       spin
darkstart = 1 '                                                       thickness of lines
demo = 0 '                                                            cram onto one page
doclock = 0 '                                                         shield effect
gh = 9
gs = 85 '                                                             graphics start
glmax = q4 '                                                          ground level max
glmin = glmax - 49 '                                                  ground level min
gs = 85 '                                                             graphics start (flying area)
'gstyle = 5
invincible = 1 '                                                      easier for beginner, thrusters gold
jitter = 1 '                                                          thrust calc
LED$ = "021404120115" '                                               color sequence - gr ye re or gun wh
LEDc = green '
LEDtri = 0 '                                                          off
mdelay = t '                                                          master delay
opower = 62 '                                                         original thrust factor
pdiv = 0 '                                                            instrument update
radarf = 1
restart = 0 '                                                         shift-d load defaults
segs$ = "abcdefg" '                                                   for 7 segment displays
settings$ = "LANDER.SET"
shield = 0 '                                                          Star Trek!
showmap = 0 '                                                         silly legend at top
skyoff = 1 '                                                          DS, BH, Wo, Co
starfiles = 1 '                                                       dat1, dat2, dat3
starstatus = 1 '                                                      show stars only, no names/info
twinkle = 0
zoom = 1 '                                                            starfield 6 hours 45 degrees
 
black = 0: blue = 1: green = 2: gunmetal = 3: red = 4: gasoline = 5
gray2 = 6: white = 7: gray = 8: dred = 9: gold = 10: black2 = 11
orange = 12: blue2 = 13: yellow = 14: white2 = 15
 
craft = white: flame = yellow: fuel = gasoline: LEDc = green
LMci(0) = gray2 '                                                     ASO shifting colors
LMci(1) = gold
LMci(2) = gray2
LMci(3) = black2
 
IF _FILEEXISTS(settings$) THEN
    OPEN settings$ FOR INPUT AS #1
    INPUT #1, g$, auto
    INPUT #1, g$, background
    INPUT #1, g$, cbh
    INPUT #1, g$, demo
    INPUT #1, g$, doclock
    INPUT #1, g$, invincible
    INPUT #1, g$, jitter
    INPUT #1, g$, LEDc
    INPUT #1, g$, LEDtri
    INPUT #1, g$, radarf
    INPUT #1, g$, shield
    INPUT #1, g$, showmap
    INPUT #1, g$, starstatus
    INPUT #1, g$, zoom
    INPUT #1, g$, skyoff
    INPUT #1, g$, gstyle
    INPUT #1, g$, mouseswap
    INPUT #1, g$, porb
    INPUT #1, g$, starfiles
    INPUT #1, g$, mdelay
    INPUT #1, g$, fsf
    CLOSE #1
END IF
IF fsf THEN
    _FULLSCREEN
ELSE
    IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFF
END IF
 
FOR i = 0 TO tsix '                                                    table faster
    s!(i) = SIN(_D2R(i))
    c!(i) = COS(_D2R(i))
NEXT i
 
clines = 0
OPEN f$(1) FOR INPUT AS #1 '                                          convo.dat, LM/CM chatter
WHILE NOT (EOF(1))
    clines = clines + 1
    LINE INPUT #1, convo$(clines)
WEND
CLOSE #1
 
s& = VARSEG(cmp&(0)) '                                                Command Module
o& = VARPTR(cmp&(0))
DEF SEG = s& '                                                        cm.dat
BLOAD f$(18), o&
 
IF (RND > .95) AND (okrick = 0) AND (INSTR(COMMAND$, "NOS") = 0) THEN MakeSur
 
start1! = TIMER
RETURN
 
init2: '                                                              each cycle
a = 0 '                                                               angle
a51i = 0
ASO = 0 '                                                             ascent stage only = false
boltc = 0 '                                                           lightning count
center = 362
contact = 0 '                                                         with ground
convo = 0 '                                                           with CM
crash = 0
cut = 0 '                                                             engine
dump = 0 '                                                            fuel
eou = 0 '                                                             end of universe
fb$ = "" '                                                            landing feedback
flx = 0 '                                                             where to plot flag
fuel! = h
hover = 1 '                                                           start safe
ideal! = 2.7 '                                                        autopilot speed
inpause = 0
jf = -1 '                                                             jump to feature
LGMc = 1 '                                                            little green man color
lmsl = blue '                                                         LM shield & laser
lob = 0 '                                                             landed on Borg
lock1 = 0 '                                                           radar tracking
lockfuel = 0
ma = 0 '                                                              malfunction angle
magic = 0 '                                                           landing
mes$(0) = "" '                                                        messages ^ landing eval
mes$(1) = "" '                                                        radiation, landing comments
ok = 0 '                                                              landing status
panelinit = 0 '                                                       instruments
paraf = 0 '                                                           parachute flag
pif = -1 '                                                            counter for instruments
platform = 0 '                                                        for detached DS
power = opower '                                                      thrust factor
powerloss = 0 '                                                       random malfunction
px! = 320 '                                                           vehicle x
py! = 70 '                                                            vehicle y
radiationdeath = 0 '                                                  rads > 1000
rads = 0 '                                                            radiation count
rlink = 0 '                                                           LM/CM radio link
rmin = RND * 23 '                                                     stars right ascension 0 - 23
dmin = (INT(RND * 18) - 9) * t '                                      stars declination -90 to 90
sia = 0 '                                                             shells in air
sspinit1 = 0
sspinit2 = 0
starinit = 0
tfollow = 0 '                                                         terrain following
tmt! = 0 '                                                            to move total
wa = 0 '                                                              wanted angle
vert = 1 '                                                            vertical autopilot on
vsd = 0 '                                                             vehicle severely damaged
 
Setcolor
GetSurface gh
 
IF demo THEN
    auto = 0
    px! = sf(6, 2) - 3130 '                                           TMA
    py! = 130
    sf = 6 '                                                          surface feature
    suri = 3130 '                                                     surface index
    vx! = 0 '                                                         not moving
    vy! = 0
ELSE
    a = RND + t
    IF RND > pf! THEN a = -a
    sf = 4
    suri = RND * q1
    px! = 320
    thrust! = 95
    vx! = SGN(a) * 5
    vy! = RND + 1
END IF
 
ERASE exv, ei, ek, rtl!, rtlc, shx, shd
 
mes$(0) = "F1 FOR HELP AND INFORMATION"
IF ufof > 0 THEN mes$(1) = "Alien on the loose!" '                    10% active
IF LEDtri THEN LEDc = green
GOSUB ReadLM
start2! = TIMER '                                                     elapsed time clock
sec = 0
min = 0
RETURN
 
PlotGround:
IF crash = 0 THEN
    surd = SGN(tmt!) '                                                direction
    tomo = INT(ABS(tmt!)) '                                           to move
    IF tomo > (q3 - gs) THEN tomo = q3 - gs
    tmt! = tmt! - tomo * surd '                                       to move total
    suri = suri + tomo * surd '                                       surface index
    GOSUB slimit '                                                    limit values to 0-6399
END IF
         
IF gh = -1 THEN '                                                     ground height = flat
    LINE (gs, q4)-(q3, q4), gray
    GOTO stuff
END IF
 
FOR x = gs TO q3 '                                                    graphics start to 639
    z = (suri + x) MOD q1
    'IF showspeed THEN tc = gc(z) ELSE tc = gray
    tc = gray
    IF (z >= sf(5, 0)) AND (z <= sf(5, 1)) THEN
        PSET (x, glmax), tc '                                         optional McD fix
    ELSE
        IF (z >= sf(7, 0)) AND (z <= sf(7, 1)) THEN '                 Surveyor
            'y = gh(sf(7, 0))
            y = glmax
        ELSE
            y = gety(x)
        END IF
        SELECT CASE gstyle
            CASE IS = 0 '                                             solid
                LINE (x, y)-(x, glmax), tc
            CASE IS = 5 '                                             solid
                LINE (x, y)-(x, glmax), tc
            CASE IS = 1 '                                             fancy
                LINE (x, glmax)-(x, y), black2
                LINE -(x, glmax), tc, , z + y
                PSET (x, y), tc
            CASE IS = 2
                LINE (x, y)-(x, glmax), tc
                ty = y + 5
                IF ty < glmax THEN
                    LINE (x, ty)-(x, glmax - 1), black, , &HFEFE
                END IF
            CASE ELSE '                                               minimal or tiling
                LINE (x, glmax)-(x, y), black2
                LINE -(x, y + 3), tc
        END SELECT
    END IF
NEXT x
 
IF gstyle > 3 THEN Tile
 
stuff:
FOR i = 1 TO t
    ' Surv before IBM+TMA, IBM before TMA, LGM last
    '              1 2 3 4 5 6 7 8 9 0
    j = VAL(MID$("01070802040506091003", (i - 1) * 2 + 1, 2))
    z = VAL(MID$("80000080000080000000", (j - 1) * 2 + 1, 2))
    fb = sf(j, 0) - z
    fe = sf(j, 1) + z
    c1 = (fe >= (suri + gs)) AND (fb <= (suri + q3))
    c2 = ((fe + q1) >= (suri + gs)) AND ((fb + q1) <= (suri + q3))
    IF c1 OR c2 THEN
        sf = 0
        IF sf(j, 2) = -1 THEN GOTO nf
        sf = j
        x = sf(sf, 0) - suri
        z = sf(sf, 1) - suri
 
        'w1 = sf(sf, 2) - suri - h '                                  show limits of landing at feature
        'w2 = sf(sf, 2) - suri + h
        'w3 = gety(w1)
        'w4 = gety(w2)
        'IF bbit THEN
        '    LINE (w1, w3)-(w1, w3 - t), green
        '    LINE (w2, w4)-(w2, w4 - t), green
        'END IF
        'LOCATE 3, 12: PRINT w1; w2; w3; w4;
 
        IF (j = 1) AND (x < 0) AND (suri > 3000) THEN x = x + q1: z = z + q1
        bolthitf = (skyoff = 0) AND (boltx >= x) AND (boltx <= z) AND (exl(1) <> 9999)
        IF j = 1 THEN
            Area51 f$(40)
            IF (cut = 0) AND (LEFT$(mes$(1), 7) = "AREA 51") THEN
                GOSUB CutOrOutOfFuel
            END IF
        END IF
        IF j = 2 THEN CarWash
        IF j = 3 THEN LGM fc
        IF j = 4 THEN Volcano
        IF j = 5 THEN McD
        IF j = 6 THEN TMA
        IF j = 7 THEN Surveyor
        IF j = 8 THEN IBM
        IF j = 9 THEN Hollywood
        IF j = t THEN Grave x, fb$
    END IF
    nf:
NEXT i
RETURN
 
CommandModule: '                                                      27 * 9
IF ek(0) = -1 THEN RETURN
cminview = 1
tx = localize(ex(0), 14, 14)
IF tx = 999 THEN cminview = 0: GOTO nocm
x1 = tx - 14
x2 = tx + 14
 
VIEW SCREEN(gs + 1, 0)-(q3, q4) '                                     protect panel
LINE (x1 + 0, 18)-(x1 + 26, 26), black2, BF
FOR z = 1 TO 27
    LINE (x1 + z, 17)-(x1 + z, 26), white, , cmp&(z)
NEXT z
 
CMshadow tx, x1, x2 '                                                 optional
 
sd! = ABS(exv(0)) - ABS(vx!) '                                        speed diff
dbc = ABS(px! - tx)
 
'IF okrick AND (py! < h) THEN '                                       rendesvous assist
'    FOR z = -1 TO 1 STEP 2
'        tx2 = tx + z * 50
'        LINE (tx2, 18)-(tx2, 28), yellow
'        z! = INT(sd! * h) / h
'        z$ = STR$(z!)
'        TinyFont z$, tx - t, 33, yellow
'    NEXT z
'END IF
'
IF (py! < h) AND (dbc < 50) AND (ABS(sd!) < .06) THEN
    rlink = t
    LINE (LMrx(1), LMry(1))-(tx + 8, 27), green, , RND * &H7FFF
    IF (cmleaving + convo) = 0 THEN
        mes$(0) = "Establishing link with Campbell soup cans and string"
        sct! = 2
        convo = 1
    END IF
    IF sc! = 0 THEN sc! = TIMER + sct! '                              start conversation in xs
    IF TIMER > sc! THEN
        convo = convo + 1
        IF convo > (clines + 1) THEN
            sc! = 0
            convo = 0
            cmleaving = 1
        ELSE
            mes$(0) = convo$(convo)
            sc! = TIMER + sct!
        END IF
    END IF
END IF
     
nocm:
rlink = rlink - 1 - (rlink = 0) '                                     allows brief radio interruption
IF rlink = 0 THEN '                                                   lost awhile ago
    IF convo THEN mes$(0) = " " '                                     clear current dialogue
    convo = 0 '                                                       stop conversation
    sc! = 0 '                                                         talk timer
END IF
 
IF cmleaving AND cminview THEN '                                      CM exhaust
    ty = 22
    LINE (x1, ty - 2)-(x1, ty + 2), yellow
    LINE -(x1 - 15, ty), yellow
    LINE -(x1, ty - 2), yellow
END IF
RETURN
 
liftoff: '                                                            forced seperation or surface launch
IF (contact OR liftoff) AND (cwd < 69) AND (py! > 322) THEN
    dead$ = "HIT CAR WASH"
    RETURN
END IF
 
IF contact THEN vx! = 0
IF lob THEN vx! = exv(2): a = 0 '                                     landed on Borg
 
goy = -h '                                                            AS go y
IF ASO THEN '                                                         ascent stage only
    IF fuel! = 0 THEN RETURN
    thrust! = h
    falling = 0
    platform = 0
    IF lob THEN pminy = borgt
ELSE
    power = opower
    thrust! = th '                                                    simulate explosive seperation
    platform = 22 '                                                   deflect flame from DS
    IF contact THEN
        falling = 0 '                                                 DS already on surface
    ELSE
        falling = 1 '                                                 DS in air
        goy = py! - 20 '                                              go y - not to screen top
    END IF
    LINE (gs, 30)-(q3, q4), 0, BF '                                   erase "space" area
    pminx = q1: pmaxx = -pminx
    pminy = q1: pmaxy = -pmaxy
    FOR i = 279 TO rp '                                               draw descent stage
        c = LMc(i)
        IF c < 0 THEN c = fuel
        PSET (LMrx(i), LMry(i)), c
        IF LMrx(i) < pminx THEN pminx = LMrx(i)
        IF LMrx(i) > pmaxx THEN pmaxx = LMrx(i)
        IF LMry(i) < pminy THEN pminy = LMry(i)
        IF LMry(i) > pmaxy THEN pmaxy = LMry(i)
    NEXT i
    GOSUB flevel
    IF platform > 0 THEN deflectat = pminy
    zz = pmaxy - pminy
    GET (pminx, pminy)-(pmaxx, pmaxy), gbuff() '                      save descent stage
    LINE (gs, 30)-(q3, q4), 0, BF '                                   erase "space" area
 
    ta = (a + tsix) MOD tsix
    px! = px! - t * s!(ta)
    py! = py! - 15 * c!(ta) '                                         explosive seperation
END IF
 
wASO = ASO
ASO = 1
GOSUB ReadLM
IF wASO = 0 THEN fuel! = h
IF vsd THEN LMdistort
 
IF contact THEN
    dropvx! = 0
    IF lob AND (ABS(px! - center) > 2) THEN dropvx! = exv(1)
    dropvy! = 0
ELSE
    dropvx! = vx!
    dropvy! = vy!
END IF
 
IF lob OR (contact = 0) THEN
    wa = 0
ELSE
    wa = SGN(-exv(0)) * 20 '                                          want angle
    IF wa = 0 THEN wa = -20
END IF
 
sauto = auto: auto = 1
contact = 0
cut = 0
dump = 0
hover = 0
liftoff = 1
lminx = pminx
lock1 = 0
lockfuel = 0
lpass = 0
IF wASO = 0 THEN ma = 0
mes$(0) = ""
mes$(1) = ""
np = 0
paraf = 0
pcontact = 0
powerloss = 0
psuri = suri
py! = py! - 2 '                                                       fool CheckHit
svert = vert
vert = 0
 
DO: _LIMIT mdelay * 1.5
    IF py! < 280 THEN GOSUB angle '                                   make a=wa (angle=wanted)
    GOSUB Plotscreen
    np = np + 1
    IF np >= t THEN GOSUB CheckHit
    z = (sy1 + sy2) / 2 - 2
    IF (deflectat > 0) AND (z > deflectat) AND (z > deflectat) THEN contact = 1
    IF contact THEN dead$ = "NOT YOUR DAY": EXIT DO
    lpass = lpass + 1
    IF thrust! = th THEN thrust! = h
    IF vsd THEN '                                                     very severe damage
        thrust! = h - (lpass + RND) '                                 slowly drop power
        IF thrust! < 50 THEN thrust! = 50 + RND
        IF RND > .95 THEN
            dead$ = "STRUCTURAL FAILURE"
            EXIT DO
        END IF
    END IF
    GOSUB KeyAndMouse
    IF LEN(dead$) THEN GOTO endl
    IF lob OR ((platform > 0) AND (falling = 1)) THEN
        pminx = pminx + dropvx!
        pmaxx = pmaxx + dropvx!
        pminy = pminy + dropvy!
        pmaxy = pmaxy + dropvy!
        IF lob = 0 THEN
            dropvy! = dropvy! + .6
            dropy! = gety(-(pminx + nx))
            IF pmaxy < dropy! THEN
                lminx = pminx
                lminy = dropy! - zz
                deflectat = pminy
            ELSE
                pminx = lminx
                pminy = lminy
                psuri = suri
                pcontact = 1
                falling = 0
            END IF
        END IF
    ELSE
        pminx = lminx + (psuri - suri)
    END IF
    IF cut THEN lpass = 0
    IF wASO THEN
        IF (py! <= goy) AND (cut = 0) THEN EXIT DO
    ELSE
        IF pcontact OR (pminx < gs) OR (pminx > 580) THEN EXIT DO
        IF (cut = 0) AND (py! <= goy) THEN
            hover = 1
            GOSUB Autopilot
            IF falling = 0 THEN EXIT DO
        END IF
    END IF
LOOP UNTIL (alt! > h) OR LEN(dead$)
  
endl:
auto = sauto
crash = 0
deflectat = 0
liftoff = 0
lock1 = 0
platform = 0
vert = svert
RETURN
 
ReadLM:
LMbloads
IF ASO THEN '                                                         ascent stage only
    lp = 294
    nx = 16
    ny = 9
    rp = 302
    th1 = 170
    th2 = 198
    vmass = 60
ELSE '                                                                AS&DS 34*36
    lp = 696 '                                                        left pad
    nx = 17 '                                                         center x (for rotating)
    ny = 18 '                                                         center y
    rp = 705 '                                                        right pad
    th1 = 449 '                                                       left thruster
    th2 = 483 '                                                       right thruster
    vmass = h '                                                       full mass
END IF
 
nred = 0 '                                                            number red (volcanic heating)
temp = 0 '                                                            temperature
IF bw = 0 THEN PALETTE gasoline, 24
xp = 97 ' radar
wi = LMx(rp) - LMx(lp) + 1 '                                          width
wi2 = wi \ 2
 
IF invincible THEN c = gold ELSE c = gray '                           thruster color
FOR i = 1 TO rp
    LMx(i) = LMx(i) - nx
    LMy(i) = LMy(i) - ny
    IF (LMc(i) = gray) OR (LMc(i) = gold) THEN LMc(i) = c '           thrusters
    IF LMc(i) < 0 THEN LMc(i) = fuel '                                fuel
    LMoc(i) = LMc(i)
NEXT i
GOSUB LMcolors
RETURN
' --------------------------------------------------------------------------
d1:
DATA 27,"Elapsed time"
DATA 36,"Distance to McD"
DATA 45,"CPU"
DATA 54,"Rads/temperature"
DATA 86,"Fuel"
DATA 126,"Altitude"
DATA 166,"Horizontal velocity"
DATA 206,"Vertical velocity"
DATA 244,"Main thrust"
DATA 277,"Sideways thrust"
DATA 307,"Autopilot (full)"
DATA 322,"Hover control"
DATA 337,"Vertical automatic"
 
DATA "Scored on vertical & horizontal speed:"
DATA "0.00 - 0.50 Excellent"
DATA "0.51 - 1.00 Good"
DATA "1.01 - 2.00 Fair"
DATA "2.01 - 3.00 Poor"
DATA ""
DATA "Landing surface should be near flat,"
DATA with required ending angle under 5ø.
DATA ""
DATA Based on a 1974 program running on a
DATA DEC PDP/11 with GT40 vector display
DATA terminal at the University of Alberta.
DATA The graphic at top left is usually a Henon
DATA "plot, dealing with the stability of orbits."
DATA The face appearing in TMA-1 when it shoots
DATA "is Cybill Shepherd. If you land on TMA-1,"
DATA it displays a Mandelbrot. The semaphores
DATA "use proper flag positions, and the Morse"
DATA code in the McDonalds sign is real too.
DATA "Little Green Man can be turned into a pile"
DATA of ashes.  Beware the beach balls of IBM!
DATA ""
DATA F2 for a demo mode showing most features.
DATA ""
DATA "Esc or <: Back to Lander   > Next page"
 
d2:
DATA "ud        main thrust"
DATA "<>        side thrust/angle"
DATA "Shift ud  move up"
DATA "Shift <>  move left/right"
DATA "<>        ground back/forward"
DATA "space     abort/feature cycle"
DATA "Bkspace   random star position"
DATA "Esc       quit"
DATA "01234     stars off/on/info"
DATA "aA        autopilot on/off/McD"
DATA "b         goto Borg"
DATA "B         goto black hole"
DATA "c         cut engine"
DATA "C         clock(s) on/off"
DATA "d         dump fuel"
DATA "D         restart with defaults"
DATA "fF        fuel lock/unlimited"
DATA "G         new ground"
DATA "h         hover"
DATA "I         invincible mode"
DATA "k         kill (fire laser)"
DATA "wlemtsiHg goto surface feature"
DATA "L         level ground"
DATA "M         Magic landing!"
DATA "n         nation (flag)"
DATA "o         goto comet"
DATA "O         goto EPCOR"
DATA "p         pause"
DATA "P         parachute"
DATA "r         radar"
DATA "R         rendesvous with CM"
DATA "T         thrust accuracy"
DATA "u         instruments"
DATA "v         vertical automatic"
DATA "y         swap mouse buttons"
DATA "z         self-destruct"
DATA ".         terrain following"
DATA "F2        demo mode (compressed)"
DATA "F3        sky features"
DATA "F4        constant black holes"
DATA "F5        panel/instruments"
DATA "F6        drop descent stage"
DATA "F7        map at top"
DATA "F8        shields (uses fuel)"
DATA "F9/F10    LED color/tri-color"
DATA "PgDn/Up   slower/faster"
DATA "< Previous page   > Next page"
 
d3:
DATA "/  green/b&w/regular screen"
DATA "+  zoom in starfield"
DATA "-  zoom out starfield"
DATA "\  drop bomb"
DATA ".  terrain following"
DATA "_  star twinkle"
DATA "j  DeathStar rotation"
DATA "|  generate all star files (hours!)"
DATA "x  more/less starfiles"
DATA "X  regenerate current star file"
DATA "Q  oscar (LGM flag colors)"
DATA "=  show LM data"
DATA "[  crude black & white"
DATA "]  UFO toggle"
DATA "U  ground tiling style"
DATA "ctrl-c or -s: SCREEN capture"
DATA "alt-Enter: fullscreen toggle"
DATA ""
DATA "< Previous page   > Next page"
 
d4:
DATA "      Programmed by:   R. Frost"
DATA "                       Edmonton, Alberta, Canada"
DATA ""
DATA "                       rfrost@mail.com "
DATA ""
DATA ""
DATA " 1) 2001 A Space Odyssey: TMA-1, HAL, CM/LM chatter"
DATA " 2) Star Trek: warp messages, phasers, shield, Borg"
DATA " 3) Lost in Space: black hole warning"
DATA " 4) Southpark: black hole at 3:50 (Tree-fiddy! - Chef)"
DATA " 5) Simpsons: LGM saying he has semaphore flags"
DATA " 6) Rocky & Bullwinkle: a hall of Montezuma (car wash)"
DATA " 7) Bonanza: car wash traverse generates a Hop Sing quote"
DATA " 8) SCTV: CM/LM chatter"
DATA " 9) a McDonalds on the Moon, and an instrument for it"
DATA "10) Little Green Man wiggles ears & reacts to LM exhaust"
DATA "11) pirate books & movies: CM/LM chatter"
DATA "12) Command Module leaves you stranded"
DATA "13) a Steve Martin quote precedes black hole death"
DATA "14) half the time the USSR flag is planted"
DATA "15) Cybil Shepherd's face appears in TMA-1 when it fires"
DATA "16) Halley's Comet is renamed Halle Berry"
DATA "17) digital, analog, and binary clocks!"
DATA "18) End Of The Universe is signaled by Chicken Little"
DATA "19) Mt. Etna spews volcanic cheese"
DATA "20) a parachute that doesn't work in a vacuum"
DATA "21) Area 51 is the first level landing zone"
DATA "22) IBM weapon is a fishing float or beach ball"
DATA ""
DATA "< Previous page   Esc or >: Back to Lander"
 
leds:
DATA a,0,-2,1,-2
DATA b,1,-2,1,-1
DATA c,1,-1,1,0
DATA d,0,0,1,0
DATA e,0,-1,0,0
DATA f,0,-2,0,-1
DATA g,0,-1,1,-1
       
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
 
features:
'               x   y  lz
DATA "Area 51",65,40,45
DATA "Car Wash",100,44,130
DATA "Little Green Man",12,0,70
DATA "Etna",10,49,20
DATA "McDonalds",38,0,80
DATA "TMA-1",45,71,80
DATA "Surveyor",28,0,80
DATA "IBM",50,45,90
DATA "Hollywood",170,0,0
DATA "a grave",68,49,98
 
MorseData:
DATA a,.-,b,-...,c,-.-.,d,-..,e,.,f,..-.,g,--.
DATA h,....,i,..,j,.---,k,-.-,l,.-..,m,--,n,-.
DATA o,---,p,.--.,q,--.-,r,-.-,s,...,t,-,u,..-
DATA v,...-,w,.--,x,-..-,y,-.--,z,--..,1,.----,2,..---
DATA 3,...--,4,....-,5,.....,6,-...,7,--..,8,---..,9,----.
DATA 0,-----,!,..--.,$,...-..-,&,.-...
 
warp:
DATA "The Rockwell warranty is now void"
DATA "Hope we don't collide with Klingons!"
DATA "You need a vacation, Jim!  - Bones!"
DATA "It's a long way to Tipperary!"
DATA "Do we know this universe?  - Spock"
DATA "My miniskirt is getting shorter! - Uhuru"
DATA "Da engines kanna tayke much more! - Scotty"
DATA "Keptin, are you insane? - Chekhov"
DATA "Hit 10 and we die!"
 
radcomments:
DATA "has caused genetic damage"
DATA "causes glowing in the dark"
DATA "5 years"
DATA "1 year"
DATA "6 months"
DATA "1 month"
DATA "1 week"
DATA "8 hours"
DATA "5 minutes"
DATA "has killed you - press Esc"
 
skycrud:
DATA CM,14,14
DATA DS,150,150
DATA BO,58,46
DATA BH,200,200
DATA Wo,90,90
DATA Co,20,100
DATA AL,40,40
DATA ZZ,1,1
 
semadata:
DATA a 1,225,180
DATA b 2,270,180
DATA c 3,315,180
DATA d 4,0,180
DATA e 5,180,45
DATA f 6,180,90
DATA g 7,180,135
DATA h 8,270,225
DATA i 9,225,315
DATA j,0,90
DATA k 0,225,0
DATA l,225,45
DATA m,225,90
DATA n,225,135
DATA o,270,315
DATA p,270,0
DATA q,270,45
DATA r,270,90
DATA s,270,135
DATA t,315,0
DATA u,315,45
DATA v,0,135
DATA w,45,90
DATA x,45,135
DATA y,315,90
DATA z,135,90
DATA " ",180,180
DATA !,0,0
 
say:
DATA "The time is 1234"
DATA "Welcome to the Moon"
DATA "I am a little green man"
DATA "I have semaphore flags"
DATA "R Frost is a nerd!"
DATA "abcdefghijklmnopqrstuvwxyz"
DATA end
 
BigM: '                                                               37 * 16
DATA "          X               X          "
DATA "         X X             X X         "
DATA "        X   X           X   X        "
DATA "       X     X         X     X       "
DATA "      X       X       X       X      "
DATA "     X         X     X         X     "
DATA "     X         X     X         X     "
DATA "    X           X   X           X    "
DATA "    X           X   X           X    "
DATA "   X             X X             X   "
DATA "   X             X X             X   "
DATA "  X              XXX              X  "
DATA " X                                 X "
DATA " X                                 X "
DATA "X                                   X"
DATA "X                                   X"
DATA x
'     1234567890123456789012345678901234567
'              1         2         3
tinyfontd:
DATA 0,7,5,5,5,7
DATA 1,2,6,2,2,7
DATA 2,7,1,7,4,7
DATA 3,7,1,7,1,7
DATA 4,5,5,7,1,1
DATA 5,7,4,7,1,7
DATA 6,7,4,7,5,7
DATA 7,7,1,1,1,1
DATA 8,7,5,7,5,7
DATA 9,7,5,7,1,7
DATA .,0,0,0,0,2
DATA -,0,0,1,0,0
DATA ":",0,2,0,2,0
DATA " ",0,0,0,0,0
 
'2010 :
'DATA ALL THESE WORLDS
'DATA ARE YOURS EXCEPT
'DATA EUROPA
'DATA ATTEMPT NO
'DATA LANDING THERE
'DATA USE THEM TOGETHER
'DATA USE THEM IN PEACE
 
lmshow:
VIEW
FOR pass = 1 TO 2
    CLS
    FOR i = 1 TO rp
        x = (LMx(i) + 17 - ASO) * 16 + 30 + (pass = 2)
        y = (LMy(i) + 18 - ASO * 9) * 8 + t
        IF pass = 1 THEN z$ = LTRIM$(STR$(LMc(i))) ELSE z$ = RIGHT$("  " + STR$(i), 3)
        IF LEN(z$) = 1 THEN z$ = "0" + z$
        c = LMc(i)
        TinyFont z$, x + 3, y + 3, c
    NEXT i
    FOR i = 1 TO 35 '                                                 line of numbers at top
        z$ = RIGHT$(" " + LTRIM$(STR$(i)), 2)
        TinyFont z$, (i - 1) * 16 + 33, 4, gray
        x = (i - 1) * 16 + 30 + 16
        LINE (x, 0)-(x, 320), red
    NEXT i
    FOR i = 1 TO 36 '                                                 columb of numbers at left
        z$ = RIGHT$(" " + LTRIM$(STR$(i)), 2)
        TinyFont z$, 8, i * 8 + 13, gray
        y = i * 8 + t + 8 + 1
        LINE (0, y)-(q3, y), red
    NEXT i
    LINE (0, 0)-(q3, 320), red, B
    _DISPLAY
    SLEEP
NEXT pass
RETURN
' -------------------------------------------------------------------------------------------------------x
SUB mHelp
    VIEW: CLS
    hp = 1
    DO
        CLS
        IF hp = 1 THEN GOSUB Help1
        IF hp = 2 THEN GOSUB Help2
        IF hp = 3 THEN GOSUB Help3
        IF hp = 4 THEN GOSUB credits
        timemachine
        DO: _LIMIT 30
            i$ = INKEY$
        LOOP UNTIL LEN(i$)
        IF LEN(i$) = 1 THEN k = ASC(i$) ELSE k = ASC(RIGHT$(i$, 1))
        hp = hp + (k = 75) - (k = 77)
        IF (k = 27) OR (hp < 1) OR (hp > 4) THEN EXIT DO
    LOOP
    CLS
    EXIT SUB
    ' --------------------------------------------------------------------------
    ReadAndReplace:
    READ z$
    z = INSTR(z$, "ground")
    p = INSTR(z$, "<"): IF (p > 0) AND (z = 0) THEN MID$(z$, p, 1) = CHR$(27)
    p = INSTR(z$, ">"): IF (p > 0) AND (z = 0) THEN MID$(z$, p, 1) = CHR$(26)
    RETURN
    ' --------------------------------------------------------------------------
    Help1:
    RESTORE d1
    REDIM gbuff2(8000)
    s& = VARSEG(gbuff2(0))
    o& = VARPTR(gbuff2(0))
    DEF SEG = s&
    BLOAD "PANEL.DAT", o&
    PUT (0, 0), gbuff2(0)
    REDIM gbuff2(0)
    LINE (85, 0)-(260, q4), gray, BF
    FOR i = 1 TO 13 '                                                 define the panel first
        READ ty, z$
        IF i < 5 THEN
            sprint2 z$, 90, ty, white, 0
        ELSE
            IF i = 9 THEN z$ = CHR$(24) + CHR$(25) + z$ '             up & down arrow keys
            IF i = 10 THEN z$ = CHR$(27) + CHR$(26) + z$ '            left & right arrow keys
            sprint z$, 90, ty, white, 0
            IF (i = 9) OR (i = 10) THEN sprint LEFT$(z$, 2), 90, ty, red, 0
            IF i > 10 THEN sprint LEFT$(z$, 1), 90, ty, red, 0
        END IF
    NEXT i
    LINE (261, 0)-(639, q4), blue2, BF '                              summary of program
    ty = 11: c = white
    FOR i = 1 TO 25
        GOSUB ReadAndReplace
        p = INSTR(z$, "*auto")
        IF p THEN qm$ = CHR$(34): MID$(z$, p, 6) = qm$ + "auto" + qm$
        sprint z$, 275, ty, c, 0
        ty = ty + 9 - (z$ <> "") * 5
    NEXT i
    RETURN
    ' --------------------------------------------------------------------------
    Help2:
    RESTORE d2
    c1 = gray
    c2 = black
    z$ = "KEYBOARD COMMANDS"
    GOSUB pageprep
    tx = 40: ty = 26
    FOR i = 1 TO 46
        GOSUB ReadAndReplace
        p = INSTR(z$, "ud")
        IF p THEN MID$(z$, p, 2) = CHR$(24) + CHR$(25)
        IF i = 3 THEN MID$(z$, 8, 1) = " "
        e = INSTR(z$, "main t") + INSTR(z$, "side t")
        IF e THEN c = green ELSE c = white
        IF INSTR("ahv", LEFT$(z$, 1)) THEN c = gasoline
        sprint2 z$, tx, ty, c, 0
        ty = ty + 11: IF ty > 276 THEN tx = 340: ty = 26
    NEXT i
    LINE (50, 300)-(585, 300), 0
    LINE (55, 302)-(590, 302), 0
    GOSUB ReadAndReplace
    sprint2 "When landed or paused, arrow keys move stars", 135, 282, white, 0
    ty = 310
    sprint z$, 350, ty, white, 0
    sprint "essential", 50, ty, green, 0
    sprint "other flight", 150, ty, gasoline, 0
    RETURN
 
    Help3:
    RESTORE d3
    c1 = gray
    c2 = black
    z$ = "MORE KEYBOARD COMMANDS"
    GOSUB pageprep
    tx = 200: ty = 36: c2 = blue
    FOR i = 1 TO 19
        GOSUB ReadAndReplace
        IF i = 19 THEN ty = 310: c2 = black
        sprint z$, tx, ty, white, c2
        ty = ty + 15
    NEXT i
 
    LINE (50, 300)-(585, 300), 0
    LINE (55, 302)-(590, 302), 0
    RETURN
    ' --------------------------------------------------------------------------
    credits:
    RESTORE d4
    c1 = dred
    c2 = white
    z$ = "AUTHOR & HUMOUR SUMMARY"
    GOSUB pageprep: x1 = 86: ty = 40
    FOR i = 1 TO 30
        GOSUB ReadAndReplace
        IF i = 30 THEN
            x1 = 320 - LEN(z$) * 4 - 8
            x2 = 320 + LEN(z$) * 4 + 8
            ty = 330
            LINE (x1, ty)-(x2, ty + 11), dred, BF
        END IF
        sprint2 z$, x1 + 8, ty, c2, 0
        ty = ty + t
    NEXT i
    RETURN
    ' --------------------------------------------------------------------------
    pageprep:
    CLS: PAINT (1, 1), c1
    x1 = 30: y1 = 5: x2 = 610: y2 = 345
    FOR q = 2 TO 20 STEP 4
        LINE (x1 - q, y1 + q)-(x2 + q, y2 - q), c1, B
        LINE (x1 - q + 1, y1 + q + 1)-(x2 + q + 1, y2 - q + 1), c2, B
    NEXT q
    z = LEN(z$) + 2: x1 = 320 - z * 4: x2 = 320 + z * 4
    LINE (x1, 9)-(x2, 22), c1, BF
    sprint z$, x1 + 8, t, white, -c2
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB sprint (z$, tx, ty, c1, c2) '                                     VGA font
    FOR i = 1 TO LEN(z$)
        d = ASC(MID$(z$, i, 1))
        IF d = 248 THEN d = 0 '                                       degree symbol
        x = tx + (i - 1) * 8
        FOR byte = 0 TO 13
            y = ty + byte
            p& = (p(d, byte) AND 255) * 128
            IF c2 >= 0 THEN LINE (x + 1, y)-(x + 8, y), c2, , p&
            LINE (x, y)-(x + 7, y), c1, , p&
        NEXT byte
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB sprint2 (c$, tx, ty, c1, c2) '                                    CGA font
    FOR i = 1 TO LEN(c$)
        d = ASC(MID$(c$, i, 1))
        IF d = 248 THEN d = 0 '                                       degree symbol
        FOR k = 0 TO 7
            tx2 = tx + (i - 1) * 8 + k
            ty2 = ty + 2
            p& = p2(d, k)
            IF c2 >= 0 THEN
                LINE (tx2 + 1, ty2 + 1)-(tx2 + 1, ty2 + 9), c2, , p&
            END IF
            LINE (tx2, ty2)-(tx2, ty2 + 8), c1, , p&
        NEXT k
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB AuHoVe (auto, hover, vert, lam)
    FOR i = 0 TO 2
        z$ = MID$(" AUTOHOVER VERT", i * 5 + 1, 5)
        IF i = 0 THEN k = auto
        IF i = 1 THEN k = hover
        IF i = 2 THEN k = vert
 
        ty = 307 + i * 15
        PrintCGA z$, 4, ty, gunmetal, black2, 0
 
        IF k THEN
            c1 = green
            c2 = black2
        ELSE
            c1 = black2
            c2 = red
        END IF
 
        IF crash THEN c1 = black2: c2 = black2
 
        IF lam AND k AND (i = 0) THEN c1 = gold '                     land at McD
 
        PrintCGA "ON ", 57, ty - 4, c1, -1, 0
 
        '                                                             blink OFF to indicate a keyboard command turned it off
        IF (i = 0) AND (APdisengage > 0) AND (c2 = red) THEN
            c2 = (APdisengage MOD 2) * red
            APdisengage = APdisengage - 1
        END IF
        PrintCGA "OFF", 57, ty + 3, c2, -1, 0
 
        tx1 = 48: ty1 = ty + 5 '                                      switches
        IF i = 1 THEN c = blue2 ELSE c = blue '                       background
        IF k THEN ta = 285 ELSE ta = 75 '                             up & down angles
        tx2 = tx1 + 5 * c!(ta)
        ty2 = ty1 + 5 * s!(ta)
        FOR k = 0 TO 1
            LINE (tx1 + 2, ty1)-(tx2 + k + 2, ty2), white '           plot switch
        NEXT k
        LINE (tx1 + 1, ty1)-(tx2 + 1, ty2), black2 '                  outline left
        LINE (tx1 + 3, ty1)-(tx2 + 4, ty2), black2 '                  outline right
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Bar (xdat!, cl)
    xmax = gs - t '                                                   graphics start - ten
    xmin = xmax - 50
    ymax = 273 - osc * 39
    ymin = ymax - t
    'xcen = xmin + (xmax - xmin) / 2 '                                center line
    xbar = xmin + xdat! * (xmax - xmin) '                             data
    IF xbar < xmin THEN xbar = xmin '                                 limit min
    IF xbar > xmax THEN xbar = xmax '                                 limit max
 
    IF porb THEN '                                                    led bar
        IF LEDtri = 0 THEN c = LEDc
        IF cl THEN '                                                  center line
            LINE (xbar - 1, ymin + 4)-(xbar + 1, ymin + 7), c, BF
        ELSE
            LINE (xmin, ymin + 5)-(xbar, ymin + 7), c, BF
        END IF
    ELSE '                                                            mechanical pointer
        IF (osc = 4) AND (radarf = 0) THEN '                          altitude with radar off
            tc1 = gray
            tc2 = black
        ELSE '                                                        normal
            tc1 = white
            tc2 = white
        END IF
        LINE (xbar, ymin + 4)-(xbar - 4, ymin + 8), tc1
        LINE -(xbar + 4, ymin + 8), tc1
        LINE -(xbar, ymin + 4), tc1
        PAINT (xbar, ymin + 5), tc2, tc1
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB BlackHole (freeze) STATIC
    IF ei(3) = 0 THEN
        DIM tc(2)
        ei(3) = 1
        l! = aspect!
        tx = 30 + RND * 40
        IF RND > .7 THEN tx = tx + RND * h
        IF RND > .7 THEN tx = tx + RND * h '                          intentional repeat
        v! = tx / l!
        s1! = l! / t: r = RND * 90: ri = RND * 8 + 2
        bc = bc + 1 + (bc = 6) * 7
        z$ = "020105040906010613070603091301070605121404" '           colors
        FOR i = 0 TO 2
            tc(i) = VAL(MID$(z$, bc * 6 + i * 2 + 1, 2))
        NEXT i
        d1 = RND * 2 + 1
        d2 = RND * 2 + 1
    END IF
 
    x0 = localize(ex(3), 0, 0)
    y0 = ey(3)
 
    tri = ri
    IF freeze THEN tri = tri \ 2 '                                    rotation increment
    r = (r + tri) MOD tsix '                                           rotation
    dtlt! = -30 - 30 * ABS(c!((r * 3 + 50) MOD tsix)) '                tilt
    dtlti = (dtlt! + tsix) MOD tsix
    crot! = c!(r)
    srot! = s!(r)
    ctlt! = c!(dtlti) / d1
    stlt! = s!(dtlti) / d2
    co = (co + 1) MOD tsix
 
    bhx = 0: bhy = bhx
    FOR pass = 0 TO 1 '                                               90 degrees apart
        FOR za! = -l! TO l! STEP s1!
            pd = 0 '                                                  pen up
            FOR zb! = -l! TO l! STEP s1!
                x1! = za!
                y1! = zb!
                IF pass THEN SWAP x1!, y1!
                x! = x1! * crot! + y1! * srot!
                y! = y1! * crot! - x1! * srot!
                q! = -.8 / (x1! * x1! + y1! * y1!) + .8
                z! = q! * ctlt! - y! * stlt!
                y! = y! * ctlt! + q! * stlt!
                s! = (l! * 2) / ((l! * 2) + y!)
                xx = x0 + x! * v! * s!
                yy = y0 - z! * v! * s!
                x! = za! * 1.8: x! = x! * x!
                y! = zb! * 1.8: y! = y! * y!
                tc = tc((x! + y! + co) MOD 3)
                IF pd THEN LINE -(xx, yy), tc ELSE PSET (xx, yy)
                c1 = (xx > -120) AND (xx < 770)
                c2 = (yy > -120) AND (yy < 470)
                IF c1 AND c2 THEN '                                   on screen
                    bh = 1
                    IF (ABS(za!) < .1) AND (yy > bhy) THEN
                        bhx = xx
                        bhy = yy
                    END IF
                END IF
                pd = 1 '                                              pen down
            NEXT zb!
        NEXT za!
    NEXT pass
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB BlackHoleDoom '                                                   fall in while shrinking
    fb$ = "" '                                                        silence feedback, if any
    sgs = gs '                                                        save graphics start (going to kill panel here)
    gs = 0 '                                                          kills panel
    VIEW
    DIM LMxi!(q2), LMyi!(q2)
    FOR i = 1 TO rp '                                                 rp=right pad (end of LM data)
        LMxi!(i) = (exl(3) - LMrx(i)) / 50
        LMyi!(i) = ((ey(3) + bhy) \ 2 - LMry(i)) / 50
    NEXT i
    FOR pass = 1 TO 50
        CLS
        mes$(0) = "Let's get SMALL! - Steve Martin"
        FOR i = 1 TO rp
            x = LMrx(i) + LMxi!(i) * pass
            y = LMry(i) + LMyi!(i) * pass
            c = LMc(i)
            IF (c = gasoline) AND (RND > pf!) THEN c = 0
            PSET (x, y), c
        NEXT i
        GOSUB ibd
        wu! = TIMER + .1
        DO: _LIMIT mdelay
            GOSUB ibd
            i$ = INKEY$
            IF (i$ = "q") OR (i$ = CHR$(27)) THEN Quit
        LOOP UNTIL TIMER > wu!
    NEXT pass
    mes$(0) = dead$
    mes$(1) = ""
    gs = sgs
    EXIT SUB
 
    ibd:
    Info
    BlackHole 1
    timemachine
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB CMshadow (tx2, x1, x2)
    z = (TIMER MOD 17) + 1 '                                          rotation 1
    IF z < t THEN
        LINE (tx2 - 4, 17 + z)-(tx2 - 1, 17 + z), white
    END IF
    z = ((z + 8) MOD 17) + 1 '                                        rotation 2
    IF z < t THEN
        LINE (tx2 + 6, 17 + z)-(tx2 + 8, 17 + z), white
    END IF
    FOR tx = x1 TO x2 '                                               shadow
        FOR ty = 17 TO 26
            pp = POINT(tx, ty)
            zx = tx - x1 - (x2 - x1) \ 2
            zy = ty - 22
            IF (pp = white) AND (zy > (zx + 4)) THEN PSET (tx, ty), gray2
        NEXT ty
    NEXT tx
END SUB
' -------------------------------------------------------------------------------------------------------x
FUNCTION dcolor (v!, z1, z2, d) '                                     determine color for various displays
    dcolor = LEDc '                                                   normal
    IF liftoff = 0 THEN
        tv! = ABS(v!)
        IF d = 1 THEN '                                               problem higher
            IF tv! > z1 THEN dcolor = yellow '                        warning
            IF tv! > z2 THEN dcolor = red '                           serious warning
        ELSE '                                                        problem lower
            IF tv! < z1 THEN dcolor = yellow '                        warning
            IF tv! < z2 THEN dcolor = red '                           serious warning
        END IF
    END IF
END FUNCTION
' -------------------------------------------------------------------------------------------------------x
SUB Evaluate (savea, z) '                                             landing analysis
    IF (ABS(z) > 4) AND (crash = 0) THEN
        IF ABS(savea) > 4 THEN
            z$ = "contact angle " + LTRIM$(STR$(-savea)) + CHR$(248)
            GOSUB tackon
        END IF
        IF ABS(z) > 4 THEN
            z$ = "ending angle " + LTRIM$(STR$(-(z))) + CHR$(248)
            GOSUB tackon
        END IF
    END IF
 
    IF ABS(vx!) > 3 THEN z$ = "horizontal velocity": GOSUB tackon
    IF ABS(vy!) > 3 THEN z$ = "vertical velocity": GOSUB tackon
    ok = -(LEN(fb$) = 0)
    z! = ABS(vx!)
    IF (z! <= 3) AND (vy! <= 3) THEN score = 5: z$ = "Poor"
    IF (z! <= 2) AND (vy! <= 2) THEN score = 4: z$ = "Fair"
    IF (z! <= 1) AND (vy! <= 1) THEN score = 3: z$ = "Good"
    IF (z! <= pf!) AND (vy! <= pf!) THEN score = 2: z$ = "Excellent"
    IF (z! < .1) AND (vy! < .1) THEN score = 1: z$ = "Fantastic"
    IF magic THEN z$ = "Magic"
    IF ok = 0 THEN z$ = "Bad"
    z$ = z$ + " landing"
    IF crash THEN fb$ = "": z$ = "CRASHED"
 
    IF lob THEN
        z$ = z$ + " on Borg": GOSUB tackon
        GOTO eother
    END IF
 
    v$ = "" '                                                         verb
    n$ = "" '                                                         noun
    ldis = q1 '                                                       last distance
 
    FOR i = 1 TO t '                                                  5wlemtsihg
        tx = sf(i, 2) - suri '                                        point of interest middle
        IF tx < 0 THEN tx = tx + q1
        poi$ = sf$(i) '                                               name of poi
        dis = ABS(px! - tx)
        IF (poi$ = "") OR (dis > ldis) THEN GOTO ni
        ldis = dis
        IF dis < h THEN
            n$ = poi$
            don = (sf(i, 2) - sf(i, 0)) + wi2 '                       distance to be "on"
            IF dis < don THEN
                '        pad  349              LGM        Surveyor
                IF (ABS(sy1 - q4) < 20) AND (i <> 3) AND (i <> 7) THEN
                    v$ = "in"
                ELSE
                    v$ = "on"
                END IF
            ELSE
                v$ = "at"
            END IF
            IF ok THEN
                IF (i = 1) THEN mes$(1) = "MIB will visit you shortly!"
                IF (i = 3) AND (LGMc = gray) THEN n$ = "the ashes of " + n$
                IF (i = 4) AND (v$ = "on") THEN mes$(1) = "On a volcano?  Are you crazy?"
                IF (i = 5) THEN mes$(1) = "Buzz wants a Happy Meal!"
                IF (i = t) AND (v$ = "on") THEN
                    mes$(1) = "Rude to land on a tombstone!"
                END IF
            END IF
        END IF
        ni:
    NEXT i
 
    z$ = RTRIM$(z$ + " " + v$ + " " + n$): GOSUB tackon
 
    IF v$ = "in" THEN '                                               handle oddball cases
        IF n$ = sf$(6) THEN mes$(1) = "The aliens will not be pleased!"
        IF n$ = sf$(8) THEN mes$(1) = "Merged with the machine!"
        IF n$ = sf$(t) THEN mes$(1) = "Desecration of a grave!"
    END IF
 
    eother:
    IF fuel! = 0 THEN z$ = "ran out of fuel!": GOSUB tackon
    EXIT SUB
 
    tackon:
    IF LEN(fb$) THEN z$ = ", " + z$
    fb$ = fb$ + z$
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB ExplodeLM
    DIM LMxi!(q2), LMyi!(q2)
    CountFuel = 0
    FOR i = 1 TO rp '                                                 for each pixel, a direction
        ta = RND * tsix '                                              pick an angle, any angle
        IF contact THEN ta = RND * 180 + 180 '                        upward only if on ground
        tf = RND * 20 + 2 '                                           force
        LMxi!(i) = tf * c!(ta) '                                      x increment
        LMyi!(i) = tf * s!(ta)
        IF LMc(i) = fuel THEN '                                       color
            CountFuel = CountFuel + 1
            IF CountFuel < ptk THEN LMc(i) = 0 '                      points to kill
        END IF
    NEXT i
    contact = 0
    fb$ = "" '                                                        eval feedback
    sgs = gs
    gs = 0 '                                                          full screen
    VIEW
    FOR pass = 1 TO 40 '                                              expanding debris
        CLS
        mes$(0) = dead$
        mes$(1) = ""
        Info '                                                        say why exploding
        FOR i = 1 TO rp
            LMrx(i) = LMrx(i) + LMxi!(i)
            LMry(i) = LMry(i) + LMyi!(i)
            LMyi!(i) = LMyi!(i) - grav! * (warp! = 0)
            x = (LMrx(i) - h) * aspect!
            y = LMry(i)
            s = i MOD 5 '                                             size
            LINE (x, y)-(x + s, y + s), LMc(i), BF
            z1 = ((RND * t) - 5) * 3
            z2 = ((RND * t) - 5) * 3
            LINE (x + z1, y + z2)-(x + z1 + s, y + z2 + s), LMc(i), BF
        NEXT i
        LINE (0, 0)-(q3, q4), 0, B '                                  erase ugly border
        timemachine
        w! = TIMER + .02: WHILE TIMER < w!: WEND
    NEXT pass
    gs = sgs
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB ExplodeShell (s) '                                                not contact - when LM fires at them
    tx = shx(s) - suri
    ty = shy(s)
    LINE (tx - 5, ty - 5)-(tx + 5, ty + 5), black2, BF '              erase shell
 
    FOR d = t TO 30 STEP 2 '                                          distance
        FOR z = 0 TO 40 - d '                                         particles at above distance
            ang = RND * tsix '                                         angle
            tx2 = tx + d * c!(ang) * aspect!
            ty2 = ty + d * s!(ang)
            bit = bit XOR 1
            IF bit THEN c = red ELSE c = yellow
            PSET (tx2, ty2), c
        NEXT z
    NEXT d
    shx(s) = 0
    shd(s) = q1 '                                                     6400, any large number
    sia = sia - 1 '                                                   shells in air
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB GetSurface (gh) '                                                 load surface array
    DIM lz(t) '                                                       landing zones
    f$ = "s" + LTRIM$(STR$(gh)) + ".dat" '                            0 - 10
    IF gh < 0 THEN f$ = "SL.DAT" '                                    l for level
    IF demo THEN f$ = "SD.DAT" '                                      d for demo
    CLOSE #6
    OPEN f$ FOR RANDOM AS #6 LEN = 2
    FOR i = 0 TO 6399
        GET #6, i + 1, gh(i)
        'gc(i) = gray
    NEXT i
    FOR i = 1 TO t '                                                  create landing zones
        IF demo THEN '                                                compress onto 1 page
            lz(i) = 3050 + (i - 1) * 80
        ELSE
            lz(i) = 320 + (i - 1) * (q3 + 1) '                        1 per page
        END IF
    NEXT i
    IF demo THEN '                                                    all on one page
        SWAP lz(9), lz(t) '                                           move grave 1 page left
        SWAP lz(2), lz(4) '                                           move car wash 2 pages right
    END IF
    RESTORE features
    FOR i = 1 TO t
        READ sf$(i), x, y, lz '                                       sf = special feature
        sf(i, 0) = lz(i) - x \ 2 '                                    start
        IF demo AND (i = 9) THEN sf(i, 0) = 3750 '                    Hollywood
        sf(i, 1) = sf(i, 0) + x '                                     end
        sf(i, 2) = sf(i, 0) + x \ 2 '                                 middle
    NEXT i
    IF demo THEN '                                                    move LGM to top of grave
        sf(3, 0) = sf(t, 0) + 14 '                                    x left
        sf(3, 1) = sf(t, 1) + 14 '                                    x right
        sf(3, 2) = sf(t, 2) + 14 '                                    x middle
    END IF
    sspinit2 = 0
END SUB
' -------------------------------------------------------------------------------------------------------x
FUNCTION gety (x) '                                                   ground level for given x
    ax = ABS(x)
    xx = (suri + ax) MOD q1
    IF sy1 > 310 THEN
        c1 = (xx >= sf(2, 0)) '                                       car wash start
        c2 = (xx <= sf(2, 1)) '                                       car wash end
        IF c1 AND c2 THEN
            IF ASO THEN z = 320 ELSE z = 338 '                        safe zone start different with ascent stage only
            IF sy1 > z THEN
                gety = q4 '                                           349, max y
                EXIT FUNCTION
            END IF
        END IF
    END IF
    IF x < 0 THEN
        c1 = (ek(2) <> -1) AND (ek(2) < h)
        c2 = (skyoff = 0) AND (sy1 < borgt) AND (ax > borgl) AND (ax < borgr)
        IF c1 AND c2 THEN
            ' LINE (borgl, borgt)-(borgl, borgt - 20), yellow ' debugging
            ' LINE (borgl, borgt)-(borgr, borgt - 20), yellow
            ' LINE (borgl, borgt)-(borgr, borgt), yellow
            gety = borgt
            EXIT FUNCTION
        END IF
    END IF
    gety = gh(xx)
END FUNCTION
' -------------------------------------------------------------------------------------------------------x
SUB Hollywood
    FOR i = 1 TO 9
        tx = x + i * 16
        ty = gety(tx) - 14
        PrintVGA MID$("HOLLYWOOD", i, 1), tx - 4, ty, white, black
        LINE (tx, ty + 9)-(tx, ty + 22), gray2
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB IBM STATIC
    DIM a(1)
    x0 = x
    y0 = 304
    IF bolthitf THEN tc = white ELSE tc = gasoline '                  lightning bolt from deathstar
    LINE (x0, y0)-(x0 + 50, y0 + 45), tc, BF '                        entire area
    LINE (x0, y0)-(x0 + 50, y0 + 45), gray, B '                       outline
 
    LINE (x0, y0 - 1)-(x0, y0 - 30), gray2 '                          light towers
    LINE (x0 + 50, y0 - 1)-(x0 + 50, y0 - 30), gray2
 
    IF bbit THEN '                                                    global seconds toggle
        PSET (x0, y0 - 30), red '                                     lights on towers
        PSET (x0 + 50, y0 - 30), red
        ltoggle = ltoggle XOR 1
        IF ltoggle THEN
            PSET (x0, y0 - 31), red
            PSET (x0 + 50, y0 - 31), red
            LINE (x0 - 2, y0 - 30)-STEP(4, 0), red
            LINE (x0 + 48, y0 - 30)-STEP(4, 0), red
        END IF
    END IF
 
    IF a(0) = 0 THEN a(0) = 30: a(1) = 150 '                          initial marker positions
    IF RND > pf! THEN '                                               reel mark direction&speed
        tdir = SGN(RND - pf!) * INT(RND * 4 + 2)
        IF RND > .8 THEN tdir = 0 '                                   sometimes not moving
    END IF
    LINE (x0 + 6, y0 + 15)-(x0 + 19, y0 + 21), black2 '               tape
    LINE -(x0 + 33, y0 + 21), black2
    LINE -(x0 + 44, y0 + 15), black2
    LINE (x0 + 24, y0 + 19)-STEP(3, 1), dred, BF '                    head
    FOR i = 0 TO 1 '                                                  reels/rollers
        a(i) = (a(i) + t * tdir + tsix) MOD tsix '                      marker angle
        x = x0 + 13 + i * 24
        y = y0 + 11
        FOR d! = 5 TO 9
            CIRCLE (x, y), d!, white, , , .73 '                       reel
            CIRCLE (x, y), d!, white, , , .68
        NEXT d!
        x1 = x + 3 * s!(a(i)) * grav!
        y1 = y + 3 * c!(a(i))
        x2 = x + 6 * s!(a(i)) * grav!
        y2 = y + 6 * c!(a(i))
        LINE (x1, y1)-(x2, y2), black2 '                              rotation marker
        FOR d = 0 TO 4 '                                              hub
            CIRCLE (x, y), d, dred, , , .73
        NEXT d
    NEXT i
 
    IF sia > 0 THEN '                                                 shells in air = building gets MEAN title
        PrintLines "HAL", 0, 47, x0 + 1, y0 + 39, red, white, 1, 2
    ELSE
        PrintLines "IBM", 0, 47, x0, y0 + 39, blue, white, 1, 2
    END IF
 
    '                                                                 binary clock
    z$ = TIME$ '                                                      hh:mm:ss
    z$ = LEFT$(z$, 2) + MID$(z$, 4, 2) + RIGHT$(z$, 2) '              hhmmss
    FOR i = 1 TO 6
        v = VAL(MID$(z$, i, 1)) '                                     value
        x = x0 + i * 5 + 2 - (i > 2) * 5 - (i > 4) * 5 '              column
        z = VAL(MID$("132323", i, 1)) '                               rows for this column
        FOR j = 0 TO z
            IF v AND 1 THEN c = red ELSE c = black2 '                 red = on
            v = v \ 2
            y = glmax - 2 - j * 2
            LINE (x - 1, y)-(x + 1, y), c, B '                        show bit
        NEXT j
    NEXT i
 
    IF ttf! < -2 THEN fat! = TIMER + 10
    ttf! = fat! - TIMER '                                             time to fire
    IF fat! > 86400 THEN fat! = t: ttf! = 0
 
    IF (ttf! > 0) AND (ttf! < 1) THEN '                               optional radar
        sky = (sky + 1) MOD tsix
        x1 = x0 + 25
        FOR sky2 = 0 TO 180 STEP 5
            zz = (sky + sky2) MOD 180
            x2 = x1 + q2 * c!(zz)
            y2 = (y0 - 1) - q2 * s!(zz) - 1
            LINE (x1, y0 - 1)-(x2, y2), red, , &H1111
        NEXT sky2
    END IF
 
    IF pat1& = 0 THEN pat1& = &H5555: pat2& = &HAAAA
    SWAP pat1&, pat2& '                                               countdown to firing
    z! = ttf!: IF z! < 0 THEN z! = 0
    tx = x0 + z! / t * 48
    IF tx > (x0 + 48) THEN tx = xo + 48 '                             crude fix for a midnite crossing
    ty = y0 + 1
    LINE (x0 + 1, ty)-(tx, ty), black2, , pat1&
    LINE (x0 + 1, ty)-(tx, ty), red, , pat2&
 
    IF (sia < 20) AND (shoot OR (ttf! <= 0)) THEN '                   initialize shell
        shoot = 0
        FOR s = 1 TO 20
            IF shx(s) = 0 THEN
                sia = sia + 1 '                                       shells in air
                shx(s) = suri + x0 + 25
                shy(s) = 320
                shellv = (-32 + (RND - pf!) * t) * t '                velocity
                ta = 0
                IF RND > .1 THEN '                                    smart 10%
                    IF RND > pf! THEN
                        ta = -RND * 25
                    ELSE
                        ta = RND * 50 '                               above or below
                    END IF
                    ta = ta + (RND - pf!) * 4 '                       vary it a little
                END IF
                dx = px! - shx(s) + suri
                dy = shy(s) - py!
                IF dy = 0 THEN dy = 1
                shella = _R2D(ATN(dx / dy)) + (90 - 5 * SGN(dx) + ta)
                IF py! > 280 THEN
                    shella = 90 + (RND - pf!) * 40
                    shellv = shellv * .75
                END IF
                shella = (shella + tsix) MOD tsix
                shvx(s) = (shellv / t) * c!(shella)
                shvy(s) = (shellv / t) * s!(shella)
                shd(s) = q1
                EXIT FOR
            END IF
        NEXT s
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Info STATIC '                                                     show messages
    DIM lenmes(1)
    IF LEN(fb$) THEN mes$(0) = UCASE$(fb$): sm!(0) = mTIMER
 
    FOR i = 0 TO 1
        IF mes$(i) <> omes$(i) THEN sm!(i) = 0
        lenmes(i) = LEN(mes$(i))
        IF lenmes(i) AND (sm!(i) = 0) THEN
            sm!(i) = TIMER
            omes$(i) = mes$(i)
        END IF
        el! = TIMER - sm!(i)
        IF el! > 5 THEN mes$(i) = "": sm!(i) = 0
    NEXT i
    tcenter = (q3 + gs) \ 2 '                                         center of "space" area
    IF lenmes(0) THEN
        c1 = white2: c2 = gray
        z$ = LTRIM$(mes$(0))
        l3$ = LEFT$(z$, 3)
        IF l3$ = "CM:" THEN c1 = red '                                rendesvous chatter
        IF l3$ = "DAN" THEN c1 = red '                                Danger, Will Robinson
        IF c1 = red THEN c2 = black2
        IF (convo > 0) OR (INSTR("EstWARRad", l3$) > 0) THEN
            PrintVGA z$, tcenter - lenmes(0) * 4, 5, c1, -1
        ELSE
            IF lenmes(0) > (34 - (gs = 0) * 5) THEN
                tcol = (tcol + 4) MOD (lenmes(0) * t)
                z$ = SPACE$(4) + z$
                PrintLines z$, tcol, tcol + 40 * 16, gs, 20, c1, c2, 2, 2
            ELSE
                tx = tcenter - LEN(z$) * 8
                'LINE (gs, 6)-(q3, 17), 0, BF
                PrintLines z$, 0, lenmes(0) * 16 - 1, tx, 20, c1, c2, 2, 2
            END IF
        END IF
    END IF
 
    IF lenmes(1) THEN '                                               subordinate msg
        IF lenmes(0) THEN ty = 30 ELSE ty = 5
        PrintVGA mes$(1), tcenter - lenmes(1) * 4, ty, red, dred
    END IF
 
    IF (invincible = 0) AND (rads >= h) AND (TIMER < rtl!(0)) THEN
        z = rads \ h
        IF z >= t THEN radiationdeath = 1: z = t '                    >= ten
        IF z <= t THEN '                                              <= ten
            RESTORE radcomments
            FOR i = 1 TO z
                READ z$
            NEXT i
            IF VAL(LEFT$(z$, 1)) THEN '                               does it start with a #?
                z$ = "ensures your death within " + z$ '              yes, tack on phrase
            END IF
            mes$(1) = "Radiation exposure " + z$ + "!"
        END IF
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB LEDdisplay (t$) STATIC
    IF LEDinit = 0 THEN
        DIM segment(6, 3), number$(11)
        RESTORE leds
        FOR i = 0 TO 6
            READ g$
            FOR j = 0 TO 3
                READ segment(i, j)
            NEXT j
        NEXT i
        FOR i = 0 TO 11
            READ g$, number$(i)
        NEXT i
        LEDinit = 1
    END IF
 
    IF (osc < 6) OR (osc = t) THEN '                                  fuel,alt,h,v,thrust,angle
        tc = c: IF LEDtri = 0 THEN tc = LEDc
        IF osc = t THEN '                                             angle
            segx = 14: segy = 14 '                                    segment size
            tx = 92 - LEN(t$) * segx * 2
            ty = 298
        ELSE
            tl = (LEN(t$) - SGN(INSTR(t$, "."))) * 16
            tx = gs - tl
            ty = 296 - osc * 39
            segx = 8: segy = 8
        END IF
    ELSE '                                                            6clock 7dtm 8speed 9rads
        IF osc = 9 THEN tc = red ELSE tc = orange
        IF crash THEN tc = white2
        tx = 50
        ty = 35 + (osc - 6) * 9
        IF osc = 9 THEN ty = 62
        segx = 4: segy = 3
    END IF
 
    IF crash AND (osc <> 6) THEN EXIT SUB '                           allow clock
 
    dpp = 0 '                                                         decimal point
    FOR si = 1 TO LEN(t$)
        z$ = MID$(t$, si, 1)
        IF z$ = "." THEN '                                            plot sub can't handle decimal
            tx1 = tx + (si - 1) * 16 - 5
            LINE (tx1, ty - 1)-(tx1 + 1, ty), tc, BF
            dpp = 1
        ELSE
            z = VAL(z$)
            IF z$ = "-" THEN z = t
            IF z$ = "L" THEN z = 11 '                                 "L" for lock fuel and level ground
            IF z$ <> " " THEN GOSUB leddigit
        END IF
    NEXT si
 
    IF osc = 6 THEN '                                                 colon for clock
        IF crash THEN bbit = 1
        PSET (tx + 14, ty - 4), tc * bbit
        PSET (tx + 14, ty - 2), tc * bbit
    END IF
    EXIT SUB
 
    leddigit:
    FOR i = 1 TO LEN(number$(z))
        seg$ = MID$(number$(z), i, 1)
        IF INSTR("abcdefg", z$) THEN seg$ = z$ '                      for wave effect
        segn = ASC(seg$) - 97
        x0 = tx + (si - 1 - dpp) * (segx * 2)
        x1 = x0 + segment(segn, 0) * segx
        y1 = ty + segment(segn, 1) * segy
        x2 = x0 + segment(segn, 2) * segx
        y2 = ty + segment(segn, 3) * segy
        IF x1 < x2 THEN
            LINE (x1 + 1, y1)-(x2 - 1, y1), tc '                      horizontal
            IF osc = t THEN '                                         angle (very thick)
                LINE (x1 + 2, y1 - 1)-(x2 - 2, y1 - 1), tc
                LINE (x1 + 2, y1 + 1)-(x2 - 2, y1 + 1), tc
            END IF
        ELSE
            LINE (x1, y1 + 1)-(x1, y2 - 1), tc '                      vertical
            IF osc = t THEN '                                         angle (very thick)
                LINE (x1 - 1, y1 + 2)-(x1 - 1, y2 - 2), tc
                LINE (x1 + 1, y1 + 2)-(x1 + 1, y2 - 2), tc
            END IF
        END IF
    NEXT i
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB LMbloads
    p = ASO * 3 + 4
 
    s& = VARSEG(LMx(0))
    o& = VARPTR(LMx(0))
    DEF SEG = s&
    BLOAD f$(p), o&
 
    s& = VARSEG(LMy(0))
    o& = VARPTR(LMy(0))
    DEF SEG = s&
    BLOAD f$(p + 1), o&
 
    s& = VARSEG(LMc(0))
    o& = VARPTR(LMc(0))
    DEF SEG = s&
    BLOAD f$(p + 2), o&
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB LMdistort
    FOR i = 1 TO rp
        IF (LMc(i) = craft) AND (RND > .6) THEN
            LMx(i) = LMx(i) + RND * 3 - 1
            LMy(i) = LMy(i) + RND * 3 - 1
        END IF
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB LoadPanel STATIC
    IF pload = 0 THEN
        z = 12500
        REDIM pb(z)
        tf$ = "PANEL" + CHR$(48 + background) + ".DAT"
        s& = VARSEG(pb(0))
        o& = VARPTR(pb(0))
        DEF SEG = s&
        BLOAD tf$, o&
        pload = 1
    END IF
    PUT (0, 67), pb(), PSET
END SUB
' -------------------------------------------------------------------------------------------------------x
FUNCTION localize (tx, p, m)
    z0 = 9999 '                                                       assume out of range
    z1 = suri - m '                                                   surface index - minus
    z2 = suri + p + q3 '                                              surface index + plus
    FOR z = -1 TO 1 '                                                 page before, current, next
        zx = tx + z * q1
        IF (zx <= z2) AND (zx >= z1) THEN z0 = tx - suri + q1 * z
    NEXT z
    localize = z0 '                                                   return 9999 or calculated
END FUNCTION
' -------------------------------------------------------------------------------------------------------x
SUB Map
    LINE (0, 0)-(gs - 1, 1), blue2, BF
    FOR i = 1 TO 17 + ufof
        IF i <= t THEN '                                              surface features
            tx = sf(i, 2)
            IF tx = -1 THEN GOTO skipf '                              destroyed
            tc = blue
            z$ = sf$(i) '                                             surface feature name
            IF i = 3 THEN z$ = "LGM" '                                shorten some names
            IF i = 5 THEN z$ = "McD"
            IF i = 7 THEN z$ = "SSC"
            GOTO wubba
        END IF
        IF i = (17 + ufof) THEN
            tc = white
            tx = (suri + px!) MOD (q1 + 1)
            z$ = "LM"
        ELSE '                                                        sky feature
            IF skyoff THEN GOTO skipf
            j = i - 11
            IF (ek(j) = -1) OR eou THEN GOTO skipf '                  destroyed or not present
            IF j THEN tc = red ELSE tc = green '                      CM green, rest red
            tx = ex(j)
            '                     1    2    3    4    5    6
            '                 12345123451234512345123451234512345
            z$ = RTRIM$(MID$("CM   EPCORBorg BH   Worm CometAlien", j * 5 + 1, 5))
            IF j = 0 THEN z$ = z$ + STR$(exv(0)) '                    CM + velocity
        END IF
 
        wubba:
        tx = tx \ t
        LINE (tx, 0)-(tx + 1, 1), tc, BF
        zz = LEN(mes$(0)) + LEN(mes$(1)) - (liftoff = 1) '            quash names when messages active and during liftoff
        IF (zz = 0) AND (tx > (gs + 6)) THEN PrintLines z$, 0, LEN(z$) * 8, tx - 6, 16, tc, -99, 0, 1
        skipf:
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB McD STATIC '                                                      37 * 16
    IF McDi = 0 THEN '                                                initialize
        z$ = "    Burger, fries & Coke only $1.99!"
        FOR i = 1 TO LEN(z$) '                                        Morse code
            c$ = MID$(z$, i, 1)
            RESTORE MorseData
            FOR j = 1 TO 39
                READ d$, x$
                IF d$ = LCASE$(c$) THEN m$ = m$ + x$ + " "
            NEXT j
        NEXT i
        McDi = 1
    END IF
 
    mp = (mp + 4) MOD 320 '                                           show ad in text
    x2 = x + 38
    IF bolthitf THEN tc = white ELSE tc = gold
    LINE (x, glmax)-(x2, glmax - 19), tc, BF '                        clear sign area
    PrintLines z$, mp, mp + 37, x, glmax - 1, red, black2, 1, 1
 
    FOR mx = x TO x2 - 1 '                                            arch & red neon
        my = gety(mx)
        arch = (arch + 1) MOD t
        IF arch < 2 THEN tc = red ELSE tc = gold
        IF bolthitf THEN tc = white
        IF mx > x THEN LINE (mx, my)-(mx, my + 2), tc
        tmx = x + x2 - mx - 2
        IF tmx > x THEN LINE (tmx, glmax - 19)-(tmx + 2, glmax - 18), tc, BF
    NEXT mx
 
    y = glmax - 1 '                                                   show ad in Morse
    i = 0
    z = (z MOD LEN(m$)) + 1
    DO
        j = ((z + i) MOD LEN(m$)) + 1
        i = i + 1
        p = INSTR(".- ", MID$(m$, j, 1)) - 1
        IF p < 2 THEN LINE (x, y)-(x + p * 2, y), black2
        x = x + (p + 1) * 2
    LOOP UNTIL (x + 2) > x2
END SUB
' -------------------------------------------------------------------------------------------------------x
FUNCTION OnOff$ (v)
    OnOff$ = MID$("OFFON ", v * 3 + 1, 3)
END FUNCTION
' -------------------------------------------------------------------------------------------------------x
SUB PrepAndShowLED (t!, nd, dp) STATIC
    osc = osc + 1
    IF dp = t THEN dp = 0: osc = 9
 
    ti = FIX(t!)
    z! = ABS(t! - ti)
    s$ = SPACE$(6)
    IF (t! < 0) AND (ti = 0) THEN
        t1$ = RIGHT$(s$ + "-" + LTRIM$(STR$(ti)), nd)
    ELSE
        t1$ = RIGHT$(s$ + LTRIM$(STR$(ti)), nd)
    END IF
 
    t2a$ = LTRIM$(STR$(INT(z! * (t ^ dp))))
    IF LEN(t2a$) < dp THEN t2a$ = RIGHT$("000" + t2a$, dp)
    t2$ = LEFT$(LTRIM$(t2a$) + "0000", dp)
    IF dp = 0 THEN z$ = t1$ ELSE z$ = t1$ + "." + t2$
 
    IF z$ = " -0.00" THEN z$ = "  0.00"
    'IF z$ = " -0.99" THEN z$ = " -1.00"
 
    IF (osc = 9) AND (t! = 0) THEN '                                  usually count for rads, lightning
        cylon = (cylon + 1) MOD 6 '                                    when blank, cycle a "-"
        zz = VAL(MID$("123432", cylon + 1, 1))
        z$ = "    "
        MID$(z$, zz, 1) = "-"
    END IF
 
    IF osc = 4 THEN
        IF (liftoff = 0) AND level THEN MID$(z$, 1, 1) = "L" '        altitude
        IF radarf = 0 THEN z$ = " ----"
    END IF
 
    IF (osc = 5) AND lockfuel THEN MID$(z$, 1, 1) = "L" '             fuel
 
    IF warp! > 0 THEN
        IF osc = 4 THEN z$ = " ----" '                                suppress altitude
        IF osc = 7 THEN z$ = "----" '                                 distance to McDonalds
    END IF
 
    LEDdisplay z$
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB PrintCGA (c$, x, y, tc1, tc2, compress) STATIC '                  CGA font, 8 * 8
    c1 = tc1
    c2 = tc2
    IF y = -1 THEN '                                                  single char panel stuff - F for Fuel, etc.
        c2 = -1
        y = 263 - osc * 39
        tx1 = x - 3
        tx2 = x + 11
        ty1 = y
        ty2 = y + t
        IF bbit AND (LEDc = green) AND (radarf > 0) AND (contact = 0) AND ((c1 = red) OR (c1 = yellow)) THEN
            LINE (tx1 + 1, ty1 + 1)-(tx2 - 1, ty2 - 1), c1, BF
            c1 = black2
        ELSE
            IF (osc = 4) AND (radarf = 0) THEN c1 = gray ELSE c1 = white
        END IF
    END IF
 
    IF y + 9 > glmax THEN EXIT SUB
    tx = x + 1
 
    FOR i = 1 TO LEN(c$)
        d = ASC(MID$(c$, i, 1))
        'IF d = 248 THEN d = 0                                        ' degree symbol
        FOR k = 0 TO 7
            IF p2(d, k) OR (compress = 0) THEN
                IF c2 >= 0 THEN
                    LINE (tx + 1, y + 2)-(tx + 1, y + t), c2, , p2(d, k)
                END IF
                LINE (tx, y + 1)-(tx, y + 9), c1, , p2(d, k)
                tx = tx + 1
            END IF
        NEXT k
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB PrintLines (d$, i1, i2, x1, y1, c1, c2, sd, s) STATIC
    ' chars, index1, index2, x,y, color 1, color 2, shadow distance,size
    slant = -(c2 < -20)
    FOR i = i1 TO i2 - 1
        z = i \ (8 * s) + 1
        IF z > LEN(d$) THEN d = 32 ELSE d = ASC(MID$(d$, z, 1))
        IF d = 248 THEN d = 0 '                                       degree symbol
        m& = _SHL(1, (7 - (i \ s) MOD 8))
        p& = 0
        FOR j = 0 TO 13
            p& = p& * 2 + SGN((p(d, 13 - j) AND m&))
        NEXT j
        IF c2 = -99 THEN '                                            vertical
            ty1 = y1 + (i - i1)
            ty2 = ty1 - slant * 13
            LINE (x1, ty1)-(x1 + 13, ty2), c1, , p& * 2
        ELSE '                                                        horizontal
            tx1 = x1 + i - i1 + 1
            tx2 = tx1 + slant * 15
            ty2 = y1 - 15
            LINE (tx1, y1)-(tx2, ty2), c1, , p&
            IF c2 >= 0 THEN LINE (tx1 + sd, y1)-(tx2 + sd, ty2), c2, , p&
        END IF
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB PrintVGA (z$, tx, ty, c1, c2) '                                   VGA font, 8 * 14
    PrintLines z$, 0, LEN(z$) * 8 - 1, tx, ty + 13, c1, c2, 1, 1
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Setcolor
    'black = 0: blue = 1: green = 2: gunmetal = 3: red = 4: gasoline = 5
    'gray2 = 6: white = 7: gray = 8: dred = 9: gold = 10: black2 = 11
    'orange = 12: blue2 = 13: yellow = 14: white2 = 15
 
    '          b g g r g g w g d g b o b y w
    '          l r u e a y h y r o k r 2 e h
    '          1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
    IF bw THEN '
        z$ = "070707075607070756070007565656" '                       black and white (because I can!)
    ELSE
        z$ = "010249042456075632380052085407" '                       color
        'z$ = "010249322456075632380052085407" '                       color
    END IF
    FOR i = 0 TO 14
        PALETTE i + 1, VAL(MID$(z$, i * 2 + 1, 2))
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Shells STATIC
    FOR s = 0 TO 20 '                                                 0 element is bomb, others from IBM
        IF shx(s) = 0 THEN GOTO nextshell '                           never active or already exploded
        shvy(s) = shvy(s) + grav! '                                   gravity
        shx(s) = shx(s) + shvx(s)
        shy(s) = shy(s) + shvy(s)
        tsx = shx(s) - suri
        tsy = shy(s)
 
        IF (s > 0) AND (crash = 0) THEN
            dx! = tsx - px!
            dy! = (tsy - py!) * aspect!
            shd(s) = SQR(dx! * dx! + dy! * dy!)
            IF (invincible = 0) AND (shd(s) < 20) THEN
                dead$ = "HAL KILLED YOU"
                EXIT SUB
            END IF
        END IF
 
        IF (tsy > 0) AND (shvy(s) > 0) AND ((tsy + shvy(s)) > gety(tsx)) THEN
            tsy = gety(tsx)
            FOR a2 = 0 TO tsix STEP 30 '                               explode, make star
                bit = bit XOR 1 '                                     toggle
                d2 = bit * t + t / 2
                x2 = tsx + d2 * c!(a2) * aspect!
                y2 = tsy + d2 * s!(a2)
                IF a2 THEN LINE -(x2, y2), gold ELSE PSET (x2, y2), gold
            NEXT a2
            PAINT (tsx, tsy), gold, gold
            shx(s) = 0
            sia = sia - 1
            IF s = 0 THEN GOSUB makecrater
        ELSE '                                                        show shell
            IF shvx(s) < 0 THEN ai = -30 ELSE ai = 30 '               spin
            sha(s) = (sha(s) + ai + tsix) MOD tsix
            ss = 3 + (s = 0) * 2
            FOR i = 0 TO 1
                IF i THEN cc = red ELSE cc = gold
                a1 = (sha(s) + i * 180) MOD tsix '                     angle 1
                a2 = a1 + 150 '                                       angle 2
                ex = tsx + ss * c!(a1) * aspect! '                    1 of the endpoints
                ey = tsy + ss * s!(a1) '                              a line from an endpoint to
                FOR j = a1 TO a2 STEP t '                             each point on the half circle
                    zk = j MOD tsix '                                  seemed easier than a paint
                    zx = tsx + ss * c!(zk) * aspect!
                    zy = tsy + ss * s!(zk)
                    LINE (zx, zy)-(ex, ey), cc
                NEXT j
            NEXT i
        END IF
        nextshell:
    NEXT s
    EXIT SUB
 
    makecrater:
    dd = ABS(sf(sf, 2) - suri - tsx) '                                distance to current surface feature
    IF dd < t THEN sf(sf, 2) = -1 '                                   under ten from a surface feature, kill feature
 
    'FOR crx = 0 TO q1
    'gc(crx) = gray
    'NEXT crx
    zz = 40 '                                                         distance +- impact
    r1 = RND * 40
    r2 = RND * 40 + 40
    FOR crx = -zz TO zz
        ta = (crx * 2 + 270) MOD tsix '                                angle
        tx = tsx + crx
        ty = gety(tc) - r1 - r2 * s!(ta)
        IF ty > glmax THEN ty = glmax
        ti = ((suri + tx + q1) MOD q1)
        gh(ti) = ty
        'gc(ti) = yellow
        IF iscd = 0 THEN PUT #6, ti + 1, ty
    NEXT crx
 
    ti = (suri + tsx - zz - 1 + q1) MOD q1
    Smooth ti
    ti = (suri + tsx + zz) MOD q1
    Smooth ti
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB ShowAngle (a)
    zc = dcolor(CSNG(a), 0, 4, 1)
    c = zc
    IF (bbit = 0) AND (contact = 0) THEN c = black '                  blink
    IF a = 0 THEN z$ = "  "
    IF a > 0 THEN z$ = CHR$(17) + " " '                               point left
    IF a < 0 THEN z$ = " " + CHR$(16) '                               point right
    PrintVGA z$, 7, 270, c, black2
    IF LEDtri THEN c = zc ELSE c = LEDc
    osc = t
    a$ = LTRIM$(STR$(-a))
    LEDdisplay a$
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Surveyor STATIC
    DIM SSp&(1, 26), x(1), y(1)
    IF sspinit1 = 0 THEN
        s& = VARSEG(SSp&(0, 0))
        o& = VARPTR(SSp&(0, 0))
        DEF SEG = s&
        BLOAD f$(17), o& '                                            surv2.dat
        sc = white
        sspinit1 = 1
    END IF
 
    x0 = x
    ti = suri + x0 - 1
    IF ti > q1 THEN ti = ti - q1
    y0 = gh(ti)
 
    FOR i = 0 TO 26
        tx = x0 + i
        LINE (tx, y0 - 21)-(tx, y0 - 5), sc, , SSp&(0, i)
        LINE (tx, y0 - 16)-(tx, y0 - 0), sc, , SSp&(1, i)
    NEXT i
 
    '                                                                 modify ground to include Surveyor
    IF (x0 >= gs) AND (x0 < 604) AND (sspinit2 = 0) THEN
        FOR tx = x0 TO x0 + 32
            FOR ty = y0 - 20 TO glmax
                IF POINT(tx, ty) = sc THEN
                    z = (suri + tx) MOD q1
                    gh(z) = ty
                    EXIT FOR
                END IF
            NEXT ty
        NEXT tx
        sspinit2 = 1
    END IF
 
    FOR tx = x0 TO x0 + 26 '                                          optional shadow
        FOR ty = y0 - 21 TO y0
            p = POINT(tx, ty)
            IF p = sc THEN
                zx = tx - (x0 + 13)
                zy = ty - (y0 - t)
                IF zy > (zx + 4) THEN PSET (tx, ty), gray
            END IF
        NEXT ty
    NEXT tx
 
    attack = 0
    sdd = q1
    FOR i = 180 TO 355 STEP 5 '                                       rays
        ra = i + RND * 5
        z = 25 + RND * t
        FOR j = 0 TO 1
            x(j) = (x + t) + z * c!(ra) * aspect!
            y(j) = y0 + z * s!(ra) - 1
            z = z + RND * 30 + t
        NEXT j
        xs! = (x(1) - x(0)) / 20
        ys! = (y(1) - y(0)) / 20
        FOR j = 0 TO 19
            tx = x(0) + j * xs!
            ty = y(0) + j * ys!
            x! = px! - tx
            y! = (py! - ty) * aspect!
            dd = SQR(x! * x! + y! * y!)
            IF dd < sdd THEN sdd = dd
            IF (shield = 0) OR (dd > 70) OR (j = 0) THEN PSET (tx, ty), gunmetal
            IF shield AND ((dd = 70) OR ((j = 0) AND (dd < 70))) THEN
                LINE (sx0 + xoff, sy0 + vy!)-(tx, ty), lmsl
                IF RND < .7 THEN
                    PSET STEP(0, 0), red
                ELSE
                    LINE (tx - 1, ty)-(tx + 1, ty), red
                    LINE (tx, ty - 1)-(tx, ty + 1), red
                END IF
                EXIT FOR
            END IF
        NEXT j
        IF sdd < 20 THEN attack = 1
    NEXT i
    IF attack AND (crash = 0) AND (shield = 0) THEN
        oldr = rads
        rads = rads + RND * t + 1
        IF rads > 9999 THEN rads = 9999
        IF rads > oldr THEN
            rtl!(0) = TIMER + 5
            rtlc(0) = rads
            panelinit = 0
        END IF
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Tile STATIC
    IF tinit = 0 THEN
        s = 7
        DIM t(1, s, s)
        FOR i = 0 TO 1
            FOR j = 0 TO 1
                FOR k = 0 TO 90 STEP t
                    ta = k + j * 180
                    tx = j * s + (s \ 2) * c!(ta)
                    ty = j * s + (s \ 2) * s!(ta)
                    IF i THEN ty = s - ty
                    t(i, tx, ty) = 1
                NEXT k
            NEXT j
        NEXT i
        tinit = 1
    END IF
 
    IF gstyle = 4 THEN tc = gray ELSE tc = black2
    FOR xo = gs TO q3 STEP s
        FOR yo = glmax TO (glmin - 50) STEP -s
            SELECT CASE tilef
                CASE IS = 0
                    bp = gety(xo) + yo
                    z1 = bp MOD 128
                    z2 = (bp MOD 12) + 1
                    td = p(z1, z2)
                    kk = SGN(td AND _SHL(1, (bp MOD 8)))
                CASE IS = 1
                    bp = SQR(xo * yo)
                    z1 = bp MOD 128
                    z2 = (bp MOD 12) + 1
                    td = p(z1, z2)
                    kk = SGN(td AND _SHL(1, (bp MOD 8)))
                CASE IS = 2
                    kk = RND '
            END SELECT
            FOR i = 0 TO s
                tx = xo + i
                yy = gety(tx) + 1
                FOR j = 0 TO s
                    ty = yo - j
                    IF ty <= yy THEN EXIT FOR
                    IF t(kk, i, j) THEN
                        zz = tx + suri
                        c1 = (sf(5, 2) = -1) OR (zz < sf(5, 0)) OR (zz > sf(5, 1)) '     McD
                        c2 = (sf(7, 2) = -1) OR (zz < sf(7, 0)) OR (zz > sf(7, 1)) '     Surv
                        IF c1 AND c2 THEN PSET (tx, ty), tc
                    END IF
                NEXT j
            NEXT i
        NEXT yo
    NEXT xo
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB TMA STATIC
    DIM tmaa!(10), tmab!(10), tmac(10)
    IF ok AND (INSTR(fb$, "on TMA") > 0) THEN '                       landed, do Mandelbrot instead of moire
        Mandel
        GOTO tmaother
    END IF
    IF zdc = 0 THEN '                                                 then initialize
        nc = RND * 2 + 1 '                                            use 2-3 colors
        lc = -1 '                                                     last color, prevent repeats
        FOR z = 0 TO nc
            tmaa!(z) = RND + 4
            tmab!(z) = (RND - pf!) / 8
            DO
                c = RND * 14 + 1
                IF c = gray2 THEN c = gray '                          stars use gray2
                IF c = white2 THEN c = white '                        stars use white2
                IF c <> lc THEN lc = c: EXIT DO
            LOOP
            tmac(z) = c
        NEXT z
    END IF
 
    zdc = (zdc + 1) MOD 50
    FOR z = 0 TO 2
        tmaa!(z) = tmaa!(z) + tmab!(z)
    NEXT z
    y0 = glmax - 72
    y1 = y0 + 1
    y2 = glmax - 1
    LINE (x, glmax)-(x + 46, glmax), gray
 
    FOR gx = x TO x + 45
        x2! = gx / tmaa!(0)
        x2! = x2! * x2!
        FOR gy = y1 TO y2
            y2! = gy / tmaa!(0)
            y2! = y2! * y2!
            tcc = ABS((x2! + y2!) / tmaa!(1)) MOD (nc + 1)
            PSET (gx, gy), tmac(tcc)
        NEXT gy
    NEXT gx
 
    IF TIMER < cybilltime! THEN CybillPix f$(16) ELSE gotpix = 0
 
    tmaother:
    IF bolthitf THEN LINE (x, y0)-(x + 45, glmax), white, BF
 
    FOR s = 0 TO 20 '                                                 shells
        IF (shx(s) > 0) AND (shd(s) < 80) THEN
            tarx = shx(s) - suri
            tary = shy(s)
            IF (s > 0) OR (shy(s) > 200) THEN
                GOSUB tmafl
                ExplodeShell s '                                      show it exploded
            END IF
        END IF
    NEXT s
 
    FOR i = 2 TO 6 '                                                  not DS!
        IF (ek(i) > 0) AND (ek(i) < 30) THEN
            tarx = exl(i) '                                           where to shoot
            tary = ey(i)
            GOSUB tmafl '                                             fire laser
            ek(i) = 0
            ex(i) = 0 '                                               mark destroyed
            exv(i) = 0
        END IF
    NEXT i
    EXIT SUB
 
    tmafl: '                                                          fire laser
    FOR gx = x TO x + 45 STEP 2 '                                     along top of TMA1
        LINE (gx, y1 - 1)-(tarx, tary), blue '                        nice blue
    NEXT gx
    IF gotpix = 0 THEN '                                              not showing Cybill
        cybilltime! = TIMER + 2 '                                     keep on screen for 2 sec
        gotpix = 1 '                                                  flag onscreen
    END IF
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Wave STATIC '                                                     funny effect for warp speeds
    tdg = (tdg MOD 4) + 1
    FOR i = 1 TO 22
        '               1234567890123456789012
        '               TTTTHHHHHVVVVVAAAAFFFF
        osc = VAL(MID$("1111222223333344445555", i, 1))
        wll = VAL(MID$("45555", osc, 1))
        adg = (tdg + wll) MOD 4 + 1 - (wll = 4)
        z$ = MID$("agdgagdg", adg, wll)
        LEDdisplay z$
    NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB WormHole STATIC
    IF eou THEN EXIT SUB '                                            end of universe
 
    IF ei(4) = 0 THEN
        nc:
        c1 = RND * 14 + 1
        c2 = RND * 14 + 1
        IF c1 = c2 THEN GOTO nc
        IF (c1 = black2) OR (c1 = gray) THEN GOTO nc
        IF (c2 = black2) OR (c2 = gray) THEN GOTO nc
        ei(4) = 1
    END IF
 
    tx = localize(ex(4), 0, 0)
    wy = ey(4)
    ba = (ba + 30) MOD tsix
    FOR ta = 0 TO 720 STEP 2
        FOR d = 0 TO 3
            baa = (ta + ba + d * 90) MOD tsix
            tx1 = tx + ta / 8 * c!(baa)
            ty1 = wy + ta / 40 * s!(baa)
            IF d MOD 2 THEN c = c1 ELSE c = c2
            PSET (tx1, ty1), c
        NEXT d
    NEXT ta
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB LGM (fc) STATIC '                                                 little green man
 
    x = x - 5
    IF LGMc = gray THEN '                                             LGM toasted - show pile of ashes
        y1 = gety(x + t) - 1
        FOR y = 0 TO 5
            LINE (x + y, y1 - y)-(x + 15 - y, y1 - y), gray
            p = VAL(MID$("162341", y + 1, 1))
            PSET (x + y + p, y1 - y), black2
            PSET (x + y + p + 3, y1 - y), black2
        NEXT y
        EXIT SUB
    END IF
 
    IF sema$ = "" THEN '                                              initialize
        DIM a(28, 1) '                                                angles
        RESTORE semadata
        FOR i = 1 TO 28 '                                             read angles
            READ z$, a(i, 0), a(i, 1)
        NEXT i
        DO
            READ z$
            IF z$ = "end" THEN EXIT DO
            sema$ = sema$ + " " + z$ + " "
        LOOP
        lc$ = CHR$(255): i = 0 '                                      lc = last character, i = index
    END IF
 
    IF crash THEN LGMc = dred '                                       white2 as many other colors g1
    IF TIMER < sema! THEN sema! = TIMER '                             midnite crossing fix
    IF (TIMER - sema!) > semat! THEN '                                signal next letter
        sema! = TIMER
        IF fc = 0 THEN '                                              flame count
            semat! = .3
            tsema$ = sema$
            IF si > 0 THEN i = si - 1: si = 0
        ELSE
            semat! = .2 '                                             0.2 seconds between letters
            IF fc < 5 THEN '                                          flame count
                IF tsema$ <> "help  " THEN tsema$ = "!"
                toast = 0
            ELSE
                tsema$ = "help  "
                toast = toast + 1
                IF toast > 2 THEN toast = 0: LGMc = LGMc + 1
            END IF
        END IF
        i = (i MOD LEN(tsema$)) + 1
        p = INSTR(tsema$, "time is")
        IF p THEN
            z$ = MID$(TIME$, 1, 2) + MID$(TIME$, 4, 2)
            MID$(tsema$, p + 8, 4) = z$
        END IF
        y1 = gety(x) - 14
        IF demo THEN y1 = 286
        c$ = MID$(tsema$, i, 1)
        d = ASC(LCASE$(c$)) - 96
        IF d < 1 THEN d = 27
        IF c$ = "!" THEN d = 28
        p = INSTR("1234567890", c$): IF p THEN d = p - (c$ = "0")
        IF oscar THEN
            c1 = red
            c2 = gold
        ELSE
            c1 = blue
            c2 = white
        END IF
        IF (c$ <> " ") AND (c$ = lc$) THEN SWAP c1, c2
        lc$ = c$
    END IF
 
    '              1 2 3 4 5 6 7 8 9
    '              g y o r d g b
    '              r e r e r 2 2
    c = VAL(MID$("021412040906110015", (LGMc - 1) * 2 + 1, 2))
    IF bolthitf THEN c = white
    IF c = black2 THEN co = gray2 ELSE co = black2
    CIRCLE (x + t, y1 - 6), 4, c '                                    head
    PAINT (x + t, y1 - 6), c, c '                                     fill in head
    PSET (x + 8, y1 - 7), co '                                        left eye
    PSET (x + 12, y1 - 7), co '                                       right eye
    LINE (x + 9, y1 - 5)-(x + 11, y1 - 5), co '                       mouth
    LINE (x + 5, y1)-(x + 15, y1 + 12), c, BF '                       body
    IF c = black2 THEN
        CIRCLE (x + t, y1 - 6), 5, co '                               eye
        LINE (x + 5, y1)-(x + 15, y1 + 12), co, B '                   body
    END IF
 
    IF (d = 27) AND (c <> black2) AND (fc = 0) THEN '                 wiggle ears
        x2 = x + 5 - bbit
        x3 = x + 14 + bbit
        y2 = y1 - 8 + bbit
        LINE (x2, y2)-(x2 + 1, y2 + 1), c, BF
        LINE (x3, y2)-(x3 + 1, y2 + 1), c, BF
    END IF
 
    IF fc THEN '                                                      optional flame effect
        IF fc > t THEN di = 4 ELSE di = t '                           flame count
        FOR tx = x + 5 TO x + 15
            FOR ty = y1 - 9 TO y1 + 12
                p = POINT(tx, ty)
                z = (z + 1) MOD q1
                IF p = c THEN
                    tc = (ty + tx + z) MOD di
                    IF tc = 0 THEN PSET (tx, ty), gold
                    IF tc = 1 THEN PSET (tx, ty), black2
                END IF
            NEXT ty
        NEXT tx
    END IF
 
    IF c = black2 THEN c = gray2
    FOR j = 0 TO 1 '                                                  arms & flags
        a1 = a(d, j) - 90
        x2 = x + j * 20
        x3 = x2 + 26 * COS(_D2R(a1))
        y2 = y1 + 25 * SIN(_D2R(a1))
        LINE (x2, y1)-(x3, y2), c '                                   arm
        IF j = 0 THEN s = 1: IF INSTR("wxz", c$) THEN s = -s
        IF j = 1 THEN s = -1: IF INSTR("hio89", c$) THEN s = -s
        FOR q = 0 TO 3
            a1 = a1 - 90 * s
            x4 = x3 + t * COS(_D2R(a1))
            y4 = y2 + t * SIN(_D2R(a1))
            LINE -(x4, y4), gunmetal
            IF q = 1 THEN
                sx = x4: sy = y4
                r! = _D2R(a1 - 45 * s)
                rx = x3 + 5 * COS(r!)
                ry = y2 + 5 * SIN(r!)
            END IF
            IF q = 3 THEN
                r! = _D2R(a1 - 45 * s)
                yx = x3 + 5 * COS(r!)
                yy = y2 + 5 * SIN(r!)
            END IF
            x3 = x4: y2 = y4
        NEXT q
        LINE -(sx, sy), gunmetal
        PAINT (rx, ry), c1, gunmetal
        PAINT (yx, yy), c2, gunmetal
    NEXT j
 
    IF c$ = UCASE$(c$) THEN
        x2 = x + 5 + SGN(INSTR("ACDHJMNOPSUV0123456789", c$)) '       letter centering
        y2 = y1 + 2
    ELSE
        x2 = x + 6 - SGN(INSTR("ijlnv", c$)) '                        as above
        y2 = y1 - SGN(INSTR("gjpqy", c$)) + 2
    END IF
 
    IF LGMc = 4 THEN tc = gold ELSE tc = red
    CALL PrintVGA(c$, x2, y2, tc, black2)
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Stars STATIC
 
    ' - starstatus  0 off, 1 on, 2+names, 3+RA & Dec & grid, 4+Mag
    ' - encodes magnitude into xy array by making negative
    ' - stars1 1797, stars2 16571, stars3 87470
    ' - parsec = 3.262 light years
 
    IF sinit = 0 THEN
        sinit = 1
        qq = 18000
        DIM starx(qq), stary(qq), starn(30), star$(2, 50)
        starmax = qq: namemax = 100
        gc = blue '                                                   grid color
        sc = gray2 '                                                  star info color
    END IF
    nh = 12 / (zoom + 1) '                                            hours (RA)
    nd = 90 / (zoom + 1) '                                            degrees (Dec)
 
    IF eou <> 0 THEN '                                                End of Universe
        alldown = 1
        FOR star = 1 TO nstars
            sy = stary(star)
            ay = ABS(sy)
            IF ay < q4 THEN '                                         less than screen bottom
                stary(star) = stary(star) + SGN(stary(star))
                alldown = 0 '                                         not done
            END IF
        NEXT star
        IF alldown THEN CLS: EXIT SUB
    END IF
 
    IF regen = 0 THEN CLS
    tss = starstatus
    IF starinit = 0 THEN
        starinit = 1
        eou = 0 '                                                     End of Universe
        alldown = 0
        nstars = 0
        named = 0
        rmax! = rmin + nh '                                           hours
        dmax! = dmin + nd '                                           degrees
        n1& = 0
        isred1 = 0: isred2 = 0
        rmin$ = RIGHT$("00" + LTRIM$(STR$(rmin)), 2) '                0 - 24
        dmin$ = RIGHT$("000" + LTRIM$(STR$(dmin)), 3) '               -90 to 90
        zz$ = LTRIM$(STR$(starfiles)) + rmin$ + dmin$ + ".DAT"
        IF (warp! >= 1) AND (starfiles = 2) THEN tfs = 1 ELSE tfs = starfiles
        SELECT CASE tfs
            CASE IS = 0
                th! = 5.07 + zoom: tf$ = "STARS1.DAT": d$ = "DAT1\": nl& = 1797
            CASE IS = 1
                th! = 7.07 + zoom: tf$ = "STARS2.dat": d$ = "DAT2\": nl& = 16571
            CASE IS = 2
                th! = 8.07 + zoom: tf$ = "STARS3.dat": d$ = "DAT3\": nl& = 87470
        END SELECT
        IF okrick = 0 THEN d$ = ""
        tf1$ = d$ + "SI" + zz$: tif1 = _FILEEXISTS(tf1$)
        tf2$ = d$ + "SX" + zz$: tif2 = _FILEEXISTS(tf2$)
        tf3$ = d$ + "SY" + zz$: tif3 = _FILEEXISTS(tf3$)
        isstari = ((tif1 + tif2 + tif3) = -3)
        IF regen THEN isstari = 0
        IF isstari THEN
            GOSUB readstar
            GOTO plot
        END IF
        regen = 0
        FOR i = 0 TO qq
            starx(i) = 0
            stary(i) = 0
        NEXT i
        tf = FREEFILE
        OPEN tf$ FOR INPUT AS #tf
        DO
            INPUT #tf, r!, d!, m!, dis$, n$
            n1& = n1& + 1
            IF (starfiles > -1) AND ((n1& MOD h) = 1) THEN
                zz1 = h + t '                                         hundred + 10 = 110
                zz2 = zz1 + n1& / nl& * 500
                LINE (gs, 0)-(639, 40), black, BF
                LINE (zz1, t)-(zz1 + 500, 13), red, B
                LINE (zz1, t)-(zz2, 13), red, BF
                PrintCGA "Loading stars...", 300, 14, red, black, 0
                PrintCGA tf1$, 110, 14, red, black, 0
                IF mstar > 0 THEN '                                   regenerating all starfiles, show progress
                    zz2 = zz1 + mstar / 1368 * 500
                    LINE (zz1, 27)-(zz1 + 500, 30), red, B
                    LINE (zz1, 27)-(zz2, 30), red, BF
                END IF
                timemachine
            END IF
            'y$ = STR$(INT(VAL(dis$) * 3.262 * h) / h) '              convert to light years
            'y$ = LTRIM$(RIGHT$(SPACE$(6) + y$, 6))
 
            sa = (LEFT$(n$, 1) = "*") '                               show always (low mag)
            tt! = th! '                                               temp threshold
            IF ABS(d!) > 70 THEN tt! = tt! + 2
            IF ABS(d!) > 80 THEN tt! = tt! + 2
            abd = ABS(d!): tt! = tt! - (abd > 70) - (abd > 80)
            IF sa OR (m! <= tt!) THEN '                               show always or bright
                FOR z1 = 0 TO 1 '                                     why why why?
                    FOR z2 = 0 TO 1
                        tr! = r! + z1 * 24
                        td! = d! + z2 * 180
                        IF (tr! > rmin) AND (tr! < rmax!) AND (td! > dmin) AND (td! < dmax!) THEN sr = z1: sd = z2
                    NEXT z2
                NEXT z1
                tx = q3 - (r! - rmin + sr * 24) / nh * q3
                ty = q4 - (d! - dmin + sd * 180) / nd * q4
                IF (tx > 0) AND (tx < q3) AND (ty > 0) AND (ty < q4) THEN
                    IF m! <= 3 THEN tx = -tx
                    IF m! <= 2 THEN ty = -ty
                    nstars = nstars + 1
                    starx(nstars) = tx
                    stary(nstars) = ty
                    IF sa THEN n$ = RIGHT$(n$, LEN(n$) - 1) '         show always, remove asterisk
                    IF LEN(n$) AND (sa OR (m! < 2)) AND (named < namemax) THEN
                        named = named + 1
                        starn(named) = nstars
                        star$(0, named) = n$
                        IF n$ = "Antares" THEN isred1 = nstars
                        IF n$ = "Mira" THEN isred2 = nstars
                        star$(1, named) = LTRIM$(STR$(m!)) + " " + dis$ ' + "P " + y$ + "L"
                        star$(2, named) = LTRIM$(STR$(r!)) + " " + LTRIM$(STR$(d!))
                    END IF
                END IF
            END IF
        LOOP UNTIL EOF(tf) OR (nstars = starmax)
        CLOSE #tf
    END IF
 
    IF isstari = 0 THEN GOSUB writestar
    plot:
    CLS
    tss = starstatus
    IF auto AND (gstyle = 0) THEN tss = 4
 
    IF tss > 2 THEN '                                                 optional grids
        FOR i = 0 TO nh '                                             vertical lines
            tx = (i / nh * q3) MOD (q3 + 1)
            LINE (tx, 0)-(tx, q4), gc, , &H1111
            z = rmax! - i: z = z + (z > 23) * 24 '                    optional labeling
            TinyFont STR$(z), tx - 2, 0, -gc
        NEXT i
        z! = nd / t
        FOR de! = 0 TO z! '                                           horizontal lines
            ty = q4 - ((de! / z! * q4) MOD (q4 + 1))
            LINE (gs, ty)-(q3, ty), gc, , &H1111
            z = dmin + de! * t '                                      optional lableling
            z = z + ((z > 90) - (z < -90)) * 180
            z$ = STR$(z)
            TinyFont z$, q3 - LEN(z$) * 4 - 2, ty + 2, -gc
        NEXT de!
    END IF
 
    FOR star = 1 TO nstars
        stx = starx(star): ax = ABS(stx)
        sty = stary(star): ay = ABS(sty)
        IF warp! THEN
            tx = ax + SGN(-vx!) * warp! * 2
            IF ay < glmax THEN LINE (ax, ay)-(tx, ay), gray2
            IF tx < 1 THEN tx = tx + (q3 + 1)
            IF tx > q3 THEN tx = tx - (q3 + 1)
            starx(star) = tx * SGN(stx + .01)
        ELSE
            m = 3 + (stx < 0) + (sty < 0) '                           magnitude
            IF m < 3 THEN tc = white2 ELSE tc = gray2 '               slightly different brightness
            IF twinkle AND (RND > .9) AND (tc = white2) THEN tc = gray2
            IF star = isred1 THEN tc = red '                          Mira and Antares
            IF star = isred2 THEN tc = red
            IF m = 1 THEN '                                           small cross if < 2
                LINE (ax - 1, ay)-(ax + 1, ay), tc
                LINE (ax, ay - 1)-(ax, ay + 1), tc
            ELSE '                                                    bright or dim point
                PSET (ax, ay), tc
            END IF
            ' IF (star MOD 37) = 0 THEN TinyFont STR$(star), ax, ay, sc ' diagnostic
            FOR i = 1 TO named '                                      show names & info
                IF star = starn(i) THEN
                    FOR j = 0 TO tss - 2
                        IF j THEN
                            ty = ay + j * 9 + (j = 2) * 3 + 1
                            TinyFont star$(j, i), ax, ty, sc
                        ELSE
                            PrintCGA star$(j, i), ax, ay + j * 9, sc, -1, 1
                        END IF
                    NEXT j
                END IF
            NEXT i
        END IF
    NEXT star
    IF rick THEN '                                                    show counts
        z$ = LTRIM$(STR$(starfiles)) + STR$(nstars) + STR$(starmax) + STR$(named) + STR$(th!)
        TinyFont z$, 86, 20, red
    END IF
    EXIT SUB
 
    readstar:
    tf = FREEFILE
    OPEN tf1$ FOR INPUT AS #tf
    INPUT #tf, nstars, named, isred1, isred2
    n1 = nstars
    FOR i = 1 TO named
        INPUT #tf, starn(i)
        FOR j = 0 TO 2
            INPUT #tf, star$(j, i)
        NEXT j
    NEXT i
    CLOSE #tf
    OPEN tf2$ FOR BINARY AS #tf
    GET #tf, , starx()
    CLOSE #tf
    OPEN tf3$ FOR BINARY AS #tf
    GET #tf, , stary()
    CLOSE #tf
    RETURN
    ' -----------------------------------------------------------------------------------
    writestar:
    tf = FREEFILE
    OPEN tf1$ FOR OUTPUT AS #tf
    PRINT #tf, nstars; ","; named; ","; isred1; ","; isred2
    FOR i = 1 TO named
        PRINT #tf, starn(i);
        FOR j = 0 TO 2
            PRINT #tf, ","; star$(j, i);
        NEXT j
        PRINT #tf, CHR$(13);
    NEXT i
    CLOSE #tf
 
    OPEN tf2$ FOR BINARY AS #tf
    PUT #tf, , starx()
    CLOSE #tf
 
    OPEN tf3$ FOR BINARY AS #tf
    PUT #tf, , stary()
    CLOSE #tf
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Borg (lbx, bmy) STATIC
    IF borginit = 0 THEN
        z$ = SPACE$(t) + "WE ARE THE BORG - RESISTANCE IS FUTILE" + SPACE$(50)
        moire = 0: moired = 1: xn = 19: yn = 8: zz = 13: p0 = &HAAAA
        DIM mat$(yn)
        FOR i = 1 TO yn
            mat$(i) = STRING$(xn, ASC("0"))
        NEXT i
        borginit = 1 '                                                      direction for guts
    END IF
    p1 = &H5555: p2 = &HAAAA
 
    'lbx = localize(bmx, 58, 46)
    'IF lbx = 999 THEN
    '   IF (demo = 1) THEN ex(1) = 3170 ELSE EXIT SUB ' keep around in demo mode
    'END IF
 
    borgt = bmy - 40 '                                                top
    borgl = lbx - 40 '                                                left side
    borgr = lbx + 52 '                                                right side
 
    x1 = lbx - 46: y1 = bmy - 34: x2 = lbx + 46: y2 = bmy + 34
 
    FOR i = 0 TO zz
        tx1 = x1 + i: tx2 = x2 + i: ty1 = y1 - i: ty2 = y2 - i
        IF (tx1 + 2) < gs THEN SWAP p1, p2
        LINE (tx1, ty1)-(tx1, ty2), black2 '                          left
        LINE (tx1, ty1)-(tx1, ty2), dred, , p0
        LINE (tx1 + 2, ty2)-(tx2, ty2), black2 '                      bottom
        LINE (tx1 + 2, ty2)-(tx2, ty2), dred, , p1
    NEXT i
    FOR i = 0 TO zz
        tx2 = x2 + i: ty1 = y1 - i + 2: ty2 = y2 - i
        LINE (tx2, ty1)-(tx2, ty2), red '                             right
        tx1 = x1 + i: tx2 = x2 + i: ty1 = y1 - i
        LINE (tx1, ty1)-(tx2, ty1), red '                             top
    NEXT i
    LINE (x2 + 1, y1)-(x2 + zz, y1 - zz + 1), black2 '                top right diag
    LINE (x1 + 1, y2)-(x1 + zz, y2 - zz + 1), black2 '                bottom left diag
 
    x1 = x1 + 8: y1 = y1 + 1: y2 = y2 - 8 '                           inside of craft
 
    LINE (x1 + 4, y1)-(x2 - 1, y2 - 4), black2, BF '                  blank interior
    SELECT CASE bstyle1
        CASE IS = 0 '                                                 ala Matrix
            '                                                         84 60
            FOR y = 0 TO yn - 1
                mat$(y) = mat$(y + 1)
            NEXT y
            FOR x = 1 TO xn
                MID$(mat$(yn), x, 1) = CHR$(48 + RND)
            NEXT x
            FOR y = 0 TO yn
                ty = y1 + y * 6
                TinyFont mat$(y), x1 + 5, ty + 1, blue
            NEXT y
        CASE IS = 1 '                                                 Moire
            moire = moire + moired
            IF ABS(moire) > t THEN moired = -moired
            FOR ty = y1 TO y2
                FOR tx = x1 TO x2 - 1
                    z1! = tx / (moire + 40): z1! = z1! * z1!
                    z2! = ty / (moire + 40): z2! = z2! * z1!
                    IF ((z1! + z2!) MOD 4) THEN
                        IF ((z1! + z2!) MOD 2) THEN tc = blue ELSE tc = dred
                        PSET (tx, ty), tc
                    END IF
                NEXT tx
            NEXT ty
        CASE IS = 2 '                                                 boxes
            x2 = x2 - 3: xs = x2 - x1: ys = y2 - y1
            FOR z = 1 TO h
                bx1 = x1 + RND * xs + 2
                by1 = y1 + RND * ys + 2
                bx2 = bx1 + (RND - pf!) * xs / z * t + 2
                by2 = by1 + (RND - pf!) * ys / z * t + 2
                IF bx2 < x1 THEN bx2 = x1
                IF bx2 > x2 THEN bx2 = x2
                IF by2 < y1 THEN by2 = y1
                IF by2 > y2 THEN by2 = y2
                c = 1 + SGN(z MOD 2) * 12
                IF RND > .95 THEN c = gunmetal
                LINE (bx1, by1)-(bx2, by2), c, B
            NEXT z
    END SELECT
 
    IF bstyle2 = 777 THEN
        'FOR i = borgl + 5 TO borgr - t STEP 5 '                       ion drive
        '    IF RND > .6 THEN
        '        PSET (i, bmy + 27), white
        '        FOR j = 0 TO 30
        '            IF RND * h < j THEN
        '                ty = y2 - j + 39
        '                LINE (i, ty)-STEP(1, 0), blue
        '            END IF
        '        NEXT j
        '    END IF
        'NEXT i
    ELSE
        FOR k = -30 TO 30 STEP 15 '                                   exhaust, 5 flames
            ' CIRCLE (lbx + k, bmy + 27), 2, blue, , , .75
            ' PAINT (lbx + k, bmy + 27), blue, blue
            bit = bit XOR 1 '                                         alternate
            FOR i = 0 TO 20
                ba1 = (ba1 + i) MOD tsix
                zzz = ((20 - i) / 4) * SIN(_D2R(ba1))
                ty0 = y2 + i + 8 + bit + 1
                tx1 = lbx - zzz + k
                tx2 = lbx + zzz + k
                LINE (tx1, ty0)-(tx2, ty0), blue, , RND * &H7FFF
            NEXT i
        NEXT k
    END IF
 
    '                                                                 scroll Borg message along top and right side of craft
    ti = (ti MOD (50 * 16)) + 8 '                                     index into text, speed 1-??
    tx1 = lbx - 46 - 3
    ty1 = bmy - 31
 
    PrintLines z$, ti, ti + 90, tx1, ty1 - 1, black2, -88, 2, 2 '     top
    PrintLines z$, ti, ti + 90, tx1, ty1 - 0, white2, -88, 2, 2
 
    tx1 = lbx + 46 - 2: ty1 = bmy - 32 '                              right
    PrintLines z$, ti + 91, ti + 91 + 67, tx1, ty1, black2, -99, 2, 2
 
    'IF RND > .8 THEN '                                                side thrusters
    '    IF RND > pf! THEN
    '        tx1 = lbx - 48: txi = -1: ty1 = bmy
    '    ELSE
    '        tx1 = lbx + 60: txi = 1: ty1 = bmy - 12
    '    END IF
    '    FOR i = 34 TO 0 STEP -1
    '        z = i * SIN(_d2r((i + 90) * 2))
    '        LINE (tx1, ty1 - z)-(tx1, ty1 + z), blue
    '        tx1 = tx1 + txi * 2
    '    NEXT i
    'END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Volcano STATIC
 
    IF vinit = 0 THEN
        q = q3 * 2 '                                                  640*2=1280
        DIM vox!(q), voy!(q), vxi!(q), vyi!(q)
        vinit = 1
    END IF
 
    vx = sf(4, 2)
    IF ABS((TIMER MOD t) - (RND * t)) > 5 THEN
        FOR i = 0 TO q
            IF vyi!(i) < -3 THEN k! = .6 ELSE k! = .8 '               kill some
            IF (vox!(i) = 0) OR (RND > k!) THEN '                     dead or kill
                vox!(i) = vx + RND * t - 5 '                          initial x
                voy!(i) = gety(INT(vox!(i) - suri)) - 1 '             initial y
                ta = RND * 40 + 70 '                                  angle
                r! = _D2R(ta)
                vxi!(i) = (RND * t + 1) * COS(r!) '                   x velocity
                vyi!(i) = (RND * t + 2) * SIN(r!) '                   y velocity
            END IF
        NEXT i
    END IF
 
    FOR i = 0 TO q
        tx = vox!(i) - suri '                                         local x
        ty = voy!(i) '                                                local y
        IF shield THEN z = 0: GOSUB protect
        IF ty > q4 THEN '                                             off screen
            vox!(i) = 0 '                                             flag for init
        ELSE
            IF (tx >= gs) AND (tx <= q3) THEN
                IF vyi!(i) < -(RND * 4) THEN
                    c = gunmetal
                    IF (ty > gety(tx)) AND (gstyle = 0) THEN c = black ' black on white
                ELSE
                    c = orange
                END IF
                PSET (tx, ty), c
                IF i MOD 2 THEN LINE -STEP(RND * 2 - 1, RND * 2 - 1), c
            END IF
        END IF
        vyi!(i) = vyi!(i) - .25 '                                     decelerate
        vox!(i) = vox!(i) - vxi!(i) '                                 new x
        voy!(i) = voy!(i) - vyi!(i) '                                 new y
    NEXT i
    EXIT SUB
 
    protect:
    dx! = px! - tx '                                                  distance x
    dy! = (py! - ty) * aspect! '                                      distance y
    dd = SQR(dx! * dx! + dy! * dy!) '                                 distance
    IF dd < 70 THEN '                                                 at shield
        z = 1
        vyi!(i) = 0
        ty = ty - SGN(dy!)
        GOTO protect
    END IF
    IF z THEN '                                                       laser
        vxi!(i) = SGN(dx!) * (5 + RND * 5)
        LINE (sx0 + xoff, sy0 + vy!)-(tx, ty), lmsl
    END IF
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Mandel '                                                          appears in TMA-1 when landed on
    xd! = .044
    yd! = .036
    zz! = TIMER * 4
    LINE (x, glmax - 1)-(x + 45, glmax - 71), black2, BF
    FOR xx = 0 TO 23
        FOR yy = 0 TO 70
            MandelX! = -2 + yy * yd!
            MandelY! = -1 + xx * xd!
            Real# = 0
            Imag# = 0
            Itera = 20
            DO
                Itera = Itera - 1
                hold# = Imag#
                Imag# = (Real# * Imag#) * 2 + MandelY!
                Real# = Real# * Real# - hold# * hold# + MandelX!
                Size# = (Real# * Real# + Imag# * Imag#) - 4
            LOOP UNTIL (Itera = 0) OR (Size# > 0)
            IF Size# > 0 THEN
                tc = (Itera + zz!) MOD 15 + 1
                ty = glmax - 71 + yy
                PSET (x + xx, ty), tc '                               left half
                PSET (x + 45 - xx, ty), tc '                          right half
            END IF
        NEXT yy
    NEXT xx
 
    'RESTORE 2010
    'FOR i = 1 TO 7
    '    READ z$
    '    tx = center - LEN(z$) * 4
    '    PrintVGA z$, tx, 50 + i * 13, white, 0
    'NEXT i
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB CarWash
    DIM cwpat&(7)
    cwpat&(0) = &HFFFF
    cwpat&(1) = &H1111
    cwpat&(2) = &H2222
    cwpat&(3) = &H4444
    cwpat&(4) = &H8888
    cwpat&(5) = cwpat&(3)
    cwpat&(6) = cwpat&(2)
    cwpat&(7) = cwpat&(1)
 
    x1 = x + 1
    x2 = x1 + 99
    y0 = 305
    IF bolthitf THEN tc = white ELSE tc = gunmetal
    LINE (x, y0 - 19)-(x2, y0 - 1), tc, BF '                          sign background
    PrintCGA "MONTEZUMA", x + 14, 286, orange, black2, 0
 
    IF bbit THEN
        c1 = green
        c2 = blue
        c3 = green
    ELSE
        c1 = black2
        c2 = -1
        c3 = gunmetal
    END IF
    PrintCGA "Car Wash", x + 17, 294, c1, c2, 0
    LINE (x, y0 - 19)-(x2, y0 - 1), c3, B
 
    IF bolthitf THEN tc = white ELSE tc = blue2
    LINE (x, y0)-(x2, q4), tc, BF '                                   spray zone
    LINE (x1, y0)-(x1, q4), white, , cwpat&(1) '                      left side &H1111
    LINE (x2, y0)-(x2, q4), white, , cwpat&(1) '                      right side
 
    IF cwsi = 0 THEN cwsi = 1 '                                       spray angle increment
    cwsd = cwsd + cwsi '                                              spray direction
    IF (cwsd = 0) OR (cwsd = t) THEN cwsi = -cwsi '                   hit limits, reverse
    FOR z = 1 TO 5
        x1 = x + z * t + 24
        FOR i = -4 TO 4 STEP 2
            td = cwsd - 5 + i
            IF z MOD 2 = 0 THEN
                td = -td
                up = 0 '                                              use pattern
            ELSE
                iz = (iz + 1) MOD th
                up = iz MOD 7 + 1
            END IF
            ra = (90 + td * 3) MOD tsix
            tx = 64 * c!(ra) * 1.1
            ty = y0 + 64 * s!(ra)
            LINE (x1, y0)-(x1 + tx, ty), gunmetal, , cwpat&(up) '     along top
            LINE (x + 0, y0)-(x1 + tx \ 2, ty), gunmetal, , cwpat&(up) ' tl
            LINE (x + h, y0)-(x1 + tx \ 2, ty), gunmetal, , cwpat&(up) ' tr
            tx = x1 + 20 * c!(ra) * 1.2
            ty = q4 - 20 * s!(ra) \ 2
            LINE (x1, q4)-(tx, ty), white '                           bottom
        NEXT i
        iz = iz + 1
    NEXT z
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB DeathStar (dtx, tf$) STATIC
    IF dsinit = 0 THEN
        DIM tc(1)
        xc = 320: yc = 175: dty = 170
        IF INSTR(tf$, "rs") THEN
            xs = 100: ys = 73: bs = ys + 6: rs = 4020 '               small
        ELSE
            xs = 130: ys = 110: bs = ys - t: rs = 8000 '              large
        END IF
        wx1 = xc - xs: wx2 = xc + xs
        wy1 = yc - ys: wy2 = yc + ys
        CLOSE #8
        REDIM buff&(rs)
        OPEN tf$ FOR BINARY AS #8
        dsinit = 1
    END IF
 
    IF darkstarc = 0 THEN c1 = black2: c2 = blue: c3 = blue2
    IF darkstarc = 1 THEN c1 = gunmetal: c2 = red: c3 = dred
    tc(0) = c2: tc(1) = c3
 
    CIRCLE (dtx, dty + 6), xs, black2 '                               define area
    FOR z = -1 TO 1 STEP 2 '                                          circle may be barely on screen
        PAINT (dtx + z * (xs - 1), dty), c1, black2 '                 far left & far right
    NEXT z
 
    xx = dtx - xc
    yy = dty - yc
    zz = (zz + darkstars) MOD 49 '                                   0-48 images
    rn& = zz * rs * 4 + 1
    GET #8, rn&, buff&()
    n = -1
    FOR i = wx1 TO wx2
        tx = xx + i
        IF tx > q3 THEN GOTO bork
        FOR j = wy1 TO wy2 STEP 15
            FOR k = 0 TO 1
                n = n + 1
                IF (buff&(n) > 0) AND (tx >= gs) THEN
                    LINE (tx, j)-(tx, j + 15), tc(k), , buff&(n)
                    IF darkstart THEN LINE (tx, j + 1)-(tx, j + 16), tc(k), , buff&(n)
                END IF
            NEXT k
        NEXT j
    NEXT i
    bork:
    GOSUB Title
 
    boltx = q1 '                                                      handy large value
 
    IF RND > .7 THEN '                                                lightning bolt
        a! = 90 + (RND * 20) - t '                                    starting angle
        r! = bs '                                                     starting radius
        bolty = q1 '                                                  handy large value
        FOR i = -h TO h '                                             -100 to 100
            tx = dtx + i
            ty = gety(tx)
            IF ty <= bolty THEN
                IF (bolty = q1) OR (RND > .8) THEN boltx = tx
                bolty = ty
            END IF
        NEXT i
        DO
            xx = dtx + r! * COS(_D2R(a!)) * aspect!
            yy = dty + r! * SIN(_D2R(a!))
            IF yy > q4 THEN EXIT DO '                                 q4 = 349
            a! = a! + RND * 2 - 1 + SGN(xx - boltx) * .05
            r! = r! + RND * 2.18 - 1
            IF r! < bs THEN r! = bs
            GOSUB dot
        LOOP
    END IF
 
    nc = RND * 3 '                                                    "internal" lightning
    FOR s = 0 TO nc
        DO
            a! = RND * tsix
        LOOP UNTIL ABS(a! - 90) > 20
        td = bs \ 2 + RND * bs \ 2
        IF RND > .8 THEN td = RND * bs
        r! = td
        qq = 6
        DO
            xx = dtx + r! * COS(_D2R(a!)) * aspect!
            yy = dty + r! * SIN(_D2R(a!))
            GOSUB dot
            a! = a! + RND * 2.15 - 1
            r! = r! - RND * 2.18 + qq
            qq = qq - 1 - (qq = 1)
        LOOP UNTIL r! < td
    NEXT s
    EXIT SUB
 
    dot:
    dx! = px! - xx
    dy! = py! - yy
    dd! = SQR(dx! * dx! + dy! * dy!)
    tcc = 1 - (RND > pf!) * 14
    IF (shield = 0) AND (dd! < 15) THEN bolthit = 1
    IF shield AND (dd! <= 70) THEN
        tcc = green
        IF RND > .95 THEN LINE (sx0 + xoff, sy0 + vy!)-(xx, yy), red
    END IF
    PSET (xx, yy), tcc
    RETURN
 
    Title:
    IF atu = 0 THEN atu = t: ati = 1
    atu = atu + ati
    IF (atu = t) OR (atu = 25) THEN ati = -ati
    t$ = "EPCOR"
    FOR i = 1 TO LEN(t$)
        z$ = MID$(t$, i, 1)
        aa = -90 + (i - 3) * atu
        tx = dtx + bs * COS(_D2R(aa)) * aspect! - 5
        ty = dty + bs * SIN(_D2R(aa))
        PrintVGA z$, tx, ty, c3, white
    NEXT i
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Parachute STATIC
    IF contact THEN
        cy! = cy! + 5
        IF cy! > 500 THEN cy! = 500: chs = 1: paraf = 0
        chs = chs - 1
    ELSE
        cy! = py! - h
        IF (py! > 120) AND (chs < 40) THEN chs = chs + 2
    END IF
    FOR ta = 0 TO tsix
        r! = _D2R(ta) / 2
        tx = px! + chs * COS(r!) * 2
        ty = cy! - chs * SIN(r!)
        PSET (tx, ty), gray2
        IF (ta / 20) MOD 2 THEN tc = red ELSE tc = white2
        LINE -(tx, cy!), tc
        IF (ta MOD 40) = 0 THEN LINE -(px! - ASO, cy! + 82 + ASO * t), gray2
    NEXT ta
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Comet (comx, comy)
    IF crash THEN tc = white ELSE tc = green
    FOR i = 0 TO 1
        CIRCLE (comx, comy), i + 1, tc, , , .78
        c$ = MID$("HalleBerry", i * 5 + 1, 5)
        tx = comx + t
        ty = comy + i * 8
        IF (tx > gs) AND (tx < 590) AND (ty > 0) AND (ty < 330) THEN PrintCGA c$, tx, ty, white2, gunmetal, 0
    NEXT i
    FOR ta = -t TO t STEP 5 '                                         tail, -10 to 10
        zz = 50 + RND * tw '                                          vary tail length
        r! = _D2R(140 + ta * 4)
        x1 = comx + 3 * COS(r!) '                                     tail start
        y1 = comy + 3 * SIN(r!)
        r! = _D2R(140 + ta \ 2)
        x2 = comx + zz * COS(r!) '                                    tail end
        y2 = comy + zz * SIN(r!)
        LINE (x1, y1)-(x2, y2), white2, , RND * &H7FFF
    NEXT ta
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB CybillPix (pfile$) STATIC
    IF cpinit = 0 THEN
        z = 1225
        DIM cbuff(z)
        s& = VARSEG(cbuff(0))
        o& = VARPTR(cbuff(0))
        DEF SEG = s&
        BLOAD pfile$, o&
        cpinit = 1
    END IF
    IF ((x + 5) >= gs) AND (x < 600) THEN PUT (x + 5, 289), cbuff(), PSET
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Quit
    SCREEN 0, 0, 0, 0
    CLS
    CLOSE
    IF iscd THEN SYSTEM
 
    OPEN settings$ FOR OUTPUT AS #1
    z = auto: d$ = "auto": GOSUB pconfig '                            1 full autopilot
    z = background: d$ = "panel": GOSUB pconfig '                     2 instrument panel
    z = cbh: d$ = "cbh": GOSUB pconfig '                              3 constant black holes
    z = demo: d$ = "skyf": GOSUB pconfig '                            4 0 off 1 all features
    z = doclock: d$ = "clock": GOSUB pconfig '                        5 clock display on DS
    z = invincible: d$ = "invincible": GOSUB pconfig '                6 invincible
    z = jitter: d$ = "thrust": GOSUB pconfig '                        7 thrust calculation
    z = LEDc: d$ = "ledc": GOSUB pconfig '                            8 LED color
    z = LEDtri: d$ = "ledtri": GOSUB pconfig '                        9 LED tri-color
    z = radarf: d$ = "radar": GOSUB pconfig '                         10 radar visible
    z = shield: d$ = "shield": GOSUB pconfig '                        11 Star Trek!
    z = showmap: d$ = "map": GOSUB pconfig '                          12 feature locations at screen top
    z = starstatus: d$ = "stari": GOSUB pconfig '                     13 0off 1names 2info 3info 4grid
    z = zoom: d$ = "starz": GOSUB pconfig '                           14 starfield
    z = skyoff: d$ = "skys": GOSUB pconfig '                          15 sky objects
    z = gstyle: d$ = "gstyle": GOSUB pconfig '                        16 ground type
    z = mouseswap: d$ = "mouse": GOSUB pconfig '                      17 mouse buttons
    z = porb: d$ = "porb": GOSUB pconfig '                            18 pointers or bars for instruments
    z = starfiles: d$ = "stars": GOSUB pconfig '                      19 star quantity
    z = mdelay: d$ = "speed": GOSUB pconfig '                         20 system speed
    z = SGN(_FULLSCREEN): d$ = "fullscreen": GOSUB pconfig '          21 fullscreen
 
    CLOSE
    SYSTEM
 
    pconfig:
    PRINT #1, d$; ","; z
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Henonp (f) STATIC
 
    IF henoni = 0 THEN
        z = 20000
        DIM tb(z)
        henoni = 1
    END IF
 
    s& = VARSEG(tb(0)) '                                              for BLOADING images
    o& = VARPTR(tb(0))
    DEF SEG = s&
 
    IF crash THEN GOTO nosp
    wts = (wts + 1) MOD 3 '                                           what to show
    FOR pass = 1 TO 2
        FOR i = 0 TO 2
            IF ((i = wts) OR (pass = 2)) AND (TIMER < rtl!(i)) THEN
                SELECT CASE i
                    CASE IS = 0 '                                     radiation
                        BLOAD f$(19), o& '                            rad.dat
                        PUT (0, 0), tb(0), PSET
                        gotblank = 0
                    CASE IS = 1 '                                     thermometer
                        GOSUB loadblank
                        LINE (20, 28)-(26, 56), 0, BF '               shadow
                        LINE (20, 26)-(24, 56), 0, BF '               erase old
                        LINE (20, 26)-(24, 56), red, B '              outline
                        CIRCLE (23, 60), 5, 0 '                       bulb shadow
                        CIRCLE (24, 60), 5, 0 '                       bulb shadow
                        CIRCLE (22, 59), 5, red '                     bulb
                        PAINT (22, 59), red, red '                    bulb fill
                        ty = 56 - rtlc(1) / 100 * 30 '                reading
                        LINE (20, ty)-(24, 56), red, BF
                    CASE IS = 2 '                                     lightning
                        GOSUB loadblank
                        uc = uc XOR 1
                        IF uc THEN tc = yellow ELSE tc = gold
                        PSET (17, 27)
                        LINE -(33, 27), tc
                        LINE -(24, 43), tc
                        LINE -(29, 43), tc
                        LINE -(16, 63), tc
                        LINE -(21, 47), tc
                        LINE -(13, 47), tc
                        LINE -(17, 27), tc
                        PAINT (22, 47), tc, tc
                END SELECT
                z = rtlc(i) '                                         0rads 1temperature 2bolts
                lf = -1
                PrepAndShowLED CSNG(z), 4, 10
                EXIT SUB
            END IF
        NEXT i
    NEXT pass
 
    nosp: '                                                           no special = Henon plots
    IF f <> lf THEN
        tf$ = f$(f)
        BLOAD tf$, o&
        gotblank = 0
        lf = f
    END IF
    hc = (hc + 1) MOD 13 '                                            h1-h5 contain 13 images each
    IF crash THEN hc = 0 '                                            h6.dat only has one page
    PUT (0, 0), tb(hc * 1500), PSET '                                 includes
    PrepAndShowLED 0, 4, 0
    EXIT SUB
 
    loadblank: '                                                      not really blank - has program name
    IF gotblank = 0 THEN '                                               and clock/McD/speed/count box
        BLOAD f$(39), o& '                                            is lanblank.dat
        gotblank = 1
    END IF
    PUT (0, 0), tb(0), PSET
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Grave (x, fb$) STATIC
    tx1 = x: IF tx1 < gs THEN tx1 = gs
    tx2 = x + 68: IF tx2 > q3 THEN tx2 = q3
    IF tx1 >= tx2 THEN EXIT SUB
    VIEW SCREEN(tx1, 300)-(tx2, q4)
    IF bolthitf THEN
        tc = white: tc2 = white
    ELSE
        tc = gray: tc2 = gasoline
    END IF
    LINE (x, 300)-(x + 68, q4), tc, BF
    LINE (x + 2, 302)-(x + 66, 347), black2, B
    FOR x1 = 0 TO 1
        FOR y1 = 0 TO 1
            x2 = x + x1 * 68 - 4
            y2 = 300 + y1 * 42 - 1
            LINE (x2, y2)-(x2 + 9, y2 + 9), tc2, BF
            LINE (x2, y2)-(x2 + 9, y2 + 9), black2, B
        NEXT y1
    NEXT x1
 
    FOR z = 0 TO 1
        LINE (x + z, 300 + z)-(x + 68 - z, q4 - z), tc2, B
    NEXT z
 
    IF INSTR(fb$, "g on a ") = 0 THEN
        z$ = "  JFK      R.I.P. 1917 1963"
    ELSE
        IF (TIMER MOD 10) < 5 THEN
            z$ = "B FROST    R.I.P. 1952 2006"
        ELSE
            z$ = "R FROST    R.I.P. 1957 2019"
        END IF
    END IF
 
    PrintVGA LEFT$(z$, 7), x + 5, 317, black2, white2
 
    FOR i = 0 TO 1
        d$ = MID$(z$, i * 9 + 10, 9)
        c1 = black2: c2 = gasoline
        FOR j = 1 TO 9
            c$ = MID$(d$, j, 1)
            ta = (ta + 23) MOD tsix
            zz = (3 + 3 * SIN(ta * ATN(1) / 45)) * i
            tx = x + (j - 2) * 6 + 12
            ty = 304 + i * 24 + zz
            PrintCGA c$, tx, ty, c1, c2, 0
        NEXT j
    NEXT i
    VIEW SCREEN(gs, 0)-(q3, q4)
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB FlagandFireworks STATIC
    IF fmax = 0 THEN
        fs = 60: fq = 600: fmax = fs
        DIM flagb(fq)
        DIM ve!(fs), ho!(fs), pe(fs), x!(fs), y!(fs), c(fs)
    END IF
 
    IF flx = 0 THEN '                                                 initialize
        z = SGN(sf(sf, 2) - (px! + suri)) '                           to plant flag opposite feature
        IF z = 0 THEN z = -1 '                                        optional, prevent middle
        FOR i = -1 TO 1 STEP 2 '                                      check sides
            tx = px! + i * z * 22
            ty = gety(-tx)
            '                                                         prevent PUT beyond 580 for grave in demo mode
            IF (tx < 580) AND (ABS(ty - sy1) < t) THEN
                flx = tx
                fly = ty
                rev = 0
                IF nation = 1 THEN nation = 2 ELSE nation = 1
                initfw = 0
                EXIT SUB
            END IF
        NEXT i
        EXIT SUB
    END IF
 
    IF liftoff THEN GOTO pflag
 
    IF initfw = 0 THEN '                                              fireworks launch & init
        ve! = RND * 5 + 16 - lob * 8 '                                vertical velocity
        ho! = RND * 5 + 2 '                                           horizontal velocity
        x!(0) = px! '                                                 initial x, middle of craft
        y!(0) = py! - 15 + ASO * 7 '                                  initial y, top of craft
        ea = -(RND * t) '                                             explode at 0-10
        IF lho! > 0 THEN ho! = -ho! '                                 reverse direction half the time
        lho! = ho!
        DO '                                                          launch
            x!(0) = x!(0) + ho! / t '                                 t = 10
            y!(0) = y!(0) - ve! / t
            ve! = ve! - .1 '                                          slow down
            PSET (x!(0), y!(0)), yellow '                             launch track
        LOOP UNTIL ve! < ea '                                         explode
        FOR i = 1 TO fmax
            z = nation - 1
            z = z * 6 + (i MOD (3 - z)) * 2 + 1 '                     color index
            '                rewhblreye
            c(i) = VAL(MID$("0415010414", z, 2)) '                    color
            z! = RND * 5 + 1 '                                        velocity
            ta = (i * 6) MOD tsix '                                    angle
            ve!(i) = z! * c!(ta) '                                    vertical velocity
            ho!(i) = z! * s!(ta) * 1.8 '                              horizontal velocity
            x!(i) = x!(0) + ho!(i) * 2 + xe! '                        start of arm
            y!(i) = y!(0) + ve!(i) * 2 + ye!
            pe(i) = RND * 5 + t '                                     persistance of arm
        NEXT i
        initfw = 1 '                                                  mark initialized
    END IF
 
    f = 1 '                                                           assume done
    FOR q = 0 TO 1 '                                                  show shell exploding
        FOR i = 1 TO fmax '                                           arms
            IF pe(i) THEN '                                           persistance of arm
                f = 0 '                                               not done
                pe(i) = pe(i) - 1 '                                   persistance
                x!(i) = x!(i) + ho!(i)
                y!(i) = y!(i) + ve!(i)
                ve!(i) = ve!(i) + .4 '                                gravity modifies vertical
                IF RND > .1 THEN
                    LINE (x!(i), y!(i))-(x!(i) + RND, y!(i) + RND), c(i), B
                END IF
            END IF
        NEXT i
    NEXT q
    IF f THEN initfw = 0 '                                            end of this one, start another
 
    pflag:
    IF sn <> nation THEN '                                            new, or user changed it
        sn = nation '                                                 save current nation
        s& = VARSEG(flagb(0)) '                                       segment
        o& = VARPTR(flagb(0)) '                                       offset
        DEF SEG = s& '                                                set segment
        BLOAD f$(19 + nation), o& '                                   load array 20=USA 21=USSR
        sx = 0
        rev = 0
    END IF
 
    REDIM f2(600) '                                                   FLAG
    ty = fly - 80
    LINE (flx - 1, fly)-(flx - 1, ty), white '                        pole
    zx = flx - rev * 71
    GET (zx, ty)-(zx + 70, ty + 32), f2() '                           was flx
    PUT (zx, ty), flagb(), PSET '                                     flag
 
    '                                                                 optional move flag to left of pole
    IF (flx < px!) AND (rev = 0) AND (liftoff = 0) THEN
        FOR rx = 0 TO 69
            FOR ry = 0 TO 32
                p = POINT(flx + rx, ty + ry)
                PSET (flx - rx - 2, ty + ry), p
            NEXT ry
        NEXT rx
        PUT (flx, ty), f2(), PSET '                                   restore original area
        GET (flx - 71, ty)-(flx - 2, ty + 32), flagb() '              get new
        rev = 1
        zx = flx - 71
    END IF
    REDIM f2(0)
 
    sx = sx + t '                                                     optional unfurl flag
    IF sx > 70 THEN sx = 70
    IF sx < 70 THEN
        IF rev THEN
            LINE (zx, ty)-(zx + 71 - sx, ty + 32), 0, BF
        ELSE
            LINE (zx + sx, ty)-(zx + 71, ty + 32), 0, BF
        END IF
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB MakeSur
    IF iscd THEN EXIT SUB
    DIM z!(t), a1(t), v1(t), lz(t)
    msflag = 1
    VIEW
    CLS
    FOR gh = -2 TO 9 '                                                -2 demo, -1 flat, 0-9 rocks
        z$ = "Creating surfaces" + STR$(gh + 3) + " of 12"
        LINE (s, 0)-(q3, 20), 0, BF
        PrintVGA z$, 320 - LEN(z$) * 4, 2, white, black
        timemachine
 
        IF INKEY$ = CHR$(27) THEN Quit
        f$ = "S" + LTRIM$(STR$(gh))
        IF gh = -2 THEN f$ = "sd"
        IF gh = -1 THEN f$ = "sl"
        f$ = f$ + ".DAT"
        CLOSE #6
        OPEN f$ FOR RANDOM AS #6 LEN = 2
        FOR i = 1 TO q1 '                                             6400, 10 pages
            PUT #6, i, glmax
        NEXT i
        IF gh < 0 THEN GOTO keepflat
        FOR i = 1 TO 4 '                                              make sine waves
            z!(i) = RND * 36 / 550
            a1(i) = RND * tsix
            v1(i) = RND * gh * 2
        NEXT i
        FOR i = 0 TO q1
            z! = 0
            FOR j = 1 TO 4
                y! = v1(j) * SIN((i - a1(j)) * z!(j))
                z! = z! + y! * 4
            NEXT j
            IF (i > 5320) AND (i < 5560) THEN z! = z! / 4 - 40 '      make Hollywood higher
            z = glmax - ABS(z!)
            IF z < glmin THEN z = glmin
            PUT #6, i + 1, z
        NEXT i
        Smooth 5319
        Smooth 5559
        keepflat:
        IF gh = -2 THEN tz = 3130 ELSE tz = 2240
        FOR i = -51 TO 51 '                                           volcano
            z = glmax - (51 - ABS(i))
            PUT #6, tz + i, z
        NEXT i
        Smooth 2240 - 50
        Smooth 2240 + 50
        z = 302
        FOR i = -5 TO 5 '                                             volcano top
            PUT #6, tz + i, z
        NEXT i
        IF gh > -1 THEN '                                             ground height not flat, add rocks/small craters
            FOR i = -1 TO 1 STEP 2 '                                  up or down
                rocks = RND * h + h '                                 rocks & indentations
                FOR j = 1 TO rocks
                    rx = RND * 6380 + t
                    zz = RND * 4 + 1
                    FOR k = -zz TO zz
                        GET #6, rx + k, z
                        z = z - zz * i + ABS(k) * i
                        IF z < glmin THEN z = glmin
                        IF z > glmax THEN z = glmax
                        PUT #6, rx + k, z
                    NEXT k
                NEXT j
            NEXT i
        END IF
        Smooth q1 - 1 '                                               6399 - 0 transition
 
        FOR i = 1 TO t '                                              create landing zones
            IF gh = -2 THEN '                                         compress onto 1 page
                lz(i) = 3050 + (i - 1) * 80
            ELSE
                lz(i) = 320 + (i - 1) * (q3 + 1) '                    1 per page
            END IF
        NEXT i
        IF gh = -2 THEN '                                             demo terrain
            SWAP lz(9), lz(t) '                                       move grave 1 page left
            SWAP lz(2), lz(4) '                                       move car wash 2 pages right
        END IF
        'hs = (RND * 20 + 1) * -(gh <> -2) ' height of Surveyor ground
 
        hs = 0
        RESTORE features
        FOR i = 1 TO t '                                              10 features, create landing zones beside each
            READ z$, x, y, lz
            sf(i, 0) = lz(i) - x \ 2 '                                start
            sf(i, 1) = sf(i, 0) + x '                                 end
            sf(i, 2) = (sf(i, 0) + sf(i, 1)) \ 2 '                    middle
            IF i = 4 THEN GOTO isvolcano
            FOR x2 = -lz TO lz
                z = hs * (y = 0) * (i <> 5)
                IF i = 3 THEN z = 40 '                                LGM
                IF i = 4 THEN z = 50 - ABS(x2) / 2
                IF gh <> -2 THEN
                    z = glmax - z
                    PUT #6, sf(i, 2) + x2, z
                END IF
            NEXT x2
            FOR x2 = sf(i, 0) TO sf(i, 1) '                           target
                GET #6, x2 + 1, z
                z = z + y * (y <> 0)
                PUT #6, x2 + 1, z
            NEXT x2
            IF gh <> -2 THEN
                Smooth sf(i, 2) - lz
                Smooth sf(i, 2) + lz
            END IF
            isvolcano:
        NEXT i
 
        Smooth sf(1, 0) '                                             Area 51
        Smooth sf(1, 1)
 
        RESTORE BigM '                                                McDonalds
        y = 0
        DO
            READ z$
            IF z$ = "x" THEN EXIT DO
            y = y + 1
            FOR x = 1 TO LEN(z$)
                IF MID$(z$, x, 1) = "X" THEN
                    z = glmax + y - 38
                    PUT #6, sf(5, 0) + x + 1, z
                END IF
            NEXT x
        LOOP
 
        suri = 0
        FOR i = 1 TO q1 '                                             optional, show progress
            GET #6, i + 1, y
            y = gh * 25 + y / 6 + 20
            PSET (i \ t, y), 1
        NEXT i
    NEXT gh
    msflag = 0
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Area51 (tf$) STATIC
    IF a51i = 0 THEN
        pi! = _D2R(180)
        zz! = ATN(1) / 45 * 3
        ac1 = red
        ac2 = white2
        fc$ = "0105030709101412"
        a51i = 1
    END IF
 
    IF bolthitf THEN GOTO aother
 
    tx = x + 33
    FOR i = 20 TO h STEP 5
        z = (z + 2) MOD 45
        FOR j = 0 TO 1
            SWAP ac1, ac2
            FOR k = 0 TO 3
                aa = k * 45 + z
                a1! = _D2R(aa) - zz!
                a2! = _D2R(aa) + zz!
                IF j THEN
                    a1! = pi! - a1!
                    a2! = pi! - a2!
                END IF
                IF a1! < 0 THEN a1! = 0
                IF a2! < 0 THEN a2! = 0
                IF a2! < a1! THEN SWAP a1!, a2!
                CIRCLE (tx, 308), i, ac1, a1!, a2!
            NEXT k
        NEXT j
    NEXT i
 
    IF invincible THEN GOTO aother
    dx! = px! - tx
    dy! = 280 - py!
    IF (ABS(dx!) < 81) AND (ABS(dy!) < 61) AND (liftoff = 0) THEN
        IF contact = 0 THEN mes$(1) = "AREA 51 ELEVATOR ACTIVATED"
        _DELAY .1
        FOR tx2 = sx1 TO sx2 STEP 1
            LINE (tx2, sy1 + 2)-(tx, 309), gray
        NEXT tx2
        IF sy1 > 310 THEN
            LINE (sx1 - 1, sy1 + 2)-(tx, 309), black
            LINE (sx2 + 1, sy1 + 2)-(tx, 309), black
        END IF
        px! = px! - SGN(dx!)
        IF ABS(dx!) < 2 THEN
            IF py! > 280 THEN j = 0 ELSE j = 2
        ELSE
            IF py! > 280 THEN j = -2 ELSE j = 1
        END IF
        py! = py! + j
        a = 0
        thrust! = 0
        vx! = 0
        vy! = 0
        b2b = 1
        '  LINE (gs, 280)-(q3, 280), red
        GOTO bingo
    END IF
 
    aother:
    IF bb2! = 0 THEN bb2! = TIMER + 2
    IF TIMER > bb2! THEN
        bb2! = TIMER + 2
        b2b = 1 - b2b
    END IF
 
    bingo:
    IF contact THEN b2b = 1
    IF b2b THEN
        IF bolthitf THEN tc = white ELSE tc = dred
        FOR i = 1 TO 4
            tx = x + i * t + 3
            PrintVGA MID$("AREA", i, 1), tx, 313, white2, tc
        NEXT i
        FOR nu = 0 TO 1
            FOR ty = 0 TO 4
                bp = VAL("&H" + MID$("26227E8E2E", nu * 5 + ty + 1, 1))
                sp = 1
                FOR tx = 1 TO 4
                    IF bp AND 1 THEN
                        tx2 = x + 52 - tx * 4 - nu * 16
                        ty2 = 309 + ty * 5 + 15
                        LINE (tx2, ty2)-STEP(3, 4), tc, BF
                        IF sp THEN sp = 0: LINE (tx2 + 4, ty2)-STEP(0, 4), white2
                    END IF
                    bp = bp \ 2
                NEXT tx
            NEXT ty
        NEXT nu
    ELSE
        OPEN tf$ FOR INPUT AS #5 '                                    alien.dat (head)
        zc = (zc + 1) MOD 8 '                                         color
        FOR i = 1 TO 32
            LINE INPUT #5, z$
            FOR j = 1 TO LEN(z$)
                c$ = MID$(z$, j, 1)
                IF c$ <> "." THEN '                                   . = transparent
                    IF c$ = " " THEN
                        tc = VAL(MID$(fc$, zc * 2 + 1, 2))
                        IF bolthitf THEN tc = white
                    ELSEIF c$ = "r" THEN '                            spooky eyes
                        tc = red
                    ELSE
                        tc = black2 '                                 eyes/nose/mouth
                    END IF
                    x2 = x + j + t
                    y2 = 312 + i
                    PSET (x2, y2), tc
                END IF
            NEXT j
        NEXT i
        CLOSE #5
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB UFO (tx0, ty0, txi) STATIC '                                      so pathetic a graphic that it's funny, maybe
    aa = (aa + 5) MOD tsix
    tx = tx0 + t * COS(_D2R(aa))
    ty = ty0 + t * SIN(_D2R(aa))
    FOR i = 0 TO 55
        CIRCLE (tx, ty), i, gunmetal, , , .15
    NEXT i
    FOR i = 8 TO 15
        IF i MOD 2 THEN tc = orange ELSE tc = black2
        CIRCLE (tx, ty - 12), i, tc, , , .35
    NEXT i
    tc = VAL(MID$("020414", (ty MOD 3) * 2 + 1, 2))
    p = (p + 1) MOD 5
    IF txi < 0 THEN tp = 4 - p ELSE tp = p
    FOR z = -2 TO 2
        tx2 = tx + z * 16
        CIRCLE (tx2, ty), 5 - ABS(z), black2, , , .7
        IF tp = (z + 2) THEN tc2 = tc ELSE tc2 = black2
        PAINT (tx2, ty), tc2, black2
        CIRCLE (tx2, ty), 5 - ABS(z), tc2, , , .7
    NEXT z
    LINE (tx - 30, ty + 8)-(tx - 35, ty + 20), orange '               legs
    LINE (tx - 37, ty + 20)-(tx - 31, ty + 20), orange
    LINE (tx + 30, ty + 8)-(tx + 35, ty + 20), orange '               pads
    LINE (tx + 32, ty + 20)-(tx + 38, ty + 20), orange
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB TinyFont (d$, tx, ty, tc) STATIC '                                3*5
    IF fontinit = 0 THEN '                                            initialize
        DIM sp(13, 4)
        RESTORE tinyfontd
        FOR n = 0 TO 13
            READ g$
            FOR i = 0 TO 4
                READ z
                sp(n, i) = z * 4096
            NEXT i
        NEXT n
        fontinit = 1
    END IF
 
    FOR z = 1 TO LEN(d$)
        z$ = MID$(d$, z, 1)
        zz = INSTR(".-: ", z$)
        IF zz THEN d = zz + 9 ELSE d = VAL(z$)
        IF (tc = 1) AND (RND > .9) THEN ttc = 3 ELSE ttc = tc '       Borg effect (some bright)
        FOR i = 0 TO 4
            x2 = tx + z * 4 + j - 4
            LINE (x2, ty + i)-(x2 + 4, ty + i), ABS(ttc), , sp(d, i)
        NEXT i
    NEXT z
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB GraphSpeed STATIC
    IF speedi = 0 THEN
        spq = t: psp = 500
        DIM spt!(spq)
        DIM pspeed(psp)
        DIM m(3) AS _MEM
        m(0) = _MEM(spt!(0))
        m(1) = _MEM(spt!(1))
        m(2) = _MEM(pspeed(0))
        m(3) = _MEM(pspeed(1))
        speedi = 1
    END IF
 
    IF spt! = 0 THEN
        spt! = TIMER
        zmin! = h
        zran! = 2
        sphac = psp + 1
    ELSE
        _MEMCOPY m(1), m(1).OFFSET, 4 * spq TO m(0), m(0).OFFSET
        _MEMCOPY m(3), m(3).OFFSET, 2 * psp TO m(2), m(2).OFFSET
 
        IF spt! > TIMER THEN spt! = TIMER
        spt!(spq) = (TIMER - spt!) * h * t
        spt! = TIMER
        z! = 0
        FOR i = 1 TO spq
            z! = z! + spt!(i)
        NEXT i
        pspeed(psp) = z! / spq
        spmin = q1: spmax = -spmin
        sphac = sphac - 1 - (sphac = 0)
 
        IF rick = 0 THEN EXIT SUB
 
        FOR i = sphac TO psp
            spx = 113 + i
            spy = zmin! + (pspeed(i) - zmin!) / zran!
            IF i = sphac THEN
                PSET (spx, spy), orange
            ELSE
                LINE -(spx, spy), orange
            END IF
            IF pspeed(i) <= spmin THEN spmin = pspeed(i): spminx = spx: spminy = spy
            IF pspeed(i) >= spmax THEN spmax = pspeed(i): spmaxx = spx: spmaxy = spy
        NEXT i
 
        spsta = FIX(spmin / h) * h
        spend = INT(spmax / h + pf!) * h
        spend = spend - (spend = spsta) * h
        FOR i = spsta TO spend STEP h
            spy = zmin! + (i - zmin!) / zran!
            LINE (110, spy)-(614, spy), green, , &H1111
            z$ = RIGHT$("  " + STR$(i), 4)
            TinyFont z$, 87, spy - 2, orange
            TinyFont z$, 620, spy - 2, orange
        NEXT i
 
        z$ = LTRIM$(STR$(spmin))
        ty = spminy - 15
        TinyFont z$, spminx + 5, ty, orange
        LINE (spminx, ty + 5)-(spminx, ty - 5), orange
 
        z$ = LTRIM$(STR$(spmax))
        ty = spmaxy + 15
        IF ty > q4 THEN ty = q4 - 20
        TinyFont z$, spmaxx + 5, ty, orange
        LINE (spmaxx, ty)-(spmaxx, ty + t), orange
    END IF
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB Smooth (p1)
    p2 = p1 + 1
    zz = t
    i1 = (p1 - zz + q1) MOD q1
    i2 = (p2 + zz + q1) MOD q1
    IF msflag THEN '                                                  making surfaces, array not valid
        GET #6, i1 + 1, y1
        GET #6, i2 + 1, y2
    ELSE
        y1 = gh(i1)
        y2 = gh(i2)
    END IF
    m! = (y1 + y2) / 2
    d! = (y1 - y2) / zz / 2
    FOR x = 1 TO zz
        s! = d! * (zz - x)
        i1 = (p2 + zz - x + q1) MOD q1
        i2 = (p1 - zz + x + q1) MOD q1
        gh(i1) = m! - s!
        gh(i2) = m! + s!
        IF iscd = 0 THEN
            PUT #6, i1 + 1, gh(i1)
            PUT #6, i2 + 1, gh(i2)
        END IF
        'IF msflag = 0 THEN
        '    IF gc(i1) = gray THEN gc(i1) = red
        '    IF gc(i2) = gray THEN gc(i2) = yellow
        'END IF
    NEXT x
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB SaveImage (f$) '                                                  this sub from qb64.org website (modified)
    IF iscd THEN EXIT SUB
    VIEW SCREEN(0, 0)-(q3, q4)
    bpp& = 8
    tx& = 640
    ty& = 350
    '       XXXX   1XXXX
    '     12345678901234
    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)
    FOR c& = 0 TO 255 '                                               read BGR color settings from JPG image + 1 byte spacer(CHR$(0))
        cv& = _PALETTECOLOR(c&, 0) '                                  color attribute to read
        b$ = b$ + CHR$(_BLUE32(cv&)) + CHR$(_GREEN32(cv&)) + CHR$(_RED32(cv&)) + CHR$(0) 'spacer byte
    NEXT
    MID$(b$, 11, 4) = MKL$(LEN(b$)) '                                 image pixel data offset (BMP header)
    IF ((x& * 3) MOD 4) THEN padder$ = STRING$(4 - ((x& * 3) MOD 4), 0)
    FOR py& = ty& - 1 TO 0 STEP -1
        z$ = ""
        FOR px& = 0 TO tx& - 1
            c& = POINT(px&, py&) '                                    2 bit values are large LONG values
            z$ = z$ + CHR$(ABS(c&) MOD 256)
        NEXT px&
        d$ = d$ + z$ + padder$
    NEXT py&
    MID$(b$, 35, 4) = MKL$(LEN(d$)) '                                 image size (BMP header)
    b$ = b$ + d$ '                                                    total file data bytes to create file
    MID$(b$, 3, 4) = MKL$(LEN(b$)) '                                  size of data file (BMP header)
    f& = FREEFILE
    OPEN f$ FOR OUTPUT AS #f&: CLOSE #f& '                            erases an existing file
    OPEN f$ FOR BINARY AS #f&
    PUT #f&, , b$
    CLOSE #f&
    VIEW SCREEN(gs, 0)-(q3, q4)
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB MakeStarFiles '                                                   takes a LONG time
    IF iscd THEN EXIT SUB
    savestarfiles = starfiles
    ts$ = TIME$
    mstar = 0
    FOR starfiles = 0 TO 2
        FOR rmin = 0 TO 23
            FOR dmin = -90 TO 90 STEP 10
                mstar = mstar + 1 '                                   for progress bar
                starinit = 0
                regen = 1
                Stars
                IF INKEY$ = CHR$(27) THEN SYSTEM '                    Esc aborts
            NEXT dmin
        NEXT rmin
    NEXT starfiles
    mstar = 0
    sprint ts$, 200, 100, red, black
    sprint TIME$, 200, 120, red, black
    timemachine
    SLEEP '                                                           lets user see how LONG it took
    starfiles = savestarfiles: starinit = 0: rmin = 0: dmin = 0
    'Stars '                                                          is this necessary?
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB dissolve STATIC '                                                 called with }
    DIM Buffer AS _MEM
    'LINE (0, 470)-(639, 479), 0, BF
    Buffer = _MEMIMAGE(0)
    np = 0
    DO
        FOR y = _HEIGHT - 8 TO 0 STEP -1
            FOR x = 0 TO _WIDTH
                f& = y * _WIDTH + x
                t& = f& + INT(RND * 2 + 4) * _WIDTH
                d = _MEMGET(Buffer, Buffer.OFFSET + f&, _UNSIGNED _BYTE)
                _MEMPUT Buffer, Buffer.OFFSET + t&, d AS _UNSIGNED _BYTE
            NEXT x
        NEXT y
        IF np = 0 THEN
            FOR x = 0 TO _WIDTH * 4
                _MEMPUT Buffer, Buffer.OFFSET + x, 0 AS _UNSIGNED _BYTE
                o2& = _WIDTH * _HEIGHT - 1 - x
                _MEMPUT Buffer, Buffer.OFFSET + o2&, 0 AS _UNSIGNED _BYTE
            NEXT x
        END IF
        timemachine
        np = np + 1
        IF INKEY$ = CHR$(27) THEN SYSTEM
    LOOP UNTIL np > 120
    _MEMFREE Buffer
END SUB
' -------------------------------------------------------------------------------------------------------x
SUB timemachine '                                                     xlate to 32 bit color for green screen, warp effects
    DIM oc&(15)
    FOR i = 0 TO 15
        OUT &H3C7, i
        tred = INP(&H3C9) * 4: tgrn = INP(&H3C9) * 4: tblu = INP(&H3C9) * 4
        coav = (tred + tgrn + tblu) \ 3
        IF cpal = 0 THEN
            oc&(i) = _RGB32(tred, tgrn, tblu) '                       regular color
        ELSEIF cpal = 1 THEN
            oc&(i) = _RGB32(0, coav, 0) '                             shades of green
        ELSE
            oc&(i) = _RGB32(coav, coav, coav) '                       black and white
        END IF
    NEXT i
 
    DIM m AS _MEM
    m = _MEMIMAGE(canvas&)
    DO: _LIMIT q4 '                                                   349 (h/100 too little, slows down program!)
        tempimage& = _NEWIMAGE(640, 350, 32)
    LOOP UNTIL tempimage& < -1 '                                      try until valid (can fail to make screen)
    SCREEN tempimage&
    FOR y = 0 TO q4 '                                                 replot each pixel of old to new screen
        FOR x = 0 TO q3
            a& = y * 640 + x
            dd = _MEMGET(m, m.OFFSET + a&, _UNSIGNED _BYTE)
            PSET (x, y), oc&(dd)
        NEXT x
    NEXT y
    IF (LEN(dead$) = 0) AND (warp! >= 1) THEN
        VIEW SCREEN(gs, SGN(LEN(mes$(0))) * 20)-(q3, q4) '            protect instrument panel, top line if message active
        IF warp! >= 9 THEN contour ELSE warpx
        VIEW SCREEN(gs, 0)-(q3, q4) '                                 back to normal, only instrument panel protected
    END IF
    _DISPLAY '                                                        show new image
    SCREEN canvas& '                                                  back to old mode so the rest of the program can run
    _MEMFREE m '                                                      would run out of memory otherwise
    _FREEIMAGE tempimage&
END SUB
' -------------------------------------------------------------------------------------------------------x
DEFINT A-Z
SUB warpx STATIC
    wa1 = (wa1 + 5) MOD tsix
    wa2 = wa1
    wx! = 320 + 70 * s!(wa1)
    wy! = 175 + 70 * c!(wa1)
    wc1 = 200
    FOR wd1 = 64 TO 600 STEP 8
        wa2 = wa2 + 2
        wc1 = (wc1 + 27) MOD 512
        wc2 = ABS(wc1 - 256)
        wc& = _RGB32(wc2, 1, 1)
        wd2 = 20 * s!((ABS(wa1 - 256) * 5) MOD tsix)
        wd3 = wd1 + wd2
        FOR z = 0 TO 4
            wde = (wa2 + 90 * z) MOD tsix
            wtx = wx! + wd3 * s!(wde)
            wty = wy! + wd3 * c!(wde)
            IF z = 0 THEN PSET (wtx, wty), wc& ELSE LINE -(wtx, wty), wc&
        NEXT z
    NEXT wd1
END SUB
' -------------------------------------------------------------------------------------------------------x
DEFINT A-Z
SUB contour STATIC
    wa1 = (wa1 + 5) MOD tsix
    wx! = 320 + 70 * s!(wa1)
    wy! = 175 + 70 * c!(wa1)
    DIM distance(360), elevation(360), active(10), angle(10)
    e0 = 320
    n = 6: GOSUB genang
    FOR i = 1 TO n
        angle = angle(i)
        angle = (angle + tsix) MOD tsix
        active(i) = angle
        distance(angle) = 50 + RND * 150
        elevation(angle) = 100 + RND * 150
    NEXT i
    n = n + 1
    active(n) = active(1)
    distance(active(n)) = distance(active(1))
    elevation(active(n)) = elevation(active(1))
    FOR i = 1 TO n
        angle1 = active(i - 1)
        angle2 = active(i)
        ddif! = distance(angle2) - distance(angle1)
        edif! = elevation(angle2) - elevation(angle1)
        IF i = n THEN angle2 = angle2 + tsix
        a! = 0: ai! = 90 / (angle2 - angle1)
        FOR z = INT(angle1) TO angle2
            na = z MOD tsix
            a! = a! + ai!
            z! = s!(a!) * s!(a!)
            distance(na) = distance(angle1) + ddif! * z!
            elevation(na) = elevation(angle1) + edif! * z!
        NEXT z
    NEXT i
    FOR el = -200 TO 220
        zz = 155 * s!((ABS(el) * 3) MOD tsix) + 100
        bb = bb XOR 1
        IF bb THEN c& = _RGB32(0, 0, zz) ELSE c& = _RGB32(zz, 0, 0)
        FOR mangle = 0 TO tsix
            angle = mangle MOD tsix
            distance = distance(angle)
            elevation = elevation(angle)
            epf! = distance / (e0 - elevation)
            d! = distance - ((el - elevation) * epf!)
            tx = px! + d! * c!(angle)
            ty = py! - d! * s!(angle)
            IF mangle THEN LINE -(tx, ty), c& ELSE PSET (tx, ty), c&
        NEXT mangle
    NEXT el
    EXIT SUB
 
    genang:
    zz = 420 / n
    FOR i = 2 TO n
        ta = (i - 2) * zz + INT(RND * 10) - 5 + 30
        angle(i) = INT(ta MOD tsix)
    NEXT i
    sort:
    sorted = 1
    FOR i = 1 TO n - 1
        a1 = angle(i)
        a2 = angle(i + 1)
        IF a1 > a2 THEN sorted = 0: SWAP angle(i), angle(i + 1)
    NEXT i
    IF sorted = 0 THEN GOTO sort
    FOR i = 1 TO n - 1
        a1 = angle(i)
        a2 = angle(i + 1)
        IF (a2 - a1) < 20 THEN GOTO genang
    NEXT i
    RETURN
END SUB
' -------------------------------------------------------------------------------------------------------x
' -------------------------------------------------------------------------------------------------------x
 
 

William33 · « **Reply #1 on:** March 02, 2020, 12:49:51 pm »

Unfortunately this seems not to work on Linux although it compiled without any error. All I got is a black window...

bplus · « **Reply #2 on:** March 02, 2020, 02:48:05 pm »

Quote from: William33 on March 02, 2020, 12:49:51 pm

Unfortunately this seems not to work on Linux although it compiled without any error. All I got is a black window...

@William33
If you run the code with CHECKING:OFF commented out you wont crash your computer and you can report the error you get to code author.

@Richard Frost
Why are there 2 of these posts?

William33 · « **Reply #3 on:** March 02, 2020, 03:21:52 pm »

Thanks bplus, this I didn't know. First few issues was because Linux is case sensitive. Some file names are not correct.
The next error I couldn't solve: Input past end of file in line 2318.

Sorry, I used the wrong ZIP - from the other thread. Now I got a screen but I can't do anything, just showing some particle effects over and over again.

News:

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

Richard Frost

Moon Lander (reprise by request)

William33

Re: Moon Lander (reprise by request)

bplus

Re: Moon Lander (reprise by request)

William33

Re: Moon Lander (reprise by request)