Today, 12:35 AM
No shooting please!
Code: (Select All)
_Title "Return of the Cheese Chewer(s) by bplus 2018-08-06"
' QB64 X 64 version 1.2 20180228/86 from git b301f92
' 2018-07-13 eRATication - modified from Asteroids game
' 2018-07-15 eRATication 2
' color rats, eliminate jerks when kill rat,
' decrease rat size as life progresses
' 2018-07-15 some minor changes since post of e #2
' 2018-07-20 eRATication 3
' Shooter: location controlled by mouse
' mouse left and right button works like left and right arrow keys.
' Code: use type for objects, simplify math where possible
' complete makeover of code.
' Fixed problem of running into burning rat.
' Display: Life # and Points on screen as Fellippe suggested.
' Points: should be directly proportional to rat's speed and indirectly
' proportional to size, so speed\size!
' but compare that to number of shots taken!
'2018-08-06 Return of the Cheese Chewer(s)
' All that cheese going to waste?
' nope! redesigned shooter to chucky cheese rat eater
'================================ Instructions ==========================
'
' Move cheese, eat rats, get a-round(er)
'
' Eat or be eaten!
'
'========================================================================
'screen dimensions
Const ww = 1280
Const wh = 740
Const cx0 = 400
Const cy0 = 300
Const ratPack = 5
Const maxLife = 3
Type cheeseType
x As Integer
y As Integer
r As Integer
a As Double 'curr angle
ma As Double 'mouth angle
dma As Integer 'mouth angle growing 1 or shrinking -1
End Type
Type rat
x As Integer
y As Integer
r As Integer
dx As Integer
dy As Integer
c As _Unsigned Long
dead As Integer
End Type
Screen _NewImage(ww, wh, 32)
_FullScreen
Randomize Timer
Dim Shared life, nRats, points, GameOn, newRound, cheese&
Dim Shared r(maxLife * ratPack + maxLife) As rat
Dim Shared chucky As cheeseType
restart:
chucky.x = ww / 2
chucky.y = wh / 2
chucky.r = 50
chucky.a = 0 'mouth direction
chucky.ma = _Pi(1 / 3) 'mouth angle
chucky.dma = 1 'mouth angle direction up or down
lastx = ww / 2: lasty = wh / 2
life = 1
nRats = life * ratPack
points = 0
GameOn = 1
newRound = 0
For i = 0 To nRats
newRat i
Next
growCheese
_MouseHide
While GameOn
Cls
newRound = 0
'KISS control!!!
While _MouseInput: Wend
chucky.x = _MouseX: chucky.y = _MouseY
If chucky.x <> lastx Or chucky.y <> lasty Then
chucky.a = _Atan2(chucky.y - lasty, chucky.x - lastx)
lastx = chucky.x: lasty = chucky.y
End If
If _MouseButton(1) Then chucky.a = chucky.a - _Pi(10 / 360)
If _MouseButton(2) Then chucky.a = chucky.a + _Pi(10 / 360)
While chucky.a < 0
chucky.a = chucky.a + _Pi(2)
Wend
While chucky.a >= _Pi(2)
chucky.a = chuck.a - _Pi(2)
Wend
If _KeyDown(27) Then _MouseShow: End
drawChucky
stats
handleRats
If newRound Then
'chucky goes, round over show last frame to see rat overlap
For ra = 0 To _Pi(2) Step _Pi(1 / 24)
xx = chucky.x + (chucky.r + 20) * Cos(ra)
yy = chucky.y + (chucky.r + 20) * Sin(ra)
xx2 = chucky.x + 5 * chucky.r * Cos(ra)
yy2 = chucky.y + 5 * chucky.r * Sin(ra)
ln xx, yy, xx2, yy2, _RGB32(200, 0, 0)
Next
_Display
_Delay 1.5
If life + 1 <= maxLife Then
life = life + 1
nRats = life * ratPack
'new set o rats
For i = 0 To nRats
newRat i
Next
Else
GameOn = 0
End If
Else
chucky.r = 50 + Int(points / 5)
If chucky.r > 150 Then chucky.r = 150
_Display
_Limit 30
End If
Wend
_Delay 4 ' pause to examine score,
' no play again prompt necessary, of course you want to play again!
GoTo restart
Sub newRat (iRat)
side = rand(1, 4)
Select Case life
Case Is = 1: m = 1
Case Is = 2: m = 1.125
Case Is = 3: m = 1.5
End Select
Select Case side
Case 1
r(iRat).x = 0: r(iRat).y = rand(0, wh)
r(iRat).dx = rand(1, 6) * m: r(iRat).dy = rand(-4, 4) * m
Case 2
r(iRat).x = ww: r(iRat).y = rand(0, wh)
r(iRat).dx = rand(-6, -1) * m: r(iRat).dy = rand(-4, 4) * m
Case 3
r(iRat).x = rand(0, ww): r(iRat).y = 0
r(iRat).dx = rand(-6, 6) * m: r(iRat).dy = rand(1, 4) * m
Case 4
r(iRat).x = rand(0, ww): r(iRat).y = wh:
r(iRat).dx = rand(-6, 6) * m: r(iRat).dy = rand(-4, -1) * m
End Select
r(iRat).r = rand(10, 60 / m)
r(iRat).dead = 0
r = rand(60, 255): g = r \ 2 + rand(0, 10): b = g \ 2
r(iRat).c = _RGB32(r, g, b)
End Sub
Sub handleRats ()
For i = 0 To nRats
If r(i).dead = 0 Then 'if rat not dead move it
r(i).x = r(i).x + r(i).dx
r(i).y = r(i).y + r(i).dy
End If
' rat collides with chucky:
If ((r(i).x - chucky.x) ^ 2 + (r(i).y - chucky.y) ^ 2) ^ .5 < .85 * chucky.r And r(i).dead = 0 Then
'Who gets who ??
'if rat (abdomen) in chucky's mouth chucky lives, rat dies... otherwise vice versa
'we can determine this from the angle between two centers and the direction = direction of chucky's mouth
mx = chucky.x + .5 * chucky.r * Cos(chucky.a)
my = chucky.y + .5 * chucky.r * Sin(chucky.a)
If ((r(i).x - mx) ^ 2 + (r(i).y - my) ^ 2) ^ .5 < .65 * chucky.r Then 'very near center of mouth
'rat dies
If r(i).dead = 0 Then
r(i).dead = 1
points = points + life
End If
Else
newRound = 1 'draw rest of rats to show collisions
End If
End If
'is the rat on screen
If r(i).x > 0 And r(i).x < ww And r(i).y > 0 And r(i).y < wh Then 'inbounds
If r(i).dead Then 'show the burn out until reaches rat radius
r(i).dead = r(i).dead + 2
If r(i).dead < r(i).r Then
For d = 1 To 2 * r(i).r
r1 = rand(-r(i).r, r(i).r): ra1 = Rnd * _Pi(2): r2 = Rnd
dx1 = chucky.x + .5 * chucky.r * Cos(chucky.a) + r2 * r1 * Cos(ra1)
dy1 = chucky.y + .5 * chucky.r * Sin(chucky.a) + r2 * r1 * Sin(ra1)
fcirc dx1, dy1, 2, _RGB32(255 - r(i).dead, 128 - r(i).dead, 0)
Next
Else
newRat i
End If
Else
'draw it
Dim heading As Single
heading = _Atan2(r(i).dy, r(i).dx)
noseX = r(i).x + 2 * r(i).r * Cos(heading)
noseY = r(i).y + 2 * r(i).r * Sin(heading)
neckX = r(i).x + .75 * r(i).r * Cos(heading)
neckY = r(i).y + .75 * r(i).r * Sin(heading)
tailX = r(i).x + 2 * r(i).r * Cos(heading + _Pi)
tailY = r(i).y + 2 * r(i).r * Sin(heading + _Pi)
earLX = r(i).x + r(i).r * Cos(heading - _Pi(1 / 12))
earLY = r(i).y + r(i).r * Sin(heading - _Pi(1 / 12))
earRX = r(i).x + r(i).r * Cos(heading + _Pi(1 / 12))
earRY = r(i).y + r(i).r * Sin(heading + _Pi(1 / 12))
fcirc r(i).x, r(i).y, .65 * r(i).r, r(i).c
fcirc neckX, neckY, r(i).r * .3, r(i).c
fTri noseX, noseY, earLX, earLY, earRX, earRY, r(i).c
fcirc earLX, earLY, r(i).r * .3, r(i).c
fcirc earRX, earRY, r(i).r * .3, r(i).c
wX = .5 * r(i).r * Cos(heading - _Pi(11 / 18))
wY = .5 * r(i).r * Sin(heading - _Pi(11 / 18))
ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, r(i).c
wX = .5 * r(i).r * Cos(heading - _Pi(7 / 18))
wY = .5 * r(i).r * Sin(heading - _Pi(7 / 18))
ln noseX + wX, noseY + wY, noseX - wX, noseY - wY, r(i).c
ln r(i).x, r(i).y, tailX, tailY, r(i).c
End If
Else 'out of bounds
newRat i
End If
Next
End Sub
Sub drawChucky ()
'first makeCheese and use cheese& image to build chucky image
'dim shared chucky as cheeseType
'first chucky's mouth angle
chucky.ma = chucky.ma + _Pi(1 / 5) * chucky.dma
If chucky.ma > _Pi(5 / 6) Then chucky.ma = _Pi(5 / 6): chucky.dma = -1 * chucky.dma
If chucky.ma < _Pi(1 / 12) Then chucky.ma = _Pi(1 / 12): chucky.dma = -1 * chucky.dma
ma2 = .5 * chucky.ma
'next first leg of chucky
x1 = chucky.x + chucky.r * Cos(chucky.a + ma2)
y1 = chucky.y + chucky.r * Sin(chucky.a + ma2)
'first leg of cheese
cx1 = cx0 + chucky.r * Cos(ma2)
cy1 = cy0 + chucky.r * Sin(ma2)
'take small traingles off cheese& image and map them onto main screen at chucky's and mouth angle position
stepper = _Pi(1 / 20)
starter = ma2 + stepper
stopper = _Pi(2) - ma2
For a = starter To stopper Step stepper
'one to one ratio of mapping
x2 = chucky.x + chucky.r * Cos(chucky.a + a)
y2 = chucky.y + chucky.r * Sin(chucky.a + a)
cx2 = cx0 + chucky.r * Cos(a)
cy2 = cy0 + chucky.r * Sin(a)
_MapTriangle (cx0, cy0)-(cx1, cy1)-(cx2, cy2), cheese& To(chucky.x, chucky.y)-(x1, y1)-(x2, y2), 0
x1 = x2: y1 = y2: cx1 = cx2: cy1 = cy2
Next
End Sub
Sub growCheese () 'make this more self contained than first version, all hole stuff just in here
curr& = _Dest
If cheese& Then _FreeImage cheese&
cheese& = _NewImage(ww, wh, 32)
_Dest cheese&
nHoles = 300: maxHoleLife = 20: maxHoleRadius = 7: tfStart = 1
Dim hx(nHoles), hy(nHoles), hLife(nHoles)
For i = 1 To nHoles
GoSub newHole
Next
tfStart = 0
For layr = 1 To 30
Line (0, 0)-(ww, wh), _RGBA32(255, 255, 0, 50), BF 'layer of cheese
For i = 1 To nHoles 'holes in layer
If hLife(i) + 1 > maxHoleLife Then GoSub newHole Else hLife(i) = hLife(i) + 1
hx(i) = hx(i) + Rnd * 2 - 1
hy(i) = hy(i) + Rnd * 2 - 1
If hLife(i) < maxHoleRadius Then
radius = hLife(i)
ElseIf maxHoleLife - hLife(i) < maxHoleRadius Then
radius = maxHoleLife - hLife(i)
Else
radius = maxHoleRadius
End If
fcirc hx(i), hy(i), radius, _RGBA32(0, 0, 0, 50)
Next
Next
_Dest curr&
Exit Sub
newHole:
hx(i) = ww * Rnd
hy(i) = wh * Rnd
If tfStart Then hLife(i) = Int(Rnd * maxHoleLife) Else hLife(i) = 1
Return
End Sub
Sub stats ()
Color _RGB(200, 225, 255)
_PrintString (5, 5), "Life #" + LTrim$(Str$(life)) + " Points:" + Str$(points)
End Sub
Function rand% (lo%, hi%)
rand% = Int(Rnd * (hi% - lo% + 1)) + lo%
End Function
' found at QB64.net: http://www.qb64.net/forum/index.php?topic=14425.0
Sub fTri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
a& = _NewImage(1, 1, 32)
_Dest a&
PSet (0, 0), K
_Dest 0
_MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
_FreeImage a& '<<< this is important!
End Sub
Sub ln (x1, y1, x2, y2, K As _Unsigned Long)
Line (x1, y1)-(x2, y2), K
End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long, c As _Unsigned Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY), c: Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
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
b = b + ...
