Pathfinder toimii teoriassa näin:
1. Etsitään vapaita paloja joka suunnalta (suuntia on 4).
2. Jos löydetään vapaa pala, siirrytään siihen välittömästi. Vapaa pala on pala johon ei ole esteitä, eikä siinä olla käyty vielä kertaakaan.
3. Asetetaan tämän uuden palan dataan tieto edellisen palan koordinaateista. Sen lisäksi laitetaan palaan tieto, että sitä on jo käytetty.
4. Hypätään kohtaan 1.
5. Kun tullaan umpikujaan (vapaita reittejä ei enää ole), palataan edelliseen palaan käyttäen tiedossa olevia koordinaatteja. Hypätään kohtaan 1.
6. Jos löydetään tavoite-koordinaatit, palautetaan yksinkertaisesti True.
7. Logiikan mukaan pathfinderin pitäisi käydä kaikki haarautumat ja palata lopulta ekaan palaan. Jos ollaan ensimmäisessä palassa, eikä vapaita paloja ympärillä ole, ei tavoitetta löydetty. Palautetaan False.
Tällä hetkellä pathfinder ei jostain syystä löydä kaikkia vapaita paloja.
Code: Select all
SCREEN 1024, 768
Dim dLauta( 7, 7, 1 )
Dim dMove( 7, 7, 2 )
plX = 1
plY = 1
Repeat
For x = 1 To 7
For y = 1 To 7
Color cbWhite
Box x * 64, y * 64, 64, 64, 0
Select dLauta( x, y, 0 )
Case 1
Line x * 64 + 32, y * 64, x * 64 + 32, ( y + 1 ) * 64
Case 2
Line x * 64, y * 64 + 32, ( x + 1 ) * 64, y * 64 + 32
Case 3
Line x * 64 + 32, y * 64, x * 64 + 32, y * 64 + 32
Line x * 64 + 32, y * 64 + 32, ( x + 1 ) * 64, y * 64 + 32
Case 4
Line x * 64 + 32, y * 64 + 32, x * 64 + 32, ( y + 1 ) * 64
Line x * 64 + 32, y * 64 + 32, ( x + 1 ) * 64, y * 64 + 32
Case 5
Line x * 64 + 32, y * 64 + 32, x * 64 + 32, ( y + 1 ) * 64
Line x * 64, y * 64 + 32, x * 64 + 32, y * 64 + 32
Case 6
Line x * 64 + 32, y * 64, x * 64 + 32, y * 64 + 32
Line x * 64, y * 64 + 32, x * 64 + 32, y * 64 + 32
Case 7
Line x * 64 + 32, y * 64, x * 64 + 32, ( y + 1 ) * 64
Line x * 64 + 32, y * 64 + 32, ( x + 1 ) * 64, y * 64 + 32
Case 8
Line x * 64 + 32, y * 64 + 32, x * 64 + 32, ( y + 1 ) * 64
Line x * 64, y * 64 + 32, ( x + 1 ) * 64, y * 64 + 32
Case 9
Line x * 64 + 32, y * 64, x * 64 + 32, ( y + 1 ) * 64
Line x * 64, y * 64 + 32, x * 64 + 32, y * 64 + 32
Case 10
Line x * 64 + 32, y * 64, x * 64 + 32, y * 64 + 32
Line x * 64, y * 64 + 32, ( x + 1 ) * 64, y * 64 + 32
End Select
Text x * 64, y * 64, dLauta( x, y, 0 )
Color cbRed
If dMove( x, y, 0 ) = 1 Then
Circle x * 64 + 32, y * 64 + 32, 10
EndIf
Next y
Next x
startX = 64
startY = 64
_iX = ( MouseX() - startX ) / 64 + 1
_iY = ( MouseY() - startY ) / 64 + 1
If MouseX() < startX Then _iX = 0
If MouseY() < startY Then _iY = 0
If MouseHit( 1 ) Then
If InMap( _iX, _iY ) Then
plX = _iX
plY = _iY
EndIf
EndIf
Circle plX * 64 + 32, plY * 64 + 32, 20
If FindRoute( plX, plY, _iX, _iY ) = False Then
Color cbRed
Else
Color cbWhite
EndIf
Box MouseX() - 10, MouseY() - 10, 20, 20, 0
Color cbWhite
If KeyHit( CbKeyReturn ) Then
For x = 1 To 7
For y = 1 To 7
dLauta( x, y, 0 ) = Rand( 1, 10 )
Next y
Next x
EndIf
Text 20, 0, _iX + " " + _iY
Text 20, 13, "Hiiri1 siirtää aloitusta..."
Text 20, 26, "Enter luo mapin."
DrawScreen
Forever
Function FindRoute( _startX, _startY, _endX, _endY )
//nollataan alue
For x = 1 To 7
For y = 1 To 7
For i = 0 To 2
dMove( x, y, i ) = 0
Next i
Next y
Next x
If InMap( _endX, _endY ) = False Then Return False
If _startX = _endX And _startY = _endY Then Return True
_seekX = _startX
_seekY = _startY
dMove( _startX, _startY, 0 ) = 1
dMove( _startX, _startY, 1 ) = _startX
dMove( _startX, _startY, 2 ) = _startY
While True
bExit = False
For x = -1 To 1
For y = -1 To 1
If x = 0 Xor y = 0 Then
If InMap( _seekX + x, _seekY + y ) Then
//jos alue on vapaa...
If CheckCollision( _seekX, _seekY, _seekX + x, _seekY + y ) Then
//jos löydettiin tavoite, palautetaan True
If _seekX + x = _endX And _seekY + y = _endY Then
Return True
EndIf
//jos palassa ei vielä olla käyty...
If dMove( _seekX + x, _seekY + y, 0 ) = 0 Then
Color cbRed
Circle ( _seekX + x ) * 64 + 32, ( _seekY + y ) * 64 + 32, 10
//laitetaan muistiin että nykyinen pala on jo "käytetty"
dMove( _seekX + x, _seekY + y, 0 ) = 1
dMove( _seekX + x, _seekY + y, 0 ) = 1
//asetetaan siirryttävään palaan tieto, mistä palasta siihen siirryttiin
dMove( _seekX + x, _seekY + y, 1 ) = _seekX
dMove( _seekX + x, _seekY + y, 2 ) = _seekY
//siirrytään palaan...
_seekX = _seekX + x
_seekY = _seekY + y
bExit = True
Exit
EndIf
EndIf
EndIf
EndIf
Next y
If bExit = True Then Exit
Next x
//jos ei löydetty yhtäkään palaa mihin voi liikkua...
If bExit = False Then
//tavoitetta ei löydetty, palautetaan false
If _seekX = _startX And _seekY = _startY Then
Return False
EndIf
//asetetaan muistiin että pala on jo käytetty.
dMove( _seekX, _seekY, 0 ) = 1
//jos vielä ei olla alkupalassa, niin siirrytään edelliseen palaan...
_seekX = dMove( _seekX, _seekY, 1 )
_seekY = dMove( _seekX, _seekY, 2 )
EndIf
Wend
End Function
Function CheckCollision( _x1, _y1, _x2, _y2 )
_data = dLauta( _x1, _y1, 0 )
Select _data
Case 1
_ylä = True
_ala = True
Case 2
_vasen = True
_oikea = True
Case 3
_ylä = True
_oikea = True
Case 4
_ala= True
_oikea = True
Case 5
_vasen = True
_ala = True
Case 6
_ylä = True
_vasen = True
Case 7
_ylä = True
_ala = True
_oikea = True
Case 8
_vasen = True
_oikea = True
_ala = True
Case 9
_ylä = True
_vasen = True
_ala = True
Case 10
_vasen= True
_ylä = True
_oikea = True
End Select
_data = dLauta( _x2, _y2, 0 )
Select _data
Case 1
_ylä2 = True
_ala2 = True
Case 2
_vasen2 = True
_oikea2 = True
Case 3
_ylä2 = True
_oikea2 = True
Case 4
_ala2= True
_oikea2 = True
Case 5
_vasen2 = True
_ala2 = True
Case 6
_ylä2 = True
_vasen2 = True
Case 7
_ylä2 = True
_ala2 = True
_oikea2 = True
Case 8
_vasen2 = True
_oikea2 = True
_ala2 = True
Case 9
_ylä2 = True
_vasen2 = True
_ala2 = True
Case 10
_vasen2 = True
_ylä2 = True
_oikea2 = True
End Select
If _x1 < _x2 Then
If _oikea And _vasen2 Then Return True
ElseIf _x1 > _x2 Then
If _vasen And _oikea2 Then Return True
ElseIf _y1 < _y2 Then
If _ala And _ylä2 Then Return True
ElseIf _y1 > _y2 Then
If _ylä And _ala2 Then Return True
EndIf
Return False
End Function
Function InMap( _x, _y )
If _x > 0 And _x < 8 And _y > 0 And _y < 8 Then Return True
End Function