OK so here is "Basic Chase and Prize 2 - with Face, fresh off the presses, the "give me a break!" version:
Code: (Select All)
_Title "Basic Chase and Prize Game - With a Face" ' b+ 2023-03-24, 2023-04-01, 2023-04-02, 2023-06-13
Randomize Timer
Const cellW = 30
Type XY
As Long x, y
End Type
Dim doomer(1 To 5) As XY
Dim prize(1 To 5) As XY
Screen _NewImage(1200, 600, 32) '40 x 20
_ScreenMove 50, 50
_MouseHide
Do
Cls
k$ = InKey$
yCP 100, "*** Basic Chase and Prize Game ***"
_PrintString (550, 200), "Hero"
makeFace 650, 200
_PrintString (550, 250), "Prize"
drawstar 650, 250
_PrintString (550, 300), "Doom!"
toggle = 1 - toggle
monster 650, 300, toggle
yCP 350, "Object: Use NumberPad to Collect prizes,"
yCP 370, "don't let Doom come to Hero!"
yCP 500, "press any to start...."
_Display
_Limit 5
Loop Until Len(k$)
Color , &HFF009900: Cls
While _KeyDown(27) = 0
DoomMoves = 20
dooms = 1
HeroX = 20: HeroY = 10
score = 0
prize(dooms).x = Int(Rnd * 40) + 1: prize(dooms).y = Int(Rnd * 20) + 1
doomer(dooms).x = Int(Rnd * 40) + 1: doomer(dooms).y = Int(Rnd * 20) + 1
Do
Cls ' screen update
lc2 = lc2 + 1
If lc2 >= 10 Then toggle = 1 - toggle: lc2 = 0
makeFace HeroX * cellW - .5 * cellW, HeroY * cellW - .5 * cellW
For i = 1 To dooms
monster doomer(i).x * cellW - .5 * cellW, doomer(i).y * cellW - .5 * cellW, toggle
drawstar prize(i).x * cellW - .5 * cellW, prize(i).y * cellW - .5 * cellW
Next
For i = 1 To dooms
If HeroX = prize(i).x And HeroY = prize(i).y Then
score = score + 1
prize(i).x = Int(Rnd * 40) + 1: prize(i).y = Int(Rnd * 20) + 1
If DoomMoves > 16 Then DoomMoves = DoomMoves - 1
If dooms < 4 Then
dooms = dooms + 1
prize(dooms).x = Int(Rnd * 40) + 1: prize(dooms).y = Int(Rnd * 20) + 1
End If
For j = 1 To dooms
doomer(j).x = Int(Rnd * 40) + 1: doomer(j).y = Int(Rnd * 20) + 1
Next
Else
If doomer(i).x = HeroX And doomer(i).y = HeroY Then
yCP 18 * 16, "Game Over ...ZZZ"
Beep: _Display: _Delay 3: _KeyClear: Sleep: Exit Do
End If
End If
Next
_Title "Basic Chase and Prize Game - Prize Winning Edition Prizes:" + Str$(score)
kh& = _KeyHit
Select Case kh& ' top left to bottom right
Case 55, 18176 ' up and left
DX = -1: DY = -1
Case 56, 18432 ' up
DX = 0: DY = -1
Case 57, 18688 ' up and right
DX = 1: DY = -1
Case 52, 19200 ' left
DX = -1: DY = 0
Case 54, 19712 ' right
DX = 1: DY = 0
Case 49, 20224 ' left and down
DX = -1: DY = 1
Case 50, 20480 ' down
DX = 0: DY = 1
Case 51, 20736 ' down and right
DX = 1: DY = 1
Case Else
DX = 0: DY = 0
End Select
testX = HeroX + DX: testY = HeroY + DY
If testX > 0 And testX < 81 And testY > 0 And testY < 31 Then
HeroX = testX: HeroY = testY
End If
lc = lc + 1
If lc >= DoomMoves Then
For i = 1 To dooms
' move x or y but not both
dmx = doomer(i).x: dmy = doomer(i).y
If Rnd < .5 Then ' try x first
doomer(i).x = doomer(i).x + Sgn(HeroX - doomer(i).x)
Else ' try y first
doomer(i).y = doomer(i).y + Sgn(HeroY - doomer(i).y)
End If
Next
lc = 0
End If
_Display
_Limit 30
Loop Until _KeyDown(27)
Wend
Sub makeFace (x, y)
fcirc x, y, cellW / 2.5, &HFF88AAFF
fcirc x - 3 * cellW / 24, y, cellW / 14, &HFFFFFFFF
fcirc x + 3 * cellW / 24, y, cellW / 14, &HFFFFFFFF
fcirc x - 3 * cellW / 24, y + 1, cellW / 28, &HFF000000
fcirc x + 3 * cellW / 24, y + 1, cellW / 28, &HFF000000
Line (x - cellW / 12, y + cellW / 6 + 2)-Step(cellW / 6, 2), &HFFFF4444, BF
End Sub
Sub monster (x, y, mouth)
fcirc x, y, cellW / 2.5, &HFF990000
If mouth Then
Line (x - cellW / 6, y - 6)-Step(cellW / 18, 1), &HFF000000, BF
Line (x + cellW / 12, y - 6)-Step(cellW / 18, 1), &HFF000000, BF
fcirc x, y + cellW / 6, cellW / 6, &HFF000000
Else
Line (x - cellW / 6, y - 2)-Step(cellW / 18, 1), &HFF000000, BF
Line (x + cellW / 12, y - 2)-Step(cellW / 18, 1), &HFF000000, BF
Line (x - cellW / 12, y + cellW / 6)-Step(cellW / 6, 2), &HFF000000, BF
End If
End Sub
Sub drawstar (x, y)
Star x, y, .19 * cellW, .5 * cellW, 5, 18, &HFFFFFF00, -1
End Sub
Sub Star (x, y, rInner, rOuter, nPoints, angleOffset, c~&, TFfill)
' x, y are same as for circle,
' rInner is center circle radius
' rOuter is the outer most point of star
' nPoints is the number of points,
' angleOffset = angle offset IN DEGREES, it will be converted to radians in sub
' this is to allow us to spin the polygon of n sides
' TFfill filled True or False (1 or 0)
p_angle = _D2R(360 / nPoints): rad_angle_offset = _D2R(angleOffset)
x1 = x + rInner * Cos(rad_angle_offset)
y1 = y + rInner * Sin(rad_angle_offset)
For i = 0 To nPoints - 1
x2 = x + rOuter * Cos(i * p_angle + rad_angle_offset + .5 * p_angle)
y2 = y + rOuter * Sin(i * p_angle + rad_angle_offset + .5 * p_angle)
x3 = x + rInner * Cos((i + 1) * p_angle + rad_angle_offset)
y3 = y + rInner * Sin((i + 1) * p_angle + rad_angle_offset)
Line (x1, y1)-(x2, y2), c~&
Line (x2, y2)-(x3, y3), c~&
x1 = x3: y1 = y3
Next
If TFfill Then
'Circle (x, y), 2, &HFFFFFFFF
Paint (x, y), c~&, c~&
End If
End Sub
Sub yCP (y, s$) 'for xmax pixel wide graphics screen
_PrintString ((_Width - Len(s$) * 8) / 2, y), s$
End Sub
Sub fcirc (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
724 855 599 923 575 468 400 206 147 564 878 823 652 556 bxor cross forever
