- Welcome to RetroCoders Community.
Recent posts
#21
FreeBasic Game Dev / Re: Ski Slope by electricwalru...
Last post by __blackjack__ - Aug 03, 2025, 02:11 PMIt's easy to get rid of the GOTOs. The one for the `start:` label is just a DO ... LOOP around the code and the other two are an EXIT DO to exit the game loop.
And the game just needs three variables. The others can be removed. `i` isn't needed when the value is checked with a SELECT CASE statement. The expression defining `x2` can be inserted in the only place where `x2` is used. `a` is for a loop that can be replaced by a LOCATE. And for `check` we can use SELECT CASE again.
And the game just needs three variables. The others can be removed. `i` isn't needed when the value is checked with a SELECT CASE statement. The expression defining `x2` can be inserted in the only place where `x2` is used. `a` is for a loop that can be replaced by a LOCATE. And for `check` we can use SELECT CASE again.
Randomize Timer
Screen 17 ' Ideal Screen Size (80x25 characters)
' Welcome
Color 2
Print "Ski Slope Challenge! By electricwalrus (2022)"
Print "Try to last on this slope as long as possible"
Print
Print "Use the arrow keys to move left and right down the slope"
Print
Print "Press any key to begin!"
Sleep
Dim score As Integer, x As Integer, player As Integer
Do
Cls
Print "Get Ready!"
Sleep 1000, 1
score = 0: x = 40: player = x
Do
Select Case Int(Rnd * 2)
Case 0: If x > 10 Then x = x - 1
Case 1: If x < 70 Then x = x + 1
End Select
Locate 25, x - 9: Color 11: Print "* *";
If MultiKey(1) Then End
If MultiKey(75) Then player = player - 1
If MultiKey(77) Then player = player + 1
Select Case player - x
Case Is < -8, Is > 6: Exit Do
End Select
Locate 25, player: Color 10: Print "!!"
Sleep 100, 1
score = score + 1
Loop
Beep
Sleep 1000, 1
Cls
Locate 1, 1
Color 6
Print "You crashed on the ski-field!"
Print "Score:"; score
Print
Color 15
Print "Try Again in 5 seconds"
Sleep 5000, 1
Loop
#22
FreeBasic Game Dev / Re: Coin Hunt - Freebasic Comp...
Last post by __blackjack__ - Aug 02, 2025, 09:30 PMOn 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.
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.
`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.
#23
General Discussion / Re: Greetings
Last post by CharlieJV - Jul 27, 2025, 03:25 PMA belated "Welcome!"
Every one of us floats around from forum to forum, as "activity" in any forum increases/decreases.
If you haven't already, also visit the "GotBASIC" discord. You'll find the link for it in the "Love BASIC?" section of the following page: https://gotbasic.com/
Every one of us floats around from forum to forum, as "activity" in any forum increases/decreases.
If you haven't already, also visit the "GotBASIC" discord. You'll find the link for it in the "Love BASIC?" section of the following page: https://gotbasic.com/
#24
FreeBasic / Re: one of my first programs i...
Last post by __blackjack__ - Jul 25, 2025, 05:30 PMBit masks... 
#25
FreeBasic / Re: Battle Simulation
Last post by __blackjack__ - Jul 25, 2025, 03:17 PMThe `turn` variable has no effect, because the IF tests are always true. I guess that's a bug.
#26
FreeBasic / Re: mishka's clock
Last post by __blackjack__ - Jul 25, 2025, 03:06 PMThere's a bug in the clock program: hour, minute, and sec are defined by three independent calls to TIME$. But time goes by between those calls and there's a chance that the values don't refer to the same point in time. For instance if the time at the beginning of the first call is 05:59:59.9999 the result from the calls might be 5, 0, and 0.
But that's simple to fix:
But that's simple to fix:
t$ = TIME$
hour = VAL(LEFT$(t$, 2))
minute = VAL(MID$(t$, 4, 2))
sec = VAL(RIGHT$(t$, 2))
#27
FreeBasic / Re: Conway's game of life
Last post by __blackjack__ - Jul 25, 2025, 02:30 PM@Tomaaz: Well that's cheating. You are simply storing two arrays in one array. At the expense of code readability. And that's even unnecessary because you could have used one array with three dimensions. One dimension each for X, Y, and "generation" for two generations. That would make it possible to make the program even more efficient. Instead of copying the new generation to the old one, it would be possible just to switch the generation index then.
#28
FreeBasic / Re: Dancer Demo
Last post by __blackjack__ - Jul 23, 2025, 08:47 PMThere is an array out of bounds error with `Cor`. Initialising this with -1 leads to `Cor` being 15 and then this value being used as index into the just 9 element long `CP_Cores` array.
#29
FreeBasic / Re: FreeBasic Console Game - A...
Last post by __blackjack__ - Jul 23, 2025, 04:44 PM`SLEEP` is a problem here as it waits for a key press but doesn't clear the keyboard buffer, so whatever you press will show up at the `INPUT` later. FreeBASIC has `GetKey` for waiting and removing the key from the buffer.
`over` has the exact opposite meaning as one would expect here. It would also be cleaner not to set a global flag but to return the status from `game_turn`.
The five `CASE 1`, `CASE 2`, ..., `CASE 5` with always the same code can be merged into one `CASE 1 TO 5`. The other `SELECT CASE` construct and the happy and sad variables can be replaced by arrays with the reaction text and an array to count how often which result was randomly chosen.
Then the main loop is simple enough to get rid of the subroutines:
`over` has the exact opposite meaning as one would expect here. It would also be cleaner not to set a global flag but to return the status from `game_turn`.
The five `CASE 1`, `CASE 2`, ..., `CASE 5` with always the same code can be merged into one `CASE 1 TO 5`. The other `SELECT CASE` construct and the happy and sad variables can be replaced by arrays with the reaction text and an array to count how often which result was randomly chosen.
Then the main loop is simple enough to get rid of the subroutines:
enum TResult
SUCCESS, NEUTRAL, FAILED, MAX = FAILED
end enum
dim reactions(TResult.MAX) as string = { "is happy", "is apathetic", "cries" }
dim stats(TResult.MAX) as integer, choice as integer, result as TResult
Randomize
do
Cls
print "It's a new day in 1988."
print "Options:"
print "1. Feed Avishai"
print "2. Give him medications"
print "3. Take him to the public garden"
print "4. Play music for him"
print "5. Put Avishai to bed"
print "6. Exit the game"
input choice
Cls
select case choice
case 1 to 5
result = Cast(TResult, Int(Rnd * (TResult.MAX + 1)))
print "Avishai "; reactions(result); "."
stats(result) += 1
case 6
print "Exiting the game."
GetKey
exit do
case else
print "Invalid choice. Try again."
end select
GetKey
loop
locate 20, 1
print "Avishai was happy"; stats(SUCCESS); " times."
print "Avishai was sad"; stats(FAILED); " times."
GetKey
#30
FreeBasic / Re: super simple Matrix Rain s...
Last post by __blackjack__ - Jul 23, 2025, 02:08 PM`q` doesn't make any sense here. Even in QBasic on an old DOS machine this would just cause a non noticeable delay.
`A`, `B`, and `x` are not really needed either. All three are just used once, so we could just use the expressions used to define their values instead of the variables.
Instead of hard coding the limits of the random numbers for row and column it would be more flexible to query the number of rows and columns for the active screen mode. Then it would also be possible to centre the message on the screen.
`A`, `B`, and `x` are not really needed either. All three are just used once, so we could just use the expressions used to define their values instead of the variables.
Instead of hard coding the limits of the random numbers for row and column it would be more flexible to query the number of rows and columns for the active screen mode. Then it would also be possible to centre the message on the screen.
'THIS IS A MATRIX PROGRAM, BY JOHN. W. SZCZEPANIAK
' converted from qb to fb by ron77 2023-08-25
RANDOMIZE: SCREEN 19
DIM i AS LONG, rows AS INTEGER, columns AS INTEGER, text AS STRING
i = WIDTH: rows = HIWORD(i): columns = LOWORD(i)
COLOR 2 ' Green
DO
LOCATE INT(RND * (rows - 1)) + 1, INT(RND * (columns - 1)) + 1
PRINT CHR(INT(RND * 227) + 28)
SLEEP 5 ' about 200 characters per second.
LOOP UNTIL INKEY <> "" ' = CHR(27)
CLS
text = "THE MATRIX HAS YOU"
LOCATE rows \ 2, (columns - LEN(text)) \ 2
PRINT text
SLEEP