' bugs: synch LM with skyobject when moving off screen
' todo: make star position lines proper (curve)
' ideas: when McD bombed, replace with KFC, Starbucks, somehow add Microsoft, Apple, FB, Amazon
' declares retained for documentation
DECLARE SUB AuHoVe
(i
, j
, k
, z
) ' auto/hover/vertical switches DECLARE SUB CybillPix
(tf$
) ' Shepherd pix for TMA kill DECLARE SUB DeathStar
(tx
, tf$
) ' Star Wars / EPCOR DECLARE SUB ExplodeLM
() ' expanding ring of debris DECLARE SUB ExplodeShell
(z
) ' lasered by LM or TMA1 DECLARE SUB FlagandFireworks
' US & Soviet Onion flags DECLARE SUB GetSurface
(z
) ' load sd(emo),sl(evel),s0-10.dat DECLARE SUB Henonp
(tf
) ' color cycling title graphic DECLARE SUB IBM
() ' with tape drive & binary clock DECLARE SUB LEDdisplay
(z$
) ' simulate a Seiko watch DECLARE SUB LGM
(flame
) ' little green man flame count DECLARE SUB MakeSur
() ' create surfaces (demo,level,0-10) DECLARE SUB PrepAndShowLED
(t!
,i
,j
) ' 7 segment displays DECLARE SUB PrintLines
(z$
,i
,j
,x
,y
,c1
,c2
,k
,z
) ' called by PrintVGA DECLARE SUB sprint
(z$
, tx
, ty
, c1
, c2
) ' redundant? DECLARE SUB sprint2
(c$
, x
, y
, c1
, c2
) ' redundant? DECLARE SUB TinyFont
(d$
, tx
, ty
, tc
) ' tiny 3*5 font DECLARE SUB TMA
() ' w/ circle patterns/Mandel/Shepard DECLARE SUB UFO
(tx
, ty
, z
) ' traditional flying saucer DECLARE SUB Wave
() ' warp speed instrument distortion
DIM SHARED bbit
' blinking bit synced to time DIM SHARED bolthit
, bolthitf
, boltx
' Deathstar hit vehicle, feature DIM SHARED borgl
, borgr
, borgt
' left right top, distance DIM SHARED bstyle1
, bstyle2
' Borg matrix/lines/Moire DIM SHARED center
' varies according to gs (graphics start) DIM SHARED cpal
' color palette, normal/green/b&w (32 color kludge/fun) DIM SHARED cwd
, cwsi
, cwsd
' car wash distance, angles DIM SHARED fuel
, fuel!
' color of, quantity left DIM SHARED gh
, glmin
, glmax
' ground height, level DIM SHARED invincible
' impervious to threats DIM SHARED lp
, rp
, xp
, th1
, th2
' pads, radar, thrusters DIM SHARED nation
' 1 US, 2 USSR (flags & fireworks) DIM SHARED ptk
' points to kill (gasoline) ExplodeLM DIM SHARED px!
, py!
' vehicle position on screen DIM SHARED showmap
' locations of things shown at top DIM SHARED starfiles
' use stars1,2 or 3 (few/med/lots) DIM SHARED starstatus
' 0 off, 1 on, 234 more info DIM SHARED sx0
, sy0
' LM radar/laser location DIM SHARED wi
, wi2
' width (distance between pads) DIM SHARED wx!
, wy!
' vehicle position on screen DIM SHARED xoff
' offset for v=5-20, Surv & Etna
DIM SHARED blue
, green
, gunmetal
, red
, gasoline
, gray2
, white
, gray
DIM SHARED dred
, gold
, black2
, orange
, blue2
, yellow
, white2
DIM SHARED q1
, q2
, q3
, q4
, h
, t
, th
, tsix
, aspect!
, pf!
' constants
q1 = 6400: q2 = 860: q3 = 639: q4 = 349: h = 100: th = 200: t = 10: tsix = 360
pf! = .5: aspect! = 1.4: grav! = 1.6
qt = 2000 ' 3 arrays below weren't loading properly with q2
DIM SHARED LMx
(qt
), LMy
(qt
), LMc
(qt
) ' LM+exhaust x,y,color
DIM SHARED LMrx
(1400), LMry
(1400) ' LM+exhaust x,y after rotation DIM SHARED LMoc
(705), LMci
(3) ' LM colors,original colors, index DIM SHARED c!
(360), s!
(360) ' sines and cosines DIM SHARED ex
(6), ey
(6), exv
(6), eyv
(6), ei
(6), ek
(6), exl
(6) ' sky objects DIM SHARED mes$
(1), omes$
(1), sm!
(1) ' messages at screen top DIM SHARED sf
(10, 2), sf$
(10) ' surface features start/end/middle DIM SHARED shx
(20), shy
(20), sha
(20) ' shells (IBM weapons) x,y,angle DIM SHARED shvx
(20), shvy
(20), shd
(20) ' velocity, distance DIM SHARED rtl!
(2), rtlc
(2) ' radiation/temperature/lightning 'DIM SHARED gc(6400) ' ground color
DIM clocka
(2) ' clock angles DIM cmp&
(30) ' CM patterns DIM skyset1
(t
), skyset2
(t
) ' skycrud DIM SHARED p
(127, 13), p2
(127, 7) ' vga and cga fonts
begin:
Evaluate savea, a + ma ' landing feedback contact/currentø
GOSUB pause
' landed, Enter for liftoff
CheckDead:
IF INSTR(" CBE", z$
) = 0 THEN ' not Crashed, Borg, Eaten by BH ExplodeLM
contact = 0
dead$ = ""
Autopilot:
aboveborg = 0
IF (ek
(2) = -1) OR (ek
(2) > h
) THEN borgt
= 0 IF (skyoff
= 0) AND (sy1
< borgt
) AND (px!
> borgl
) AND (px!
< borgr
) THEN aboveborg
= 1 super = 0
i! = alt! / 8 + pf! ' thrust target
IF jitter
AND (alt!
< t
) THEN i!
= i!
* 2 ' optional, faster thrust! = sbest!
super = -(sbest! > h) ' add side thusters
'IF warp! >= 1 THEN super = 0
IF thrust!
> h
THEN thrust!
= h
IF thrust!
< 0 THEN thrust!
= 0
CutOrOutOfFuel:
IF fuel!
= 0 THEN shield
= 0 ' shields need fuel cut = 1
cvy! = vy!
tfollow = 0 ' terrain following
thrust! = 0
idealthrust: ' for hover or descend
IF (alt!
< pf!
) AND (jitter
= 0) THEN i!
= .05 ' soft landing IF hover
THEN i!
= hoverc
' target hoverc
= hoverc
- SGN(hoverc
) ' up/downfmin! = q1 ' conventient large number (6400)
ma! = (vmass + fuel!) / th ' mass (actually 54% fuel)
ts!
= s!
((a
+ 270) MOD tsix
) / ma!
/ power
FOR z!
= 0 TO (h
+ t
) STEP us!
' find best thrust 0-110 fo! = z! * ts!
aa!
= ABS(vy!
+ grav!
+ fo!
- i!
) IF aa!
< fmin!
THEN fmin!
= aa!: sbest!
= z!
GoSkyObject:
auto = 0
a = -ma
wa = -ma
lock1 = 0
suri = ex(p) - center
IF p
> 2 THEN ey
(p
) = th
' BH, worm, comet, alien px! = center
IF p
= 2 THEN py!
= 130 ' above Borg vx! = exv(p)
eyv(p) = 0
KeyAndMouse:
IF mouseswap
THEN SWAP lb
, rb
' whatever floats your boat IF TIMER < ignoreuntil!
THEN lb
= 0: rb
= 0 ' 2 lines for debouncing ww = wa ' stash current wanted angle
wa = wa + lb - rb ' want angle
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 thrust!
= INT(thrust!
) - mw
IF thrust!
< 0 THEN thrust!
= 0 IF thrust!
> h
THEN thrust!
= h
apd = 1 ' autopilot disconnect warning
auto = 0 ' autopilot
hover = 0 ' hover off
vert = 0 ' vertical control off
mw = 0 ' zap
GOTO endk
' don't bother checking keys
status
= PEEK(&H417) ' 7ins 6caps 5num 4scrl 3alt 2ctrl 1ls 0rsIF ((status
AND 1) > 0) AND ((status
AND 2) > 0) THEN vx!
= 901 ' both shift IF status
AND 8 THEN start1!
= TIMER: mpass&
= 0 ' alt, reset speed timer
nfile:
image = image + 1
SaveImage f$
IF i$
= "|" THEN MakeStarFiles
' takes hours!
k = 13 ' transform spacebar to Enter
gotit:
IF (i$
= "\") AND (shx
(0) = 0) AND (contact
= 0) THEN ' LM drops bomb IF (cwd
< 50) AND (sy1
> 300) THEN dead$
= "Smooth move, Exlax!" 'kill self in car wash sia = sia + 1 ' shells in air
shvx
(0) = vx!
+ 3 + RND * t
shvy(0) = 0
shx(0) = suri + sx0
shy(0) = sy0
shd(0) = 1
IF i$
= "[" THEN bw
= bw
XOR 1: Setcolor
' crude method for b&w mes$(0) = "UFO " + OnOff$(ufof)
IF i$
= "=" THEN GOSUB lmshow
' show LM data - pointless but amusing IF i$
= "'" THEN pdiv
= (pdiv
+ 1) MOD 4 ' Henon speed, also slows down thrust display IF radiationdeath
THEN i$
= "":
RETURN ' you're dead and cannot pass this point
IF i$
= "`" THEN ' Deathstar size - thought a smaller one wouuld be faster - it is - not by much dsinit = 0
dstype
= 2 + (MID$(f$
(37), 6, 1) = "m") MID$(f$
(37), 6, 1) = MID$("sm", dstype
, 1) IF i$
= "~" THEN darkstarc
= darkstarc
XOR 1 ' color IF i$
= "@" THEN darkstart
= darkstart
XOR 1 ' thickness
IF inpause
THEN ' hit "p" or landed rmin = 9 ' right ascension
dmin = 30 ' declination
starinit = 0
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 (rmin
+ dmin
) <> rdol
THEN starinit
= 0 ' changed, replot stars
IF i$
= "_" THEN ' star twinkle mes$(0) = "STAR TWINKLE " + OnOff$(twinkle)
IF i$
= ";" THEN fpl
= 1 ' force power loss IF k
= 9 THEN ex
(1) = (suri
+ px!
) - SGN(exv
(1)) * h
' TAB summon DS p
= INSTR(")!@#$%^&*(", i$
)IF p
AND (contact
= 0) THEN GetSurface p
- 1 ' shifted-number for 1 of 10 surfaces p
= INSTR("01234", i$
) ' stars off/on/infoIF k
= 8 THEN ' backspace, random star position rmin
= INT(RND * 24) ' random RA dmin
= (INT(RND * 18) - 9) * t
' random dec starinit = 0
auto = 0
vert = 1
mes$(0) = "TERRAIN FOLLOWING " + OnOff$(tfollow)
p = (i$ = "<") - (i$ = ">") ' jump left/right
suri = suri + 40 * p ' surface index
GOSUB slimit
' limit suri IF lock1
THEN hover
= 1: lock1
= 0 IF (i$
= "+") AND (zoom
< 2) THEN zoom
= zoom
+ 1: starinit
= 0 IF (i$
= "-") AND (zoom
> 0) THEN zoom
= zoom
- 1: starinit
= 0 IF i$
= "?" THEN rick
= rick
XOR 1 ' show speed of processing graph IF okrick
AND (i$
= "U") THEN tilef
= (tilef
+ 1) MOD 3 ' alternate tilings cpal
= (cpal
+ 1) MOD 3 ' cycle green/black & white/normal monitor mes$(0) = "": mes$(1) = ""
IF cpal
= 1 THEN mes$
(0) = "GT40 mode" IF cpal
= 2 THEN mes$
(1) = "Do not adjust your set. We control the horizontal and the vertical!" IF k
= 32 THEN ' cycle thru features IF lock1
> 0 THEN ' on auto, landing zone selected, abort landing abort = 1
mes$(0) = "ABORT!"
IF convo
THEN ' or speed up rendesvous sct! = .2
' 01234567890123456
i$
= MID$("mtsiHg5wleObBWoR", jf
+ 1, 1) ' cycle thru ground and sky features IF demo
AND (jf
= 7) THEN i$
= "e" ' skip LGM in demo, because it's on the grave
p
= INSTR("RObBWo", i$
) ' jump to CM, deathstar, etc.
lam
= lam
XOR 1 ' land at McDonalds IF lam
AND (auto
= 0) THEN i$
= "a" ' turn on autopilot abort = 0 ' in case it was on
tfollow = 0
auto
= auto
XOR 1 ' toggle IF auto
= 0 THEN hover
= 1 ' be nice, help user pt!
= TIMER ' restart countdownIF i$
= "D" THEN restart
= 1 ' restart with defaults IF (i$
= "E") AND (starstatus
> 0) THEN ' end of universe IF eou
= 0 THEN eou
= -1 ELSE eou
= eou
+ 1 ' restart or speedup fuel! = h
lockfuel = 1
IF i$
= "f" THEN lockfuel
= lockfuel
XOR 1 ' THIS cheat the GT40 had, using toggle switches! IF i$
= "G" THEN gstyle
= (gstyle
+ 1) MOD 6 ' ground style IF i$
= "h" THEN hover
= hover
XOR 1: apd
= 1 ' apd=autopilot disconnect warning invincible
= ABS(invincible
) XOR 1 mes$(0) = "INVINCIBLE MODE " + OnOff$(invincible)
GOSUB ReadLM
' to change thrusters darkstars
= (darkstars
+ 1) MOD 5 mes$
(0) = "Deathstar rotation" + STR$(darkstars
)IF i$
= "k" THEN ' kill threats or, if none, shoot at ground feature firel = 1 ' fire laser
FOR z
= 1 TO 20 ' IBM shells shd(z) = 1
IF i$
= "L" THEN GetSurface
-1 ' level ground IF (i$
= "M") AND ((contact
+ inpause
) = 0) THEN ' laser level & land magic = magic + 1
IF (i$
= "n") AND inpause
THEN nation
= ((nation
- 1) XOR 1) + 1 ' flag 1 US, 2 USSR paraf = 1 ' parachute!
chs = 0
a = 0
oscar
= oscar
XOR 1 ' land or sea flags for LGM mes$(0) = "LGM flags: " + z$
cut = 0
hover = 1
power = opower
powerloss = 0
radarf
= (radarf
+ 1) MOD 3 mes$
(0) = "Radar " + MID$("OFFON FAT", radarf
* 3 + 1, 3)IF i$
= "S" THEN MakeSur: restart
= 1 ' generate new surfaces IF i$
= "T" THEN jitter
= jitter
XOR 1 ' thrust computation IF i$
= "u" THEN ' instrument panel on/off zz = gs
gs
= (SGN(gs
) XOR 1) * 85 ' graphics start
panelinit = 0
pif = -1
z = (gs + 30) - px!
px! = px! + z
suri = suri - z
IF i$
= "v" THEN ' vertical automatic tfollow = 0
mes$(0) = "TERRAIN FOLLOWING OFF"
apd = 1 ' autopilot disconnect warning
IF i$
= "x" THEN starinit
= 0: starfiles
= (starfiles
+ 1) MOD 3 ' star density IF i$
= "X" THEN starinit
= 0: regen
= 1: Stars
' regenerate single star file mouseswap
= mouseswap
XOR 1 IF mouseswap
THEN z$
= "reversed" ELSE z$
= "normal" mes$(0) = "Mouse buttons " + z$
IF i$
= "Y" THEN min
= 3: sec
= 45 ' black hole at 3:50 mes$(0) = "" '
mes$(1) = "" ' erase radiation messages
dead$ = "SELF-DESTRUCT"
sgs = gs: gs = 0
srf = radarf: radarf = 0
dissolve
dead$ = " "
gs = sgs: radarf = srf
' 1234567890
p
= INSTR("5wlemtsiHg", i$
) ' jump to feature sf = p
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
px! = center ' move ship to screen center
suri = sf(sf, 0) - center - 30 - (sf = 9) * h ' move ground to IBM
a = -ma ' angle = -malfunction angle
abort = 0
wa = -ma ' want angle
lock1 = 0 ' radar lock
tmt! = 0 ' to move total
vx! = 0 ' not moving
warp! = 0 ' cancel warp
GOTO endk
' done with ordinary keys
is2: ' extended key
z = mdelay ' master delay
mdelay = mdelay - (k = 73) + (k = 81) ' PgUp/PgDn
mes$
(0) = "_LIMIT " + OnOff$
(SGN(mdelay
)) IF k
= 72 THEN k
= 201 ' LM up IF k
= 75 THEN k
= 203 ' LM left IF k
= 77 THEN k
= 204 ' LM right IF (inpause
= 0) AND ((k
= 72) OR (k
= 80)) THEN ' up and down arrow apd = 1 ' autopilot disconnect
hover = 0
vert = 0
thrust! = thrust! + (k = 80) - (k = 72) ' true = -1
thrust!
= INT(thrust!
* t
) / t
' t = 10IF thrust!
> h
THEN thrust!
= h
IF (dump
= 0) AND (fuel!
> 0) AND (contact
= 0) THEN ' side thrust/angle IF inpause
= 0 THEN wa
= a
- (k
= 75) + (k
= 77) ' left/right arrows IF ABS(wa
) > 99 THEN wa
= 99 * SGN(wa
) ' want angle, limit 99 IF a
<> wa
THEN apd
= 1 ' autopilot disconnect mHelp
start1!
= TIMER: mpass&
= 0 ' reset speed timer cbh = demo ' constant black holes
IF k
= 61 THEN ' F3, sky feature toggle mes$(0) = "SKY OBJECTS " + OnOff$(1 - skyoff)
IF k
= 62 THEN ' F4 endless bh exv(3) = 0
mes$(0) = "CONSTANT BLACK HOLES " + OnOff$(cbh)
IF k
= 63 THEN ' F5 instrument background f5toggle
= f5toggle
XOR 1 IF f5toggle
= 0 THEN background
= background
XOR 1 pload = 0
IF (k
= 64) AND ((ASO
+ inpause
) = 0) THEN ' F6 seperate AS/DS IF k
= 65 THEN showmap
= showmap
XOR 1 ' F7 map geof = shield * t
LEDtri = 0
IF k
= 68 THEN ' F10 LED tri-color IF k
= 71 THEN rmin
= 0: dmin
= 0: starinit
= 0 ' Home, star RA/dec to 0
endk:
IF k
= 201 THEN hoverc
= hoverc
- t
' move up IF k
= 203 AND (left
= 0) THEN left
= 16 ' move left IF k
= 204 AND (right
= 0) THEN right
= 16 ' move right IF apd
OR (k
= 201) OR (k
= 203) OR (k
= 204) THEN ' blink AUTO IF auto
THEN APdisengage
= 20 ' blink 20 times auto = 0 ' turn it off
apd = 0 ' reset flag
pause:
dead$ = ""
inpause = 1
pt!
= TIMER ' for demo modewu! = pt! + 1 ' delay before planting flag
IF auto
AND contact
THEN ' countdown to blast off z = t - z!
IF z!
> t
THEN i$
= CHR$(13) ' like pressing the key fb$ = "" ' feedback
inpause = 0
c
= (contact
= 1) AND (crash
= 0) AND (liftoff
= 0) AND (ABS(a
) < 31)
CalculateMotion:
i = 0
i
= ((auto
+ contact
+ liftoff
+ vert
) = 0) AND ((min
* 60 + sec
) > t
) 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!"
IF lob
THEN px!
= px!
+ exv
(2) ' landed on Borg
ta
= ((a
+ ma
) + 270) MOD tsix
' temp angle = a+malfunction anglema! = (vmass + fuel!) / th ' actually 54% fuel
fo! = ((thrust! + super * 5) / ma!) / power ' f = ma
IF fuel!
= 0 THEN fo!
= 0 ' nix any force if running on empty fx! = fo! * c!(ta) / 2
fy! = fo! * s!(ta) + grav! ' thrust + gravity
IF warp!
> 0 THEN fx!
= fx!
* (warp!
* 2 + 1) ' get thru warp msgs faster vx! = vx! - fx!
IF a
<> 0 THEN vx!
= vx!
+ (RND - pf!
) / h
' help get to integer vx cel!
= TIMER - ctime!
' time since cut vy! = cvy! + grav! * (cel! * cel!) ' v = at^2 velocity = acceleration times time squared
fy! = 0 ' null y force since it's a different situation
vy! = vy! + fy!
px! = px! + vx! - lob * exv(2)
py! = py! + vy!
IF (liftoff
= 0) AND (py!
< 55) THEN ' stop going off screen top IF convo
= 0 THEN mes$
(0) = "Too high - reduce thrust!" py! = 55
vy! = 0
other:
nomove
= demo
AND (((suri \ q3
) + 1) = 5)
zz = px! - center
dx! = px! - center
px! = center
tmt! = tmt! + dx!
zq = 0 ' was 30 woof woof
c1 = (px! <= (gs + zq))
c2 = (px! >= (q3 - zq))
z = z - px!
tmt! = tmt! - z
px! = px! + z
z = zz \ 2 + 1
tmt! = tmt! + z
px! = px! - z
IF left
THEN ' jog left (shift left arrow) left = left - 1
IF left
= 0 THEN a
= 0: vx!
= sv!
IF right
THEN ' jog right (shift right arrow) right = right - 1
IF right
= 0 THEN a
= 0: vx!
= sv!
CalcFuel:
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 shield
THEN used!
= used!
+ .001 fuel! = fuel! - used! * 4
Plotscreen:
bbit
= bbit
XOR 1 ' toggles twice per second, used all over - instruments, IBM hazard lights, clock colon, LGM ear wiggle bit! = 0
bolthit = 0
bolthitf = 0
IF warp!
>= 1 THEN paraf
= 0 ' reckon parachute can be dropped at warp speeds
' change styles every 10/30 seconds
IF style!
> 86400 THEN style!
= 1 ' midnite xing bstyle1
= (bstyle1
+ 1) MOD 3 ' Borg guts every 10s IF bstyle1
= 0 THEN bstyle2
= bstyle2
XOR 1 ' Borg exhaust style! = 0
IF (starstatus
> 0) AND (eou
= 0) AND (vert
= 0) AND (RND > .9999) THEN ' stars on+not already falling+WHY?+rarely mes$(0) = "THE SKY IS FALLING! THE SKY IS FALLING!"
eou = 1
IF gs
THEN ' graphics start not 0, instruments are visible pif
= (pif
+ 1) MOD (pdiv
+ 1) Stars ' STARS
Info ' INFO show timed messages at top, if any
'VIEW SCREEN(gs, 0)-(q3, q4)
IF warp!
< 1 THEN ' no sky features except star streaks at warp speeds GOSUB PlotGround
' GROUND/FEATURES Shells ' SHELLS
IF platform
THEN PUT (pminx
, pminy
), gbuff
(), OR ' falling descent stage Map ' LM, ground & sky features
IF bolthit
THEN ' lightning zap from Deathstar boltc = boltc + 1 + (boltc = 9999)
rtlc(2) = boltc
IF ((invincible
+ shield
) = 0) AND (boltc
>= t
) THEN dead$
= "Zapped!" ' by EPCOR!"
timemachine
SkyStuff:
IF (min
= 3) AND (sec
= 50) THEN ' Tree-fiddy! (Southpark), do black hole ex(3) = suri + t
ey(3) = h
exv(3) = t
eyv(3) = 1
exv(0) = exv(0) + 2
IF eou
THEN mi
= 2 ELSE mi
= 5 ' end of universe, no celestial events FOR i
= 0 TO mi
' 0CM 1DS 2Borg 3BH 4Worm 5Comet 6Al READ g$
, skyset1
(i
), skyset2
(i
)
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 (ey
(i
) > (q4
+ 50)) OR (ey
(i
) < -50) OR (exv
(i
) = 0) THEN ei(i) = 0 ' ini
ek(i) = 9999
nx:
IF ABS(ex
(i
) - (px!
+ suri
)) < q3
THEN GOTO nx
' start away from craft ey
(i
) = 120 + RND * h
' random y 120-220 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
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
ex(i) = suri - t
exv(i) = t
ex(i) = suri + q3 + t
exv(i) = -t
ex(i) = ex(i) + exv(i)
ey(i) = ey(i) + eyv(i)
ek(i) = -1: cmleaving = 0
ex(i) = ex(i) + q1
ek(i) = -1: cmleaving = 0
ex(i) = ex(i) - q1
exl(i) = localize(ex(i), xplus, xminus)
IF ek
(i
) <> -1 THEN ek
(i
) = 9999 ek
(i
) = SQR(dx!
* dx!
+ dy!
* dy!
)
IF i
= 1 THEN DeathStar exl
(i
), f$
(37) IF i
= 2 THEN Borg exl
(i
), ey
(i
) mes$(0) = "DANGER, WILL ROBINSON, DANGER!"
sas = 0
tx = localize(ex(5), 0, 0)
ty = ey(5)
Comet tx, ty
IF i
= 6 THEN ' traditional alien - too silly z = ey(6) + j
ey(6) = z
ex
(6) = ex
(6) + 20 * SGN(alien
- pf!
) UFO exl(6), ey(6), exv(6)
ni2:
FiveWaysToDie:
mes$(0) = "YOU ARE BORG"
Info
Borg exl(2), ey(2)
p
= POINT(LMrx
(i
), LMry
(i
)) PSET (LMrx
(i
), LMry
(i
)), c
timemachine
dead$ = "BORG"
IF (ek
(3) >= 0) AND (ek
(3) < 30) THEN ' black hole dead$ = "EATEN"
BlackHoleDoom
IF (ek
(4) >= 0) AND (ek
(4) < 30) THEN ' wormhole spx! = exl(4)
spy! = ey(4)
exv(4) = 0
eyv(4) = 0
wradar = radarf
radarf = 1
cut = 1
fb$ = ""
mes$(0) = "HOLY CRAP, BATMAN!"
mes$(1) = ""
Info
px!
= spx!
+ (RND - pf!
) * 20 py!
= spy!
+ (RND - pf!
) * 5 WormHole
LMdistort ' optional
timemachine
radarf = wradar
dead$ = "BATMAN"
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"
GetAlt:
alt! = (gety(-(rxm + wi2)) - ((sy1 + sy2) \ 2)) / 5
Instruments:
osc = 8
IF gs
THEN LoadPanel
' graphics start not zero, instrument panel is on dead$ = "WARP 10"
mes$(0) = "WARP " + w$ + " - " + z$
Henonp f
Wave ' osc = 5 if commented out
AuHoVe auto, hover, vert, lam
IF gs
= 0 THEN RETURN ' graphics start of 0 means the instrument panel is off
IF crash
THEN f
= 15 ELSE f
= ((f
+ 1) MOD 5) + t
' title graphic/face
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
IF (contact
+ auto
+ hover
+ vert
+ liftoff
) = 0 THEN IF (vy!
> .6) AND (-fy!
< 0) THEN PrintVGA
CHR$(24), 5, 241, red
, black2
IF (vy!
< .4) AND (-fy!
> -.01) THEN PrintVGA
CHR$(25), 5, 250, yellow
, black2
AuHoVe auto, hover, vert, lam
IF tfollow
THEN ' terrain following! FOR ty
= glmax
- 20 TO glmax
p&
= VAL("&H" + MID$("E744464444", i
* 2 + 1, 2)) LINE (2, 339 + i
)-(10, 339 + i
), green
, , p&
* 128
osc = 0
c = LEDc
IF (sbest!
>= h
) OR powerloss
THEN c
= red
z!
= thrust!:
IF z!
> h
THEN z!
= h
' 200 at liftoff, show 100PrepAndShowLED z!, 3, 1 ' thrust osc1
PrintCGA "T", 5, -1, c, -blue, 0 ' T is for flame
i = LEDc: j = black
LINE (4, 231)-(5, 232), i
, B
' left light (on = slow) LINE (13, 231)-(14, 232), j
, B
' right light (on = fast) Bar z! / h, 0
c = dcolor(vy!, 2, 3, 1) ' vy osc2
z! = vy!
PrepAndShowLED z!, 3, 2
PrintCGA "V", 5, -1, c, -blue2, 0
z! = (z! + 3) / 6
Bar z!, 1
c = dcolor(vx!, 2, 3, 1) ' vx osc3
z! = warp!
z! = vx! + rfs!
PrepAndShowLED z!, 3, 2
PrintCGA "H", 5, -1, c, -blue, 0
z! = (z! + 3) / 6
Bar z!, 1
c = dcolor(alt!, t, 3, -1)
PrepAndShowLED alt!, 4, 1
PrintCGA "A", 5, -1, c, -blue2, 0
Bar z!, 0
'IF rick = 1 THEN
'zz = ((suri + px!) MOD q1) \ (q3 + 1) + 1
'TinyFont LTRIM$(STR$(zz)), 11, 125, LEDc ' optional area
'TinyFont LTRIM$(STR$(gh)), 11, 131, LEDc ' " ground
'END IF
c = dcolor(fuel!, t, 5, -1) ' fuel osc5
PrepAndShowLED fuel!, 4, 1
PrintCGA "F", 5, -1, c, -blue, 0
z! = fuel! / h
Bar z!, 0
clock:
IF crash
= 0 THEN el!
= el!
+ (TIMER - start2!
) ' elapsed time WHILE el!
>= 1 ' catch-up el! = el! - 1
osc = 6
LEDdisplay z$ ' clock osc6
i = suri + px!
k = sf(5, 2) + (q1 - i)
PrepAndShowLED dtm!, 4, 0 ' dtm osc7
PrepAndShowLED
CSNG(speed
), 4, 0 ' speed osc8
ShowAngle a ' angle osc9
'IF rick > 0 THEN ' show stats
' FOR i = -2 TO 0
' z$ = STR$(FRE(i))
' IF i = -2 THEN z$ = " " + MID$(f$(38), 6, 1) + z$ ' star file
' TinyFont z$, 3, 295 + i * 6, gunmetal
' NEXT i
' PrintCGA MID$("DOSBOX", dosbox * 3 + 1, 3), 3, 270, red, black, 0
'END IF
panelinit = 1
LMcolors: ' optional
FOR i
= 1 TO rp
' right pad oc = LMoc(i)
LMc(i) = oc
IF (oc
= craft
) OR (oc
= red
) THEN ' shadow zx = LMrx(i) - px! + 2 - xoff * (inpause = 0)
zy = LMry(i) - py!
tc = gray2
tc = oc
LMc(i) = tc
IF (i
< 279) AND (LMoc
(i
) = black2
) THEN ' Ascent stage cycle LMc(i) = LMci(lbit)
lbit = lbit - (vx! > 0) * 2 + ASO * t
PlotVehicle:
wda = 0
px! = wx!: py! = wy!
wda
= warp!
* 5 * s!
((px!
+ 40) MOD tsix
)
PSET (LMrx
(i
), LMry
(i
)), LMc
(i
)
i = sf(4, 2) - 50 ' left of volcano
j = sf(4, 2) + 50 ' right of volcano
k = suri + px! ' LM position
IF (k
> i
) AND (k
< j
) THEN ' in the locality? c = 0 ' count
FOR ty
= py!
+ 8 TO py!
+ 18 ' leg/nozzle area FOR tx
= px!
- 17 TO px!
+ 17 p
= POINT(tx
, ty
) ' what color is the pixel? c = c - (p = orange) ' hot lava
' LINE (px! - 17, py! + 8)-(px! + 17, py! + 18), yellow, B ' diagnostics
IF c
THEN ' contacted some lava IF LMoc
(i
) = craft
THEN ' is normal color? LMoc(i) = red ' make red
nred = nred + 1 ' keep track of count
c = c - 1
temp = 0
rtlc(1) = 0
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
c = 24 ' gasoline
IF temp
> 30 THEN c
= 32 ' dark red IF temp
= h
THEN c
= 15 ' white IF (temp
= h
) AND (invincible
= 0) THEN dead$
= "FRIED BY VOLCANO" FOR i
= 0 TO 20 ' cool down some IF LMoc
(j
) = red
THEN LMoc
(j
) = craft: nred
= nred
- 1
n = rp ' last pixel = right pad
'IF maxn > 1400 THEN END ' beyond array size
'debug$ = LTRIM$(STR$(maxn))
ta = a + ma ' temp a = a + malfunction
zz
= ta
* -(ABS(ta
) > 4) ' rotate beyond 5 degreesta
= (zz
+ wda
+ tsix
) MOD tsix
' keep in array boundsc! = c!(ta) ' cosine
s! = s!(ta) ' sine
ta = zz ' angle to use
rfx = 0 ' optional craft jitter
rfy = 0
rfs! = 0 ' random change in vx
IF (jitter
= 1) AND (cut
= 0) THEN ' not slow or engine cut rfs!
= rfx
* .01 * (INT(RND * 9) + 1) ' how much? .01 - .09
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
ao = 0 ' angle offset
tao = ao * tvx
z3 = tsix + (shield = 0) * 361
a2
= (z2
+ tao
* 5 + tsix0
) MOD tsix
tx = px! + 50 * c!(a2) * aspect!
ty = py! + 50 * s!(a2)
CIRCLE (tx
, ty
), 1, tc
, , , .75 tx2 = px! + 60 * c!(j) * aspect!
ty2 = py! + 60 * s!(j)
LINE (tx
, ty
)-(tx2
, ty2
), tc
c
= VAL(MID$("021404", i
* 2 + 1, 2)) CIRCLE (tx
, ty
), 4 - i
, c
, , , .75
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
)
'PSET (sx3, sy3), green ' eh?
'FOR ii = -1 TO 1
'FOR jj = -1 TO 1
'PSET (sx3 + ii, sy3 + jj), green
'NEXT jj
'NEXT ii
eflag = 0 ' determine flame climb
fx1 = 0 ' initialize for deflect
fx2 = 0
phg = (sx1 + sx2) \ 2 + ta * 2 ' point hit ground
tty! = py! + 26
FOR i
= rp
+ 1 TO n
' flame/fuel dump x = px! + LMx(i) * c! + LMy(i) * s! + rfx ' x rotated
y = py! - LMx(i) * s! + LMy(i) * c! + rfy ' y rotated
c = LMc(i) ' fuel dump/flame
PSET (x
, y
), c
' flame particle IF i
<= n3
THEN ' main exhaust LINE (x
- 1, y
)-(x
+ 1, y
), c
' make "+" LINE (x
, y
- 1)-(x
, y
+ 1), c
IF rfx
AND dump
AND (a
= 0) THEN vx!
= vx!
+ rfs!
' make jitter real
endproc:
'IF showspeed THEN TextOnLM$ = LTRIM$(STR$(speed))
fc = 0 ' LGM flame count
IF (sf
(3, 1) >= suri
) AND (sf
(3, 0) < (suri
+ q3
)) THEN x1 = sf(3, 0) - suri
y1 = gety(x1) - 14
FOR x
= x1
+ 5 TO x1
+ 15 FOR y
= y1
- 9 TO y1
+ 12
geof = geof - 1 - (geof = 0)
mpass& = mpass& + 1
speed
= ((TIMER - start1!
) / mpass&
) * h
* t
IF magic
= 1 THEN ' magic landing, 1st step laser the surface to level sf = 0
z = suri + px!
sf(0, 0) = z - 35 ' cut out a swath 70 units wide
sf(0, 1) = z + 35
GOSUB lsurface
' apply laser a = 0 ' angle
auto = 0 ' autopilot
vx! = 0 ' cancel any x velocity
vy! = 0 ' cancel any y velocity
py! = 331 + ASO * 9 ' ground has been cut to the lowest
cut = 1 ' signal engine off
magic = 2
' kill surface feature
firel = ks ' ks = keep shooting
' terrain following
hover = 1
hp = q1
j = tx + i * svx
k = j
z = gety(k)
cy
= hp
- t
- ABS(a
/ 2) - sy1
st!
= cy
/ cx
* (ABS(vx!
) + 1) py! = py! + st!
IF py!
> 150 THEN mes$
(0) = "Parachutes don't work in a vacuum!" Parachute
TextOnLM:
tx = px! - lt * 2 + rfx
ty = py! + rfy
TinyFont TextOnLM$, tx, ty, white
TextOnLM$ = ""
KillThreats:
killed = 0
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 killed = 1 ' found something to kill
tx = shx(i) - suri
ty = shy(i)
GOSUB LMfl
' fl = fire laser ExplodeShell i
ks = 0
' CM DS BO BH WO Co
' kd = VAL(MID$(" 80150120 50 50 50", i * 3 + 1, 3))
' c1 = shield AND c0 AND (ek(i) < kd)
' IF (i = 2) AND (sy1 < borgt) THEN c1 = 0
' c2 = firel AND c0
killed = 1
ks = 1
tx = exl(i)
ty = ey(i)
k = (5 - laserb) * 4
PAINT (tx
, ty
), yellow
, yellow
laserb = laserb - 1
ks = 0
mes$(1) = "The Dark Side has cookies!"
x2
= tx
+ RND * h
* c!
(a2
) * aspect!
y2
= ty
+ RND * h
* s!
(a2
) LINE (tx
, ty
)-(x2
, y2
), gold
ek(i) = -1
exv(i) = 0
exl(i) = -1
IF (i
= 2) AND lob
THEN dead$
= "SELF-DESTRUCT" ni3:
lsurface: ' laser surface feature
z
= (RND > .9) OR (magic
= 1) ' 1 out of 10 destroys, magic alwaysFOR i
= sf
(sf
, 0) TO sf
(sf
, 1) tx = i - suri
ty = gety(tx)
IF z
THEN gh
(i
) = glmax
' level Smooth sf
(sf
, 0) - 1 ' smooth transition from where the ground has been leveled, left side Smooth sf
(sf
, 1) ' , right side sf(sf, 2) = -1
LMfl: ' fire laser
IF (cwd
< 50) AND (sy1
> szs
) THEN ' in car wash? dead$ = "REFLECTED LASER"
cwd = 999
firel = 0
laserb = 0
ks = 0
LINE (sx0
+ zx
, sy0
+ zy
)-(tx
, ty
), lmsl
geof = t
flevel: ' make fuel level when angle > 4
ptk = (h - fuel!) * 2.7 ' pixels to kill
z = ptk ' ptk used by ExplodeLM
x1 = px! - 16
x2 = px! + 14
y1 = py! - 15
y2 = py! + 15
'LINE (x1, y1)-(x2, y2), red, B
z = z - 1
deflect: ' flame bounce
oz = gety(-x)
IF deflectat
> 0 THEN oz
= deflectat
z = oz
' dump side t st in pause
IF (c
= fuel
) OR (c
= -yellow
) OR (c
= -blue
) THEN IF y
>= (z
- 1) THEN ' yep, deflect it IF fx1
= 0 THEN fx1
= x: fy1
= LMry
(th1
) x = fx1 + rf1
y = fy1 + rf2
IF fx2
= 0 THEN fx2
= x: fy2
= LMry
(th2
) x = fx2 - rf1
y = fy2 + rf2
IF y
>= (z
- 1) THEN ' yep, deflect it ' IF aboveborg THEN ky1 = 1: GOTO isborg
IF eflag
= 0 THEN ' limit flame climbing eflag = 1 ' only once per position
xmin2 = phg - thrust! * 1.5 ' point hit ground
xmax2 = phg + thrust! * 1.5
u1 = 0 ' up count l of nozzle
u2 = 0 ' up count r of nozzle
wu1 = 0 ' worst l up count
wu2 = 0 ' worst r up count
ky1 = 0 ' keep y
ky2 = 0 ' keep y
FOR zz
= phg
TO phg
- h
STEP -1 ' from LM center left z2
= gety
(-zz
):
IF zz
= phg
THEN lz
= z2
k1 = z2 - lz
lz = z2
u1 = 0
u1 = u1 - k1 ' up
IF u1
> wu1
THEN wu1
= u1
' worst up IF ABS(k1
) > 20 THEN ky1
= 1 ' 90 degrees TMA etc FOR zz
= phg
TO phg
+ h
' from LM center right z2
= gety
(-zz
):
IF zz
= phg
THEN lz
= z2
k2 = z2 - lz
lz = z2
u2 = 0
u2 = u2 - k2 ' up
IF u2
> wu2
THEN wu2
= u2
' worst up IF ABS(k2
) > 20 THEN ky2
= 1 ' 90 degrees TMA etc
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
IF x
< xmin2
THEN x
= xmin2
+ RND * (xmax2
- xmin2
) + x2
IF x
> xmax2
THEN x
= xmin2
+ RND * (xmax2
- xmin2
) - x2
y = y - platform
y
= gety
(-x
) - RND * k
- 1
IF (deflectat
> 0) AND (y
> deflectat
) THEN y
= deflectat
- (y
- deflectat
)
CWceiling: ' car wash
cwd
= ABS((suri
+ px!
) - sf
(2, 2)) ' car wash distanceIF ASO
THEN szs
= 323 ELSE szs
= 340 ' safe zone start IF (cwd
< 69) AND (sy1
> 304) THEN ' lower than top of building IF sy1
>= q4
THEN ' touched down inside cc1 = -1
cc2 = -1
cc1 = 0
cc2 = 0
IF cwd
< 50 THEN mes$
(0) = "Washee washee no starchee!" IF (sy1
> (szs
- t
)) AND (sy1
<= szs
) THEN ' bouncing off ceiling cc1 = 0
cc2 = 0
vy! = 1
py! = py! + 2
'hover = 1
CheckHit: ' contact with ground
cc1 = ((sy1 + 1) >= gety(-sx1)) ' left pad
cc2 = ((sy2 + 1) >= gety(-sx2)) ' right pad
mingx = 0
mingy = q1
FOR zx
= sx1
TO sx2
' check between pads zy = sy1 - 2
ty = gety(-zx)
IF ty
< mingy
THEN mingx
= zx: mingy
= ty
i = mingx - sx1
j = sx2 - mingx
GOSUB CWceiling
' car wash
contact = 1
tmt! = 0
py! = py! + rfy ' no time to correct jitter
TexOnLM$ = ""
warp! = 0
lob = 1 ' landed on Borg
vx! = vx! - exv(2)
dead$ = "HIGH SPEED IMPACT!"
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 PALETTE green
, 0 ' blank instruments 'PALETTE red, 32
IF (vy!
> 3) OR (ABS(vx!
) > 3) THEN fb$
= "vehicle damaged"
fb$ = "vehicle severely damaged"
LMdistort ' randomly vary structure
vsd = 1 ' vehicle severely damaged
savea = a + ma
a = 0
py!
= py!
- t
* (ABS(a
) = 45)
' 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 cpx = cpx + cd
npass = 0
a = a + (cc1 - cc2)
pa:
npass = npass + 1
GOSUB Plotscreen
' show change a = 180 ' upside down
py! = glmax - ny
LMdistort ' optional
cc3 = ((sy1 + 1) >= gety(-sx1))
cc4 = ((sy2 + 1) >= gety(-sx2))
z
= gety
(INT(px!
)) - py!
- ny
+ 5 dead$ = "PUNCTURE DAMAGE"
slimit: ' surface index bounds
z = 0
suri = suri + z
IF lock1
THEN lock1
= lock1
+ z
radar: ' autopilot landing here too
IF (tfollow
= 0) AND (aboveborg
OR ((radarf
= 0) AND (auto
= 0))) THEN tvx!
= 0 bl
= sbl
* ABS(tvx!
) + (sx1
- sx2
)IF lock1
= 0 THEN rxm
= sx2
+ bl
ELSE rxm
= lock1
- suri
level = 1
FOR j
= 0 TO wi
' width (distance between pads) tx = rxm + j
ty = gety(-tx)
IF aboveborg
AND (sx1
>= borgl
) AND (sx2
<= borgr
) THEN ty
= borgt
IF auto
AND (lock1
= 0) THEN ' automatic yet no current lock lock1
= suri
+ rxm
- SGN(rxm
) * 2 * (vx!
<> 0) ' lock onto level ground rbeam = green ' radar beam color
lock1 = 0 ' not level, cancel lock
rbeam = red ' radar beam color
'IF lock1 <> olock1 THEN
' LOCATE 2, 10: PRINT lock1; olock1;
' timemachine
' WHILE INKEY$ = "": WEND
' olock1 = lock1
'END IF
div = div \ 2
IF vx!
> 0 THEN tx
= rxm
+ i
ELSE tx
= rxm
+ wi
- i
tx = sx1 + i
ty = borgt
ty = gety(tx)
abort:
hover = 1
hoverc = 0
lock1 = 0
i = (py! > 120) ' too low
j
= NOT ((vx!
= 0) AND (level
= 1)) AND (ABS(vx!
) < (ideal!
- .05)) ' too slowk
= (ABS(vx!
) > (ideal!
+ .05)) ' too fastIF i
THEN wa
= -ma: hoverc
= -3 abort = 0
skipit:
IF lam
THEN ' land at McDonalds dis
= ABS((suri
+ rxm
) - sf
(5, 2)) IF dis
> 80 THEN level
= 0: lock1
= 0 wa = -ma ' want angle = -malfunction angle
IF dflag
THEN dump
= 0: dflag
= 0 IF level
= 0 THEN ' locked onto a target abort = 1
dump = 1
dflag = 1
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 okrick THEN
' LOCATE 3, 11: PRINT dist;
' LOCATE 4, 11: PRINT vx!;
' END IF
' IF (SGN(vx!) = SGN(dist)) OR (ABS(vx!) > thv!) THEN wa = wa + mu * z
end6:
rbeam:
dx! = (tx - sx0) / div
dy! = (ty - sy0) / div
tx = sx0 + j * dx!
ty = sy0 + j * dy!
my = gety(-tx)
IF (tx
< rxm
) OR (tx
> (rxm
+ wi
+ 1)) THEN level
= 0: rbeam
= red
angle:
cf = 0
IF a
<> wa
THEN ' current angle, wanted angle w = a ' was = angle
change = a - w
cf = 1
IF (a1
> 4) OR (a2
> 4) THEN wan
= 3 ' activate up/down
cp
= (a
<> 0) AND (RND < .01) ' clear problem
z = ma
IF ma
<> z
THEN ' new malfunction angle mes$(0) = "DANGER! STUCK THRUSTER " + z$
IF auto
THEN a
= a
- ma: wa
= a
- ma
' immediate correct mes$(0) = "THRUSTERS OK"
IF auto
THEN a
= a
+ z: wa
= a
+ z
' immediate correct
Exhaust:
d
= thrust!
- (RND * 20 - t
) * (thrust!
> 0)x = (LMx(lp) + LMx(rp)) \ 2 ' halfway between pads
IF ASO
THEN ' ascent stage only i = 30 ' divisor for exhaust width
j = 1 ' throwing x off up to this amount
k = 3 ' flame decrement
y = ny + 1 ' starting y
i = 20 ' divisor for exhaust width
j = 2 ' throwing x off up to this amount
k = 2 ' flame decrement
y = ny - 3 ' starting y
WHILE d
> 0 ' until thrust decremented to 0 p = d \ i
n = n + 1 ' add to vehicle daa
LMx
(n
) = x
+ p
* z
+ RND * (j
* 2) - j
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
y = y + 1 ' next flame row
d = d - k ' decrement temp thrust
n3 = n ' main/side thrusters
' if there's a thruster malfunction, may have both thrusters active
ta = a + ma
pass = 1
ta = a
pass = 2
dors: ' dump fuel or sideways motion
IF (contact
= 1) AND (dump
= 0) THEN ta
= 0: wan
= 0: super
= 0 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
)) n = n + 1
LMx
(n
) = LMx
(th0
) + z!
+ RND * 2 - 1 LMy
(n
) = LMy
(th0
) + (RND * 2 - 1) * (ABS(ta
) > 2) tc = fuel
z = 20 - 20 * s!(90 + (LMx(n) - LMx(th0)) * 1.8)
LMy(n) = LMy(n) + z
tc = -tflame
LMc(n) = tc
tt = tt - 1
z! = z! * 1.15
ta = -ta
IF lockfuel
= 0 THEN fuel!
= fuel!
- .1 + (fuel!
> 5) * 2 pass = pass - 1
noside:
' super - use side thrusters to augment main thrust when more than
' 100% thrust is called for
IF fst
OR super
OR (wan
> 0) THEN ' up/down to change angle beyond 5 degrees IF change
> 0 THEN th1d
= -1: th2d
= 1 IF change
< 0 THEN th2d
= -1: th1d
= 1 IF super
THEN th1d
= 1: th2d
= 1 IF fst
THEN th1d
= fst: th2d
= fst: fst
= 0 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
wan = wan - 1
IF wan
= 1 THEN change
= -change
init1: ' only done once
DATA convo
,f1
,f2
,lmx1
,lmy1
,lmc1
,lmx2
,lmy2
,lmc2
DATA h1
,h2
,h3
,h4
,h5
,h6
,cybill
,surv2
,cm
,rad
,af2
,sf2
,panel
DATA sd
,sl
,s0
,s1
,s2
,s3
,s4
,s5
,s6
,s7
,s8
,s9
,panel0
,panel1
DATA dstarm
,stars
,lanblank
,alien
IF INSTR(tc$
, "DOS") THEN dosbox
= 0 ' use large star file IF INSTR(tc$
, "BOX") THEN dosbox
= 1 ' use small star file IF _FILEEXISTS("cd.dat") THEN iscd
= 1 ' include/create this file for CD/DVD distribution (read only)
z = 0
j = 2 - dosbox ' 1=small, 2=medium, 3=huge
f$
(i
) = f$
(i
) + CHR$(48 + j
) f$(i) = f$(i) + ".dat" ' try lowercase first
f$
(i
) = UCASE$(f$
(i
)) ' try uppercase (Linux cares!) z = z + 1
PRINT "Above file(s) missing"
z$ = "386C6C38" ' degree symbol
p
(0, i
) = VAL("&H" + MID$(z$
, i
* 2 + 1, 2))
auto = 0 ' full automatic
background = 1 ' textured LED displays
cbh = 0 ' constant black holes
darkstars = 1 ' spin
darkstart = 1 ' thickness of lines
demo = 0 ' cram onto one page
doclock = 0 ' shield effect
gh = 9
gs = 85 ' graphics start
glmax = q4 ' ground level max
glmin = glmax - 49 ' ground level min
gs = 85 ' graphics start (flying area)
'gstyle = 5
invincible = 1 ' easier for beginner, thrusters gold
jitter = 1 ' thrust calc
LED$ = "021404120115" ' color sequence - gr ye re or gun wh
LEDc = green '
LEDtri = 0 ' off
mdelay = t ' master delay
opower = 62 ' original thrust factor
pdiv = 0 ' instrument update
radarf = 1
restart = 0 ' shift-d load defaults
segs$ = "abcdefg" ' for 7 segment displays
settings$ = "LANDER.SET"
shield = 0 ' Star Trek!
showmap = 0 ' silly legend at top
skyoff = 1 ' DS, BH, Wo, Co
starfiles = 1 ' dat1, dat2, dat3
starstatus = 1 ' show stars only, no names/info
twinkle = 0
zoom = 1 ' starfield 6 hours 45 degrees
black = 0: blue = 1: green = 2: gunmetal = 3: red = 4: gasoline = 5
gray2 = 6: white = 7: gray = 8: dred = 9: gold = 10: black2 = 11
orange = 12: blue2 = 13: yellow = 14: white2 = 15
craft = white: flame = yellow: fuel = gasoline: LEDc = green
LMci(0) = gray2 ' ASO shifting colors
LMci(1) = gold
LMci(2) = gray2
LMci(3) = black2
nflags = 0
nflags = nflags + 1
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)
FOR i
= 0 TO tsix
' table faster
clines = 0
clines = clines + 1
s&
= VARSEG(cmp&
(0)) ' Command Module
init2: ' each cycle
a = 0 ' angle
a51i = 0
ASO = 0 ' ascent stage only = false
boltc = 0 ' lightning count
center = 362
contact = 0 ' with ground
convo = 0 ' with CM
crash = 0
cut = 0 ' engine
dump = 0 ' fuel
eou = 0 ' end of universe
fb$ = "" ' landing feedback
flx = 0 ' where to plot flag
fuel! = h
hover = 1 ' start safe
ideal! = 2.7 ' autopilot speed
inpause = 0
jf = -1 ' jump to feature
LGMc = 1 ' little green man color
lmsl = blue ' LM shield & laser
lob = 0 ' landed on Borg
lock1 = 0 ' radar tracking
lockfuel = 0
ma = 0 ' malfunction angle
magic = 0 ' landing
mes$(0) = "" ' messages ^ landing eval
mes$(1) = "" ' radiation, landing comments
ok = 0 ' landing status
panelinit = 0 ' instruments
paraf = 0 ' parachute flag
pif = -1 ' counter for instruments
platform = 0 ' for detached DS
power = opower ' thrust factor
powerloss = 0 ' random malfunction
px! = 320 ' vehicle x
py! = 70 ' vehicle y
radiationdeath = 0 ' rads > 1000
rads = 0 ' radiation count
rlink = 0 ' LM/CM radio link
rmin
= RND * 23 ' stars right ascension 0 - 23dmin
= (INT(RND * 18) - 9) * t
' stars declination -90 to 90sia = 0 ' shells in air
sspinit1 = 0
sspinit2 = 0
starinit = 0
tfollow = 0 ' terrain following
tmt! = 0 ' to move total
wa = 0 ' wanted angle
vert = 1 ' vertical autopilot on
vsd = 0 ' vehicle severely damaged
Setcolor
GetSurface gh
auto = 0
px! = sf(6, 2) - 3130 ' TMA
py! = 130
sf = 6 ' surface feature
suri = 3130 ' surface index
vx! = 0 ' not moving
vy! = 0
sf = 4
px! = 320
thrust! = 95
ERASE exv
, ei
, ek
, rtl!
, rtlc
, shx
, shd
mes$(0) = "F1 FOR HELP AND INFORMATION"
IF ufof
> 0 THEN mes$
(1) = "Alien on the loose!" ' 10% active start2!
= TIMER ' elapsed time clocksec = 0
min = 0
PlotGround:
surd
= SGN(tmt!
) ' direction tomo
= INT(ABS(tmt!
)) ' to move IF tomo
> (q3
- gs
) THEN tomo
= q3
- gs
tmt! = tmt! - tomo * surd ' to move total
suri = suri + tomo * surd ' surface index
GOSUB slimit
' limit values to 0-6399
IF gh
= -1 THEN ' ground height = flat LINE (gs
, q4
)-(q3
, q4
), gray
FOR x
= gs
TO q3
' graphics start to 639 'IF showspeed THEN tc = gc(z) ELSE tc = gray
tc = gray
PSET (x
, glmax
), tc
' optional McD fix IF (z
>= sf
(7, 0)) AND (z
<= sf
(7, 1)) THEN ' Surveyor 'y = gh(sf(7, 0))
y = glmax
y = gety(x)
LINE (x
, y
)-(x
, glmax
), tc
LINE (x
, y
)-(x
, glmax
), tc
LINE (x
, glmax
)-(x
, y
), black2
LINE -(x
, glmax
), tc
, , z
+ y
LINE (x
, y
)-(x
, glmax
), tc
ty = y + 5
LINE (x
, ty
)-(x
, glmax
- 1), black
, , &HFEFE LINE (x
, glmax
)-(x
, y
), black2
stuff:
' 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
)) sf = 0
sf = j
x = sf(sf, 0) - suri
z = sf(sf, 1) - suri
'w1 = sf(sf, 2) - suri - h ' show limits of landing at feature
'w2 = sf(sf, 2) - suri + h
'w3 = gety(w1)
'w4 = gety(w2)
'IF bbit THEN
' LINE (w1, w3)-(w1, w3 - t), green
' LINE (w2, w4)-(w2, w4 - t), green
'END IF
'LOCATE 3, 12: PRINT w1; w2; w3; w4;
IF (j
= 1) AND (x
< 0) AND (suri
> 3000) THEN x
= x
+ q1: z
= z
+ q1
bolthitf
= (skyoff
= 0) AND (boltx
>= x
) AND (boltx
<= z
) AND (exl
(1) <> 9999) Area51 f$(40)
nf:
CommandModule: ' 27 * 9
cminview = 1
tx = localize(ex(0), 14, 14)
x1 = tx - 14
x2 = tx + 14
LINE (x1
+ 0, 18)-(x1
+ 26, 26), black2
, BF
LINE (x1
+ z
, 17)-(x1
+ z
, 26), white
, , cmp&
(z
)
CMshadow tx, x1, x2 ' optional
sd!
= ABS(exv
(0)) - ABS(vx!
) ' speed diff
'IF okrick AND (py! < h) THEN ' rendesvous assist
' FOR z = -1 TO 1 STEP 2
' tx2 = tx + z * 50
' LINE (tx2, 18)-(tx2, 28), yellow
' z! = INT(sd! * h) / h
' z$ = STR$(z!)
' TinyFont z$, tx - t, 33, yellow
' NEXT z
'END IF
'
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
IF sc!
= 0 THEN sc!
= TIMER + sct!
' start conversation in xs convo = convo + 1
sc! = 0
convo = 0
cmleaving = 1
mes$(0) = convo$(convo)
nocm:
rlink = rlink - 1 - (rlink = 0) ' allows brief radio interruption
IF rlink
= 0 THEN ' lost awhile ago IF convo
THEN mes$
(0) = " " ' clear current dialogue convo = 0 ' stop conversation
sc! = 0 ' talk timer
ty = 22
LINE (x1
, ty
- 2)-(x1
, ty
+ 2), yellow
LINE -(x1
- 15, ty
), yellow
LINE -(x1
, ty
- 2), yellow
liftoff: ' forced seperation or surface launch
dead$ = "HIT CAR WASH"
IF lob
THEN vx!
= exv
(2): a
= 0 ' landed on Borg
goy = -h ' AS go y
IF ASO
THEN ' ascent stage only thrust! = h
falling = 0
platform = 0
power = opower
thrust! = th ' simulate explosive seperation
platform = 22 ' deflect flame from DS
falling = 0 ' DS already on surface
falling = 1 ' DS in air
goy = py! - 20 ' go y - not to screen top
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)
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
) 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
px! = px! - t * s!(ta)
py! = py! - 15 * c!(ta) ' explosive seperation
wASO = ASO
ASO = 1
dropvx! = 0
dropvy! = 0
dropvx! = vx!
dropvy! = vy!
wa = 0
wa
= SGN(-exv
(0)) * 20 ' want angle
sauto = auto: auto = 1
contact = 0
cut = 0
dump = 0
hover = 0
liftoff = 1
lminx = pminx
lock1 = 0
lockfuel = 0
lpass = 0
mes$(0) = ""
mes$(1) = ""
np = 0
paraf = 0
pcontact = 0
powerloss = 0
psuri = suri
py! = py! - 2 ' fool CheckHit
svert = vert
vert = 0
IF py!
< 280 THEN GOSUB angle
' make a=wa (angle=wanted) np = np + 1
z = (sy1 + sy2) / 2 - 2
IF (deflectat
> 0) AND (z
> deflectat
) AND (z
> deflectat
) THEN contact
= 1 lpass = lpass + 1
IF thrust!
= th
THEN thrust!
= h
IF vsd
THEN ' very severe damage thrust!
= h
- (lpass
+ RND) ' slowly drop power dead$ = "STRUCTURAL FAILURE"
pminx = pminx + dropvx!
pmaxx = pmaxx + dropvx!
pminy = pminy + dropvy!
pmaxy = pmaxy + dropvy!
dropvy! = dropvy! + .6
dropy! = gety(-(pminx + nx))
lminx = pminx
lminy = dropy! - zz
deflectat = pminy
pminx = lminx
pminy = lminy
psuri = suri
pcontact = 1
falling = 0
pminx = lminx + (psuri - suri)
hover = 1
endl:
auto = sauto
crash = 0
deflectat = 0
liftoff = 0
lock1 = 0
platform = 0
vert = svert
ReadLM:
LMbloads
IF ASO
THEN ' ascent stage only lp = 294
nx = 16
ny = 9
rp = 302
th1 = 170
th2 = 198
vmass = 60
lp = 696 ' left pad
nx = 17 ' center x (for rotating)
ny = 18 ' center y
rp = 705 ' right pad
th1 = 449 ' left thruster
th2 = 483 ' right thruster
vmass = h ' full mass
nred = 0 ' number red (volcanic heating)
temp = 0 ' temperature
xp = 97 ' radar
wi = LMx(rp) - LMx(lp) + 1 ' width
wi2 = wi \ 2
IF invincible
THEN c
= gold
ELSE c
= gray
' thruster color 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)
' --------------------------------------------------------------------------
d1:
DATA 36,"Distance to McD" DATA 54,"Rads/temperature" DATA 166,"Horizontal velocity" DATA 206,"Vertical velocity" DATA 277,"Sideways thrust" DATA 307,"Autopilot (full)" DATA 337,"Vertical automatic"
DATA "Scored on vertical & horizontal speed:" DATA "0.00 - 0.50 Excellent" DATA "Landing surface should be near flat," DATA with required ending angle under
5ø.
DATA Based
on a
1974 program running
on a
DATA DEC PDP
/11 with GT40 vector display
DATA terminal at the University of Alberta.
DATA The graphic at top left
is usually a Henon
DATA "plot, dealing with the stability of orbits." DATA The face appearing in TMA
-1 when it shoots
DATA "is Cybill Shepherd. If you land on TMA-1," DATA it displays a Mandelbrot. The semaphores
DATA "use proper flag positions, and the Morse" DATA code in the McDonalds sign
is real too.
DATA "Little Green Man can be turned into a pile" DATA of ashes. Beware the beach balls of IBM!
DATA F2
for a demo mode showing most features.
DATA "Esc or <: Back to Lander > Next page"
d2:
DATA "<> side thrust/angle" DATA "Shift <> move left/right" DATA "<> ground back/forward" DATA "space abort/feature cycle" DATA "Bkspace random star position" DATA "01234 stars off/on/info" DATA "aA autopilot on/off/McD" DATA "D restart with defaults" DATA "fF fuel lock/unlimited" DATA "k kill (fire laser)" DATA "wlemtsiHg goto surface feature" DATA "R rendesvous with CM" DATA "v vertical automatic" DATA "y swap mouse buttons" DATA ". terrain following" DATA "F2 demo mode (compressed)" DATA "F4 constant black holes" DATA "F5 panel/instruments" DATA "F6 drop descent stage" DATA "F8 shields (uses fuel)" DATA "F9/F10 LED color/tri-color" DATA "PgDn/Up slower/faster" DATA "< Previous page > Next page"
d3:
DATA "/ green/b&w/regular screen" DATA "+ zoom in starfield" DATA "- zoom out starfield" DATA ". terrain following" DATA "j DeathStar rotation" DATA "| generate all star files (hours!)" DATA "x more/less starfiles" DATA "X regenerate current star file" DATA "Q oscar (LGM flag colors)" DATA "[ crude black & white" DATA "U ground tiling style" DATA "ctrl-c or -s: SCREEN capture" DATA "alt-Enter: fullscreen toggle" DATA "< Previous page > Next page"
d4:
DATA " Programmed by: R. Frost" DATA " Edmonton, Alberta, Canada" 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 "< Previous page Esc or >: Back to Lander"
leds:
DATA 0,abcdef
,1,bc
,2,abged
,3,abgcd
,4,fgbc
,5,acdfg
,6,acdefg
,7,abc
,8,abcdefg
,9,abcdfg
,10,g
,11,def
features:
' x y lz
DATA "Car Wash",100,44,130 DATA "Little Green Man",12,0,70
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 "has killed you - press Esc"
skycrud:
semadata:
say:
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"
BigM: ' 37 * 16
' 1234567890123456789012345678901234567
' 1 2 3
tinyfontd:
'2010 :
'DATA ALL THESE WORLDS
'DATA ARE YOURS EXCEPT
'DATA EUROPA
'DATA ATTEMPT NO
'DATA LANDING THERE
'DATA USE THEM TOGETHER
'DATA USE THEM IN PEACE
lmshow:
x = (LMx(i) + 17 - ASO) * 16 + 30 + (pass = 2)
y = (LMy(i) + 18 - ASO * 9) * 8 + t
c = LMc(i)
TinyFont z$, x + 3, y + 3, c
FOR i
= 1 TO 35 ' line of numbers at top TinyFont z$, (i - 1) * 16 + 33, 4, gray
x = (i - 1) * 16 + 30 + 16
LINE (x
, 0)-(x
, 320), red
FOR i
= 1 TO 36 ' columb of numbers at left TinyFont z$, 8, i * 8 + 13, gray
y = i * 8 + t + 8 + 1
LINE (0, 0)-(q3
, 320), red
, B
' -------------------------------------------------------------------------------------------------------x
hp = 1
timemachine
hp = hp + (k = 75) - (k = 77)
' --------------------------------------------------------------------------
ReadAndReplace:
' --------------------------------------------------------------------------
Help1:
LINE (85, 0)-(260, q4
), gray
, BF
FOR i
= 1 TO 13 ' define the panel first sprint2 z$, 90, ty, white, 0
IF i
= 10 THEN z$
= CHR$(27) + CHR$(26) + z$
' left & right arrow keys sprint z$, 90, ty, white, 0
LINE (261, 0)-(639, q4
), blue2
, BF
' summary of program ty = 11: c = white
sprint z$, 275, ty, c, 0
ty = ty + 9 - (z$ <> "") * 5
' --------------------------------------------------------------------------
Help2:
c1 = gray
c2 = black
z$ = "KEYBOARD COMMANDS"
tx = 40: ty = 26
sprint2 z$, tx, ty, c, 0
ty
= ty
+ 11:
IF ty
> 276 THEN tx
= 340: ty
= 26 LINE (50, 300)-(585, 300), 0 LINE (55, 302)-(590, 302), 0 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
Help3:
c1 = gray
c2 = black
z$ = "MORE KEYBOARD COMMANDS"
tx = 200: ty = 36: c2 = blue
IF i
= 19 THEN ty
= 310: c2
= black
sprint z$, tx, ty, white, c2
ty = ty + 15
LINE (50, 300)-(585, 300), 0 LINE (55, 302)-(590, 302), 0 ' --------------------------------------------------------------------------
credits:
c1 = dred
c2 = white
z$ = "AUTHOR & HUMOUR SUMMARY"
GOSUB pageprep: x1
= 86: ty
= 40 x1
= 320 - LEN(z$
) * 4 - 8 x2
= 320 + LEN(z$
) * 4 + 8 ty = 330
LINE (x1
, ty
)-(x2
, ty
+ 11), dred
, BF
sprint2 z$, x1 + 8, ty, c2, 0
ty = ty + t
' --------------------------------------------------------------------------
pageprep:
x1 = 30: y1 = 5: x2 = 610: y2 = 345
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
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
' -------------------------------------------------------------------------------------------------------x
SUB sprint
(z$
, tx
, ty
, c1
, c2
) ' VGA font IF d
= 248 THEN d
= 0 ' degree symbol x = tx + (i - 1) * 8
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&
' -------------------------------------------------------------------------------------------------------x
SUB sprint2
(c$
, tx
, ty
, c1
, c2
) ' CGA font IF d
= 248 THEN d
= 0 ' degree symbol tx2 = tx + (i - 1) * 8 + k
ty2 = ty + 2
p& = p2(d, k)
LINE (tx2
+ 1, ty2
+ 1)-(tx2
+ 1, ty2
+ 9), c2
, , p&
LINE (tx2
, ty2
)-(tx2
, ty2
+ 8), c1
, , p&
' -------------------------------------------------------------------------------------------------------x
SUB AuHoVe
(auto
, hover
, vert
, lam
) z$
= MID$(" AUTOHOVER VERT", i
* 5 + 1, 5)
ty = 307 + i * 15
PrintCGA z$, 4, ty, gunmetal, black2, 0
c1 = green
c2 = black2
c1 = black2
c2 = red
IF crash
THEN c1
= black2: c2
= black2
PrintCGA "ON ", 57, ty - 4, c1, -1, 0
' blink OFF to indicate a keyboard command turned it off
c2
= (APdisengage
MOD 2) * red
APdisengage = APdisengage - 1
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)
LINE (tx1
+ 2, ty1
)-(tx2
+ k
+ 2, ty2
), white
' plot switch LINE (tx1
+ 1, ty1
)-(tx2
+ 1, ty2
), black2
' outline left LINE (tx1
+ 3, ty1
)-(tx2
+ 4, ty2
), black2
' outline right ' -------------------------------------------------------------------------------------------------------x
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
LINE (xbar
- 1, ymin
+ 4)-(xbar
+ 1, ymin
+ 7), c
, BF
LINE (xmin
, ymin
+ 5)-(xbar
, ymin
+ 7), c
, BF
ELSE ' mechanical pointer IF (osc
= 4) AND (radarf
= 0) THEN ' altitude with radar off tc1 = gray
tc2 = black
tc1 = white
tc2 = white
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
' -------------------------------------------------------------------------------------------------------x
ei(3) = 1
l! = aspect!
v! = tx / l!
s1!
= l!
/ t: r
= RND * 90: ri
= RND * 8 + 2 bc = bc + 1 + (bc = 6) * 7
z$ = "020105040906010613070603091301070605121404" ' colors
tc
(i
) = VAL(MID$(z$
, bc
* 6 + i
* 2 + 1, 2))
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
bhx = 0: bhy = bhx
FOR pass
= 0 TO 1 ' 90 degrees apart pd = 0 ' pen up
x1! = za!
y1! = zb!
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) c1
= (xx
> -120) AND (xx
< 770) c2
= (yy
> -120) AND (yy
< 470) bh = 1
bhx = xx
bhy = yy
pd = 1 ' pen down
' -------------------------------------------------------------------------------------------------------x
SUB BlackHoleDoom
' fall in while shrinking fb$ = "" ' silence feedback, if any
sgs = gs ' save graphics start (going to kill panel here)
gs = 0 ' kills panel
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
mes$(0) = "Let's get SMALL! - Steve Martin"
x = LMrx(i) + LMxi!(i) * pass
y = LMry(i) + LMyi!(i) * pass
c = LMc(i)
mes$(0) = dead$
mes$(1) = ""
gs = sgs
ibd:
Info
BlackHole 1
timemachine
' -------------------------------------------------------------------------------------------------------x
SUB CMshadow
(tx2
, x1
, x2
) LINE (tx2
- 4, 17 + z
)-(tx2
- 1, 17 + z
), white
z
= ((z
+ 8) MOD 17) + 1 ' rotation 2 LINE (tx2
+ 6, 17 + z
)-(tx2
+ 8, 17 + z
), white
FOR tx
= x1
TO x2
' shadow zx = tx - x1 - (x2 - x1) \ 2
zy = ty - 22
' -------------------------------------------------------------------------------------------------------x
FUNCTION dcolor
(v!
, z1
, z2
, d
) ' determine color for various displays dcolor = LEDc ' normal
IF d
= 1 THEN ' problem higher IF tv!
> z1
THEN dcolor
= yellow
' warning IF tv!
> z2
THEN dcolor
= red
' serious warning IF tv!
< z1
THEN dcolor
= yellow
' warning IF tv!
< z2
THEN dcolor
= red
' serious warning ' -------------------------------------------------------------------------------------------------------x
SUB Evaluate
(savea
, z
) ' landing analysis
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" z$ = z$ + " landing"
IF crash
THEN fb$
= "": z$
= "CRASHED"
z$
= z$
+ " on Borg":
GOSUB tackon
v$ = "" ' verb
n$ = "" ' noun
ldis = q1 ' last distance
FOR i
= 1 TO t
' 5wlemtsihg tx = sf(i, 2) - suri ' point of interest middle
poi$ = sf$(i) ' name of poi
ldis = dis
n$ = poi$
don = (sf(i, 2) - sf(i, 0)) + wi2 ' distance to be "on"
' pad 349 LGM Surveyor
v$ = "in"
v$ = "on"
v$ = "at"
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!" mes$(1) = "Rude to land on a tombstone!"
ni:
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!"
eother:
IF fuel!
= 0 THEN z$
= "ran out of fuel!":
GOSUB tackon
tackon:
fb$ = fb$ + z$
' -------------------------------------------------------------------------------------------------------x
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)
CountFuel = CountFuel + 1
IF CountFuel
< ptk
THEN LMc
(i
) = 0 ' points to kill contact = 0
fb$ = "" ' eval feedback
sgs = gs
gs = 0 ' full screen
FOR pass
= 1 TO 40 ' expanding debris mes$(0) = dead$
mes$(1) = ""
Info ' say why exploding
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)
LINE (x
, y
)-(x
+ s
, y
+ s
), LMc
(i
), BF
LINE (x
+ z1
, y
+ z2
)-(x
+ z1
+ s
, y
+ z2
+ s
), LMc
(i
), BF
LINE (0, 0)-(q3
, q4
), 0, B
' erase ugly border timemachine
gs = sgs
' -------------------------------------------------------------------------------------------------------x
SUB ExplodeShell
(s
) ' not contact - when LM fires at them tx = shx(s) - suri
ty = shy(s)
LINE (tx
- 5, ty
- 5)-(tx
+ 5, ty
+ 5), black2
, BF
' erase shell
FOR z
= 0 TO 40 - d
' particles at above distance tx2 = tx + d * c!(ang) * aspect!
ty2 = ty + d * s!(ang)
shx(s) = 0
shd(s) = q1 ' 6400, any large number
sia = sia - 1 ' shells in air
' -------------------------------------------------------------------------------------------------------x
SUB GetSurface
(gh
) ' load surface array DIM lz
(t
) ' landing zones IF gh
< 0 THEN f$
= "SL.DAT" ' l for level IF demo
THEN f$
= "SD.DAT" ' d for demo 'gc(i) = gray
FOR i
= 1 TO t
' create landing zones IF demo
THEN ' compress onto 1 page lz(i) = 3050 + (i - 1) * 80
lz(i) = 320 + (i - 1) * (q3 + 1) ' 1 per page
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 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
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
sspinit2 = 0
' -------------------------------------------------------------------------------------------------------x
FUNCTION gety
(x
) ' ground level for given x c1 = (xx >= sf(2, 0)) ' car wash start
c2 = (xx <= sf(2, 1)) ' car wash end
IF ASO
THEN z
= 320 ELSE z
= 338 ' safe zone start different with ascent stage only gety = q4 ' 349, max y
c1
= (ek
(2) <> -1) AND (ek
(2) < h
) c2
= (skyoff
= 0) AND (sy1
< borgt
) AND (ax
> borgl
) AND (ax
< borgr
) ' LINE (borgl, borgt)-(borgl, borgt - 20), yellow ' debugging
' LINE (borgl, borgt)-(borgr, borgt - 20), yellow
' LINE (borgl, borgt)-(borgr, borgt), yellow
gety = borgt
gety = gh(xx)
' -------------------------------------------------------------------------------------------------------x
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
' -------------------------------------------------------------------------------------------------------x
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
PSET (x0
+ 50, y0
- 31), red
IF a
(0) = 0 THEN a
(0) = 30: a
(1) = 150 ' initial marker positions IF RND > pf!
THEN ' reel mark direction&speed IF RND > .8 THEN tdir
= 0 ' sometimes not moving 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
CIRCLE (x
, y
), d!
, white
, , , .73 ' reel CIRCLE (x
, y
), d!
, white
, , , .68 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 CIRCLE (x
, y
), d
, dred
, , , .73
IF sia
> 0 THEN ' shells in air = building gets MEAN title PrintLines "HAL", 0, 47, x0 + 1, y0 + 39, red, white, 1, 2
PrintLines "IBM", 0, 47, x0, y0 + 39, blue, white, 1, 2
' binary clock
x = x0 + i * 5 + 2 - (i > 2) * 5 - (i > 4) * 5 ' column
z
= VAL(MID$("132323", i
, 1)) ' rows for this column v = v \ 2
y = glmax - 2 - j * 2
LINE (x
- 1, y
)-(x
+ 1, y
), c
, B
' show bit
ttf!
= fat!
- TIMER ' time to fire IF fat!
> 86400 THEN fat!
= t: ttf!
= 0
IF (ttf!
> 0) AND (ttf!
< 1) THEN ' optional radar x1 = x0 + 25
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
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
sia = sia + 1 ' shells in air
shx(s) = suri + x0 + 25
shy(s) = 320
shellv
= (-32 + (RND - pf!
) * t
) * t
' velocity ta = 0
ta
= RND * 50 ' above or below ta
= ta
+ (RND - pf!
) * 4 ' vary it a little dx = px! - shx(s) + suri
dy = shy(s) - py!
shella
= _R2D(ATN(dx
/ dy
)) + (90 - 5 * SGN(dx
) + ta
) shella
= 90 + (RND - pf!
) * 40 shellv = shellv * .75
shella
= (shella
+ tsix
) MOD tsix
shvx(s) = (shellv / t) * c!(shella)
shvy(s) = (shellv / t) * s!(shella)
shd(s) = q1
' -------------------------------------------------------------------------------------------------------x
IF mes$
(i
) <> omes$
(i
) THEN sm!
(i
) = 0 omes$(i) = mes$(i)
IF el!
> 5 THEN mes$
(i
) = "": sm!
(i
) = 0 tcenter = (q3 + gs) \ 2 ' center of "space" area
c1 = white2: c2 = gray
IF l3$
= "CM:" THEN c1
= red
' rendesvous chatter IF l3$
= "DAN" THEN c1
= red
' Danger, Will Robinson PrintVGA z$, tcenter - lenmes(0) * 4, 5, c1, -1
IF lenmes
(0) > (34 - (gs
= 0) * 5) THEN tcol
= (tcol
+ 4) MOD (lenmes
(0) * t
) PrintLines z$, tcol, tcol + 40 * 16, gs, 20, c1, c2, 2, 2
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
IF lenmes
(1) THEN ' subordinate msg PrintVGA mes$(1), tcenter - lenmes(1) * 4, ty, red, dred
z = rads \ h
IF z
>= t
THEN radiationdeath
= 1: z
= t
' >= ten z$ = "ensures your death within " + z$ ' yes, tack on phrase
mes$(1) = "Radiation exposure " + z$ + "!"
' -------------------------------------------------------------------------------------------------------x
DIM segment
(6, 3), number$
(11) LEDinit = 1
IF (osc
< 6) OR (osc
= t
) THEN ' fuel,alt,h,v,thrust,angle tc
= c:
IF LEDtri
= 0 THEN tc
= LEDc
segx = 14: segy = 14 ' segment size
tx
= 92 - LEN(t$
) * segx
* 2 ty = 298
tx = gs - tl
ty = 296 - osc * 39
segx = 8: segy = 8
ELSE ' 6clock 7dtm 8speed 9rads tx = 50
ty = 35 + (osc - 6) * 9
segx = 4: segy = 3
dpp = 0 ' decimal point
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
IF z$
= "L" THEN z
= 11 ' "L" for lock fuel and level ground
IF osc
= 6 THEN ' colon for clock PSET (tx
+ 14, ty
- 4), tc
* bbit
PSET (tx
+ 14, ty
- 2), tc
* bbit
leddigit:
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
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
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
' -------------------------------------------------------------------------------------------------------x
p = ASO * 3 + 4
' -------------------------------------------------------------------------------------------------------x
LMx
(i
) = LMx
(i
) + RND * 3 - 1 LMy
(i
) = LMy
(i
) + RND * 3 - 1' -------------------------------------------------------------------------------------------------------x
z = 12500
tf$
= "PANEL" + CHR$(48 + background
) + ".DAT" pload = 1
' -------------------------------------------------------------------------------------------------------x
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
localize = z0 ' return 9999 or calculated
' -------------------------------------------------------------------------------------------------------x
LINE (0, 0)-(gs
- 1, 1), blue2
, BF
IF i
<= t
THEN ' surface features tx = sf(i, 2)
tc = blue
z$ = sf$(i) ' surface feature name
IF i
= 3 THEN z$
= "LGM" ' shorten some names tc = white
tx
= (suri
+ px!
) MOD (q1
+ 1) z$ = "LM"
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
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:
' -------------------------------------------------------------------------------------------------------x
z$ = " Burger, fries & Coke only $1.99!"
McDi = 1
mp
= (mp
+ 4) MOD 320 ' show ad in text x2 = x + 38
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)
tmx = x + x2 - mx - 2
IF tmx
> x
THEN LINE (tmx
, glmax
- 19)-(tmx
+ 2, glmax
- 18), tc
, BF
y = glmax - 1 ' show ad in Morse
i = 0
i = i + 1
x = x + (p + 1) * 2
' -------------------------------------------------------------------------------------------------------x
OnOff$
= MID$("OFFON ", v
* 3 + 1, 3)' -------------------------------------------------------------------------------------------------------x
osc = osc + 1
IF dp
= t
THEN dp
= 0: osc
= 9
IF z$
= " -0.00" THEN z$
= " 0.00" 'IF z$ = " -0.99" THEN z$ = " -1.00"
IF (osc
= 9) AND (t!
= 0) THEN ' usually count for rads, lightning cylon
= (cylon
+ 1) MOD 6 ' when blank, cycle a "-" zz
= VAL(MID$("123432", cylon
+ 1, 1)) z$ = " "
IF radarf
= 0 THEN z$
= " ----"
IF osc
= 4 THEN z$
= " ----" ' suppress altitude IF osc
= 7 THEN z$
= "----" ' distance to McDonalds
LEDdisplay z$
' -------------------------------------------------------------------------------------------------------x
SUB PrintCGA
(c$
, x
, y
, tc1
, tc2
, compress
) STATIC ' CGA font, 8 * 8 c1 = tc1
c2 = tc2
IF y
= -1 THEN ' single char panel stuff - F for Fuel, etc. c2 = -1
y = 263 - osc * 39
tx1 = x - 3
tx2 = x + 11
ty1 = y
ty2 = y + t
IF bbit
AND (LEDc
= green
) AND (radarf
> 0) AND (contact
= 0) AND ((c1
= red
) OR (c1
= yellow
)) THEN LINE (tx1
+ 1, ty1
+ 1)-(tx2
- 1, ty2
- 1), c1
, BF
c1 = black2
tx = x + 1
'IF d = 248 THEN d = 0 ' degree symbol
LINE (tx
+ 1, y
+ 2)-(tx
+ 1, y
+ t
), c2
, , p2
(d
, k
) LINE (tx
, y
+ 1)-(tx
, y
+ 9), c1
, , p2
(d
, k
) tx = tx + 1
' -------------------------------------------------------------------------------------------------------x
SUB PrintLines
(d$
, i1
, i2
, x1
, y1
, c1
, c2
, sd
, s
) STATIC ' chars, index1, index2, x,y, color 1, color 2, shadow distance,size
slant = -(c2 < -20)
z = i \ (8 * s) + 1
IF d
= 248 THEN d
= 0 ' degree symbol p& = 0
p&
= p&
* 2 + SGN((p
(d
, 13 - j
) AND m&
)) ty1 = y1 + (i - i1)
ty2 = ty1 - slant * 13
LINE (x1
, ty1
)-(x1
+ 13, ty2
), c1
, , p&
* 2 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&
' -------------------------------------------------------------------------------------------------------x
SUB PrintVGA
(z$
, tx
, ty
, c1
, c2
) ' VGA font, 8 * 14 PrintLines z$
, 0, LEN(z$
) * 8 - 1, tx
, ty
+ 13, c1
, c2
, 1, 1' -------------------------------------------------------------------------------------------------------x
'black = 0: blue = 1: green = 2: gunmetal = 3: red = 4: gasoline = 5
'gray2 = 6: white = 7: gray = 8: dred = 9: gold = 10: black2 = 11
'orange = 12: blue2 = 13: yellow = 14: white2 = 15
' b g g r g g w g d g b o b y w
' l r u e a y h y r o k r 2 e h
' 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
z$ = "070707075607070756070007565656" ' black and white (because I can!)
z$ = "010249042456075632380052085407" ' color
'z$ = "010249322456075632380052085407" ' color
' -------------------------------------------------------------------------------------------------------x
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)
dx! = tsx - px!
dy! = (tsy - py!) * aspect!
shd
(s
) = SQR(dx!
* dx!
+ dy!
* dy!
) dead$ = "HAL KILLED YOU"
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 d2 = bit * t + t / 2
x2 = tsx + d2 * c!(a2) * aspect!
y2 = tsy + d2 * s!(a2)
PAINT (tsx
, tsy
), gold
, gold
shx(s) = 0
sia = sia - 1
sha
(s
) = (sha
(s
) + ai
+ tsix
) MOD tsix
ss = 3 + (s = 0) * 2
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
nextshell:
makecrater:
dd
= ABS(sf
(sf
, 2) - suri
- tsx
) ' distance to current surface feature IF dd
< t
THEN sf
(sf
, 2) = -1 ' under ten from a surface feature, kill feature
'FOR crx = 0 TO q1
'gc(crx) = gray
'NEXT crx
zz = 40 ' distance +- impact
ta
= (crx
* 2 + 270) MOD tsix
' angle tx = tsx + crx
ty = gety(tc) - r1 - r2 * s!(ta)
ti
= ((suri
+ tx
+ q1
) MOD q1
) gh(ti) = ty
'gc(ti) = yellow
ti
= (suri
+ tsx
- zz
- 1 + q1
) MOD q1
ti
= (suri
+ tsx
+ zz
) MOD q1
' -------------------------------------------------------------------------------------------------------x
zc
= dcolor
(CSNG(a
), 0, 4, 1) c = zc
IF (bbit
= 0) AND (contact
= 0) THEN c
= black
' blink PrintVGA z$, 7, 270, c, black2
osc = t
LEDdisplay a$
' -------------------------------------------------------------------------------------------------------x
DIM SSp&
(1, 26), x
(1), y
(1) BLOAD f$
(17), o&
' surv2.dat sc = white
sspinit1 = 1
x0 = x
ti = suri + x0 - 1
y0 = gh(ti)
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
)
' modify ground to include Surveyor
FOR ty
= y0
- 20 TO glmax
gh(z) = ty
sspinit2 = 1
FOR tx
= x0
TO x0
+ 26 ' optional shadow zx = tx - (x0 + 13)
zy = ty - (y0 - t)
attack = 0
sdd = q1
x(j) = (x + t) + z * c!(ra) * aspect!
y(j) = y0 + z * s!(ra) - 1
xs! = (x(1) - x(0)) / 20
ys! = (y(1) - y(0)) / 20
tx = x(0) + j * xs!
ty = y(0) + j * ys!
x! = px! - tx
y! = (py! - ty) * aspect!
dd
= SQR(x!
* x!
+ y!
* y!
) LINE (sx0
+ xoff
, sy0
+ vy!
)-(tx
, ty
), lmsl
LINE (tx
- 1, ty
)-(tx
+ 1, ty
), red
LINE (tx
, ty
- 1)-(tx
, ty
+ 1), red
oldr = rads
rads
= rads
+ RND * t
+ 1 IF rads
> 9999 THEN rads
= 9999 rtlc(0) = rads
panelinit = 0
' -------------------------------------------------------------------------------------------------------x
s = 7
ta = k + j * 180
tx = j * s + (s \ 2) * c!(ta)
ty = j * s + (s \ 2) * s!(ta)
t(i, tx, ty) = 1
tinit = 1
bp = gety(xo) + yo
td = p(z1, z2)
td = p(z1, z2)
tx = xo + i
yy = gety(tx) + 1
ty = yo - j
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' -------------------------------------------------------------------------------------------------------x
DIM tmaa!
(10), tmab!
(10), tmac
(10) IF ok
AND (INSTR(fb$
, "on TMA") > 0) THEN ' landed, do Mandelbrot instead of moire Mandel
IF zdc
= 0 THEN ' then initialize nc
= RND * 2 + 1 ' use 2-3 colors lc = -1 ' last color, prevent repeats
tmab!
(z
) = (RND - pf!
) / 8 IF c
= gray2
THEN c
= gray
' stars use gray2 IF c
= white2
THEN c
= white
' stars use white2 tmac(z) = c
tmaa!(z) = tmaa!(z) + tmab!(z)
y0 = glmax - 72
y1 = y0 + 1
y2 = glmax - 1
LINE (x
, glmax
)-(x
+ 46, glmax
), gray
x2! = gx / tmaa!(0)
x2! = x2! * x2!
y2! = gy / tmaa!(0)
y2! = y2! * y2!
tcc
= ABS((x2!
+ y2!
) / tmaa!
(1)) MOD (nc
+ 1)
tmaother:
IF bolthitf
THEN LINE (x
, y0
)-(x
+ 45, glmax
), white
, BF
tarx = shx(s) - suri
tary = shy(s)
ExplodeShell s ' show it exploded
tarx = exl(i) ' where to shoot
tary = ey(i)
ek(i) = 0
ex(i) = 0 ' mark destroyed
exv(i) = 0
tmafl: ' fire laser
FOR gx
= x
TO x
+ 45 STEP 2 ' along top of TMA1 LINE (gx
, y1
- 1)-(tarx
, tary
), blue
' nice blue IF gotpix
= 0 THEN ' not showing Cybill cybilltime!
= TIMER + 2 ' keep on screen for 2 sec gotpix = 1 ' flag onscreen
' -------------------------------------------------------------------------------------------------------x
SUB Wave
STATIC ' funny effect for warp speeds ' 1234567890123456789012
' TTTTHHHHHVVVVVAAAAFFFF
osc
= VAL(MID$("1111222223333344445555", i
, 1)) adg
= (tdg
+ wll
) MOD 4 + 1 - (wll
= 4) z$
= MID$("agdgagdg", adg
, wll
) LEDdisplay z$
' -------------------------------------------------------------------------------------------------------x
nc:
ei(4) = 1
tx = localize(ex(4), 0, 0)
wy = ey(4)
baa
= (ta
+ ba
+ d
* 90) MOD tsix
tx1 = tx + ta / 8 * c!(baa)
ty1 = wy + ta / 40 * s!(baa)
' -------------------------------------------------------------------------------------------------------x
x = x - 5
IF LGMc
= gray
THEN ' LGM toasted - show pile of ashes y1 = gety(x + t) - 1
LINE (x
+ y
, y1
- y
)-(x
+ 15 - y
, y1
- y
), gray
PSET (x
+ y
+ p
, y1
- y
), black2
PSET (x
+ y
+ p
+ 3, y1
- y
), black2
IF sema$
= "" THEN ' initialize FOR i
= 1 TO 28 ' read angles READ z$
, a
(i
, 0), a
(i
, 1) sema$ = sema$ + " " + z$ + " "
lc$
= CHR$(255): i
= 0 ' lc = last character, i = index
IF crash
THEN LGMc
= dred
' white2 as many other colors g1 semat! = .3
tsema$ = sema$
IF si
> 0 THEN i
= si
- 1: si
= 0 semat! = .2 ' 0.2 seconds between letters
IF tsema$
<> "help " THEN tsema$
= "!" toast = 0
tsema$ = "help "
toast = toast + 1
IF toast
> 2 THEN toast
= 0: LGMc
= LGMc
+ 1 p
= INSTR(tsema$
, "time is") MID$(tsema$
, p
+ 8, 4) = z$
y1 = gety(x) - 14
p
= INSTR("1234567890", c$
):
IF p
THEN d
= p
- (c$
= "0") c1 = red
c2 = gold
c1 = blue
c2 = white
lc$ = c$
' 1 2 3 4 5 6 7 8 9
' g y o r d g b
' r e r e r 2 2
c
= VAL(MID$("021412040906110015", (LGMc
- 1) * 2 + 1, 2)) 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 CIRCLE (x
+ t
, y1
- 6), 5, co
' eye LINE (x
+ 5, y1
)-(x
+ 15, y1
+ 12), co
, B
' body
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
IF fc
THEN ' optional flame effect FOR ty
= y1
- 9 TO y1
+ 12 tc
= (ty
+ tx
+ z
) MOD di
FOR j
= 0 TO 1 ' arms & flags a1 = a(d, j) - 90
x2 = x + j * 20
LINE (x2
, y1
)-(x3
, y2
), c
' arm a1 = a1 - 90 * s
sx = x4: sy = y4
x3 = x4: y2 = y4
PAINT (rx
, ry
), c1
, gunmetal
PAINT (yx
, yy
), c2
, gunmetal
x2
= x
+ 5 + SGN(INSTR("ACDHJMNOPSUV0123456789", c$
)) ' letter centering y2 = y1 + 2
x2
= x
+ 6 - SGN(INSTR("ijlnv", c$
)) ' as above
CALL PrintVGA
(c$
, x2
, y2
, tc
, black2
) ' -------------------------------------------------------------------------------------------------------x
' - starstatus 0 off, 1 on, 2+names, 3+RA & Dec & grid, 4+Mag
' - encodes magnitude into xy array by making negative
' - stars1 1797, stars2 16571, stars3 87470
' - parsec = 3.262 light years
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
nh = 12 / (zoom + 1) ' hours (RA)
nd = 90 / (zoom + 1) ' degrees (Dec)
IF eou
<> 0 THEN ' End of Universe alldown = 1
sy = stary(star)
IF ay
< q4
THEN ' less than screen bottom stary
(star
) = stary
(star
) + SGN(stary
(star
)) alldown = 0 ' not done
tss = starstatus
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
zz$
= LTRIM$(STR$(starfiles
)) + rmin$
+ dmin$
+ ".DAT" IF (warp!
>= 1) AND (starfiles
= 2) THEN tfs
= 1 ELSE tfs
= starfiles
th! = 5.07 + zoom: tf$ = "STARS1.DAT": d$ = "DAT1\": nl& = 1797
th! = 7.07 + zoom: tf$ = "STARS2.dat": d$ = "DAT2\": nl& = 16571
th! = 8.07 + zoom: tf$ = "STARS3.dat": d$ = "DAT3\": nl& = 87470
isstari = ((tif1 + tif2 + tif3) = -3)
regen = 0
starx(i) = 0
stary(i) = 0
INPUT #tf
, r!
, d!
, m!
, dis$
, n$
n1& = n1& + 1
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
timemachine
'y$ = STR$(INT(VAL(dis$) * 3.262 * h) / h) ' convert to light years
'y$ = LTRIM$(RIGHT$(SPACE$(6) + y$, 6))
sa
= (LEFT$(n$
, 1) = "*") ' show always (low mag) tt! = th! ' temp threshold
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? 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
tx = q3 - (r! - rmin + sr * 24) / nh * q3
ty = q4 - (d! - dmin + sd * 180) / nd * q4
nstars = nstars + 1
starx(nstars) = tx
stary(nstars) = ty
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"
plot:
tss = starstatus
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
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
TinyFont z$
, q3
- LEN(z$
) * 4 - 2, ty
+ 2, -gc
stx
= starx
(star
): ax
= ABS(stx
) sty
= stary
(star
): ay
= ABS(sty
) tx
= ax
+ SGN(-vx!
) * warp!
* 2 IF tx
< 1 THEN tx
= tx
+ (q3
+ 1) IF tx
> q3
THEN tx
= tx
- (q3
+ 1) starx
(star
) = tx
* SGN(stx
+ .01) m = 3 + (stx < 0) + (sty < 0) ' magnitude
IF m
< 3 THEN tc
= white2
ELSE tc
= gray2
' slightly different brightness 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 ' IF (star MOD 37) = 0 THEN TinyFont STR$(star), ax, ay, sc ' diagnostic
FOR i
= 1 TO named
' show names & info ty = ay + j * 9 + (j = 2) * 3 + 1
TinyFont star$(j, i), ax, ty, sc
PrintCGA star$(j, i), ax, ay + j * 9, sc, -1, 1
TinyFont z$, 86, 20, red
readstar:
INPUT #tf
, nstars
, named
, isred1
, isred2
n1 = nstars
' -----------------------------------------------------------------------------------
writestar:
PRINT #tf
, nstars;
","; named;
","; isred1;
","; isred2
PRINT #tf
, ","; star$
(j
, i
);
' -------------------------------------------------------------------------------------------------------x
z$
= SPACE$(t
) + "WE ARE THE BORG - RESISTANCE IS FUTILE" + SPACE$(50) moire = 0: moired = 1: xn = 19: yn = 8: zz = 13: p0 = &HAAAA
borginit = 1 ' direction for guts
p1 = &H5555: p2 = &HAAAA
'lbx = localize(bmx, 58, 46)
'IF lbx = 999 THEN
' IF (demo = 1) THEN ex(1) = 3170 ELSE EXIT SUB ' keep around in demo mode
'END IF
borgt = bmy - 40 ' top
borgl = lbx - 40 ' left side
borgr = lbx + 52 ' right side
x1 = lbx - 46: y1 = bmy - 34: x2 = lbx + 46: y2 = bmy + 34
tx1 = x1 + i: tx2 = x2 + i: ty1 = y1 - i: ty2 = y2 - i
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
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 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 ' 84 60
mat$(y) = mat$(y + 1)
ty = y1 + y * 6
TinyFont mat$(y), x1 + 5, ty + 1, blue
moire = moire + moired
z1! = tx / (moire + 40): z1! = z1! * z1!
z2! = ty / (moire + 40): z2! = z2! * z1!
x2 = x2 - 3: xs = x2 - x1: ys = y2 - y1
bx2
= bx1
+ (RND - pf!
) * xs
/ z
* t
+ 2 by2
= by1
+ (RND - pf!
) * ys
/ z
* t
+ 2 LINE (bx1
, by1
)-(bx2
, by2
), c
, B
'FOR i = borgl + 5 TO borgr - t STEP 5 ' ion drive
' IF RND > .6 THEN
' PSET (i, bmy + 27), white
' FOR j = 0 TO 30
' IF RND * h < j THEN
' ty = y2 - j + 39
' LINE (i, ty)-STEP(1, 0), blue
' END IF
' NEXT j
' END IF
'NEXT i
FOR k
= -30 TO 30 STEP 15 ' exhaust, 5 flames ' CIRCLE (lbx + k, bmy + 27), 2, blue, , , .75
' PAINT (lbx + k, bmy + 27), blue, blue
bit
= bit
XOR 1 ' alternate 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
' scroll Borg message along top and right side of craft
ti
= (ti
MOD (50 * 16)) + 8 ' index into text, speed 1-?? tx1 = lbx - 46 - 3
ty1 = bmy - 31
PrintLines z$, ti, ti + 90, tx1, ty1 - 1, black2, -88, 2, 2 ' top
PrintLines z$, ti, ti + 90, tx1, ty1 - 0, white2, -88, 2, 2
tx1 = lbx + 46 - 2: ty1 = bmy - 32 ' right
PrintLines z$, ti + 91, ti + 91 + 67, tx1, ty1, black2, -99, 2, 2
'IF RND > .8 THEN ' side thrusters
' IF RND > pf! THEN
' tx1 = lbx - 48: txi = -1: ty1 = bmy
' ELSE
' tx1 = lbx + 60: txi = 1: ty1 = bmy - 12
' END IF
' FOR i = 34 TO 0 STEP -1
' z = i * SIN(_d2r((i + 90) * 2))
' LINE (tx1, ty1 - z)-(tx1, ty1 + z), blue
' tx1 = tx1 + txi * 2
' NEXT i
'END IF
' -------------------------------------------------------------------------------------------------------x
q = q3 * 2 ' 640*2=1280
DIM vox!
(q
), voy!
(q
), vxi!
(q
), vyi!
(q
) vinit = 1
vx = sf(4, 2)
IF vyi!
(i
) < -3 THEN k!
= .6 ELSE k!
= .8 ' kill some vox!
(i
) = vx
+ RND * t
- 5 ' initial x voy!
(i
) = gety
(INT(vox!
(i
) - suri
)) - 1 ' initial y ta
= RND * 40 + 70 ' angle vxi!
(i
) = (RND * t
+ 1) * COS(r!
) ' x velocity vyi!
(i
) = (RND * t
+ 2) * SIN(r!
) ' y velocity
tx = vox!(i) - suri ' local x
ty = voy!(i) ' local y
vox!(i) = 0 ' flag for init
c = gunmetal
IF (ty
> gety
(tx
)) AND (gstyle
= 0) THEN c
= black
' black on white c = orange
vyi!(i) = vyi!(i) - .25 ' decelerate
vox!(i) = vox!(i) - vxi!(i) ' new x
voy!(i) = voy!(i) - vyi!(i) ' new y
protect:
dx! = px! - tx ' distance x
dy! = (py! - ty) * aspect! ' distance y
dd
= SQR(dx!
* dx!
+ dy!
* dy!
) ' distance z = 1
vyi!(i) = 0
vxi!
(i
) = SGN(dx!
) * (5 + RND * 5) LINE (sx0
+ xoff
, sy0
+ vy!
)-(tx
, ty
), lmsl
' -------------------------------------------------------------------------------------------------------x
SUB Mandel
' appears in TMA-1 when landed on xd! = .044
yd! = .036
LINE (x
, glmax
- 1)-(x
+ 45, glmax
- 71), black2
, BF
MandelX! = -2 + yy * yd!
MandelY! = -1 + xx * xd!
Real# = 0
Imag# = 0
Itera = 20
Itera = Itera - 1
hold# = Imag#
Imag# = (Real# * Imag#) * 2 + MandelY!
Real# = Real# * Real# - hold# * hold# + MandelX!
Size# = (Real# * Real# + Imag# * Imag#) - 4
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
'RESTORE 2010
'FOR i = 1 TO 7
' READ z$
' tx = center - LEN(z$) * 4
' PrintVGA z$, tx, 50 + i * 13, white, 0
'NEXT i
' -------------------------------------------------------------------------------------------------------x
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
LINE (x
, y0
- 19)-(x2
, y0
- 1), tc
, BF
' sign background PrintCGA "MONTEZUMA", x + 14, 286, orange, black2, 0
c1 = green
c2 = blue
c3 = green
c1 = black2
c2 = -1
c3 = gunmetal
PrintCGA "Car Wash", x + 17, 294, c1, c2, 0
LINE (x
, y0
- 19)-(x2
, y0
- 1), c3
, B
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 x1 = x + z * t + 24
td = cwsd - 5 + i
td = -td
up = 0 ' use pattern
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 iz = iz + 1
' -------------------------------------------------------------------------------------------------------x
xc = 320: yc = 175: dty = 170
xs = 100: ys = 73: bs = ys + 6: rs = 4020 ' small
xs = 130: ys = 110: bs = ys - t: rs = 8000 ' large
wx1 = xc - xs: wx2 = xc + xs
wy1 = yc - ys: wy2 = yc + ys
dsinit = 1
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
xx = dtx - xc
yy = dty - yc
zz
= (zz
+ darkstars
) MOD 49 ' 0-48 images rn& = zz * rs * 4 + 1
n = -1
tx = xx + i
n = n + 1
LINE (tx
, j
)-(tx
, j
+ 15), tc
(k
), , buff&
(n
) IF darkstart
THEN LINE (tx
, j
+ 1)-(tx
, j
+ 16), tc
(k
), , buff&
(n
) bork:
boltx = q1 ' handy large value
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)
bolty = ty
xx
= dtx
+ r!
* COS(_D2R(a!
)) * aspect!
a!
= a!
+ RND * 2 - 1 + SGN(xx
- boltx
) * .05
nc
= RND * 3 ' "internal" lightning td
= bs \
2 + RND * bs \
2 r! = td
qq = 6
xx
= dtx
+ r!
* COS(_D2R(a!
)) * aspect!
r!
= r!
- RND * 2.18 + qq
qq = qq - 1 - (qq = 1)
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 tcc = green
Title:
IF atu
= 0 THEN atu
= t: ati
= 1 atu = atu + ati
IF (atu
= t
) OR (atu
= 25) THEN ati
= -ati
t$ = "EPCOR"
aa = -90 + (i - 3) * atu
tx
= dtx
+ bs
* COS(_D2R(aa
)) * aspect!
- 5 PrintVGA z$, tx, ty, c3, white
' -------------------------------------------------------------------------------------------------------x
cy! = cy! + 5
IF cy!
> 500 THEN cy!
= 500: chs
= 1: paraf
= 0 chs = chs - 1
cy! = py! - h
IF (py!
> 120) AND (chs
< 40) THEN chs
= chs
+ 2 tx
= px!
+ chs
* COS(r!
) * 2 IF (ta
MOD 40) = 0 THEN LINE -(px!
- ASO
, cy!
+ 82 + ASO
* t
), gray2
' -------------------------------------------------------------------------------------------------------x
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 zz
= 50 + RND * tw
' vary tail length x1
= comx
+ 3 * COS(r!
) ' tail start x2
= comx
+ zz
* COS(r!
) ' tail end LINE (x1
, y1
)-(x2
, y2
), white2
, , RND * &H7FFF ' -------------------------------------------------------------------------------------------------------x
z = 1225
cpinit = 1
' -------------------------------------------------------------------------------------------------------x
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
pconfig:
' -------------------------------------------------------------------------------------------------------x
z = 20000
henoni = 1
s&
= VARSEG(tb
(0)) ' for BLOADING images
wts
= (wts
+ 1) MOD 3 ' what to show BLOAD f$
(19), o&
' rad.dat gotblank = 0
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
z = rtlc(i) ' 0rads 1temperature 2bolts
lf = -1
PrepAndShowLED
CSNG(z
), 4, 10
nosp: ' no special = Henon plots
tf$ = f$(f)
gotblank = 0
lf = f
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
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
' -------------------------------------------------------------------------------------------------------x
tx1
= x:
IF tx1
< gs
THEN tx1
= gs
tx2
= x
+ 68:
IF tx2
> q3
THEN tx2
= q3
tc = white: tc2 = white
tc = gray: tc2 = gasoline
LINE (x
, 300)-(x
+ 68, q4
), tc
, BF
LINE (x
+ 2, 302)-(x
+ 66, 347), black2
, B
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
LINE (x
+ z
, 300 + z
)-(x
+ 68 - z
, q4
- z
), tc2
, B
z$ = " JFK R.I.P. 1917 1963"
z$ = "B FROST R.I.P. 1952 2006"
z$ = "R FROST R.I.P. 1957 2019"
PrintVGA
LEFT$(z$
, 7), x
+ 5, 317, black2
, white2
d$
= MID$(z$
, i
* 9 + 10, 9) c1 = black2: c2 = gasoline
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
' -------------------------------------------------------------------------------------------------------x
fs = 60: fq = 600: fmax = fs
DIM ve!
(fs
), ho!
(fs
), pe
(fs
), x!
(fs
), y!
(fs
), c
(fs
)
z
= SGN(sf
(sf
, 2) - (px!
+ suri
)) ' to plant flag opposite feature IF z
= 0 THEN z
= -1 ' optional, prevent middle tx = px! + i * z * 22
ty = gety(-tx)
' prevent PUT beyond 580 for grave in demo mode
flx = tx
fly = ty
rev = 0
initfw = 0
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!
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 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 initfw = 1 ' mark initialized
f = 1 ' assume done
FOR q
= 0 TO 1 ' show shell exploding 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
LINE (x!
(i
), y!
(i
))-(x!
(i
) + RND, y!
(i
) + RND), c
(i
), B
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 BLOAD f$
(19 + nation
), o&
' load array 20=USA 21=USSR sx = 0
rev = 0
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
' optional move flag to left of pole
p
= POINT(flx
+ rx
, ty
+ ry
) PSET (flx
- rx
- 2, ty
+ ry
), p
PUT (flx
, ty
), f2
(), PSET ' restore original area GET (flx
- 71, ty
)-(flx
- 2, ty
+ 32), flagb
() ' get new rev = 1
zx = flx - 71
sx = sx + t ' optional unfurl flag
LINE (zx
, ty
)-(zx
+ 71 - sx
, ty
+ 32), 0, BF
LINE (zx
+ sx
, ty
)-(zx
+ 71, ty
+ 32), 0, BF
' -------------------------------------------------------------------------------------------------------x
DIM z!
(t
), a1
(t
), v1
(t
), lz
(t
) msflag = 1
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
f$ = f$ + ".DAT"
FOR i
= 1 TO q1
' 6400, 10 pages FOR i
= 1 TO 4 ' make sine waves z! = 0
y!
= v1
(j
) * SIN((i
- a1
(j
)) * z!
(j
)) z! = z! + y! * 4
IF (i
> 5320) AND (i
< 5560) THEN z!
= z!
/ 4 - 40 ' make Hollywood higher keepflat:
FOR i
= -51 TO 51 ' volcano z
= glmax
- (51 - ABS(i
)) z = 302
FOR i
= -5 TO 5 ' volcano top IF gh
> -1 THEN ' ground height not flat, add rocks/small craters rocks
= RND * h
+ h
' rocks & indentations z
= z
- zz
* i
+ ABS(k
) * i
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
lz(i) = 320 + (i - 1) * (q3 + 1) ' 1 per page
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 'hs = (RND * 20 + 1) * -(gh <> -2) ' height of Surveyor ground
hs = 0
FOR i
= 1 TO t
' 10 features, create landing zones beside each 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
z = hs * (y = 0) * (i <> 5)
z = glmax - z
FOR x2
= sf
(i
, 0) TO sf
(i
, 1) ' target z = z + y * (y <> 0)
isvolcano:
y = 0
y = y + 1
z = glmax + y - 38
PUT #6, sf
(5, 0) + x
+ 1, z
suri = 0
FOR i
= 1 TO q1
' optional, show progress y = gh * 25 + y / 6 + 20
msflag = 0
' -------------------------------------------------------------------------------------------------------x
ac1 = red
ac2 = white2
fc$ = "0105030709101412"
a51i = 1
tx = x + 33
aa = k * 45 + z
a1! = pi! - a1!
a2! = pi! - a2!
CIRCLE (tx
, 308), i
, ac1
, a1!
, a2!
dx! = px! - tx
dy! = 280 - py!
IF contact
= 0 THEN mes$
(1) = "AREA 51 ELEVATOR ACTIVATED" LINE (tx2
, sy1
+ 2)-(tx
, 309), gray
LINE (sx1
- 1, sy1
+ 2)-(tx
, 309), black
LINE (sx2
+ 1, sy1
+ 2)-(tx
, 309), black
py! = py! + j
a = 0
thrust! = 0
vx! = 0
vy! = 0
b2b = 1
' LINE (gs, 280)-(q3, 280), red
aother:
b2b = 1 - b2b
bingo:
tx = x + i * t + 3
PrintVGA
MID$("AREA", i
, 1), tx
, 313, white2
, tc
bp
= VAL("&H" + MID$("26227E8E2E", nu
* 5 + ty
+ 1, 1)) sp = 1
tx2 = x + 52 - tx * 4 - nu * 16
ty2 = 309 + ty * 5 + 15
bp = bp \ 2
zc
= (zc
+ 1) MOD 8 ' color IF c$
<> "." THEN ' . = transparent tc = red
tc = black2 ' eyes/nose/mouth
x2 = x + j + t
y2 = 312 + i
' -------------------------------------------------------------------------------------------------------x
SUB UFO
(tx0
, ty0
, txi
) STATIC ' so pathetic a graphic that it's funny, maybe CIRCLE (tx
, ty
), i
, gunmetal
, , , .15 CIRCLE (tx
, ty
- 12), i
, tc
, , , .35 tx2 = tx + z * 16
PAINT (tx2
, ty
), tc2
, black2
LINE (tx
- 30, ty
+ 8)-(tx
- 35, ty
+ 20), orange
' legs LINE (tx
- 37, ty
+ 20)-(tx
- 31, ty
+ 20), orange
LINE (tx
+ 30, ty
+ 8)-(tx
+ 35, ty
+ 20), orange
' pads LINE (tx
+ 32, ty
+ 20)-(tx
+ 38, ty
+ 20), orange
' -------------------------------------------------------------------------------------------------------x
IF fontinit
= 0 THEN ' initialize sp(n, i) = z * 4096
fontinit = 1
IF (tc
= 1) AND (RND > .9) THEN ttc
= 3 ELSE ttc
= tc
' Borg effect (some bright) x2 = tx + z * 4 + j - 4
LINE (x2
, ty
+ i
)-(x2
+ 4, ty
+ i
), ABS(ttc
), , sp
(d
, i
) ' -------------------------------------------------------------------------------------------------------x
spq = t: psp = 500
speedi = 1
zmin! = h
zran! = 2
sphac = psp + 1
_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
spt!
(spq
) = (TIMER - spt!
) * h
* t
z! = 0
z! = z! + spt!(i)
pspeed(psp) = z! / spq
spmin = q1: spmax = -spmin
sphac = sphac - 1 - (sphac = 0)
spx = 113 + i
spy = zmin! + (pspeed(i) - zmin!) / zran!
IF pspeed
(i
) <= spmin
THEN spmin
= pspeed
(i
): spminx
= spx: spminy
= spy
IF pspeed
(i
) >= spmax
THEN spmax
= pspeed
(i
): spmaxx
= spx: spmaxy
= spy
spsta
= FIX(spmin
/ h
) * h
spend
= INT(spmax
/ h
+ pf!
) * h
spend = spend - (spend = spsta) * h
spy = zmin! + (i - zmin!) / zran!
LINE (110, spy
)-(614, spy
), green
, , &H1111 TinyFont z$, 87, spy - 2, orange
TinyFont z$, 620, spy - 2, orange
ty = spminy - 15
TinyFont z$, spminx + 5, ty, orange
LINE (spminx
, ty
+ 5)-(spminx
, ty
- 5), orange
ty = spmaxy + 15
TinyFont z$, spmaxx + 5, ty, orange
LINE (spmaxx
, ty
)-(spmaxx
, ty
+ t
), orange
' -------------------------------------------------------------------------------------------------------x
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 y1 = gh(i1)
y2 = gh(i2)
m! = (y1 + y2) / 2
d! = (y1 - y2) / zz / 2
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 msflag = 0 THEN
' IF gc(i1) = gray THEN gc(i1) = red
' IF gc(i2) = gray THEN gc(i2) = yellow
'END IF
' -------------------------------------------------------------------------------------------------------x
SUB SaveImage
(f$
) ' this sub from qb64.org website (modified) 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)) MID$(b$
, 11, 4) = MKL$(LEN(b$
)) ' image pixel data offset (BMP header) z$ = ""
c&
= POINT(px&
, py&
) ' 2 bit values are large LONG values d$ = d$ + z$ + padder$
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) ' -------------------------------------------------------------------------------------------------------x
SUB MakeStarFiles
' takes a LONG time savestarfiles = starfiles
mstar = 0
mstar = mstar + 1 ' for progress bar
starinit = 0
regen = 1
Stars
mstar = 0
sprint ts$, 200, 100, red, black
sprint
TIME$, 200, 120, red
, black
timemachine
SLEEP ' lets user see how LONG it took starfiles = savestarfiles: starinit = 0: rmin = 0: dmin = 0
'Stars ' is this necessary?
' -------------------------------------------------------------------------------------------------------x
'LINE (0, 470)-(639, 479), 0, BF
np = 0
timemachine
np = np + 1
' -------------------------------------------------------------------------------------------------------x
SUB timemachine
' xlate to 32 bit color for green screen, warp effects tred
= INP(&H3C9) * 4: tgrn
= INP(&H3C9) * 4: tblu
= INP(&H3C9) * 4 coav = (tred + tgrn + tblu) \ 3
oc&
(i
) = _RGB32(tred
, tgrn
, tblu
) ' regular color oc&
(i
) = _RGB32(0, coav
, 0) ' shades of green oc&
(i
) = _RGB32(coav
, coav
, coav
) ' black and white
DO:
_LIMIT q4
' 349 (h/100 too little, slows down program!) LOOP UNTIL tempimage&
< -1 ' try until valid (can fail to make screen) FOR y
= 0 TO q4
' replot each pixel of old to new screen a& = y * 640 + x
VIEW SCREEN(gs
, SGN(LEN(mes$
(0))) * 20)-(q3
, q4
) ' protect instrument panel, top line if message active VIEW SCREEN(gs
, 0)-(q3
, q4
) ' back to normal, only instrument panel protected SCREEN canvas&
' back to old mode so the rest of the program can run _MEMFREE m
' would run out of memory otherwise ' -------------------------------------------------------------------------------------------------------x
wa2 = wa1
wx! = 320 + 70 * s!(wa1)
wy! = 175 + 70 * c!(wa1)
wc1 = 200
wa2 = wa2 + 2
wd2
= 20 * s!
((ABS(wa1
- 256) * 5) MOD tsix
) wd3 = wd1 + wd2
wde
= (wa2
+ 90 * z
) MOD tsix
wtx = wx! + wd3 * s!(wde)
wty = wy! + wd3 * c!(wde)
' -------------------------------------------------------------------------------------------------------x
wx! = 320 + 70 * s!(wa1)
wy! = 175 + 70 * c!(wa1)
DIM distance
(360), elevation
(360), active
(10), angle
(10) e0 = 320
angle = angle(i)
angle
= (angle
+ tsix
) MOD tsix
active(i) = angle
distance
(angle
) = 50 + RND * 150 elevation
(angle
) = 100 + RND * 150 n = n + 1
active(n) = active(1)
distance(active(n)) = distance(active(1))
elevation(active(n)) = elevation(active(1))
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)
a! = a! + ai!
z! = s!(a!) * s!(a!)
distance(na) = distance(angle1) + ddif! * z!
elevation(na) = elevation(angle1) + edif! * z!
zz
= 155 * s!
((ABS(el
) * 3) MOD tsix
) + 100 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)
genang:
zz = 420 / n
ta
= (i
- 2) * zz
+ INT(RND * 10) - 5 + 30 sort:
sorted = 1
a1 = angle(i)
a2 = angle(i + 1)
IF a1
> a2
THEN sorted
= 0:
SWAP angle
(i
), angle
(i
+ 1) a1 = angle(i)
a2 = angle(i + 1)
' -------------------------------------------------------------------------------------------------------x
' -------------------------------------------------------------------------------------------------------x