_TITLE "b+ Asteroids m4 They are Here" '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 smaller 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.
'================================================================================================================
' 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 s$
, t
, lastt
' general string and times
fnt
= _LOADFONT("ARLRDBD.ttf", 16, "MONOSPACE")fnt2
= _LOADFONT("ARLRDBD.ttf", 40, "MONOSPACE")COLOR &HFF00FFFF, &H00000000
rocks = 3 ' always active rocks
lives = 5
newAlien
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
' CIRCLE (aliens.fireX, aliens.fireY), 10, &HFFFFFFFF transformtion poimt Bolder of Death
s$
= "Lives:" + STR$(lives
) + " Hits:" + STR$(hits
) + " Bullets:" + STR$(bullets
) + " Shooting:" + STR$(INT(hits
* 100 / bullets
)) + "%" drawAliens
IF r
(i
).live
THEN drawRock i
' while drawing rocks the ship could be blown up 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.x
- ship.x
) ^ 2 + (aliens.y
- ship.y
) ^ 2) < 60 THEN 'aliens and ship collisde boom boom fcirc ship.x
, ship.y
, br
, _RGB32(255 - br
, 255 - 2 * br
, 0) ship.live = 0
drawship
ship.a
= ship.a
+ _MOUSEWHEEL * pi
/ 8 ' 22.5 degree changes, Thank Ken for this :) fire = 0
IF lastt
= 0 OR t
- lastt
> .2 THEN fire
= 1: lastt
= t
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.x
- b
(i
).x
) ^ 2 + (aliens.y
- b
(i
).y
) ^ 2) < 30 THEN CIRCLE (aliens.x
, aliens.y
), br
/ 3, plasma~&
(0) aliens.live = 0
newAlien
points = points + 100
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 IF ship.live
= 0 THEN SLEEP ELSE _LIMIT 60 ' if ship dies let's rest and regroup before restart next life lives = lives - 1
rocks = rocks + 1
ship.x = -200: ship.y = -200 'get it out of the way
i = 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
)) + "%" s$ = "Press q to quit"
side = irnd&(1, 4) 'bring rock in from one side, need to set heading according to side
aliens.fireX = irnd(10, xmax - 10)
aliens.fireY = irnd(10, ymax - 10)
aliens.attackFrame = irnd(5, 30)
aliens.x = -10
aliens.y = rrnd(20, ymax - 20)
aliens.x = xmax + 10
aliens.y = rrnd(20, ymax - 20)
aliens.x = rrnd(20, xmax - 20)
aliens.y = -10
aliens.x = rrnd(20, xmax - 20)
aliens.y = ymax + 10
heading
= _ATAN2(aliens.fireY
- aliens.y
, aliens.fireX
- aliens.x
) aliens.dx
= 3.5 * COS(heading
) aliens.dy
= 3.5 * SIN(heading
) aliens.live = 0
aliens.transform = 0
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
))
fellipse aliens.x
, aliens.y
, 6, 15, _RGB32(110, 20, 0) fellipse aliens.x
, aliens.y
, 18, 11, _RGB32(150, 60, 0) fellipse aliens.x
, aliens.y
, 30, 7, _RGB32(190, 100, 20) fcirc aliens.x
- 35 + 5 * light
+ ls
, aliens.y
, 1, _RGB32(ls
* 20 + 150, ls
* 20 + 150, ls
* 20 + 150) ls = ls + 1
fcirc aliens.x, aliens.y, 30, &HFFFFFF00
'time to shoot?
aliens.x = aliens.x + aliens.dx
aliens.y = aliens.y + aliens.dy
IF SQR((aliens.fireX
- aliens.x
) ^ 2 + (aliens.fireY
- aliens.y
) ^ 2) < 5 THEN 'transform into the bolder of death aliens.transform = 1
heading
= _ATAN2(ship.y
- aliens.y
, ship.x
- aliens.x
) aliens.dx
= 10 * COS(heading
) aliens.dy
= 10 * SIN(heading
) IF aliens.x
< -10 OR aliens.x
> xmax
+ 10 THEN IF aliens.y
< -10 OR aliens.y
> ymax
+ 10 THEN ' out of bounds goodbye bolder of death! aliens.live = 0 'man we dodged a bullet here!!!!
newAlien 'reset the trap
aliens.attackFrame = aliens.attackFrame - 1
IF aliens.attackFrame
= 0 THEN aliens.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 tail points of triangle ship
x1
= ship.x
+ 40 * COS(ship.a
- pi
) ' middle y1
= ship.y
+ 40 * SIN(ship.a
- pi
) ' x2
= ship.x
+ 60 * COS(ship.a
+ .9 * pi
) ' wing y2
= ship.y
+ 60 * SIN(ship.a
+ .9 * pi
) x3
= ship.x
+ 60 * COS(ship.a
- .9 * pi
) ' other wing y3
= ship.y
+ 60 * SIN(ship.a
- .9 * 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 (ship.x
, ship.y
)-(x1
, y1
), _RGB32(255, 255, 128) LINE (ship.x
, ship.y
)-(x2
, y2
), _RGB32(180, 180, 120) LINE (ship.x
, ship.y
)-(x3
, y3
), _RGB32(180, 180, 120)
RANDOMIZE USING r
(iRock
).seed
'this prevents having to save a particular sequence of random number DIM dx
, dy
, rad
AS LONG, 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
IF ((r
(iRock
).x
- ship.x
) ^ 2 + (r
(iRock
).y
- ship.y
) ^ 2) ^ .5 < r
(iRock
).r
+ 30 THEN 'rock collides with ship? fcirc ship.x
, ship.y
, rad
, _RGB32(255 - rad
, 255 - 2 * rad
, 0) ship.live = 0
IF iRock
<= rocks
THEN newRock iRock
ELSE r
(iRock
).live
= 0 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
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' C = fill color
w2 = a * a
h2 = b * b
h2w2 = h2 * w2
LINE (CX
- a
, CY
)-(CX
+ a
, 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