06-01-2022, 01:21 AM
Oldie but goodie:
The zip has source and font file if you don't have Windows.
Code: (Select All)
Option _Explicit
_Title "b+QB64 Asteroids M11" 'started 2018-07-13
'2020 - Oct and Nov: Special thanks to SierraKen who has been helpful with suggestions, ideas and fixes.
Randomize Timer
' Far far away in a universe where Newton's 1st Law of Motion is not obeyed... ;-))
' New Controls
' key a or left arrow = turn left
' key s or right arrow = turn right
' enter or spacebar = "hyperspace" show up somewhere else better or worse use when collision is imminent
' key k or up arrow = thrust just a burst in direction you are pointed but doesn't last
' fire! owwha, owha, owha... is now continuous
'=================================================================================================================
' 2020-10-27 remove the alternate subs and get down below 200 LOC almost there now! new shooter action font and background
' 2020-10-28 another makeover explosions and split asteroids
' 2020-10-29 fix baby rock management, break between lives
' 2020-10-29 fix left/right gun, fix explosions over many frames to eliminate pause in action, speed up 60 fps
' 2020-10-30 m3 SierraKen's idea to angle shooter with mousewheel also finish WASD options, more rocks, points system
' points:
' The higher the speed the better speed range .5 to 2.5, diff = 2 * 50 = 100 s - .5 * 50
' DELETE The lower the color the better color range 10 to 60, diff = 50 * 2 = 100 50 - (c - 10) * 2
' The smaller the size the better size range 10 to 100, diff = 90 * 1.1111 = 100 90 - (sz -10) * 1.1111
' ((speed - .5) * 50 + (90 - (r - 10)) * 1.1111) / 2 = 100 best score per hit
' 2020-10-30 increase level of difficulty, fix double lives lost, add an ending after all lives spent.
' 2020-10-31 M4 They are Here - the aliens have accepted my invitaion for war games don't get caught in their beam.
' rework ending and variable LONG suffix. Aliens on the attack 100 points before or after transformed into the Bolder of Death.
' 2020-11-01 M5 FX Moving through space, Oh yeah, more aliens!
' 2020-11-01 M6 add play again and save high game , continuous shoot
' 2020-11-01 M7 fix hits count when hit alien ship or Bolder of Death. Fix lights on aliens ship. I want to see collsions with ship.
' Ken recommends removing text in middle of screen, yeah, distracting. Makeover ship as with mouse x, y it's center. Add Splash screen.
' Show mouse in between lives so can be in screen center when press key to start next run.
' 2020-11-03 M9 watching videos on Asteroids, I found a view and description of the control panel, it is:
' 2 buttons on left and lower button in middle and 2 buttons on right level with 2 on left.
' 2 buttons on left are left and right turns they will be Keys A and S
' The middle will be spacebar for Hypespace or these days we might call it worm hole, jump to another location better or worse!
' 2 buttons on right K and L: K will be a thruster of sorts you eventually come to a stop (not what Newton would like) L is the fire button.
' So let's try that. I am impressed by hitting thruster and shooting all around as you dift in direction gun was pointed when hit thruster.
' Lighten rocks and change points, based now only on size and speed of Asteroids.
' 2020-11-04 M9 Install new update to thrust control. Thanks to SierraKen for finding out what happened to Hyperspace jump when press
' spacebar a 2nd time in a life. Oh also Boulders of Death are now more like smooth colored spheres. Ahhhh Fixed the crashing at the borders
' now fly out one side and come back in on the other! This is getting good! Adding some sound effects.
' 2020-11-05 M10 set some constants for starting game so can just change them to level of play desired.
' speed points = 50 * (rockSpeed - minRockSpeed)/rockSpeedRange > fastest rock gets 50 points
' size points = 50 * (rockSizeRange - (rockSize - minRockSize))/rockSizeRange > smallest rock gets 50 points
' points = points + 50 * ( (rockSpeed - minRockSpeed)/rockSpeedRange + (rockSizeRange - (rockSize - minRockSize))/rockSizeRange )
' Dav's comments: Add arrow keys for left right turns and up for thrust, continuous fire now! A little score board in top left corner.
' Dav I am keeping spacebar for Hyperspace but also Enter, don't need fire button now.
' Try the A for left and the right arrow for right turns.
' 2020-11-05 p is for pause
' 2020-11-06 Move it or lose it!
' 2020-11-06 Put the dang mouse back in! Press m for mouse target rich environment! Use left and right mouse buttons to aim guns,
' 2020-11-08 add mouse mode you can enter at splash screen,
' 2021-09-24 b+QB64 Asteroids M11 best mouse only
' fix p for play again because it is also pause
' don't like enter to start next life, spacebar preferred
'================================================================================================================
' NOTE: !!!!!!!!!!!!!!! When there is a pause in action, just press enter, as in enter a new life!
'================================================================================================================
Const xmax = 1200, ymax = 700, pi = _Pi, polyAngle = _Pi / 6, nRocks = 300, nBullets = 2000, bSpeed = 15
Const startRocks = 2, minRockSpeed = 0.7500, maxRockSpeed = 3.2500, minRockSize = 10, maxRockSize = 100
Const rockSpeedRange = maxRockSpeed - minRockSpeed, rockSizeRange = maxRockSize - minRockSize
Const alienSpeed = rockSpeedRange / 2 + minRockSpeed ' average rock speed
Type alienType
x As Single
y As Single
dx As Single
dy As Single
ls As Long ' lights offset and gray scale
c As _Unsigned Long ' color
live As Long
attackFrame As Long
fireX As Single
fireY As Single
transform As Long
End Type
Type particle
x As Single
y As Single
dx As Single
dy As Single
size As Single
kolor As _Unsigned Long
End Type
Type bullet
x As Single
y As Single
dx As Single
dy As Single
live As Long
End Type
Type shipType
x As Single
y As Single
live As Long
speed As Single ' just a constant now when Thrust is applied
thrustAngle As Single ' ship/gun angle at moment Thrust is pressed
angle As Single ' rotated position ship/gun now A or S keypress or hold down
thrust As Long ' this now tracks how many frames ship will move at speed and thrustAngle
End Type
Type rock
x As Single
y As Single
r As Long ' radius
ra As Single ' rotation position a = a + spin
heading As Single ' heading from which dx, dy are calc with speed
speed As Single ' speed
spin As Single ' rotation direction and amount
seed As Long ' for drawing rocks with RND USING
c As Long ' color rgb(c, c, c)
live As Long ' need this to track rocks still active like bullets
explodeFrame As Long ' after a rock is hit by bullet, it explodes and in more than one frame
End Type
ReDim Shared aliens(1 To 5) As alienType
Dim Shared dots(2000) As particle ' explosions
Dim Shared b(nBullets) As bullet
Dim Shared ship As shipType
Dim Shared r(nRocks) As rock
Dim Shared lives As Long
Dim Shared points As Long
Dim Shared rocks As Long 'rocks is the minimum number of parent rocks to have on screen automatic replace when hit or out of bounds
Dim HS As Long, fnt As Long, fnt2 As Long ' file LOAD handles
Dim i As Long, bullets As Long, fire As Long ' index and bullets
Dim r As Long, newRockN As Long, maxBabyRocks As Long, br As Long, hits As Long ' rock stuff
Dim ai As Long, alienN As Long ' alien index and number
Dim kh As Long 'key hit for ship thrust k or up arrow or hyperspace jump spacebar
Dim hs$, s$, k$, t, lastt 'high score, general string and times for bullets
Dim rockPoints As Long, roundPoints As Long ' various points scores
'Dim mouseMode As Long 'either key press hyperdrive and thrust or mouse moves
ship.speed = 3.5 'this would be a constant but ship has to declared as Ship Type first, Hyperspace jump
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 100, 20
_FullScreen
fnt = _LoadFont("ARLRDBD.ttf", 16, "MONOSPACE")
fnt2 = _LoadFont("ARLRDBD.ttf", 40, "MONOSPACE")
_Font fnt2
Color &HFF00FFFF, &H00000000
If _FileExists("Asteroids High Score.txt") Then
Open "Asteroids High Score.txt" For Input As #1
Input #1, HS
Close #1
End If
hs$ = "High Score:" + Str$(HS)
'a little splash screen
rocks = 7: alienN = 3
For i = 1 To nRocks
newRock i
If i > rocks Then r(i).live = 0
Next
For i = 1 To alienN
newAlien i
Next
i = 0
Do
drawStars 0
i = i + 1
If i Mod 30 = 29 And rocks < nRocks Then rocks = rocks + 1: r(rocks).live = 1
For r = 1 To nRocks
If r(r).live Then drawRock r
Next
For i = 1 To alienN
drawAliens i
Next
_Font fnt2
s$ = "*** b+QB64 Asteroids ***"
_PrintString ((_Width - _PrintWidth(s$)) / 2, 60), s$
_PrintString ((_Width - _PrintWidth(hs$)) / 2, 140), hs$
s$ = "A or arrow = Left Spin"
_PrintString ((_Width - _PrintWidth(s$)) / 2, 300), s$
s$ = "S or arrow = Right Spin"
_PrintString ((_Width - _PrintWidth(s$)) / 2, 380), s$
's$ = "Space or Enter = Hyper Jump"
'_PrintString ((_Width - _PrintWidth(s$)) / 2, 380), s$
s$ = "p = Pause or end Pause"
_PrintString ((_Width - _PrintWidth(s$)) / 2, 460), s$
s$ = "Mouse L/R Button = Guns"
_PrintString ((_Width - _PrintWidth(s$)) / 2, 540), s$
_Font fnt
If _KeyDown(27) Then System
k$ = InKey$
_Display
_Limit 60
Loop Until Len(k$)
_MouseHide
restart:
If _FileExists("Asteroids High Score.txt") Then
Open "Asteroids High Score.txt" For Input As #1
Input #1, HS
Close #1
End If
hs$ = " High Score:" + Str$(HS)
lives = 10: alienN = 1: rocks = startRocks ' always active rocks
points = 0: hits = 0: bullets = 0
'If k$ = "m" Then ' undocumented use of mouse
'mouseMode = -1:
alienN = 3: rocks = 5 ' M11 mouse mode assumed only other key is space or enter for hyper jump
'End If
While lives > 0 And _KeyDown(27) = 0 ' init start restart
ReDim aliens(1 To alienN) As alienType
For ai = 1 To alienN
newAlien ai
Next
For i = 1 To nRocks 'reset rocks mainly clear baby rocks
newRock (i)
If i > rocks Then r(i).live = 0
Next
ship.x = xmax / 2 'avoids explosions top left corner at start, dang still get some!
ship.y = ymax / 2
ship.angle = 0
ship.thrustAngle = 0
ship.thrust = 0
ship.live = 1
rockPoints = 0
roundPoints = 0
While ship.live And _KeyDown(27) = 0
'draw everything then process bullets
drawStars 1
Locate 1, 1: Print "Lives:"; lives
Locate 2, 1: Print "Last Rock:"; Str$(rockPoints)
Locate 3, 1: Print "Round:;"; Str$(roundPoints)
Locate 4, 1: Print "Points:"; Str$(points)
Locate 5, 1: Print "High Score:"; Str$(HS)
For ai = 1 To alienN
drawAliens ai
Next
For i = 1 To nRocks
If r(i).live Then 'make sure if we crash into a ship it is a live rock, not one sitting on side waiting to be called up
drawRock i ' while drawing rocks the ship could be blown up
If ((r(i).x - ship.x) ^ 2 + (r(i).y - ship.y) ^ 2) ^ .5 < r(i).r + 20 Then 'rock collides with ship?
For br = 1 To 200 Step 5
Circle ((ship.x + r(i).x) / 2, (ship.y + r(i).y) / 2), br, _RGB32(255 - br, 255 - 2 * br, 0)
Next
drawRock i
drawship
ship.live = 0
If i <= rocks Then newRock i Else r(i).live = 0
End If
End If
Next
For i = 1 To nRocks 'smoke up the place with rock debris fields still flying out from hit frames ago
If r(i).explodeFrame Then
r(i).explodeFrame = r(i).explodeFrame + 1
If r(i).explodeFrame > .25 * r(i).r Then
r(i).explodeFrame = 0
If i <= rocks Then newRock i ' now replace the rock
Else
explode r(i).x, r(i).y, r(i).r, r(i).explodeFrame
End If
End If
Next
If ship.live Then
For ai = 1 To alienN
If Sqr((aliens(ai).x - ship.x) ^ 2 + (aliens(ai).y - ship.y) ^ 2) < 55 Then 'aliens and ship collisde boom boom
For br = 1 To 200 Step 5
Circle ((ship.x + aliens(ai).x) / 2, (ship.y + aliens(ai).y) / 2), br, _RGB32(255 - br, 255 - 2 * br, 0)
Next
drawship
ship.live = 0
_Continue
Else
drawship
End If
Next
'If mouseMode Then
While _MouseInput: Wend
ship.x = _MouseX: ship.y = _MouseY
If _MouseButton(1) Then ship.angle = pi
If _MouseButton(2) Then ship.angle = 0
'End If
' ship controls update
'a key or left arrow = left spin
If _KeyDown(97) Or _KeyDown(19200) Then ship.angle = ship.angle - pi / 48
's key or right arrow = right spin
If _KeyDown(115) Or _KeyDown(19712) Then ship.angle = ship.angle + pi / 48
'l is Fire! JUST CONTINUOUS FIRE
fire = 0
'IF _KEYDOWN(108) THEN
t = Timer(.01)
If lastt = 0 Or t - lastt > .15 Then fire = 1: Sound 2088, .01: lastt = t
'END IF
kh = _KeyHit
Select Case kh
Case 112 ' p for pause
kh = 0
While _KeyHit <> 112: _Limit 60: Wend
'Case 107, 18432 'thrust k key or up arrow
' If mouseMode = 0 Then
' Sound 488, .01
' ship.thrustAngle = ship.angle: ship.thrust = 120
' End If
'Case 13, 32 ' space = hyperspace jump
' 'If mouseMode = 0 Then
' Randomize Timer
' ship.x = (xmax - 300) * Rnd + 150: ship.y = (ymax - 300) * Rnd + 150: ship.thrust = 0
' 'End If
End Select
' locate ship
'If ship.thrust > 0 Then
' 'relocate ship position
' ship.x = ship.x + ship.speed * Cos(ship.thrustAngle)
' ship.y = ship.y + ship.speed * Sin(ship.thrustAngle)
'End If
' jump borders
'If ship.x < 0 Then ship.x = xmax - Abs(ship.x)
'If ship.x > xmax Then ship.x = ship.x - xmax
'If ship.y < 0 Then ship.y = ymax - Abs(ship.y)
'If ship.y > ymax Then ship.y = ship.y - ymax
For i = 0 To nBullets ' handle bullets
If b(i).live = 0 And fire = 1 Then 'have inactive bullet to use
b(i).x = ship.x + 2 * bSpeed * Cos(ship.angle)
b(i).y = ship.y + 2 * bSpeed * Sin(ship.angle)
b(i).dx = bSpeed * Cos(ship.angle)
b(i).dy = bSpeed * Sin(ship.angle)
b(i).live = -1
bullets = bullets + 1
fire = 0
End If
If b(i).live Then 'new location
b(i).x = b(i).x + b(i).dx
b(i).y = b(i).y + b(i).dy
If b(i).x > 0 And b(i).x < xmax And b(i).y > 0 And b(i).y < ymax Then 'in bounds draw it
'bullet hit aliens?
For ai = 1 To alienN
If Sqr((aliens(ai).x - b(i).x) ^ 2 + (aliens(ai).y - b(i).y) ^ 2) < 30 Then
For br = 1 To 120
Circle (aliens(ai).x, aliens(ai).y), br / 3, plasma~&(0)
Next
_Display
_Delay .05
hits = hits + 1
roundPoints = roundPoints + 100
points = points + 100
aliens(ai).live = 0
newAlien ai
b(i).live = 0
_Continue
End If
Next
For r = 1 To nRocks 'check for collision with rock
If r(r).live Then
If Sqr((r(r).x - b(i).x) ^ 2 + (r(r).y - b(i).y) ^ 2) < r(r).r Then 'its a hit!
r(r).explodeFrame = 1 'linger with explosion
r(r).live = 0
hits = hits + 1
rockPoints = 50 * ((r(r).speed - minRockSpeed) / rockSpeedRange + (rockSizeRange - (r(r).r - minRockSize)) / rockSizeRange)
roundPoints = roundPoints + rockPoints
points = points + rockPoints
If r(r).r > 30 Then ' split rock into ? new ones
maxBabyRocks = Int((r(r).r - 10) / 10)
maxBabyRocks = irnd&(2, maxBabyRocks) ' pick a number of baby Rocks
For br = 1 To maxBabyRocks
' new rock
newRockN = freeRock& ' get inactive rock number
newRock newRockN ' new identity and activate
r(newRockN).r = (r(r).r - 10) / maxBabyRocks ' split in equal parts minus 20% mass
r(newRockN).x = r(r).x + irnd&(-30, 30) ' thrown from parent
r(newRockN).y = r(r).y + irnd&(-30, 30)
r(newRockN).c = r(r).c ' same color as parent
r(newRockN).heading = rrnd(ship.angle - .75 * pi, ship.angle + .75 * pi)
Next
End If ' big enough to split
b(i).live = 0 'kill bullet
End If ' hit rock
End If 'rock is there
Next ' rock
If b(i).live Then fcirc b(i).x, b(i).y, 3, _RGB32(255, 255, 0) 'draws bullet
Else
b(i).live = 0 'out of bounds
End If ' bullet is in bounds
End If ' bullet live
Next ' bullet
End If ' if ship still live
_Display
If ship.live = 0 Then
lives = lives - 1
If lives Mod 4 = 0 Then rocks = rocks + 1
If lives Mod 4 = 2 Then alienN = alienN + 1
s$ = "Lives:" + Str$(lives) + " Hits:" + Str$(hits) + " Bullets:" + Str$(bullets) + " Shooting:" + Str$(Int(hits * 100 / bullets)) + "%"
_PrintString ((_Width - _PrintWidth(s$)) / 2, ymax / 2 - 80), s$
_Font fnt2
s$ = Str$(points) + hs$
_PrintString ((_Width - _PrintWidth(s$)) / 2, ymax / 2), s$
_Font fnt
s$ = "Press enter to enter next life."
_PrintString ((_Width - _PrintWidth(s$)) / 2, ymax / 2 + 120), s$
_Display
kh = 0
While kh <> 13
kh = _KeyHit
Wend 'wait for enter key
Else
_Limit 60 ' if ship dies let's rest and regroup before restart next life
End If
Wend
_Display
Wend
If points > HS Then
Open "Asteroids High Score.txt" For Output As #1
Print #1, points
Close #1
End If
ship.x = -200: ship.y = -200 'get it out of the way
i = 0
Do
drawStars 0
i = i + 1
If i Mod 30 = 29 And rocks < nRocks Then rocks = rocks + 1: r(rocks).live = 1
For r = 1 To nRocks
If r(r).live Then drawRock r
Next
s$ = "Lives:" + Str$(lives) + " Hits:" + Str$(hits) + " Bullets:" + Str$(bullets) + " Shooting:" + Str$(Int(hits * 100 / bullets)) + "%"
_PrintString ((_Width - _PrintWidth(s$)) / 2, ymax / 2 - 80), s$
_Font fnt2
s$ = Str$(points)
If points > HS Then s$ = s$ + " a New Record!" Else s$ = Str$(points) + hs$
_PrintString ((_Width - _PrintWidth(s$)) / 2, ymax / 2), s$
_Font fnt
s$ = "Press q to quit, p or a to Play Again..."
_PrintString ((_Width - _PrintWidth(s$)) / 2, ymax / 2 + 120), s$
If _KeyDown(Asc("a")) Or _KeyDown(Asc("p")) Then GoTo restart
_Display
_Limit 60
Loop Until _KeyDown(Asc("q"))
System
Sub drawStars (moving)
Type starType
x As Single
y As Single
size As Single
c As Integer
End Type
Static beenHere, stars(200) As starType, cy As Long
Dim i As Long
If beenHere = 0 Then 'static part
For i = 0 To 100
stars(i).x = Rnd * xmax: stars(i).y = Rnd * ymax: stars(i).size = .3
stars(i).c = irnd&(80, 140)
Next
For i = 101 To 150
stars(i).x = Rnd * xmax: stars(i).y = Rnd * ymax: stars(i).size = .6
stars(i).c = irnd&(110, 170)
Next
For i = 151 To 195
stars(i).x = Rnd * xmax: stars(i).y = Rnd * ymax: stars(i).size = 1.2
stars(i).c = irnd&(140, 200)
Next
For i = 196 To 200
stars(i).x = Rnd * xmax: stars(i).y = Rnd * ymax: stars(i).size = 2.4
stars(i).c = irnd&(170, 235)
Next
cy = ymax / 2
beenHere = 1
End If
For i = 0 To cy
Line (0, i)-(xmax, i), _RGB32(0, 0, .1 * i + 4)
Line (0, ymax - i)-(xmax, ymax - i), _RGB(0, 0, .1 * i + 4)
Next
For i = 0 To 200
If moving Then
stars(i).x = stars(i).x + .2 * stars(i).size ^ stars(i).size
If stars(i).x > xmax Then stars(i).x = -1 * Rnd * 20
End If
fcirc stars(i).x, stars(i).y, stars(i).size, _RGB32(stars(i).c - 10, stars(i).c, stars(i).c + 10)
Next
End Sub
Sub newAlien (i As Long)
Dim side As Long, heading
Randomize Timer * Rnd 'to avoid making twins
side = irnd&(1, 4) 'bring rock in from one side, need to set heading according to side
If Rnd < .6 Then
aliens(i).fireX = ship.x: aliens(i).fireY = ship.y
Else
aliens(i).fireX = irnd(10, xmax - 10): aliens(i).fireY = irnd(10, ymax - 10)
End If
aliens(i).attackFrame = irnd(50, 400) ' EDIT a tweak to survive a little long before getting murdered with low lives over and over...
Select Case side
Case 1
aliens(i).x = -10
aliens(i).y = rrnd(80, ymax - 80)
Case 2
aliens(i).x = xmax + 10
aliens(i).y = rrnd(80, ymax - 80)
Case 3
aliens(i).x = rrnd(80, xmax - 80)
aliens(i).y = -10
Case 4
aliens(i).x = rrnd(80, xmax - 80)
aliens(i).y = ymax + 10
End Select
heading = _Atan2(aliens(i).fireY - aliens(i).y, aliens(i).fireX - aliens(i).x)
aliens(i).dx = alienSpeed * Cos(heading)
aliens(i).dy = alienSpeed * Sin(heading)
aliens(i).live = 0
aliens(i).transform = 0
aliens(i).c = _RGB32(irnd(128, 255), irnd(0, 255), irnd(0, 255))
End Sub
Function plasma~& (new As Long)
Static r, g, b, cnt, beenHere
If beenHere = 0 Or new Then
r = Rnd: g = Rnd: b = Rnd: beenHere = 1: cnt = 0
End If
cnt = cnt + .2
plasma~& = _RGB32(127 + 127 * Sin(r * cnt), 127 + 127 * Sin(g * cnt), 127 + 127 * Sin(b * cnt))
End Function
Sub drawAliens (i As Long) 'shipType
Dim light As Long, heading, r As Long, g As Long, b As Long
If aliens(i).live Then
Sound 6000 + i * 200, .07
If aliens(i).transform = 0 Then
r = _Red32(aliens(i).c): g = _Green32(aliens(i).c): b = _Blue32(aliens(i).c)
fellipse aliens(i).x, aliens(i).y, 6, 15, _RGB32(r, g - 120, b - 100)
fellipse aliens(i).x, aliens(i).y, 18, 11, _RGB32(r, g - 60, b - 50)
fellipse aliens(i).x, aliens(i).y, 30, 7, _RGB32(r, g, b)
For light = 0 To 5
fcirc aliens(i).x - 30 + 11 * light + aliens(i).ls, aliens(i).y, 1, _RGB32(aliens(i).ls * 50, aliens(i).ls * 50, aliens(i).ls * 50)
Next
aliens(i).ls = aliens(i).ls + 1
If aliens(i).ls > 5 Then aliens(i).ls = 0
Else
drawBall aliens(i).x, aliens(i).y, 30, aliens(i).c
End If
'time to shoot?
aliens(i).x = aliens(i).x + aliens(i).dx
aliens(i).y = aliens(i).y + aliens(i).dy
If Sqr((aliens(i).fireX - aliens(i).x) ^ 2 + (aliens(i).fireY - aliens(i).y) ^ 2) < 5 Then 'transform into the bolder of death
aliens(i).transform = 1
heading = _Atan2(ship.y - aliens(i).y, ship.x - aliens(i).x)
aliens(i).dx = 2.5 * Cos(heading)
aliens(i).dy = 2.5 * Sin(heading)
End If
If aliens(i).x < -10 Or aliens(i).x > xmax + 10 Then
If aliens(i).y < -10 Or aliens(i).y > ymax + 10 Then ' out of bounds goodbye bolder of death!
aliens(i).live = 0 'man we dodged a bullet here!!!!
newAlien i 'reset the trap
End If
End If
Else
If aliens(i).attackFrame Then
aliens(i).attackFrame = aliens(i).attackFrame - 1
If aliens(i).attackFrame = 0 Then
aliens(i).live = 1
End If
End If
End If
End Sub
Function freeRock&
Dim i As Long
For i = rocks + 1 To nRocks ' look for inactive rock number
If r(i).live = 0 And r(i).explodeFrame = 0 Then freeRock& = i: Exit Function
Next
End Function
Sub explode (x As Long, y As Long, r As Long, frm As Long)
Dim maxParticles As Long, i As Long, rounds As Long, loopCount As Long
maxParticles = r * 4
For i = 1 To r
NewDot i, x, y, r
Next
rounds = r
For loopCount = 0 To frm
If _KeyDown(27) Then End
For i = 1 To rounds
dots(i).x = dots(i).x + dots(i).dx
dots(i).y = dots(i).y + dots(i).dy
fcirc dots(i).x, dots(i).y, dots(i).size, dots(i).kolor
Next
If rounds < maxParticles Then
For i = 1 To r
NewDot (rounds + i), x, y, r
Next
rounds = rounds + r
End If
Next
End Sub
Sub NewDot (i As Long, x As Long, y As Long, r As Long)
Dim angle, rd
angle = pi * 2 * Rnd
rd = Rnd * 30
dots(i).x = x + rd * Cos(angle)
dots(i).y = y + rd * Sin(angle)
dots(i).size = Rnd * r * .05
rd = Rnd 'STxAxTIC recommended for rounder spreads
dots(i).dx = rd * 10 * (10 - 2 * dots(i).size) * Cos(angle)
dots(i).dy = rd * 10 * (10 - 2 * dots(i).size) * Sin(angle)
rd = 20 + Rnd * 70
dots(i).kolor = _RGBA32(rd, rd, rd, 80)
End Sub
Sub drawship 'simple red iso triangle pointed towards radianAngle
Dim x1 As Long, y1 As Long, x2 As Long, y2 As Long, x3 As Long, y3 As Long
Dim x4 As Long, y4 As Long, x5 As Long, y5 As Long
If ship.thrust > 0 Then
'burn out flame as thruster dies out
x4 = ship.x + .5 * ship.thrust * Cos(ship.angle - 17 / 18 * pi)
y4 = ship.y + .5 * ship.thrust * Sin(ship.angle - 17 / 18 * pi)
x5 = ship.x + .5 * ship.thrust * Cos(ship.angle - 19 / 18 * pi)
y5 = ship.y + .5 * ship.thrust * Sin(ship.angle - 19 / 18 * pi)
ftri ship.x, ship.y, x4, y4, x5, y5, &H99FFFF88
ship.thrust = ship.thrust - 1
End If
'draw ship dead or alive thrust or not, calculate 3 points of triangle ship
fcirc ship.x, ship.y, 30, &H05FFFFFF
x1 = ship.x + 30 * Cos(ship.angle) ' front point
y1 = ship.y + 30 * Sin(ship.angle) '
x2 = ship.x + 30 * Cos(ship.angle + .6666 * pi) ' wing
y2 = ship.y + 30 * Sin(ship.angle + .6666 * pi)
x3 = ship.x + 30 * Cos(ship.angle - .6666 * pi) ' other wing
y3 = ship.y + 30 * Sin(ship.angle - .6666 * pi)
ftri ship.x, ship.y, x1, y1, x2, y2, _RGB32(80, 120, 80, 80)
ftri ship.x, ship.y, x1, y1, x3, y3, _RGB32(60, 100, 60, 80)
Line (x1, y1)-(ship.x, ship.y), _RGB32(255, 255, 128)
Line (x1, y1)-(x2, y2), _RGB32(255, 180, 40)
Line (x1, y1)-(x3, y3), _RGB32(255, 180, 40)
End Sub
Sub drawRock (iRock)
Randomize Using r(iRock).seed 'this prevents having to save a particular sequence of random number
Dim dx, dy, j As Long, rRad As Single, leg As Single, x0 As Long, y0 As Long, rc As Long, c~&, x1 As Long, y1 As Long, xoff, yoff, i As Long
Dim x2 As Long, y2 As Long
dx = r(iRock).speed * Cos(r(iRock).heading)
dy = r(iRock).speed * Sin(r(iRock).heading) 'update location
r(iRock).ra = r(iRock).ra + r(iRock).spin
If r(iRock).x + dx + r(iRock).r < 0 Or r(iRock).x + dx - r(iRock).r > xmax Or r(iRock).y + dy + r(iRock).r < 0 Or r(iRock).y + dy - r(iRock).r > ymax Then
If iRock <= rocks Then newRock iRock Else r(iRock).live = 0
Exit Sub ' reassigned get out of here
Else
r(iRock).x = r(iRock).x + dx
r(iRock).y = r(iRock).y + dy
End If
For j = 10 To 3 Step -1 ' rock drawing (see demo program where developed code)
rRad = .1 * j * r(iRock).r
leg = rRad * (Rnd * .7 + .3)
x0 = r(iRock).x + leg * Cos(r(iRock).ra)
y0 = r(iRock).y + leg * Sin(r(iRock).ra)
rc = r(iRock).c + 30 * Rnd - 15
c~& = _RGB32(rc + 5, rc - 10, rc + 5)
x1 = x0
y1 = y0
xoff = Rnd * 20 - 10 + r(iRock).x
yoff = Rnd * 20 - 10 + r(iRock).y
For i = 1 To 12
leg = rRad * (Rnd * .35 + .65)
If i = 12 Then
x2 = x0: y2 = y0
Else
x2 = xoff + leg * Cos(i * polyAngle + r(iRock).ra)
y2 = yoff + leg * Sin(i * polyAngle + r(iRock).ra)
End If
ftri r(iRock).x, r(iRock).y, x1, y1, x2, y2, c~&
x1 = x2: y1 = y2
Next
Next
End Sub
Sub newRock (iRock)
Dim side As Long
Randomize Timer * Rnd 'to avoid making twins
side = irnd&(1, 4) 'bring rock in from one side, need to set heading according to side
Select Case side
Case 1
r(iRock).x = -100
r(iRock).y = rrnd(80, ymax - 80)
If Rnd < .25 Then r(iRock).heading = _Atan2(ship.y - r(iRock).y, ship.x - r(iRock).x) Else r(iRock).heading = 3 * pi / 2 + Rnd * pi
Case 2
r(iRock).x = xmax + 100
r(iRock).y = rrnd(80, ymax - 80)
If Rnd < .25 Then r(iRock).heading = _Atan2(ship.y - r(iRock).y, ship.x - r(iRock).x) Else r(iRock).heading = pi / 2 + Rnd * pi
Case 3
r(iRock).x = rrnd(80, xmax - 80)
r(iRock).y = -100
If Rnd < .25 Then r(iRock).heading = _Atan2(ship.y - r(iRock).y, ship.x - r(iRock).x) Else r(iRock).heading = Rnd * pi
Case 4
r(iRock).x = rrnd(80, xmax - 80)
r(iRock).y = ymax + 100
If Rnd < .25 Then r(iRock).heading = _Atan2(ship.y - r(iRock).y, ship.x - r(iRock).x) Else r(iRock).heading = pi + Rnd * pi
End Select
r(iRock).speed = rrnd(minRockSpeed, maxRockSpeed) 'speed, rotation angle, radius, gray coloring, spin, seed, hit for explosion
r(iRock).ra = Rnd * 2 * pi
r(iRock).r = irnd&(minRockSize * 3, maxRockSize) 'every parent rock can be split up into at least 2 - 10 size rocks
r(iRock).c = irnd&(60, 110) ' Ken request increase in rock color
r(iRock).spin = rrnd(-pi / 20, pi / 20)
r(iRock).seed = Int(Rnd * 64000) - 32000
r(iRock).explodeFrame = 0
r(iRock).live = 1
End Sub
Function irnd& (n1, n2) 'return an integer between 2 numbers
Dim l%, h%
If n1 > n2 Then l% = n2: h% = n1 Else l% = n1: h% = n2
irnd& = Int(Rnd * (h% - l% + 1)) + l%
End Function
Function rrnd (n1, n2) ' return number (expecting reals =_single, double, _float depending on default / define setup)
rrnd = (n2 - n1) * Rnd + n1
End Function
Sub drawBall (x, y, r, c As _Unsigned Long)
Dim red As Long, grn As Long, blu As Long, rr As Long, f
red = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
For rr = r To 0 Step -1
f = 1 - rr / r
fcirc x, y, rr, _RGB32(red * f, grn * f, blu * f)
Next
End Sub
Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
Dim D As Long
Static a&
D = _Dest
If a& = 0 Then a& = _NewImage(1, 1, 32)
_Dest a&
_DontBlend a& ' '<<<< new 2019-12-16 fix
PSet (0, 0), K
_Blend a& '<<<< new 2019-12-16 fix
_Dest D
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
End Sub
Sub fcirc (x As Long, y As Long, R As Long, C As _Unsigned Long) 'vince version
Dim x0 As Long, y0 As Long, e As Long
x0 = R: y0 = 0: e = 0
Do While y0 < x0
If e <= 0 Then
y0 = y0 + 1
Line (x - x0, y + y0)-(x + x0, y + y0), C, BF
Line (x - x0, y - y0)-(x + x0, y - y0), C, BF
e = e + 2 * y0
Else
Line (x - y0, y - x0)-(x + y0, y - x0), C, BF
Line (x - y0, y + x0)-(x + y0, y + x0), C, BF
x0 = x0 - 1: e = e - 2 * x0
End If
Loop
Line (x - R, y)-(x + R, y), C, BF
End SubThe zip has source and font file if you don't have Windows.
b = b + ...