09-01-2023, 09:57 AM
Code: (Select All)
Screen _NewImage(640, 480, 32)
Const MapWidth = 30
Const MapHeight = 22
TileWidth = 20
TileHeight = 13
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(0 To 20) As String
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
LoadLabel
' 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 = False
'Goals(1).IsGoal = True
'Goals(1).HasBox = False
'Goals(1).HasPlayer = False
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, goal.Y).Symbol = "."
MapTiles(goal.X + dx, goal.Y + dy).Symbol = goal.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) + "/" + Str$(tileSymol)
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)
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, newX, newY
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 = 13
PlayerY = 10
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 LoadLabel ()
' Δημιουργία χάρτη του παιχνιδιού
levelMap(1) = " ##### "
levelMap(2) = " # # "
levelMap(3) = " #$ # "
levelMap(4) = " ### $# "
levelMap(5) = " # $ $ # "
levelMap(6) = " # # ## # ##### "
levelMap(7) = " #### # ## ## ..# "
levelMap(8) = " # $ ..# "
levelMap(9) = " #### ## # ## ..# "
levelMap(10) = " ### ## ######### "
levelMap(11) = " # # "
levelMap(12) = " ################ "
' Διασχίστε τον χάρτη και ορίστε τα χαρακτηριστικά των πλακιδίων
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
MapTiles(col, row).IsBox = 1
ElseIf tileSymbol = "." Then
MapTiles(col, row).IsGoal = 1
End If
Next col
Next row
End SubThis is all code.
Thanks.