Hi guys. I'm new to this forum. Please check out all my contributions.
Here is my freebasic game for you all to enjoy.
"Coin Hunt!"
Posting Source Code soon!
electricwalrus
Source code:
Dim i as integer
Dim ii as integer
Dim iii as integer
Dim CoinCount as integer
Dim MonsterCount as integer
Dim CoinX(500) as byte
Dim CoinY(500) As byte
Dim MonsterX(500) as byte
Dim MonsterY(500) As byte
Dim PlayerX as byte
Dim PlayerY AS Byte
Dim MonsterOnCoin as boolean
Dim CoinsCollected as integer
Dim Score as integer
Dim Level as integer
Dim Lives as Byte
Dim Cycle as Byte
Declare Sub UpdateScore(score as integer, level as integer, lives as integer)
Randomize Timer
Screen 19
' Welcome Screen
CLS
Color 14
Locate 17,35
Print "---- Welcome to Coin Hunt! ---"
Locate 18,35
Print " MagicalWizzy (2022)"
Locate 20,20
Print "Collect all the coins without being attacked by the monsters :)"
Locate 21,35
Print " Press any key to begin."
Sleep
' First Start Variables
Cycle = 1
Score = 0
Level = 1
Lives = 3
RestartLevel:
' Draw Border
Cls
Color 9
Print chr(201);: For i=1 to 98: Print chr(205);: Next: Print chr(187);
For ii = 2 to 36
Locate ii,1: Print Chr(186)
Locate ii,100: Print Chr(186);
Next
Print chr(200);: For i=1 to 98: Print chr(205);: Next: Print chr(188);
Color 15
Locate 1, 36: Print " Coin Hunt! by MagicalWizzy "
PlayerX = 51
PlayerY = 18
CoinCount = 20 + (Level - 1) * 5
MonsterCount = 10 + (Level - 1) * 5
MonsterOnCoin = False
CoinsCollected = 0
UpdateScore(Score,Level,Lives)
' Draw Coins and Monsters
For i = 1 to CoinCount
redocoin:
CoinX(i) = int(rnd*98)+2
CoinY(i) = int(rnd*35)+2
if CoinX(i) = PlayerX And CoinY(i) = PlayerY Then
goto redocoin
end if
next
For i = 1 to MonsterCount
RegenMonster:
MonsterX(i) = int(rnd*98)+2
MonsterY(i) = int(rnd*35)+2
' Check if Monster is too close to player.
if MonsterY(i) >= 16 AND MonsterY(i) <= 20 And MonsterX(i) >= 49 AND MonsterX(i) <= 53 Then goto RegenMonster
next
' Draw Coins and Monsters
Color 14
For i = 1 to CoinCount
Locate CoinY(i), CoinX(i)
Print chr(248);
next
Color 12
For i = 1 to MonsterCount
Locate MonsterY(i), MonsterX(i)
Print chr(234);
next
' Draw Player
Color 15
Locate PlayerY,PlayerX
Print chr(153);
' Main Game Loop
Do
' Check if Player moves...
If MultiKey(1) then
' Escape pressed, close game
end
End if
If Cycle = 2 then
Cycle = 1
Color 15
If MultiKey(77) then
Locate PlayerY, PlayerX
Print " ";
PlayerX = PlayerX + 1
If PlayerX >= 99 then PlayerX = 99
Locate PlayerY, PlayerX
Print chr(153);
end if
If MultiKey(75) then
Locate PlayerY, PlayerX
Print " ";
PlayerX = PlayerX - 1
If PlayerX <= 2 then PlayerX = 2
Locate PlayerY, PlayerX
Print chr(153);
end if
If MultiKey(72) then
Locate PlayerY, PlayerX
Print " ";
PlayerY = PlayerY - 1
If PlayerY <= 2 then PlayerY = 2
Locate PlayerY, PlayerX
Print chr(153);
end if
If MultiKey(80) then
Locate PlayerY, PlayerX
Print " ";
PlayerY = PlayerY + 1
If PlayerY >= 36 then PlayerY = 36
Locate PlayerY, PlayerX
Print chr(153);
end if
Else
Cycle = 2
end if
' Check if monster eats player
For i = 1 to MonsterCount
If PlayerX = MonsterX(i) And PlayerY = MonsterY(i) Then
Locate 17,32
Color 11
Print "A monster just ate you for breakfast!"
Beep
Sleep 5000, 1
Beep
Lives = Lives - 1
If Lives = 0 then end
Goto RestartLevel
end if
next
' Check if Player found a Coin.
for i = 1 to CoinCount
if PlayerX = CoinX(i) and PlayerY = CoinY(i) then
CoinsCollected = CoinsCollected + 1
' Way to ignore coin once collected
CoinX(i) = 0
Score = Score + 1
UpdateScore(Score, Level, Lives)
end if
next
' Problems with coins disappearing - redrawing all coins
Color 14
For i = 1 to CoinCount
If CoinX(i) <> 0 Then
Locate CoinY(i), CoinX(i)
Print chr(248);
end if
next
' Move monsters about
For i = 1 to MonsterCount
' Check if a coin is under the monster.
For iii = 1 to CoinCount
if CoinX(iii) = MonsterX(i) AND CoinY(iii) = MonsterY(i) Then
if CoinX(i) <> 0 Then
MonsterOnCoin = True
End if
end if
next
ii = int(rnd*6)+1
Color 14
Select Case ii
case 1
Locate MonsterY(i), MonsterX(i)
If MonsterOnCoin = True then Print chr(248); Else Print " ";
MonsterX(i) = MonsterX(i) - 1
If MonsterX(i) <= 2 then MonsterX(i) = 2
Case 2
Locate MonsterY(i), MonsterX(i)
If MonsterOnCoin = True then Print chr(248); Else Print " ";
MonsterX(i) = MonsterX(i) + 1
If MonsterX(i) >= 99 then MonsterX(i) = 99
Case 3
Locate MonsterY(i), MonsterX(i)
If MonsterOnCoin = True then Print chr(248); Else Print " ";
MonsterY(i) = MonsterY(i) - 1.
If MonsterY(i) <= 2 then MonsterY(i) = 2
Case 4
Locate MonsterY(i), MonsterX(i)
If MonsterOnCoin = True then Print chr(248); Else Print " ";
MonsterY(i) = MonsterY(i) + 1
If MonsterY(i) >= 36 then MonsterY(i) = 36
Case 5
' Monster stays still
Case 6
' Also stays still
end select
MonsterOnCoin = False
Color 12
Locate MonsterY(i), MonsterX(i)
Print chr(234);
next
' Check if monster eats player
For i = 1 to MonsterCount
If PlayerX = MonsterX(i) And PlayerY = MonsterY(i) Then
Locate 17,32
Color 11
Print "A monster just ate you for breakfast!"
Beep
Sleep 5000, 1
Beep
Lives = Lives - 1
If Lives = 0 then
cls
Print "You got " + str(Score) + " coins. Well done. You did well. Game over."
Sleep 5000, 1
end
End if
Goto RestartLevel
end if
next
If CoinsCollected >= CoinCount Then
Locate 17,28
Color 11
Print "Great Job - You got all the coins! Level up."
Beep
Sleep 3000, 1
Beep
Level = Level + 1
Goto RestartLevel
end if
Sleep 70,1
loop
beep
Sleep
End
Private Sub UpdateScore(score as integer, level as integer, lives as integer)
Dim i as byte
Locate 37,1
Color 9
Print chr(200);: For i=1 to 98: Print chr(205);: Next: Print chr(188);
Color 11
Locate 37, 3
Print " Score: " + str(score) + " ";
Locate 37, 46
Print " Level: " + str(level) + " ";
Locate 37, 89
Print " Lives: " + str(lives) + " ";
end sub
welcome electricwalrus!!! we are so happy to have you here with us :) and looking forward to see more of your fine programs! thank you so much for joining us!
not a problem :)
Screenshot:
Cool game... Took a few attempts to get to level 2... unfortunately, I did not last very long... lol But still a cool game. Thank you.
J
I ported to SpecBAS :)
Because SpecBAS doesn't run in a console window, I took some liberties with the base game - movement is now pixel by pixel rather than character based, and I've animated the coins and used custom characters (UDGs) for the graphics.
As the movement is now pixel-based, it's far too easy to avoid the monsters so now when a monster "sees" you within a small distance from itself, it will start to chase you. It's also slightly faster than you so you have to move diagonally to gain a boost in speed (which is a side-effect of orthogonal movement routines). It's quite a challenge, as monsters get faster as you progress through the levels.
(https://i.ibb.co/Zx88vtL/screenshot-1809.png)
I'll post source in the SpecBAS sub-forum when I'm done testing and tidying up.
Edit: Lol, bug in the bottom-right - that coin shouldn't be there :D
On one hand its not very likely someone plays up to level 98, but then the somewhat arbitrary number of 500 array elements for coins are not enough. Still it would be better to use dynamic arrays and just `ReDim` them to the actual needed size.
`CoinCount` and `MonsterCount` can then be removed/replaced by `UBound(...)`.
The `Goto`s when creating coins and monsters can be replaced by loops. The other `Goto`s can be replaced by `Exit Sub`s if the mainloop is moved to a `Sub`.
Coins, monsters, and the player are represented by X and Y coordinates and all game pieces share some functionality, so it would make sense to introduce a `Type` for the position und some functions to operate on/with such positions. It spares some repeated code fragments and function/sub names make the code easier to understand.
Some colors and characters are better defined as constants.
Const CoinColor = 14, MonsterColor = 12, PlayerColor = 15
Const CoinCharacter = chr(248), MonsterCharacter = chr(234)
Const PlayerCharacter = chr(153)
Type TPosition
Dim X as byte
Dim Y as byte
End Type
Declare Function IsValid (position as Const TPosition) as boolean
Declare Sub Invalidate (position as TPosition)
Declare Function IsAtSamePosition (a as Const TPosition, b as Const TPosition) as boolean
Declare Function CheckCollisions (position as Const TPosition, others() as TPosition, doInvalidate as boolean) as integer
Declare Sub SetRandom (position as TPosition)
Declare Sub MoveLeft (position as TPosition)
Declare Sub MoveRight (position as TPosition)
Declare Sub MoveUp (position as TPosition)
Declare Sub MoveDown (position as TPosition)
Declare Sub PrintAt (position as Const TPosition, text as Const String)
Declare Sub PlayLevel (ByRef score as integer, ByRef level as integer, ByRef lives as byte)
Declare Sub UpdateScore (score as integer, level as integer, lives as integer)
Dim Score as integer
Dim Level as integer
Dim Lives as byte
Randomize Timer
Screen 19
' Welcome Screen
Cls
Color 14
Locate 17, 35
Print "---- Welcome to Coin Hunt! ---"
Locate 18, 35
Print " MagicalWizzy (2022)"
Locate 20, 20
Print "Collect all the coins without being attacked by the monsters :)"
Locate 21, 35
Print " Press any key to begin."
Sleep
' First Start Variables
Score = 0
Level = 1
Lives = 3
Do
PlayLevel Score, Level, Lives
Loop
Private Function IsValid (position as Const TPosition) as boolean
IsValid = position.X <> 0
End Function
Private Sub Invalidate (position as TPosition)
position.X = 0
End Sub
Private Function IsAtSamePosition (a as Const TPosition, b as Const TPosition) as boolean
IsAtSamePosition = a.X = b.X AndAlso a.Y = b.Y
End Function
Private Function CheckCollisions (position as Const TPosition, others() as TPosition, doInvalidate as boolean) as integer
Dim count as integer = 0, i as integer
For i = 1 to UBound(others)
If IsAtSamePosition(position, others(i)) Then
count = count + 1
If doInvalidate Then Invalidate(others(i))
End If
Next
CheckCollisions = count
End Function
Private Sub SetRandom (position as TPosition)
position.X = Int(Rnd * 98) + 2: position.Y = Int(Rnd * 35) + 2
End Sub
Private Sub MoveLeft (position as TPosition)
position.X = position.X - 1
If position.X <= 2 Then position.X = 2
End Sub
Private Sub MoveRight (position as TPosition)
position.X = position.X + 1
If position.X >= 99 Then position.X = 99
End Sub
Private Sub MoveUp (position as TPosition)
position.Y = position.Y - 1
If position.Y <= 2 Then position.Y = 2
End Sub
Private Sub MoveDown (position as TPosition)
position.Y = position.Y + 1
If position.Y >= 36 Then position.Y = 36
End Sub
Private Sub PrintAt (position as Const TPosition, text as Const String)
If IsValid(position) Then Locate position.Y, position.X: Print text;
End Sub
Sub PlayLevel (ByRef score as integer, ByRef level as integer, ByRef lives as byte)
Dim isOddCycle as boolean
Dim i as integer, coinsCollected as integer = 0
Dim player as TPosition = (51, 18)
Dim coins(20 + (level - 1) * 5) as TPosition
Dim monsters(10 + (level - 1) * 5) as TPosition
' Draw Border
Cls
Color 9
Print chr(201);: For i=1 to 98: Print chr(205);: Next: Print chr(187);
For i = 2 to 36
Locate i, 1: Print Chr(186)
Locate i, 100: Print Chr(186);
Next
Print chr(200);: For i=1 to 98: Print chr(205);: Next: Print chr(188);
Color 15
Locate 1, 36: Print " Coin Hunt! by MagicalWizzy "
UpdateScore score, level, lives
' Initialise and draw Coins and Monsters
For i = 1 to UBound(coins)
Do
SetRandom coins(i)
Loop While IsAtSamePosition(coins(i), player)
Next
For i = 1 to UBound(monsters)
Do
SetRandom monsters(i)
' Check if Monster is too close to player.
Loop Until Abs(monsters(i).Y - player.Y) > 4 _
And Abs(monsters(i).X - player.X) > 4
Next
' Draw Coins and Monsters
Color CoinColor
For i = 1 to UBound(coins)
PrintAt coins(i), CoinCharacter
Next
Color MonsterColor
For i = 1 to UBound(monsters)
PrintAt monsters(i), MonsterCharacter
Next
' Draw Player
Color PlayerColor
PrintAt player, PlayerCharacter
' Main Game Loop
Do
' Check if Player moves...
If MultiKey(1) Then End ' Escape pressed, close game
isOddCycle = Not isOddCycle
If isOddCycle Then
Color PlayerColor
PrintAt player, " "
If MultiKey(77) Then MoveRight Player
If MultiKey(75) Then MoveLeft player
If MultiKey(72) Then MoveUp player
If MultiKey(80) Then MoveDown player
PrintAt player, PlayerCharacter
End If
' Check if monster eats player
If CheckCollisions(player, monsters(), False) <> 0 Then
Locate 17, 32
Color 11
Print "A monster just ate you for breakfast!"
Beep
Sleep 5000, 1
Beep
lives = lives - 1
If lives = 0 Then End
Exit Sub
End If
' Check if Player found coins.
i = CheckCollisions(player, coins(), True)
If i > 0 Then
coinsCollected = coinsCollected + i
score = score + i
UpdateScore score, level, lives
End If
' Problems with coins disappearing - redrawing all coins
Color CoinColor
For i = 1 to UBound(coins)
PrintAt coins(i), CoinCharacter
Next
' Move monsters about.
For i = 1 to UBound(monsters)
Color CoinColor
PrintAt monsters(i), _
IIf(CheckCollisions(monsters(i), coins(), False) <> 0, _
CoinCharacter, " ")
Select Case int(rnd*6)+1
Case 1: MoveLeft monsters(i)
Case 2: MoveRight monsters(i)
Case 3: MoveUp monsters(i)
Case 4: MoveDown monsters(i)
Case Else ' Monster stays still
End Select
Color MonsterColor
PrintAt monsters(i), MonsterCharacter
Next
' Check if monster eats player
If CheckCollisions(player, monsters(), False) <> 0 Then
Locate 17, 32
Color 11
Print "A monster just ate you for breakfast!"
Beep
Sleep 5000, 1
Beep
lives = lives - 1
If lives = 0 Then
Cls
Print "You got"; score; " coins. Well done. You did well. Game over."
Sleep 5000, 1
end
End If
Exit Sub
End If
If coinsCollected >= UBound(coins) Then
Locate 17,28
Color 11
Print "Great Job - You got all the coins! Level up."
Beep
Sleep 3000, 1
Beep
level = level + 1
Exit Sub
End If
Sleep 70, 1
Loop
Beep: Sleep: End
End Sub
Private Sub UpdateScore (score as integer, level as integer, lives as integer)
Dim i as byte
Color 9
Locate 37, 1
Print chr(200);: For i=1 to 98: Print chr(205);: Next: Print chr(188);
Color 11
Locate 37, 3
Print " Score:"; score; " ";
Locate 37, 46
Print " Level:"; level; " ";
Locate 37, 89
Print " Lives:"; lives; " ";
End Sub
It's still almost QBasic compatible, i.e. it uses almost no FreeBASIC-specific features that can't be removed easily. No operator overloading for instance, which would really make sense for the `=` operator for instance. Or methods on the position type.