Function CanEventMoveTowardsPlayer(playerID As Long, MapNum As Long, eventID As Long) As Long
Dim i As Long, x As Long, y As Long, x1 As Long, y1 As Long, didwalk As Boolean, WalkThrough As Long
Dim tim As Long, sX As Long, sY As Long, pos(,) As Long, reachable As Boolean, j As Long, LastSum As Long, Sum As Long, FX As Long, FY As Long
Dim path(,) As Vector, LastX As Long, LastY As Long, did As Boolean
'This does not work for global events so this MUST be a player one....
'This Event returns a direction, 4 is not a valid direction so we assume fail unless otherwise told.
CanEventMoveTowardsPlayer = 4
If playerID <= 0 Or playerID > MAX_PLAYERS Then Exit Function
If MapNum <= 0 Or MapNum > MAX_MAPS Then Exit Function
If eventID <= 0 Or eventID > TempPlayer(playerID).EventMap.CurrentEvents Then Exit Function
x = GetPlayerX(playerID)
y = GetPlayerY(playerID)
x1 = TempPlayer(playerID).EventMap.EventPages(eventID).X
y1 = TempPlayer(playerID).EventMap.EventPages(eventID).Y
WalkThrough = Map(MapNum).Events(TempPlayer(playerID).EventMap.EventPages(eventID).EventID).Pages(TempPlayer(playerID).EventMap.EventPages(eventID).PageID).WalkThrough
'Add option for pathfinding to random guessing option.
If PathfindingType = 1 Then
i = Int(Rnd() * 5)
didwalk = False
' Lets move the event
Select Case i
Case 0
' Up
If y1 > y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then
CanEventMoveTowardsPlayer = DIR_UP
Exit Function
didwalk = True
End If
End If
' Down
If y1 < y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then
CanEventMoveTowardsPlayer = DIR_DOWN
Exit Function
didwalk = True
End If
End If
' Left
If x1 > x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then
CanEventMoveTowardsPlayer = DIR_LEFT
Exit Function
didwalk = True
End If
End If
' Right
If x1 < x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then
CanEventMoveTowardsPlayer = DIR_RIGHT
Exit Function
didwalk = True
End If
End If
Case 1
' Right
If x1 < x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then
CanEventMoveTowardsPlayer = DIR_RIGHT
Exit Function
didwalk = True
End If
End If
' Left
If x1 > x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then
CanEventMoveTowardsPlayer = DIR_LEFT
Exit Function
didwalk = True
End If
End If
' Down
If y1 < y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then
CanEventMoveTowardsPlayer = DIR_DOWN
Exit Function
didwalk = True
End If
End If
' Up
If y1 > y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then
CanEventMoveTowardsPlayer = DIR_UP
Exit Function
didwalk = True
End If
End If
Case 2
' Down
If y1 < y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then
CanEventMoveTowardsPlayer = DIR_DOWN
Exit Function
didwalk = True
End If
End If
' Up
If y1 > y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then
CanEventMoveTowardsPlayer = DIR_UP
Exit Function
didwalk = True
End If
End If
' Right
If x1 < x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then
CanEventMoveTowardsPlayer = DIR_RIGHT
Exit Function
didwalk = True
End If
End If
' Left
If x1 > x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then
CanEventMoveTowardsPlayer = DIR_LEFT
Exit Function
didwalk = True
End If
End If
Case 3
' Left
If x1 > x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_LEFT, False) Then
CanEventMoveTowardsPlayer = DIR_LEFT
Exit Function
didwalk = True
End If
End If
' Right
If x1 < x And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_RIGHT, False) Then
CanEventMoveTowardsPlayer = DIR_RIGHT
Exit Function
didwalk = True
End If
End If
' Up
If y1 > y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_UP, False) Then
CanEventMoveTowardsPlayer = DIR_UP
Exit Function
didwalk = True
End If
End If
' Down
If y1 < y And Not didwalk Then
If CanEventMove(playerID, MapNum, x1, y1, eventID, WalkThrough, DIR_DOWN, False) Then
CanEventMoveTowardsPlayer = DIR_DOWN
Exit Function
didwalk = True
End If
End If
End Select
CanEventMoveTowardsPlayer = Random(0, 3)
ElseIf PathfindingType = 2 Then
'Initialization phase
tim = 0
sX = x1
sY = y1
FX = x
FY = y
ReDim pos(0 To Map(MapNum).MaxX, 0 To Map(MapNum).MaxY)
'CacheMapBlocks mapnum
pos = MapBlocks(MapNum).Blocks
For i = 1 To TempPlayer(playerID).EventMap.CurrentEvents
If TempPlayer(playerID).EventMap.EventPages(i).Visible Then
If TempPlayer(playerID).EventMap.EventPages(i).WalkThrough = 1 Then
pos(TempPlayer(playerID).EventMap.EventPages(i).X, TempPlayer(playerID).EventMap.EventPages(i).Y) = 9
End If
End If
Next
pos(sX, sY) = 100 + tim
pos(FX, FY) = 2
'reset reachable
reachable = False
'Do while reachable is false... if its set true in progress, we jump out
'If the path is decided unreachable in process, we will use exit sub. Not proper,
'but faster ;-)
Do While reachable = False
'we loop through all squares
For j = 0 To Map(MapNum).MaxY
For i = 0 To Map(MapNum).MaxX
'If j = 10 And i = 0 Then MsgBox "hi!"
'If they are to be extended, the pointer TIM is on them
If pos(i, j) = 100 + tim Then
'The part is to be extended, so do it
'We have to make sure that there is a pos(i+1,j) BEFORE we actually use it,
'because then we get error... If the square is on side, we dont test for this one!
If i < Map(MapNum).MaxX Then
'If there isnt a wall, or any other... thing
If pos(i + 1, j) = 0 Then
'Expand it, and make its pos equal to tim+1, so the next time we make this loop,
'It will exapand that square too! This is crucial part of the program
pos(i + 1, j) = 100 + tim + 1
ElseIf pos(i + 1, j) = 2 Then
'If the position is no 0 but its 2 (FINISH) then Reachable = true!!! We found end
reachable = True
End If
End If
'This is the same as the last one, as i said a lot of copy paste work and editing that
'This is simply another side that we have to test for... so instead of i+1 we have i-1
'Its actually pretty same then... I wont comment it therefore, because its only repeating
'same thing with minor changes to check sides
If i > 0 Then
If pos((i - 1), j) = 0 Then
pos(i - 1, j) = 100 + tim + 1
ElseIf pos(i - 1, j) = 2 Then
reachable = True
End If
End If
If j < Map(MapNum).MaxY Then
If pos(i, j + 1) = 0 Then
pos(i, j + 1) = 100 + tim + 1
ElseIf pos(i, j + 1) = 2 Then
reachable = True
End If
End If
If j > 0 Then
If pos(i, j - 1) = 0 Then
pos(i, j - 1) = 100 + tim + 1
ElseIf pos(i, j - 1) = 2 Then
reachable = True
End If
End If
End If
DoEvents()
Next i
Next j
'If the reachable is STILL false, then
If reachable = False Then
'reset sum
Sum = 0
For j = 0 To Map(MapNum).MaxY
For i = 0 To Map(MapNum).MaxX
'we add up ALL the squares
Sum = Sum + pos(i, j)
Next i
Next j
'Now if the sum is euqal to the last sum, its not reachable, if it isnt, then we store
'sum to lastsum
If Sum = LastSum Then
CanEventMoveTowardsPlayer = 4
Exit Function
Else
LastSum = Sum
End If
End If
'we increase the pointer to point to the next squares to be expanded
tim = tim + 1
Loop
'We work backwards to find the way...
LastX = FX
LastY = FY
ReDim path(tim + 1)
'The following code may be a little bit confusing but ill try my best to explain it.
'We are working backwards to find ONE of the shortest ways back to Start.
'So we repeat the loop until the LastX and LastY arent in start. Look in the code to see
'how LastX and LasY change
Do While LastX <> sX Or LastY <> sY
'We decrease tim by one, and then we are finding any adjacent square to the final one, that
'has that value. So lets say the tim would be 5, because it takes 5 steps to get to the target.
'Now everytime we decrease that, so we make it 4, and we look for any adjacent square that has
'that value. When we find it, we just color it yellow as for the solution
tim = tim - 1
'reset did to false
did = False
'If we arent on edge
If LastX < Map(MapNum).MaxX Then
'check the square on the right of the solution. Is it a tim-1 one? or just a blank one
If pos(LastX + 1, LastY) = 100 + tim Then
'if it, then make it yellow, and change did to true
LastX = LastX + 1
did = True
End If
End If
'This will then only work if the previous part didnt execute, and did is still false. THen
'we want to check another square, the on left. Is it a tim-1 one ?
If did = False Then
If LastX > 0 Then
If pos(LastX - 1, LastY) = 100 + tim Then
LastX = LastX - 1
did = True
End If
End If
End If
'We check the one below it
If did = False Then
If LastY < Map(MapNum).MaxY Then
If pos(LastX, LastY + 1) = 100 + tim Then
LastY = LastY + 1
did = True
End If
End If
End If
'And above it. One of these have to be it, since we have found the solution, we know that already
'there is a way back.
If did = False Then
If LastY > 0 Then
If pos(LastX, LastY - 1) = 100 + tim Then
LastY = LastY - 1
End If
End If
End If
path(tim).x = LastX
path(tim).y = LastY
'Now we loop back and decrease tim, and look for the next square with lower value
DoEvents()
Loop
'Ok we got a path. Now, lets look at the first step and see what direction we should take.
If path(1).x > LastX Then
CanEventMoveTowardsPlayer = DIR_RIGHT
ElseIf path(1).y > LastY Then
CanEventMoveTowardsPlayer = DIR_DOWN
ElseIf path(1).y < LastY Then
CanEventMoveTowardsPlayer = DIR_UP
ElseIf path(1).x < LastX Then
CanEventMoveTowardsPlayer = DIR_LEFT
End If
End If
End Function
im working on the event system for orion, but i hit a little snag, the path finding subs use vector for position, but there are no vectors in vb.net
1 suggestion i was given was using key value pairs, but i have no clue if that will work.
so my question, mainly to JC, because he made the damn system , is, what can i use to replace the vector with??
Dami
