Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
02-01-2025, 10:36 PM
(This post was last modified: 02-01-2025, 10:39 PM by SierraKen.)
Well, it's not exactly like the original Asteroids. The rocks don't break into smaller ones. I did try to make it that way, but it's a bit too advanced for my learning. Plus I don't want to make it look almost exactly like the arcade version because of copyright infringement. I know there's been a million other versions already made, but ya never know. lol
The rocks change their looks randomly for each level.
Tell me what you think, I've been working on this for maybe 3 or 4 days. It might still have some flukes, like possibly more than 1 asteroids being gone after shooting one for a different angle. I'm not exactly sure why that happened but I might have fixed it, or at least almost all of it.
Disclaimer: This game is not intended to replace any other game in existence. It is a labor of love and given out for free like usual.
Thank you guys for your inspiration. My Mouse Tank game really helped a lot on this code. Plus I got more math code from ChatGPT. Feel free to take as much as you want, as usual. 
Here is a picture, the code is below it.
@bplus
@Pete
![[Image: Asteroids-Clone-by-Sierra-Ken.jpg]](https://i.ibb.co/rRDGvCx9/Asteroids-Clone-by-Sierra-Ken.jpg)
Code: (Select All)
'Asteroids Clone by, SierraKen
'February 1, 2025
'Thank you QB64pe Forum for your inspiration!
'Thank you also ChatGPT for a lot of the math.
'This game is not intended to replace any other game already in existence.
'It is a labor of love and given out for free.
_Title "Asteroids Clone - by SierraKen"
Screen _NewImage(800, 600, 32)
Randomize Timer
Dim oldx(100), oldy(100)
Dim llx(300), lly(300)
Dim lx(300), ly(300), ldir(300)
Dim x1 As Single, y1 As Single
Const numPoints = 30
Dim x2(100, 35), y2(100, 35)
Dim xRot(100, 35), yRot(100, 35)
Dim cx2(200), cy2(200), angle2(200)
Dim dx(100), dy(100)
Dim nox(200)
start:
numAsteroids = 8
radius2 = 45 'Asteroids
level = 1
score = 0
health = 50
healthp = 100
rot = -90
Cls
_AutoDisplay
Locate 3, 25: Print "A s t e r o i d s C l o n e"
Locate 5, 25: Print "By SierraKen"
Locate 10, 25: Print "Move your ship around with the arrow keys."
Locate 11, 25: Print "Turn your ship with the left and right arrow keys."
Locate 12, 25: Print "Go forward with the up arrow key."
Locate 12, 25: Print "Press Space Bar to fire at asteroids."
Locate 13, 25: Print "To pause and un-pause, press Esc."
Locate 14, 25: Print "Press Q anytime to quit."
Locate 16, 25: Print "This game is not intended to replace any other game."
Locate 17, 25: Print "It is a labor of love and given out for free."
Locate 20, 25: Input "Press Enter to Begin.", a$
start2:
Cls
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
numAsteroids = numAsteroids + 2
If numAsteroids > 40 Then numAsteroids = 40
num = numAsteroids
rock = 0
hits = 0
speed2 = 0
laser = 0
ll = 0
numpoints2 = Int(Rnd * numPoints) + 5
For ll3 = 1 To 200
lx(ll3) = 0
ly(ll3) = 0
ldir(ll3) = 0
Next ll3
sx = 400
sy = 300
oldx = 400
oldy = 300
det = 0
r1 = 3 'bullets
r3 = 25 'Your ship
loops = 0
Play "MB"
' Initialize asteroids
For a = 0 To num - 1
more:
cx2(a) = Int(Rnd * 680) + 55 ' Random start X
cy2(a) = Int(Rnd * 480) + 55 ' Random start Y
If cx2(a) > 250 And cx2(a) < 550 And cy2(a) > 150 And cy2(a) < 450 Then GoTo more:
angle2(a) = Rnd * 360 ' Random starting rotation
dx(a) = (Rnd - 0.5) * 2 ' Random speed X (-1 to 1)
dy(a) = (Rnd - 0.5) * 2 ' Random speed Y (-1 to 1)
' Generate random asteroid shape
For i = 0 To numpoints2
ang = i * (360 / numpoints2)
rOffset = radius2 + Int(Rnd * 15 - 7) ' Vary radius randomly
x2(a, i) = Cos(ang * _Pi / 180) * rOffset
y2(a, i) = Sin(ang * _Pi / 180) * rOffset
Next
rock = rock + 1
Next
Do
_Limit 100
k = _KeyHit
If k = 32 Then
laser = 1
ll = ll + 1
If ll > 100 Then ll = 1
lx(ll) = x1
ly(ll) = y1
ldir(ll) = angle
End If
If k = 19200 Then dir = 1 ' Left Arrow (rotate counterclockwise)
If k = 19712 Then dir = 2 ' Right Arrow (rotate clockwise)
If k = 18432 Then dir = 3 ' Up Arrow (thrust forward)
If k = 20480 Then dir = 4 ' Down Arrow (thrust backward)
If dir = 1 Then
angle = angle - 1
If right = 1 Then
right = 0
dir = 0
GoTo nex2
End If
left = 1
right = 0
End If
If dir = 2 Then
angle = angle + 1
If left = 1 Then
left = 0
dir = 0
GoTo nex2
End If
right = 1
left = 0
End If
If dir = 3 Then
forward = 1
backward = 0
speed2 = speed2 + .5
If speed2 > 3 Then speed2 = 3
' Move in the direction of the angle
sx = sx + speed2 * Cos(angle * _Pi / 180)
sy = sy + speed2 * Sin(angle * _Pi / 180)
End If
If dir = 4 Then
If forward = 1 Then
dir = 0
speed2 = 0
GoTo nex2:
End If
End If
nex2:
If sx > 800 Then sx = 0
If sx < 0 Then sx = 800
If sy > 600 Then sy = 0
If sy < 0 Then sy = 600
If k = 27 Then
Do: c = _KeyHit
Loop Until c = 27
End If
If k = 81 Or k = 113 Then End
' Update and draw each asteroid
For a = 0 To num - 1
If nox(a) = 1 Then GoTo skip
angle2(a) = angle2(a) + 1 ' Rotate
If angle2(a) >= 360 Then angle2(a) = 0
' Rotate asteroid points
rad = angle2(a) * _Pi / 180
For i = 0 To numpoints2
xRot(a, i) = cx2(a) + (x2(a, i) * Cos(rad) - y2(a, i) * Sin(rad))
yRot(a, i) = cy2(a) + (x2(a, i) * Sin(rad) + y2(a, i) * Cos(rad))
Next
' Draw asteroid
For i = 0 To numpoints2 - 1
j = (i + 1) Mod numpoints2
Line (xRot(a, i), yRot(a, i))-(xRot(a, j), yRot(a, j)), _RGB32(255, 255, 255)
Next
' Move asteroid
cx2(a) = cx2(a) + dx(a)
cy2(a) = cy2(a) + dy(a)
' Wrap around screen edges
If cx2(a) < 0 Then cx2(a) = 800
If cx2(a) > 800 Then cx2(a) = 0
If cy2(a) < 0 Then cy2(a) = 600
If cy2(a) > 600 Then cy2(a) = 0
Next
skip:
If laser = 1 Then
For lz = 0 To ll - 1 Step 10
lx2 = Cos(ldir(lz) * _Pi / 180) * 10
ly2 = Sin(ldir(lz) * _Pi / 180) * 10
lx(lz) = lx2 + lx(lz)
ly(lz) = ly2 + ly(lz)
If lx(lz) > 850 Then lx(lz) = 850
If lx(lz) < -50 Then lx(lz) = -50
If ly(lz) > 650 Then ly(lz) = 650
If ly(lz) < -50 Then ly(lz) = -50
fillCircle lx(lz), ly(lz), r1, _RGB32(255, 0, 5)
For chk = 0 To num - 1
distance = Sqr((lx(lz) - cx2(chk)) ^ 2 + (ly(lz) - cy2(chk)) ^ 2)
If distance <= r1 + radius2 Then
DetectCollision = -1 ' True (collision detected)
Else
DetectCollision = 0 ' False (no collision)
End If
If DetectCollision = -1 Then
For explosion = 1 To 50
Circle (lx(lz), ly(lz)), explosion, _RGB32(255, 0, 0)
llx(explosion) = lx(lz)
lly(explosion) = ly(lz)
Next explosion
'SOUND frequency!, duration![, volume!][, panPosition!][, waveform&][, waveformParameters!][, voice&]]
Sound 800, .4, , , 5
Sound 200, .75, , , 6
Sound 100, .75, , , 7
nox(rock) = 1
rock = rock - 1
num = num - 1
cx2(chk) = -500: cy2(chk) = 1200
lx(lz) = -150: ly(lz) = -150: ldir(lz) = 0
score = score + 10
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
hits = hits + 1
laser = 0
End If
Next chk
'Detect Level Change
If hits > numAsteroids - 1 Then
Cls
level = level + 1
For n = 1 To 200
nox(n) = 0
Next n
For n = 0 To 100
cx2(n) = -400: cy2(n) = -400
dx(n) = 0: dy(n) = 0
angle2(n) = 0
Next n
GoTo start2
End If
Next lz
End If
'Draw ship,
DrawTriangle sx, sy, 20, angle, x1, y1
For chk = 0 To numAsteroids - 1
distance = Sqr((sx - cx2(chk)) ^ 2 + (sy - cy2(chk)) ^ 2)
If distance <= r3 + radius2 Then
DetectCollision = -1 ' True (collision detected)
Else
DetectCollision = 0 ' False (no collision)
End If
If DetectCollision = -1 And nox(chk) <> 1 Then
det = 1
health = health - .2
healthp = Int((health / 50) * 100)
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
If health < .01 Then
health = 0
For explosion = 1 To 200
Circle (sx, sy + 25), explosion, _RGB32(255, 0, 0)
Next explosion
For nn = 1 To 200
nox(nn) = 0
Next nn
Sound 500, 4, , , 8
Sound 500, 8, , , 5
Sound 100, 4, , , 7
Locate 20, 30: Print "G A M E O V E R"
Locate 25, 30: Input "Again (Y/N)"; ag$
ag2$ = LTrim$(RTrim$(ag$))
If Left$(ag2$, 1) = "y" Or Left$(ag2$, 1) = "Y" Then GoTo start
End
End If
End If
Next chk
skip3:
If det > 0 Then
det = det + 1
Paint (sx, sy), _RGB32(255, 0, 0), _RGB32(255, 255, 255)
If det > 200 Then det = 0
End If
If loops < 1000 Then
loops = loops + 1
End If
_Display
Cls
Loop
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub DrawTriangle (cx As Integer, cy As Integer, size As Integer, angle As Single, x1, y1)
Dim x2 As Single, y2 As Single
Dim x3 As Single, y3 As Single
Dim a1 As Single, a2 As Single, a3 As Single
' Define angles of triangle vertices
a1 = angle
a2 = angle + 120
a3 = angle + 240
' Convert polar to Cartesian coordinates
x1 = cx + size * Cos(a1 * _Pi / 180)
y1 = cy + size * Sin(a1 * _Pi / 180)
x2 = cx + size * Cos(a2 * _Pi / 180)
y2 = cy + size * Sin(a2 * _Pi / 180)
x3 = cx + size * Cos(a3 * _Pi / 180)
y3 = cy + size * Sin(a3 * _Pi / 180)
' Draw triangle
Line (x1, y1)-(x2, y2), _RGB32(255, 255, 255)
Line (x2, y2)-(x3, y3), _RGB32(255, 255, 255)
Line (x3, y3)-(x1, y1), _RGB32(255, 255, 255)
'Draw Gun
gx = x1 + Cos(angle * _Pi / 180) * 5
gy = y1 + Sin(angle * _Pi / 180) * 5
Line (x1, y1)-(gx, gy), _RGB32(255, 255, 255)
End Sub
Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
02-02-2025, 11:53 AM
(This post was last modified: 02-02-2025, 11:55 AM by TempodiBasic.
Edit Reason: wrong typing
)
I like it but where do you leave the mouse?
Posts: 2
Threads: 0
Joined: Oct 2023
Reputation:
1
Someone on the Discord forum suggested I share this ChatGPT o3-generated Asteroids clone on this thread. Arrow keys to move, space to fire, B to halt ship.
Code: (Select All)
'--------------------------------------------
' Asteroids Clone in QB64 Phoenix Edition
'--------------------------------------------
' === CONSTANTS AND GLOBAL DECLARATIONS ===
CONST SCREENSIZEX = 352 ' 352 pixels wide
CONST SCREENSIZEY = 256 ' 256 pixels tall
CONST MAX_SPEED = 5 ' Maximum speed for the spaceship
COMMON SHARED viewSizeX, viewSizeY
' --- Game Settings ---
CONST MAX_ASTEROIDS = 5 ' Number of asteroids
' --- Asteroid Variables (arrays are global and sized on declaration) ---
DIM SHARED astX(1 TO MAX_ASTEROIDS), astY(1 TO MAX_ASTEROIDS)
DIM SHARED astDX(1 TO MAX_ASTEROIDS), astDY(1 TO MAX_ASTEROIDS)
' --- Spaceship Variables ---
COMMON SHARED shipX, shipY ' Position of the spaceship
COMMON SHARED shipAngle ' Facing direction (in degrees)
COMMON SHARED shipSpeed ' Current speed
' --- Bullet Variables ---
COMMON SHARED bulletActive ' 0 = no bullet active, 1 = bullet is active
COMMON SHARED bulletX, bulletY ' Bullet position
COMMON SHARED bulletDX, bulletDY ' Bullet velocity
'============================================
' SET UP SCREEN AND INITIAL GAME VARIABLES
'============================================
'_FULLSCREEN
SCREEN _NEWIMAGE(SCREENSIZEX, SCREENSIZEY, 13) ' Third argument MUST be 13
_FONT 8 ' Ensures the font is 8x8 (QB64-specific)
' Set play area (for example, if you want to use ASCII coordinate notions)
viewSizeX = 32
viewSizeY = 24
' Initialize spaceship in the center of the screen.
shipX = SCREENSIZEX / 2
shipY = SCREENSIZEY / 2
shipAngle = 0 ' Facing right (0 degrees)
shipSpeed = 0
' Bullet is initially inactive.
bulletActive = 0
' Randomize and initialize asteroid positions and velocities.
RANDOMIZE TIMER
FOR ii = 1 TO MAX_ASTEROIDS
astX(ii) = RND * SCREENSIZEX
astY(ii) = RND * SCREENSIZEY
' Give each asteroid a random velocity between -1 and 1 (pixels per frame)
astDX(ii) = (RND * 2 - 1)
astDY(ii) = (RND * 2 - 1)
NEXT ii
'============================================
' MAIN GAME LOOP
'============================================
DO
' --- Handle Input ---
' Rotate spaceship left: key 4 (keycode 52 or alternate 19200)
IF _KEYDOWN(52) OR _KEYDOWN(19200) THEN
shipAngle = shipAngle - 5
END IF
' Rotate spaceship right: key 6 (keycode 54 or alternate 19712)
IF _KEYDOWN(54) OR _KEYDOWN(19712) THEN
shipAngle = shipAngle + 5
END IF
' Accelerate forward: use key 8 (keycode 56 or alternate 18432) as “up”
IF _KEYDOWN(56) OR _KEYDOWN(18432) THEN
shipSpeed = shipSpeed + 0.1
END IF
' Decelerate / Brake: use key 2 (keycode 50 or alternate 20480) as “down”
IF _KEYDOWN(50) OR _KEYDOWN(20480) THEN
shipSpeed = shipSpeed - 0.1
IF shipSpeed < 0 THEN shipSpeed = 0
END IF
' Halt momentum: B key (keycode 66 or alternate 98) sets speed to 0.
IF _KEYDOWN(66) OR _KEYDOWN(98) THEN
shipSpeed = 0
END IF
' Enforce maximum speed limit.
IF shipSpeed > MAX_SPEED THEN shipSpeed = MAX_SPEED
' Fire Bullet: space bar (keycode 32)
IF _KEYDOWN(32) THEN
IF bulletActive = 0 THEN
bulletActive = 1
bulletX = shipX
bulletY = shipY
' Set bullet velocity in the direction the ship is facing.
bulletDX = COS(shipAngle * 3.14159 / 180) * 4
bulletDY = SIN(shipAngle * 3.14159 / 180) * 4
END IF
END IF
' --- Update Game Objects ---
' Update spaceship position (using its current speed and angle)
shipX = shipX + COS(shipAngle * 3.14159 / 180) * shipSpeed
shipY = shipY + SIN(shipAngle * 3.14159 / 180) * shipSpeed
' Screen wrapping for spaceship:
IF shipX < 0 THEN shipX = SCREENSIZEX
IF shipX > SCREENSIZEX THEN shipX = 0
IF shipY < 0 THEN shipY = SCREENSIZEY
IF shipY > SCREENSIZEY THEN shipY = 0
' Update bullet if active:
IF bulletActive = 1 THEN
bulletX = bulletX + bulletDX
bulletY = bulletY + bulletDY
' If bullet goes off screen, deactivate it.
IF bulletX < 0 OR bulletX > SCREENSIZEX OR bulletY < 0 OR bulletY > SCREENSIZEY THEN
bulletActive = 0
END IF
END IF
' Update asteroids:
FOR ii = 1 TO MAX_ASTEROIDS
astX(ii) = astX(ii) + astDX(ii)
astY(ii) = astY(ii) + astDY(ii)
' Wrap asteroids around the screen.
IF astX(ii) < 0 THEN astX(ii) = SCREENSIZEX
IF astX(ii) > SCREENSIZEX THEN astX(ii) = 0
IF astY(ii) < 0 THEN astY(ii) = SCREENSIZEY
IF astY(ii) > SCREENSIZEY THEN astY(ii) = 0
NEXT ii
' --- Collision Detection ---
' Check collisions between bullet and asteroids.
IF bulletActive = 1 THEN
FOR ii = 1 TO MAX_ASTEROIDS
' Using 2 as bullet radius and 12 as asteroid radius.
IF isCollision(bulletX, bulletY, 2, astX(ii), astY(ii), 12) THEN
' On collision, reset the asteroid and deactivate the bullet.
astX(ii) = RND * SCREENSIZEX
astY(ii) = RND * SCREENSIZEY
bulletActive = 0
EXIT FOR
END IF
NEXT ii
END IF
' Check collisions between spaceship and asteroids.
' Here, we use an approximate collision radius of 10 for the spaceship.
FOR ii = 1 TO MAX_ASTEROIDS
IF isCollision(shipX, shipY, 10, astX(ii), astY(ii), 12) THEN
CALL ESCAPETEXT("GAME OVER")
END IF
NEXT ii
' --- Draw Everything ---
CLS ' Clear the screen
' Draw the spaceship as a triangle.
' Calculate the three vertices based on shipX, shipY and shipAngle.
shipTipX = shipX + COS(shipAngle * 3.14159 / 180) * 10
shipTipY = shipY + SIN(shipAngle * 3.14159 / 180) * 10
shipLeftX = shipX + COS((shipAngle + 140) * 3.14159 / 180) * 8
shipLeftY = shipY + SIN((shipAngle + 140) * 3.14159 / 180) * 8
shipRightX = shipX + COS((shipAngle - 140) * 3.14159 / 180) * 8
shipRightY = shipY + SIN((shipAngle - 140) * 3.14159 / 180) * 8
LINE (shipLeftX, shipLeftY)-(shipTipX, shipTipY), 15
LINE (shipTipX, shipTipY)-(shipRightX, shipRightY), 15
LINE (shipRightX, shipRightY)-(shipLeftX, shipLeftY), 15
' Draw bullet if it is active.
IF bulletActive = 1 THEN
CIRCLE (bulletX, bulletY), 2, 15
END IF
' Draw each asteroid as a circle.
FOR ii = 1 TO MAX_ASTEROIDS
CIRCLE (astX(ii), astY(ii)), 12, 15
NEXT ii
_DISPLAY ' Refresh the graphics screen
' --- Exit Check ---
IF _KEYDOWN(27) THEN CALL ESCAPE(0) ' Exit if ESC is pressed
_LIMIT 30 ' Limit frame rate to 30 FPS
LOOP
'============================================
' COLLISION DETECTION FUNCTION
'============================================
FUNCTION isCollision (obj1X, obj1Y, r1, obj2X, obj2Y, r2)
DIM dx, dy, distanceSquared, rSumSquared
dx = obj1X - obj2X
dy = obj1Y - obj2Y
distanceSquared = dx * dx + dy * dy
rSumSquared = (r1 + r2) * (r1 + r2)
IF distanceSquared <= rSumSquared THEN
isCollision = 1
ELSE
isCollision = 0
END IF
END FUNCTION
'============================================
' EXAMPLE FUNCTION (for reference)
'============================================
FUNCTION moveCheck (wPosX, wPosY)
' A dummy function to illustrate function returns.
moveCheck = 1
END FUNCTION
'============================================
' HELPER SUBROUTINES (NEVER MODIFY THESE)
'============================================
SUB ZLOCATE (wx, wy)
' Adjusts LOCATE since QB64’s LOCATE starts at row 1.
LOCATE wy + 1, wx + 1
END SUB
SUB ESCAPE (code)
' Display an exit message with the given code and end the program.
COLOR 15
ZLOCATE 10, 5: PRINT " "
ZLOCATE 10, 6: PRINT "ENDED WITH CODE:"; code; " "
ZLOCATE 10, 7: PRINT " "
END
END SUB
SUB ESCAPETEXT (wStr$)
' Display an exit message (for example, GAME OVER) and end the program.
COLOR 15
xPos = 1
yPos = 5
IF wStr$ = "" THEN wStr$ = "No text sent"
ZLOCATE xPos, yPos: PRINT " "
ZLOCATE xPos, yPos + 2: PRINT " " ' Clear line before text in case of wrap
ZLOCATE xPos, yPos + 1: PRINT " "; wStr$; " "
END
END SUB
Posts: 4,692
Threads: 222
Joined: Apr 2022
Reputation:
322
02-02-2025, 04:49 PM
(This post was last modified: 02-02-2025, 04:52 PM by bplus.)
Nice, more natural navigation and better shooting in less LOC 
Welcome to the forum @Deciheximal
Oh hey did that work right out-of-the-box from the AI or did you have to fix a few things?
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
Posts: 522
Threads: 55
Joined: Jul 2022
Reputation:
48
02-02-2025, 04:53 PM
(This post was last modified: 02-02-2025, 07:30 PM by TempodiBasic.
Edit Reason: answer to the question made
)
@Deciheximal
fine code, I can affirm that chatGPT is better coder than me.
QB64pe IDE found 2 unused variables, wposX and wposY.
Interesting the Helper suborutines set and the MoveCheck example function.
ChatGPT prefers the Pitagora's theorem for collision detecting.
Just a human dubt... is it possible packing all the action done into the many FOR loops into just one FOR loop?
yes it seems to be possible
here my confusional mod that packes all FOR loop of asteroids to one loop
Code: (Select All)
'--------------------------------------------
' Asteroids Clone in QB64 Phoenix Edition
'--------------------------------------------
' === CONSTANTS AND GLOBAL DECLARATIONS ===
Const SCREENSIZEX = 352 ' 352 pixels wide
Const SCREENSIZEY = 256 ' 256 pixels tall
Const MAX_SPEED = 5 ' Maximum speed for the spaceship
Common Shared viewSizeX, viewSizeY
' --- Game Settings ---
Const MAX_ASTEROIDS = 5 ' Number of asteroids
' --- Asteroid Variables (arrays are global and sized on declaration) ---
Dim Shared astX(1 To MAX_ASTEROIDS), astY(1 To MAX_ASTEROIDS)
Dim Shared astDX(1 To MAX_ASTEROIDS), astDY(1 To MAX_ASTEROIDS)
' --- Spaceship Variables ---
Common Shared shipX, shipY ' Position of the spaceship
Common Shared shipAngle ' Facing direction (in degrees)
Common Shared shipSpeed ' Current speed
' --- Bullet Variables ---
Common Shared bulletActive ' 0 = no bullet active, 1 = bullet is active
Common Shared bulletX, bulletY ' Bullet position
Common Shared bulletDX, bulletDY ' Bullet velocity
'============================================
' SET UP SCREEN AND INITIAL GAME VARIABLES
'============================================
'_FULLSCREEN
Screen _NewImage(SCREENSIZEX, SCREENSIZEY, 13) ' Third argument MUST be 13
_Font 8 ' Ensures the font is 8x8 (QB64-specific)
' Set play area (for example, if you want to use ASCII coordinate notions)
viewSizeX = 32
viewSizeY = 24
' Initialize spaceship in the center of the screen.
shipX = SCREENSIZEX / 2
shipY = SCREENSIZEY / 2
shipAngle = 0 ' Facing right (0 degrees)
shipSpeed = 0
' Bullet is initially inactive.
bulletActive = 0
' Randomize and initialize asteroid positions and velocities.
Randomize Timer
For ii = 1 To MAX_ASTEROIDS
astX(ii) = Rnd * SCREENSIZEX
astY(ii) = Rnd * SCREENSIZEY
' Give each asteroid a random velocity between -1 and 1 (pixels per frame)
astDX(ii) = (Rnd * 2 - 1)
astDY(ii) = (Rnd * 2 - 1)
Next ii
'============================================
' MAIN GAME LOOP
'============================================
Do
' --- Handle Input ---
' Rotate spaceship left: key 4 (keycode 52 or alternate 19200)
If _KeyDown(52) Or _KeyDown(19200) Then
shipAngle = shipAngle - 5
End If
' Rotate spaceship right: key 6 (keycode 54 or alternate 19712)
If _KeyDown(54) Or _KeyDown(19712) Then
shipAngle = shipAngle + 5
End If
' Accelerate forward: use key 8 (keycode 56 or alternate 18432) as “up”
If _KeyDown(56) Or _KeyDown(18432) Then
shipSpeed = shipSpeed + 0.1
End If
' Decelerate / Brake: use key 2 (keycode 50 or alternate 20480) as “down”
If _KeyDown(50) Or _KeyDown(20480) Then
shipSpeed = shipSpeed - 0.1
If shipSpeed < 0 Then shipSpeed = 0
End If
' Halt momentum: B key (keycode 66 or alternate 98) sets speed to 0.
If _KeyDown(66) Or _KeyDown(98) Then
shipSpeed = 0
End If
' Enforce maximum speed limit.
If shipSpeed > MAX_SPEED Then shipSpeed = MAX_SPEED
' Fire Bullet: space bar (keycode 32)
If _KeyDown(32) Then
If bulletActive = 0 Then
bulletActive = 1
bulletX = shipX
bulletY = shipY
' Set bullet velocity in the direction the ship is facing.
bulletDX = Cos(shipAngle * 3.14159 / 180) * 4
bulletDY = Sin(shipAngle * 3.14159 / 180) * 4
End If
End If
' --- Update Game Objects ---
' Update spaceship position (using its current speed and angle)
shipX = shipX + Cos(shipAngle * 3.14159 / 180) * shipSpeed
shipY = shipY + Sin(shipAngle * 3.14159 / 180) * shipSpeed
' Screen wrapping for spaceship:
If shipX < 0 Then shipX = SCREENSIZEX
If shipX > SCREENSIZEX Then shipX = 0
If shipY < 0 Then shipY = SCREENSIZEY
If shipY > SCREENSIZEY Then shipY = 0
' Update bullet if active:
If bulletActive = 1 Then
bulletX = bulletX + bulletDX
bulletY = bulletY + bulletDY
' If bullet goes off screen, deactivate it.
If bulletX < 0 Or bulletX > SCREENSIZEX Or bulletY < 0 Or bulletY > SCREENSIZEY Then
bulletActive = 0
End If
End If
Cls ' Clear the screen
' Update asteroids:
For ii = 1 To MAX_ASTEROIDS
astX(ii) = astX(ii) + astDX(ii)
astY(ii) = astY(ii) + astDY(ii)
' Wrap asteroids around the screen.
If astX(ii) < 0 Then astX(ii) = SCREENSIZEX
If astX(ii) > SCREENSIZEX Then astX(ii) = 0
If astY(ii) < 0 Then astY(ii) = SCREENSIZEY
If astY(ii) > SCREENSIZEY Then astY(ii) = 0
' Check collisions between bullet and asteroids.
If bulletActive = 1 Then
' Using 2 as bullet radius and 12 as asteroid radius.
If isCollision(bulletX, bulletY, 2, astX(ii), astY(ii), 12) Then
' On collision, reset the asteroid and deactivate the bullet.
astX(ii) = Rnd * SCREENSIZEX
astY(ii) = Rnd * SCREENSIZEY
bulletActive = 0
End If
End If
' Check collisions between spaceship and asteroids.
' Here, we use an approximate collision radius of 10 for the spaceship.
If isCollision(shipX, shipY, 10, astX(ii), astY(ii), 12) Then
Call ESCAPETEXT("GAME OVER")
End If
' Draw each asteroid as a circle.
Circle (astX(ii), astY(ii)), 12, 15
Next ii
' --- Collision Detection ---
' Check collisions between bullet and asteroids.
'If bulletActive = 1 Then
' For ii = 1 To MAX_ASTEROIDS
' ' Using 2 as bullet radius and 12 as asteroid radius.
' If isCollision(bulletX, bulletY, 2, astX(ii), astY(ii), 12) Then
' ' On collision, reset the asteroid and deactivate the bullet.
' astX(ii) = Rnd * SCREENSIZEX
' astY(ii) = Rnd * SCREENSIZEY
' bulletActive = 0
' Exit For
' End If
' Next ii
'End If
' Check collisions between spaceship and asteroids.
' Here, we use an approximate collision radius of 10 for the spaceship.
'For ii = 1 To MAX_ASTEROIDS
' If isCollision(shipX, shipY, 10, astX(ii), astY(ii), 12) Then
' Call ESCAPETEXT("GAME OVER")
' End If
'Next ii
' --- Draw Everything ---
'Cls ' Clear the screen
' Draw the spaceship as a triangle.
' Calculate the three vertices based on shipX, shipY and shipAngle.
shipTipX = shipX + Cos(shipAngle * 3.14159 / 180) * 10
shipTipY = shipY + Sin(shipAngle * 3.14159 / 180) * 10
shipLeftX = shipX + Cos((shipAngle + 140) * 3.14159 / 180) * 8
shipLeftY = shipY + Sin((shipAngle + 140) * 3.14159 / 180) * 8
shipRightX = shipX + Cos((shipAngle - 140) * 3.14159 / 180) * 8
shipRightY = shipY + Sin((shipAngle - 140) * 3.14159 / 180) * 8
Line (shipLeftX, shipLeftY)-(shipTipX, shipTipY), 15
Line (shipTipX, shipTipY)-(shipRightX, shipRightY), 15
Line (shipRightX, shipRightY)-(shipLeftX, shipLeftY), 15
' Draw bullet if it is active.
If bulletActive = 1 Then
Circle (bulletX, bulletY), 2, 15
End If
' Draw each asteroid as a circle.
'For ii = 1 To MAX_ASTEROIDS
' Circle (astX(ii), astY(ii)), 12, 15
'Next ii
_Display ' Refresh the graphics screen
' --- Exit Check ---
If _KeyDown(27) Then Call ESCAPE(0) ' Exit if ESC is pressed
_Limit 30 ' Limit frame rate to 30 FPS
Loop
'============================================
' COLLISION DETECTION FUNCTION
'============================================
Function isCollision (obj1X, obj1Y, r1, obj2X, obj2Y, r2)
Dim dx, dy, distanceSquared, rSumSquared
dx = obj1X - obj2X
dy = obj1Y - obj2Y
distanceSquared = dx * dx + dy * dy
rSumSquared = (r1 + r2) * (r1 + r2)
If distanceSquared <= rSumSquared Then
isCollision = 1
Else
isCollision = 0
End If
End Function
'============================================
' EXAMPLE FUNCTION (for reference)
'============================================
Function moveCheck (wPosX, wPosY)
' A dummy function to illustrate function returns.
moveCheck = 1
End Function
'============================================
' HELPER SUBROUTINES (NEVER MODIFY THESE)
'============================================
Sub ZLOCATE (wx, wy)
' Adjusts LOCATE since QB64’s LOCATE starts at row 1.
Locate wy + 1, wx + 1
End Sub
Sub ESCAPE (code)
' Display an exit message with the given code and end the program.
Color 15
ZLOCATE 10, 5: Print " "
ZLOCATE 10, 6: Print "ENDED WITH CODE:"; code; " "
ZLOCATE 10, 7: Print " "
End
End Sub
Sub ESCAPETEXT (wStr$)
' Display an exit message (for example, GAME OVER) and end the program.
Color 15
xPos = 1
yPos = 5
If wStr$ = "" Then wStr$ = "No text sent"
ZLOCATE xPos, yPos: Print " "
ZLOCATE xPos, yPos + 2: Print " " ' Clear line before text in case of wrap
ZLOCATE xPos, yPos + 1: Print " "; wStr$; " "
End
End Sub
it is just a curiosity and not a better code. But it still works.
The game sometimes starts with a GAME OVER. It is probable that sometimes the starship and an asteroid are born in the same place.
Posts: 101
Threads: 13
Joined: Jul 2024
Reputation:
15
Bro this is a very lovely game!
I made one a year ago, and added some AI after watching a youtube video: Asteroids with NEAT Genetic Algorithm
But implementing that was hard, so I scrapped that idea.
The rock design is pretty good actually!
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
02-02-2025, 08:40 PM
(This post was last modified: 02-02-2025, 09:08 PM by SierraKen.)
TempodiBasic, mine doesn't use a mouse, it uses the keyboard. Instructions are on the welcome screen.
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
Thank you Deciheximal!! Your game helped me improve mine greatly. Now the keys work every time as soon as you press them. Also, I took up what B+ said about natural flight, so I changed that too, and it's actually a much more fun game to play.
What do you guys think?
Code: (Select All)
'Asteroids Clone by, SierraKen
'February 2, 2025
'Thank you QB64pe Forum for your inspiration!
'Thank you also ChatGPT for a lot of the math.
'This game is not intended to replace any other game already in existence.
'It is a labor of love and given out for free.
'Update: Fixed speed of ship and better response to keys. Thank you Deciheximal for your game code!
_Title "Asteroids Clone - by SierraKen"
Screen _NewImage(800, 600, 32)
Randomize Timer
Dim oldx(100), oldy(100)
Dim llx(500), lly(500)
Dim lx(500), ly(500), ldir(500)
Dim x1 As Single, y1 As Single
Const numPoints = 30
Dim x2(100, 40), y2(100, 40)
Dim xRot(100, 40), yRot(100, 40)
Dim cx2(200), cy2(200), angle2(200)
Dim dx(100), dy(100)
Dim nox(500)
start:
numAsteroids = 8
radius2 = 45 'Asteroids
level = 1
score = 0
health = 50
healthp = 100
rot = -90
Cls
_AutoDisplay
Locate 3, 25: Print "A s t e r o i d s C l o n e"
Locate 5, 25: Print "By SierraKen"
Locate 10, 25: Print "Move your ship around with the arrow keys."
Locate 11, 25: Print "Turn your ship with the left and right arrow keys."
Locate 12, 25: Print "Go forward with the up arrow key."
Locate 12, 25: Print "Press Space Bar to fire at asteroids."
Locate 13, 25: Print "To pause and un-pause, press Esc."
Locate 14, 25: Print "Press Q anytime to quit."
Locate 20, 25: Input "Press Enter to Begin.", a$
start2:
Cls
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
numAsteroids = numAsteroids + 2
If numAsteroids > 40 Then numAsteroids = 40
num = numAsteroids
rock = 0
hits = 0
speed2 = 0
laser = 0
ll = 0
numpoints2 = Int(Rnd * numPoints) + 10
For ll3 = 1 To 200
lx(ll3) = 0
ly(ll3) = 0
ldir(ll3) = 0
Next ll3
sx = 400
sy = 300
oldx = 400
oldy = 300
det = 0
r1 = 3 'bullets
r3 = 25 'Your ship
loops = 0
Play "MB"
' Initialize asteroids
For a = 0 To num - 1
more:
cx2(a) = Int(Rnd * 680) + 55 ' Random start X
cy2(a) = Int(Rnd * 480) + 55 ' Random start Y
If cx2(a) > 250 And cx2(a) < 550 And cy2(a) > 150 And cy2(a) < 450 Then GoTo more:
angle2(a) = Rnd * 360 ' Random starting rotation
dx(a) = (Rnd - 0.5) * 2 ' Random speed X (-1 to 1)
dy(a) = (Rnd - 0.5) * 2 ' Random speed Y (-1 to 1)
' Generate random asteroid shape
For i = 0 To numpoints2
ang = i * (360 / numpoints2)
rOffset = radius2 + Int(Rnd * 15 - 7) ' Vary radius randomly
x2(a, i) = Cos(ang * _Pi / 180) * rOffset
y2(a, i) = Sin(ang * _Pi / 180) * rOffset
Next
rock = rock + 1
Next
Do
_Limit 100
If _KeyDown(32) Then
laser = 1
ll = ll + 1
If ll > 500 Then ll = 1
lx(ll) = x1
ly(ll) = y1
ldir(ll) = angle
End If
If _KeyDown(52) Or _KeyDown(19200) Then dir1 = 1 ' Left Arrow (rotate counterclockwise)
If _KeyDown(54) Or _KeyDown(19712) Then dir1 = 2 ' Right Arrow (rotate clockwise)
If _KeyDown(56) Or _KeyDown(18432) Then dir2 = 3 ' Up Arrow (thrust forward)
If _KeyDown(50) Or _KeyDown(20480) Then dir2 = 4 ' Down Arrow (thrust backward)
If dir1 = 1 Then
angle = angle - 1
If right = 1 Then
right = 0
dir1 = 0
GoTo nex2
End If
left = 1
right = 0
End If
If dir1 = 2 Then
angle = angle + 1
If left = 1 Then
left = 0
dir1 = 0
GoTo nex2
End If
right = 1
left = 0
End If
If dir2 = 3 Then
speed2 = speed2 + .01
If speed2 > 2 Then speed2 = 2
sx = sx + speed2 * Cos(angle * _Pi / 180)
sy = sy + speed2 * Sin(angle * _Pi / 180)
End If
If dir2 = 4 Then
speed2 = speed2 - .01
If speed2 < 0 Then speed2 = 0
sx = sx + speed2 * Cos(angle * _Pi / 180)
sy = sy + speed2 * Sin(angle * _Pi / 180)
End If
nex2:
If sx > 800 Then sx = 0
If sx < 0 Then sx = 800
If sy > 600 Then sy = 0
If sy < 0 Then sy = 600
If _KeyHit = 27 Then
Do
If _KeyHit = 27 Then GoTo go
Loop
End If
go:
k$ = ""
If _KeyDown(81) Or _KeyDown(113) Then End
' Update and draw each asteroid
For a = 0 To num - 1
If nox(a) = 1 Then GoTo skip
angle2(a) = angle2(a) + 1 ' Rotate
If angle2(a) >= 360 Then angle2(a) = 0
' Rotate asteroid points
rad = angle2(a) * _Pi / 180
For i = 0 To numpoints2
xRot(a, i) = cx2(a) + (x2(a, i) * Cos(rad) - y2(a, i) * Sin(rad))
yRot(a, i) = cy2(a) + (x2(a, i) * Sin(rad) + y2(a, i) * Cos(rad))
Next
' Draw asteroid
For i = 0 To numpoints2 - 1
j = (i + 1) Mod numpoints2
Line (xRot(a, i), yRot(a, i))-(xRot(a, j), yRot(a, j)), _RGB32(255, 255, 255)
Next
' Move asteroid
cx2(a) = cx2(a) + dx(a)
cy2(a) = cy2(a) + dy(a)
' Wrap around screen edges
If cx2(a) < 0 Then cx2(a) = 800
If cx2(a) > 800 Then cx2(a) = 0
If cy2(a) < 0 Then cy2(a) = 600
If cy2(a) > 600 Then cy2(a) = 0
Next
skip:
If laser = 1 Then
For lz = 0 To ll - 1 Step 10
lx2 = Cos(ldir(lz) * _Pi / 180) * 10
ly2 = Sin(ldir(lz) * _Pi / 180) * 10
lx(lz) = lx2 + lx(lz)
ly(lz) = ly2 + ly(lz)
If lx(lz) > 850 Then lx(lz) = 850
If lx(lz) < -50 Then lx(lz) = -50
If ly(lz) > 650 Then ly(lz) = 650
If ly(lz) < -50 Then ly(lz) = -50
fillCircle lx(lz), ly(lz), r1, _RGB32(255, 0, 5)
For chk = 0 To num - 1
distance = Sqr((lx(lz) - cx2(chk)) ^ 2 + (ly(lz) - cy2(chk)) ^ 2)
If distance <= r1 + radius2 Then
DetectCollision = -1 ' True (collision detected)
Else
DetectCollision = 0 ' False (no collision)
End If
If DetectCollision = -1 And nox(chk) <> 1 Then
For explosion = 1 To 50
Circle (lx(lz), ly(lz)), explosion, _RGB32(255, 0, 0)
llx(explosion) = lx(lz)
lly(explosion) = ly(lz)
Next explosion
'SOUND frequency!, duration![, volume!][, panPosition!][, waveform&][, waveformParameters!][, voice&]]
Sound 800, .4, , , 5
Sound 200, .75, , , 6
Sound 100, .75, , , 7
nox(rock) = 1
rock = rock - 1
num = num - 1
cx2(chk) = -500: cy2(chk) = 1200
lx(lz) = -150: ly(lz) = -150: ldir(lz) = 0
score = score + 10
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
hits = hits + 1
laser = 0
End If
Next chk
'Detect Level Change
If hits > numAsteroids - 1 Then
Cls
level = level + 1
For n = 1 To 200
nox(n) = 0
Next n
For n = 0 To 100
cx2(n) = -400: cy2(n) = -400
dx(n) = 0: dy(n) = 0
angle2(n) = 0
Next n
GoTo start2
End If
Next lz
End If
'Draw ship,
DrawTriangle sx, sy, 20, angle, x1, y1
For chk = 0 To num - 1
distance = Sqr((sx - cx2(chk)) ^ 2 + (sy - cy2(chk)) ^ 2)
If distance <= r3 + radius2 Then
DetectCollision = -1 ' True (collision detected)
Else
DetectCollision = 0 ' False (no collision)
End If
If DetectCollision = -1 And nox(chk) <> 1 Then
det = 1
health = health - .2
healthp = Int((health / 50) * 100)
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
If health < .01 Then
health = 0
healthp = 0
For explosion = 1 To 200
Circle (sx, sy + 25), explosion, _RGB32(255, 0, 0)
Next explosion
For nn = 1 To 200
nox(nn) = 0
Next nn
Sound 500, 4, , , 8
Sound 500, 8, , , 5
Sound 100, 4, , , 7
Locate 20, 30: Print "G A M E O V E R"
Locate 25, 30: Input "Again (Y/N)"; ag$
ag2$ = LTrim$(RTrim$(ag$))
If Left$(ag2$, 1) = "y" Or Left$(ag2$, 1) = "Y" Then GoTo start
End
End If
End If
Next chk
skip3:
If det > 0 Then
det = det + 1
Paint (sx, sy), _RGB32(255, 0, 0), _RGB32(255, 255, 255)
If det > 200 Then det = 0
End If
If loops < 1000 Then
loops = loops + 1
End If
_Display
Cls
Loop
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub DrawTriangle (cx As Integer, cy As Integer, size As Integer, angle As Single, x1, y1)
Dim x2 As Single, y2 As Single
Dim x3 As Single, y3 As Single
Dim a1 As Single, a2 As Single, a3 As Single
' Define angles of triangle vertices
a1 = angle
a2 = angle + 120
a3 = angle + 240
' Convert polar to Cartesian coordinates
x1 = cx + size * Cos(a1 * _Pi / 180)
y1 = cy + size * Sin(a1 * _Pi / 180)
x2 = cx + size * Cos(a2 * _Pi / 180)
y2 = cy + size * Sin(a2 * _Pi / 180)
x3 = cx + size * Cos(a3 * _Pi / 180)
y3 = cy + size * Sin(a3 * _Pi / 180)
' Draw triangle
Line (x1, y1)-(x2, y2), _RGB32(255, 255, 255)
Line (x2, y2)-(x3, y3), _RGB32(255, 255, 255)
Line (x3, y3)-(x1, y1), _RGB32(255, 255, 255)
'Draw Gun
gx = x1 + Cos(angle * _Pi / 180) * 5
gy = y1 + Sin(angle * _Pi / 180) * 5
Line (x1, y1)-(gx, gy), _RGB32(255, 255, 255)
End Sub
Posts: 3,446
Threads: 376
Joined: Apr 2022
Reputation:
345
I played around with this and again added joystick support to the game. (Eventually, some dang body is going to notice and comment on whether or not a joystick works for them! LOL!!)
Code: (Select All)
'Asteroids Clone by, SierraKen
'February 2, 2025
'Thank you QB64pe Forum for your inspiration!
'Thank you also ChatGPT for a lot of the math.
'This game is not intended to replace any other game already in existence.
'It is a labor of love and given out for free.
'Update: Fixed speed of ship and better response to keys. Thank you Deciheximal for your game code!
'*** FROM: https://qb64phoenix.com/forum/showthread.php?tid=3424
'*** Joystick Support by Steve!
Type Axis_Type
Active As _Byte
X As Integer
Y As Integer
Vert As Single
Hort As Single
Angle As Single
End Type
ReDim Shared As Axis_Type JoyStick(0)
ReDim Shared As Long Button(0)
'*** END Top of JoyStick Support
_Title "Asteroids Clone - by SierraKen"
Screen _NewImage(800, 600, 32)
Randomize Timer
Dim oldx(100), oldy(100)
Dim llx(500), lly(500)
Dim lx(500), ly(500), ldir(500)
Dim x1 As Single, y1 As Single
Const numPoints = 30
Dim x2(100, 40), y2(100, 40)
Dim xRot(100, 40), yRot(100, 40)
Dim cx2(200), cy2(200), angle2(200)
Dim dx(100), dy(100)
Dim nox(500)
start:
numAsteroids = 8
radius2 = 45 'Asteroids
level = 1
score = 0
health = 50
healthp = 100
rot = -90
Cls
_AutoDisplay
Locate 3, 25: Print "A s t e r o i d s C l o n e"
Locate 5, 25: Print "By SierraKen"
Locate 10, 25: Print "Move your ship around with the arrow keys."
Locate 11, 25: Print "Turn your ship with the left and right arrow keys."
Locate 12, 25: Print "Go forward with the up arrow key."
Locate 12, 25: Print "Press Space Bar to fire at asteroids."
Locate 13, 25: Print "To pause and un-pause, press Esc."
Locate 14, 25: Print "Press Q anytime to quit."
Locate 20, 25: Print "Press Enter or press <Button 1> to Begin."
Do
ReadJoyStick
_Limit 15
Loop Until Button(1) Or _KeyDown(13)
_Delay .2
_KeyClear
start2:
Cls
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
numAsteroids = numAsteroids + 2
If numAsteroids > 40 Then numAsteroids = 40
num = numAsteroids
rock = 0
hits = 0
speed2 = 0
laser = 0
ll = 0
numpoints2 = Int(Rnd * numPoints) + 10
For ll3 = 1 To 200
lx(ll3) = 0
ly(ll3) = 0
ldir(ll3) = 0
Next ll3
sx = 400
sy = 300
oldx = 400
oldy = 300
det = 0
r1 = 3 'bullets
r3 = 25 'Your ship
loops = 0
Play "MB"
' Initialize asteroids
For a = 0 To num - 1
more:
cx2(a) = Int(Rnd * 680) + 55 ' Random start X
cy2(a) = Int(Rnd * 480) + 55 ' Random start Y
If cx2(a) > 250 And cx2(a) < 550 And cy2(a) > 150 And cy2(a) < 450 Then GoTo more:
angle2(a) = Rnd * 360 ' Random starting rotation
dx(a) = (Rnd - 0.5) * 2 ' Random speed X (-1 to 1)
dy(a) = (Rnd - 0.5) * 2 ' Random speed Y (-1 to 1)
' Generate random asteroid shape
For i = 0 To numpoints2
ang = i * (360 / numpoints2)
rOffset = radius2 + Int(Rnd * 15 - 7) ' Vary radius randomly
x2(a, i) = Cos(ang * _Pi / 180) * rOffset
y2(a, i) = Sin(ang * _Pi / 180) * rOffset
Next
rock = rock + 1
Next
Do
_Limit 100
'*** JOYSTICK SUPPORT BY STEVE!! ***
ReadJoyStick
joybutton = _FALSE
joyleft = _FALSE: joyright = _FALSE
joyup = _FALSE: joydown = _FALSE
If Button(1) Then joybutton = _TRUE
For i = 1 To UBound(JoyStick) 'this checks for each axis of our joystick
If JoyStick(i).Active Then 'check to see if any of the joysticks are active
If JoyStick(i).X < 0 Then joyleft = _TRUE
If JoyStick(i).X > 0 Then joyright = _TRUE
If JoyStick(i).Y < 0 Then joyup = _TRUE
If JoyStick(i).Y > 0 Then joydown = _TRUE
End If
Next
If _KeyDown(32) _Orelse joybutton Then
laser = 1
ll = ll + 1
If ll > 500 Then ll = 1
lx(ll) = x1
ly(ll) = y1
ldir(ll) = angle
End If
If _KeyDown(52) Or _KeyDown(19200) _Orelse joyleft Then dir1 = 1 ' Left Arrow (rotate counterclockwise)
If _KeyDown(54) Or _KeyDown(19712) _Orelse joyright Then dir1 = 2 ' Right Arrow (rotate clockwise)
If _KeyDown(56) Or _KeyDown(18432) _Orelse joyup Then dir2 = 3 ' Up Arrow (thrust forward)
If _KeyDown(50) Or _KeyDown(20480) _Orelse joydown Then dir2 = 4 ' Down Arrow (thrust backward)
If dir1 = 1 Then
angle = angle - 1
If right = 1 Then
right = 0
dir1 = 0
GoTo nex2
End If
left = 1
right = 0
End If
If dir1 = 2 Then
angle = angle + 1
If left = 1 Then
left = 0
dir1 = 0
GoTo nex2
End If
right = 1
left = 0
End If
If dir2 = 3 Then
speed2 = speed2 + .01
If speed2 > 2 Then speed2 = 2
sx = sx + speed2 * Cos(angle * _Pi / 180)
sy = sy + speed2 * Sin(angle * _Pi / 180)
End If
If dir2 = 4 Then
speed2 = speed2 - .01
If speed2 < 0 Then speed2 = 0
sx = sx + speed2 * Cos(angle * _Pi / 180)
sy = sy + speed2 * Sin(angle * _Pi / 180)
End If
nex2:
If sx > 800 Then sx = 0
If sx < 0 Then sx = 800
If sy > 600 Then sy = 0
If sy < 0 Then sy = 600
If _KeyHit = 27 Or (Button(2) And Not oldbutton2.1) Then 'give time for button 2 to release
oldbutton2 = _TRUE
oldbutton2.1 = _TRUE
Do
ReadJoyStick
If _KeyHit = 27 Or (Button(2) And Not oldbutton2) GoTo go
oldbutton2 = Button(2)
_Limit 15
Loop
End If
oldbutton2.1 = Button(2) 'the
go:
k$ = ""
If _KeyDown(81) Or _KeyDown(113) Then End
' Update and draw each asteroid
For a = 0 To num - 1
If nox(a) = 1 Then GoTo skip
angle2(a) = angle2(a) + 1 ' Rotate
If angle2(a) >= 360 Then angle2(a) = 0
' Rotate asteroid points
rad = angle2(a) * _Pi / 180
For i = 0 To numpoints2
xRot(a, i) = cx2(a) + (x2(a, i) * Cos(rad) - y2(a, i) * Sin(rad))
yRot(a, i) = cy2(a) + (x2(a, i) * Sin(rad) + y2(a, i) * Cos(rad))
Next
' Draw asteroid
For i = 0 To numpoints2 - 1
j = (i + 1) Mod numpoints2
Line (xRot(a, i), yRot(a, i))-(xRot(a, j), yRot(a, j)), _RGB32(255, 255, 255)
Next
' Move asteroid
cx2(a) = cx2(a) + dx(a)
cy2(a) = cy2(a) + dy(a)
' Wrap around screen edges
If cx2(a) < 0 Then cx2(a) = 800
If cx2(a) > 800 Then cx2(a) = 0
If cy2(a) < 0 Then cy2(a) = 600
If cy2(a) > 600 Then cy2(a) = 0
Next
skip:
If laser = 1 Then
For lz = 0 To ll - 1 Step 10
lx2 = Cos(ldir(lz) * _Pi / 180) * 10
ly2 = Sin(ldir(lz) * _Pi / 180) * 10
lx(lz) = lx2 + lx(lz)
ly(lz) = ly2 + ly(lz)
If lx(lz) > 850 Then lx(lz) = 850
If lx(lz) < -50 Then lx(lz) = -50
If ly(lz) > 650 Then ly(lz) = 650
If ly(lz) < -50 Then ly(lz) = -50
fillCircle lx(lz), ly(lz), r1, _RGB32(255, 0, 5)
For chk = 0 To num - 1
distance = Sqr((lx(lz) - cx2(chk)) ^ 2 + (ly(lz) - cy2(chk)) ^ 2)
If distance <= r1 + radius2 Then
DetectCollision = -1 ' True (collision detected)
Else
DetectCollision = 0 ' False (no collision)
End If
If DetectCollision = -1 And nox(chk) <> 1 Then
For explosion = 1 To 50
Circle (lx(lz), ly(lz)), explosion, _RGB32(255, 0, 0)
llx(explosion) = lx(lz)
lly(explosion) = ly(lz)
Next explosion
'SOUND frequency!, duration![, volume!][, panPosition!][, waveform&][, waveformParameters!][, voice&]]
Sound 800, .4, , , 5
Sound 200, .75, , , 6
Sound 100, .75, , , 7
nox(rock) = 1
rock = rock - 1
num = num - 1
cx2(chk) = -500: cy2(chk) = 1200
lx(lz) = -150: ly(lz) = -150: ldir(lz) = 0
score = score + 10
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
hits = hits + 1
laser = 0
End If
Next chk
'Detect Level Change
If hits > numAsteroids - 1 Then
Cls
level = level + 1
For n = 1 To 200
nox(n) = 0
Next n
For n = 0 To 100
cx2(n) = -400: cy2(n) = -400
dx(n) = 0: dy(n) = 0
angle2(n) = 0
Next n
GoTo start2
End If
Next lz
End If
'Draw ship,
DrawTriangle sx, sy, 20, angle, x1, y1
For chk = 0 To num - 1
distance = Sqr((sx - cx2(chk)) ^ 2 + (sy - cy2(chk)) ^ 2)
If distance <= r3 + radius2 Then
DetectCollision = -1 ' True (collision detected)
Else
DetectCollision = 0 ' False (no collision)
End If
If DetectCollision = -1 And nox(chk) <> 1 Then
det = 1
health = health - .2
healthp = Int((health / 50) * 100)
_Title "Score: " + Str$(score) + " Health: " + Str$(healthp) + "% Level: " + Str$(level)
If health < .01 Then
health = 0
healthp = 0
For explosion = 1 To 200
Circle (sx, sy + 25), explosion, _RGB32(255, 0, 0)
Next explosion
For nn = 1 To 200
nox(nn) = 0
Next nn
Sound 500, 4, , , 8
Sound 500, 8, , , 5
Sound 100, 4, , , 7
Locate 20, 30: Print "G A M E O V E R"
Locate 25, 30: Input "Again (Y/N)"; ag$
ag2$ = LTrim$(RTrim$(ag$))
oldbutton = _TRUE
oldbutton2 = _TRUE
Do
ReadJoyStick
If Button(1) And Not oldbutton GoTo start 'make certain button is up before accepting it as a down click
If Button(2) And Not oldbutton2 Then System 'quit with the 2nd button
oldbutton = Button(1): oldbutton2 = Button(2)
k = _KeyHit
Select Case Chr$(k)
Case "Y", "y": GoTo start
Case "N", "n": System
End Select
_Limit 15
Loop
End If
End If
Next chk
skip3:
If det > 0 Then
det = det + 1
Paint (sx, sy), _RGB32(255, 0, 0), _RGB32(255, 255, 255)
If det > 200 Then det = 0
End If
If loops < 1000 Then
loops = loops + 1
End If
_Display
Cls
Loop
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub DrawTriangle (cx As Integer, cy As Integer, size As Integer, angle As Single, x1, y1)
Dim x2 As Single, y2 As Single
Dim x3 As Single, y3 As Single
Dim a1 As Single, a2 As Single, a3 As Single
' Define angles of triangle vertices
a1 = angle
a2 = angle + 120
a3 = angle + 240
' Convert polar to Cartesian coordinates
x1 = cx + size * Cos(a1 * _Pi / 180)
y1 = cy + size * Sin(a1 * _Pi / 180)
x2 = cx + size * Cos(a2 * _Pi / 180)
y2 = cy + size * Sin(a2 * _Pi / 180)
x3 = cx + size * Cos(a3 * _Pi / 180)
y3 = cy + size * Sin(a3 * _Pi / 180)
' Draw triangle
Line (x1, y1)-(x2, y2), _RGB32(255, 255, 255)
Line (x2, y2)-(x3, y3), _RGB32(255, 255, 255)
Line (x3, y3)-(x1, y1), _RGB32(255, 255, 255)
'Draw Gun
gx = x1 + Cos(angle * _Pi / 180) * 5
gy = y1 + Sin(angle * _Pi / 180) * 5
Line (x1, y1)-(gx, gy), _RGB32(255, 255, 255)
End Sub
'This sub needs to go at the end of your code, or in a BM file
Sub ReadJoyStick
Static As Long d, LA, LB 'Last Axis, Last Button
If d = 0 Then d = _Devices
If d < 3 Then Exit Sub '3 is joystick. Without one, then there's no reason to waste effort doing anything else.
If LA = 0 Then LA = _LastAxis(3): ReDim JoyStick(1 To 3) As Axis_Type
If LA = 0 Then Exit Sub 'if there's no axis on your joystick, I don't know how to read it!
If LB = 0 Then LB = _LastButton(3): ReDim Button(1 To LB + 2) As Long
If LB = 0 Then Exit Sub 'if there's no buttons on your joystick, then it's not a proper controller. Go buy one!
Dim axis(LA) As Single
Do
di = _DeviceInput
Select Case di
Case 3 'We have joystick input
For a = 1 To LA: axis(a) = Int(100 * _Axis(a)) / 100: Next 'read the input on each axis
JoyStick(1).Hort = axis(1): JoyStick(1).Vert = axis(2) 'left pad is axis 1 and 2
'axis 3 is the botton left/right buttons on the front of my joystick
JoyStick(2).Hort = axis(5): JoyStick(2).Vert = axis(4) 'right pad is axis 5 and 4
JoyStick(3).Hort = axis(6): JoyStick(3).Vert = axis(7) 'd-pad is axis 6 and 7
'right-pad seems to be mapped backwards to the other axis??!!
For i = 1 To LB
Button(i) = _Button(i)
Next
Button(LB + 1) = _FALSE: Button(LB + 2) = _FALSE
Select Case _Axis(3) 'this is an odd axis which reads off the left/right buttons on the front of the gamepad
Case Is > 0.4: Button(LB + 1) = _TRUE
Case Is < -0.4: Button(LB + 2) = _TRUE
End Select
End Select
Loop Until di = 0
For j = 1 To 3
If Abs(JoyStick(j).Vert) <= .01 Then JoyStick(j).Vert = 0 'remove some natural drift from the keypad
If Abs(JoyStick(j).Hort) <= .01 Then JoyStick(j).Hort = 0 'my joystick seldom resets back to perfect 0
' the code below here gives me a simple X/Y value for left/right, up/down of _TRUE/_FALSE
'I personally find it easier for my 2-d style games to process than having to use frational results.
'Feel free to change the threshold as necessary for your own uses. 0.4 works fine for cardinal directions and diagionals for my use.
If Abs(JoyStick(j).Vert) > 0.4 Then JoyStick(j).Y = Sgn(JoyStick(j).Vert) Else JoyStick(j).Y = 0
If Abs(JoyStick(j).Hort) > 0.4 Then JoyStick(j).X = Sgn(JoyStick(j).Hort) Else JoyStick(j).X = 0
'the angle here is just like the one we learned in school with 0/360 to the right, 90 up, 180 left, and 270 down
'Tweak this as needed so it fits the coordinate system of your own stuff as desired.
JoyStick(j).Angle = _Atan2(JoyStick(j).Hort, JoyStick(j).Vert)
JoyStick(j).Angle = (_R2D(JoyStick(j).Angle) + 270) Mod 360
'And below here is what determines if a joystick was active or not
If JoyStick(j).Vert = 0 And JoyStick(j).Hort = 0 Then JoyStick(j).Active = _FALSE Else JoyStick(j).Active = _TRUE
Next
End Sub
Button 1 is Yes/Fire.
Button 2 is No/Pause.
Any axis will rotate the plane and move it.
One thing that I've noticed is if one shoots in one direction (such as always shooting to the right), you'll also blow up asteroids on your left side of the screen sometimes. The bullets don't seem to carry over all the way across the screen, so I'm not certain what's going on here. It might be something you'd want to check to see what's going on with the collision routines (maybe an ABS in affect somewhere it shouldn't be?? I dunno.)
Anywho... You can now pew-pew with your X-box style controllers!
Posts: 688
Threads: 125
Joined: Apr 2022
Reputation:
49
Thanks Steve! Yeah I've been looking for that glitch for a couple days and will continue to do so. The only ABS command is in your fillcircle SUB so I highly doubt it's that.
|
