Moon Lander by Richard Frost

Samples Gallery & Reference > Games

(1/1)

Qwerkey:
Moon Lander

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

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

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

Source Code:

--- Code: QB64: ---' Moon Lander by rfrost@mail.com $EXEICON:'.\astro.ico'$RESIZE:SMOOTH DEFINT A-ZDIM SHARED a ' angle of craftDIM SHARED a51i ' Area 51 initializationsDIM SHARED APdisengage ' AutoPilot disengageDIM SHARED ASO ' ascent stage onlyDIM SHARED auto ' autopilotDIM SHARED background ' for instrument panelDIM SHARED bh ' black holeDIM SHARED bhx, bhy ' black holeDIM SHARED bbit ' blinking bit synced to timeDIM SHARED bolthit, bolthitf, boltx ' Deathstar hit vehicle, featureDIM SHARED borgl, borgr, borgt ' left right top, distanceDIM SHARED bstyle1, bstyle2 ' Borg matrix/lines/MoireDIM SHARED bw ' black and whiteDIM SHARED c ' usually colorDIM SHARED canvas& ' primary screenDIM SHARED cbh ' constant black holesDIM SHARED center ' varies according to gs (graphics start)DIM SHARED chs ' parachute sizeDIM SHARED contact ' landedDIM SHARED convo ' conversation active LM/CMDIM SHARED cpal ' color palette, normal/green/b&w (32 color kludge/fun)DIM SHARED craft ' colorDIM SHARED crash ' layer of debrisDIM SHARED cwd, cwsi, cwsd ' car wash distance, anglesDIM SHARED cybilltime! ' time on screenDIM SHARED darkstarc ' deathstar color setDIM SHARED darkstars ' deathstar spin rateDIM SHARED darkstart ' " thicknessDIM SHARED dead$ ' end conditionDIM SHARED debug$ ' messages to GodDIM SHARED demo ' ground features compressedDIM SHARED doclock ' it's Howdy Doody timeDIM SHARED dosbox ' flagDIM SHARED dsinit ' deathstarDIM SHARED eou ' end of universeDIM SHARED fb$ ' landing feedback/analysisDIM SHARED flx ' US/USSR flag positionDIM SHARED fuel, fuel! ' color of, quantity leftDIM SHARED gh, glmin, glmax ' ground height, levelDIM SHARED grav! ' gravityDIM SHARED gs ' flight area x startDIM SHARED gstyle ' ground styleDIM SHARED inpause ' flagDIM SHARED invincible ' impervious to threatsDIM SHARED iscd ' don't attempt to write!DIM SHARED jitter ' shift-T to controlDIM SHARED LEDc ' colorDIM SHARED LEDtri ' tri-color flagDIM SHARED level ' surface isDIM SHARED LGMc ' Little Green Man colorDIM SHARED liftoff ' AS onlyDIM SHARED lmsl ' LM shield/laser colorDIM SHARED lob ' landed on BorgDIM SHARED lockfuel ' cheat!DIM SHARED lp, rp, xp, th1, th2 ' pads, radar, thrustersDIM SHARED magic ' cheat! (instant landing)DIM SHARED mdelay ' PgUp/PgDn controlledDIM SHARED msflag ' making surfacesDIM SHARED mstar ' make starsDIM SHARED nation ' 1 US, 2 USSR (flags & fireworks)DIM SHARED ok ' at landing, to plant flagDIM SHARED okrick ' diagnosticsDIM SHARED osc ' on screen countDIM SHARED oscar ' semaphore land/sea flagsDIM SHARED panelinit ' replot flagDIM SHARED paraf ' parachute flagDIM SHARED pload ' panel load flagDIM SHARED porb ' pointers/bargraphsDIM SHARED ptk ' points to kill (gasoline) ExplodeLMDIM SHARED px!, py! ' vehicle position on screenDIM SHARED ra ' random angleDIM SHARED radarf ' radar on/offDIM SHARED rads ' Luna radiationDIM SHARED radiationdeath ' flagDIM SHARED rdtime! ' fun with high res screen (my picture)DIM SHARED regen ' all star filesDIM SHARED rfx, rfy ' craft jiggerDIM SHARED rick ' debug flagDIM SHARED rmin, dmin ' starsDIM SHARED settings$ ' lander.setDIM SHARED sf ' surface featureDIM SHARED shield ' flagDIM SHARED shoot ' flagDIM SHARED showmap ' locations of things shown at topDIM SHARED sia ' shells in airDIM SHARED skyoff ' for faster performanceDIM SHARED starship ' Enterprise (double shift twice)DIM SHARED ufof ' for ufoDIM SHARED sspinit1, sspinit2 ' SurveyorDIM SHARED starfiles ' use stars1,2 or 3 (few/med/lots)DIM SHARED starinit ' flagDIM SHARED shipi&, shipx ' starshipDIM SHARED starstatus ' 0 off, 1 on, 234 more infoDIM SHARED suri ' surface indexDIM SHARED sx0, sy0 ' LM radar/laser locationDIM SHARED sx1, sy1 ' LM left landing padDIM SHARED sx2, sy2 ' LM right landing padDIM SHARED temp ' temperatureDIM SHARED thrust! ' 0 - 100DIM SHARED tilef ' tile variationDIM SHARED vx!, vy! ' LM velocityDIM SHARED wa1DIM SHARED warp! ' vx! >= 100DIM SHARED wi, wi2 ' width (distance between pads)DIM SHARED wx!, wy! ' vehicle position on screenDIM SHARED x ' = suri + px!DIM SHARED xoff ' offset for v=5-20, Surv & EtnaDIM SHARED zoom ' starfield DIM SHARED blue, green, gunmetal, red, gasoline, gray2, white, grayDIM 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 = 360pf! = .5: aspect! = 1.4: grav! = 1.6 qt = 2000 ' 3 arrays below weren't loading properly with q2DIM SHARED LMx(qt), LMy(qt), LMc(qt) ' LM+exhaust x,y,color DIM SHARED LMrx(1400), LMry(1400) ' LM+exhaust x,y after rotationDIM SHARED LMoc(705), LMci(3) ' LM colors,original colors, indexDIM SHARED c!(360), s!(360) ' sines and cosinesDIM SHARED ex(6), ey(6), exv(6), eyv(6), ei(6), ek(6), exl(6) ' sky objectsDIM SHARED f$(40) ' support filesDIM SHARED mes$(1), omes$(1), sm!(1) ' messages at screen topDIM SHARED sf(10, 2), sf$(10) ' surface features start/end/middleDIM SHARED shx(20), shy(20), sha(20) ' shells (IBM weapons) x,y,angleDIM SHARED shvx(20), shvy(20), shd(20) ' velocity, distanceDIM SHARED rtl!(2), rtlc(2) ' radiation/temperature/lightningDIM SHARED gh(6400) ' ground height DIM clocka(2) ' clock anglesDIM cmp&(30) ' CM patternsDIM convo$(50) ' LM/CMDIM SHARED gbuff(800) ' DS liftoffDIM skyset1(t), skyset2(t) ' skycrudDIM SHARED p(127, 13), p2(127, 7) ' vga and cga fontsDIM SHARED tflags(30) begin:GOSUB init1DO 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 IFLOOP CheckDead:z$ = LEFT$(LEFT$(dead$, 1) + " ", 1)IF INSTR(" CBE", z$) = 0 THEN ' not Crashed, Borg, Eaten by BH ExplodeLM contact = 0END IFdead$ = ""RETURN Autopilot:aboveborg = 0IF (ek(2) = -1) OR (ek(2) > h) THEN borgt = 0IF (skyoff = 0) AND (sy1 < borgt) AND (px! > borgl) AND (px! < borgr) THEN aboveborg = 1super = 0IF 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 thrust! > h THEN thrust! = hEND IFIF thrust! < 0 THEN thrust! = 0RETURN CutOrOutOfFuel:IF fuel! = 0 THEN shield = 0 ' shields need fuelIF cut = 0 THEN cut = 1 cvy! = vy! ctime! = TIMER tfollow = 0 ' terrain following thrust! = 0END IFRETURN idealthrust: ' for hover or descendIF (alt! < pf!) AND (jitter = 0) THEN i! = .05 ' soft landingIF hover THEN i! = hoverc ' targethoverc = hoverc - SGN(hoverc) ' up/downfmin! = q1 ' conventient large number (6400)ma! = (vmass + fuel!) / th ' mass (actually 54% fuel)ts! = s!((a + 270) MOD tsix) / ma! / powerIF jitter THEN us! = RND * t + 1 ELSE us! = .1IF powerloss THEN us! = hFOR 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 FORNEXT 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) = 0END IFRETURN 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 + _MOUSEWHEELLOOPIF 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 keysEND IF DEF SEG = 0status = PEEK(&H417) ' 7ins 6caps 5num 4scrl 3alt 2ctrl 1ls 0rs IF ((status AND 1) > 0) AND ((status AND 2) > 0) THEN ' both shift (cookie!) IF rdtime! > 0 THEN starship = 1 ' must have pressed shift-shift twice, another cookie rdtime! = TIMER + 5 ' Rick display timeEND IF 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 IFEND IF i$ = INKEY$ ' consult humanli = LEN(i$)IF li = 0 THEN RETURN IF i$ = "|" THEN MakeStarFiles ' takes hours! k = ASC(RIGHT$(i$, 1))IF k = 27 THEN QuitIF inpause AND (k = 32) THEN k = 13 ' transform spacebar to Enter i$ = RIGHT$(CHR$(0) + CHR$(k), li) ' gentlemen, we can rebuild himEND 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) = 1END IF IF i$ = "[" THEN bw = bw XOR 1: Setcolor ' crude method for b&wIF i$ = "]" THEN ufof = ufof XOR 1 mes$(0) = "UFO " + OnOff$(ufof) IF ufof THEN GOSUB SkyStuff p = 6: GOSUB GoSkyObject END IFEND IF IF i$ = "=" THEN GOSUB lmshow ' show LM data - pointless but amusingIF i$ = "'" THEN pdiv = (pdiv + 1) MOD 4 ' Henon speed, also slows down thrust displayIF 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 IFIF i$ = "~" THEN darkstarc = darkstarc XOR 1 ' colorIF 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 IFEND IFIF li = 2 THEN GOTO is2 ' extended key IF i$ = "_" THEN ' star twinkle twinkle = twinkle XOR 1 mes$(0) = "STAR TWINKLE " + OnOff$(twinkle)END IFIF i$ = ";" THEN fpl = 1 ' force power lossIF k = 9 THEN ex(1) = (suri + px!) - SGN(exv(1)) * h ' TAB summon DSp = INSTR(")!@#$%^&*(", i$)IF p AND (contact = 0) THEN GetSurface p - 1 ' shifted-number for 1 of 10 surfacesp = INSTR("01234", i$) ' stars off/on/infoIF p THEN starstatus = p - 1IF k = 8 THEN ' backspace, random star position rmin = INT(RND * 24) ' random RA dmin = (INT(RND * 18) - 9) * t ' random dec starinit = 0END IFIF i$ = "." THEN tfollow = tfollow XOR 1 auto = 0 vert = 1 mes$(0) = "TERRAIN FOLLOWING " + OnOff$(tfollow)END IFp = (i$ = "<") - (i$ = ">") ' jump left/rightIF (contact = 0) AND (p <> 0) THEN suri = suri + 40 * p ' surface index GOSUB slimit ' limit suri IF lock1 THEN hover = 1: lock1 = 0END IFIF (i$ = "+") AND (zoom < 2) THEN zoom = zoom + 1: starinit = 0IF (i$ = "-") AND (zoom > 0) THEN zoom = zoom - 1: starinit = 0IF i$ = "?" THEN rick = rick XOR 1 ' show speed of processing graphIF okrick AND (i$ = "U") THEN tilef = (tilef + 1) MOD 3 ' alternate tilingsIF i$ = "/" THEN cpal = (cpal + 1) MOD 4 ' cycle green/black & white/normal monitor mes$(0) = "": mes$(1) = "" IF cpal = 1 THEN mes$(0) = "GT40 mode" IF cpal = 2 THEN mes$(1) = "Hyperion mode!" IF cpal = 3 THEN mes$(1) = "Do not adjust your set. We control the horizontal and the vertical!"END IFIF 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 graveEND 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 autopilotEND IFIF 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 countdownEND IFIF i$ = "c" THEN GOSUB CutOrOutOfFuelIF i$ = "C" THEN doclock = doclock XOR 1IF i$ = "d" THEN dump = dump XOR 1 ' fuelIF i$ = "D" THEN restart = 1 ' restart with defaultsIF (i$ = "E") AND (starstatus > 0) THEN ' end of universe IF eou = 0 THEN eou = -1 ELSE eou = eou + 1 ' restart or speedupEND IFIF i$ = "F" THEN fuel! = h lockfuel = 1END IFIF 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 styleIF i$ = "h" THEN hover = hover XOR 1: apd = 1 ' apd=autopilot disconnect warningIF i$ = "I" THEN invincible = ABS(invincible) XOR 1 mes$(0) = "INVINCIBLE MODE " + OnOff$(invincible) GOSUB ReadLM ' to change thrustersEND IFIF i$ = "j" THEN darkstars = (darkstars + 1) MOD 5 mes$(0) = "Deathstar rotation" + STR$(darkstars)END IFIF 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 zEND IFIF i$ = "L" THEN GetSurface -1 ' level groundIF (i$ = "M") AND ((contact + inpause) = 0) THEN ' laser level & land magic = magic + 1END IFIF (i$ = "n") AND inpause THEN nation = ((nation - 1) XOR 1) + 1 ' flag 1 US, 2 USSRIF i$ = "p" THEN GOSUB pause ' pause LM movementIF (i$ = "P") AND (contact = 0) AND (warp! < 1) AND (paraf = 0) THEN paraf = 1 ' parachute! chs = 0 a = 0 GOSUB CutOrOutOfFuelEND IFIF i$ = "q" THEN QuitIF 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 IFIF 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 IFEND IFIF i$ = "S" THEN MakeSur: restart = 1 ' generate new surfacesIF i$ = "T" THEN jitter = jitter XOR 1 ' thrust computationIF 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 IFEND IFIF 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 warningEND IFIF i$ = "x" THEN starinit = 0: starfiles = (starfiles + 1) MOD 3 ' star densityIF i$ = "X" THEN starinit = 0: regen = 1: Stars ' regenerate single star fileIF i$ = "y" THEN mouseswap = mouseswap XOR 1 IF mouseswap THEN z$ = "reversed" ELSE z$ = "normal" mes$(0) = "Mouse buttons " + z$END IFIF i$ = "Y" THEN min = 3: sec = 45 ' black hole at 3:50IF (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 = srfEND IF ' 1234567890p = INSTR("5wlemtsiHg", i$) ' jump to featureIF 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 warpEND IFGOTO endk ' done with ordinary keys is2: ' extended keyz = mdelay ' master delaymdelay = mdelay - (k = 73) + (k = 81) ' PgUp/PgDnIF mdelay < 1 THEN mdelay = 1IF mdelay <> z THEN ' changed mes$(0) = "_LIMIT " + OnOff$(SGN(mdelay)) IF mdelay THEN mes$(0) = mes$(0) + LTRIM$(STR$(mdelay))END IFIF 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 rightEND IFIF (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 = -1END IFthrust! = INT(thrust! * t) / t ' t = 10IF (hover = 0) AND (vert = 0) THEN thrust! = INT(thrust!)IF thrust! > h THEN thrust! = hIF (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 disconnectEND IFIF k = 59 THEN ' F1 help mHelp start1! = TIMER: mpass& = 0 ' reset speed timerEND IFIF k = 60 THEN ' F2 demo demo = demo XOR 1 GOSUB init2 cbh = demo ' constant black holesEND IFIF 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 IFIF k = 62 THEN ' F4 endless bh cbh = cbh XOR 1 exv(3) = 0 mes$(0) = "CONSTANT BLACK HOLES " + OnOff$(cbh)END IFIF 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 = 0END IFIF (k = 64) AND ((ASO + inpause) = 0) THEN ' F6 seperate AS/DS GOSUB liftoff RETURNEND IFIF k = 65 THEN showmap = showmap XOR 1 ' F7 mapIF k = 66 THEN ' F8 shields shield = shield XOR 1 geof = shield * tEND IFIF 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 = 0END IFIF k = 68 THEN ' F10 LED tri-color LEDtri = LEDtri XOR 1 IF LEDtri THEN LEDc = greenEND IFIF k = 71 THEN rmin = 0: dmin = 0: starinit = 0 ' Home, star RA/dec to 0 endk:IF k = 201 THEN hoverc = hoverc - t ' move upIF k = 203 AND (left = 0) THEN left = 16 ' move leftIF k = 204 AND (right = 0) THEN right = 16 ' move rightIF 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 flagEND IFRETURN pause:IF inpause THEN RETURN ' already doing this....dead$ = ""inpause = 1pt! = TIMER ' for demo modewu! = pt! + 1 ' delay before planting flagDO: _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 CalcFuelLOOP UNTIL (i$ = CHR$(13)) OR (i$ = "p")ctime! = TIMERfb$ = "" ' feedbackinpause = 0c = (contact = 1) AND (crash = 0) AND (liftoff = 0) AND (ABS(a) < 31)IF c THEN GOSUB liftoffRETURN CalculateMotion:i = 0IF (power = opower) AND (RND < .0003) THEN i = ((auto + contact + liftoff + vert) = 0) AND ((min * 60 + sec) > t)END IFIF 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 BorgIF contact OR inpause THEN GOTO other ta = ((a + ma) + 270) MOD tsix ' temp angle = a+malfunction anglema! = (vmass + fuel!) / th ' actually 54% fuelfo! = ((thrust! + super * 5) / ma!) / power ' f = maIF fuel! = 0 THEN fo! = 0 ' nix any force if running on emptyfx! = fo! * c!(ta) / 2IF dump AND (ABS(a) < 5) THEN fx! = 0fy! = fo! * s!(ta) + grav! ' thrust + gravityIF warp! > 0 THEN fx! = fx! * (warp! * 2 + 1) ' get thru warp msgs fastervx! = vx! - fx!IF a <> 0 THEN vx! = vx! + (RND - pf!) / h ' help get to integer vxIF ABS(vx!) < .01 THEN vx! = 0avx = ABS(vx!)IF (avx > 5) AND (avx < 20) THEN xoff = vx! ELSE xoff = 0IF 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 situationEND IFvy! = 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! = 0END IF other:GOSUB CalcFuelIF liftoff AND (lob = 0) THEN RETURNnomove = demo AND (((suri \ q3) + 1) = 5) zz = px! - centerz! = 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 IFEND IFIF 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 IFIF 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 IFRETURN CalcFuel:IF cut THEN thrust! = 0IF 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 CutOrOutOfFuelEND IFRETURN 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! = 0END IF bolthit = 0bolthitf = 0IF (crash = 0) AND (ABS(vx!) >= h) THEN warp! = ABS(vx!) / h ELSE warp! = 0IF warp! >= 1 THEN paraf = 0 ' reckon parachute can be dropped at warp speeds ' change styles every 10/30 secondsIF style! = 0 THEN style! = TIMER + tIF style! > 86400 THEN style! = 1 ' midnite xingIF TIMER > style! THEN bstyle1 = (bstyle1 + 1) MOD 3 ' Borg guts every 10s IF bstyle1 = 0 THEN bstyle2 = bstyle2 XOR 1 ' Borg exhaust style! = 0END 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 = 1END IFGOSUB 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 ' INSTRUMENTSEND IFIF 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) CLSEND 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 anyIF 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 FiveWaysToDieEND IFIF platform THEN PUT (pminx, pminy), gbuff(), OR ' falling descent stageIF LEN(dead$) = 0 THEN GOSUB PlotVehicle ' VEHICLEIF (warp! < 1) AND showmap AND (crash = 0) THEN VIEW Map ' LM, ground & sky features VIEW SCREEN(gs, 0)-(q3, q4)END IFIF 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) = 1END IF IF cmleaving THEN exv(0) = exv(0) + 2 IF exv(0) = 0 THEN exv(0) = 1END IF RESTORE skycrudIF eou THEN mi = 2 ELSE mi = 5 ' end of universe, no celestial eventsFOR 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 iRETURN 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" BlackHoleDoomEND 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)) / 5RETURN Instruments:osc = 8IF gs THEN LoadPanel ' graphics start not zero, instrument panel is onIF (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 IFEND 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/faceEND 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 iEND 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, black2END 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 iEND IF osc = 0c = LEDcIF (sbest! >= h) OR powerloss THEN c = redz! = thrust!: IF z! > h THEN z! = h ' 200 at liftoff, show 100PrepAndShowLED z!, 3, 1 ' thrust osc1PrintCGA "T", 5, -1, c, -blue, 0 ' T is for flamei = LEDc: j = blackIF jitter THEN SWAP i, j ' thrust calc typeLINE (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 osc2z! = vy!IF ABS(z!) > 99.97 THEN z! = 99.99PrepAndShowLED z!, 3, 2PrintCGA "V", 5, -1, c, -blue2, 0z! = (z! + 3) / 6Bar z!, 1 c = dcolor(vx!, 2, 3, 1) ' vx osc3IF warp! THEN z! = warp!ELSE z! = vx! + rfs!END IFPrepAndShowLED z!, 3, 2PrintCGA "H", 5, -1, c, -blue, 0z! = (z! + 3) / 6Bar z!, 1 GOSUB GetAlt ' alt osc4IF contact AND (alt! > 0) THEN alt! = 0c = dcolor(alt!, t, 3, -1)PrepAndShowLED alt!, 4, 1PrintCGA "A", 5, -1, c, -blue2, 0IF warp! OR (radarf = 0) THEN z! = 0 ELSE z! = alt! / 60Bar z!, 0 c = dcolor(fuel!, t, 5, -1) ' fuel osc5PrepAndShowLED fuel!, 4, 1PrintCGA "F", 5, -1, c, -blue, 0z! = fuel! / hBar z!, 0 clock:IF TIMER < start2! THEN start2! = TIMER ' midnite crossingIF crash = 0 THEN el! = el! + (TIMER - start2!) ' elapsed timestart2! = TIMERIF 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 IFEND IFz$ = RIGHT$("0" + LTRIM$(STR$(min)), 2) + RIGHT$("0" + LTRIM$(STR$(sec)), 2)osc = 6LEDdisplay 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! = kPrepAndShowLED dtm!, 4, 0 ' dtm osc7PrepAndShowLED CSNG(speed), 4, 0 ' speed osc8ShowAngle a ' angle osc9panelinit = 1RETURN LMcolors: ' optionalIF contact OR (vx! = 0) THEN lbit = 0IF (contact + vx!) = 0 THEN v1 = RND * 3 v2 = RND * 3 SWAP LMci(v1), LMci(v2)END IFFOR 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 IFNEXT ilbit = lbit - (vx! > 0) * 2 + ASO * tRETURN PlotVehicle:IF warp! < 1 THEN wda = 0ELSE 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 endprocEND IF IF bolthit = 0 THEN GOSUB LMcolors i = sf(4, 2) - 50 ' left of volcanoj = sf(4, 2) + 50 ' right of volcanok = suri + px! ' LM positionIF (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 IFEND IF IF nred = 0 THEN ' number red temp = 0 rtlc(1) = 0ELSE 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 iEND IF n = rp ' last pixel = right padIF fuel! > 0 THEN GOSUB Exhaust ' maybe vehicle only IF n > maxn THEN maxn = n ta = a + ma ' temp a = a + malfunctionzz = ta * -(ABS(ta) > 4) ' rotate beyond 5 degreesta = (zz + wda + tsix) MOD tsix ' keep in array boundsc! = c!(ta) ' cosines! = s!(ta) ' sineta = zz ' angle to use rfx = 0 ' optional craft jitterrfy = 0rfs! = 0 ' random change in vxIF (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 IFEND 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 offsetELSE ao = (ao + 1) MOD 361END IF tvx = SGN(vx!): IF tvx = 0 THEN tvx = 1tao = ao * tvxsco = sco XOR 1IF doclock THEN sco = 0IF sco THEN tc = red ELSE tc = lmslz3 = tsix + (shield = 0) * 361FOR 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 IFNEXT 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 IF fuel! < 95 THEN GOSUB flevel eflag = 0 ' determine flame climbfx1 = 0 ' initialize for deflectfx2 = 0phg = (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 IFNEXT i IF rfx AND dump AND (a = 0) THEN vx! = vx! + rfs! ' make jitter realIF rfx AND (dump = 0) AND (a <> 0) THEN vx! = vx! + rfs! endproc: IF doclock THEN TextOnLM$ = LEFT$(TIME$, 5)IF LEN(TextOnLM$) THEN GOSUB TextOnLM GOSUB radar fc = 0 ' LGM flame countIF (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 xEND IF GOSUB KillThreats geof = geof - 1 - (geof = 0) IF ok AND (TIMER > wu2!) AND (INSTR(mes$(0), "IN CAR") = 0) THEN FlagandFireworks mpass& = mpass& + 1IF TIMER <= start1! THEN start1! = TIMER: mpass& = 1speed = ((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 = 2END IF ' kill surface featureIF firel AND ksf AND (contact = 0) AND (sf(sf, 2) > 0) THEN GOSUB lsurfaceEND IFfirel = ks ' ks = keep shooting ' terrain followingIF 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 IFEND IFIF paraf THEN IF py! > 150 THEN mes$(0) = "Parachutes don't work in a vacuum!" ParachuteEND 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, whiteEND IFTextOnLM$ = ""RETURN KillThreats:killed = 0FOR 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 IFNEXT i ks = 0FOR i = 1 TO 6 IF skyoff OR (ek(i) = -1) THEN GOTO ni3 ' CM DS BO BH WO Co 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 iIF killed THEN ksf = 0 ELSE ksf = 1RETURN lsurface: ' laser surface featurez = (RND > .9) OR (magic = 1) ' 1 out of 10 destroys, magic alwaysFOR 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 ' levelNEXT iIF 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) = -1END IFRETURN LMfl: ' fire laserIF (cwd < 50) AND (sy1 > szs) THEN ' in car wash? dead$ = "REFLECTED LASER" cwd = 999 firel = 0 laserb = 0 ks = 0 RETURNEND IFFOR zx = -1 TO 1 FOR zy = -1 TO 1 LINE (sx0 + zx, sy0 + zy)-(tx, ty), lmsl NEXT zyNEXT zxgeof = tRETURN flevel: ' make fuel level when angle > 4IF ASO THEN RETURN ' no fuel shown with ASptk = (h - fuel!) * 2.7 ' pixels to killz = ptk ' ptk used by ExplodeLMx1 = px! - 16x2 = px! + 14y1 = py! - 15y2 = py! + 15FOR 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 FORNEXT yRETURN deflect: ' flame bounceoz = gety(-x)IF deflectat > 0 THEN oz = deflectatz = oz ' dump side t st in pauseIF (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 RETURNEND IF IF y >= (z - 1) THEN ' yep, deflect it IF sy1 < borgt 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 IFRETURN CWceiling: ' car washcwd = ABS((suri + px!) - sf(2, 2)) ' car wash distanceIF ASO THEN szs = 323 ELSE szs = 340 ' safe zone startIF (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 IFEND IFRETURN CheckHit: ' contact with groundcc1 = ((sy1 + 1) >= gety(-sx1)) ' left padcc2 = ((sy2 + 1) >= gety(-sx2)) ' right padmingx = 0mingy = q1FOR 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 IFNEXT zxIF mingx THEN i = mingx - sx1 j = sx2 - mingx IF i < j THEN cc1 = -1 ELSE cc2 = -1END IF GOSUB CWceiling ' car washIF 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 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 IFEND IFRETURN slimit: ' surface index boundsz = 0IF suri < 0 THEN z = q1IF suri >= q1 THEN z = -q1suri = suri + zIF lock1 THEN lock1 = lock1 + zRETURN radar: ' autopilot landing here tooIF contact OR liftoff THEN RETURNz = SGN(vx!): IF z = 0 THEN z = 1IF z = -1 THEN sbl = -280 ELSE sbl = 220bt = (bt MOD 4) + 1div = 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! = 0bl = sbl * ABS(tvx!) + (sx1 - sx2)IF ABS(bl) > ABS(sbl) THEN bl = sblIF auto = 0 THEN lock1 = 0IF lock1 = 0 THEN rxm = sx2 + bl ELSE rxm = lock1 - suri level = 1FOR 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 = 0NEXT 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 colorELSE lock1 = 0 ' not level, cancel lock rbeam = red ' radar beam colorEND IF rpass = rpass XOR 1IF level AND (vx! = 0) THEN div = div \ 2 IF div < 1 THEN div = 1 IF rpass THEN rbeam = 0END 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 rbeamNEXT i IF auto = 0 THEN GOTO end6IF aboveborg OR (abort = 0) THEN GOTO skipit abort:hover = 1hoverc = 0lock1 = 0 i = (py! > 120) ' too lowj = NOT ((vx! = 0) AND (level = 1)) AND (ABS(vx!) < (ideal! - .05)) ' too slowk = (ABS(vx!) > (ideal! + .05)) ' too fastIF i THEN wa = -ma: hoverc = -3IF j THEN wa = 4 * -z + maIF k THEN wa = ABS(vx!) * z - ma IF ABS(wa) > 20 THEN wa = 20 * zEND IFIF i OR j OR k THEN abort = 1: GOTO end6abort = 0 skipit:IF lam THEN ' land at McDonalds dis = ABS((suri + rxm) - sf(5, 2)) IF dis > 80 THEN level = 0: lock1 = 0END IFwa = -ma ' want angle = -malfunction angle IF dflag THEN dump = 0: dflag = 0IF level = 0 THEN ' locked onto a target abort = 1ELSE 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 ABS(vx!) > thv! THEN wa = wa + mu * z END IF END IFEND IFend6:GOSUB angleRETURN rbeam:dx! = (tx - sx0) / divdy! = (ty - sy0) / divFOR 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 IFNEXT jRETURN angle:IF dump THEN RETURNcf = 0IF 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 IFEND IF IF liftoff OR ((auto = 0) AND (vert = 1) AND (ma = 0)) THEN RETURNcp = (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 IFEND IFRETURN Exhaust:IF inpause THEN tflame = blue ELSE tflame = flame IF cut THEN thrust! = 0d = 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 yELSE i = 20 ' divisor for exhaust width j = 2 ' throwing x off up to this amount k = 2 ' flame decrement y = ny - 3 ' starting yEND 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 thrustWENDn3 = n ' main/side thrusters ' if there's a thruster malfunction, may have both thrusters activeIF (ma = 0) OR (a = 0) OR (SGN(a) = SGN(ma)) THEN ta = a + ma pass = 1ELSE ta = a pass = 2END IFIF dump THEN ta = t dors: ' dump fuel or sideways motionIF liftoff THEN ta = 0IF rfx AND (dump = 0) THEN ta = rfs! * 50IF (contact = 1) AND (dump = 0) THEN ta = 0: wan = 0: super = 0IF 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 IFEND IFpass = pass - 1IF pass THEN ta = ma: GOTO dorsnoside: ' super - use side thrusters to augment main thrust when more than' 100% thrust is called forIF dump THEN RETURNIF 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 = -changeEND IF RETURN init1: ' only done onceDATA convo,f1,f2,lmx1,lmy1,lmc1,lmx2,lmy2,lmc2DATA h1,h2,h3,h4,h5,h6,cybill,surv2,cm,rad,af2,sf2,panelDATA sd,sl,s0,s1,s2,s3,s4,s5,s6,s7,s8,s9,panel0,panel1DATA dstarm,stars,lanblank,alien RESTORE init1IF _FILEEXISTS("rick.") THEN okrick = 1tc$ = UCASE$(COMMAND$ + " ")IF LEFT$(tc$, 1) = "/" THEN tc$ = " "IF INSTR(tc$, "DOS") THEN dosbox = 0 ' use large star fileIF INSTR(tc$, "BOX") THEN dosbox = 1 ' use small star fileIF INSTR(tc$, "CD ") THEN iscd = 1 ' simulate CDIF INSTR(tc$, "UFO ") THEN ufof = 1 'IF _FILEEXISTS("cd.dat") THEN iscd = 1 ' include/create this file for CD/DVD distribution (read only) z = 0FOR 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 IFNEXT iIF z THEN PRINT PRINT "Above file(s) missing" SLEEP SYSTEMEND IF s& = VARSEG(p(0, 0))o& = VARPTR(p(0, 0))DEF SEG = s&BLOAD "F1.dat", o&z$ = "386C6C38" ' degree symbolFOR 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 TIMERauto = 0 ' full automaticbackground = 1 ' textured LED displayscbh = 0 ' constant black holesdarkstars = 1 ' spindarkstart = 1 ' thickness of linesdemo = 0 ' cram onto one pagedoclock = 0 ' shield effectgh = 9gs = 85 ' graphics startglmax = q4 ' ground level maxglmin = glmax - 49 ' ground level mings = 85 ' graphics start (flying area)'gstyle = 5invincible = 1 ' easier for beginner, thrusters goldjitter = 1 ' thrust calcLED$ = "021404120115" ' color sequence - gr ye re or gun whLEDc = green 'LEDtri = 0 ' offmdelay = t ' master delayopower = 62 ' original thrust factorpdiv = 0 ' instrument updateradarf = 1restart = 0 ' shift-d load defaultssegs$ = "abcdefg" ' for 7 segment displayssettings$ = "LANDER.SET"shield = 0 ' Star Trek!showmap = 0 ' silly legend at topskyoff = 1 ' DS, BH, Wo, Costarfiles = 1 ' dat1, dat2, dat3starstatus = 1 ' show stars only, no names/infotwinkle = 0zoom = 1 ' starfield 6 hours 45 degrees black = 0: blue = 1: green = 2: gunmetal = 3: red = 4: gasoline = 5gray2 = 6: white = 7: gray = 8: dred = 9: gold = 10: black2 = 11orange = 12: blue2 = 13: yellow = 14: white2 = 15 craft = white: flame = yellow: fuel = gasoline: LEDc = greenLMci(0) = gray2 ' ASO shifting colorsLMci(1) = goldLMci(2) = gray2LMci(3) = black2 IF _FILEEXISTS(settings$) THEN OPEN settings$ FOR INPUT AS #1 nflags = 0 DO IF EOF(1) THEN EXIT DO INPUT #1, g$ IF EOF(1) THEN EXIT DO nflags = nflags + 1 INPUT #1, tflags(nflags) LOOP CLOSE #1END IF auto = tflags(1)background = tflags(2)cbh = tflags(3)demo = tflags(4)doclock = tflags(5)invincible = tflags(6)jitter = tflags(7)LEDc = tflags(8)LEDtri = tflags(9)radarf = tflags(10)shield = tflags(11)showmap = tflags(12)starstatus = tflags(13)zoom = tflags(14)skyoff = tflags(15)gstyle = tflags(16)mouseswap = tflags(17)porb = tflags(18)starfiles = tflags(19)mdelay = tflags(20)fsf = tflags(21) IF fsf THEN _FULLSCREENELSE IF _FULLSCREEN = 0 THEN _FULLSCREEN _OFFEND IF FOR i = 0 TO tsix ' table faster s!(i) = SIN(_D2R(i)) c!(i) = COS(_D2R(i))NEXT i clines = 0OPEN f$(1) FOR INPUT AS #1 ' convo.dat, LM/CM chatterWHILE NOT (EOF(1)) clines = clines + 1 LINE INPUT #1, convo$(clines)WENDCLOSE #1 s& = VARSEG(cmp&(0)) ' Command Moduleo& = VARPTR(cmp&(0))DEF SEG = s& ' cm.datBLOAD f$(18), o& IF (RND > .95) AND (okrick = 0) AND (INSTR(COMMAND$, "NOS") = 0) THEN MakeSur start1! = TIMERRETURN init2: ' each cyclea = 0 ' anglea51i = 0ASO = 0 ' ascent stage only = falseboltc = 0 ' lightning countcenter = 362contact = 0 ' with groundconvo = 0 ' with CMcrash = 0cut = 0 ' enginedump = 0 ' fueleou = 0 ' end of universefb$ = "" ' landing feedbackflx = 0 ' where to plot flagfuel! = hhover = 1 ' start safeideal! = 2.7 ' autopilot speedinpause = 0jf = -1 ' jump to featureLGMc = 1 ' little green man colorlmsl = blue ' LM shield & laserlob = 0 ' landed on Borglock1 = 0 ' radar trackinglockfuel = 0ma = 0 ' malfunction anglemagic = 0 ' landingmes$(0) = "" ' messages ^ landing evalmes$(1) = "" ' radiation, landing commentsok = 0 ' landing statuspanelinit = 0 ' instrumentsparaf = 0 ' parachute flagpif = -1 ' counter for instrumentsplatform = 0 ' for detached DSpower = opower ' thrust factorpowerloss = 0 ' random malfunctionpx! = 320 ' vehicle xpy! = 70 ' vehicle yradiationdeath = 0 ' rads > 1000rads = 0 ' radiation countrlink = 0 ' LM/CM radio linkrmin = RND * 23 ' stars right ascension 0 - 23dmin = (INT(RND * 18) - 9) * t ' stars declination -90 to 90sia = 0 ' shells in airsspinit1 = 0sspinit2 = 0starinit = 0tfollow = 0 ' terrain followingtmt! = 0 ' to move totalwa = 0 ' wanted anglevert = 1 ' vertical autopilot onvsd = 0 ' vehicle severely damaged SetcolorGetSurface 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! = 0ELSE a = RND + t IF RND > pf! THEN a = -a sf = 4 suri = RND * q1 px! = 320 thrust! = 95 vx! = SGN(a) * 5 vy! = RND + 1END 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% activeIF LEDtri THEN LEDc = greenGOSUB ReadLMstart2! = TIMER ' elapsed time clocksec = 0min = 0RETURN 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-6399END IF IF gh = -1 THEN ' ground height = flat LINE (gs, q4)-(q3, q4), gray GOTO stuffEND IF FOR x = gs TO q3 ' graphics start to 639 z = (suri + x) MOD q1 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 = 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 IFNEXT 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 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 iRETURN CommandModule: ' 27 * 9IF ek(0) = -1 THEN RETURNcminview = 1tx = localize(ex(0), 14, 14)IF tx = 999 THEN cminview = 0: GOTO nocmx1 = tx - 14x2 = tx + 14 VIEW SCREEN(gs + 1, 0)-(q3, q4) ' protect panelLINE (x1 + 0, 18)-(x1 + 26, 26), black2, BFFOR 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 diffdbc = ABS(px! - tx) 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 IFEND IF nocm:rlink = rlink - 1 - (rlink = 0) ' allows brief radio interruptionIF rlink = 0 THEN ' lost awhile ago IF convo THEN mes$(0) = " " ' clear current dialogue convo = 0 ' stop conversation sc! = 0 ' talk timerEND 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), yellowEND IFRETURN liftoff: ' forced seperation or surface launchIF (contact OR liftoff) AND (cwd < 69) AND (py! > 322) THEN dead$ = "HIT CAR WASH" RETURNEND IF IF contact THEN vx! = 0IF lob THEN vx! = exv(2): a = 0 ' landed on Borg goy = -h ' AS go yIF ASO THEN ' ascent stage only IF fuel! = 0 THEN RETURN thrust! = h falling = 0 platform = 0 IF lob THEN pminy = borgtELSE 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 seperationEND IF wASO = ASOASO = 1GOSUB ReadLMIF wASO = 0 THEN fuel! = hIF vsd THEN LMdistort IF contact THEN dropvx! = 0 IF lob AND (ABS(px! - center) > 2) THEN dropvx! = exv(1) dropvy! = 0ELSE dropvx! = vx! dropvy! = vy!END IF IF lob OR (contact = 0) THEN wa = 0ELSE wa = SGN(-exv(0)) * 20 ' want angle IF wa = 0 THEN wa = -20END IF sauto = auto: auto = 1contact = 0cut = 0dump = 0hover = 0liftoff = 1lminx = pminxlock1 = 0lockfuel = 0lpass = 0IF wASO = 0 THEN ma = 0mes$(0) = ""mes$(1) = ""np = 0paraf = 0pcontact = 0powerloss = 0psuri = suripy! = py! - 2 ' fool CheckHitsvert = vertvert = 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 IFLOOP UNTIL (alt! > h) OR LEN(dead$) endl:auto = sautocrash = 0deflectat = 0liftoff = 0lock1 = 0platform = 0vert = svertRETURN ReadLM:LMbloadsIF ASO THEN ' ascent stage only lp = 294 nx = 16 ny = 9 rp = 302 th1 = 170 th2 = 198 vmass = 60ELSE ' 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 massEND IF nred = 0 ' number red (volcanic heating)temp = 0 ' temperatureIF bw = 0 THEN PALETTE gasoline, 24xp = 97 ' radarwi = LMx(rp) - LMx(lp) + 1 ' widthwi2 = wi \ 2 IF invincible THEN c = gold ELSE c = gray ' thruster colorFOR 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 iGOSUB LMcolorsRETURN' --------------------------------------------------------------------------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 aDATA DEC PDP/11 with GT40 vector displayDATA terminal at the University of Alberta.DATA The graphic at top left is usually a HenonDATA "plot, dealing with the stability of orbits."DATA The face appearing in TMA-1 when it shootsDATA "is Cybill Shepherd. If you land on TMA-1,"DATA it displays a Mandelbrot. The semaphoresDATA "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/amber/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 stars"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,-2DATA b,1,-2,1,-1DATA c,1,-1,1,0DATA d,0,0,1,0DATA e,0,-1,0,0DATA f,0,-2,0,-1DATA 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 lzDATA "Area 51",65,40,45DATA "Car Wash",100,44,130DATA "Little Green Man",12,0,70DATA "Etna",10,49,20DATA "McDonalds",38,0,80DATA "TMA-1",45,71,80DATA "Surveyor",28,0,80DATA "IBM",50,45,90DATA "Hollywood",170,0,0DATA "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,14DATA DS,150,150DATA BO,58,46DATA BH,200,200DATA Wo,90,90DATA Co,20,100DATA AL,40,40DATA ZZ,1,1 semadata:DATA a 1,225,180DATA b 2,270,180DATA c 3,315,180DATA d 4,0,180DATA e 5,180,45DATA f 6,180,90DATA g 7,180,135DATA h 8,270,225DATA i 9,225,315DATA j,0,90DATA k 0,225,0DATA l,225,45DATA m,225,90DATA n,225,135DATA o,270,315DATA p,270,0DATA q,270,45DATA r,270,90DATA s,270,135DATA t,315,0DATA u,315,45DATA v,0,135DATA w,45,90DATA x,45,135DATA y,315,90DATA z,135,90DATA " ",180,180DATA !,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 * 16DATA " 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 3tinyfontd:DATA 0,7,5,5,5,7DATA 1,2,6,2,2,7DATA 2,7,1,7,4,7DATA 3,7,1,7,1,7DATA 4,5,5,7,1,1DATA 5,7,4,7,1,7DATA 6,7,4,7,5,7DATA 7,7,1,1,1,1DATA 8,7,5,7,5,7DATA 9,7,5,7,1,7DATA .,0,0,0,0,2DATA -,0,0,1,0,0DATA ":",0,2,0,2,0DATA " ",0,0,0,0,0 lmshow:VIEWFOR 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 SLEEPNEXT passRETURN' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 passEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 txEND SUB' -------------------------------------------------------------------------------------------------------xFUNCTION 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 IFEND FUNCTION' -------------------------------------------------------------------------------------------------------xSUB 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$ RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 = sgsEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 airEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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) 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 = 0END SUB' -------------------------------------------------------------------------------------------------------xFUNCTION 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 gety = borgt EXIT FUNCTION END IF END IF gety = gh(xx)END FUNCTION' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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(), PSETEND SUB' -------------------------------------------------------------------------------------------------------xFUNCTION 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 calculatedEND FUNCTION' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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) > x2END SUB' -------------------------------------------------------------------------------------------------------xFUNCTION OnOff$ (v) OnOff$ = MID$("OFFON ", v * 3 + 1, 3)END FUNCTION' -------------------------------------------------------------------------------------------------------xSUB 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 (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' -------------------------------------------------------------------------------------------------------xSUB 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)) 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB PrintVGA (z$, tx, ty, c1, c2) ' VGA font, 8 * 14 PrintLines z$, 0, LEN(z$) * 8 - 1, tx, ty + 13, c1, c2, 1, 1END SUB' -------------------------------------------------------------------------------------------------------xSUB Setcolor ' 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 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 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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' -------------------------------------------------------------------------------------------------------xSUB 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 xoEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 iEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 taEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 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' -------------------------------------------------------------------------------------------------------xSUB 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 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$ = "" ' ugh, all star files in same directory tf1$ = d$ + "si" + zz$: f1$ = tf1$: f1$ = FileCheck$(f1$) tf2$ = d$ + "sx" + zz$: f2$ = tf2$: f1$ = FileCheck$(f2$) tf3$ = d$ + "sy" + zz$: f3$ = tf3$: f1$ = FileCheck$(f3$) isstari = (f1$ <> "") AND (f2$ <> "") AND (f3$ <> "") 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 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 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 FOR k = -30 TO 30 STEP 15 ' exhaust, 5 flames 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 ' 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 END SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 xxEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 zEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 taEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 taEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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(), PSETEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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' -------------------------------------------------------------------------------------------------------xSUB 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 = 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 = 0END SUB' -------------------------------------------------------------------------------------------------------xSUB 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 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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), orangeEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 zEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 IFEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 NEXT xEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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' -------------------------------------------------------------------------------------------------------xSUB 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 = 0END SUB' -------------------------------------------------------------------------------------------------------xSUB dissolve STATIC ' called with } DIM Buffer AS _MEM 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 BufferEND SUB' -------------------------------------------------------------------------------------------------------xSUB 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 ELSEIF cpal = 2 THEN oc&(i) = _RGB32(coav, coav \ 2, 0) ' shades of orange 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 IF (rdtime! > 0) AND (TIMER < rdtime!) AND _FILEEXISTS("rick.jpg") THEN i& = _LOADIMAGE("rick.jpg") ' 87 * 93 pix of author IF i& < -1 THEN tx = _WIDTH - 87 _PUTIMAGE (tx, 0)-(tx + 87, 93), i&, 0 _FREEIMAGE i& _PRINTSTRING (tx + 24, 100), "What?" END IF END IF IF starship AND _FILEEXISTS("starship.jpg") THEN IF shipi& = 0 THEN shipi& = _LOADIMAGE("starship.jpg") ' 296 * 91 shipx = shipx + 4 ty1 = py! - 50: ty2 = ty1 + 91 shipo = shipx - 100 q = 2 gs = 0 IF shipi& < -1 THEN _PUTIMAGE (shipo, ty1 \ q)-(shipo + 296 \ q, ty2 \ q), shipi&, 0 IF shipx > 750 THEN shipx = 0: starship = 0 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' -------------------------------------------------------------------------------------------------------xSUB 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 wd1END SUB' -------------------------------------------------------------------------------------------------------xSUB 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 RETURNEND SUB' -------------------------------------------------------------------------------------------------------xFUNCTION FileCheck$ (f$) i = 0 IF _FILEEXISTS(LCASE$(f$)) THEN f$ = LCASE$(f$): i = 1 IF _FILEEXISTS(UCASE$(f$)) THEN f$ = UCASE$(f$): i = 1 IF i = 0 THEN f$ = "" FileCheck$ = f$END FUNCTION' -------------------------------------------------------------------------------------------------------x

(98 downloads previously)

Navigation

[0] Message Index

Go to full version