_TITLE "b+ Asteroids m7 Play Again" 'started 2018-07-13" ' 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 2 to 5, diff = 3 * 33.3333 = 100 s - 2 * 33.3333
' The lower the color the better color range 10 to 60, diff = 50 * 2 = 100 50 - (c - 10) * 2
' The small er the size the better size range 10 to 100, diff = 90 * 1.1111 = 100 90 - (sz -10) * 1.1111
' ((speed - 2) * 33.3333 + (50 - (c -10)) * 2 + (90 - (r - 10)) * 1.1111) / 3 = 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.
'================================================================================================================
' NOTE: !!!!!!!!!!!!!!! When there is a pause in action, just hit any key to reset next life.
'================================================================================================================
CONST xmax
= 1200, ymax
= 700, pi
= _PI, polyAngle
= _PI / 6, nRocks
= 300, nBullets
= 2000, bSpeed
= 15
a
AS SINGLE ' rotated position usu gun left or right (mouse button), maybe up press w or down press z
ra
AS SINGLE ' rotation position a = a + spin heading
AS SINGLE ' heading from which dx, dy are calc with 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
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$
, s$
, t
, lastt
' general string and times
fnt
= _LOADFONT("ARLRDBD.ttf", 16, "MONOSPACE")fnt2
= _LOADFONT("ARLRDBD.ttf", 40, "MONOSPACE")COLOR &HFF00FFFF, &H00000000
hs$
= "High Score:" + STR$(HS
)
'a little splash screen
rocks = 7: alienN = 3
newRock i
IF i
> rocks
THEN r
(i
).live
= 0 newAlien i
i = 0
drawStars 0
i = i + 1
IF i
MOD 30 = 29 AND rocks
< nRocks
THEN rocks
= rocks
+ 1: r
(rocks
).live
= 1 drawAliens i
s$ = "Welcome to b+ Asteroids"
s$ = "To get ready,"
s$ = "place mouse pointer"
s$ = "in center of screen"
s$ = "Press q to Quit,"
s$ = "any other to Play"
restart:
hs$
= " High Score:" + STR$(HS
)lives = 10: alienN = 1: rocks = 4: ' always active rocks
points = 0: hits = 0: bullets = 0
newAlien ai
FOR i
= 1 TO nRocks
'reset rocks mainly clear baby rocks newRock (i)
IF i
> rocks
THEN r
(i
).live
= 0 ship.x = xmax / 2 'avoids explosions top left corner at start, dang still get some!
ship.y = ymax / 2
ship.live = 1
'draw everything then process bullets
drawStars 1
drawAliens ai
IF r
(i
).live
THEN 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
+ 30 THEN 'rock collides with ship? CIRCLE ((ship.x
+ r
(i
).x
) / 2, (ship.y
+ r
(i
).y
) / 2), br
, _RGB32(255 - br
, 255 - 2 * br
, 0) drawRock i
drawship
ship.live = 0
FOR i
= 1 TO nRocks
'smoke up the place with rock debris fields still flying out from hit frames ago r(i).explodeFrame = r(i).explodeFrame + 1
IF r
(i
).explodeFrame
> .5 * r
(i
).r
THEN r(i).explodeFrame = 0
IF i
<= rocks
THEN newRock i
' now replace the rock explode r(i).x, r(i).y, r(i).r, r(i).explodeFrame
IF SQR((aliens
(ai
).x
- ship.x
) ^ 2 + (aliens
(ai
).y
- ship.y
) ^ 2) < 60 THEN 'aliens and ship collisde boom boom CIRCLE ((ship.x
+ aliens
(ai
).x
) / 2, (ship.y
+ aliens
(ai
).y
) / 2), br
, _RGB32(255 - br
, 255 - 2 * br
, 0) drawship
ship.live = 0
drawship
ship.a
= ship.a
+ _MOUSEWHEEL * pi
/ 8 ' 22.5 degree changes, Thank Ken for this :) fire = 0
'IF _KEYDOWN(32) THEN 'fire bullets
IF lastt
= 0 OR t
- lastt
> .2 THEN fire
= 1: lastt
= t
'END IF
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
+ bSpeed
* COS(ship.a
) b
(i
).y
= ship.y
+ bSpeed
* SIN(ship.a
) b
(i
).dx
= bSpeed
* COS(ship.a
) b
(i
).dy
= bSpeed
* SIN(ship.a
) b(i).live = -1
bullets = bullets + 1
fire = 0
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?
IF SQR((aliens
(ai
).x
- b
(i
).x
) ^ 2 + (aliens
(ai
).y
- b
(i
).y
) ^ 2) < 30 THEN CIRCLE (aliens
(ai
).x
, aliens
(ai
).y
), br
/ 3, plasma~&
(0) hits = hits + 1
points = points + 100
aliens(ai).live = 0
newAlien ai
b(i).live = 0
FOR r
= 1 TO nRocks
'check for collision with rock 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
points = points + ((r(r).speed - 2) * 33.3333 + (50 - (r(r).c - 10)) * 2 + (90 - (r(r).r - 10)) * 1.1111) / 3
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.a - .75 * pi, ship.a + .75 * pi)
END IF ' big enough to split b(i).live = 0 'kill bullet
IF b
(i
).live
THEN fcirc b
(i
).x
, b
(i
).y
, 3, _RGB32(255, 255, 0) 'draws bullet b(i).live = 0 'out of bounds
END IF ' bullet is in bounds END IF ' if ship still live lives = lives - 1
s$
= "Lives:" + STR$(lives
) + " Hits:" + STR$(hits
) + " Bullets:" + STR$(bullets
) + " Shooting:" + STR$(INT(hits
* 100 / bullets
)) + "%" s$ = "Center mouse and press any"
_LIMIT 60 ' if ship dies let's rest and regroup before restart next life ship.x = -200: ship.y = -200 'get it out of the way
i = 0
drawStars 0
i = i + 1
IF i
MOD 30 = 29 AND rocks
< nRocks
THEN rocks
= rocks
+ 1: r
(rocks
).live
= 1 s$
= "Lives:" + STR$(lives
) + " Hits:" + STR$(hits
) + " Bullets:" + STR$(bullets
) + " Shooting:" + STR$(INT(hits
* 100 / bullets
)) + "%" IF points
> HS
THEN s$
= s$
+ " a New Record!" ELSE s$
= STR$(points
) + hs$
s$ = "Press q to quit, p or a to Play Again..."
IF beenHere
= 0 THEN 'static part stars
(i
).x
= RND * xmax: stars
(i
).y
= RND * ymax: stars
(i
).size
= 0 stars(i).c = irnd&(80, 140)
stars
(i
).x
= RND * xmax: stars
(i
).y
= RND * ymax: stars
(i
).size
= .3 stars(i).c = irnd&(80, 140)
stars
(i
+ 400).x
= RND * xmax: stars
(i
+ 400).y
= RND * ymax: stars
(i
+ 100).size
= .6 stars(i).c = irnd&(110, 170)
stars
(i
+ 540).x
= RND * xmax: stars
(i
+ 540).y
= RND * ymax: stars
(i
+ 170).size
= 1.2 stars(i).c = irnd&(140, 200)
stars
(i
+ 590).x
= RND * xmax: stars
(i
+ 590).y
= RND * ymax: stars
(i
+ 195).size
= 2.4 stars(i).c = irnd&(170, 235)
cy = ymax / 2
beenHere = 1
LINE (0, ymax
- i
)-(xmax
, ymax
- i
), _RGB(0, 0, .1 * i
+ 4) 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 fcirc stars
(i
).x
, stars
(i
).y
, stars
(i
).size
, _RGB32(stars
(i
).c
- 10, stars
(i
).c
, stars
(i
).c
+ 10)
side = irnd&(1, 4) 'bring rock in from one side, need to set heading according to side
aliens(i).fireX = irnd(10, xmax - 10)
aliens(i).fireY = irnd(10, ymax - 10)
aliens(i).attackFrame = irnd(30, 400) ' EDIT a tweak to survive a little long before getting murdered with low lives over and over...
aliens(i).x = -10
aliens(i).y = rrnd(20, ymax - 20)
aliens(i).x = xmax + 10
aliens(i).y = rrnd(20, ymax - 20)
aliens(i).x = rrnd(20, xmax - 20)
aliens(i).y = -10
aliens(i).x = rrnd(20, xmax - 20)
aliens(i).y = ymax + 10
heading
= _ATAN2(aliens
(i
).fireY
- aliens
(i
).y
, aliens
(i
).fireX
- aliens
(i
).x
) aliens
(i
).dx
= 3.5 * COS(heading
) aliens
(i
).dy
= 3.5 * SIN(heading
) aliens(i).live = 0
aliens(i).transform = 0
aliens
(i
).c
= _RGB32(irnd
(128, 255), irnd
(0, 255), irnd
(0, 255))
r
= RND: g
= RND: b
= RND: beenHere
= 1: cnt
= 0 cnt = cnt + .2
plasma~&
= _RGB32(127 + 127 * SIN(r
* cnt
), 127 + 127 * SIN(g
* cnt
), 127 + 127 * SIN(b
* cnt
))
IF aliens
(i
).transform
= 0 THEN 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
) 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) aliens(i).ls = aliens(i).ls + 1
IF aliens
(i
).ls
> 5 THEN aliens
(i
).ls
= 0 fcirc aliens(i).x, aliens(i).y, 30, aliens(i).c
'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
= 10 * COS(heading
) aliens
(i
).dy
= 10 * SIN(heading
) 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
aliens(i).attackFrame = aliens(i).attackFrame - 1
IF aliens
(i
).attackFrame
= 0 THEN aliens(i).live = 1
FOR i
= rocks
+ 1 TO nRocks
' look for inactive rock number
maxParticles = r * 4
NewDot i, x, y, r
rounds = r
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
NewDot (rounds + i), x, y, r
rounds = rounds + r
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
) dots
(i
).kolor
= _RGBA32(rd
, rd
, rd
, 80)
SUB drawship
'simple red iso triangle pointed towards radianAngle 'calculate 3 points of triangle ship
fcirc ship.x, ship.y, 30, &H05FFFFFF
x1
= ship.x
+ 30 * COS(ship.a
) ' front point y1
= ship.y
+ 30 * SIN(ship.a
) ' x2
= ship.x
+ 30 * COS(ship.a
+ .6666 * pi
) ' wing y2
= ship.y
+ 30 * SIN(ship.a
+ .6666 * pi
) x3
= ship.x
+ 30 * COS(ship.a
- .6666 * pi
) ' other wing y3
= ship.y
+ 30 * SIN(ship.a
- .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)
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 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 r(iRock).x = r(iRock).x + dx
r(iRock).y = r(iRock).y + dy
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
leg
= rRad
* (RND * .35 + .65) x2 = x0: y2 = y0
x2
= xoff
+ leg
* COS(i
* polyAngle
+ r
(iRock
).ra
) y2
= yoff
+ leg
* SIN(i
* polyAngle
+ r
(iRock
).ra
) ftri r(iRock).x, r(iRock).y, x1, y1, x2, y2, c~&
x1 = x2: y1 = y2
side = irnd&(1, 4) 'bring rock in from one side, need to set heading according to side
r(iRock).x = -10
r(iRock).y = rrnd(20, ymax - 20)
r
(iRock
).heading
= 3 * pi
/ 2 + RND * pi
r(iRock).x = xmax + 10
r(iRock).y = rrnd(20, ymax - 20)
r
(iRock
).heading
= pi
/ 2 + RND * pi
r(iRock).x = rrnd(20, xmax - 20)
r(iRock).y = -10
r
(iRock
).heading
= RND * pi
r(iRock).x = rrnd(20, xmax - 20)
r(iRock).y = ymax + 10
r
(iRock
).heading
= pi
+ RND * pi
r(iRock).speed = rrnd(2, 5) 'speed, rotation angle, radius, gray coloring, spin, seed, hit for explosion
r
(iRock
).ra
= RND * 2 * pi
r(iRock).r = irnd&(30, 100)
r(iRock).c = irnd&(10, 60)
r(iRock).spin = rrnd(-pi / 20, pi / 20)
r
(iRock
).seed
= INT(RND * 64000) - 32000 r(iRock).explodeFrame = 0
r(iRock).live = 1
FUNCTION irnd&
(n1
, n2
) 'return an integer between 2 numbers IF n1
> n2
THEN l%
= n2: h%
= n1
ELSE l%
= n1: h%
= n2
irnd&
= INT(RND * (h%
- l%
+ 1)) + l%
FUNCTION rrnd
(n1
, n2
) ' return number (expecting reals =_single, double, _float depending on default / define setup) rrnd
= (n2
- n1
) * RND + n1
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
LINE (CX
- xr
, CY
)-(CX
+ xr
, CY
), C
, BF
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
_BLEND a&
'<<<< new 2019-12-16 fix
x0 = R: y0 = 0: e = 0
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
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
LINE (x
- R
, y
)-(x
+ R
, y
), C
, BF
