Aktuelle Zeit: 18.07.2019 15:13

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]




Ein neues Thema erstellen Auf das Thema antworten  [ 47 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4, 5  Nächste
Autor Nachricht
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 18.03.2019 14:18 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
diceman hat geschrieben:
Ist das mit der A*-Pfadsuche noch ein Thema? :)
Frage nur, weil ich hätte eine entsprechende Funktion vorliegen, die ich mal in Blitzbasic programmiert, und dann auch erfolgreich nach PureBasic übersetzt habe. Läuft flott und fehlerfrei. Alles was die Funktion braucht, ist ein Array vom entsprechenden Level, welches mit mit Nullen (Mauern/Hindernisse) und Einsen (frei) gefüllt ist.


Ist noch ein Thema :)

Benötige ich noch immer, vor kurzem habe ich mich mal daran versucht bin aber noch nicht erfolgreich gewesen.
Der Algo findet nicht immer das Ziel - verm. ist der rekursive Suchlauf fehlerbehaftet.

Würde mich freuen wenn ich deine Funktionen verwenden dürfte.
Gerne aber stelle ich auch meinen Code ein eventuell kann der ja gefixt werden (war da ratlos am Ende).

Hier der Code:

Code:
EnableExplicit

;ASTAR TYPE PATHFINDING
;Version: DRAFT
;Author: Mijikai

Structure ASTAR_OFFSET_STRUCT
  x.i
  y.i
EndStructure

Structure ASTAR_LINK_STRUCT
  *child.ASTAR_NODE_STRUCT
  cost.i
EndStructure

Structure ASTAR_NODE_STRUCT
  offset.ASTAR_OFFSET_STRUCT
  *parent.ASTAR_NODE_STRUCT
  links.i
  Array link.ASTAR_LINK_STRUCT(7)
EndStructure

Structure ASTAR_MASK_STRUCT
  *buffer
  size.i
  width.i
  height.i
EndStructure

Structure ASTAR_STRUCT
  mask.ASTAR_MASK_STRUCT
  start.ASTAR_OFFSET_STRUCT
  stop.ASTAR_OFFSET_STRUCT
  *path.ASTAR_NODE_STRUCT
  List node.ASTAR_NODE_STRUCT()
EndStructure

Global *dummy
Global position.ASTAR_OFFSET_STRUCT

Macro astar_Equal(X1,Y1,X2,Y2)
  Bool(X1 = X2 And Y1 = Y2)
EndMacro

Macro astar_Valid(X1,Y1,X2,Y2,Width,Height)
  Bool(Not X1 < 0 And
       Not Y1 < 0 And
       Not X2 < 0 And
       Not Y2 < 0 And
       X1 < Width And
       Y1 < Height And
       X2 < Width And
       Y2 < Height)
EndMacro

Procedure.i astar_Distance(X1.i,Y1.i,X2.i,Y2.i)
  Protected dx.i
  Protected dy.i
  dx = Abs(X1 - X2)
  dy = Abs(Y1 - Y2)
  If dx > dy
    ProcedureReturn (dx + dy) + (dx >> 1)
  Else
    ProcedureReturn (dx + dy) + (dy >> 1)
  EndIf
EndProcedure

Procedure.i astar_Check(*astar.ASTAR_STRUCT,X.i,Y.i)
  Protected *ptr.Ascii
  With *astar
    If Not X < 0 And Not Y < 0 And X < \mask\width And Y < \mask\height
      *ptr = \mask\buffer + X + (Y * \mask\width)
      ProcedureReturn *ptr\a
    Else
      ProcedureReturn #True
    EndIf
  EndWith
EndProcedure

Procedure.i astar_Mark(*astar.ASTAR_STRUCT,X.i,Y.i,Flag.b)
  Protected *ptr.Ascii
  With *astar
    *ptr = \mask\buffer + X + (Y * \mask\width)
    *ptr\a = Flag
  EndWith
EndProcedure

Procedure.i astar_Child(*astar.ASTAR_STRUCT,*node.ASTAR_NODE_STRUCT,Index.i,X.i,Y.i)
  With *astar
    If astar_Check(*astar,X,Y) = #Null
      If astar_Equal(X,Y,\start\y,\start\x)
        \path = *node
      EndIf
      If AddElement(\node())
        \node()\parent = *node
        \node()\offset\x = X
        \node()\offset\y = Y
        *node\link(Index)\child = @\node()
        *node\link(Index)\cost = astar_Distance(X,Y,\stop\x,\stop\y)
        *node\links + 1
        ProcedureReturn #True
      EndIf
    EndIf
  EndWith
EndProcedure

Procedure.i astar_Parent(*astar.ASTAR_STRUCT,*node.ASTAR_NODE_STRUCT)
  Protected index.i
  Protected *next.ASTAR_NODE_STRUCT
  With *astar
    If \path
      ProcedureReturn #Null
    EndIf
    astar_Child(*astar,*node,0,*node\offset\x - 1,*node\offset\y)
    astar_Child(*astar,*node,1,*node\offset\x + 1,*node\offset\y)
    astar_Child(*astar,*node,2,*node\offset\x    ,*node\offset\y - 1)
    astar_Child(*astar,*node,3,*node\offset\x    ,*node\offset\y + 1)
    astar_Child(*astar,*node,4,*node\offset\x - 1,*node\offset\y - 1)
    astar_Child(*astar,*node,5,*node\offset\x + 1,*node\offset\y - 1)
    astar_Child(*astar,*node,6,*node\offset\x - 1,*node\offset\y + 1)
    astar_Child(*astar,*node,7,*node\offset\x + 1,*node\offset\y + 1)
    astar_Mark(*astar,*node\offset\x,*node\offset\y,#True)
    If *node\links
      SortStructuredArray(*node\link(),#PB_Sort_Descending,OffsetOf(ASTAR_LINK_STRUCT\cost),#PB_Integer)
      !@@:
      For index = 0 To 7
        If *node\link(index)\child
          *next = *node\link(index)\child
          *node\link(index)\child = #Null
          ;Debug Str(*next\offset\x) + " x " + Str(*next\offset\y)
          astar_Parent(*astar,*next)
          ProcedureReturn #Null
        EndIf
      Next
    EndIf
    If *node
      If *node\parent
        astar_Mark(*astar,*node\offset\x,*node\offset\y,#False)
        *node = *node\parent
        If *node\parent
          *node = *node\parent
        EndIf
        !jmp @b
      EndIf
    EndIf
  EndWith
EndProcedure

Procedure.i astar_Task(X1.i,Y1.i,X2.i,Y2.i,*Buffer,Width.i,Height.i)
  Protected *astar.ASTAR_STRUCT
  If *Buffer And Width > 0 And Height > 0
    If Not astar_Equal(X1,Y1,X2,Y2)
      If astar_Valid(X1,Y1,X2,Y2,Width,Height)
        *astar = AllocateStructure(ASTAR_STRUCT)
        If *astar
          With *astar
            \start\x  = X1
            \start\y  = Y1
            \stop\x   = X2
            \stop\y   = Y2
            \mask\width = Width
            \mask\height = Height
            \mask\size = \mask\width * \mask\height
            \mask\buffer = AllocateMemory(\mask\size)
            If \mask\buffer
              CopyMemory(*Buffer,\mask\buffer,\mask\size)
              If AddElement(\node())
                \node()\offset\x = \stop\x
                \node()\offset\y = \stop\y
                astar_Parent(*astar,@\node())
                If \path
                  ProcedureReturn *astar
                EndIf
              EndIf
              FreeMemory(\mask\buffer)
            EndIf
          EndWith
          FreeStructure(*astar)
        EndIf
      EndIf
    EndIf
  EndIf
EndProcedure

Procedure.i astar_Path(*astar.ASTAR_STRUCT,*Vector.ASTAR_OFFSET_STRUCT)
  With *astar
    If \path
      *Vector\x = \path\offset\x
      *Vector\y = \path\offset\y
      \path = \path\parent
      ProcedureReturn #True
    EndIf
  EndWith
EndProcedure

Procedure.i astar_TaskFree(*astar.ASTAR_STRUCT)
  With *astar
    FreeMemory(\mask\buffer)
    FreeStructure(*astar)
  EndWith
EndProcedure

*dummy = astar_Task(0,0,15,15,?mask,16,16)

If *dummy
  Debug "PATH FOUND!"
 
  While astar_Path(*dummy,@position)
    Debug Str(position\x) + " x " + Str(position\y)
  Wend 
 
  astar_TaskFree(*dummy)
Else
  Debug "NO PATH FOUND!"
EndIf

DataSection
  mask:
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0
  !db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0;<- die zeile mit dieser ersetzen: 0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0 und die Suche schlägt fehl!
  !db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
EndDataSection

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 15.05.2019 16:43 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Ach du Scheiße. :o
Ich habs ganz vergessen. Habe lange nicht mehr hier reingeschaut, stattdessen habe viel gelesen, Filme geguckt und Heroes of the Storm gezockt. Jetzt letztes Wochenende war ich auf einem kleinen lokalen GameJam, da habe ich etwas mit PureBasic gebastelt, und das Thema ist wieder relevant geworden.
Brauchst du die A*-Routine noch?

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 15.05.2019 18:06 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
Ja, würde mir helfen :)
Programmiere gerade wieder für die 2D Engine.
Das nächste Update wird Isometrie-Funktionen enthalten.

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 19.05.2019 18:59 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
Hab mich heute nochmal an den A* Algorithmus gewagt
und habs hinbekommen :D

Bild

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 21.05.2019 09:36 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Gratulation. :)
Freut mich, daß du eine für dich funktionierende Lösung gefunden hast. Ich war das ganze Wochenende auf einer beruflichen Fortbildung, daher habe ich hier noch gar nicht reingeschaut, also nochmal sorry fürs nicht zeitnah eingehaltene Versprechen. /:->

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 21.05.2019 11:53 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
diceman hat geschrieben:
Gratulation. :)
Freut mich, daß du eine für dich funktionierende Lösung gefunden hast.


Danke :)

Es fehlt allerdings noch eine Version ohne diagonale Felder.
Eventuell hast du mir einen Tipp dafür.

Hab bisher nur mal versucht die diagonalen Felder zu ignorieren wenn ich
die Nachbarn untersuche.

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 21.05.2019 12:57 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Ich habe das folgendermaßen gelöst …
Habe am Anfang des Programms die x/y-Modifikatoren für alle 4 Himmelsrichtungen als Array eingelesen, also:

Code:
Enumeration
    #nord
    #west
    #east
    #south
EndEnumeration

xMod(0) = 0
yMod(0) = -1
xMod(1) = -1
yMod(1) = 0
xMod(2) = 1
yMod(2) = 0
xMod(3) = 0
yMod(3) = 1


Und so ist es ein leichtes mit

Code:
For dir = 0 to 3
    If map(x+xMod(dir),y+yMod(dir)) = #isNotWall
        …
    Endif
Next


ausschließlich durch alle 4 Himmelsrichtungen zu rotieren.
Abgesehen davon kann man die Modifikatoren auch noch für viele andere tolle Sachen nutzen, zum Beispiel Tastaturabfrage und Bewegung der Spielfigur, geführte prozedurale Generierung, etc. :)

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 21.05.2019 19:14 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
diceman hat geschrieben:
Ich habe das folgendermaßen gelöst …


Das mit der Enumeration gefällt mir :)

Also sollte es doch gehen wenn die Diagonalen nicht berücksichtigt werden.
Hab es mir also nochmal angeschaut und das Problem gefunden -
hatte vergessen das ich was auskommentiert hatte :oops:

Test:
Bild

Allerdings wird der kürzeste Pfad (dunkelgrün) ohne Hindernisse jetzt so generiert (Bild unten) was mir nicht so gefällt :freak:
Der hellgrüne Pfad wäre schöner allerdings läuft hier der Spieler dann auch zick zack was u.U. auch schlecht aussieht.... was tun? ist das so ok?

Bild

Wie sieht bei dir der kürzeste Pfad aus wenn die Diagonalen nicht berücksichtigt werden?

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 21.05.2019 19:53 
Offline
Benutzeravatar

Registriert: 06.07.2017 12:24
Ich habe dir hier mal meinen kompletten A*-Testcode rüberkopiert, das Programm ist vollkommen eigenständig lauffähig.
Es wird eine zufällige "Welt" aus zufälligen Blöcken erstellt, sowie ein zufälliger Start- und Zielpunkt gesetzt.
Mit der linken Maustaste kannst du den Startpunkt versetzen, und der Pfad wird daraufhin aktualisiert. Durch Drücken der Return-Taste erstellst du eine neue Welt.
Die ganze A*-Magie findet in der Prozedur getPath() statt. Dort findest du auch (in Zeile 279) das Macro _NoCornerCuts() ... sobald du dieses auskommentierst, "schneidet" die Pfadsuche Ecken von Blöcken ab, was nicht so schön smooth aussieht (alles eine Frage, ob du erlauben möchtest, daß der Spieler an diagonal angrenzenden Blöcken "vorbeischlüpfen" darf).
Diese Version der Pfadsuche bezieht auch die diagonalen Felder ein.
Wenn du ausschließlich orthogonale Pfadsuche haben möchtest, mußt du Zeile 273 wie folgt ändern:

Code:
If (x = *nodePointer\X And y = *nodePointer\Y) Or binaryMap(x,y) = 0 Or checkList(x,y) = -1 Or (x <> *nodePointer\x And y <> *nodePointer\y)


Meinen A*-Code habe ich im Laufe von bestimmt 8 Jahren immer weiter auf maximale Effizienz und Geschwindigkeit optimiert (angefangen hat das in BlitzBasic), deswegen erlaube ich mir auch ein einziges Goto in der getPath()-Prozedur, um die Pfadsuche umgehend zu verlassen, sobald ein eindeutiges Ergebnis vorliegt.
Der Pfad wird aufgezeichnet, in einer Liste gespeichert, und kann so anschließend abgerufen werden.
Der getPath()-Code ist kommentiert, aber wenn du irgendwelche Fragen hast, stehe ich dir natürlich gerne Rede und Antwort. :)


Code:
EnableExplicit

Macro _NoCornerCuts()
   If x <> *nodePointer\X And y <> *nodePointer\Y
      If x < *nodePointer\X And y < *nodePointer\Y   ;NW
         If binaryMap(limit(*nodePointer\X-1,0,xMax),*nodePointer\Y) = 0 Or binaryMap(*nodePointer\X,limit(*nodePointer\Y-1,0,yMax)) = 0
            tileOkay = 0
         EndIf
      EndIf
      If x > *nodePointer\X And y < *nodePointer\Y   ;NE
         If binaryMap(limit(*nodePointer\X+1,0,xMax),*nodePointer\Y) = 0 Or binaryMap(*nodePointer\X,limit(*nodePointer\Y-1,0,yMax)) = 0
            tileOkay = 0
         EndIf
      EndIf
      If x < *nodePointer\X And y > *nodePointer\Y   ;SW
         If binaryMap(limit(*nodePointer\X-1,0,xMax),*nodePointer\Y) = 0 Or binaryMap(*nodePointer\X,limit(*nodePointer\Y+1,0,yMax)) = 0
            tileOkay = 0
         EndIf
      EndIf
      If x > *nodePointer\X And y > *nodePointer\Y   ;SO
         If binaryMap(limit(*nodePointer\X+1,0,xMax),*nodePointer\Y) = 0 Or binaryMap(*nodePointer\X,limit(*nodePointer\Y+1,0,yMax)) = 0
            tileOkay = 0
         EndIf
      EndIf
   EndIf
EndMacro


Declare createWindow(x,y,exeName.s)
Declare createWorld(xMax,yMax)
Declare showWorld(xMax,yMax)
Declare getPath(x0,y0,xTarget,yTarget,xMax,yMax)
Declare limit(var,min,max)

Global Dim binaryMap(1,1)


Structure NODE
   X.i
   Y.i
EndStructure

Structure A_STAR_PATH ;Zum Aufzeichnen des Pfades
   X.i
   Y.i
EndStructure
Global NewList aStarPath.A_STAR_PATH()



Global screen
Define quit

#xRes = 800
#yRes = 600

#tileSize = 20
#xMax = 39
#yMax = 29

Global startX, startY
Global exitX, exitY
Global pathExist
screen = createWindow(#xRes,#yRes,"A-Star.exe")

Repeat
   createWorld(#xMax,#yMax)
   ClearList(aStarPath())
   pathExist = getPath(startX,startY,exitX,exitY,#xMax,#yMax)
   quit = showWorld(#xMax,#yMax)
Until quit



Procedure createWindow(x,y,exeName.s)
   Define window

    If Not InitSprite() : Debug "InitSprite() failed" : End : EndIf
   
      window = OpenWindow(#PB_Any,0,0,x,y,exeName,#PB_Window_ScreenCentered)
    If Not window : Debug "Window-Creation failed" : End : EndIf
    If Not OpenWindowedScreen(WindowID(window),0,0,x,y) : Debug "Screen-Creation failed" : End : EndIf
   
    If Not InitMouse() : Debug "InitMouse() failed" : End : EndIf
    If Not InitKeyboard() : Debug "InitKeyboard() failed" : End : EndIf
     
    ProcedureReturn window
EndProcedure



Procedure showWorld(xMax,yMax)
   Define x,y
   Define rad
   Define event, keyboardReturn, quit
   Define *parentPointer.A_STAR_PATH = #Null
   Define drawBoard = CreateImage(#PB_Any,#xRes,#yRes)
   
   Define wallImage = CreateImage(#PB_Any,#tileSize,#tileSize)
   If StartDrawing(ImageOutput(wallImage))
      DrawingMode(#PB_2DDrawing_Default)
      Box(0,0,#tileSize,#tileSize,RGB(0,0,0))
      StopDrawing()
   EndIf
   

draw_stuff:   
   If StartDrawing(ImageOutput(drawBoard))
      DrawingMode(#PB_2DDrawing_Default)
      Box(0,0,#xRes,#yRes,RGB(255,255,255))
      For x = 0 To xMax
         For y = 0 To yMax
            If binaryMap(x,y) = 0
               DrawImage(ImageID(wallImage),x*#tileSize,y*#tileSize)
            EndIf
         Next
      Next
      
      
      Circle((startX*#tileSize)+(#tileSize/2),(startY*#tileSize)+(#tileSize/2),#tileSize/2,RGB(0,100,255))
      Circle((exitX*#tileSize)+(#tileSize/2),(exitY*#tileSize)+(#tileSize/2),#tileSize/2,RGB(225,0,0))
      
      ResetList(aStarPath())
      If FirstElement(aStarPath())
         *parentPointer = @aStarPath()
         ForEach aStarPath()
            LineXY((*parentPointer\X*#tileSize)+(#tileSize/2),(*parentPointer\Y*#tileSize)+(#tileSize/2),(aStarPath()\X*#tileSize)+(#tileSize/2),(aStarPath()\Y*#tileSize)+(#tileSize/2),RGB(0,100,255))
            *parentPointer = @aStarPath()
         Next
      EndIf
      StopDrawing()
   EndIf
      
   Repeat
      ExamineKeyboard()
      ExamineMouse()
      
      ClearScreen(RGB(255,255,255))
      If StartDrawing(ScreenOutput())
         DrawImage(ImageID(drawBoard),0,0)
         DrawingMode(#PB_2DDrawing_Outlined)
         Circle(MouseX(),MouseY(),#tileSize/2-3,RGB(0,150,0))
         Circle(MouseX(),MouseY(),#tileSize/2-6,RGB(0,150,0))
         
         StopDrawing()
      EndIf
      FlipBuffers()
         
      If MouseButton(#PB_MouseButton_Left)
         For x = 0 To xMax
            For y = 0 To yMax
               If MouseX() >= x*#tileSize And MouseX() < (x*#tileSize)+#tileSize And MouseY() >= (y*#tileSize) And MouseY() < (y*#tileSize)+#tileSize
                  If binaryMap(x,y) = 1 And (Not (x = exitX And y = exitY))
                     startX = x
                     startY = y
                     ClearList(aStarPath())
                     pathExist = getPath(startX,startY,exitX,exitY,#xMax,#yMax)
                     Goto draw_stuff
                  EndIf
               EndIf
            Next
         Next
      EndIf
      
      
      event = WaitWindowEvent(1)
      Delay(1)

      
      keyboardReturn = KeyboardReleased(#PB_Key_Return)
      If KeyboardPushed(#PB_Key_Escape) Or event = #PB_Event_CloseWindow
         ProcedureReturn 1
      EndIf
   Until keyboardReturn
EndProcedure



Procedure createWorld(xMax,yMax)
   Define x,y
   
   Dim binaryMap(xMax,yMax)
   For x = 0 To xMax
      For y = 0 To yMax
         binaryMap(x,y) = limit(Random(2,0),0,1)
      Next
   Next
   
   Repeat
      startX = Random(xMax,0)
      startY = Random(yMax,0)
      exitX = Random(xMax,0)
      exitY = Random(yMax,0)
   Until binaryMap(startX,startY) = 1 And binaryMap(exitX,exitY) = 1 And (startX <> exitX Or startY <> exitY)
EndProcedure



Procedure limit(var,min,max)
   If var < min
      ProcedureReturn min
   Else
      If var > max
         ProcedureReturn max
      Else
         ProcedureReturn var
      EndIf
   EndIf
EndProcedure




Procedure getPath(x0,y0,xTarget,yTarget,xMax,yMax) ;xM/yM = maximale Feldgröße
   #costStraight = 10
   #costDiagonal = 14      ;Quadratwurzel 2
   
   NewList node.NODE()
   
   Dim checkList(xMax,yMax)   ;Schnelles Schreiben in die Open-List (= 1) und die Closed-List (-1)
   Dim g_cost(xMax,yMax)   ;G-Kosten = bekannte Pfadkosten-Summe zum aktuellen Tile
   Dim h_cost(xMax,yMax)   ;H-Kosten = Geschätzte verbleibende Entfernung vom bekannten Tile aus (Luftlinie)
   Dim f_cost(xMax,yMax)   ;F-Kosten = G + H
   
   Dim parentX(xMax,yMax)   ;Parent-Nodes speichern ...
   Dim parentY(xMax,yMax)   ;... damit gefundener Pfad abgerufen werden kann

   Define firstNode
   Define lowF
   Define nodeCost
   Define x, y
   Define tileOkay
   Define *nodePointer.NODE ;Pointer auf Speicheradresse der aktuellen Node

   Define count   ;Zählt Schritte von Start zum Ziel (0 = kein Pfad existiert, -1 = Start und Zielort identisch)
   
   If x0 = xTarget And y0 = yTarget
      ProcedureReturn -1 ;Start und Zielfeld sind dasselbe
   Else
      ;Add first Node to Open List
      checkList(xTarget,yTarget) = 1
      AddElement(node())
      node()\X = xTarget               ;Pfad wird rückwärts gesucht ...
      node()\Y = yTarget               ;... Aufzeichnen erfolgt am Ende mittels Rückverfolgung der Parent-Nodes
      ;erstes Element hat keinen Parent
      
      ;optionale G-Penalities für bestimmte Felder festlegen
      ;Beispiel: g_cost(lavaX,lavaY) = 1000
      Repeat
         ;find Low F
         firstNode = FirstElement(node())
         If firstNode = #Null
            ProcedureReturn 0
            ;optionale Konsequenz aufrufen, wenn kein Pfad gefunden wurde
         Else
            lowF = f_cost(node()\X,node()\Y)
            *nodePointer = @node()
            ForEach node()
               If f_cost(node()\X,node()\Y) < lowF            
                  lowF = f_cost(node()\X,node()\Y)
                  *nodePointer = @node()
               EndIf
            Next
         EndIf
         
         ;Angrenzende Felder überprüfen
         If checkList(*nodePointer\X,*nodePointer\Y) = 1
            checkList(*nodePointer\X,*nodePointer\Y) = -1
            
            For x = limit(*nodePointer\X-1, 0, xMax) To limit(*nodePointer\X+1, 0, xMax)
               For y = limit(*nodePointer\Y-1, 0, yMax) To limit(*nodePointer\Y+1, 0, yMax)   
                  
                  If (x = *nodePointer\X And y = *nodePointer\Y) Or binaryMap(x,y) = 0 Or checkList(x,y) = -1
                     Continue ;Parent-Nodes, blockierte- und ClosedList-Tiles direkt überspringen = Speed!
                  EndIf
                  
                  tileOkay = 1
                  ;optional: keine Ecken "abschneiden":
                  _NoCornerCuts()   ;Macro
                  
                  If tileOkay
                     If x = x0 And y = y0 ;Wenn Ziel erreicht wurde ...
                        parentX(x,y) = *nodePointer\X
                        parentY(x,y) = *nodePointer\Y
                        Goto pathFound   ;... Routine verlassen und Pfad aufzeichnen
                     EndIf
                     If checkList(x,y) = 1
                        ;checken, ob der Weg zum bereits bekannten Feld über den neuen Pfad kürzer ist.
                        ;Wenn ja, dann Parent-Koordinaten des bekannten Feldes "umleiten".
                        nodeCost = #costStraight
                        If (x <> *nodePointer\X And y <> *nodePointer\Y)
                           nodeCost = #costDiagonal
                        EndIf
                        If (g_cost(*nodePointer\X,*nodePointer\Y) + nodeCost) < g_cost(x,y)
                           g_cost(x,y) = g_cost(*nodePointer\X,*nodePointer\Y) + nodeCost
                           f_cost(x,y) = g_cost(x,y) + h_cost(x,y)
                           parentX(x,y) = *nodePointer\X
                           parentY(x,y) = *nodePointer\Y
                        EndIf
                     EndIf
                     If checkList(x,y) = 0
                        ;Add to Open List
                        checkList(x,y) = 1
                        AddElement(node())
                        node()\X = x
                        node()\Y = y
                        parentX(x,y) = *nodePointer\X
                        parentY(x,y) = *nodePointer\Y
                        nodeCost = #costStraight
                        If x <> *nodePointer\X And y <> *nodePointer\Y
                           nodeCost = #costDiagonal
                        EndIf
                        g_cost(x,y) + g_cost(*nodePointer\X,*nodePointer\Y) + nodeCost
                        h_cost(x,y) = (Abs(x-x0) + Abs(y-y0)) * #costStraight         ;Annäherung statt Satz des Pythagoras = ausreichend, da nur Längenvergleich stattfindet
                        f_cost(x,y) = g_cost(x,y) + h_cost(x,y)
                     EndIf
                  EndIf
                     

               Next
            Next

            ChangeCurrentElement(node(), *nodePointer)   ;auf aktuelles Listenelement zurückschalten damit richtiges Element
            DeleteElement(node())                  ;gelöscht wird (falls in der Zwischenzeit AddElement() aufgerufen wurde)

         EndIf
         
      ForEver         
   EndIf
   
   
   
   
pathFound:      ;Pfad aufzeichnen und ...
   count = 1
   AddElement(aStarPath())
   aStarPath()\X = x0
   aStarPath()\Y = y0
   *nodePointer = @aStarPath()
   
   Repeat
      count +1
      AddElement(aStarPath())
      aStarPath()\X = parentX(*nodePointer\X,*nodePointer\Y)
      aStarPath()\Y = parentY(*nodePointer\X,*nodePointer\Y)
      *nodePointer = @aStarPath()
   Until aStarPath()\X = xTarget And aStarPath()\Y = yTarget
   
   ProcedureReturn count ;... Schrittanzahl an Requester zurückgeben
EndProcedure

_________________
Now these points of data make a beautiful line,
And we're out of Beta, we're releasing on time.


Zuletzt geändert von diceman am 22.05.2019 11:37, insgesamt 1-mal geändert.

Nach oben
 Profil  
Mit Zitat antworten  
 Betreff des Beitrags: Re: Isometrische 2D Spiele-Engine
BeitragVerfasst: 21.05.2019 20:35 
Offline
Benutzeravatar

Registriert: 25.09.2016 01:42
diceman hat geschrieben:
Ich habe dir hier mal meinen kompletten A*-Testcode rüberkopiert, das Programm ist vollkommen eigenständig lauffähig.
Es wird eine zufällige "Welt" aus zufälligen Blöcken erstellt, sowie ein zufälliger Start- und Zielpunkt gesetzt.
Mit der linken Maustaste kannst du den Startpunkt versetzen, und der Pfad wird daraufhin aktualisiert. Durch Drücken der Return-Taste erstellst du eine neue Welt.
Die ganze A*-Magie findet in der Prozedur getPath() statt. Dort findest du auch (in Zeile 279) das Macro _NoCornerCuts() ... sobald du dieses auskommentierst, "schneidet" die Pfadsuche Ecken von Blöcken ab, was nicht so schön smooth aussieht (alles eine Frage, ob du erlauben möchtest, daß der Spieler zwischen zwei diagonalen Blöcken durchschlüpfen darf).
Diese Version der Pfadsuche bezieht auch die diagonalen Felder ein.
Wenn du ausschließlich orthogonale Pfadsuche haben möchtest, mußt du Zeile 273 wie folgt ändern:

Code:
If (x = *nodePointer\X And y = *nodePointer\Y) Or binaryMap(x,y) = 0 Or checkList(x,y) = -1 Or (x <> *nodePointer\x And y <> *nodePointer\y)


Meinen A*-Code habe ich im Laufe von bestimmt 8 Jahren immer weiter auf maximale Effizienz und Geschwindigkeit optimiert (angefangen hat das in BlitzBasic), deswegen erlaube ich mir auch ein einziges Goto in der getPath()-Prozedur, um die Pfadsuche umgehend zu verlassen, sobald ein eindeutiges Ergebnis vorliegt.
Der Pfad wird aufgezeichnet, in einer Liste gespeichert, und kann so anschließend abgerufen werden.
Der getPath()-Code ist kommentiert, aber wenn du irgendwelche Fragen hast, stehe ich dir natürlich gerne Rede und Antwort. :)
...


Danke für das Code Beispiel :)

_NoCornerCuts() :o - einfach genial!

Mal sehen ob ich das auch so umsetzen kann.
Ich vermute das der Aufruf des Macros nach dem Check der Closed List stattfindet?
Das Macro checkt die Felder um das momentane Feld und entscheidet ob es berücksichtigt wird?

Ich gönn mir jetzt eine Tasse Tee und studier den Code :D

_________________

Links:
PureBasic Discord
[ENGINE] 2D Engine Nautilus (Win)
[INCLUDE] GLFW 3.3 Library
[MODULE] Bass Library 2.4 (Win)
[LIBRARY] Hexi Binary2Hex (Win)



Nach oben
 Profil  
Mit Zitat antworten  
Beiträge der letzten Zeit anzeigen:  Sortiere nach  
Ein neues Thema erstellen Auf das Thema antworten  [ 47 Beiträge ]  Gehe zu Seite Vorherige  1, 2, 3, 4, 5  Nächste

Alle Zeiten sind UTC + 1 Stunde [ Sommerzeit ]


Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 1 Gast


Sie dürfen keine neuen Themen in diesem Forum erstellen.
Sie dürfen keine Antworten zu Themen in diesem Forum erstellen.
Sie dürfen Ihre Beiträge in diesem Forum nicht ändern.
Sie dürfen Ihre Beiträge in diesem Forum nicht löschen.

Suche nach:
Gehe zu:  

 


Powered by phpBB © 2008 phpBB Group | Deutsche Übersetzung durch phpBB.de
subSilver+ theme by Canver Software, sponsor Sanal Modifiye