unit mit pathfinding bewegen

Übersicht BlitzBasic Beginners-Corner

Neue Antwort erstellen

kreisman

Betreff: unit mit pathfinding bewegen

BeitragSo, Dez 05, 2004 15:45
Antworten mit Zitat
Benutzer-Profile anzeigen
ich hab folgenden code

Code: [AUSKLAPPEN]

Dim grafik(4)
Dim playmap(80,80)
Include "pathfinding.bb"
For a = 1 To 4
  grafik(a)=LoadImage("tile"+Str$(a)+".bmp")
Next
curx=50
cury=50
notmove=1
mapheight=80
mapwidth=80
For x = 0 To 79
For y = 0 To 79
  playmap(x,y)=2
Next
Next
unit = LoadImage("worker.bmp")
maus = LoadImage("maus.bmp")
MaskImage unit,255,0,255
MaskImage maus,255,0,255
createmap(80,80)
Graphics 800,600,16,0

SetBuffer BackBuffer()
Repeat
Cls
For x = 0 To 79
For y = 0 To 79
DrawBlock grafik(playmap(x,y)),x*30,y*30  ;Map malen
Next
Next
DebugLog(newx)
If MouseHit(1) Then
  newx=MouseX()/30
  newy=MouseY()/30
  oldx=curx/30
  oldy=cury/30
  curx=newx*30
  cury=newy*30
  pathfinding(oldx,oldy,newx,newy)
  notmove=0
  For path.path = Each path
   DrawImage unit,path\node\x*30,path\node\y*30
  Next
  notmove=1
EndIf

If notmove=1 Then 
DrawImage unit,curx,cury
EndIf
DrawImage maus,MouseX(),MouseY()
Flip
Until KeyHit(1)

End

das problem dabei ist das die unit sich über den bildschirm beamt
Wo ist der fehler????
Hier ist noch die pathfinding routine

Code: [AUSKLAPPEN]

Type node
  Field parent.node
  Field cost
  Field x
  Field y
End Type

Type open
  Field node.node
End Type

Type path
  Field node.node
End Type

Dim map(0,0)
Dim sqrmap(0,0)
Dim nodemap(0,0)
Dim dirx(7)
Dim diry(7)
Dim dirz(7)

For i=0 To 7
  Read dirx(i)
  Read diry(i)
  Read dirz(i)
Next

Global mapwidth
Global mapheight






Function createmap(width,height)  ;pathfindingmap erstellen
  mapwidth=width-1
  mapheight=height-1
  Dim map(width-1,height-1)
  Dim sqrmap(width-1,height-1)
  For y=0 To mapheight
    For x=0 To mapwidth
      sqrmap(x,y)=Sqr(x*x+y*y)
    Next
  Next
End Function




Function pathfinding(startx,starty,endx,endy)         
  Delete Each node                               
  Delete Each open                                   
  Delete Each path
  Dim nodemap(mapwidth,mapheight)
  If startx=endx And starty=endy Then Return

  node.node=New node
  node\x=startx
  node\y=starty
  open.open=New open
  open\node=node
  nodemap(startx,starty)=1

  .again2
  node=Null
  cost=2147483647
  For open=Each open
    delta=sqrmap(Abs(open\node\x-endx),Abs(open\node\y-endy))
    If open\node\cost+delta<cost Then
      cost=open\node\cost+delta
      node=open\node
      tempopen.open=open
    EndIf
  Next
  If node=Null Then Return
  Delete tempopen

  For i=0 To 7
    x=node\x+dirx(i)
    y=node\y+diry(i)
    If x=>0 And y=>0 And x<=mapwidth And y<=mapheight Then
      If map(x,y)=0 And nodemap(x,y)=0 Then
        If dirz(i)=1 Then
          If map(x,node\y)=1 And map(node\x,y)=1 Then Goto jump2
        EndIf
        tempnode.node=New node
        tempnode\parent=node
        tempnode\cost=node\cost+1+dirz(i)
        tempnode\x=x
        tempnode\y=y
        open.open=New open
        open\node=tempnode
        nodemap(x,y)=1
        If x=endx And y=endy Then finish=1:Exit
        .jump2
      EndIf
    EndIf
   Next
  If finish=0 Then Goto again2

  While tempnode\parent<>Null
    path.path=New path
    path\node=tempnode
    tempnode=tempnode\parent
  Wend
  path.path=New path
  path\node=tempnode
End Function


;--------------------------------------------------------------------------
Data 0,-1,0,  -1,0,0,  1,0,0,  0,1,0,  -1,-1,1,  1,-1,1,  -1,1,1,  1,1,1 

Hubsi

BeitragSo, Dez 05, 2004 15:56
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab mich mit ?bruZards? Pathfindingroutine noch nicht näher auseinander gesetzt, aber Du musst die Punkte der Reihe nach durchgehen, nicht alle auf einmal. Du nimmst immer den ersten (oder letzten) Eintrag der Type-Kollektion und läufst zu diesem hin. Ist er +/- einer gewissen Toleranz erreicht wird er gelöscht usw.
Den ganzen Doag im Bett umanandflagga und iaz daherkema und meine Hendl`n fressn...

kreisman

BeitragSo, Dez 05, 2004 16:08
Antworten mit Zitat
Benutzer-Profile anzeigen
ich habe das mal anders versucht, nur jetzt findet er das Object nicht mehr
Code: [AUSKLAPPEN]

  If Not path.path = Last path Then   
   DrawImage unit,path\node\x*30,path\node\y*30
   path.path = After path.path
  EndIf

Neue Antwort erstellen


Übersicht BlitzBasic Beginners-Corner

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group