USER
Imports System.IO
Imports System.Text.Json
Imports System.Text.Json.Serialization
Imports System.Drawing
Imports System.Drawing.Drawing2D
Imports System.ComponentModel
Imports System.Resources
Imports System.Drawing.Imaging
Imports System.Reflection
Public Class frmGame
#Region " Variables "
Private triggers As New List(Of Trigger)()
Private FirstMove As Boolean = True
Private baddyMovementTimer As Timer
Private baddies As New List(Of Baddy)
Private lastDirection As String = "Left" ' Default to left
Private lastMoveTime As DateTime
Private idleTimer As Timer
Private doorImage As Image
Private doorAnimationTimer As Timer
Private doorX As Integer
Private doorY As Integer
Private doorAnimationStartTime As DateTime
Private movingObjects As New List(Of MovingObject)()
Private movingObjectsTimer As Timer
Private CollectedCoins As Integer = 0
Private totalCoins As Integer = 0
Private playerX As Integer
Private playerY As Integer
Private hasKey As Boolean = False
Private justWarped As Boolean = False
Public Property RoomFilePath As String
Private SelectedMusic As String
Private Const INDENT As Integer = 20
Private Const WALL_THICKNESS As Integer = 10
Private SQCOUNTX As Integer
Private SQCOUNTY As Integer
Private SQSizeX As Integer
Private SQSizeY As Integer
Private wallsHatchStyle As HatchStyle
Private wallsColor1 As Color
Private wallsColor2 As Color
Private floorsHatchStyle As HatchStyle
Private floorsColor1 As Color
Private floorsColor2 As Color
Private verticalWalls()() As Boolean
Private horizontalWalls()() As Boolean
Private placedItems()() As String
Private verticalWallItems()() As String
Private horizontalWallItems()() As String
Private floorsUseEdgeStyle()() As Boolean
Private imageDictionary As New Dictionary(Of String, Image)
Private animatedImages As New List(Of Image)
Private animationTimer As Timer
Private isRoomDataLoaded As Boolean = False
Private ReadOnly projectDir As String = GetProjectDirectory()
Private ReadOnly ImagesFolder As String = Path.Combine(projectDir, "Data", "Images")
Private ReadOnly musicFolder As String = Path.Combine(projectDir, "Data", "Sound/Music")
Private ReadOnly SFXFolder As String = Path.Combine(projectDir, "Data", "Sound/Sound Effects")
Private ReadOnly musicManager As New MusicManager()
Private ReadOnly sfxManager As New SFXManager(SFXFolder)
Private totalKeys As Integer = 0
Private collectedKeys As Integer = 0
Private resourceManager As ResourceManager
Private itemAnimations As New List(Of ItemAnimation)()
Private itemAnimationTimer As Timer
' New property to determine if gradient background should be used
Public Property useGradient As Boolean = False
' Timer for redrawing
Private redrawTimer As Timer
#End Region
#Region " Classes "
Private Class MovingObject
Public Property X As Integer
Public Property Y As Integer
Public Property DeltaX As Integer
Public Property DeltaY As Integer
Public Property IsBall As Boolean
Public Property IsBlock As Boolean
Public Property MoveInterval As Integer
Public Property NextMoveTime As DateTime
End Class
Private Class ItemAnimation
Public Property ItemImage As Image
Public Property StartX As Integer
Public Property StartY As Integer
Public Property EndX As Integer
Public Property EndY As Integer
Public Property CurrentX As Integer
Public Property CurrentY As Integer
Public Property AnimationDuration As Integer
Public Property StartTime As DateTime
Public Sub New(itemImage As Image, startX As Integer, startY As Integer, endX As Integer, endY As Integer, animationDuration As Integer)
Me.ItemImage = itemImage
Me.StartX = startX
Me.StartY = startY
Me.EndX = endX
Me.EndY = endY
Me.CurrentX = startX
Me.CurrentY = startY
Me.AnimationDuration = animationDuration
Me.StartTime = DateTime.Now
End Sub
Public Function IsAnimationComplete() As Boolean
Return (DateTime.Now - StartTime).TotalMilliseconds >= AnimationDuration
End Function
Public Sub UpdatePosition()
Dim elapsedTime As Integer = CInt((DateTime.Now - StartTime).TotalMilliseconds)
Dim progress As Double = elapsedTime / AnimationDuration
CurrentX = StartX + CInt((EndX - StartX) * progress)
CurrentY = StartY + CInt((EndY - StartY) * progress)
End Sub
End Class
Friend Class Baddy
Public Property X As Integer
Public Property Y As Integer
Public Property CurrentDirection As String
Public Property ImageKey As String
Public Sub New(startX As Integer, startY As Integer, imageKey As String)
Me.X = startX
Me.Y = startY
Me.CurrentDirection = "Right" ' Start moving to the right
Me.ImageKey = imageKey
End Sub
End Class
#End Region
#Region "Initialization"
Public Sub New()
InitializeComponent()
resourceManager = New ResourceManager("Enigma.frmGame", GetType(frmGame).Assembly)
InitializeSoundEffects()
' Enable double buffering for the form
Me.DoubleBuffered = True
' Enable double buffering for the PictureBox
EnableDoubleBuffering(picTest)
' Initialize the idle timer
idleTimer = New Timer() With {.Interval = 250} ' 1 second
AddHandler idleTimer.Tick, AddressOf OnIdleTick
idleTimer.Start()
End Sub
Private Sub EnableDoubleBuffering(control As Control)
Dim propertyInfo As PropertyInfo = control.GetType().GetProperty("DoubleBuffered", BindingFlags.NonPublic Or BindingFlags.Instance)
propertyInfo.SetValue(control, True, Nothing)
End Sub
Private Sub frmGame_Load(sender As Object, e As EventArgs) Handles MyBase.Load
InitializeImages()
LoadRoomData()
StartAnimationTimer()
FindPlayerStartPosition()
AddObjectsOnFlippersToMovingObjects()
PlaySelectedMusic()
InitializeTriggers() ' Initialize triggers
' Initialize the redraw timer
redrawTimer = New Timer() With {.Interval = 50} ' 20 times a second
AddHandler redrawTimer.Tick, AddressOf OnRedrawTick
redrawTimer.Start()
itemAnimationTimer = New Timer() With {.Interval = 16} ' Approximately 60 FPS
AddHandler itemAnimationTimer.Tick, AddressOf OnItemAnimationTick
itemAnimationTimer.Start()
End Sub
Private Sub InitializeTriggers()
' Example trigger for testing
Dim trigger As New Trigger With {
.ItemType = "Any Block",
.TriggerAction = "Enters",
.TriggerSquare = New Point(2, 4),
.Action = "Remove",
.ItemToRemove = "BlockStopper_4_8"
}
triggers.Add(trigger)
End Sub
Private Sub InitializeImages()
Try
' Load images into the imageDictionary
imageDictionary("picBlockSwitch") = Image.FromFile(Path.Combine(ImagesFolder, "BlockSwitch.png"))
imageDictionary("picBlockSwitch2") = Image.FromFile(Path.Combine(ImagesFolder, "BlockSwitch2.png"))
imageDictionary("picBlock1") = Image.FromFile(Path.Combine(ImagesFolder, "Block.png"))
imageDictionary("picBall") = Image.FromFile(Path.Combine(ImagesFolder, "Ball.gif"))
imageDictionary("picCoin") = Image.FromFile(Path.Combine(ImagesFolder, "Coin.gif"))
imageDictionary("picFinish") = Image.FromFile(Path.Combine(ImagesFolder, "Finish.gif"))
imageDictionary("picFlipper1") = Image.FromFile(Path.Combine(ImagesFolder, "Flipper1.gif"))
imageDictionary("picFlipper2") = Image.FromFile(Path.Combine(ImagesFolder, "Flipper2.gif"))
imageDictionary("picFlipper3") = Image.FromFile(Path.Combine(ImagesFolder, "Flipper3.gif"))
imageDictionary("picFlipper4") = Image.FromFile(Path.Combine(ImagesFolder, "Flipper4.gif"))
imageDictionary("picGate") = Image.FromFile(Path.Combine(ImagesFolder, "Gate.gif"))
imageDictionary("picKey") = Image.FromFile(Path.Combine(ImagesFolder, "Key.gif"))
imageDictionary("picLaser1") = Image.FromFile(Path.Combine(ImagesFolder, "Laser1.gif"))
imageDictionary("picLaser2") = Image.FromFile(Path.Combine(ImagesFolder, "Laser2.gif"))
imageDictionary("picWarp") = Image.FromFile(Path.Combine(ImagesFolder, "Warp.gif"))
imageDictionary("picWarp2") = Image.FromFile(Path.Combine(ImagesFolder, "Warp2.gif"))
imageDictionary("picStart") = Image.FromFile(Path.Combine(ImagesFolder, "Guy.gif"))
imageDictionary("picStartLeft") = Image.FromFile(Path.Combine(ImagesFolder, "Guy Left.gif"))
imageDictionary("picStartRight") = Image.FromFile(Path.Combine(ImagesFolder, "Guy Right.gif"))
imageDictionary("picBlockStopper1") = Image.FromFile(Path.Combine(ImagesFolder, "Debris1.png"))
imageDictionary("picBaddy1") = Image.FromFile(Path.Combine(ImagesFolder, "Baddy1.gif"))
imageDictionary("picBaddy2") = Image.FromFile(Path.Combine(ImagesFolder, "Baddy2.gif"))
imageDictionary("picBaddy3") = Image.FromFile(Path.Combine(ImagesFolder, "Baddy3.gif"))
imageDictionary("picBaddy4") = Image.FromFile(Path.Combine(ImagesFolder, "Baddy4.gif"))
imageDictionary("picExplosion") = Image.FromFile(Path.Combine(ImagesFolder, "Explosion.gif"))
' Extract the first frame of the door image
doorImage = ExtractFirstFrame(imageDictionary("picGate"))
Dim animatedImageKeys As String() = {
"picLaser1", "picLaser2", "picFlipper1", "picFlipper2",
"picFlipper3", "picFlipper4", "picCoin", "picGate",
"picKey", "picFinish", "picBall", "picWarp", "picWarp2", "picStart", "picStartLeft", "picStartRight",
"picBaddy1", "picBaddy2", "picBaddy3", "picBaddy4", "picExplosion"
}
For Each imgKey In animatedImageKeys
If imageDictionary.ContainsKey(imgKey) Then
Dim img As Image = imageDictionary(imgKey)
animatedImages.Add(img)
ImageAnimator.Animate(img, AddressOf OnFrameChanged)
End If
Next
Catch ex As Exception
MessageBox.Show("Error loading images: " & ex.Message)
End Try
End Sub
Private Function ExtractFirstFrame(animatedImage As Image) As Image
Dim frameDimensions As New FrameDimension(animatedImage.FrameDimensionsList(0))
animatedImage.SelectActiveFrame(frameDimensions, 0)
Return New Bitmap(animatedImage)
End Function
Private Sub InitializeSoundEffects()
' sfxManager is already initialized in the constructor
End Sub
Private Sub LoadRoomData()
If Not String.IsNullOrEmpty(RoomFilePath) AndAlso File.Exists(RoomFilePath) Then
LoadRoomFromFile(RoomFilePath)
AddBaddiesOnGrid() ' Add this method to place baddies
StartBaddyMovementTimer() ' Start moving baddies
Else
MessageBox.Show("Room file not found.")
Me.Close()
End If
End Sub
Private Sub StartAnimationTimer()
animationTimer = New Timer() With {.Interval = 33} ' Approximately 30 FPS
AddHandler animationTimer.Tick, AddressOf OnAnimationTick
animationTimer.Start()
End Sub
Private Sub FindPlayerStartPosition()
For x As Integer = 0 To placedItems.Length - 1
If placedItems(x) IsNot Nothing Then
For y As Integer = 0 To placedItems(x).Length - 1
Dim imageKey As String = placedItems(x)(y)
If imageKey = "picStart" Then
playerX = x
playerY = y
Exit Sub
End If
Next
End If
Next
End Sub
Private Sub AddObjectsOnFlippersToMovingObjects()
For x As Integer = 0 To SQCOUNTX - 1
For y As Integer = 0 To SQCOUNTY - 1
Dim item As String = placedItems(x)(y)
If item = "picBlock1" OrElse item = "picBall" Then
Dim movingObject As New MovingObject With {
.X = x,
.Y = y,
.IsBlock = (item = "picBlock1"),
.IsBall = (item = "picBall"),
.DeltaX = 0,
.DeltaY = 0
}
CheckForFlipper(movingObject)
If movingObject.DeltaX <> 0 OrElse movingObject.DeltaY <> 0 Then
placedItems(x)(y) = Nothing
movingObject.MoveInterval = If(movingObject.IsBall, 100, 50)
movingObject.NextMoveTime = DateTime.Now.AddMilliseconds(movingObject.MoveInterval)
movingObjects.Add(movingObject)
End If
End If
Next
Next
If movingObjects.Count > 0 AndAlso movingObjectsTimer Is Nothing Then
movingObjectsTimer = New Timer()
AddHandler movingObjectsTimer.Tick, AddressOf OnMovingObjectsTimerTick
movingObjectsTimer.Interval = 50 ' Ensure the interval is appropriate
movingObjectsTimer.Start()
End If
End Sub
Private Sub PlaySelectedMusic()
If Not String.IsNullOrEmpty(SelectedMusic) Then
Dim musicDetails As String() = SelectedMusic.Split(", ")
Dim musicFileName As String = musicDetails(0)
Dim volumeLevel As Single = Integer.Parse(musicDetails(1).Split(":")(1)) / 100.0F
Dim gainLevel As Single = Integer.Parse(musicDetails(2).Split(":")(1)) / 10.0F
Dim musicFilePath As String = Path.Combine(musicFolder, musicFileName)
musicManager.PlaySelectedMusic(musicFilePath, volumeLevel, gainLevel)
End If
End Sub
#End Region
#Region " Baddies "
Private Sub AddBaddiesOnGrid()
For x As Integer = 0 To SQCOUNTX - 1
For y As Integer = 0 To SQCOUNTY - 1
If placedItems(x)(y) IsNot Nothing Then
Dim imageKey As String = placedItems(x)(y)
If imageKey.StartsWith("picBaddy") Then
Dim baddy As New Baddy(x, y, imageKey) ' Pass the imageKey here
baddies.Add(baddy) ' Add baddy to the list
placedItems(x)(y) = Nothing ' Clear the starting point
End If
End If
Next
Next
End Sub
Private Sub StartBaddyMovementTimer()
baddyMovementTimer = New Timer() With {.Interval = 250} ' Adjust speed as needed
AddHandler baddyMovementTimer.Tick, AddressOf OnBaddyMovementTick
baddyMovementTimer.Start()
End Sub
Private Sub OnBaddyMovementTick(sender As Object, e As EventArgs)
' Iterate over the baddies list in reverse order to safely remove baddies
For i As Integer = baddies.Count - 1 To 0 Step -1
Try
Dim baddy As Baddy = baddies(i)
' Check if the baddy can move
If Not MoveBaddy(baddy) Then
' Baddy is trapped, remove it from the list
baddies.RemoveAt(i) ' Remove by index
End If
Catch ex As ArgumentOutOfRangeException
Console.WriteLine($"Caught ArgumentOutOfRangeException! Index: {i}, Current count: {baddies.Count}. Message: {ex.Message}")
End Try
Next
picTest.Invalidate() ' Refresh the display to show updated baddy positions
End Sub
Private Function MoveBaddy(baddy As Baddy) As Boolean
Dim nextX As Integer = baddy.X
Dim nextY As Integer = baddy.Y
' Attempt to move in the current direction
Select Case baddy.CurrentDirection
Case "Right"
nextX += 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try down if right is blocked
nextX = baddy.X
nextY += 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try up if down is blocked
nextY = baddy.Y - 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Finally try left
nextX = baddy.X - 1
nextY = baddy.Y
baddy.CurrentDirection = "Left" ' Update direction
Else
baddy.CurrentDirection = "Up" ' Update direction
End If
Else
baddy.CurrentDirection = "Down" ' Update direction
End If
End If
Case "Down"
nextY += 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try left if down is blocked
nextY = baddy.Y
nextX -= 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try right if left is blocked
nextX = baddy.X + 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Finally try up
nextY = baddy.Y - 1
nextX = baddy.X
baddy.CurrentDirection = "Up" ' Update direction
Else
baddy.CurrentDirection = "Right" ' Update direction
End If
Else
baddy.CurrentDirection = "Left" ' Update direction
End If
End If
Case "Left"
nextX -= 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try up if left is blocked
nextX = baddy.X
nextY -= 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try down if up is blocked
nextY = baddy.Y + 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Finally try right
nextX = baddy.X + 1
nextY = baddy.Y
baddy.CurrentDirection = "Right" ' Update direction
Else
baddy.CurrentDirection = "Down" ' Update direction
End If
Else
baddy.CurrentDirection = "Up" ' Update direction
End If
End If
Case "Up"
nextY -= 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try right if up is blocked
nextY = baddy.Y
nextX += 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Try left if right is blocked
nextX = baddy.X - 1
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Finally try down
nextY = baddy.Y + 1
nextX = baddy.X
baddy.CurrentDirection = "Down" ' Update direction
Else
baddy.CurrentDirection = "Left" ' Update direction
End If
Else
baddy.CurrentDirection = "Right" ' Update direction
End If
End If
End Select
' Now perform the move if the next position is valid
If CanBaddyMoveTo(baddy, nextX, nextY) Then
baddy.X = nextX
baddy.Y = nextY
Return True ' Return true to indicate that the baddy is still active
Else
' If baddy cannot move, it might be trapped
If trapped(baddy) Then
Return False ' This indicates the baddy should be removed
End If
End If
Return True ' Return true to indicate that the baddy is still active
End Function
Private Function CanBaddyMoveTo(baddy As Baddy, newX As Integer, newY As Integer) As Boolean
' Check boundaries
If newX < 0 OrElse newX >= SQCOUNTX OrElse newY < 0 OrElse newY >= SQCOUNTY Then
Return False
End If
' Check for walls in the way
If newX > baddy.X Then
' Moving right
If verticalWalls(newX)(newY) Then
Return False
End If
ElseIf newX < baddy.X Then
' Moving left
If verticalWalls(newX + 1)(newY) Then
Return False
End If
End If
If newY > baddy.Y Then
' Moving down
If horizontalWalls(newX)(newY) Then
Return False
End If
ElseIf newY < baddy.Y Then
' Moving up
If horizontalWalls(newX)(newY + 1) Then
Return False
End If
End If
' Check for wall items (lasers and flippers)
If newX > baddy.X Then
' Moving right
If verticalWallItems(newX)(newY) IsNot Nothing Then
Return False
End If
ElseIf newX < baddy.X Then
' Moving left
If verticalWallItems(newX + 1)(newY) IsNot Nothing Then
Return False
End If
End If
If newY > baddy.Y Then
' Moving down
If horizontalWallItems(newX)(newY) IsNot Nothing Then
Return False
End If
ElseIf newY < baddy.Y Then
' Moving up
If horizontalWallItems(newX)(newY + 1) IsNot Nothing Then
Return False
End If
End If
' Check for other baddies occupying the new space
If baddies.Any(Function(b) b.X = newX AndAlso b.Y = newY) Then
Return False
End If
' Check if the new position is clear (no items or other obstacles)
If placedItems(newX)(newY) IsNot Nothing Then
Return False
End If
' If all checks passed, return true
Return True
End Function
Private Function trapped(baddy As Baddy) As Boolean
' Simple definition of trapped
Dim nextX As Integer = baddy.X
Dim nextY As Integer = baddy.Y
Select Case baddy.CurrentDirection
Case "Right"
nextX += 1
Case "Down"
nextY += 1
Case "Left"
nextX -= 1
Case "Up"
nextY -= 1
End Select
If Not CanBaddyMoveTo(baddy, nextX, nextY) Then
' Baddy is trapped
sfxManager.PlaySoundEffect("Explosion") ' Play explosion sound
' Remove the baddy from the list
baddies.Remove(baddy)
' Place a key where the baddy was trapped
placedItems(baddy.X)(baddy.Y) = "picKey"
' Start explosion animation
Dim explosionImage As Image = imageDictionary("picExplosion")
Dim startX As Integer = INDENT + baddy.X * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim startY As Integer = INDENT + baddy.Y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim animationDuration As Integer = 1000 ' 1 second animation
Dim explosionAnimation As New ItemAnimation(explosionImage, startX, startY, startX, startY, animationDuration)
itemAnimations.Add(explosionAnimation)
Return True
End If
Return False
End Function
#End Region
#Region "Movement"
Private Sub frmGame_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
Dim moved As Boolean = False
Select Case e.KeyCode
Case Keys.Up, Keys.P
moved = AttemptMove("Up")
Case Keys.Down, Keys.L
moved = AttemptMove("Down")
Case Keys.Left, Keys.Z
moved = AttemptMove("Left")
Case Keys.Right, Keys.X
moved = AttemptMove("Right")
End Select
If moved Then
lastMoveTime = DateTime.Now
' No need to invalidate here, the redraw timer will handle it
End If
' Stop the idle timer when a key is pressed
If idleTimer IsNot Nothing Then
idleTimer.Stop()
End If
End Sub
Private Sub frmGame_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
' Start the idle timer immediately when a key is released
idleTimer.Start()
End Sub
Private Function AttemptMove(direction As String) As Boolean
Dim deltaX As Integer = 0
Dim deltaY As Integer = 0
Select Case direction
Case "Up"
deltaY = -1
Case "Down"
deltaY = 1
Case "Left"
deltaX = -1
lastDirection = "Left"
Case "Right"
deltaX = 1
lastDirection = "Right"
End Select
Dim newX As Integer = playerX + deltaX
Dim newY As Integer = playerY + deltaY
If newX < 0 OrElse newX >= SQCOUNTX OrElse newY < 0 OrElse newY >= SQCOUNTY Then
Return False
End If
If Not CanMoveTo(newX, newY, deltaX, deltaY) Then
Return False
End If
Dim targetItem As String = placedItems(newX)(newY)
If FirstMove Then
' Remove the starting point once the player moves
placedItems(playerX)(playerY) = Nothing
FirstMove = False
End If
If String.IsNullOrEmpty(targetItem) Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
CheckForWarp()
Return True
ElseIf targetItem = "picBlock1" Then
Dim blockMoved As Boolean = AttemptPushBlock(newX, newY, deltaX, deltaY)
If blockMoved Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
CheckForWarp()
Return True
Else
Return False
End If
ElseIf targetItem = "picBlockStopper1" Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
CheckForWarp()
Return True
ElseIf targetItem = "picBall" Then
Dim ballMoved As Boolean = AttemptPushBall(newX, newY, deltaX, deltaY)
If ballMoved Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
CheckForWarp()
Return True
Else
Return False
End If
ElseIf targetItem = "picCoin" Then
CollectedCoins += 1
placedItems(newX)(newY) = Nothing
playerX = newX
playerY = newY
sfxManager.PlaySoundEffect("Coin")
PlayRandomMoveSound() ' Play one of the move sounds randomly.
UpdateCoinLabel()
' Start coin animation
Dim coinImage As Image = imageDictionary("picCoin")
Dim startX As Integer = INDENT + newX * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim startY As Integer = INDENT + newY * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim endX As Integer = lblCoinCount.Bounds.Left + lblCoinCount.Bounds.Width \ 2 - coinImage.Width \ 2
Dim endY As Integer = lblCoinCount.Bounds.Top + lblCoinCount.Bounds.Height \ 2 - coinImage.Height \ 2
Dim animationDuration As Integer = 1000 ' 1 second animation
Dim coinAnimation As New ItemAnimation(coinImage, startX, startY, endX, endY, animationDuration)
itemAnimations.Add(coinAnimation)
CheckForWarp()
Return True
ElseIf targetItem = "picKey" Then
collectedKeys += 1
placedItems(newX)(newY) = Nothing
playerX = newX
playerY = newY
sfxManager.PlaySoundEffect("Key")
PlayRandomMoveSound() ' Play one of the move sounds randomly.
UpdateKeyLabel()
' Start key animation
Dim keyImage As Image = imageDictionary("picKey")
Dim startX As Integer = INDENT + newX * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim startY As Integer = INDENT + newY * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim endX As Integer = lblKeyCount.Bounds.Left + lblKeyCount.Bounds.Width \ 2 - keyImage.Width \ 2
Dim endY As Integer = lblKeyCount.Bounds.Top + lblKeyCount.Bounds.Height \ 2 - keyImage.Height \ 2
Dim animationDuration As Integer = 1000 ' 1 second animation
Dim keyAnimation As New ItemAnimation(keyImage, startX, startY, endX, endY, animationDuration)
itemAnimations.Add(keyAnimation)
CheckForWarp()
Return True
ElseIf targetItem = "picGate" Then
If collectedKeys = totalKeys Then
UnlockDoor(newX, newY)
PlayRandomMoveSound() ' Play one of the move sounds randomly.
Return False
Else
Return False
End If
ElseIf targetItem = "picFinish" Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
GameWon()
Return True
ElseIf targetItem = "picWarp" Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
HandleWarp("picWarp")
Return True
ElseIf targetItem = "picWarp2" Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
HandleWarp("picWarp2")
Return True
ElseIf targetItem = "picBlockSwitch" Or targetItem = "picBlockSwitch2" Then
playerX = newX
playerY = newY
PlayRandomMoveSound() ' Play one of the move sounds randomly.
Return True
Else
Return False
End If
End Function
Private Sub PlayRandomMoveSound()
Dim moveSounds As String() = {"Move 1", "Move 2", "Move 3"}
Dim randomIndex As Integer = New Random().Next(moveSounds.Length)
Dim selectedSound As String = moveSounds(randomIndex)
sfxManager.PlaySoundEffect(selectedSound)
End Sub
Private Sub UnlockDoor(doorX As Integer, doorY As Integer)
' Store the door position
Me.doorX = doorX
Me.doorY = doorY
' Start the door animation timer
If doorAnimationTimer Is Nothing Then
doorAnimationTimer = New Timer()
AddHandler doorAnimationTimer.Tick, AddressOf OnDoorAnimationTick
doorAnimationTimer.Interval = 50 ' Adjust the interval as needed
End If
doorAnimationTimer.Start()
' Record the start time of the door animation
doorAnimationStartTime = DateTime.Now
' Play the door open sound effect
sfxManager.PlaySoundEffect("Door Open")
End Sub
Private Sub OnDoorAnimationTick(sender As Object, e As EventArgs)
' Update the door animation frame
Dim doorImage As Image = imageDictionary("picGate")
ImageAnimator.UpdateFrames(doorImage)
' Check if one second has passed since the animation started
If (DateTime.Now - doorAnimationStartTime).TotalSeconds >= 1 Then
' Stop the timer
doorAnimationTimer.Stop()
' Remove the door from the grid
placedItems(doorX)(doorY) = Nothing
' No need to invalidate here, the redraw timer will handle it
End If
End Sub
Private Sub CheckForWarp()
Dim currentItem As String = placedItems(playerX)(playerY)
If currentItem = "picWarp" AndAlso Not justWarped Then
HandleWarp("picWarp")
ElseIf currentItem = "picWarp2" AndAlso Not justWarped Then
HandleWarp("picWarp2")
ElseIf currentItem <> "picWarp" AndAlso currentItem <> "picWarp2" Then
justWarped = False
End If
End Sub
Private Sub HandleWarp(warpType As String)
If Not justWarped Then
Dim warpPositions As New List(Of Point)
For x As Integer = 0 To placedItems.Length - 1
If placedItems(x) IsNot Nothing Then
For y As Integer = 0 To placedItems(x).Length - 1
If placedItems(x)(y) = warpType Then
warpPositions.Add(New Point(x, y))
End If
Next
End If
Next
warpPositions.Remove(New Point(playerX, playerY))
If warpPositions.Count = 1 Then
justWarped = True
sfxManager.PlaySoundEffect("Warp")
playerX = warpPositions(0).X
playerY = warpPositions(0).Y
CheckForWarp()
End If
End If
End Sub
Private Function AttemptPushBall(ballX As Integer, ballY As Integer, deltaX As Integer, deltaY As Integer) As Boolean
Dim nextX As Integer = ballX + deltaX
Dim nextY As Integer = ballY + deltaY
If nextX < 0 OrElse nextX >= SQCOUNTX OrElse nextY < 0 OrElse nextY >= SQCOUNTY Then
Return False
End If
If Not CanBallMoveTo(ballX, ballY, deltaX, deltaY) Then
Return False
End If
Dim targetItem As String = placedItems(nextX)(nextY)
Dim playerAtNextPos As Boolean = (nextX = playerX AndAlso nextY = playerY)
If String.IsNullOrEmpty(targetItem) AndAlso Not playerAtNextPos Then
placedItems(ballX)(ballY) = Nothing
Dim newBall As New MovingObject With {
.X = ballX,
.Y = ballY,
.DeltaX = deltaX,
.DeltaY = deltaY,
.IsBall = True,
.IsBlock = False,
.MoveInterval = 100,
.NextMoveTime = DateTime.Now.AddMilliseconds(100)
}
movingObjects.Add(newBall)
If movingObjectsTimer Is Nothing Then
movingObjectsTimer = New Timer()
AddHandler movingObjectsTimer.Tick, AddressOf OnMovingObjectsTimerTick
movingObjectsTimer.Interval = 50
movingObjectsTimer.Start()
End If
sfxManager.PlaySoundEffect("Push Ball")
Return True
Else
Return False
End If
End Function
Private Sub OnMovingObjectsTimerTick(sender As Object, e As EventArgs)
Dim currentTime As DateTime = DateTime.Now
For i As Integer = movingObjects.Count - 1 To 0 Step -1
Dim movingObject = movingObjects(i)
If movingObject.NextMoveTime > currentTime Then
Continue For
End If
Dim deltaX As Integer = movingObject.DeltaX
Dim deltaY As Integer = movingObject.DeltaY
Dim currentX As Integer = movingObject.X
Dim currentY As Integer = movingObject.Y
Dim objectStopped As Boolean = False
Dim nextX As Integer = currentX + deltaX
Dim nextY As Integer = currentY + deltaY
If nextX < 0 OrElse nextX >= SQCOUNTX OrElse nextY < 0 OrElse nextY >= SQCOUNTY Then
objectStopped = True
Else
If Not CanObjectMoveTo(movingObject, currentX, currentY, deltaX, deltaY) Then
objectStopped = True
Else
Dim targetItem As String = placedItems(nextX)(nextY)
Dim playerAtNextPos As Boolean = (nextX = playerX AndAlso nextY = playerY)
Dim objectAtNextPos As Boolean = movingObjects.Any(Function(o) o.X = nextX AndAlso o.Y = nextY AndAlso o IsNot movingObject)
If String.IsNullOrEmpty(targetItem) AndAlso Not playerAtNextPos AndAlso Not objectAtNextPos Then
movingObject.X = nextX
movingObject.Y = nextY
movingObject.NextMoveTime = currentTime.AddMilliseconds(movingObject.MoveInterval)
CheckForFlipper(movingObject)
Else
objectStopped = True
End If
End If
End If
If objectStopped Then
If IsObjectOnFlipper(movingObject) Then
movingObject.NextMoveTime = currentTime.AddMilliseconds(movingObject.MoveInterval)
CheckForFlipper(movingObject)
Else
If movingObject.IsBall Then
placedItems(movingObject.X)(movingObject.Y) = "picBall"
ElseIf movingObject.IsBlock Then
placedItems(movingObject.X)(movingObject.Y) = "picBlock1"
End If
sfxManager.PlaySoundEffect("Block Stop")
movingObjects.RemoveAt(i)
End If
End If
Next
End Sub
Private Function IsObjectOnFlipper(movingObject As MovingObject) As Boolean
Dim x As Integer = movingObject.X
Dim y As Integer = movingObject.Y
' Left Flipper Check (Flipper2)
If x >= 0 AndAlso x < verticalWallItems.Length AndAlso
y >= 0 AndAlso y < verticalWallItems(x).Length AndAlso
verticalWallItems(x)(y) = "picFlipper2" Then
Return True
End If
' Right Flipper Check (Flipper1)
If x + 1 < verticalWallItems.Length AndAlso
y >= 0 AndAlso y < verticalWallItems(x + 1).Length AndAlso
verticalWallItems(x + 1)(y) = "picFlipper1" Then
Return True
End If
' Up Flipper Check (Flipper4)
If x >= 0 AndAlso x < horizontalWallItems.Length AndAlso
y >= 0 AndAlso y < horizontalWallItems(x).Length AndAlso
horizontalWallItems(x)(y) = "picFlipper4" Then
Return True
End If
' Down Flipper Check (Flipper3)
If x >= 0 AndAlso x < horizontalWallItems.Length AndAlso
y + 1 < horizontalWallItems(x).Length AndAlso
horizontalWallItems(x)(y + 1) = "picFlipper3" Then
Return True
End If
Return False
End Function
Private Sub CheckForFlipper(movingObject As MovingObject)
Dim x As Integer = movingObject.X
Dim y As Integer = movingObject.Y
' Left Flipper Check (Flipper2)
If x >= 0 AndAlso x < verticalWallItems.Length AndAlso
y >= 0 AndAlso y < verticalWallItems(x).Length AndAlso
verticalWallItems(x)(y) = "picFlipper2" Then
movingObject.DeltaX = 1 ' Move right
movingObject.DeltaY = 0
movingObject.MoveInterval = If(movingObject.IsBall, 100, 12)
movingObject.NextMoveTime = DateTime.Now.AddMilliseconds(movingObject.MoveInterval)
sfxManager.PlaySoundEffect("Flipper")
Return
End If
' Right Flipper Check (Flipper1)
If x + 1 < verticalWallItems.Length AndAlso
y >= 0 AndAlso y < verticalWallItems(x + 1).Length AndAlso
verticalWallItems(x + 1)(y) = "picFlipper1" Then
movingObject.DeltaX = -1 ' Move left
movingObject.DeltaY = 0
movingObject.MoveInterval = If(movingObject.IsBall, 100, 12)
movingObject.NextMoveTime = DateTime.Now.AddMilliseconds(movingObject.MoveInterval)
sfxManager.PlaySoundEffect("Flipper")
Return
End If
' Up Flipper Check (Flipper4)
If x >= 0 AndAlso x < horizontalWallItems.Length AndAlso
y >= 0 AndAlso y < horizontalWallItems(x).Length AndAlso
horizontalWallItems(x)(y) = "picFlipper4" Then
movingObject.DeltaX = 0
movingObject.DeltaY = 1 ' Move down
movingObject.MoveInterval = If(movingObject.IsBall, 100, 12)
movingObject.NextMoveTime = DateTime.Now.AddMilliseconds(movingObject.MoveInterval)
sfxManager.PlaySoundEffect("Flipper")
Return
End If
' Down Flipper Check (Flipper3)
If x >= 0 AndAlso x < horizontalWallItems.Length AndAlso
y + 1 < horizontalWallItems(x).Length AndAlso
horizontalWallItems(x)(y + 1) = "picFlipper3" Then
movingObject.DeltaX = 0
movingObject.DeltaY = -1 ' Move up
movingObject.MoveInterval = If(movingObject.IsBall, 100, 12)
movingObject.NextMoveTime = DateTime.Now.AddMilliseconds(movingObject.MoveInterval)
sfxManager.PlaySoundEffect("Flipper")
Return
End If
End Sub
Private Function CanObjectMoveTo(movingObject As MovingObject, currentX As Integer, currentY As Integer, deltaX As Integer, deltaY As Integer) As Boolean
Dim wallExists As Boolean = False
Dim laserExists As Boolean = False
Dim laserX As Integer = -1
Dim laserY As Integer = -1
Dim laserType As String = ""
If deltaX = 1 Then
wallExists = verticalWalls(currentX + 1)(currentY)
If verticalWallItems(currentX + 1)(currentY) IsNot Nothing Then
laserExists = True
laserX = currentX + 1
laserY = currentY
laserType = verticalWallItems(laserX)(laserY)
End If
ElseIf deltaX = -1 Then
wallExists = verticalWalls(currentX)(currentY)
If verticalWallItems(currentX)(currentY) IsNot Nothing Then
laserExists = True
laserX = currentX
laserY = currentY
laserType = verticalWallItems(laserX)(laserY)
End If
ElseIf deltaY = 1 Then
wallExists = horizontalWalls(currentX)(currentY + 1)
If horizontalWallItems(currentX)(currentY + 1) IsNot Nothing Then
laserExists = True
laserX = currentX
laserY = currentY + 1
laserType = horizontalWallItems(laserX)(laserY)
End If
ElseIf deltaY = -1 Then
wallExists = horizontalWalls(currentX)(currentY)
If horizontalWallItems(currentX)(currentY) IsNot Nothing Then
laserExists = True
laserX = currentX
laserY = currentY
laserType = horizontalWallItems(laserX)(laserY)
End If
End If
If wallExists Then
Return False
End If
If laserExists Then
Dim laserCanBeDestroyed As Boolean = False
If (deltaX <> 0 AndAlso laserType = "picLaser1") Then
laserCanBeDestroyed = True
ElseIf (deltaY <> 0 AndAlso laserType = "picLaser2") Then
laserCanBeDestroyed = True
End If
If laserCanBeDestroyed Then
If deltaX <> 0 Then
verticalWallItems(laserX)(laserY) = Nothing
ElseIf deltaY <> 0 Then
horizontalWallItems(laserX)(laserY) = Nothing
End If
sfxManager.PlaySoundEffect("Break Laser")
Else
Return False
End If
End If
Return True
End Function
Private Function CanBallMoveTo(currentX As Integer, currentY As Integer, deltaX As Integer, deltaY As Integer) As Boolean
Return CanObjectMoveTo(New MovingObject With {.IsBall = True}, currentX, currentY, deltaX, deltaY)
End Function
Private Function IsLaserOnVerticalWall(x As Integer, y As Integer) As Boolean
If verticalWallItems(x)(y) IsNot Nothing Then
Dim item As String = verticalWallItems(x)(y)
Return item = "picLaser1" OrElse item = "picLaser2"
End If
Return False
End Function
Private Function IsLaserOnHorizontalWall(x As Integer, y As Integer) As Boolean
If horizontalWallItems(x)(y) IsNot Nothing Then
Dim item As String = horizontalWallItems(x)(y)
Return item = "picLaser1" OrElse item = "picLaser2"
End If
Return False
End Function
Private Function AttemptPushBlock(blockX As Integer, blockY As Integer, deltaX As Integer, deltaY As Integer) As Boolean
Dim blockNewX As Integer = blockX + deltaX
Dim blockNewY As Integer = blockY + deltaY
If blockNewX < 0 OrElse blockNewX >= SQCOUNTX OrElse blockNewY < 0 OrElse blockNewY >= SQCOUNTY Then
Return False
End If
If Not CanBlockMoveTo(blockX, blockY, deltaX, deltaY) Then
Return False
End If
Dim blockTargetItem As String = placedItems(blockNewX)(blockNewY)
Dim playerAtNextPos As Boolean = (blockNewX = playerX AndAlso blockNewY = playerY)
' Check for baddies at the new position
If baddies.Any(Function(b) b.X = blockNewX AndAlso b.Y = blockNewY) Then
Return False
End If
If String.IsNullOrEmpty(blockTargetItem) AndAlso Not playerAtNextPos Then
placedItems(blockX)(blockY) = Nothing
placedItems(blockNewX)(blockNewY) = "picBlock1"
sfxManager.PlaySoundEffect("Push Block")
Dim newBlock As New MovingObject With {
.X = blockNewX,
.Y = blockNewY,
.IsBlock = True,
.IsBall = False,
.DeltaX = 0,
.DeltaY = 0
}
CheckForFlipper(newBlock)
If newBlock.DeltaX <> 0 OrElse newBlock.DeltaY <> 0 Then
placedItems(blockNewX)(blockNewY) = Nothing
newBlock.MoveInterval = 50
newBlock.NextMoveTime = DateTime.Now.AddMilliseconds(50)
movingObjects.Add(newBlock)
If movingObjectsTimer Is Nothing Then
movingObjectsTimer = New Timer()
AddHandler movingObjectsTimer.Tick, AddressOf OnMovingObjectsTimerTick
movingObjectsTimer.Interval = 50
movingObjectsTimer.Start()
End If
End If
Return True
Else
Return False
End If
End Function
Private Function CanBlockMoveTo(blockX As Integer, blockY As Integer, deltaX As Integer, deltaY As Integer) As Boolean
Return CanObjectMoveTo(New MovingObject With {.IsBlock = True}, blockX, blockY, deltaX, deltaY)
End Function
Private Function IsFlipperOnVerticalWall(x As Integer, y As Integer) As Boolean
If verticalWallItems(x)(y) IsNot Nothing Then
Dim item As String = verticalWallItems(x)(y)
Return item = "picFlipper1" OrElse item = "picFlipper2"
End If
Return False
End Function
Private Function IsFlipperOnHorizontalWall(x As Integer, y As Integer) As Boolean
If horizontalWallItems(x)(y) IsNot Nothing Then
Dim item As String = horizontalWallItems(x)(y)
Return item = "picFlipper3" OrElse item = "picFlipper4"
End If
Return False
End Function
Private Function CanMoveTo(newX As Integer, newY As Integer, deltaX As Integer, deltaY As Integer) As Boolean
' Check for walls and lasers based on the direction of movement
If deltaX = 1 Then
If verticalWalls(playerX + 1)(playerY) Then Return False
If IsLaserOnVerticalWall(playerX + 1, playerY) Then Return False
If IsFlipperOnVerticalWall(playerX + 1, playerY) Then Return False
ElseIf deltaX = -1 Then
If verticalWalls(playerX)(playerY) Then Return False
If IsLaserOnVerticalWall(playerX, playerY) Then Return False
If IsFlipperOnVerticalWall(playerX, playerY) Then Return False
ElseIf deltaY = 1 Then
If horizontalWalls(playerX)(playerY + 1) Then Return False
If IsLaserOnHorizontalWall(playerX, playerY + 1) Then Return False
If IsFlipperOnHorizontalWall(playerX, playerY + 1) Then Return False
ElseIf deltaY = -1 Then
If horizontalWalls(playerX)(playerY) Then Return False
If IsLaserOnHorizontalWall(playerX, playerY) Then Return False
If IsFlipperOnHorizontalWall(playerX, playerY) Then Return False
End If
' Check for moving objects at the new position
If movingObjects.Any(Function(b) b.X = newX AndAlso b.Y = newY) Then
Return False
End If
Return True
End Function
Private Sub GameWon()
sfxManager.PlaySoundEffect("Finish")
MessageBox.Show($"Congratulations! You have completed the level.{Environment.NewLine}Coins Collected: {CollectedCoins}")
Me.Close()
End Sub
Private Sub UpdateCoinLabel()
lblCoinCount.Text = $"{CollectedCoins} of {totalCoins}"
End Sub
Private Sub UpdateKeyLabel()
If totalKeys > 0 Then
lblKeyCount.Text = $"{collectedKeys} of {totalKeys}"
Else
lblKeyCount.Text = "X"
End If
End Sub
#End Region
#Region "Drawing"
Private Sub OnAnimationTick(sender As Object, e As EventArgs)
For Each img In animatedImages
ImageAnimator.UpdateFrames(img)
Next
End Sub
Private Sub OnFrameChanged(o As Object, e As EventArgs)
' Required but can be left empty
End Sub
Private Sub picTest_Paint(sender As Object, e As PaintEventArgs) Handles picTest.Paint
If Not isRoomDataLoaded Then
Return
End If
' Draw the gradient background if useGradient is true
If useGradient Then
DrawGradientBackground(e.Graphics)
End If
CalculateSquareSizes(picTest.ClientSize.Width, picTest.ClientSize.Height)
e.Graphics.SmoothingMode = SmoothingMode.None
DrawGrid(e.Graphics)
' Draw item animations
For Each itemAnimation In itemAnimations
Dim destRect As New Rectangle(itemAnimation.CurrentX, itemAnimation.CurrentY, itemAnimation.ItemImage.Width, itemAnimation.ItemImage.Height)
e.Graphics.DrawImage(itemAnimation.ItemImage, destRect)
Next
End Sub
Private Sub InvalidateMovingObjects()
For Each movingObject In movingObjects
Dim rect As New Rectangle(
INDENT + movingObject.X * (SQSizeX + WALL_THICKNESS),
INDENT + movingObject.Y * (SQSizeY + WALL_THICKNESS),
SQSizeX + WALL_THICKNESS,
SQSizeY + WALL_THICKNESS
)
picTest.Invalidate(rect)
Next
End Sub
Private Sub DrawHatchStyleBackground(g As Graphics)
Dim xOrigin As Integer = INDENT
Dim yOrigin As Integer = INDENT
Dim gridWidth As Integer = SQCOUNTX * (SQSizeX + WALL_THICKNESS)
Dim gridHeight As Integer = SQCOUNTY * (SQSizeY + WALL_THICKNESS)
' Calculate the hatch style rectangle for the entire grid
Dim hatchRect As New Rectangle(xOrigin, yOrigin, gridWidth, gridHeight)
' Draw the hatch style background
Using brush As New HatchBrush(floorsHatchStyle, floorsColor1, floorsColor2)
g.FillRectangle(brush, hatchRect)
End Using
End Sub
Private Sub DrawGradientBackground(g As Graphics)
Dim xOrigin As Integer = INDENT
Dim yOrigin As Integer = INDENT
Dim gridWidth As Integer = SQCOUNTX * (SQSizeX + WALL_THICKNESS)
Dim gridHeight As Integer = SQCOUNTY * (SQSizeY + WALL_THICKNESS)
' Calculate the gradient rectangle for the entire grid
Dim gradientRect As New Rectangle(xOrigin, yOrigin, gridWidth, gridHeight)
' Draw the gradient background
Using brush As New LinearGradientBrush(gradientRect, floorsColor1, floorsColor2, LinearGradientMode.Vertical)
g.FillRectangle(brush, gradientRect)
End Using
End Sub
Private Sub CalculateSquareSizes(clientWidth As Integer, clientHeight As Integer)
SQSizeX = (clientWidth - 2 * INDENT - (SQCOUNTX + 1) * WALL_THICKNESS) \ SQCOUNTX
SQSizeY = (clientHeight - 2 * INDENT - (SQCOUNTY + 1) * WALL_THICKNESS) \ SQCOUNTY
End Sub
Private Sub DrawGrid(g As Graphics)
Dim xOrigin As Integer = INDENT
Dim yOrigin As Integer = INDENT
' Draw the gradient background if useGradient is true
If useGradient Then
DrawGradientBackground(g)
End If
' Draw floor squares with the chosen style only if not using gradient
If Not useGradient Then
For x As Integer = 0 To SQCOUNTX - 1
For y As Integer = 0 To SQCOUNTY - 1
Dim floorRect As New Rectangle(
xOrigin + x * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2,
yOrigin + y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2,
SQSizeX,
SQSizeY
)
If floorsUseEdgeStyle IsNot Nothing AndAlso floorsUseEdgeStyle.Length > x AndAlso
floorsUseEdgeStyle(x) IsNot Nothing AndAlso floorsUseEdgeStyle(x).Length > y AndAlso
floorsUseEdgeStyle(x)(y) Then
Using floorBrush As New HatchBrush(wallsHatchStyle, wallsColor1, wallsColor2)
g.FillRectangle(floorBrush, floorRect)
End Using
Else
Using floorBrush As New HatchBrush(floorsHatchStyle, floorsColor1, floorsColor2)
g.FillRectangle(floorBrush, floorRect)
End Using
End If
Next
Next
End If
' Draw wall intersections
For x As Integer = 0 To SQCOUNTX
For y As Integer = 0 To SQCOUNTY
Dim intersectionRect As New Rectangle(
xOrigin + x * (SQSizeX + WALL_THICKNESS) - WALL_THICKNESS \ 2,
yOrigin + y * (SQSizeY + WALL_THICKNESS) - WALL_THICKNESS \ 2,
WALL_THICKNESS,
WALL_THICKNESS
)
Using wallBrush As New HatchBrush(wallsHatchStyle, wallsColor1, wallsColor2)
g.FillRectangle(wallBrush, intersectionRect)
End Using
Next
Next
' Draw vertical walls or floor
For x As Integer = 0 To SQCOUNTX
For y As Integer = 0 To SQCOUNTY - 1
Dim wallRect As New Rectangle(
xOrigin + x * (SQSizeX + WALL_THICKNESS) - WALL_THICKNESS \ 2,
yOrigin + y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2,
WALL_THICKNESS,
SQSizeY
)
If x >= 0 AndAlso x < verticalWalls.Length AndAlso
verticalWalls(x) IsNot Nothing AndAlso
y >= 0 AndAlso y < verticalWalls(x).Length Then
If verticalWalls(x)(y) Then
' Draw wall
Using wallBrush As New HatchBrush(wallsHatchStyle, wallsColor1, wallsColor2)
g.FillRectangle(wallBrush, wallRect)
End Using
ElseIf Not useGradient Then
Using floorBrush As New HatchBrush(floorsHatchStyle, floorsColor1, floorsColor2)
g.FillRectangle(floorBrush, wallRect)
End Using
End If
End If
Next
Next
' Draw horizontal walls or floor
For x As Integer = 0 To SQCOUNTX - 1
For y As Integer = 0 To SQCOUNTY
Dim wallRect As New Rectangle(
xOrigin + x * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2,
yOrigin + y * (SQSizeY + WALL_THICKNESS) - WALL_THICKNESS \ 2,
SQSizeX,
WALL_THICKNESS
)
If x >= 0 AndAlso x < horizontalWalls.Length AndAlso
horizontalWalls(x) IsNot Nothing AndAlso
y >= 0 AndAlso y < horizontalWalls(x).Length Then
If horizontalWalls(x)(y) Then
' Draw wall
Using wallBrush As New HatchBrush(wallsHatchStyle, wallsColor1, wallsColor2)
g.FillRectangle(wallBrush, wallRect)
End Using
ElseIf Not useGradient Then
Using floorBrush As New HatchBrush(floorsHatchStyle, floorsColor1, floorsColor2)
g.FillRectangle(floorBrush, wallRect)
End Using
End If
End If
Next
Next
' Draw edge squares with the wall hatch style and colors
For x As Integer = 0 To SQCOUNTX - 1
For y As Integer = 0 To SQCOUNTY - 1
If floorsUseEdgeStyle IsNot Nothing AndAlso floorsUseEdgeStyle.Length > x AndAlso
floorsUseEdgeStyle(x) IsNot Nothing AndAlso floorsUseEdgeStyle(x).Length > y AndAlso
floorsUseEdgeStyle(x)(y) Then
Dim edgeRect As New Rectangle(
xOrigin + x * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2,
yOrigin + y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2,
SQSizeX,
SQSizeY
)
Using edgeBrush As New HatchBrush(wallsHatchStyle, wallsColor1, wallsColor2)
g.FillRectangle(edgeBrush, edgeRect)
End Using
End If
Next
Next
' Draw items
DrawItems(g)
DrawWallItems(g)
End Sub
Private Sub DrawItems(g As Graphics)
If placedItems Is Nothing Then Return
For x As Integer = 0 To placedItems.Length - 1
If placedItems(x) IsNot Nothing Then
For y As Integer = 0 To placedItems(x).Length - 1
Dim imageKey As String = placedItems(x)(y)
If Not String.IsNullOrEmpty(imageKey) AndAlso imageDictionary.ContainsKey(imageKey) Then
If imageKey = "picStart" Then
Continue For
End If
Dim img As Image = Nothing
If imageKey = "picGate" Then
If doorAnimationTimer IsNot Nothing AndAlso doorAnimationTimer.Enabled Then
img = imageDictionary(imageKey) ' Use the animated door image
Else
img = doorImage ' Use the static door image
End If
Else
img = imageDictionary(imageKey)
End If
Dim xPos As Integer = INDENT + x * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim yPos As Integer = INDENT + y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim destRect As New Rectangle(xPos, yPos, SQSizeX, SQSizeY)
g.DrawImage(img, destRect)
' Draw the number of remaining keys on the door
If imageKey = "picGate" Then
Dim remainingKeys As Integer = totalKeys - collectedKeys
Dim font As New Font("Arial", 12, FontStyle.Bold)
Dim textSize As SizeF = g.MeasureString(remainingKeys.ToString(), font)
Dim textX As Integer = xPos + (SQSizeX - textSize.Width) \ 2
Dim textY As Integer = yPos + (SQSizeY - textSize.Height) \ 2
g.DrawString(remainingKeys.ToString(), font, Brushes.White, textX, textY)
End If
End If
Next
End If
Next
For Each movingObject In movingObjects
Dim img As Image = Nothing
If movingObject.IsBall Then
img = imageDictionary("picBall")
ElseIf movingObject.IsBlock Then
img = imageDictionary("picBlock1")
End If
If img IsNot Nothing Then
Dim xPos As Integer = INDENT + movingObject.X * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim yPos As Integer = INDENT + movingObject.Y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim destRect As New Rectangle(xPos, yPos, SQSizeX, SQSizeY)
g.DrawImage(img, destRect)
End If
Next
' Draw baddies
For Each baddy In baddies
Dim img As Image = imageDictionary(baddy.ImageKey)
Dim xPos As Integer = INDENT + baddy.X * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim yPos As Integer = INDENT + baddy.Y * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim destRect As New Rectangle(xPos, yPos, SQSizeX, SQSizeY)
g.DrawImage(img, destRect)
Next
DrawPlayer(g)
End Sub
Private Sub DrawPlayer(g As Graphics)
Dim img As Image
Select Case lastDirection
Case "Left"
img = imageDictionary("picStartLeft")
Case "Right"
img = imageDictionary("picStartRight")
Case Else
img = imageDictionary("picStart")
End Select
Dim xPos As Integer = INDENT + playerX * (SQSizeX + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim yPos As Integer = INDENT + playerY * (SQSizeY + WALL_THICKNESS) + WALL_THICKNESS \ 2
Dim destRect As New Rectangle(xPos, yPos, SQSizeX, SQSizeY)
g.DrawImage(img, destRect)
End Sub
Private Sub DrawWallItems(g As Graphics)
If verticalWallItems IsNot Nothing Then
For x As Integer = 0 To verticalWallItems.Length - 1
If verticalWallItems(x) IsNot Nothing Then
For y As Integer = 0 To verticalWallItems(x).Length - 1
Dim imageKey As String = verticalWallItems(x)(y)
If Not String.IsNullOrEmpty(imageKey) AndAlso imageDictionary.ContainsKey(imageKey) Then
Dim img As Image = imageDictionary(imageKey)
ImageAnimator.UpdateFrames(img)
Dim wallX As Integer = INDENT + x * (SQSizeX + WALL_THICKNESS) - (WALL_THICKNESS \ 2)
Dim wallY As Integer = INDENT + y * (SQSizeY + WALL_THICKNESS) + (WALL_THICKNESS \ 2)
Dim wallWidth As Integer = WALL_THICKNESS
Dim wallHeight As Integer = SQSizeY
Dim newWidth As Integer = img.Width
Dim newHeight As Integer = wallHeight
Dim centeredX As Integer = wallX + (wallWidth - newWidth) \ 2
Dim drawRect As New Rectangle(centeredX, wallY, newWidth, newHeight)
g.DrawImage(img, drawRect)
End If
Next
End If
Next
End If
If horizontalWallItems IsNot Nothing Then
For x As Integer = 0 To horizontalWallItems.Length - 1
If horizontalWallItems(x) IsNot Nothing Then
For y As Integer = 0 To horizontalWallItems(x).Length - 1
Dim imageKey As String = horizontalWallItems(x)(y)
If Not String.IsNullOrEmpty(imageKey) AndAlso imageDictionary.ContainsKey(imageKey) Then
Dim img As Image = imageDictionary(imageKey)
ImageAnimator.UpdateFrames(img)
Dim wallX As Integer = INDENT + x * (SQSizeX + WALL_THICKNESS) + (WALL_THICKNESS \ 2)
Dim wallY As Integer = INDENT + y * (SQSizeY + WALL_THICKNESS) - (WALL_THICKNESS \ 2)
Dim wallWidth As Integer = SQSizeX
Dim wallHeight As Integer = WALL_THICKNESS
Dim newWidth As Integer = wallWidth
Dim newHeight As Integer = img.Height
Dim centeredY As Integer = wallY + (wallHeight - newHeight) \ 2
Dim drawRect As New Rectangle(wallX, centeredY, newWidth, newHeight)
g.DrawImage(img, drawRect)
End If
Next
End If
Next
End If
End Sub
Private Sub OnRedrawTick(sender As Object, e As EventArgs)
picTest.Invalidate()
CheckTriggers() ' Check triggers on every redraw tick
End Sub
Private Sub OnIdleTick(sender As Object, e As EventArgs)
lastDirection = "Idle"
End Sub
#End Region
#Region " Triggers "
Private Sub CheckTriggers()
For Each trigger In triggers
If CheckTriggerCondition(trigger) Then
ExecuteTriggerAction(trigger)
End If
Next
End Sub
Private Function CheckTriggerCondition(trigger As Trigger) As Boolean
If trigger.TriggerAction = "Enters" Then
If trigger.ItemType = "Any Block" Then
Debug.WriteLine($"Checking trigger for Any Block at ({trigger.TriggerSquare.X}, {trigger.TriggerSquare.Y})")
' Check for moving blocks
For Each movingObject In movingObjects
Debug.WriteLine($"Checking moving object at ({movingObject.X}, {movingObject.Y})")
If movingObject.IsBlock AndAlso movingObject.X = trigger.TriggerSquare.X AndAlso movingObject.Y = trigger.TriggerSquare.Y Then
Debug.WriteLine($"Trigger condition met for moving block at ({movingObject.X}, {movingObject.Y})")
Return True
End If
Next
' Check for stationary blocks
If placedItems IsNot Nothing AndAlso trigger.TriggerSquare.X >= 0 AndAlso trigger.TriggerSquare.X < placedItems.Length AndAlso placedItems(trigger.TriggerSquare.X) IsNot Nothing Then
Debug.WriteLine($"Checking stationary block at ({trigger.TriggerSquare.X}, {trigger.TriggerSquare.Y})")
If trigger.TriggerSquare.Y >= 0 AndAlso trigger.TriggerSquare.Y < placedItems(trigger.TriggerSquare.X).Length AndAlso placedItems(trigger.TriggerSquare.X)(trigger.TriggerSquare.Y) IsNot Nothing Then
Debug.WriteLine($"Stationary block found at ({trigger.TriggerSquare.X}, {trigger.TriggerSquare.Y})")
If placedItems(trigger.TriggerSquare.X)(trigger.TriggerSquare.Y) = "picBlock1" Then
Debug.WriteLine($"Trigger condition met for stationary block at ({trigger.TriggerSquare.X}, {trigger.TriggerSquare.Y})")
Return True
End If
End If
End If
ElseIf trigger.ItemType = "Player" Then
Debug.WriteLine($"Checking trigger for Player at ({trigger.TriggerSquare.X}, {trigger.TriggerSquare.Y})")
If playerX = trigger.TriggerSquare.X AndAlso playerY = trigger.TriggerSquare.Y Then
Debug.WriteLine($"Trigger condition met for Player at ({playerX}, {playerY})")
Return True
End If
End If
End If
' Add more conditions as needed
Return False
End Function
Private Sub ExecuteTriggerAction(trigger As Trigger)
If trigger.Action = "Remove" Then
' Implement the logic to remove an item
Dim itemToRemove As String = trigger.ItemToRemove
Dim coordinates As String() = itemToRemove.Split("_")
If coordinates.Length = 3 Then
Dim x As Integer = Integer.Parse(coordinates(1))
Dim y As Integer = Integer.Parse(coordinates(2))
If placedItems IsNot Nothing AndAlso x >= 0 AndAlso x < placedItems.Length AndAlso placedItems(x) IsNot Nothing Then
If y >= 0 AndAlso y < placedItems(x).Length Then
placedItems(x)(y) = Nothing
End If
End If
End If
ElseIf trigger.Action = "Create" Then
' Implement the logic to create an item
Dim x As Integer = trigger.ActionSquare.X
Dim y As Integer = trigger.ActionSquare.Y
If placedItems IsNot Nothing AndAlso x >= 0 AndAlso x < placedItems.Length AndAlso placedItems(x) IsNot Nothing Then
If y >= 0 AndAlso y < placedItems(x).Length Then
placedItems(x)(y) = trigger.ItemToCreate
End If
End If
End If
' Add more actions as needed
End Sub
#End Region
#Region "Closing"
Private Sub frmGame_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
StopAndDisposeAnimationTimer()
StopAndDisposeMovingObjectsTimer()
ClearMovingObjectsList()
StopMusicPlayback()
StopSoundEffects()
StopAndDisposeRedrawTimer()
StopAndDisposeIdleTimer()
End Sub
Private Sub StopAndDisposeIdleTimer()
If idleTimer IsNot Nothing Then
idleTimer.Stop()
idleTimer.Dispose()
idleTimer = Nothing
End If
End Sub
Private Sub StopAndDisposeAnimationTimer()
If animationTimer IsNot Nothing Then
animationTimer.Stop()
animationTimer.Dispose()
animationTimer = Nothing
End If
End Sub
Private Sub StopAndDisposeMovingObjectsTimer()
If movingObjectsTimer IsNot Nothing Then
movingObjectsTimer.Stop()
movingObjectsTimer.Dispose()
movingObjectsTimer = Nothing
End If
End Sub
Private Sub ClearMovingObjectsList()
movingObjects.Clear()
End Sub
Private Sub StopMusicPlayback()
musicManager.StopMusic()
End Sub
Private Sub StopSoundEffects()
sfxManager.StopSoundEffects()
End Sub
Private Sub StopAndDisposeRedrawTimer()
If redrawTimer IsNot Nothing Then
redrawTimer.Stop()
redrawTimer.Dispose()
redrawTimer = Nothing
End If
End Sub
Private Sub btnClose_Click(sender As Object, e As EventArgs) Handles btnCLose.Click
Close()
End Sub
#End Region
#Region "Utility Methods"
Private Function GetProjectDirectory() As String
Dim dir As DirectoryInfo = New DirectoryInfo(Application.StartupPath)
For i As Integer = 1 To 4
If dir.Parent IsNot Nothing Then
dir = dir.Parent
End If
Next
Return dir.FullName
End Function
Private Sub LoadRoomFromFile(filePath As String)
Try
Dim options As New JsonSerializerOptions With {
.IncludeFields = True,
.PropertyNameCaseInsensitive = True
}
Dim jsonString As String = File.ReadAllText(filePath)
Dim roomData As RoomData = JsonSerializer.Deserialize(Of RoomData)(jsonString, options)
If roomData Is Nothing Then
MessageBox.Show("Error: Failed to deserialize room data.")
Return
End If
RestoreRoomData(roomData)
CountKeysInGrid(roomData)
CountCoinsInGrid(roomData) ' Count the total number of coins available
' Invalidate the picTest control to redraw the grid
picTest.Invalidate()
Catch ex As Exception
MessageBox.Show("Error loading room: " & ex.ToString())
End Try
End Sub
Private Sub CountCoinsInGrid(roomData As RoomData)
totalCoins = 0
For x As Integer = 0 To roomData.placedItems.Length - 1
If roomData.placedItems(x) IsNot Nothing Then
For y As Integer = 0 To roomData.placedItems(x).Length - 1
If roomData.placedItems(x)(y) IsNot Nothing AndAlso roomData.placedItems(x)(y).ImageKey = "picCoin" Then
totalCoins += 1
End If
Next
End If
Next
UpdateCoinLabel()
End Sub
Private Sub CountKeysInGrid(roomData As RoomData)
totalKeys = 0
For x As Integer = 0 To roomData.placedItems.Length - 1
If roomData.placedItems(x) IsNot Nothing Then
For y As Integer = 0 To roomData.placedItems(x).Length - 1
If roomData.placedItems(x)(y) IsNot Nothing AndAlso roomData.placedItems(x)(y).ImageKey = "picKey" Then
totalKeys += 1
End If
Next
End If
Next
UpdateKeyLabel()
End Sub
Private Sub RestoreRoomData(roomData As RoomData)
Try
SQCOUNTX = roomData.GridSizeX
SQCOUNTY = roomData.GridSizeY
wallsHatchStyle = CType(roomData.wallsHatchStyleValue, HatchStyle)
wallsColor1 = Color.FromArgb(roomData.wallsColor1Argb)
wallsColor2 = Color.FromArgb(roomData.wallsColor2Argb)
floorsHatchStyle = CType(roomData.floorsHatchStyleValue, HatchStyle)
floorsColor1 = Color.FromArgb(roomData.floorsColor1Argb)
floorsColor2 = Color.FromArgb(roomData.floorsColor2Argb)
verticalWalls = roomData.verticalWalls
horizontalWalls = roomData.horizontalWalls
floorsUseEdgeStyle = roomData.floorsUseEdgeStyle
placedItems = RestorePlacedItems(roomData.placedItems)
verticalWallItems = RestorePlacedItems(roomData.verticalWallItems)
horizontalWallItems = RestorePlacedItems(roomData.horizontalWallItems)
SelectedMusic = roomData.SelectedMusic
lblName.Text = roomData.LevelName
PlaySelectedMusic()
' Ensure the useGradient property is restored
useGradient = roomData.useGradient
isRoomDataLoaded = True
picTest.Invalidate()
Catch ex As Exception
MessageBox.Show("Error restoring room data: " & ex.ToString())
End Try
End Sub
Private Function RestorePlacedItems(data As PlacedItemData()()) As String()()
If data Is Nothing Then Return Nothing
Dim lengthOuter As Integer = data.Length
Dim restoredItems As String()() = New String(lengthOuter - 1)() {}
For x As Integer = 0 To lengthOuter - 1
If data(x) IsNot Nothing Then
Dim lengthInner As Integer = data(x).Length
restoredItems(x) = New String(lengthInner - 1) {}
For y As Integer = 0 To lengthInner - 1
If data(x)(y) IsNot Nothing Then
restoredItems(x)(y) = data(x)(y).ImageKey
Else
restoredItems(x)(y) = Nothing
End If
Next
Else
restoredItems(x) = Nothing
End If
Next
Return restoredItems
End Function
Private Sub OnItemAnimationTick(sender As Object, e As EventArgs)
For i As Integer = itemAnimations.Count - 1 To 0 Step -1
Dim itemAnimation = itemAnimations(i)
itemAnimation.UpdatePosition()
If itemAnimation.IsAnimationComplete() Then
itemAnimations.RemoveAt(i)
End If
Next
' No need to invalidate here, the redraw timer will handle it
End Sub
Private Sub btnRetry_Click(sender As Object, e As EventArgs) Handles btnRetry.Click
RestartLevel()
End Sub
Private Sub RestartLevel()
' Reload the room data to reset the placedItems array
LoadRoomData()
' Reset player position
FindPlayerStartPosition()
' Reset collected items
CollectedCoins = 0
collectedKeys = 0
UpdateCoinLabel()
UpdateKeyLabel()
' Reset moving objects
movingObjects.Clear()
AddObjectsOnFlippersToMovingObjects()
' Reset animations
itemAnimations.Clear()
End Sub
Private Sub btnMinimize_Click(sender As Object, e As EventArgs) Handles btnMinimize.Click
Me.WindowState = FormWindowState.Minimized
End Sub
Protected Overrides ReadOnly Property CreateParams() As CreateParams
Get
Dim cp As CreateParams = MyBase.CreateParams
cp.ExStyle = cp.ExStyle Or &H2000000 ' WS_EX_COMPOSITED
Return cp
End Get
End Property
#End Region
End Class
Public Class DoubleBufferedPictureBox
Inherits PictureBox
Public Sub New()
Me.DoubleBuffered = True
End Sub
End Class
Public Class NoBorderToolStripRenderer
Inherits ToolStripRenderer
Protected Overrides Sub OnRenderToolStripBorder(e As ToolStripRenderEventArgs)
' Do nothing to prevent the border from being drawn
End Sub
Protected Overrides Sub OnRenderButtonBackground(e As ToolStripItemRenderEventArgs)
' Do nothing to prevent the button background from being drawn
End Sub
Protected Overrides Sub OnRenderItemBackground(e As ToolStripItemRenderEventArgs)
' Do nothing to prevent the item background from being drawn
End Sub
End Class
' SelectedObject class
Public Class SelectedObject
Public Property Type As String ' "Square" or "Item"
Public Property Coordinates As Point? ' Use Point? to allow for Nothing
Public Property ImageKey As String
End Class
' GameTrigger class
Public Class GameTrigger
Public Property Condition As TriggerCondition
Public Property Action As TriggerAction
End Class
' TriggerCondition class
Public Class TriggerCondition
Public Property Subject As SelectedObject
Public Property Action As String ' For example, "Enters"
Public Property ObjectRef As SelectedObject
End Class
' TriggerAction class
Public Class TriggerAction
Public Property ActionType As String ' "Create" or "Remove"
Public Property Item As String
Public Property Target As SelectedObject
End Class
' Trigger class
Public Class Trigger
Public Property ItemType As String
Public Property TriggerAction As String
Public Property Action As String
Public Property ItemToCreate As String
Public Property TriggerSquare As Point
Public Property ActionSquare As Point
Public Property ItemToRemove As String
Public Overrides Function ToString() As String
If Action = "Remove" Then
Return $"When {ItemType} {TriggerAction} Square ({TriggerSquare.X}, {TriggerSquare.Y}), Remove {ItemToRemove} from the game."
Else
Return $"When {ItemType} {TriggerAction} Square ({TriggerSquare.X}, {TriggerSquare.Y}), {Action} a {ItemToCreate} at Square ({ActionSquare.X}, {ActionSquare.Y})."
End If
End Function
End Class
Can you see why my triggers are not working correctly...
I have 2 triggers...
When Any Block Enters Cell Square (7, 4), Remove BlockStopper_9_8 from the game.
When Player (Start) Enters Cell Square (8, 5), Create a Block Stopper at Square (10, 5).
This is the output...
Checking trigger for Any Block at (2, 4)
Checking stationary block at (2, 4)
As you can see, the output is COMPLETELY wrong