This is my first game. I make it with help from QB64_GPT.
Enjoy the Game
Guslouk
To be continue.
Assets.zip (Size: 238.69 KB / Downloads: 23)
Code: (Select All)
' Here is my first game created with help QB64_GPT.
' Name app "SokoGus v0.01"
' Created by Gus and QB64_GPT 07-03-2024.
OPTION _EXPLICIT
CONST MapWidth = 30
CONST MapHeight = 12
CONST TileWidth = 64
CONST TileHeight = 64
TYPE Tile
Symbol AS STRING * 1
IsBox AS INTEGER
IsGoal AS INTEGER
HasBox AS INTEGER
HasPlayer AS INTEGER
END TYPE
TYPE Box
X AS INTEGER
Y AS INTEGER
Symbol AS STRING * 1
END TYPE
DIM SHARED Boxes(6) AS Box
DIM SHARED key$
DIM SHARED levelMap(1 TO 25) AS STRING * 25
DIM SHARED tileSymbol AS STRING
DIM SHARED MapTiles(MapWidth, MapHeight) AS Tile
DIM SHARED PlayerX, PlayerY
DIM SHARED NumGoals, GoalsCompleted
DIM SHARED GoalsCoveredCount AS INTEGER
DIM SHARED prevX AS INTEGER
DIM SHARED prevY AS INTEGER
DIM SHARED newX AS INTEGER
DIM SHARED newY AS INTEGER
DIM SHARED newBoxX AS INTEGER
DIM SHARED newBoxY AS INTEGER
DIM SHARED fontfile$
DIM SHARED f&
DIM SHARED ascIIcode AS SINGLE
DIM SHARED unicode
DIM SHARED currentTile AS Tile
DIM SHARED boxTile AS Tile
DIM SHARED newTile AS Tile
' Icons
DIM SHARED playerIcon AS LONG
DIM SHARED boxIcon AS LONG
DIM SHARED goalIcon AS LONG
DIM SHARED emptyTileIcon AS LONG
DIM SHARED boxOnGoalIcon AS LONG
DIM SHARED playerOnGoalIcon AS LONG
DIM SHARED wallIcon AS LONG
DIM SHARED folder$
folder$ = "D:\qb64pe\Assets\"
SCREEN _NEWIMAGE(1264, 878, 32) ' Create new screen
' Load a font that supports Greek characters
fontfile$ = "C:\windows\fonts\lucon.ttf"
f& = _LOADFONT(fontfile$, 20, "MONOSPACE")
_FONT f&
' Load icons and check for errors
playerIcon = _LOADIMAGE(folder$ + "player.png", 32)
boxIcon = _LOADIMAGE(folder$ + "box.png", 32)
goalIcon = _LOADIMAGE(folder$ + "goal.png", 32)
emptyTileIcon = _LOADIMAGE(folder$ + "empty.png", 32)
boxOnGoalIcon = _LOADIMAGE(folder$ + "boxOnGoal.png", 32)
playerOnGoalIcon = _LOADIMAGE(folder$ + "playerOnGoal.png", 32)
wallIcon = _LOADIMAGE(folder$ + "wall.png", 32)
' Initialize GoalsCoveredCount to 0
GoalsCoveredCount = 0
' Initialize the game
InitializeGame
' Load level 1
LoadLevel 1
DO
_LIMIT 60
DrawMap
_DISPLAY
DO
key$ = INKEY$
IF LEN(key$) > 0 THEN EXIT DO
LOOP
IF key$ = CHR$(27) THEN EXIT DO ' Exit on Escape key
newX = PlayerX
newY = PlayerY
SELECT CASE UCASE$(key$)
CASE "W", CHR$(0) + CHR$(72) ' Up arrow or "w" key
newY = PlayerY - 1
CASE "S", CHR$(0) + CHR$(80) ' Down arrow or "s" key
newY = PlayerY + 1
CASE "A", CHR$(0) + CHR$(75) ' Left arrow or "a" key
newX = PlayerX - 1
CASE "D", CHR$(0) + CHR$(77) ' Right arrow or "d" key
newX = PlayerX + 1
END SELECT
' Check player movement
IF newX >= 1 AND newX <= MapWidth AND newY >= 1 AND newY <= MapHeight THEN
IF MapTiles(newX, newY).Symbol = " " OR MapTiles(newX, newY).Symbol = "." THEN
MovePlayer newX, newY
ELSEIF MapTiles(newX, newY).Symbol = "$" OR MapTiles(newX, newY).Symbol = "*" THEN
newBoxX = newX + (newX - PlayerX)
newBoxY = newY + (newY - PlayerY)
IF newBoxX >= 1 AND newBoxX <= MapWidth AND newBoxY >= 1 AND newBoxY <= MapHeight THEN
IF MapTiles(newBoxX, newBoxY).Symbol = " " OR MapTiles(newBoxX, newBoxY).Symbol = "." THEN
MoveBox newX, newY, newBoxX, newBoxY
MovePlayer newX, newY
END IF
END IF
END IF
END IF
LOOP UNTIL GoalsCompleted = NumGoals
CLS
PRINT "Congratulations! You completed the level."
END
' Subroutine to draw the map
SUB DrawMap
DIM x AS INTEGER
DIM y AS INTEGER
CLS
FOR y = 1 TO MapHeight
FOR x = 1 TO MapWidth
SELECT CASE MapTiles(x, y).Symbol
CASE "@"
IF playerIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), playerIcon
CASE "$"
IF MapTiles(x, y).IsGoal THEN
IF boxOnGoalIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), boxOnGoalIcon
ELSE
IF boxIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), boxIcon
END IF
CASE "."
IF goalIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), goalIcon
CASE " "
IF emptyTileIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), emptyTileIcon
CASE "+"
IF playerOnGoalIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), playerOnGoalIcon
CASE "*"
IF boxOnGoalIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), boxOnGoalIcon
CASE "#"
IF wallIcon <> -1 THEN _PUTIMAGE (x * TileWidth, y * TileHeight), wallIcon
END SELECT
NEXT x
NEXT y
GreekChange
_PRINTSTRING (10, 10), "Goals completed: " + STR$(GoalsCoveredCount) + "/" + STR$(NumGoals)
EnglChange
END SUB
' Subroutine to move the player
SUB MovePlayer (newX, newY)
prevX = PlayerX
prevY = PlayerY
' Update the tile the player is leaving
currentTile = MapTiles(prevX, prevY)
IF currentTile.IsGoal = 1 THEN
MapTiles(prevX, prevY).Symbol = "."
ELSE
MapTiles(prevX, prevY).Symbol = " "
END IF
' Move the player to the new position
PlayerX = newX
PlayerY = newY
' Update the tile the player is moving to
currentTile = MapTiles(PlayerX, PlayerY)
IF currentTile.IsGoal = 1 THEN
MapTiles(PlayerX, PlayerY).Symbol = "+"
ELSE
MapTiles(PlayerX, PlayerY).Symbol = "@"
END IF
END SUB
' Subroutine to move a box
SUB MoveBox (boxX AS INTEGER, boxY AS INTEGER, newBoxX AS INTEGER, newBoxY AS INTEGER)
DIM i AS INTEGER
boxTile = MapTiles(boxX, boxY)
newTile = MapTiles(newBoxX, newBoxY)
IF newTile.Symbol = "." OR newTile.Symbol = " " THEN
' Update the tile the box is leaving
IF boxTile.IsGoal = 1 THEN
MapTiles(boxX, boxY).Symbol = "."
ELSE
MapTiles(boxX, boxY).Symbol = " "
END IF
' Update the tile the box is moving to
MapTiles(newBoxX, newBoxY).Symbol = "$"
MapTiles(newBoxX, newBoxY).HasBox = 1
MapTiles(boxX, boxY).HasBox = 0
' Update the position of the box
FOR i = 1 TO 6
IF Boxes(i).X = boxX AND Boxes(i).Y = boxY THEN
Boxes(i).X = newBoxX
Boxes(i).Y = newBoxY
EXIT FOR
END IF
NEXT i
' Update the goals covered
IF MapTiles(newBoxX, newBoxY).IsGoal = 1 THEN
GoalsCoveredCount = GoalsCoveredCount + 1
END IF
IF MapTiles(boxX, boxY).IsGoal = 1 THEN
GoalsCoveredCount = GoalsCoveredCount - 1
END IF
' Check if all goals are covered
IF GoalsCoveredCount = NumGoals THEN
GoalsCompleted = GoalsCompleted + 1
END IF
END IF
END SUB
' Subroutine to initialize the game
SUB InitializeGame ()
DIM y AS INTEGER
DIM x AS INTEGER
NumGoals = 0 ' Initialize the goals
GoalsCompleted = 0
PlayerX = 14
PlayerY = 4
MapTiles(PlayerX, PlayerY).Symbol = "@"
FOR y = 1 TO MapHeight
FOR x = 1 TO MapWidth
MapTiles(x, y).Symbol = " "
MapTiles(x, y).IsGoal = 0
MapTiles(x, y).IsBox = 0
NEXT x
NEXT y
END SUB
' Subroutine to load a level
SUB LoadLevel (levelNumber AS INTEGER)
DIM row, col, i
levelMap(1) = " ####"
levelMap(2) = " ## #########"
levelMap(3) = " # ###"
levelMap(4) = " # **********@ #"
levelMap(5) = "## * . #"
levelMap(6) = "# *#######**$##"
levelMap(7) = "# #"
levelMap(8) = "############ #"
levelMap(9) = " ####"
'levelMap(1) = " #####"
'levelMap(2) = " # #"
'levelMap(3) = " #$ #"
'levelMap(4) = " ### $##"
'levelMap(5) = " # $ $ #"
'levelMap(6) = "##### # ## # ######"
'levelMap(7) = "# # ## ### ..#"
'levelMap(8) = "# $ $ ..#"
'levelMap(9) = "##### ## # ### ..#"
'levelMap(10) = " # ## ##########"
'levelMap(11) = " # #"
'levelMap(12) = " ######"
NumGoals = 0 ' Reset total goals
GoalsCoveredCount = 0 ' Reset goals covered count
FOR row = 1 TO MapHeight
FOR col = 1 TO MapWidth
tileSymbol = MID$(levelMap(row), col, 1)
MapTiles(col, row).Symbol = tileSymbol
MapTiles(col, row).IsBox = 0
MapTiles(col, row).IsGoal = 0
IF tileSymbol = "$" THEN
FOR i = 1 TO 6
IF Boxes(i).X = 0 AND Boxes(i).Y = 0 THEN
Boxes(i).Symbol = "$"
Boxes(i).X = col
Boxes(i).Y = row
EXIT FOR
END IF
NEXT i
MapTiles(col, row).IsBox = 1
MapTiles(col, row).HasBox = 1
END IF
IF tileSymbol = "." OR tileSymbol = "*" THEN
MapTiles(col, row).IsGoal = 1
NumGoals = NumGoals + 1 ' Update total goals
END IF
' Check if box is on a goal
IF tileSymbol = "*" THEN
GoalsCoveredCount = GoalsCoveredCount + 1 ' Update goals covered count
MapTiles(col, row).HasBox = 1
END IF
NEXT col
NEXT row
END SUB
' Subroutine to switch to Greek characters
SUB GreekChange
RESTORE GreekUnicodeMap
FOR ascIIcode = 128 TO 255
READ unicode
_MAPUNICODE unicode TO ascIIcode
NEXT
GreekUnicodeMap:
'Microsoft_windows_cp1253
DATA 8364,0,8218,402,8222,8230,8224,8225,0,8240,0,8249,0,0,0,0
DATA 0,8216,8217,8220,8221,8226,8211,8212,0,8482,0,8250,0,0,0,0
DATA 160,901,902,163,164,165,166,167,168,169,0,171,172,173,174,8213
DATA 176,177,178,179,900,181,182,183,904,905,906,187,908,189,910,911
DATA 912,913,914,915,916,917,918,919,920,921,922,923,924,925,926,927
DATA 928,929,0,931,932,933,934,935,936,937,938,939,940,941,942,943
DATA 944,945,946,947,948,949,950,951,952,953,954,955,956,957,958,959
DATA 960,961,962,963,964,965,966,967,968,969,970,971,972,973,974,0
END SUB
' Subroutine to switch to English characters
SUB EnglChange
RESTORE EnglUnicodeMap
FOR ascIIcode = 128 TO 255
READ unicode
_MAPUNICODE unicode TO ascIIcode
NEXT
EnglUnicodeMap:
'Microsoft_pc_cp437
DATA 199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197
DATA 201,230,198,244,246,242,251,249,255,214,220,162,163,165,8359,402
DATA 225,237,243,250,241,209,170,186,191,8976,172,189,188,161,171,187
DATA 9617,9618,9619,9474,9508,9569,9570,9558,9557,9571,9553,9559,9565,9564,9563,9488
DATA 9492,9524,9516,9500,9472,9532,9566,9567,9562,9556,9577,9574,9568,9552,9580,9575
DATA 9576,9572,9573,9561,9560,9554,9555,9579,9578,9496,9484,9608,9604,9612,9616,9600
DATA 945,223,915,960,931,963,181,964,934,920,937,948,8734,966,949,8745
DATA 8801,177,8805,8804,8992,8993,247,8776,176,8729,183,8730,8319,178,9632,160
END SUB
Enjoy the Game
Guslouk
To be continue.
Assets.zip (Size: 238.69 KB / Downloads: 23)
