Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Goals(1) = New Tile()
#16
Thanks b+ for the help.
The game is a clone of Sokoban.

Code: (Select All)
Screen _NewImage(640, 480, 32)

Const MapWidth = 30
Const MapHeight = 22
TileWidth = 30
TileHeight = 22

Type GoalType
    Score As Integer
    Description As String
    IsComplete As Integer
End Type
Type Tile
    Symbol As String * 1 'use higher numbers if you need more chars
    IsBox As Integer ' 0 for False, 1 for True
    IsGoal As Integer ' 0 for False, 1 for True
    HasBox As Integer ' 0 for False, 1 for True
    HasPlayer As Integer ' 0 for False, 1 for True
    X As Integer
    Y As Integer
End Type

Dim Shared row, col As Integer
Dim Shared levelMap As String * 25
Dim Shared tileSymbol As String
Dim Shared MapTiles(MapWidth, MapHeight) As Tile
Dim Shared Map(MapWidth, MapHeight) As Integer
Dim Shared PlayerX, PlayerY
Dim Shared NumGoals, GoalsCompleted
Dim Shared GoalsCoveredCount As Integer
Dim Shared boxTile As Tile
Dim Shared currentTile As Tile
Dim Shared prevX As Integer
Dim Shared prevY As Integer
Dim Shared newBoxTile As Tile
Dim Shared positionAfterBox As Tile
Dim Shared prevSymbol As String
Dim Shared prevIsGoal As Integer
Dim Shared possibleMove As _Unsigned _Byte
Dim Shared otherGoal As Tile
Dim Shared goal As Tile
Dim Shared j As Integer
Dim Shared Goals(6) As Tile
Dim Shared GoalArr(10) As GoalType

' Initialize MapTiles
' Set up walls

InitializeGame
LoadLevel (1)

' Initialize GoalsCoveredCount to 0
GoalsCoveredCount = 0

Do
    _Limit 60
    DrawMap
    _Display

    Do
        key$ = InKey$
        If Len(key$) > 0 Then Exit Do
    Loop

    If key$ = Chr$(27) Then Exit Do

    newX = PlayerX
    newY = PlayerY

    Select Case UCase$(key$)
        Case "W", Chr$(0) + Chr$(72) ' "w" key or up arrow
            newY = PlayerY - 1
        Case "S", Chr$(0) + Chr$(80) ' "s" key or down arrow
            newY = PlayerY + 1
        Case "A", Chr$(0) + Chr$(75) ' "a" key or left arrow
            newX = PlayerX - 1
        Case "D", Chr$(0) + Chr$(77) ' "d" key or right arrow
            newX = PlayerX + 1
    End Select

    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 Map(newX, newY) = 36 Then
            MoveBox newX, newY, newBoxX, newBoxY
        End If
    End If

    mouseX = _MouseX
    mouseY = _MouseY

    If mouseX >= 0 And mouseX <= 640 And mouseY >= 0 And mouseY <= 480 Then
        tileX = Int(mouseX / TileWidth) + 1
        tileY = Int(mouseY / TileHeight) + 1

        If tileX >= 1 And tileX <= MapWidth And tileY >= 1 And tileY <= MapHeight Then
            If MOUSECLICK() Then
                If Map(tileX, tileY) = 0 Or Map(tileX, tileY) = 46 Then ' 0 για κενό, 46 για τελεία
                    MovePlayer tileX, tileY
                ElseIf Map(tileX, tileY) = 36 Then ' 36 για το σύμβολο $
                    MoveBox tileX, tileY, newBoxX, newBoxY
                End If
            End If
        End If
    End If

Loop Until GoalsCompleted = NumGoals

Cls
Print "Congratulations! You completed the level."
End


Sub PushGoals (dx As Integer, dy As Integer)
    Dim i As Integer
    For i = 0 To UBound(GoalArr)
        GoalArr(i).Score = 0
        GoalArr(i).Description = ""
        GoalArr(i).IsComplete = 0
    Next
    ReDim Goals(6) As Tile
    Goals(1).Symbol = "o"
    Goals(2).Symbol = "."
    Goals(3).Symbol = "*"
    Goals(1).IsBox = 0
    Goals(1).IsGoal = 1
    Goals(1).HasBox = 0
    Goals(1).HasPlayer = 0
    Goals(1).X = 4
    Goals(1).Y = 7

    For i = 1 To NumGoals
        goal = MapTiles(i, j)
        If goal.X = PlayerX + dx And goal.Y = PlayerY + dy Then
            ' The goal is in that direction
            ' Check if we can move it
            If IsTileWalkable(goal.X + dx, goal.Y + dy) And Not IsGoalAtLocation(goal.X + dx, goal.Y + dy) Then
                ' Move the goal to the new position
                MapTiles(goal.X + dx, goal.Y + dy).Symbol = goal.Symbol
                MapTiles(goal.X, goal.Y).Symbol = "."
                goal.X = goal.X + dx
                goal.Y = goal.Y + dy
                ' See if there is another goal to move
                possibleMove = True
                Do Until Not possibleMove
                    possibleMove = False
                    For j = 1 To NumGoals
                        otherGoal = MapTiles(j, j)
                        If i <> j Then
                            If otherGoal.X = goal.X And otherGoal.Y = goal.Y Then
                                ' There is another goal next to this one; move it too
                                If IsTileWalkable(otherGoal.X + dx, otherGoal.Y + dy) And Not IsGoalAtLocation(otherGoal.X + dx, otherGoal.Y + dy) Then
                                    MapTiles(otherGoal.X, otherGoal.Y).Symbol = "."
                                    MapTiles(otherGoal.X + dx, otherGoal.Y + dy).Symbol = otherGoal.Symbol
                                    otherGoal.X = otherGoal.X + dx
                                    otherGoal.Y = otherGoal.Y + dy
                                    possibleMove = True
                                    Exit Do
                                End If
                            End If
                        End If
                    Next j
                Loop
                Exit Sub
            End If
        End If
    Next i
End Sub

Sub DrawMap ()
    Cls
    For y = 1 To MapHeight
        For x = 1 To MapWidth
            If x = PlayerX And y = PlayerY Then
                Print "@"; ' Draw the player
            Else
                If MapTiles(x, y).Symbol = "." Then
                    Print "o";
                Else
                    Print MapTiles(x, y).Symbol;
                End If
            End If
        Next x
        Print
    Next y
    Print "Goals completed: " + Str$(GoalsCompleted) + "/" + Str$(NumGoals) + "/" + Str$(GoalsCoveredCount)
End Sub

Sub MovePlayer (newX, newY)

    prevX = PlayerX
    prevY = PlayerY

    currentTile = MapTiles(PlayerX, PlayerY)
    prevSymbol = currentTile.Symbol
    prevIsGoal = currentTile.IsGoal

    If currentTile.IsGoal = 1 Then
        currentTile.Symbol = "."
        MoveBox PlayerX, PlayerY, newX, newY
    Else
        currentTile.Symbol = " "
    End If

    PlayerX = newX
    PlayerY = newY

End Sub

Sub MoveBox (boxX, boxY, newBoxX, newBoxY)
    'Dim boxTile As Tile ' Πρέπει να δηλώσετε τις μεταβλητές boxX και boxY
    If newBoxTile.Symbol = "." Then
        'positionAfterBox = MapTiles(newBoxX + (newBoxX - boxX), newBoxY + (newBoxY - boxY))

        If newBoxX >= 1 And newBoxX <= MapWidth And newBoxY >= 1 And newBoxY <= MapHeight Then
            newBoxTile = MapTiles(newBoxX, newBoxY)

            If positionAfterBox.Symbol <> "." Then
                boxTile = MapTiles(boxX, boxY)
                If boxTile.IsGoal = 1 Then
                    boxTile.Symbol = "."
                Else
                    boxTile.Symbol = " "
                End If

                newBoxTile.Symbol = "$"
                MapTiles(newBoxX, newBoxY).Symbol = "."
                MapTiles(newBoxX, newBoxY).HasBox = 1
                MapTiles(boxX, boxY).HasBox = 0
                GoalsCoveredCount = GoalsCoveredCount + 1
                MoveBox PlayerX, PlayerY, newBoxX, newBoxY
                MovePlayer boxX, boxY
            End If
        ElseIf newBoxTile.Symbol = " " Then
            boxTile = MapTiles(boxX, boxY)
            If boxTile.IsGoal = 1 Then
                boxTile.Symbol = "."
            Else
                boxTile.Symbol = " "
            End If
        End If
    End If
End Sub

Sub InitializeGame ()
    NumGoals = 6
    GoalsCompleted = 0
    ' Set up player
    PlayerX = 11
    PlayerY = 9
    MapTiles(PlayerX, PlayerY).Symbol = "@"

    For y = 1 To MapHeight
        For x = 1 To MapWidth
            Map(x, y) = Asc(" ")
        Next x
    Next y

    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
    For x = 1 To MapWidth
        MapTiles(x, 1).Symbol = "*"
        MapTiles(x, MapHeight).Symbol = "*"
    Next x

    For y = 1 To MapHeight
        MapTiles(1, y).Symbol = "*"
        MapTiles(MapWidth, y).Symbol = "*"
    Next y
End Sub

Sub LoadLevel (levelNumber As Integer)
    ReDim levelMap(levelNumber, 23) As String * 25 ' Δημιουργία του δυναμικού πίνακα με τον απαιτούμενο αριθμό σειρών
    levelMap(levelNumber, 1) = "      #####                  "
    levelMap(levelNumber, 2) = "      #  #                  "
    levelMap(levelNumber, 3) = "      #$  #                  "
    levelMap(levelNumber, 4) = "    ###  $#                  "
    levelMap(levelNumber, 5) = "    #  $ $ #                  "
    levelMap(levelNumber, 6) = "    # # ## # #####            "
    levelMap(levelNumber, 7) = " #### # ## ##  ..#            "
    levelMap(levelNumber, 8) = " # $  $        ..#            "
    levelMap(levelNumber, 9) = " #### ## # ##  ..#            "
    levelMap(levelNumber, 10) = "  ### ## #########            "
    levelMap(levelNumber, 11) = "  #              #            "
    levelMap(levelNumber, 12) = "  ################            "

    For row = 1 To MapHeight
        For col = 1 To MapWidth
            tileSymbol = Mid$(levelMap(levelNumber, row), col, 1)

            MapTiles(col, row).Symbol = tileSymbol
            MapTiles(col, row).IsBox = 0
            MapTiles(col, row).IsGoal = 0

            If tileSymbol = "$" Then
                MapTiles(col, row).IsBox = 1
            ElseIf tileSymbol = "." Then
                MapTiles(col, row).IsGoal = 1
            End If
        Next col
    Next row
End Sub
I have problems with the push of the boxes.
Huh 

help please.

Thanks again.
Reply


Messages In This Thread
Goals(1) = New Tile() - by gaslouk - 08-31-2023, 05:42 PM
RE: Goals(1) = New Tile() - by TerryRitchie - 08-31-2023, 06:08 PM
RE: Goals(1) = New Tile() - by mnrvovrfc - 08-31-2023, 06:58 PM
RE: Goals(1) = New Tile() - by RhoSigma - 08-31-2023, 09:45 PM
RE: Goals(1) = New Tile() - by gaslouk - 09-01-2023, 07:07 AM
RE: Goals(1) = New Tile() - by RhoSigma - 09-01-2023, 08:35 AM
RE: Goals(1) = New Tile() - by SMcNeill - 09-01-2023, 07:28 AM
RE: Goals(1) = New Tile() - by gaslouk - 09-01-2023, 08:49 AM
RE: Goals(1) = New Tile() - by bplus - 09-01-2023, 09:28 AM
RE: Goals(1) = New Tile() - by gaslouk - 09-01-2023, 09:42 AM
RE: Goals(1) = New Tile() - by bplus - 09-01-2023, 09:49 AM
RE: Goals(1) = New Tile() - by gaslouk - 09-01-2023, 09:57 AM
RE: Goals(1) = New Tile() - by bplus - 09-01-2023, 10:08 AM
RE: Goals(1) = New Tile() - by gaslouk - 09-01-2023, 10:19 AM
RE: Goals(1) = New Tile() - by bplus - 09-01-2023, 11:18 AM
RE: Goals(1) = New Tile() - by gaslouk - 09-01-2023, 01:01 PM
RE: Goals(1) = New Tile() - by bplus - 09-03-2023, 06:39 PM



Users browsing this thread: 2 Guest(s)