Damian666 Posted November 30, 2015 Share Posted November 30, 2015 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 Link to comment Share on other sites More sharing options...
Rob Janes Posted November 30, 2015 Share Posted November 30, 2015 Vector calculations in VB6 were a part of DirectX 7 or 8 depending on which version of Eclipse you were using. You'd need to import a geometry library into VB.NET to calculate vectors, there's a few options out there, you could also import Microsoft.DirectX and Microsoft.Direct3D / X as well. Honestly though, you could probably develop your own path finding algorithm without a ton of work using a few embedded if statements and loops. It wouldn't be ideal, but would probably work just as well for what you need. Link to comment Share on other sites More sharing options...
Damian666 Posted November 30, 2015 Author Share Posted November 30, 2015 i see, its not something easely fixed by using a double to store them? fucking hell >.< edit, added the function in question for clarity Link to comment Share on other sites More sharing options...
jcsnider Posted December 1, 2015 Share Posted December 1, 2015 Replace vector with System.Drawing.Point Link to comment Share on other sites More sharing options...
Damian666 Posted December 1, 2015 Author Share Posted December 1, 2015 Wtf, why did i not come up with that Link to comment Share on other sites More sharing options...
jcsnider Posted December 1, 2015 Share Posted December 1, 2015 Marked as solved. Let me know if you have any other issues porting that code Link to comment Share on other sites More sharing options...
Damian666 Posted December 1, 2015 Author Share Posted December 1, 2015 oh yeah sorry, i forgot that and trust me, i will xD so far so good though easy for you perhaps later on, converting to C is a breeze i guess Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now