_TITLE "Invaders b0_4_1" 'Bplus started 2019-07-27 inspired by Ken's fun program series
' 2019-07-29 b0_3 from feed back fix game ending with big "Game Over" sign and delay before Top Ten.
' Show score to compare with Top Ten Numbers.
' Change the way hits are calculated, use method that avoids distance function or ABS.
' Change TopTen sub to TopTenGoAgain$ function to also get Play Again reply.
' OK let's start charging for bullets! 1 point per... and do a hit % to reward skillful shooting
' change BEEPs to SOUNDS, add more to report, Game Over signals end of game, TopTen does go again also.
' 2019-07-31 Rework the Top Ten screen using Text sub routine that I want to demo in "another one for the Toolbox."
' This new TopTen function now uses inputBox$ which added a ton of lines to the program!
'2019-08-01 incremental speed of shooter
CONST xmax
= 1200, ymax
= 720, PI
= 3.141592653589793, PD2
= 1.570796326794897, PT2
= 6.283185307
setUp
LINE (0, 0)-(xmax
, ymax
), _RGBA(0, 0, 0, 255), BF
'IF kh = 18432 THEN o(0).dx = 0
' IF kh = 19200 THEN o(0).dx = -3
' IF kh = 19712 THEN o(0).dx = 3
IF kh
= 18432 OR kh
= 20480 THEN o
(0).dx
= 0 'up or down, stop for either key (new for down arrow)
'For TempodiBasic acceleration idea
IF kh
= 19200 THEN 'left or more left IF o
(0).dx
< 0 AND o
(0).dx
> -8 THEN o
(0).dx
= o
(0).dx
- 1 ELSE o
(0).dx
= -3 IF kh
= 19712 THEN 'right or more right IF o
(0).dx
> 0 AND o
(0).dx
< 8 THEN o
(0).dx
= o
(0).dx
+ 1 ELSE o
(0).dx
= 3
report
'dead ships and bullets? but still exploding this separated out because ships are getting hit more than once while exploding
o(i).exploding = o(i).exploding - 1
newEnemy i
SOUND 1000 - o
(i
).size
* 3 + (21 - o
(i
).exploding
) * 10, .1 red = rand(60, 255)
fcirc o
(i
).x
, o
(i
).y
, o
(i
).exploding
* 3, _RGB32(red
, rand
(0, red
), 0) 'bullets
o(i).exploding = o(i).exploding - 1
red = rand(60, 255)
fcirc o
(i
).x
, o
(i
).y
, o
(i
).exploding
, _RGB32(red
, rand
(0, red
), 0)
IF o
(i
).live
<> 0 THEN 'draw everything, update positions, check updated position drawshooter o(i).x
IF shoot
AND (TIMER(.001) - o
(0).lastShot
) > .1 THEN '.2 is this the cause of hitting a ship twice? newBullet 0, o(0).x, ymax - 60
IF o
(i
).x
+ o
(i
).dx
> 0 AND o
(i
).x
+ o
(i
).dx
< xmax
THEN o(i).x = o(i).x + o(i).dx
o(i).dx = -o(i).dx
o(i).exploding = o(i).exploding - 1
IF o
(i
).exploding
= 0 THEN 'no longer exploding o(0).live = o(0).live - 1
fcirc o(0).x, ymax - 75, 50, &HFF770000
report
drawshooter o(i).x
SOUND 400 + o
(0).exploding
* 7, .3 red = rand(60, 255)
fcirc o
(0).x
, ymax
- 75, o
(0).exploding
* 6, _RGB32(red
, rand
(0, red
), 0)
'update coodinates
o(i).lastX = o(i).x: o(i).lastY = o(i).y
o
(i
).x
= o
(i
).xc
+ 150 * (COS(o
(i
).a
) + COS(o
(i
).v1
* o
(i
).a
) / 2 + SIN(o
(i
).v2
* o
(i
).a
) / 3) o
(i
).y
= o
(i
).yc
+ 150 * (SIN(o
(i
).a
) + SIN(o
(i
).v1
* o
(i
).a
) / 2 + COS(o
(i
).v2
* o
(i
).a
) / 3) drawRat i
o(i).a = o(i).a + PI / 1440
IF o
(i
).xc
+ o
(i
).dx
> 0 AND o
(i
).xc
+ o
(i
).dx
< xmax
THEN o(i).xc = o(i).xc + o(i).dx
o(i).dx = -o(i).dx
'drop bombs
newBullet i, o(i).x, o(i).y + o(i).size
fcirc o(i).x, o(i).y, o(i).size, o(i).c
IF o
(i
).y
+ o
(i
).dy
> 0 AND o
(i
).y
+ o
(i
).dy
< ymax
THEN IF o
(i
).dy
> 0 THEN o
(i
).dy
= o
(i
).dy
+ .1 'gravity o(i).y = o(i).y + o(i).dy
o(i).live = 0
'did this bullet hit anything
IF o
(i
).dy
> 0 THEN 'did it hit the shooter IF (o
(0).x
- o
(0).size
<= o
(i
).x
) AND (o
(i
).x
<= o
(0).x
+ o
(0).size
) THEN IF (o
(0).y
- o
(0).size
<= o
(i
).y
) AND (o
(i
).y
<= o
(0).y
+ o
(0).size
+ 20) THEN o(0).exploding = 20 'signal exploding
o(i).live = 0 'kill bullet
IF (o
(j
).x
- o
(j
).size
<= o
(i
).x
) AND (o
(i
).x
<= o
(j
).x
+ o
(j
).size
) THEN 'is x right IF (o
(j
).y
- o
(j
).size
- 5 < o
(i
).y
) AND (o
(i
).y
<= o
(j
).y
+ o
(j
).size
+ 5) THEN 'is y right IF o
(j
).exploding
= 0 AND o
(j
).live
<> 0 THEN 'ship not exploding already o(j).exploding = 20
SOUND 800 - o
(i
).size
* 3, .1 points = points + 50 - o(j).size
hits = hits + 1
o(i).live = 0: o(j).live = 0 'kill bullet and ship
END IF 'if not exploding already
'finally bullet versus bullet!! remember these bullets (i) are headed up
FOR j
= i
+ 1 TO 100 ' find only those going in different directions IF o
(j
).dy
> 0 THEN 'look for bullets headed down IF o
(j
).x
- 3 <= o
(i
).x
AND o
(i
).x
<= o
(j
).x
+ 3 THEN 'is x right IF (o
(j
).y
- 8 <= o
(i
).y
) AND (o
(i
).y
<= o
(j
).y
+ o
(j
).dy
) THEN 'is y right why 16 gravity accums fcirc o(i).x, o(i).y, 200, &HFFFFFFFF
o(i).live = 0: o(j).live = 0
o(i).exploding = 10
END IF 'bullets going in opposite directions cText xmax / 2, ymax / 2, 128, &HFFFF5500, "Game Over"
again$ = topTenGoAgain$(points)
'obj 0 is the player's shooter
points = 0: bullets = 0: hits = 0
o(0).x = xmax / 2: o(0).y = ymax - 60: o(0).size = 50
o(0).live = 10
newEnemy i
o
(i
).a
= RND * PT2: o
(i
).live
= 1: o
(i
).v1
= rand
(2, 19): o
(i
).v2
= rand
(2, 19) r = rand(128, 255): g = rand(0, .5 * r): b = rand(0, .5 * g)
o
(i
).size
= rand
(10, 45): o
(i
).c
= _RGB32(r
, g
, b
) o
(i
).yc
= ymax
/ 2 - 30: o
(i
).lastShot
= TIMER(.003) + i
o(i).xc = 0: o(i).dx = 1
o(i).xc = xmax: o(i).dx = -1
SUB newBullet
(who
, x
, y
) FOR ii
= 4 TO 100 'find bullet slot o
(ii
).x
= x: o
(ii
).y
= y: o
(ii
).size
= 2: o
(ii
).live
= -1: o
(who
).lastShot
= TIMER(.001) o(ii).dy = -10: o(ii).c = &HFFFFFFFF: bullets = bullets + 1: points = points - 1
o(ii).dy = 1: o(ii).c = &HFFFFFF00
shoot = 0
s$ = "Lives: " + TS$(o(0).live) + " Bullets: " + TS$(bullets) + " Hits: " + TS$(hits) + " Eff% "
IF bullets
= 0 THEN s$
= s$
+ "**" ELSE s$
= s$
+ TS$
(100 * hits \ bullets
) s$ = s$ + " Points: " + TS$(points)
cText xmax / 2, 30, 20, &HFF009900, s$
DIM noseX
, noseY
, neckX
, neckY
, tailX
, tailY
, earLX
, earLY
, earRX
, earRY
, wX
, wY
, rh
rh
= _ATAN2(o
(i
).y
- o
(i
).lastY
, o
(i
).x
- o
(i
).lastX
) noseX
= o
(i
).x
+ 2 * o
(i
).size
* COS(rh
) noseY
= o
(i
).y
+ 2 * o
(i
).size
* SIN(rh
) neckX
= o
(i
).x
+ .75 * o
(i
).size
* COS(rh
) neckY
= o
(i
).y
+ .75 * o
(i
).size
* SIN(rh
) tailX
= o
(i
).x
+ 2 * o
(i
).size
* COS(rh
+ _PI) tailY
= o
(i
).y
+ 2 * o
(i
).size
* SIN(rh
+ _PI) earLX
= o
(i
).x
+ o
(i
).size
* COS(rh
- _PI(1 / 12)) earLY
= o
(i
).y
+ o
(i
).size
* SIN(rh
- _PI(1 / 12)) earRX
= o
(i
).x
+ o
(i
).size
* COS(rh
+ _PI(1 / 12)) earRY
= o
(i
).y
+ o
(i
).size
* SIN(rh
+ _PI(1 / 12)) fcirc o(i).x, o(i).y, .65 * o(i).size, o(i).c
fcirc neckX, neckY, o(i).size * .3, o(i).c
fTri noseX, noseY, earLX, earLY, earRX, earRY, o(i).c
fcirc earLX, earLY, o(i).size * .3, o(i).c
fcirc earRX, earRY, o(i).size * .3, o(i).c
wX
= .5 * o
(i
).size
* COS(rh
- _PI(11 / 18)) wY
= .5 * o
(i
).size
* SIN(rh
- _PI(11 / 18)) ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, o(i).c
wX
= .5 * o
(i
).size
* COS(rh
- _PI(7 / 18)) wY
= .5 * o
(i
).size
* SIN(rh
- _PI(7 / 18)) ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, o(i).c
ln o(i).x, o(i).y, tailX, tailY, o(i).c
'calculate 3 points of triangle shooter
y1 = ymax - 10
y2 = ymax - 60
x1 = x - 50
x2 = x + 50
fTri x, y1, x1, ymax, x, y2, &HFF0000BB
fTri x, y1, x2, ymax, x, y2, &HFF0000BB
ln x
, y1
, x1
, ymax
, _RGB32(255, 255, 128) ln x1
, ymax
, x
, y2
, _RGB32(255, 255, 128) ln x
, y1
, x2
, ymax
, _RGB32(255, 255, 128) ln x2
, ymax
, x
, y2
, _RGB32(255, 255, 128)
' For TempodiBasic Mod this might be handy
'ln x, y1, x, y2, _RGB32(255, 255, 128)
COLOR &HFF88BBFF, &HFF0000BB COLOR &HFFFFFFFF, &HFF000000
' This FUNCTION creates a file in the same folder as your .bas source or .exe
'EDIT: 2019-07-31 this function needs:
' SUB cText(x, y, pixelTextHeight, Colr)
' SUB inputBox$(prompt$, title$, maxBoxWidth)
' which needs scnState(restoreTF)
fName$ = "Top 10 Scores.txt" '<<< since this is toolbox code change this as needed for app
cText
_WIDTH / 2, _HEIGHT / 8, 20, &HFF0000FF, "Your score was:" + STR$(compareScore
) n = n + 1
IF compareScore
>= score
AND settleScore
= 0 THEN names$(n) = inputBox$("Please enter your name here:", "You have made the Top Ten!", 40)
scores(n) = compareScore
settleScore = -1
n = n + 1
IF n
<= 10 THEN names$
(n
) = NAME$: scores
(n
) = score
scores
(n
) = score: names$
(n
) = NAME$
NAME$
= inputBox$
("Please enter your name here:", "Top Ten has slot open for you:", 40) IF NAME$
<> "" THEN n
= n
+ 1: names$
(n
) = NAME$: scores
(n
) = compareScore
cText
_WIDTH / 2, yc
, 40, &HFFFFFF00, "Top Ten Scorers and Scores:" cText
_WIDTH / 2, yc
+ 30 + i
* 20, 20, &HFF00FFFF, s$
NAME$
= inputBox
("Please enter your name here:", "You are first into Top Ten file.", 40) topTenGoAgain$ = inputBox$("Press <Enter> to play again, enter q (or any) to quit... ", "Play Again?", 66)
'center the text around (x, y) point, needs a graphics screen!
'screen snapshot
mult = textHeight / 16
xlen
= LEN(txt$
) * 8 * mult
_PUTIMAGE (x
- .5 * xlen
, y
- .5 * textHeight
)-STEP(xlen
, textHeight
), I&
, cur&
' You can grab this box by title and drag it around screen for full viewing while answering prompt.
' Only one line allowed for prompt$
' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
' Utilities > Input Box > Input Box 1 tester v 2019-07-31
' This FUNCTION needs scnState(restroreTF)
'colors
ForeColor = &HFF000055 '< change as desired prompt text color, back color or type in area
BackColor = &HFF6080CC '< change as desired used fore color in type in area
White = &HFFFFFFFF
'items to restore at exit
scnState 0
'screen snapshot
'moving box around on screen
'draw message box
bxW = boxWidth * 8: bxH = 7 * 16
COLOR ForeColor
, BackColor
'convert to pixels the top left corner of box at moment
bxW = boxWidth * 8: bxH = 5 * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
'now allow user to move it around or just read it
IF mx
>= tlx
AND mx
<= tlx
+ bxW
AND my
>= tly
AND my
<= tly
+ 16 THEN 'mouse down on title bar grabx = mx - tlx: graby = my - tly
IF mx
- grabx
>= 0 AND mx
- grabx
<= sw
- bxW
AND my
- graby
>= 0 AND my
- graby
<= sh
- bxH
THEN 'attempt to speed up with less updates
IF ((lastx
- (mx
- grabx
)) ^ 2 + (lasty
- (my
- graby
)) ^ 2) ^ .5 > 10 THEN tlx = mx - grabx: tly = my - graby
lastx = tlx: lasty = tly
SELECT CASE kh&
'whew not much for the main event!
'put things back
scnState 1 'need fg and bg colors set to cls
CLS '? is this needed YES!! scnState 1 'because we have to call _display, we have to call this again
finishBox:
COLOR BackColor
, ForeColor
'from mBox v 2019-07-31 update
' for saving and restoring screen settins
COLOR DefaultColor
, BackGroundColor
rand%
= INT(RND * (hi%
- lo%
+ 1)) + lo%
' found at [abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]: http://www.[abandoned, outdated and now likely malicious qb64 dot net website - don’t go there]/forum/index.php?topic=14425.0
LINE (x1
, y1
)-(x2
, y2
), K
'from Steve Gold standard
Radius
= ABS(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
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