Timeshifter,
As per our PM here is how the algorithm works:
Declarations:
Standard API declares for RECT's and Regions, Poly's and Fill are used and supporting types and constants. The only custom declaration is the Enum for the loop logic.
Code:
Enum Logic
Origin = 1
Target = 2
Victory = 3
Idle = 4
Init = 5
quit = 6
Defeat = 7
Lattice = 8
End Enum
This is a mini scritpting system that controls the sequence of events.
The Variables
- hRgn() - All hexes are defined as regions
- Think - Token using logic enum for flow control
- FindPath - Stores beginning and end coords in RECT structure
- GameOn - boolean that keeps loop looping
- LastPath - see next comment
- TailCount - keeps track of last 100 locations for backing out of dead ends and stops endless loops - increase this for larger grids!
- Tailend stores end of path for restoring
- DeadEnds - tracks dead ends
Making the Lattice
- PI = Atn(1) * 4 = best way to define PI in VB
- NumCoords = 6 - It' a hex
- hexrad = Me.ScaleWidth / 25 - and it's 25 across
- INC = pi / 3 - the equivalent to 60 degrees
- latX = Cos(INC) * hexrad - convert 60 degrees to x and y
- latY = Sin(INC) * hexrad - " "
Create regions in windows for hex:
Code:
ReDim hRgn(0 To Me.ScaleWidth / 50, 0 To Me.ScaleHeight / hexrad)
Draw hexes on screen - mostly brown and some green randomnly:
Code:
For y = 0 To Me.ScaleHeight / hexrad
For x = 0 To Me.ScaleWidth / 50
For j = 1 To 6
i = j * INC
poly(j).x = Cos(i) * hexrad + latX * x + hexrad * x
poly(j).y = Sin(i) * hexrad + latY * (x And 1) + y * latY * 2
Next
Me.FillColor = Choose(Int(Rnd() * 4) + 1, RGB(192, 192, 0), _
RGB(64, 255, 64), RGB(192, 192, 0), RGB(192, 192, 0))
Polygon Me.hdc, poly(1), NumCoords
hRgn(x, y) = CreatePolygonRgn(poly(1), NumCoords, ALTERNATE)
Next
Next
The y axis wobble is created by offsetting the 60 degrees for even and odd hexes in this part of the routine
Code:
latY * (x And 1) + y
*Note that regions have to be deleted before redraing the Lattice.
Navigation Algorithm
There are 2 Key routines that support the path finding logic:
1. The Cartesian 2 hex translation - I believe in precomputing as much as possible for speed. OE is the odd even bit used to translate the y axis wobble.
Code:
Private Function NPair(OE As Integer, ByVal nav As Integer) As COORD
'LATTICE lOGIC
NPair.x = Choose(nav, -1, 0, -1, 1, 0, 1)
NPair.y = Choose(nav, -1 + OE, -1, 0 + OE, -1 + OE, 1, 0 + OE)
End Function
2. Check block colors for collision- yes it's an archaic throwback to the commodore 64 but it works. Using GetRgnBox and finding the center pixel color. I am also checking check for boundaries. If your filling your hexes with graphics and not colors - keep refence array for this type of collision detection.
Note that the LastPath and borders are also checked.
Code:
Function CheckBlock(ByVal x1 As Integer, ByVal y1 As Integer) As Boolean
Dim box As RECT, color As Long
If x1 < 0 Or x1 > UBound(hRgn, 1) Then
CheckBlock = False
Exit Function
ElseIf y1 < 0 Or y1 > UBound(hRgn, 2) Then
CheckBlock = False
Exit Function
ElseIf DeadEnds(x1, y1) Then
CheckBlock = False
Exit Function
ElseIf LastPath(x1, y1) Then
CheckBlock = False
Exit Function
End If
GetRgnBox hRgn(x1, y1), box
color = GetPixel(Me.hdc, (box.Left + box.Right) / 2, (box.Top + box.Bottom) / 2)
If color = RGB(192, 192, 0) Then
CheckBlock = True
Else
CheckBlock = False
End If
End Function
Now for the main AI routine PlotPath. I'm going to explain it little by little since it is kind of complex
Necessary Evils:
Note we're setting up to sort and paint
Code:
Sub plotpath()
Dim DONE As Boolean, PlotX As Integer, Ploty As Integer
Dim hbrush As Long, pause As Long, x1 As Integer, y1 As Integer
Dim x As Single, OE As Integer, i As Integer, lost As Boolean
Dim Sort(1 To 6, 0 To 1) As Single, sTmp As COORD, tmp As Single
Contstants for sorting array
Code:
Const Index = 0
Const Dist = 1
Initialize the path history with current location
Code:
Erase LastPath
ReDim LastPath(0 To UBound(hRgn, 1), 0 To UBound(hRgn, 2))
Erase DeadEnds
ReDim DeadEnds(0 To UBound(hRgn, 1), 0 To UBound(hRgn, 2))
LastPath(FindPath.Left, FindPath.Top) = True
TailCount = 0
Tailend.x = FindPath.Left
Tailend.y = FindPath.Top
start pathfinding loop and set up a drawing delay that's easy on the eyes.
Code:
Do While Not DONE
'sell the drama -LET'S SLOW IT DOWN
pause = GetTickCount + 50
While pause > GetTickCount
DoEvents
Wend
check if your at your destination - you can also use abs()
set the flag and end the loop if you are.
Code:
'get bearings
PlotX = Sgn(FindPath.Right - FindPath.Left)
Ploty = Sgn(FindPath.Bottom - FindPath.Top)
OE = FindPath.Left And 1
'think
'Check Arrive
If PlotX = 0 And Ploty = 0 Then
Think = Victory
DONE = True
If your not start the logic as if your lost - which you are.
Scan all hexes around your current location and use the Pythagorean theorem to determine their distance to the destination. If the hex you check is out of bound store a really far distance.
I all hexes are out of bounds the lost flag remains true. If you do have a spot to move to then it becomes false.
Code:
Else
lost = True
For i = 1 To 6
If CheckBlock(NPair(OE, i).x + FindPath.Left, _
NPair(OE, i).y + FindPath.Top) Then
sTmp.x = FindPath.Left + NPair(OE, i).x
sTmp.y = FindPath.Top + NPair(OE, i).y
x = Sqr((FindPath.Right - sTmp.x) ^ 2 + (FindPath.Bottom - sTmp.y) ^ 2)
Sort(i, Index) = i
Sort(i, Dist) = x
lost = False
Else
Sort(i, Index) = i
Sort(i, Dist) = 65535
End If
Next
Are we lost??? If we are that means we've hit a dead end so clear the path history mark your current location, that way you will back out of the dead end. Keep Track of dead ends, but don't erase them.
Code:
If lost Then
Erase LastPath
ReDim LastPath(0 To UBound(hRgn, 1), 0 To UBound(hRgn, 2))
LastPath(FindPath.Left, FindPath.Top) = True
DeadEnds(FindPath.Left, FindPath.Top) = True
Else
Not lost - sort the hexes around you to see which is closest to your destination cause that's where your going.
Code:
'sort
i = 1
While i < 7
If i = 1 Then
i = i + 1
ElseIf Sort(i - 1, Dist) <= Sort(i, Dist) Then
i = i + 1
Else
tmp = Sort(i, Dist): Sort(i, Dist) = Sort(i - 1, Dist): Sort(i - 1, Dist) = tmp
tmp = Sort(i, Index): Sort(i, Index) = Sort(i - 1, Index): Sort(i - 1, Index) = tmp
i = i - 1
End If
Wend
Now go there! Don't forget your path history. I've limit it to 100 but you can make it bigger for bigger boards with larger bottlenecks and dead ends. I used 15% of the board - that seems to work good.
Code:
'use closest
FindPath.Left = FindPath.Left + NPair(OE, Sort(1, Index)).x
FindPath.Top = FindPath.Top + NPair(OE, Sort(1, Index)).y
LastPath(FindPath.Left, FindPath.Top) = True
TailCount = (TailCount + 1) Mod 100
If TailCount = 0 Then
LastPath(Tailend.x, Tailend.y) = False
Tailend.x = FindPath.Right
Tailend.y = FindPath.Bottom
End If
End If
End If
Draw the graphics - its time
Code:
If Not DONE Then
Me.Cls
hbrush = CreateSolidBrush(RGB(255, 0, 0))
x1 = FindPath.Left
y1 = FindPath.Top
FillRgn Me.hdc, hRgn(x1, y1), hbrush
DeleteObject hbrush
End If
Viola! Loop 'til your there or you want to escape!
Code:
If Think = quit Or Think = Init Then DONE = True
Loop
End Sub
Reply With Quote
