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
b = b + ...