Posts: 229
Threads: 25
Joined: Aug 2022
Reputation:
23
(09-07-2022, 06:07 AM)johnno56 Wrote: Nicely done. Return trip was a bit nerve racking... but fun...
Thanks!
Posts: 229
Threads: 25
Joined: Aug 2022
Reputation:
23
Another update: added some indicators to (maybe) help pilot the ship. And a fancy intro when starting the game.
Code: (Select All) 'Space Lander
'james2464
'Sept 2022
Dim scx, scy As Integer
'screen size
scx = 1100 ' 640 min --- 1600 max made for 1100
scy = 600 ' 480 min --- 700 max made for 600
Screen _NewImage(scx, scy, 32)
Randomize Timer
Const PI = 3.141592654#
Dim thrust&
thrust& = _SndOpen("thrustsnd.ogg")
Dim snap&, bgsnap&
snap& = _NewImage(60, 60, 32)
bgsnap& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared c0(100) As Long
c0(0) = _RGB(0, 0, 0)
c0(1) = _RGBA(255, 255, 255, 150)
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(150, 150, 255)
c0(4) = _RGB(0, 200, 50)
c0(5) = _RGB(105, 100, 95)
c0(6) = _RGB(55, 50, 45)
c0(7) = _RGB(255, 50, 50)
c0(8) = _RGB(125, 125, 200)
c0(9) = _RGB(50, 150, 255)
c0(10) = _RGB(255, 200, 125)
c0(11) = _RGB(23, 20, 17)
c0(12) = _RGBA(6, 3, 0, 100) 'terrain texture
c0(14) = _RGBA(255, 255, 255, 50)
c0(15) = _RGBA(255, 255, 255, 250)
c0(16) = _RGB(150, 150, 150)
c0(17) = _RGBA(0, 255, 0, 90)
c0(18) = _RGB(15, 15, 15)
c0(20) = _RGB(120, 120, 170) 'ship
c0(21) = _RGB(150, 150, 200) 'ship
c0(22) = _RGB(170, 170, 220) 'ship
c0(23) = _RGB(180, 180, 230) 'ship
c0(30) = _RGBA32(255, 255, 150, 160) 'ship exhaust
c0(31) = _RGBA32(255, 255, 150, 80) 'ship exhaust
c0(32) = _RGBA32(255, 255, 150, 40) 'ship exhaust
c0(33) = _RGBA32(255, 255, 150, 20) 'ship exhaust
c0(34) = _RGBA32(255, 220, 0, 200) 'ship exhaust
c0(35) = _RGBA32(255, 220, 0, 100) 'ship exhaust
c0(36) = _RGBA32(255, 220, 0, 70) 'ship exhaust
c0(37) = _RGBA32(255, 220, 0, 40) 'ship exhaust
c0(38) = _RGBA32(255, 220, 0, 10) 'ship exhaust
c0(39) = _RGBA32(255, 220, 0, 0) 'ship exhaust
Dim xx, yy
xx = scx / 2
yy = scy / 2
Type BB
live As Integer
x As Single
y As Single
xv As Single
yv As Single
age As Integer
rad As Integer
spd As Single
colour As Integer
End Type
Dim Shared bnb(900) As BB
Type landingpad
x1 As Single
y1 As Single
x2 As Single
y2 As Single
colour As Integer
count As Integer
End Type
Dim Shared pad(100) As landingpad
Dim Shared j
Cls
'Color , &HFF000000 '= black background
j = 1
bnb(j).x = xx
bnb(j).y = yy
drawship j, c0, bnb
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(9), BF
_PutImage (0, 0), 0, snap&, (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 30, bnb(j).y + 30)
_ClearColor &HFF000000, snap&
Cls
'add stars
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 1999)
If ttt > 1994 Then
c0(99) = Point(tx, ty)
If c0(99) = c0(0) Then
PSet (tx, ty), c0(14)
If ttt > 1997 Then
PSet (tx, ty), c0(1)
End If
xl = Int(Rnd * 100)
If xl > 98 Then
PSet (tx, ty), c0(15)
PSet (tx + 1, ty), c0(1)
PSet (tx, ty - 1), c0(1)
PSet (tx - 1, ty), c0(1)
PSet (tx, ty + 1), c0(1)
End If
End If
End If
Next ty
Next tx
Next tt
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
'rotate ship
Cls
flag = 0
rad = (xx * .9)
ds = .5 'step interval
si = 40 'size of image
sc = 15 'scale
dv = .020
df = 9000
flog = 2
If flog > 1 Then
_AutoDisplay
_Limit 30
For j = 1 To 90 Step ds
k = rad * (Cos(j * (PI / 180)))
sz = si + ((Sqr(rad ^ 2 - k ^ 2)) / sc)
_Display
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen background only
_PutImage (xx + k - sz, yy - sz)-(xx + k + sz, yy + sz), snap&, 0
d2 = sz / df
_Delay dv - d2
Next j
_AutoDisplay
For j = 90 To 1 Step -ds
k = rad * (Cos(j * (PI / 180)))
sz = si + ((Sqr(rad ^ 2 - k ^ 2)) / sc)
_Display
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen background only
_PutImage (xx - k - sz, yy - sz)-(xx - k + sz, yy + sz), snap&, 0
d2 = sz / df
_Delay dv - d2
Next j
_AutoDisplay
For j = 1 To 90 Step ds
k = rad * (Cos(j * (PI / 180)))
sz = si - ((Sqr(rad ^ 2 - k ^ 2)) / sc)
_Display
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen background only
_PutImage (xx - k - sz, yy - sz)-(xx - k + sz, yy + sz), snap&, 0
d2 = sz / df
_Delay dv + d2
Next j
ds = 3
_AutoDisplay
For j = xx To scx Step ds
_Display
sz = sz * .99
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen background only
_PutImage (j - k - sz, yy - sz)-(j - k + sz, yy + sz), snap&, 0
Next j
End If
_AutoDisplay
'display title
x77 = xx
y77 = yy - 35
'---- SPACE horizontal
Line (x77 - 100, y77 - 30)-(x77 - 70, y77 - 28), c0(9), BF
Line (x77 - 105, y77 - 1)-(x77 - 75, y77 + 1), c0(9), BF
Line (x77 - 110, y77 + 30)-(x77 - 80, y77 + 28), c0(9), BF
'--
Line (x77 - 60, y77 - 30)-(x77 - 30, y77 - 28), c0(9), BF
Line (x77 - 65, y77 - 1)-(x77 - 35, y77 + 1), c0(9), BF
'--
Line (x77 - 25, y77 - 1)-(x77 + 5, y77 + 1), c0(9), BF
'--
Line (x77 + 20, y77 - 30)-(x77 + 50, y77 - 28), c0(9), BF
Line (x77 + 10, y77 + 30)-(x77 + 40, y77 + 28), c0(9), BF
'--
Line (x77 + 60, y77 - 30)-(x77 + 90, y77 - 28), c0(9), BF
Line (x77 + 55, y77 - 1)-(x77 + 85, y77 + 1), c0(9), BF
Line (x77 + 50, y77 + 30)-(x77 + 80, y77 + 28), c0(9), BF
'---- SPACE vertical
Line (x77 - 100, y77 - 30)-(x77 - 105, y77 + 1), c0(9)
Line (x77 - 98, y77 - 30)-(x77 - 103, y77 + 1), c0(9)
Line (x77 - 75, y77 + 1)-(x77 - 80, y77 + 30), c0(9)
Line (x77 - 73, y77 + 1)-(x77 - 78, y77 + 28), c0(9)
'--
Line (x77 - 60, y77 - 30)-(x77 - 70, y77 + 30), c0(9)
Line (x77 - 58, y77 - 30)-(x77 - 68, y77 + 30), c0(9)
Line (x77 - 70, y77 - 30)-(x77 - 68, y77 - 30), c0(9)
Line (x77 - 30, y77 - 30)-(x77 - 35, y77 - 1), c0(9)
Line (x77 - 28, y77 - 30)-(x77 - 33, y77 - 1), c0(9)
'--
Line (x77 - 6, y77 - 30)-(x77 - 4, y77 - 30), c0(9)
Line (x77 - 25, y77 - 1)-(x77 - 6, y77 - 30), c0(9)
Line (x77 - 23, y77 - 1)-(x77 - 5, y77 - 28), c0(9)
Line (x77 - 4, y77 - 30)-(x77 + 5, y77 - 1), c0(9)
Line (x77 - 5, y77 - 28)-(x77 + 3, y77 - 1), c0(9)
Line (x77 - 25, y77 + 1)-(x77 - 30, y77 + 30), c0(9)
Line (x77 - 23, y77 + 1)-(x77 - 28, y77 + 30), c0(9)
Line (x77 + 5, y77 - 1)-(x77 + 0, y77 + 30), c0(9)
Line (x77 + 3, y77 - 1)-(x77 - 2, y77 + 30), c0(9)
Line (x77 - 30, y77 + 30)-(x77 - 28, y77 + 30), c0(9)
Line (x77 - 0, y77 + 30)-(x77 - 2, y77 + 30), c0(9)
'--
Line (x77 + 20, y77 - 28)-(x77 + 10, y77 + 28), c0(9)
Line (x77 + 22, y77 - 28)-(x77 + 12, y77 + 28), c0(9)
'--
Line (x77 + 60, y77 - 28)-(x77 + 50, y77 + 28), c0(9)
Line (x77 + 62, y77 - 28)-(x77 + 52, y77 + 28), c0(9)
'---- LANDER horizontal
Line (x77 - 120, y77 + 90)-(x77 - 95, y77 + 88), c0(9), BF
'--
Line (x77 - 80, y77 + 66)-(x77 - 55, y77 + 64), c0(9), BF
'--
Line (x77 + 30, y77 + 40)-(x77 + 55, y77 + 42), c0(9), BF
Line (x77 + 25, y77 + 64)-(x77 + 50, y77 + 66), c0(9), BF
Line (x77 + 20, y77 + 90)-(x77 + 45, y77 + 88), c0(9), BF
'--
Line (x77 + 65, y77 + 40)-(x77 + 90, y77 + 42), c0(9), BF
Line (x77 + 60, y77 + 64)-(x77 + 85, y77 + 66), c0(9), BF
'---- LANDER vertical
Line (x77 - 110, y77 + 40)-(x77 - 120, y77 + 90), c0(9)
Line (x77 - 108, y77 + 40)-(x77 - 118, y77 + 90), c0(9)
Line (x77 - 110, y77 + 40)-(x77 - 108, y77 + 40), c0(9)
'--
Line (x77 - 63, y77 + 40)-(x77 - 61, y77 + 40), c0(9)
Line (x77 - 80, y77 + 64)-(x77 - 63, y77 + 40), c0(9)
Line (x77 - 78, y77 + 64)-(x77 - 62, y77 + 42), c0(9)
Line (x77 - 61, y77 + 40)-(x77 - 55, y77 + 64), c0(9)
Line (x77 - 62, y77 + 42)-(x77 - 57, y77 + 64), c0(9)
Line (x77 - 80, y77 + 66)-(x77 - 85, y77 + 90), c0(9)
Line (x77 - 78, y77 + 66)-(x77 - 83, y77 + 90), c0(9)
Line (x77 - 85, y77 + 90)-(x77 - 83, y77 + 90), c0(9)
Line (x77 - 57, y77 + 66)-(x77 - 62, y77 + 90), c0(9)
Line (x77 - 55, y77 + 66)-(x77 - 60, y77 + 90), c0(9)
Line (x77 - 62, y77 + 90)-(x77 - 60, y77 + 90), c0(9)
'--
Line (x77 - 40, y77 + 40)-(x77 - 50, y77 + 90), c0(9)
Line (x77 - 38, y77 + 44)-(x77 - 48, y77 + 90), c0(9)
Line (x77 - 15, y77 + 40)-(x77 - 25, y77 + 90), c0(9)
Line (x77 - 17, y77 + 40)-(x77 - 27, y77 + 86), c0(9)
Line (x77 - 40, y77 + 40)-(x77 - 38, y77 + 40), c0(9)
Line (x77 - 38, y77 + 40)-(x77 - 27, y77 + 86), c0(9)
Line (x77 - 38, y77 + 48)-(x77 - 28, y77 + 90), c0(9)
Line (x77 - 50, y77 + 90)-(x77 - 48, y77 + 90), c0(9)
Line (x77 - 27, y77 + 90)-(x77 - 25, y77 + 90), c0(9)
Line (x77 - 17, y77 + 40)-(x77 - 15, y77 + 40), c0(9)
'--
Line (x77 - 5, y77 + 40)-(x77 - 15, y77 + 90), c0(9)
Line (x77 - 3, y77 + 45)-(x77 - 13, y77 + 87), c0(9)
Line (x77 - 5, y77 + 40)-(x77 - 3, y77 + 40), c0(9)
Line (x77 - 3, y77 + 40)-(x77 + 15, y77 + 65), c0(9)
Line (x77 - 13, y77 + 90)-(x77 + 15, y77 + 65), c0(9)
Line (x77 - 13, y77 + 87)-(x77 + 12, y77 + 65), c0(9)
Line (x77 - 3, y77 + 45)-(x77 + 12, y77 + 65), c0(9)
'--
Line (x77 + 30, y77 + 40)-(x77 + 20, y77 + 90), c0(9)
Line (x77 + 32, y77 + 42)-(x77 + 22, y77 + 88), c0(9)
'--
Line (x77 + 65, y77 + 40)-(x77 + 55, y77 + 90), c0(9)
Line (x77 + 67, y77 + 42)-(x77 + 57, y77 + 90), c0(9)
Line (x77 + 55, y77 + 90)-(x77 + 57, y77 + 90), c0(9)
Line (x77 + 90, y77 + 40)-(x77 + 85, y77 + 66), c0(9)
Line (x77 + 87, y77 + 42)-(x77 + 83, y77 + 64), c0(9)
Line (x77 + 64, y77 + 66)-(x77 + 80, y77 + 90), c0(9)
Line (x77 + 62, y77 + 68)-(x77 + 77, y77 + 90), c0(9)
Line (x77 + 77, y77 + 90)-(x77 + 80, y77 + 90), c0(9)
Sleep
Cls
Locate 20, 40
Print "Land carefully on each pad. Return to the starting pad to complete."
Sleep
Do
Cls
'lower random landscape
j = 0
jj = 0
k = 170
Do
j = j + 1
jj = jj + 1
If jj > 8 Then
r = Int(Rnd * 5) - 2
jj = 0
End If
k = k + r
If k > 220 Then
k = k - r
End If
If k < 120 Then
k = k - r
End If
Line (j, scy - k)-(j, scy), c0(6)
Loop Until j >= scx
'add texture to terrain
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 18)
If ttt > 16 Then
c0(99) = Point(tx, ty)
If c0(99) <> c0(0) Then
Line (tx, ty)-(tx + 2, ty + 2), c0(12), BF
End If
End If
Next ty
Next tx
Next tt
'===== ground
Line (0, scy - 20)-(scx, scy), c0(5), BF
'===== right wall
Line (scx - 40, 0)-(scx, scy - 20), c0(5), BF
'===== left wall
Line (0, 0)-(40, scy - 20), c0(5), BF
'initialize pads
pad(1).x1 = scx / 10
pad(1).x2 = pad(1).x1 + 100
pad(1).y1 = scy - 80
pad(1).y2 = pad(1).y1 + 2
pad(1).colour = 5
pad(1).count = 0
pad(2).x1 = scx / 3 + 50
pad(2).x2 = pad(2).x1 + 75
pad(2).y1 = scy - 50
pad(2).y2 = pad(2).y1 + 2
pad(2).colour = 5
pad(2).count = 0
pad(3).x1 = scx / 2 + 50
pad(3).x2 = pad(3).x1 + 50
pad(3).y1 = scy - 90
pad(3).y2 = pad(3).y1 + 2
pad(3).colour = 5
pad(3).count = 0
pad(4).x1 = scx - 120
pad(4).x2 = pad(4).x1 + 40
pad(4).y1 = scy - 50
pad(4).y2 = pad(4).y1 + 2
pad(4).colour = 5
pad(4).count = 0
'===== pad 1
Line (pad(1).x1, yy)-(pad(1).x2, pad(1).y1), c0(0), BF
'===== pad 2
Line (pad(2).x1, yy)-(pad(2).x2, pad(2).y1), c0(0), BF
'===== pad 3
Line (pad(3).x1, yy)-(pad(3).x2, pad(3).y1), c0(0), BF
'===== pad 4
Line (pad(4).x1, yy)-(pad(4).x2, pad(4).y1), c0(0), BF
'add stars
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 1999)
If ttt > 1994 Then
c0(99) = Point(tx, ty)
If c0(99) = c0(0) Then
PSet (tx, ty), c0(14)
If ttt > 1997 Then
PSet (tx, ty), c0(1)
End If
xl = Int(Rnd * 100)
If xl > 98 Then
PSet (tx, ty), c0(15)
PSet (tx + 1, ty), c0(1)
PSet (tx, ty - 1), c0(1)
PSet (tx - 1, ty), c0(1)
PSet (tx, ty + 1), c0(1)
End If
End If
End If
Next ty
Next tx
Next tt
'===== pad 1
Line (pad(1).x1, pad(1).y1)-(pad(1).x2, pad(1).y2), c0(pad(1).colour), BF
'===== pad 2
Line (pad(2).x1, pad(2).y1)-(pad(2).x2, pad(2).y2), c0(pad(2).colour), BF
'===== pad 3
Line (pad(3).x1, pad(3).y1)-(pad(3).x2, pad(3).y2), c0(pad(3).colour), BF
'===== pad 4
Line (pad(4).x1, pad(4).y1)-(pad(4).x2, pad(4).y2), c0(pad(4).colour), BF
'===== parameters
dv = .027 ' time delay value
stx = pad(4).x1 + 20 'starting pos x
sty = pad(4).y1 - 20 'starting pos y
bnb(1).live = 1
bnb(1).colour = 3
bnb(1).x = stx
bnb(1).y = sty
j = 1
'game objective - to land safely on all 4 pads, the last one must be pad 4
'ship starts at pad 4
'======== main loop
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
flag = 0
Do
_Limit 30
'check for stray sounds
silence = 0
If _KeyDown(18432) Then silence = silence + 1
If _KeyDown(19200) Then silence = silence + 1
If _KeyDown(19712) Then silence = silence + 1
If silence = 0 Then 'there should be no thrust sound
If _SndPlaying(thrust&) Then _SndStop (thrust&)
End If
'update screen
keyfire1 = 0
keyfire2 = 0
keyfire3 = 0
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
'find what's changed before drawing ship again
'what colour pixels are beneath the ship?
'need to rule out the sky somehow, so this can't interfere with the ship
skpttot = 0
c0(99) = Point(bnb(j).x - 16, bnb(j).y + 20)
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
skptl = 0
Else
skptl = 1
End If
c0(99) = Point(bnb(j).x + 16, bnb(j).y + 20)
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
skptr = 0
Else
skptr = 1
End If
skpttot = skptl + skptr
If skpttot > 0 Then
ccflag = 1 'contact
If bnb(j).yv > .5 Then ccflag = 2 ' was landing too hard?
Else
ccflag = 0 'no contact
End If
gravityadd = .025
bnb(j).yv = bnb(j).yv + gravityadd
If ccflag = 0 Then 'if ship is flying
'=============== player input
If _KeyDown(18432) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).yv = bnb(j).yv - .05
keyfire1 = 1
End If
If bnb(j).yv > 10 Then bnb(j).yv = 10
If bnb(j).yv < -10 Then bnb(j).yv = -10
If _KeyDown(19200) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).xv = bnb(j).xv - .03
keyfire2 = 1
End If
If bnb(j).xv < -5 Then bnb(j).xv = -5
If _KeyDown(19712) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).xv = bnb(j).xv + .03
keyfire3 = 1
End If
If bnb(j).xv > 5 Then bnb(j).xv = 5
'if ship is not landed anywhere
bnb(j).x = bnb(j).x + bnb(j).xv
bnb(j).y = bnb(j).y + bnb(j).yv
If bnb(j).x < 50 Then bnb(j).x = 50
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
'ship
drawship j, c0, bnb
If keyfire1 = 1 Then
fire1 j, c0, bnb
End If
If keyfire2 = 1 Then
fire2 j, c0, bnb
End If
If keyfire3 = 1 Then
fire3 j, c0, bnb
End If
Else 'ship is touching down
'check to see if on a pad
px = bnb(j).x: py = bnb(j).y
pc = pad(1).count + pad(2).count + pad(3).count
For t = 1 To 4
If px > pad(t).x1 + 16 And px < pad(t).x2 - 16 And pad(t).count = 0 Then
If t < 4 Then
pad(t).count = 1
If ccflag = 1 Then
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(4), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
Else
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(2), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
End If
Else
If pc = 3 Then
pad(t).count = 1
If ccflag = 1 Then
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(4), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
Else
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(2), BF
eraseship j, c0, bnb
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
End If
End If
End If
End If
Next t
If pad(4).count = 1 Then
flag = 1
End If
'=============== player input
If _KeyDown(18432) Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust&
bnb(j).yv = bnb(j).yv - .05
keyfire1 = 1
End If
If bnb(j).yv > 10 Then bnb(j).yv = 10
If bnb(j).yv < -10 Then bnb(j).yv = -10
'if ship is landed
bnb(j).xv = bnb(j).xv * .6 'cancel out most of existing x velocity
If bnb(j).yv > 0 Then bnb(j).yv = 0 'cancel y velocity if heading down
bnb(j).x = bnb(j).x + bnb(j).xv
bnb(j).y = bnb(j).y + bnb(j).yv
If bnb(j).x < 50 Then bnb(j).x = 50
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
'ship
drawship j, c0, bnb
If keyfire1 = 1 Then
fire1 j, c0, bnb
End If
End If
blink = blink + 1
If blink < 25 Then
bk = 0
End If
If blink > 24 Then
bk = 9
End If
If blink > 50 Then blink = 0
If ccflag = 0 Then
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(bk), BF
Else
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(4), BF
End If
Line (45, 4)-(229, 188), c0(9), BF
_PutImage (0, 0), 0, snap&, (bnb(j).x - 30, bnb(j).y - 20)-(bnb(j).x + 30, bnb(j).y + 40)
_PutImage (47, 6)-(227, 186), snap&, 0
dy = Int(bnb(j).yv * 30)
If dy > 70 Then dy = 70
If dy < -70 Then dy = -70
dx = Int(bnb(j).xv * 30 + .49)
If dx > 70 Then dx = 70
If dx < -70 Then dx = -70
Line (222, 26)-(227, 166), c0(18), BF 'y axis
Line (222, 96)-(227, 96), c0(1), BF 'y axis centerline
Line (222, 97)-(227, 107), c0(17), BF 'y axis safe zone
Line (222, 96 + dy)-(227, 96 + dy), c0(2), BF 'y axis indicator
Line (67, 181)-(207, 186), c0(18), BF 'x axis
Line (137, 181)-(137, 186), c0(1), BF 'x axis centerline
Line (137 + dx, 181)-(137 + dx, 186), c0(2), BF 'x axis indicator
_Delay dv
_Display
Loop Until flag = 1
_Delay 4.0
Cls
Loop
End
Sub eraseship (j, c0, bnb)
Line (bnb(j).x - 16, bnb(j).y - 15)-(bnb(j).x + 16, bnb(j).y + 19), c0(0), BF
End Sub
Sub drawship (j, c0, bnb)
Line (bnb(j).x - 3, bnb(j).y - 14)-(bnb(j).x + 3, bnb(j).y - 13), c0(22), BF
Line (bnb(j).x - 5, bnb(j).y - 12)-(bnb(j).x + 5, bnb(j).y - 11), c0(21), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x - 16, bnb(j).y + 19), c0(20) 'long struts
Line (bnb(j).x + 6, bnb(j).y - 10)-(bnb(j).x + 16, bnb(j).y + 19), c0(20) 'long struts
Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 2), c0(20) 'short struts
Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 2), c0(20) 'short struts
Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(20) 'engine
Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(20) 'engine
Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(20) 'engine
'highlights
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x - 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x + 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x - 5, bnb(j).y - 10)-(bnb(j).x - 4, bnb(j).y + 4), c0(21), BF
Line (bnb(j).x + 5, bnb(j).y - 10)-(bnb(j).x + 4, bnb(j).y + 4), c0(21), BF
Line (bnb(j).x - 3, bnb(j).y - 10)-(bnb(j).x - 2, bnb(j).y + 4), c0(22), BF
Line (bnb(j).x + 3, bnb(j).y - 10)-(bnb(j).x + 2, bnb(j).y + 4), c0(22), BF
Line (bnb(j).x + 1, bnb(j).y - 10)-(bnb(j).x - 1, bnb(j).y + 4), c0(23), BF
End Sub
Sub fire1 (j, c0, bnb)
Line (bnb(j).x - 2, bnb(j).y + 8)-(bnb(j).x + 2, bnb(j).y + 9), c0(30), BF
Line (bnb(j).x - 2, bnb(j).y + 10)-(bnb(j).x + 2, bnb(j).y + 10), c0(31), BF
Line (bnb(j).x - 2, bnb(j).y + 11)-(bnb(j).x + 2, bnb(j).y + 12), c0(32), BF
Line (bnb(j).x - 2, bnb(j).y + 13)-(bnb(j).x + 2, bnb(j).y + 15), c0(33), BF
End Sub
Sub fire2 (j, c0, bnb)
Line (bnb(j).x + 7, bnb(j).y - 5)-(bnb(j).x + 12, bnb(j).y - 4), c0(31), BF
End Sub
Sub fire3 (j, c0, bnb)
Line (bnb(j).x - 7, bnb(j).y - 5)-(bnb(j).x - 12, bnb(j).y - 4), c0(31), BF
End Sub
Posts: 3,936
Threads: 175
Joined: Apr 2022
Reputation:
216
For some reason it was easier to fly this time around? Anyway I found you can get stuck under the magnified picture:
![[Image: image-2022-09-07-193402690.png]](https://i.ibb.co/rkNrDjh/image-2022-09-07-193402690.png)
b = b + ...
Posts: 229
Threads: 25
Joined: Aug 2022
Reputation:
23
Yeah, there's a few ways to get stuck. Another one is just going into the side of a wall. One day I'll spend time fixing that.
Posts: 176
Threads: 13
Joined: Apr 2022
Reputation:
5
Ah! Just figured out that landing on the pad too fast is bad... Doh! It's a good thing that I have 'plenty' of fuel... Nudge. Nudge. Wink. Wink....
J
May your journey be free of incident. Live long and prosper.
Posts: 229
Threads: 25
Joined: Aug 2022
Reputation:
23
(09-08-2022, 05:10 AM)johnno56 Wrote: Ah! Just figured out that landing on the pad too fast is bad... Doh! It's a good thing that I have 'plenty' of fuel... Nudge. Nudge. Wink. Wink....
J
Haha...the days of unlimited fuel are almost over
Posts: 176
Threads: 13
Joined: Apr 2022
Reputation:
5
Aw! I did not see 'that' one coming... lol If ever you decide to add a scoring system, I have seen this style of game many years ago, where the narrower the landing pad the higher the score: eg: Wide pads 50 points; narrow pads 100+ points or you could be the 'nasty' person who includes a simple particle system and enjoys watching players crash and burn... Moo Ha Ha....
May your journey be free of incident. Live long and prosper.
Posts: 229
Threads: 25
Joined: Aug 2022
Reputation:
23
09-11-2022, 11:28 PM
(This post was last modified: 09-12-2022, 02:48 PM by james2464.)
Latest version: more bells and whistles added.
I tried a bunch of new things with this version. For example my first use of _Function. And I started to condense the program while simultaneously adding a bunch of non condensed stuff. Haha, still work to do. I'm still wrestling with Sub/Endsub, _Display/_AutoDisplay but I've learned quite a bit more since the last update. Even worked out how to create, copy and rotate small images. And managed to work out some collision detection. Cheers.
Edit: improved explosion effect
Code: (Select All) 'Space Lander
'james2464
'Sept 2022
Dim Shared scx, scy As Integer
'screen size
scx = 1100 ' 640 min --- 1600 max made for 1100
scy = 600 ' 480 min --- 700 max made for 600
Screen _NewImage(scx, scy, 32)
Dim Shared xx, yy
xx = scx / 2
yy = scy / 2
Randomize Timer
Const PI = 3.141592654#
Dim thrust&
thrust& = _SndOpen("thrustsnd.ogg")
Dim Shared snap&, snap2&, bgsnap&, bgsnap2&
snap& = _NewImage(60, 60, 32)
snap2& = _NewImage(60, 60, 32)
bgsnap& = _NewImage(scx + 1, scy + 1, 32)
bgsnap2& = _NewImage(scx + 1, scy + 1, 32)
Dim Shared ship(100) As Long
Dim Shared c0(100) As Long
colour1 c0 'sub with all the colours pre-defined
Type BB
x As Single
y As Single
xv As Single
yv As Single
live As Integer
age As Integer
rad As Integer
spd As Single
colour As Integer
fuel As Integer
End Type
Dim Shared bnb(900) As BB
Type landingpad
x1 As Single
y1 As Single
x2 As Single
y2 As Single
colour As Integer
count As Integer
End Type
Dim Shared pad(100) As landingpad
Dim Shared j
Cls
'create ship image with clear background
j = 1
bnb(j).x = xx
bnb(j).y = yy
drawship j, c0, bnb
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(9), BF
_PutImage (0, 0), 0, snap2&, (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 30, bnb(j).y + 30)
Dim Shared ctt, angle
Dim Shared keyfire(3)
Cls
Locate 20, 65
Print "STARTING...."
'create 72 rotated ship images with clear background
For ctt = 1 To 72
rotate1 ship, angle, ctt, snap2&
_ClearColor &HFF000000, ship(ctt)
Next ctt
_ClearColor &HFF000000, snap2&
'game start intro
Cls
animate1
animateshuffle = 1
title1
Sleep
Cls
_PrintMode _KeepBackground
Locate 20, 40: Print "Land carefully on each pad. Finish where you started."
Sleep
Locate 22, 40: Print "Soft landing = Pad turns GREEN. (RECEIVE FUEL BONUS)"
Sleep
Locate 24, 40: Print "Complete challenge by soft landing on the final pad."
Sleep
maxfuel = 1000
Do 'start of new level
gameover = 0
Cls
setscreen1 c0, scx, scy, yy, pad
dv = .027 ' time delay / game speed
stx = pad(4).x1 + 20 'ship starting pos x
sty = pad(4).y1 - 20 'ship starting pos y
bnb(1).x = stx: bnb(1).y = sty
j = 1
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
flag = 0
bnb(1).fuel = maxfuel
ccflag = 0 'crash conditions reset for next round
bnb(j).xv = 0 'reset velocity
bnb(j).yv = 0 'reset velocity
Do '======================================= main game loop
_Limit 30
clearset keyfire, bnb, thrust& ' clear screen, key presses and sound
'====================================================================================================
If ccflag < 3 Then
' check around the ship and determine the conditions
'what colour pixels are beneath the ship?
'sky pixels are all rgb32 with equal values eg 100,100,100 or 0,0,0
'terrain pixels are all different values eg 105,100,95
'check if values are equal or not to determine contact / collision
skpttot = 0: skptl = 0: skptr = 0
skptl = checkunderleft
skptr = checkunderright
skpttot = skptl + skptr
If skpttot = 0 Then
ccflag = 0 'no contact underneath the ship
Else
If skpttot = 2 Then
If bnb(j).yv <= .5 Then
ccflag = 1 'contact under both sides, possibly good landing
End If
If bnb(j).yv > .5 And bnb(j).yv < 2 Then
ccflag = 2 ' hard contact but no damage
End If
If bnb(j).yv >= 2 Then
ccflag = 4 ' hard contact - damaged
End If
Else
If skpttot = 1 Then
If bnb(j).yv <= 2 Then
ccflag = 3 'contact under one side only, if soft landing then roll over
If skptl = 1 Then ws = 72
If skptr = 1 Then ws = 0
If bnb(j).xv < -.5 Then
ws = 72
skptl = 1
skptr = 0
End If
If bnb(j).xv > .5 Then
ws = 0
skptl = 0
skptr = 1
End If
End If
If bnb(j).yv > 2 Then
ccflag = 4 ' hard contact - damaged
End If
End If
End If
End If
'check sides of ship for left or right side contact
leftpt = leftcheck
If leftpt > 0 Then
If bnb(j).xv >= -1. Then
If bnb(j).yv < .5 Then
ccflag = 3
ws = 72
skptl = 1
skptr = 0
If bnb(j).yv > .5 Then
ws = 0
skptl = 0
skptr = 1
End If
End If
End If
If bnb(j).xv < -2 Then ccflag = 4
If bnb(j).yv > 2 Then ccflag = 4
End If
rightpt = rightcheck
If rightpt > 0 Then
If bnb(j).xv <= 1. Then
If bnb(j).yv < .5 Then
ccflag = 3
ws = 0
skptl = 0
skptr = 1
If bnb(j).yv > .5 Then
ws = 72
skptl = 1
skptr = 0
End If
End If
End If
If bnb(j).xv > 2 Then ccflag = 4
If bnb(j).yv > 2 Then ccflag = 4
End If
End If
'====================================================================================================
gravityadd = .025 ' apply some gravity
bnb(j).yv = bnb(j).yv + gravityadd
'====================================================================================================
If ccflag = 0 Then ' ship is flying
' proceed with pilot input
If bnb(j).fuel > 0 Then ' if there's fuel available, that is
keyfire(1) = uparrowkey
keyfire(2) = leftarrowkey
keyfire(3) = rightarrowkey
End If
keyfiretot = 0 ' if any arrow keys were pressed just now
For soundct = 1 To 3
keyfiretot = keyfiretot + keyfire(soundct)
Next soundct
If keyfiretot > 0 Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust& ' play sound if it wasn't already playing
_SndVol thrust&, .4
End If
'====================================================================================================
' apply changes from pilot input
bnb(j).x = bnb(j).x + bnb(j).xv ' update X position value
bnb(j).y = bnb(j).y + bnb(j).yv ' update Y position value
If bnb(j).x < 50 Then bnb(j).x = 50 ' apply X limits
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10 ' apply Y limits
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
_PutImage (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 29, bnb(j).y + 29), snap2&, 0 ' draw ship in its new location
If keyfire(1) = 1 Then ' IF down arrow key was pressed
fire1 j, c0, bnb ' draw main engine exhaust
bnb(j).fuel = bnb(j).fuel - 1
End If
If keyfire(2) = 1 Then ' IF left arrow key was pressed
fire2 j, c0, bnb ' draw left engine exhaust
bnb(j).fuel = bnb(j).fuel - 1
End If
If keyfire(3) = 1 Then ' IF right arrow key was pressed
fire3 j, c0, bnb ' draw right engine exhaust
bnb(j).fuel = bnb(j).fuel - 1
End If
'====================================================================================================
ElseIf ccflag > 0 And ccflag < 3 Then ' ship is touching down, not flying
' check to see if on a pad
px = bnb(j).x: py = bnb(j).y
pc = pad(1).count + pad(2).count + pad(3).count
For t = 1 To 4
If px > pad(t).x1 + 16 And px < pad(t).x2 - 16 And pad(t).count = 0 Then
If t < 4 Then
pad(t).count = 1
If ccflag = 1 Then
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 ' erase ship (show background only)
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(4), BF ' change landing pad to GREEN
bnb(j).fuel = bnb(j).fuel + 300 ' fuel bonus
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1) 'update background
ElseIf ccflag = 2 Then
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 ' erase ship (show background only)
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(2), BF ' change landing pad to RED
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1) 'update background
End If
Else
If pc = 3 Then ' 4th (final) pad only active after others completed
pad(t).count = 1
If ccflag = 1 Then
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(4), BF ' change landing pad to GREEN
ccflag = 10
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
ElseIf ccflag = 2 Then
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
Line (pad(t).x1, pad(t).y1)-(pad(t).x2, pad(t).y2), c0(2), BF ' change landing pad to RED
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1)
End If
End If
End If
End If
Next t
If pad(4).count = 1 Then ' if 4th pad has been activated, the level is complete
flag = 1
End If
'=====================================================================================================
' player input for a landed (not flying) ship
If bnb(j).fuel > 0 Then ' if there's fuel available, that is
keyfire(1) = uparrowkey
End If
If keyfire(1) = 1 Then
If Not _SndPlaying(thrust&) Then _SndLoop thrust& ' play sound if it wasn't already playing
_SndVol thrust&, .4
End If
'====================================================================================================
' apply changes from pilot input and conditions
bnb(j).xv = bnb(j).xv * .6 ' cancel out most of existing x velocity
If bnb(j).yv > 0 Then bnb(j).yv = 0 ' cancel y velocity if heading down
bnb(j).x = bnb(j).x + bnb(j).xv ' X position update
bnb(j).y = bnb(j).y + bnb(j).yv ' Y postion update
If bnb(j).x < 50 Then bnb(j).x = 50 ' apply X and Y limits
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
_PutImage (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 29, bnb(j).y + 29), snap2&, 0 ' draw ship in its new location
If keyfire(1) = 1 Then
fire1 j, c0, bnb
bnb(j).fuel = bnb(j).fuel - 1
End If
'====================================================================================================
ElseIf ccflag = 3 Then ' ship has contact under one side only
' rollover begins - controls disabled
If skptl = 1 Then
bnb(j).xv = bnb(j).xv * .995 ' diminish X velocity
bnb(j).x = bnb(j).x + bnb(j).xv ' X position update
bnb(j).y = bnb(j).y + bnb(j).yv ' Y postion update
If bnb(j).x < 50 Then bnb(j).x = 50 ' apply X and Y limits
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
ws = ws - 1
If ws < 2 Then ws = 72
_PutImage (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 29, bnb(j).y + 29), ship(ws), 0 ' draw ship rotated
If bnb(j).y > scy - 60 Then
flag = 1
End If
End If
If skptr = 1 Then
bnb(j).xv = bnb(j).xv * .995 ' diminish X velocity
bnb(j).x = bnb(j).x + bnb(j).xv ' X position update
bnb(j).y = bnb(j).y + bnb(j).yv ' Y postion update
If bnb(j).x < 50 Then bnb(j).x = 50 ' apply X and Y limits
If bnb(j).x > scx - 50 Then bnb(j).x = scx - 50
If bnb(j).y < 10 Then bnb(j).y = 10
If bnb(j).y > scy - 30 Then bnb(j).y = scy - 30
ws = ws + 1
If ws > 71 Then ws = 1
_PutImage (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 29, bnb(j).y + 29), ship(ws), 0 ' draw ship rotated
If bnb(j).y > scy - 60 Then
flag = 1
End If
End If
ElseIf ccflag = 4 Then 'hard landing - crash
If _SndPlaying(thrust&) Then _SndStop (thrust&)
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
explode1 bnb, c0, scx, scy
'explode2 bnb, c0, j
flag = 1
End If
'====================================================================================================
'====================================================================================================
If ccflag < 3 Then
'blinking light on ship
blinkinglight bnb, c0, blink, ccflag
vaw c0, bnb, snap&, scx, maxfuel
End If
_Delay dv
If bnb(j).fuel < 1 Then
'If bnb(j).xv < .05 And bnb(j).yv < .05 Then
If ccflag = 1 Then
flag = 1
End If
End If
_Display
Loop Until flag = 1
If _SndPlaying(thrust&) Then _SndStop (thrust&)
_PutImage (0, 0)-(scx, scy), bgsnap&, 0
If ccflag < 3 Then
_PutImage (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 29, bnb(j).y + 29), snap2&, 0 ' draw ship
End If
If ccflag < 10 Then
_AutoDisplay
gameover = 1
_Delay 2.
Cls
Locate 20, 65
Print "GAME OVER"
_Delay 2.
Else
_AutoDisplay
_PutImage (bnb(j).x - 30, bnb(j).y - 30)-(bnb(j).x + 29, bnb(j).y + 29), snap2&, 0 ' draw ship
vaw c0, bnb, snap&, scx, maxfuel
_Delay 2.
Cls
Locate 20, 50: Print "LEVEL COMPLETED. WELL DONE."
_Delay 2.
animateshuffle = animateshuffle + 1
If animateshuffle > 3 Then animateshuffle = 1
If animateshuffle = 1 Then
animate1
End If
If animateshuffle = 2 Then
animate2
End If
If animateshuffle = 3 Then
animate3
End If
Cls
End If
Loop Until quit1 = 1
End
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
'=======================================================================================
Function uparrowkey
uparrowkey = 0
If _KeyDown(18432) Then ' IF up arrow key was pressed
bnb(j).yv = bnb(j).yv - .05 ' add some upward velocity
uparrowkey = 1 ' record that this happened
End If
If bnb(j).yv > 10 Then bnb(j).yv = 10 ' apply velocity limits
If bnb(j).yv < -10 Then bnb(j).yv = -10
End Function
Function leftarrowkey
leftarrowkey = 0
If _KeyDown(19200) Then ' IF left arrow key was pressed
bnb(j).xv = bnb(j).xv - .03 ' add some left velocity
leftarrowkey = 1 ' record that this happened
If leftpt = 1 Then bnb(j).xv = 0
End If
If bnb(j).xv < -5 Then bnb(j).xv = -5 ' apply velocity limit
End Function
Function rightarrowkey
rightarrowkey = 0
If _KeyDown(19712) Then ' IF right arrow key was pressed
bnb(j).xv = bnb(j).xv + .03 ' add some right velocity
rightarrowkey = 1 ' record that this happened
If rightpt = 1 Then bnb(j).xv = 0
End If
If bnb(j).xv > 5 Then bnb(j).xv = 5 ' apply velocity limit
End Function
Function checkunderleft
c0(99) = Point(bnb(j).x - 16, bnb(j).y + 20) 'check under left side of ship
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
checkunderleft = 0
Else
checkunderleft = 1
End If
End Function
Function checkunderright
c0(99) = Point(bnb(j).x + 16, bnb(j).y + 20) 'check under right side of ship
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
checkunderright = 0
Else
checkunderright = 1
End If
End Function
Function leftcheck
c0(99) = Point(bnb(j).x - 17, bnb(j).y + 19)
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
leftcheck = 0
Else
leftcheck = 1
End If
End Function
Function rightcheck
c0(99) = Point(bnb(j).x + 17, bnb(j).y + 19)
red% = _Red32(c0(99))
grn% = _Green32(c0(99))
blu% = _Blue32(c0(99))
If red% = grn% And red% = blu% Then
rightcheck = 0
Else
rightcheck = 1
End If
End Function
Sub clearset (keyfire, bnb, thrust&)
'check for stray sounds
silence = 0
If bnb(j).fuel > 0 Then
If _KeyDown(18432) Then silence = silence + 1
If _KeyDown(19200) Then silence = silence + 1
If _KeyDown(19712) Then silence = silence + 1
End If
If silence = 0 Then ' there should be no thrust sound
If _SndPlaying(thrust&) Then _SndStop (thrust&)
End If
'clear arrow key records
keyfire(1) = 0
keyfire(2) = 0
keyfire(3) = 0
'update screen
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
End Sub
Sub blinkinglight (bnb, c0, blink, ccflag)
blink = blink + 1
If blink < 25 Then
bk = 0
End If
If blink > 24 Then
bk = 9
End If
If blink > 50 Then blink = 0
If ccflag = 0 Then
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(bk), BF
ElseIf ccflag > 0 And ccflag < 3 Then
Line (bnb(j).x - 1, bnb(j).y - 8)-(bnb(j).x + 1, bnb(j).y - 6), c0(4), BF
End If
End Sub
Sub eraseship (j, c0, bnb)
Line (bnb(j).x - 16, bnb(j).y - 15)-(bnb(j).x + 16, bnb(j).y + 19), c0(0), BF
End Sub
Sub drawship (j, c0, bnb)
Line (bnb(j).x - 3, bnb(j).y - 14)-(bnb(j).x + 3, bnb(j).y - 13), c0(22), BF
Line (bnb(j).x - 5, bnb(j).y - 12)-(bnb(j).x + 5, bnb(j).y - 11), c0(21), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x - 16, bnb(j).y + 19), c0(20) 'long struts
Line (bnb(j).x + 6, bnb(j).y - 10)-(bnb(j).x + 16, bnb(j).y + 19), c0(20) 'long struts
Line (bnb(j).x - 16, bnb(j).y + 19)-(bnb(j).x - 6, bnb(j).y + 2), c0(20) 'short struts
Line (bnb(j).x + 16, bnb(j).y + 19)-(bnb(j).x + 6, bnb(j).y + 2), c0(20) 'short struts
Line (bnb(j).x - 1, bnb(j).y + 5)-(bnb(j).x + 1, bnb(j).y + 5), c0(20) 'engine
Line (bnb(j).x - 2, bnb(j).y + 6)-(bnb(j).x + 2, bnb(j).y + 6), c0(20) 'engine
Line (bnb(j).x - 3, bnb(j).y + 7)-(bnb(j).x + 3, bnb(j).y + 7), c0(20) 'engine
'highlights
Line (bnb(j).x - 6, bnb(j).y - 10)-(bnb(j).x - 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x + 6, bnb(j).y - 10)-(bnb(j).x + 6, bnb(j).y + 4), c0(20), BF
Line (bnb(j).x - 5, bnb(j).y - 10)-(bnb(j).x - 4, bnb(j).y + 4), c0(21), BF
Line (bnb(j).x + 5, bnb(j).y - 10)-(bnb(j).x + 4, bnb(j).y + 4), c0(21), BF
Line (bnb(j).x - 3, bnb(j).y - 10)-(bnb(j).x - 2, bnb(j).y + 4), c0(22), BF
Line (bnb(j).x + 3, bnb(j).y - 10)-(bnb(j).x + 2, bnb(j).y + 4), c0(22), BF
Line (bnb(j).x + 1, bnb(j).y - 10)-(bnb(j).x - 1, bnb(j).y + 4), c0(23), BF
End Sub
Sub fire1 (j, c0, bnb)
Line (bnb(j).x - 2, bnb(j).y + 8)-(bnb(j).x + 2, bnb(j).y + 9), c0(30), BF
Line (bnb(j).x - 2, bnb(j).y + 10)-(bnb(j).x + 2, bnb(j).y + 10), c0(31), BF
Line (bnb(j).x - 2, bnb(j).y + 11)-(bnb(j).x + 2, bnb(j).y + 12), c0(32), BF
Line (bnb(j).x - 2, bnb(j).y + 13)-(bnb(j).x + 2, bnb(j).y + 15), c0(33), BF
End Sub
Sub fire2 (j, c0, bnb)
Line (bnb(j).x + 7, bnb(j).y - 5)-(bnb(j).x + 12, bnb(j).y - 4), c0(31), BF
End Sub
Sub fire3 (j, c0, bnb)
Line (bnb(j).x - 7, bnb(j).y - 5)-(bnb(j).x - 12, bnb(j).y - 4), c0(31), BF
End Sub
Sub addstars
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 1999)
If ttt > 1994 Then
c0(99) = Point(tx, ty)
If c0(99) = c0(0) Then
PSet (tx, ty), c0(14)
If ttt > 1997 Then
PSet (tx, ty), c0(1)
End If
xl = Int(Rnd * 100)
If xl > 98 Then
PSet (tx, ty), c0(15)
PSet (tx + 1, ty), c0(1)
PSet (tx, ty - 1), c0(1)
PSet (tx - 1, ty), c0(1)
PSet (tx, ty + 1), c0(1)
End If
End If
End If
Next ty
Next tx
Next tt
End Sub
Sub animate1
Cls
addstars
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap2&, (1, 1)-(scx - 1, scy - 1) 'capture screen as bgsnap2 (only stars)
'horizontally flying ship (starting on right side and moving left, then far away to the right)
Cls
flag = 0
rad = (xx * .9)
ds = .5 'step interval
si = 40 'size of image
sc = 15 'scale
dv = .015
df = 9000
_AutoDisplay
_Limit 30
For j = 1 To 90 Step ds
k = rad * (Cos(j * (PI / 180)))
sz = si + ((Sqr(rad ^ 2 - k ^ 2)) / sc)
_Display
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
_PutImage (xx + k - sz, yy - sz)-(xx + k + sz, yy + sz), snap2&, 0
d2 = sz / df
_Delay dv - d2
Next j
_AutoDisplay
For j = 90 To 1 Step -ds
k = rad * (Cos(j * (PI / 180)))
sz = si + ((Sqr(rad ^ 2 - k ^ 2)) / sc)
_Display
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
_PutImage (xx - k - sz, yy - sz)-(xx - k + sz, yy + sz), snap2&, 0
d2 = sz / df
_Delay dv - d2
Next j
_AutoDisplay
For j = 1 To 90 Step ds
k = rad * (Cos(j * (PI / 180)))
sz = si - ((Sqr(rad ^ 2 - k ^ 2)) / sc)
_Display
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
_PutImage (xx - k - sz, yy - sz)-(xx - k + sz, yy + sz), snap2&, 0
d2 = sz / df
_Delay dv + d2
Next j
ds = 3
_AutoDisplay
For j = xx To scx Step ds
_Display
sz = sz * .99
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
_PutImage (j - k - sz, yy - sz)-(j - k + sz, yy + sz), snap2&, 0
Next j
_AutoDisplay
End Sub
Sub animate2
Cls
addstars
_PutImage (0, 0)-(scx - 1, scy - 1), 0, bgsnap2&, (1, 1)-(scx - 1, scy - 1) 'capture screen as bgsnap2
'out of control flying ship (from far left to near right, rotating)
Cls
ds = .8 'step interval
sz = 5 'size of ship
df = 9000 'time delay factor
wship = 0
k = -300 'y axis movement
j = -30
dv = .02
_AutoDisplay
_Limit 30
jmax = scx + 300
Do
j = j + ds
k = k + 1.2
sz = sz + .4
_Display
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
wship = wship + 1
If wship > 71 Then wship = 1
_PutImage (j - sz, yy - k - sz)-(j + sz, yy - k + sz), ship(72 - wship), 0
ds = ds * 1.01
_Delay .01
Loop Until j > jmax
_AutoDisplay
End Sub
Sub animate3
Cls
addstars
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap2&, (1, 1)-(scx - 1, scy - 1) 'capture screen as bgsnap2 (only stars)
flag = 0
rad = (xx * 1.1)
ds = .5 'step interval
si = 20 'size of image
sc = 15 'scale
dv = .020
df = 9000
_AutoDisplay
For j = 1 To 90 Step ds
_Limit 40
k = rad * (Cos(j * (PI / 180)))
sz = si + (rad * (Tan(j * (PI / 180)))) / 10
_Display
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
_PutImage (xx + k - sz, yy - sz)-(xx + k + sz, yy + sz), ship(1), 0
Next j
_AutoDisplay
For j = 90 To 1 Step -ds
_Limit 40
k = rad * (Cos(j * (PI / 180)))
sz = si + (rad * (Tan(j * (PI / 180)))) / 10
_Display
_PutImage (0, 0)-(scx, scy), bgsnap2&, 0 'replace screen background only
_PutImage (xx - k - sz, yy - sz)-(xx - k + sz, yy + sz), ship(1), 0
Next j
_AutoDisplay
End Sub
Sub title1
x77 = xx
y77 = yy - 35
'---- SPACE horizontal
Line (x77 - 100, y77 - 30)-(x77 - 70, y77 - 28), c0(9), BF
Line (x77 - 105, y77 - 1)-(x77 - 75, y77 + 1), c0(9), BF
Line (x77 - 110, y77 + 30)-(x77 - 80, y77 + 28), c0(9), BF
'--
Line (x77 - 60, y77 - 30)-(x77 - 30, y77 - 28), c0(9), BF
Line (x77 - 65, y77 - 1)-(x77 - 35, y77 + 1), c0(9), BF
'--
Line (x77 - 25, y77 - 1)-(x77 + 5, y77 + 1), c0(9), BF
'--
Line (x77 + 20, y77 - 30)-(x77 + 50, y77 - 28), c0(9), BF
Line (x77 + 10, y77 + 30)-(x77 + 40, y77 + 28), c0(9), BF
'--
Line (x77 + 60, y77 - 30)-(x77 + 90, y77 - 28), c0(9), BF
Line (x77 + 55, y77 - 1)-(x77 + 85, y77 + 1), c0(9), BF
Line (x77 + 50, y77 + 30)-(x77 + 80, y77 + 28), c0(9), BF
'---- SPACE vertical
Line (x77 - 100, y77 - 30)-(x77 - 105, y77 + 1), c0(9)
Line (x77 - 98, y77 - 30)-(x77 - 103, y77 + 1), c0(9)
Line (x77 - 75, y77 + 1)-(x77 - 80, y77 + 30), c0(9)
Line (x77 - 73, y77 + 1)-(x77 - 78, y77 + 28), c0(9)
'--
Line (x77 - 60, y77 - 30)-(x77 - 70, y77 + 30), c0(9)
Line (x77 - 58, y77 - 30)-(x77 - 68, y77 + 30), c0(9)
Line (x77 - 70, y77 - 30)-(x77 - 68, y77 - 30), c0(9)
Line (x77 - 30, y77 - 30)-(x77 - 35, y77 - 1), c0(9)
Line (x77 - 28, y77 - 30)-(x77 - 33, y77 - 1), c0(9)
'--
Line (x77 - 6, y77 - 30)-(x77 - 4, y77 - 30), c0(9)
Line (x77 - 25, y77 - 1)-(x77 - 6, y77 - 30), c0(9)
Line (x77 - 23, y77 - 1)-(x77 - 5, y77 - 28), c0(9)
Line (x77 - 4, y77 - 30)-(x77 + 5, y77 - 1), c0(9)
Line (x77 - 5, y77 - 28)-(x77 + 3, y77 - 1), c0(9)
Line (x77 - 25, y77 + 1)-(x77 - 30, y77 + 30), c0(9)
Line (x77 - 23, y77 + 1)-(x77 - 28, y77 + 30), c0(9)
Line (x77 + 5, y77 - 1)-(x77 + 0, y77 + 30), c0(9)
Line (x77 + 3, y77 - 1)-(x77 - 2, y77 + 30), c0(9)
Line (x77 - 30, y77 + 30)-(x77 - 28, y77 + 30), c0(9)
Line (x77 - 0, y77 + 30)-(x77 - 2, y77 + 30), c0(9)
'--
Line (x77 + 20, y77 - 28)-(x77 + 10, y77 + 28), c0(9)
Line (x77 + 22, y77 - 28)-(x77 + 12, y77 + 28), c0(9)
'--
Line (x77 + 60, y77 - 28)-(x77 + 50, y77 + 28), c0(9)
Line (x77 + 62, y77 - 28)-(x77 + 52, y77 + 28), c0(9)
'---- LANDER horizontal
Line (x77 - 120, y77 + 90)-(x77 - 95, y77 + 88), c0(9), BF
'--
Line (x77 - 80, y77 + 66)-(x77 - 55, y77 + 64), c0(9), BF
'--
Line (x77 + 30, y77 + 40)-(x77 + 55, y77 + 42), c0(9), BF
Line (x77 + 25, y77 + 64)-(x77 + 50, y77 + 66), c0(9), BF
Line (x77 + 20, y77 + 90)-(x77 + 45, y77 + 88), c0(9), BF
'--
Line (x77 + 65, y77 + 40)-(x77 + 90, y77 + 42), c0(9), BF
Line (x77 + 60, y77 + 64)-(x77 + 85, y77 + 66), c0(9), BF
'---- LANDER vertical
Line (x77 - 110, y77 + 40)-(x77 - 120, y77 + 90), c0(9)
Line (x77 - 108, y77 + 40)-(x77 - 118, y77 + 90), c0(9)
Line (x77 - 110, y77 + 40)-(x77 - 108, y77 + 40), c0(9)
'--
Line (x77 - 63, y77 + 40)-(x77 - 61, y77 + 40), c0(9)
Line (x77 - 80, y77 + 64)-(x77 - 63, y77 + 40), c0(9)
Line (x77 - 78, y77 + 64)-(x77 - 62, y77 + 42), c0(9)
Line (x77 - 61, y77 + 40)-(x77 - 55, y77 + 64), c0(9)
Line (x77 - 62, y77 + 42)-(x77 - 57, y77 + 64), c0(9)
Line (x77 - 80, y77 + 66)-(x77 - 85, y77 + 90), c0(9)
Line (x77 - 78, y77 + 66)-(x77 - 83, y77 + 90), c0(9)
Line (x77 - 85, y77 + 90)-(x77 - 83, y77 + 90), c0(9)
Line (x77 - 57, y77 + 66)-(x77 - 62, y77 + 90), c0(9)
Line (x77 - 55, y77 + 66)-(x77 - 60, y77 + 90), c0(9)
Line (x77 - 62, y77 + 90)-(x77 - 60, y77 + 90), c0(9)
'--
Line (x77 - 40, y77 + 40)-(x77 - 50, y77 + 90), c0(9)
Line (x77 - 38, y77 + 44)-(x77 - 48, y77 + 90), c0(9)
Line (x77 - 15, y77 + 40)-(x77 - 25, y77 + 90), c0(9)
Line (x77 - 17, y77 + 40)-(x77 - 27, y77 + 86), c0(9)
Line (x77 - 40, y77 + 40)-(x77 - 38, y77 + 40), c0(9)
Line (x77 - 38, y77 + 40)-(x77 - 27, y77 + 86), c0(9)
Line (x77 - 38, y77 + 48)-(x77 - 28, y77 + 90), c0(9)
Line (x77 - 50, y77 + 90)-(x77 - 48, y77 + 90), c0(9)
Line (x77 - 27, y77 + 90)-(x77 - 25, y77 + 90), c0(9)
Line (x77 - 17, y77 + 40)-(x77 - 15, y77 + 40), c0(9)
'--
Line (x77 - 5, y77 + 40)-(x77 - 15, y77 + 90), c0(9)
Line (x77 - 3, y77 + 45)-(x77 - 13, y77 + 87), c0(9)
Line (x77 - 5, y77 + 40)-(x77 - 3, y77 + 40), c0(9)
Line (x77 - 3, y77 + 40)-(x77 + 15, y77 + 65), c0(9)
Line (x77 - 13, y77 + 90)-(x77 + 15, y77 + 65), c0(9)
Line (x77 - 13, y77 + 87)-(x77 + 12, y77 + 65), c0(9)
Line (x77 - 3, y77 + 45)-(x77 + 12, y77 + 65), c0(9)
'--
Line (x77 + 30, y77 + 40)-(x77 + 20, y77 + 90), c0(9)
Line (x77 + 32, y77 + 42)-(x77 + 22, y77 + 88), c0(9)
'--
Line (x77 + 65, y77 + 40)-(x77 + 55, y77 + 90), c0(9)
Line (x77 + 67, y77 + 42)-(x77 + 57, y77 + 90), c0(9)
Line (x77 + 55, y77 + 90)-(x77 + 57, y77 + 90), c0(9)
Line (x77 + 90, y77 + 40)-(x77 + 85, y77 + 66), c0(9)
Line (x77 + 87, y77 + 42)-(x77 + 83, y77 + 64), c0(9)
Line (x77 + 64, y77 + 66)-(x77 + 80, y77 + 90), c0(9)
Line (x77 + 62, y77 + 68)-(x77 + 77, y77 + 90), c0(9)
Line (x77 + 77, y77 + 90)-(x77 + 80, y77 + 90), c0(9)
End Sub
Sub vaw (c0, bnb, snap&, scx, maxfuel)
'visual aid window
If bnb(j).x >= xx Then
xp = 20
Else
xp = scx - 300
End If
Line (xp + 30, 4)-(xp + 229, 188), c0(9), BF
_PutImage (0, 0), 0, snap&, (bnb(j).x - 30, bnb(j).y - 20)-(bnb(j).x + 30, bnb(j).y + 40)
_PutImage (xp + 47, 6)-(xp + 227, 186), snap&, 0
dy = Int(bnb(j).yv * 30)
If dy > 70 Then dy = 70
If dy < -70 Then dy = -70
dx = Int(bnb(j).xv * 30 + .49)
If dx > 70 Then dx = 70
If dx < -70 Then dx = -70
Line (xp + 222, 26)-(xp + 227, 166), c0(18), BF 'y axis
Line (xp + 222, 96)-(xp + 227, 96), c0(1), BF 'y axis centerline
Line (xp + 222, 97)-(xp + 227, 107), c0(17), BF 'y axis safe zone
Line (xp + 222, 96 + dy)-(xp + 227, 96 + dy), c0(2), BF 'y axis indicator
Line (xp + 67, 181)-(xp + 207, 186), c0(18), BF 'x axis
Line (xp + 137, 181)-(xp + 137, 186), c0(1), BF 'x axis centerline
Line (xp + 137 + dx, 181)-(xp + 137 + dx, 186), c0(2), BF 'x axis indicator
Line (xp + 32, 6)-(xp + 45, 186), c0(18), BF 'fuel axis
f = (bnb(j).fuel / maxfuel) * 180
Line (xp + 32, 186 - f)-(xp + 45, 186), c0(17), BF 'fuel level
End Sub
Sub setscreen1 (c0, scx, scy, yy, pad)
'lower random landscape
j = 0
jj = 0
k = 170
Do
j = j + 1
jj = jj + 1
If jj > 8 Then
r = Int(Rnd * 5) - 2
jj = 0
End If
k = k + r
If k > 220 Then
k = k - r
End If
If k < 120 Then
k = k - r
End If
Line (j, scy - k)-(j, scy), c0(6)
Loop Until j >= scx
'add texture to terrain
For tt = 1 To 2
For tx = 1 To scx
For ty = 1 To scy
ttt = Int(Rnd * 18)
If ttt > 16 Then
c0(99) = Point(tx, ty)
If c0(99) <> c0(0) Then
Line (tx, ty)-(tx + 2, ty + 2), c0(12), BF
End If
End If
Next ty
Next tx
Next tt
'===== ground
Line (0, scy - 20)-(scx, scy), c0(5), BF
'===== right wall
Line (scx - 40, 0)-(scx, scy - 20), c0(5), BF
'===== left wall
Line (0, 0)-(40, scy - 20), c0(5), BF
'initialize pads
pad(1).x1 = scx / 10
pad(1).x2 = pad(1).x1 + 100
pad(1).y1 = scy - 80
pad(1).y2 = pad(1).y1 + 2
pad(1).colour = 5
pad(1).count = 0
pad(2).x1 = scx / 3 + 50
pad(2).x2 = pad(2).x1 + 75
pad(2).y1 = scy - 50
pad(2).y2 = pad(2).y1 + 2
pad(2).colour = 5
pad(2).count = 0
pad(3).x1 = scx / 2 + 50
pad(3).x2 = pad(3).x1 + 50
pad(3).y1 = scy - 90
pad(3).y2 = pad(3).y1 + 2
pad(3).colour = 5
pad(3).count = 0
pad(4).x1 = scx - 120
pad(4).x2 = pad(4).x1 + 40
pad(4).y1 = scy - 50
pad(4).y2 = pad(4).y1 + 2
pad(4).colour = 5
pad(4).count = 0
'===== pad 1
Line (pad(1).x1, yy)-(pad(1).x2, pad(1).y1), c0(0), BF
'===== pad 2
Line (pad(2).x1, yy)-(pad(2).x2, pad(2).y1), c0(0), BF
'===== pad 3
Line (pad(3).x1, yy)-(pad(3).x2, pad(3).y1), c0(0), BF
'===== pad 4
Line (pad(4).x1, yy)-(pad(4).x2, pad(4).y1), c0(0), BF
addstars
'===== pad 1
Line (pad(1).x1, pad(1).y1)-(pad(1).x2, pad(1).y2), c0(pad(1).colour), BF
'===== pad 2
Line (pad(2).x1, pad(2).y1)-(pad(2).x2, pad(2).y2), c0(pad(2).colour), BF
'===== pad 3
Line (pad(3).x1, pad(3).y1)-(pad(3).x2, pad(3).y2), c0(pad(3).colour), BF
'===== pad 4
Line (pad(4).x1, pad(4).y1)-(pad(4).x2, pad(4).y2), c0(pad(4).colour), BF
End Sub
Sub colour1 (c0)
c0(0) = _RGB(0, 0, 0)
c0(1) = _RGBA(255, 255, 255, 150)
c0(2) = _RGB(255, 0, 0)
c0(3) = _RGB(150, 150, 255)
c0(4) = _RGB(0, 200, 50)
c0(5) = _RGB(105, 100, 95)
c0(6) = _RGB(55, 50, 45)
c0(7) = _RGB(255, 50, 50)
c0(8) = _RGB(125, 125, 200)
c0(9) = _RGB(50, 150, 255)
c0(10) = _RGB(255, 200, 125)
c0(11) = _RGB(23, 20, 17)
c0(12) = _RGBA(6, 3, 0, 100) 'terrain texture
c0(14) = _RGBA(255, 255, 255, 100)
c0(15) = _RGBA(255, 255, 255, 200)
c0(16) = _RGB(150, 150, 150)
c0(17) = _RGBA(0, 255, 0, 90)
c0(18) = _RGB(15, 15, 15)
c0(20) = _RGB(120, 120, 170) 'ship
c0(21) = _RGB(150, 150, 200) 'ship
c0(22) = _RGB(170, 170, 220) 'ship
c0(23) = _RGB(180, 180, 230) 'ship
c0(30) = _RGBA32(255, 255, 150, 160) 'ship exhaust
c0(31) = _RGBA32(255, 255, 150, 80) 'ship exhaust
c0(32) = _RGBA32(255, 255, 150, 40) 'ship exhaust
c0(33) = _RGBA32(255, 255, 150, 20) 'ship exhaust
c0(34) = _RGBA32(255, 220, 0, 200) 'ship exhaust
c0(35) = _RGBA32(255, 220, 0, 100) 'ship exhaust
c0(36) = _RGBA32(255, 220, 0, 70) 'ship exhaust
c0(37) = _RGBA32(255, 220, 0, 40) 'ship exhaust
c0(38) = _RGBA32(255, 220, 0, 10) 'ship exhaust
c0(39) = _RGBA32(255, 220, 0, 0) 'ship exhaust
c0(50) = _RGB(150, 150, 150)
c0(51) = _RGB(150, 150, 150)
c0(52) = _RGB(255, 50, 0)
c0(53) = _RGB(255, 100, 0)
c0(54) = _RGB(255, 150, 0)
c0(55) = _RGB(255, 255, 255)
c0(56) = _RGBA(255, 200, 0, 200)
c0(57) = _RGBA(255, 200, 0, 150)
c0(58) = _RGBA(255, 200, 0, 100)
c0(59) = _RGBA(255, 200, 0, 50)
c0(60) = _RGBA(255, 200, 0, 20)
End Sub
Sub rotate1 (ship, angle, ctt, snap2&)
'_FreeImage ship(ctt)
ship(ctt) = _NewImage(60, 60, 32)
pw1 = _Width(ship(ctt)) / 2
ph1 = _Height(ship(ctt)) / 2
angle = (ctt - 1) * 5
For k7 = 0 To 30 Step .1 'better resolution with more steps
For j7 = 0 To 30 Step .1 'better resolution with more steps
x1c = j7 * (Cos(angle * (PI / 180))) - k7 * (Sin(angle * (PI / 180)))
y1c = j7 * (Sin(angle * (PI / 180))) + k7 * (Cos(angle * (PI / 180)))
_PutImage (pw1 + x1c, ph1 - y1c)-(pw1 + x1c, ph1 - y1c), snap2&, ship(ctt), (pw1 + j7, ph1 - k7)-(pw1 + j7, ph1 - k7)
_PutImage (ph1 - y1c, pw1 - x1c)-(ph1 - y1c, pw1 - x1c), snap2&, ship(ctt), (ph1 + k7, pw1 - j7)-(ph1 + k7, pw1 - j7)
_PutImage (pw1 - x1c, ph1 + y1c)-(pw1 - x1c, ph1 + y1c), snap2&, ship(ctt), (pw1 - j7, ph1 + k7)-(pw1 - j7, ph1 + k7)
_PutImage (ph1 + y1c, pw1 + x1c)-(ph1 + y1c, pw1 + x1c), snap2&, ship(ctt), (ph1 - k7, pw1 + j7)-(ph1 - k7, pw1 + j7)
Next j7
Next k7
End Sub
Sub explode1 (bnb, c0, scx, scy)
x88 = bnb(j).xv / 4 'existing x velocity
y88 = bnb(j).yv / 4 'existing y velocity
If _SndPlaying(thrust&) Then _SndStop (thrust&)
_AutoDisplay
'===== parameters
flow = 1
dv2 = .005 ' time delay value
pt = 2 ' particle size
fan = 5 ' fountain fan size
cc1 = 1 ' colour 1
cc2 = 4 ' colour 2
ls = 2 ' launch speed
'Dim blive, maxb, agec, col1, col2, col3 As Integer
blive = 0
maxb = 350
flip = 0
stx = bnb(j).x + 1
sty = bnb(j).y
stx2 = bnb(j).x - 1
sty2 = bnb(j).y
timect = 0
fleg = 0
'prepare particles
Do
t = t + 1
If bnb(t).live = 0 Then
flagnew = 1
bnb(t).live = 1
bnb(t).x = stx
bnb(t).y = sty + 10
blsp = Int(Rnd * 3): blsp2 = Int(Rnd * 3)
xlaunchspeed = ((Rnd * 3) - 2 + blsp - blsp2) / 3
bnb(t).xv = (Rnd * (xlaunchspeed + x88) * 1.5) - (xlaunchspeed + x88)
ylaunchspeed = ((Rnd * 5) - 3.5 + blsp - blsp2) / 4
bnb(t).yv = 0 - (ylaunchspeed + y88)
bnb(t).rad = 2
bnb(t).spd = Int(Rnd * 6) + 1
bnb(t).age = 1
c1 = Int(Rnd * 10) + 1
c1 = 23
bnb(t).colour = c1
c1 = Int(Rnd * 30)
If c1 > 15 Then c1 = 1
If c1 > 5 Then c1 = .5
bnb(t).rad = c1
End If
Loop Until t >= maxb
'--------------------------------------------------------------
'add explosion crater here
'ellipse fill routine
a90 = 25
b90 = 20
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
Line (bnb(j).x - x90, bnb(j).y - y90)-(bnb(j).x + x90, bnb(j).y - y90), c0(0)
Line (bnb(j).x - x90, bnb(j).y + y90)-(bnb(j).x + x90, bnb(j).y + y90), c0(0)
Next j90
'-------------------------------------------------------------
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen with crater
Do
_Limit 50
timect = timect + 1
_Display
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
_AutoDisplay
For j = 1 To maxb
If bnb(j).live = 1 Then
'update position
speedchange = .9995
gravityadd = .015
bnb(j).age = bnb(j).age + 1
bnb(j).xv = bnb(j).xv * speedchange
bnb(j).yv = bnb(j).yv + gravityadd
bnb(j).x = bnb(j).x + bnb(j).xv
bnb(j).y = bnb(j).y + bnb(j).yv
If bnb(j).y > scy + 23 Then
bnb(j).y = scy + 23
bnb(j).xv = bnb(j).xv * .5
bnb(j).yv = bnb(j).yv * -1
bnb(j).yv = bnb(j).yv * .1
End If
If bnb(j).x < 46 Then
bnb(j).live = 0
End If
If bnb(j).x > scx - 46 Then
bnb(j).live = 0
End If
If bnb(j).age < 20 Then
ccc = 55
End If
If bnb(j).age > 19 Then
ccc = bnb(j).colour
End If
If bnb(j).age > 150 Then
agec = 900 - bnb(j).age * 5
If agec < 0 Then agec = 0
col1 = _Red32(c0(bnb(j).colour))
col2 = _Green32(c0(bnb(j).colour))
col3 = _Blue32(c0(bnb(j).colour))
c0(61) = _RGBA32(col1, col2, col3, agec)
ccc = 61
End If
If bnb(j).live = 1 Then
If bnb(j).spd = 1 Then
Line (bnb(j).x - bnb(j).rad, bnb(j).y - bnb(j).rad)-(bnb(j).x, bnb(j).y + bnb(j).rad), c0(ccc), BF
End If
If bnb(j).spd = 2 Then
Line (bnb(j).x - bnb(j).rad, bnb(j).y - bnb(j).rad)-(bnb(j).x + bnb(j).rad, bnb(j).y), c0(ccc), BF
End If
If bnb(j).spd = 3 Then
Line (bnb(j).x, bnb(j).y - bnb(j).rad)-(bnb(j).x + bnb(j).rad, bnb(j).y + bnb(j).rad), c0(ccc), BF
End If
If bnb(j).spd = 4 Then
Line (bnb(j).x - bnb(j).rad, bnb(j).y)-(bnb(j).x + bnb(j).rad, bnb(j).y + bnb(j).rad), c0(ccc), BF
End If
If bnb(j).spd = 5 Then
Line (bnb(j).x, bnb(j).y - bnb(j).rad * 2)-(bnb(j).x, bnb(j).y + bnb(j).rad), c0(ccc), BF
End If
If bnb(j).spd = 6 Then
Line (bnb(j).x - bnb(j).rad * 2, bnb(j).y)-(bnb(j).x + bnb(j).rad * 2, bnb(j).y), c0(ccc), BF
End If
End If
stop1 = .02
If (bnb(j).xv ^ 2) < stop1 Then
If (bnb(j).yv ^ 2) < stop1 Then
If (bnb(j).y) = scy - 23 Then
flag = 1
blive = blive - 1
bnb(j).live = 0
End If
End If
End If
End If
Next j
'======================================================
If timect > 180 Then fleg = 1
Loop Until fleg = 1
For j = 1 To maxb
bnb(j).x = 0
bnb(j).y = 0
bnb(j).xv = 0
bnb(j).yv = 0
bnb(j).live = 0
bnb(j).age = 0
bnb(j).rad = 0
bnb(j).spd = 0
bnb(j).colour = 0
bnb(j).fuel = 0
Next j
End Sub
Posts: 176
Threads: 13
Joined: Apr 2022
Reputation:
5
Refuel bonus is a nice touch... Not so nice when hitting the 'wall'... Ouch!
Nicely done!
J
May your journey be free of incident. Live long and prosper.
Posts: 229
Threads: 25
Joined: Aug 2022
Reputation:
23
(09-12-2022, 04:06 AM)johnno56 Wrote: Refuel bonus is a nice touch... Not so nice when hitting the 'wall'... Ouch!
Nicely done!
J
Thanks!
|
