09-14-2022, 08:13 PM
I added another level, and basically framed it so adding levels will be fairly easy.
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 explosion&
explosion& = _SndOpen("explosion2.ogg")
Dim bonus&
bonus& = _SndOpen("greenlight2.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
rot As Integer
End Type
Dim Shared bnb(900) As BB
Type scenario
difficulty As Integer
padct As Integer
xstart As Integer
ystart As Integer
maxfuel As Integer
bonusfuel As Integer
End Type
Dim Shared level(100) As scenario
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 ctt, angle
Dim Shared keyfire(3)
Dim Shared j, levelnumber
'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)
Cls
addstars
_PutImage (1, 1)-(scx - 1, scy - 1), 0, bgsnap&, (1, 1)-(scx - 1, scy - 1) 'take snapshot of screen
title1
'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&
animateshuffle = 0
Cls
_PutImage (0, 0)-(scx, scy), bgsnap&, 0 'replace screen with background only (no ship)
_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
levelnumber = 0
gameover = 0
Do 'start of new level
If gameover > 0 Then
gameover = 0
levelnumber = 0
End If
Cls
levelnumber = levelnumber + 1
If levelnumber > 2 Then levelnumber = 1
If levelnumber = 1 Then setscreen1
If levelnumber = 2 Then setscreen2
dv = .027 ' time delay / game speed
'ship starting pos
stx = level(levelnumber).xstart
sty = level(levelnumber).ystart
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 = level(levelnumber).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 'contact under one side only, if soft landing then roll over
If bnb(j).yv <= 2 Then
ccflag = 3
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 = 0
For t = 1 To level(levelnumber).padct
pc = pc + pad(t).count
Next t
For t = 1 To level(levelnumber).padct
If px > pad(t).x1 + 16 And px < pad(t).x2 - 16 And pad(t).count = 0 Then
If t < level(levelnumber).padct Then
pad(t).count = 1
If ccflag = 1 Then
If Not _SndPlaying(bonus&) Then _SndPlay bonus& ' play sound if it wasn't already playing
_SndVol bonus&, .4
_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 + level(levelnumber).bonusfuel ' fuel bonus
If bnb(j).fuel > level(levelnumber).maxfuel Then bnb(j).fuel = level(levelnumber).maxfuel
_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 = level(levelnumber).padct - 1 Then ' Final pad only active after others completed
pad(t).count = 1
If ccflag = 1 Then
If Not _SndPlaying(bonus&) Then _SndPlay bonus& ' play sound if it wasn't already playing
_SndVol bonus&, .4
_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(level(levelnumber).padct).count = 1 Then ' if FINAL 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, explosion&
'explode2 bnb, c0, j
flag = 1
End If
'====================================================================================================
'====================================================================================================
If ccflag < 3 Then
'blinking light on ship
blinkinglight bnb, c0, blink, ccflag
vaw
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
_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
If _KeyDown(27) Then quit1 = 1
Loop Until quit1 = 1
For ctt = 1 To 72
_FreeImage ship(ctt)
Next ctt
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
If red% < blu% Then checkunderleft = 0 'exception for atmosphere
If red% = 255 Then checkunderleft = 1
If grn% = 200 Then 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
If red% < blu% Then checkunderright = 0 'exception for atmosphere
If red% = 255 Then checkunderright = 1
If grn% = 200 Then 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
If red% < blu% Then leftcheck = 0 'exception for atmosphere
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
If red% < blu% Then rightcheck = 0 'exception for atmosphere
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&)
' If _SndPlaying(explosion&) Then _SndStop (explosion&)
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), snap2&, 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), snap2&, 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
'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 / level(levelnumber).maxfuel) * 180
Line (xp + 32, 186 - f)-(xp + 45, 186), c0(17), BF 'fuel level
End Sub
Sub setscreen1
'level 1 pad locations
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(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(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(4).x1 = scx - 120: pad(4).x2 = pad(4).x1 + 40
pad(4).y1 = scy - 50: pad(4).y2 = pad(4).y1 + 2
'level 1 parameters
level(1).difficulty = 1
level(1).padct = 4
level(1).xstart = pad(4).x1 + (pad(4).x2 - pad(4).x1) / 2
level(1).ystart = pad(4).y1 - 20
level(1).maxfuel = 1000
level(1).bonusfuel = 300
'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).colour = 5
pad(1).count = 0
pad(2).colour = 5
pad(2).count = 0
pad(3).colour = 5
pad(3).count = 0
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 setscreen2
'level 2 pad locations
pad(1).x1 = 80: pad(1).x2 = 220
pad(1).y1 = scy - 100: pad(1).y2 = pad(1).y1 + 2
pad(2).x1 = 270: pad(2).x2 = 330
pad(2).y1 = 200: pad(2).y2 = pad(2).y1 + 2
pad(3).x1 = 470: pad(3).x2 = 530
pad(3).y1 = scy - 150: pad(3).y2 = pad(3).y1 + 2
pad(4).x1 = 675: pad(4).x2 = 725
pad(4).y1 = 250: pad(4).y2 = pad(4).y1 + 2
pad(5).x1 = scx - 180: pad(5).x2 = scx - 120
pad(5).y1 = 350: pad(5).y2 = pad(5).y1 + 2
'level 2 parameters
level(2).difficulty = 1
level(2).padct = 5
level(2).xstart = pad(5).x1 + (pad(5).x2 - pad(5).x1) / 2
level(2).ystart = pad(5).y1 - 20
level(2).maxfuel = 800
level(2).bonusfuel = 200
'structure 1
x1 = pad(1).x1 + (pad(1).x2 - pad(1).x1) / 2
y1 = pad(1).y1
a90 = (pad(1).x2 - pad(1).x1) / 2 'platform width
b90 = 20 'platform thickness
w90 = 11 'post width
For t = -w90 To w90
t2 = t ^ 2
t2 = t2 * 1.5
c0(99) = _RGBA(55, 50, 45, 255 - t2)
Line (x1 + t, y1 + b90)-(x1 + t, scy - 20), c0(99)
Next t
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(55, 50, 45, j90 * 10)
Line (x1 - x90, y1 + y90)-(x1 + x90, y1 + y90), c0(99)
Next j90
'structure 2
x1 = pad(2).x1 + (pad(2).x2 - pad(2).x1) / 2
y1 = pad(2).y1
a90 = (pad(2).x2 - pad(2).x1) / 2 'platform width
b90 = 10
For t = -w90 To w90
t2 = t ^ 2
t2 = t2 * 1.5
c0(99) = _RGBA(55, 50, 45, 200 - t2)
Line (x1 + t, y1 + b90)-(x1 + t, scy - 20), c0(99)
Next t
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(55, 50, 45, j90 * 10)
Line (x1 - x90, y1 + y90)-(x1 + x90, y1 + y90), c0(99)
Next j90
'structure 3
x1 = pad(3).x1 + (pad(3).x2 - pad(3).x1) / 2
y1 = pad(3).y1
a90 = (pad(3).x2 - pad(3).x1) / 2 'platform width
b90 = 15
For t = -w90 To w90
t2 = t ^ 2
t2 = t2 * 1.5
c0(99) = _RGBA(55, 50, 45, 200 - t2)
Line (x1 + t, y1 + b90)-(x1 + t, scy - 20), c0(99)
Next t
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(55, 50, 45, j90 * 10)
Line (x1 - x90, y1 + y90)-(x1 + x90, y1 + y90), c0(99)
Next j90
'structure 4
x1 = pad(4).x1 + (pad(4).x2 - pad(4).x1) / 2
y1 = pad(4).y1
a90 = (pad(4).x2 - pad(4).x1) / 2 'platform width
b90 = 12
For t = -w90 To w90
t2 = t ^ 2
t2 = t2 * 1.5
c0(99) = _RGBA(55, 50, 45, 200 - t2)
Line (x1 + t, y1 + b90)-(x1 + t, scy - 20), c0(99)
Next t
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(55, 50, 45, j90 * 10)
Line (x1 - x90, y1 + y90)-(x1 + x90, y1 + y90), c0(99)
Next j90
'structure 5
x1 = pad(5).x1 + (pad(5).x2 - pad(5).x1) / 2
y1 = pad(5).y1
a90 = (pad(5).x2 - pad(5).x1) / 2 'platform width
b90 = 10
For t = -w90 To w90
t2 = t ^ 2
t2 = t2 * 1.5
c0(99) = _RGBA(55, 50, 45, 200 - t2)
Line (x1 + t, y1 + b90)-(x1 + t, scy - 20), c0(99)
Next t
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(55, 50, 45, j90 * 10)
Line (x1 - x90, y1 + y90)-(x1 + x90, y1 + y90), c0(99)
Next j90
addstars
'===== 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).colour = 5
pad(1).count = 0
pad(2).colour = 5
pad(2).count = 0
pad(3).colour = 5
pad(3).count = 0
pad(4).colour = 5
pad(4).count = 0
pad(5).colour = 5
pad(5).count = 0
'===== 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
'===== pad 5
Line (pad(5).x1, pad(5).y1)-(pad(5).x2, pad(5).y2), c0(pad(5).colour), BF
'add atmosphere to top of platforms
br = .03 'brightness
'structure 1
x1 = pad(1).x1 + (pad(1).x2 - pad(1).x1) / 2
y1 = pad(1).y1 - 1
a90 = (pad(1).x2 - pad(1).x1) / 2 'platform width
b90 = 210 'platform thickness
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(50, 150, 250, j90 * br)
Line (x1 - x90, y1 - y90)-(x1 + x90, y1 - y90), c0(99)
Next j90
'structure 2
x1 = pad(2).x1 + (pad(2).x2 - pad(2).x1) / 2
y1 = pad(2).y1 - 1
a90 = (pad(2).x2 - pad(2).x1) / 2 'platform width
b90 = 90
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(50, 150, 250, j90 * br)
Line (x1 - x90, y1 - y90)-(x1 + x90, y1 - y90), c0(99)
Next j90
'structure 3
x1 = pad(3).x1 + (pad(3).x2 - pad(3).x1) / 2
y1 = pad(3).y1 - 1
a90 = (pad(3).x2 - pad(3).x1) / 2 'platform width
b90 = 180
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(50, 150, 250, j90 * br)
Line (x1 - x90, y1 - y90)-(x1 + x90, y1 - y90), c0(99)
Next j90
'structure 4
x1 = pad(4).x1 + (pad(4).x2 - pad(4).x1) / 2
y1 = pad(4).y1 - 1
a90 = (pad(4).x2 - pad(4).x1) / 2 'platform width
b90 = 150
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(50, 150, 250, j90 * br)
Line (x1 - x90, y1 - y90)-(x1 + x90, y1 - y90), c0(99)
Next j90
'structure 5
x1 = pad(5).x1 + (pad(5).x2 - pad(5).x1) / 2
y1 = pad(5).y1 - 1
a90 = (pad(5).x2 - pad(5).x1) / 2 'platform width
b90 = 60
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
c0(99) = _RGBA(50, 150, 250, j90 * br * 2)
Line (x1 - x90, y1 - y90)-(x1 + x90, y1 - y90), c0(99)
Next j90
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(40) = _RGBA(50, 150, 255, 120) 'screen 2 platform upper
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)
c0(70) = _RGBA(0, 0, 0, 200)
c0(71) = _RGBA(0, 0, 0, 120)
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, explosion&)
x88 = bnb(j).xv / 8 'existing x velocity
y88 = bnb(j).yv / 8 'existing y velocity
If _SndPlaying(thrust&) Then _SndStop (thrust&)
If Not _SndPlaying(explosion&) Then _SndPlay explosion& ' play sound if it wasn't already playing
_SndVol explosion&, .4
_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 = 175
flip = 0
'starting points of explosion
If bnb(j).xv < -1 Then stx2 = -15
If bnb(j).xv > -1 And bnb(j).xv < 1 Then stx2 = 0
If bnb(j).xv > 1 Then stx2 = 15
sty2 = 0
If bnb(j).yv > 2 Then sty2 = 10
stx = bnb(j).x + stx2
sty = bnb(j).y + sty2
timect = 0
fleg = 0
'ellipse size
a90 = 15
b90 = 15
If bnb(j).xv > 3 Or bnb(j).xv < -3 Then a90 = 25
'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 * 8) - 2 + blsp - blsp2) / 5
bnb(t).xv = ((Rnd * 2) - 1) / 2
ylaunchspeed = ((Rnd * 8) - 3.5 + blsp - blsp2) / 5
bnb(t).yv = ((Rnd * (ylaunchspeed + y88) * .1) - (ylaunchspeed + y88)) / 2
bnb(t).spd = Int(Rnd * 6) + 1
bnb(t).age = 1
bnb(t).rot = 0
c1 = Int(Rnd * 10) + 1
c1 = 23
bnb(t).colour = c1
c1 = Int(Rnd * 30)
If c1 > 7 Then c1 = 1
If c1 > 2 Then c1 = .5
bnb(t).rad = c1
End If
Loop Until t >= maxb
'--------------------------------------------------------------
'explosion crater - ellipse
stx2 = 0 - stx2
sty2 = 0 - sty2
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
Line (bnb(j).x - x90 + stx2, bnb(j).y - y90 + sty2)-(bnb(j).x + x90 + stx2, bnb(j).y - y90 + sty2), c0(0)
Line (bnb(j).x - x90 + stx2, bnb(j).y + y90 + sty2)-(bnb(j).x + x90 + stx2, bnb(j).y + y90 + sty2), c0(0)
Next j90
a90 = a90 + 7: b90 = b90 + 7
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
Line (bnb(j).x - x90 + stx2, bnb(j).y - y90 + sty2)-(bnb(j).x + x90 + stx2, bnb(j).y - y90 + sty2), c0(70)
Line (bnb(j).x - x90 + stx2, bnb(j).y + y90 + sty2)-(bnb(j).x + x90 + stx2, bnb(j).y + y90 + sty2), c0(70)
Next j90
a90 = a90 + 12: b90 = b90 + 12
For j90 = 0 To b90
y90 = b90 - j90
x90 = Sqr((1 - y90 ^ 2 / b90 ^ 2) * a90 ^ 2)
Line (bnb(j).x - x90 + stx2, bnb(j).y - y90 + sty2)-(bnb(j).x + x90 + stx2, bnb(j).y - y90 + sty2), c0(71)
Line (bnb(j).x - x90 + stx2, bnb(j).y + y90 + sty2)-(bnb(j).x + x90 + stx2, bnb(j).y + y90 + sty2), c0(71)
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 = .01
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
bnb(j).rot = bnb(j).rot + 1
If bnb(j).rot > 8 Then bnb(j).rot = 1
If bnb(j).rot < 5 Then
If bnb(j).spd = 1 Then
Line (bnb(j).x - bnb(j).rad, bnb(j).y - bnb(j).rad * 2)-(bnb(j).x + bnb(j).rad, bnb(j).y + bnb(j).rad * 2), c0(ccc), BF
End If
If bnb(j).spd = 2 Then
Line (bnb(j).x, bnb(j).y - bnb(j).rad)-(bnb(j).x, bnb(j).y + bnb(j).rad), c0(ccc), BF
End If
If bnb(j).spd = 3 Then
Line (bnb(j).x, bnb(j).y - bnb(j).rad * 2)-(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
If bnb(j).rot > 4 Then
If bnb(j).spd = 1 Then
Line (bnb(j).x - bnb(j).rad * 2, bnb(j).y - bnb(j).rad)-(bnb(j).x + bnb(j).rad * 2, 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).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 * 2)-(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).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 = 5 Then
Line (bnb(j).x - bnb(j).rad * 2, bnb(j).y)-(bnb(j).x + bnb(j).rad, bnb(j).y), c0(ccc), BF
End If
If bnb(j).spd = 6 Then
Line (bnb(j).x, bnb(j).y - bnb(j).rad * 2)-(bnb(j).x, bnb(j).y + bnb(j).rad * 2), 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
bnb(j).rot = 0
Next j
End Sub
