Code: Alles auswählen
; Mein kleiner A-Stern- und Delta-Move -Test
InitSprite() : InitKeyboard()
#Fullscreen = 0
Global t.d = 0, dt.d = 0
Global Stepping.d = 0, Quit = 0
Global Dim LevelMap.i(36,36)
Restore Level
#MapH = 18
#MapW = 18
For Y = 0 To #MapH
For X = 0 To #MapW
Read.i LevelMap(X, Y)
Next X
Next Y
;Startkoordinaten
Global StartPointX = 10
Global StartPointY = 3
;Zielkoordinaten
Global EndPointX = 15
Global EndPointY = 16
Global WayString.s
Enumeration
#FrontX=1
#FrontY
#Start
#Stop
EndEnumeration
Enumeration
#NoWay=0
#Next
#Last
#Left
#Right
#Up
#Down
EndEnumeration
Structure WayPoint
X.d
Y.d
EndStructure
Structure Way
SaveWay.s
LastPosition.WayPoint
EndStructure
If #Fullscreen
OpenScreen(800,600,32,"A-Star")
Else
OpenWindow(0,0,0,800,600,"A-Star",#PB_Window_SystemMenu | #PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,800,600,0,0,0)
;SetFrameRate(200)
;SetFrameRate(100) ;Framerate-Switchen für DeltaT - Test
SetFrameRate(60)
;SetFrameRate(30)
EndIf
Structure MoveSprite
x.d
y.d
EndStructure
actor.MoveSprite
actor\x = 0 : actor\y = 200
;Actor
If CreateSprite(0,32,32)
If StartDrawing(SpriteOutput(0))
Box(0,0,32,32,RGB(0,255,0))
StopDrawing()
EndIf
EndIf
;EndPoint
If CreateSprite(1,32,32)
If StartDrawing(SpriteOutput(1))
Box(0,0,64,64,RGB(255,0,0))
StopDrawing()
EndIf
EndIf
;Wall
If CreateSprite(2,32,32)
If StartDrawing(SpriteOutput(2))
Box(0,0,32,32,RGB(255,255,0))
StopDrawing()
EndIf
EndIf
Procedure.i NextStep(*WayString)
Protected tempstr.s
If Left(PeekS(*WayString),3) = "-+-"
ProcedureReturn #NoWay
ElseIf Left(PeekS(*WayString),3) = "+++"
If Len(PeekS(*WayString))>4
tempstr=Mid(PeekS(*WayString),4,1)
PokeS(*WayString, "+++"+Right(PeekS(*WayString), (Len(PeekS(*WayString))-4 )))
ProcedureReturn Val(tempstr)
Else
tempstr=Mid(PeekS(*WayString),4,1)
PokeS(*WayString, "-+-")
ProcedureReturn Val(tempstr)
EndIf
Else
ProcedureReturn #NoWay
EndIf
EndProcedure
Procedure.s FindWay( BeginX.i, BeginY.i, EndX.i, EndY.i, Field.i, NoField.i, Array AMap.i(2) )
Protected.b WayFound=#False
Protected.WayPoint AMap_Dim, StartPoint, EndPoint
Protected.i PointerImage, CounterX, CounterY, ALayer
Protected NewList Way1.Way()
Protected NewList Way2.Way()
Protected.s TempString
Protected.i WayNext=#Next, WayBack=#Last, WayLeft=#Left, WayRight=#Right
If BeginX<0 Or BeginX>ArraySize(AMap(),1) Or EndX<0 Or EndX>ArraySize(AMap(),1) Or BeginY<0 Or BeginY>ArraySize(AMap(),2) Or EndY<0 Or EndY>ArraySize(AMap(),2)
ProcedureReturn "Start/Ziel ist ausserhalb der Karte."
ElseIf AMap( BeginX, BeginY ) = NoField
ProcedureReturn "Start ist nicht möglich."
ElseIf AMap( EndX, EndY ) = NoField
ProcedureReturn "Ziel ist nicht erreichbar."
ElseIf BeginX = EndX And EndY = BeginY
ProcedureReturn "Ziel wurde erreicht."
EndIf
StartPoint\X = BeginX
StartPoint\Y = BeginY
EndPoint\X = EndX
EndPoint\Y = EndY
If ArraySize(AMap(),1) >= ArraySize(AMap(),2)
ALayer = #FrontX
AMap_Dim\X = ArraySize(AMap(),1)
AMap_Dim\Y = ArraySize(AMap(),2)
Else
ALayer=#FrontY
AMap_Dim\X = ArraySize(AMap(),2)
AMap_Dim\Y = ArraySize(AMap(),1)
Swap StartPoint\X, StartPoint\Y
Swap EndPoint\X, EndPoint\Y
Swap WayNext, WayLeft
Swap WayBack, WayRight
EndIf
AddElement(Way1())
Way1()\LastPosition\X = StartPoint\X
Way1()\LastPosition\Y = StartPoint\Y
Way1()\SaveWay = "+++"
PointerImage = CreateImage(#PB_Any,AMap_Dim\X+5,AMap_Dim\Y+5)
If PointerImage = #False
ProcedureReturn "Prüfinstanz nicht einrichtbar"
ElseIf #False = StartDrawing(ImageOutput(PointerImage))
ProcedureReturn "Prüfdraw nicht verfügbar"
EndIf
For CounterX=0 To AMap_Dim\X
For CounterY=0 To AMap_Dim\Y
Select ALayer
Case #FrontX
Plot(CounterX, CounterY, AMap(CounterX, CounterY))
Case #FrontY
Plot(CounterX, CounterY, AMap(CounterY, CounterX))
Default
ProcedureReturn "Dimensionen sind falsch eingerichtet"
EndSelect
Next CounterY
Next CounterX
While WayFound = #False
ResetList(Way1())
ForEach Way1()
If Way1()\LastPosition\Y > 0
If Point( Way1()\LastPosition\X, Way1()\LastPosition\Y-1) = Field
If Way1()\LastPosition\X = EndPoint\X And Way1()\LastPosition\Y-1 = EndPoint\Y
TempString = Way1()\SaveWay + Str(WayNext)
WayFound = #True
Else
AddElement(Way2())
Way2()\SaveWay = Way1()\SaveWay + Str(WayNext)
Way2()\LastPosition\X = Way1()\LastPosition\X
Way2()\LastPosition\Y = Way1()\LastPosition\Y-1
Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
EndIf
EndIf
EndIf
If Way1()\LastPosition\Y < AMap_Dim\Y
If Point( Way1()\LastPosition\X, Way1()\LastPosition\Y+1) = Field
If Way1()\LastPosition\X = EndPoint\X And Way1()\LastPosition\Y+1 = EndPoint\Y
TempString = Way1()\SaveWay + Str(WayBack)
WayFound = #True
Else
AddElement(Way2())
Way2()\SaveWay = Way1()\SaveWay + Str(WayBack)
Way2()\LastPosition\X = Way1()\LastPosition\X
Way2()\LastPosition\Y = Way1()\LastPosition\Y+1
Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
EndIf
EndIf
EndIf
If Way1()\LastPosition\X > 0
If Point( Way1()\LastPosition\X-1, Way1()\LastPosition\Y ) = Field
If Way1()\LastPosition\X-1 = EndPoint\X And Way1()\LastPosition\Y = EndPoint\Y
TempString = Way1()\SaveWay + Str(WayLeft)
WayFound = #True
Else
AddElement(Way2())
Way2()\SaveWay = Way1()\SaveWay + Str(WayLeft)
Way2()\LastPosition\X = Way1()\LastPosition\X-1
Way2()\LastPosition\Y = Way1()\LastPosition\Y
Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
EndIf
EndIf
EndIf
If Way1()\LastPosition\X < AMap_Dim\X
If Point( Way1()\LastPosition\X+1, Way1()\LastPosition\Y ) = Field
If Way1()\LastPosition\X+1 = EndPoint\X And Way1()\LastPosition\Y = EndPoint\Y
TempString = Way1()\SaveWay + Str(WayRight)
WayFound = #True
Else
AddElement(Way2())
Way2()\SaveWay = Way1()\SaveWay + Str(WayRight)
Way2()\LastPosition\X = Way1()\LastPosition\X+1
Way2()\LastPosition\Y = Way1()\LastPosition\Y
Plot(Way2()\LastPosition\X,Way2()\LastPosition\Y,NoField)
EndIf
EndIf
EndIf
Next
If WayFound = #False
ClearList(Way1())
ResetList(Way2())
If 1 <= ListSize(Way2())
ForEach Way2()
AddElement(Way1())
Way1()\SaveWay = Way2()\SaveWay
Way1()\LastPosition\X = Way2()\LastPosition\X
Way1()\LastPosition\Y = Way2()\LastPosition\Y
Next
ClearList(Way2())
ResetList(Way1())
Else
WayFound = #True
TempString = "Es gibt keinen Weg zum Ziel."
EndIf
EndIf
Wend
StopDrawing()
FreeImage(PointerImage)
ClearList(Way2())
ClearList(Way1())
ProcedureReturn TempString
EndProcedure
Procedure StarDraw()
For Y=0 To #MapH
For X=0 To #MapW
If StartPointX = X And StartPointY = Y
DisplaySprite(0,XX,YY)
ElseIf EndPointX = X And EndPointY = Y
DisplaySprite(1,XX,YY)
Else
Select LevelMap(X,Y)
Case 0
;...
Case 2
DisplaySprite(2,XX,YY)
EndSelect
EndIf
If XX <= 575
XX + 32
Else
XX = 0
EndIf
Next X
YY + 32
Next Y
EndProcedure
Procedure StarMove()
If Quit <> 3
;Auf gehts!
Dir.i = NextStep(@WayString)
Select Dir
Case #Left
StartPointX = StartPointX-1
Case #Right
StartPointX = StartPointX+1
Case #Next
StartPointY = StartPointY-1
Case #Last
StartPointY = StartPointY+1
Case #NoWay
Quit = 3
MessageRequester("Ende", "Kein Weg möglich oder das Ziel wurde erreicht!"+Chr(13)+Chr(13)+"Das Ziel wurde in: "+Str(ElapsedMilliseconds() - run)+" ms erreicht.", 0)
EndSelect
EndIf
EndProcedure
run = ElapsedMilliseconds()
WayString = FindWay(StartPointX, StartPointY, EndPointX, EndPointY, 0, 2, LevelMap())
XX.d = 0 : YY.d = 0
Repeat
If #Fullscreen = 0
Repeat
EventID = WindowEvent()
Select EventID
Case #PB_Event_CloseWindow
End
EndSelect
Until EventID = 0
EndIf
t = ElapsedMilliseconds()
ExamineKeyboard()
ClearScreen(RGB(0,0,0))
StarDraw()
If Stepping >= 20
StarMove()
EndIf
If Stepping >= 20
Stepping = 0
Else
Stepping + (100 * dt)
EndIf
FlipBuffers():Delay(10)
dt = (ElapsedMilliseconds() - t) / 1000
Until KeyboardPushed(#PB_Key_Escape) Or EventID = #PB_Event_CloseWindow
DataSection
Level:
Data.i 0,0,0,0,0,0,0,0,0,2,2,0,0,0,0,0,0,0,0
Data.i 0,0,0,0,0,0,0,2,2,2,0,2,0,0,0,0,0,0,0
Data.i 0,0,0,0,0,0,2,2,0,0,0,0,2,0,0,0,0,0,0
Data.i 0,0,0,0,2,2,0,0,0,0,0,0,2,2,0,0,0,0,0
Data.i 0,0,2,2,2,0,0,0,0,0,0,0,0,2,2,0,0,0,0
Data.i 0,2,2,0,0,0,2,2,0,0,2,2,0,0,2,2,2,0,0
Data.i 2,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,2,0
Data.i 2,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,2,2
Data.i 2,2,2,2,0,0,0,0,2,0,0,0,0,0,0,0,0,0,2
Data.i 0,0,0,2,2,2,0,0,0,0,0,0,0,0,2,2,2,2,2
Data.i 0,0,0,0,0,2,2,0,0,0,0,0,0,0,2,0,0,0,0
Data.i 0,0,0,0,2,2,0,0,0,2,2,0,0,0,2,0,0,0,0
Data.i 0,0,0,0,2,0,0,0,2,2,2,0,0,0,2,0,0,0,0
Data.i 0,0,0,2,0,0,0,2,2,0,2,2,0,0,2,2,0,0,0
Data.i 0,0,2,2,0,0,2,2,0,0,0,2,2,0,0,2,2,0,0
Data.i 0,0,2,0,0,0,2,0,0,0,0,0,2,2,0,0,2,0,0
Data.i 0,2,2,0,0,2,2,0,0,0,0,0,0,2,2,0,2,2,0
Data.i 2,2,0,0,2,2,0,0,0,0,0,0,0,0,2,0,0,2,2
Data.i 2,2,2,2,2,0,0,0,0,0,0,0,0,0,0,2,2,2,2
EndDataSection