I have been working on a pseudo-A* kind of routine, but I have a problem.
The problem seems to occur when the best route seems to take the moving object back to where it last was, thereby creating an infinite pattern of repeated steps back and forth.
Not sure how best to fix it... Any help would be greatly recommended.
I appreciate the following code will not run as-is, but I hope that it will be clear enough - The main A-Star routine (and where the problem occurs) is "GetAStarBest(Location,Target)"
;Declarations
Global LevelDataFilePath$
Global LevelImageFilePath$
Global MapImage
Global ASTarBank
Global X_Offset
Global Y_Offset
Type Blobs
Field Location
Field Colour
Field Image
End Type
Global Move.Blobs
Global Destination.Blobs
Global LastValue#
;Example
RunTime
;Functions
Function RunTime()
Initialise
While (Not( (KeyDown(1) + KeyHit(1))))
Loop
Wend
CloseDown
End Function
Function CloseDown()
FreeImage MapImage
FreeImage Move\Image
FreeImage Destination\Image
Delete Each Blobs
EndGraphics
End
End Function
Function Initialise()
Graphics GadgetWidth(Desktop()),GadgetHeight(Desktop()),32,2
SetBuffer(BackBuffer())
SeedRnd MilliSecs()
LevelDataFilePath$=CurrentDir()+"OutPut.dat"
LevelImageFilePath$=CurrentDir()+"Temp.png"
MapImage=SetMapImage()
ASTarBank=SetAStarData()
SetMoveBlob
SetDestinationBlob
X_Offset=(GraphicsWidth()-512)*0.5
Y_Offset=(GraphicsHeight()-512)*0.5
LastValue#=256.0*(Sqr(512+512))
End Function
Function Loop()
MoveBlob
UpdateScreen
End Function
Function UpdateScreen()
Cls
DrawImage MapImage,X_Offset,Y_Offset
DrawBlobs
Flip
End Function
Function MoveBlob()
If (move\location=destination\location)
Notify"Destination reached!"
CloseDown
End If
Move\Location=GetAStarBest(Move\Location,Destination\Location)
End Function
Function DrawBlobs()
Local Blob.Blobs
Local X
Local Y
If ((MilliSecs() Mod 1000)>125)
X=GetCoordX(Move\Location)
X=X+X_Offset
Y=GetCoordY(Move\Location)
Y=Y+Y_Offset
DrawImage Move\Image,X,Y
End If
X=GetCoordX(Destination\Location)
X=X+X_Offset
Y=GetCoordY(Destination\Location)
Y=Y+Y_Offset
DrawImage Destination\Image,X,Y
End Function
Function SetMoveBlob()
Move.Blobs=New Blobs
Move\Location=GetSafeLocation()
Move\Colour=GetRGB(0,255,0)
SetBlobImage(Move)
End Function
Function SetDestinationBlob()
Destination.Blobs=New Blobs
Destination\Location=GetSafeLocation()
If (Destination\Location=Move\Location)
While (Destination\Location=Move\Location)
Destination\Location=GetSafeLocation()
Wend
End If
Destination\Colour=GetRGB(255,0,0)
SetBlobImage(Destination)
End Function
Function SetAStarData()
If (FileType(LevelDataFilePath)<>1)
RuntimeError "Please run "+Chr(34)+CurrentDir()+"Example.bb"+Chr(34)+" To obtain Map Data"
End If
Local Temp=ReadFile(LevelDataFilePath)
If (Not(Temp))
RuntimeError("No data read from "+Chr(34)+LevelDataFilePath+Chr(34))
End If
Local Bank=CreateBank(512*512)
ReadBytes(Bank,Temp,0,512*512)
CloseFile Temp
Return Bank
End Function
Function SetMapImage()
If (FileType(LevelImageFilePath)<>1)
RuntimeError "Please run "+Chr(34)+CurrentDir()+"Example.bb"+Chr(34)+" To obtain Map Data"
End If
Local Temp=LoadImage(LevelImageFilePath)
If (Not(Temp))
RuntimeError("No data read from "+Chr(34)+LevelImageFilePath+Chr(34))
End If
Local Image=CreateImage(512,512)
CopyRect 0,0,512,512,0,0,ImageBuffer(Temp),ImageBuffer(Image)
FreeImage Temp
Return Image
End Function
Function GetSafeLocation()
Local X=Rand(0,511)
Local Y=Rand(0,511)
If (GetAStarValue(X,Y)>=100)
While (GetAStarValue(X,Y)>=100)
X=Rand(0,511)
Y=Rand(0,511)
Wend
End If
Return GetLocation(X,Y)
End Function
Function GetAStarBest(Location,Target)
Local TrialLocationX
Local TrialLocationY
Local Angle
Local X
Local Y
Local LocationX=GetCoordX(Location)
Local LocationY=GetCoordY(Location)
Local TargetLocationX=GetCoordX(Target)
Local TargetLocationY=GetCoordY(Target)
Local AStarValue#
Local InitialLowest#=256.0
Local InitialDistance#=GetDistance(LocationX,LocationY,TargetLocationX,TargetLocationY)
Local Lowest#=InitialLowest*InitialDistance
Local ChooseLocation=Location
For Angle=0 To 315 Step 45
X=Sin(Angle)
Y=Cos(Angle)
TrialLocationX=X+LocationX
TrialLocationY=Y+LocationY
Local Distance#=GetDistance(TrialLocationX,TrialLocationY,TargetLocationX,TargetLocationY)
If (TrialLocationX<0 Or TrialLocationX>511)
TrialLocationX=(TrialLocationX+(Sgn(0-TrialLocationX)))
End If
If (TrialLocationY<0 Or TrialLocationY>511)
TrialLocationY=(TrialLocationY+(Sgn(0-TrialLocationY)))
End If
AStarValue=GetAStarValue(TrialLocationX,TrialLocationY)
Local Value#=AStarValue*Distance#
DebugLog (X+","+Y+" : "+GetAStarValue(TrialLocationX,TrialLocationY))
If ((Value#<Lowest#));Import to have = or will not move over equal terrain
If ((Int(TrialLocationX)<>LocationX) And (Int(TrialLocationY)<>LocationY))
If ((Value#<=LastValue#))
Lowest=Value
ChooseLocation=GetLocation(Int(TrialLocationX),Int(TrialLocationY))
End If
End If
End If
Next
If (ChooseLocation=Location)
RuntimeError"Nowhere to move to!"
End If
LastValue=Value+1
DebugLog ("Chosen: "+Str(GetCOordX(ChooseLocation)-LocationX)+","+Str(GetCOordY(ChooseLocation)-LocationY))
Return ChooseLocation
End Function
Function GetDistance#(x1#,y1#,x2#,y2#)
Return (Sqr(((x1#-x2#)*(x1#-x2#))+((y1#-y2#)*(y1#-y2#))))
End Function
Function GetLocation(X,Y)
Return (X And 65535) + ((Y And 65535) Shl 16)
End Function
Function GetCoordX(Location)
Return Location And 65535
End Function
Function GetCoordY(Location)
Return (Location Shr 16) And 65535
End Function
Function GetAStarValue(X,Y)
Local Byte#=PeekByte(ASTarBank,X+(Y*512))
Return Byte
End Function
Function GetRGB(R%,G%,B%)
Return (((R% And 255)Shl 16) Or ((G% And 255) Shl 8) Or (B%And 255))
End Function
Function GetRed(RGB%)
Return ((RGB% Shr 16) And 255)
End Function
Function GetGreen(RGB)
Return ((RGB Shr 8) And 255)
End Function
Function GetBlue(RGB%)
Return (RGB% And 255)
End Function
Function SetBlobImage(Blob.Blobs)
Blob\Image=CreateImage(7,7)
MidHandle Blob\Image
SetBuffer(ImageBuffer(Blob\Image))
ClsColor 0,0,0
Color GetRed(Blob\Colour),GetGreen(Blob\Colour),GetBlue
Oval 0.5,0.5,7,7,True
SetBuffer(BackBuffer())
End Function
|
