Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
GusSoko
#1
Tongue 
This is my first game. I make it with help from QB64_GPT.

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.
.zip   Assets.zip (Size: 238.69 KB / Downloads: 29)
Reply
#2
@gaslouk you haven't made the assets available
Code: (Select All)
DIM SHARED folder$
folder$ = "D:\qb64pe\Assets\"

plus not everyone uses D drive.
b = b + ...
Reply
#3
(07-03-2024, 12:32 PM)bplus Wrote: @gaslouk you haven't made the assets available
Code: (Select All)
DIM SHARED folder$
folder$ = "D:\qb64pe\Assets\"

plus not everyone uses D drive.

Thanks b+ now is ok.
Reply
#4
I hate to harp on your game but I am pretty sure you want people to enjoy it so...

Changes I made:
Code: (Select All)
Dim Shared folder$
folder$ = ".\Assets\" ' <<<< changed this I put the bas code one level up from assets

Screen _NewImage(1264, 878, 32) ' Create new screen <<<<<<<<< too high
_FullScreen ' <<<< added this

got me to here:
   

I have no idea what to do with game and I managed to catch WASD instructions in code to know that was keys to move.

So some instructions are really needed plus Linux users do not have access to Windows Font files.
b = b + ...
Reply




Users browsing this thread: 1 Guest(s)