PathFinder - Update 11.08.06

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

StepTiger

Betreff: PathFinder - Update 11.08.06

 BeitragMi, Aug 09, 2006 1:03
Antworten mit Zitat
Benutzer-Profile anzeigen
Es begann mit einer Frage und wurde zu einem Code Smile

Beruht auf dem A* Prinzip.

Bisher hat er IMMER den Weg gefunden, wenn es einen gab.

ok! verändert. keine Flaggen mehr

Update: jetzt mit lade funktion (verstellbar)

Code: [AUSKLAPPEN]
show=1 ; sichtbar oder nicht?
max=40
lod=1

If lod=1
   max=0
   x=ReadFile("data.txt")
   While Not Eof(x)
      c$=ReadLine$(x)
      max=max+1
   Wend
   CloseFile x
EndIf

Dim dat(max,max)
Dim knot(max*(max+1)+max)
Dim knot_urspr(max*(max+1)+max)
Dim knot_dist#(max*(max+1)+max)

Dim ToDo(max*(max+1)+max)
Dim used(max*(max+1)+max)
Graphics max*20,max*20+20,32,2
SetBuffer BackBuffer()


If lod=0 Then Restore datas

If lod=0
   For y=1 To max
      For x=1 To max
         Read dat(x,y)
         tnum=x*(max+1)+y
         If dat(x,y)=2
            num=(x*(max+1))+y
            knot(num)=1
            ToDo(num)=1
            posx=x
            posy=y
            starx=x
            stary=y
         EndIf
         If dat(x,y)=3
            tarx=x
            tary=y
         EndIf
      Next
   Next
EndIf

If lod=1
   x=ReadFile("data.txt")
   While Not Eof(x)
      y=y+1
      c$=ReadLine$(x)
      c$=Right$(c$,Len(c$)-5)
      tx=0
      While Instr(c$,",")>0
         pos=Instr(c$,",")
         tx=tx+1
         tdat=Left$(c$,pos-1)
         dat(tx,y)=tdat
         c$=Right$(c$,Len(c$)-pos)
         tnum=tx*(max+1)+y
         If tdat=2
            num=(tx*(max+1))+y
            knot(num)=1
            ToDo(num)=1
            posx=tx
            posy=y
            starx=tx
            stary=y
         EndIf
         If tdat=3
            tarx=tx
            tary=y
         EndIf
      Wend
      tx=tx+1
      tdat=c$
      dat(tx,y)=tdat
      tnum=tx*(max+1)+y
      If tdat=2
         num=(tx*(max+1))+y
         knot(num)=1
         ToDo(num)=1
         posx=tx
         posy=y
         starx=tx
         stary=y
      EndIf
      If tdat=3
         tarx=tx
         tary=y
      EndIf
   Wend
   CloseFile x
EndIf

If tarx=0 Or tary=0 Then RuntimeError "Kein Ziel!"
;knot_dist#(num)=cdist#(num/(max+1),num And max,tarx,tary)


While Not KeyDown(1) Or found=1
   Cls

   num=posx*(max+1)+posy
   For chx=-1 To 1
      For chy=-1 To 1
         px=posx+chx
         py=posy+chy
         pnum=px*(max+1)+py
         If px>0 And py>0 And px<=max And py<=max And Abs(chx)<>Abs(chy)
            If dat(px,py)<>1
               If used(pnum)=0
                  knot(pnum)=1
                  ToDo(pnum)=1
                  knot_urspr(pnum)=num
                  knot_dist#(pnum)=knot_dist#(num)+1
                  If dat(px,py)=6 Then knot_dist#(pnum)=knot_dist#(pnum)+.5
                  If dat(px,py)=7 Then knot_dist#(pnum)=knot_dist#(pnum)+.8
               EndIf
            EndIf
         EndIf
      Next
   Next
   ToDo(num)=0
   used(num)=1
   
   searchdist#=10000
   searchx=0
   searchy=0
   
   For x=1 To max
      For y=1 To max
         num=x*(max+1)+y
         If ToDo(num)=1
            If knot_dist#(num)<searchdist#
               searchx=x
               searchy=y
               searchdist#=knot_dist#(num)
            EndIf
         EndIf
      Next
   Next
   
   If searchx=0 Or searchy=0 Then RuntimeError "Kein Weg!"

   posx=searchx
   posy=searchy

   dat(posx,posy)=4

   If show=1
      For x=1 To max
         For y=1 To max
            tposx=(x-1)*20
            tposy=(y-1)*20
            If dat(x,y)=0 Then Color 125,125,125
            If dat(x,y)=1 Then Color 255,0,0
            If dat(x,y)=2 Then Color 0,255,0
            If dat(x,y)=3 Then Color 0,0,255
            If dat(x,y)=4 Then Color 255,0,255
            If dat(x,y)=6 Then Color 125,125,255
            If dat(x,y)=7 Then Color 128,0,0
            Rect tposx,tposy,20,20
            Color 255,255,255
            Text tposx+5,tposy+5,Int(knot_dist(x*(max+1)+y))
         Next
      Next
   EndIf

   Text 1,max*20,"X: "+posx+" Y:"+posy+" "+knot_urspr(posx*(max+1)+posy)

   If Abs(tarx-posx)<=1 And Abs(tary-posy)<=1 And Abs(tarx-posx)<>Abs(tary-posy)
      tx=posx
      ty=posy
      dat(tx,ty)=5
      tnum=knot_urspr((tx*(max+1))+ty)

      tx=tnum/(max+1) - (tnum/(max+1)) Mod 1
      ty=((tnum/(max+1.)) - tx) * (max+1)
      dat(tx,ty)=5

      While tnum<>(starx*(max+1)+stary)
         tnum=knot_urspr(tnum)
         tx=tnum/(max+1) - (tnum/(max+1)) Mod 1
         ty=((tnum/(max+1.)) - tx) * (max+1)
         dat(tx,ty)=5
;         Cls
;         Text 1,1,tnum+" "+tx+" "+ty
;         Flip
;         WaitKey
      Wend

      For x=1 To max
         For y=1 To max
            tposx=(x-1)*20
            tposy=(y-1)*20
            If dat(x,y)=0 Then Color 125,125,125
            If dat(x,y)=1 Then Color 255,0,0
            If dat(x,y)=2 Then Color 0,255,0
            If dat(x,y)=3 Then Color 0,0,255
            If dat(x,y)=4 Then Color 255,0,255
            If dat(x,y)=5 Then Color 255,255,255
            If dat(x,y)=6 Then Color 125,125,255
            If dat(x,y)=7 Then Color 128,0,0
            Rect tposx,tposy,20,20
            Color 255,255,255
            If dat(x,y)=5 Then Color 0,0,0
            Text tposx+5,tposy+5,Int(knot_dist(x*(max+1)+y))
         Next
      Next

      Flip

      RuntimeError "Gefunden! X:"+posx+" Y:"+posy

   EndIf

   If MouseDown(1) Or MouseDown(2)
      mosx=MouseX()/20+1
      mosy=MouseY()/20+1
      If MouseDown(1) Then dat(mosx,mosy)=1
      If MouseDown(2) Then dat(mosx,mosy)=0
   EndIf

   If show=1 Then Flip:Delay 0

Wend

End

.datas
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,3,7,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,7,7,7,1,1,1,0,0,1,0,1,1,1,1,0,1,1,1,1,1,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,7,1,1,1,0,0,0,0,1,1,0,0,0,1,7,7,7,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,1,1,7,1,0,0,0,0,1,1,1,1,0,1,1,1,7,7,1,1,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,1,7,1,0,1,1,1,1,1,0,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,0,1,1,0,1,7,1,0,0,1,0,1,1,0,1,1,1,1,7,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,1,0,1,7,1,1,0,1,0,1,1,0,0,0,1,1,7,7,7,1,6,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,0,1,7,1,0,0,1,0,1,1,1,1,0,1,1,7,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,6,0,1,7,1,0,1,1,0,1,1,0,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,0,1,1,1,1,7,1,0,0,1,0,1,1,0,1,1,1,1,7,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,1,7,1,1,0,1,0,1,1,0,0,0,1,1,7,7,7,1,7,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,1,7,1,0,0,1,0,1,1,1,1,0,1,1,7,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,0,1,1,0,1,0,0,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,7,1,0,0,1,0,1,0,1,1,1,1,1,7,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,1,0,1,0,1,0,0,0,1,1,1,7,7,7,1,6,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,7,1,0,0,1,0,1,1,1,0,1,1,1,7,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,0,1,1,0,0,0,1,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,7,1,0,0,1,1,1,0,1,1,0,1,1,1,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,1,0,0,0,1,0,1,0,0,6,6,1,7,7,1,7,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,7,1,1,1,1,0,1,0,1,0,0,1,6,1,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,1,0,0,0,1,0,1,1,1,1,6,1,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,7,1,0,0,1,0,1,0,1,7,7,1,6,1,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,0,1,1,0,1,0,1,1,7,1,6,1,7,7,1,6,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,7,1,0,0,0,0,1,0,1,0,0,6,6,1,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,1,0,1,1,1,0,1,0,0,1,1,1,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,7,1,0,0,1,0,0,0,1,1,0,1,1,7,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,0,1,1,0,1,0,1,0,0,1,1,7,7,7,1,7,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,7,1,0,0,1,0,0,0,1,0,1,1,1,7,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,1,0,1,0,1,1,1,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,7,1,0,0,1,0,1,1,1,1,0,1,1,7,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,0,1,1,0,1,1,0,0,0,1,1,7,7,7,1,6,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,7,1,0,0,1,0,1,1,0,1,1,1,1,7,7,7,1,6,6,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,1,0,1,0,1,1,0,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,1,0,1,7,1,0,0,1,0,1,1,1,1,0,1,1,7,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,1,7,1,0,1,1,0,1,1,0,0,0,1,1,7,7,7,1,7,1,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,1,7,1,0,0,1,0,1,1,0,1,1,1,1,7,7,7,1,7,7,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,7,1,1,0,1,0,1,1,0,0,0,1,1,7,7,7,1,1,1,0
Data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0


Function cdist#(x,y,tax,tay)
   Return Sqr#((x-tax)*(x-tax)+(y-tay)*(y-tay))
End Function


mapgröße verstellbar
0 - freier Raum
1 - Stein
2 - Start
3 - Ziel
4 - begangener Weg
5 - begangener Weg mit Flagge
6 - Berg
7 - Schlamm

Bin mal stolz auf einen code - weiß net, ob hier schonmal einer gepostet wurde. (also ein funktionierender pathfinder. Vor kurzem war einer, der ganz viele Wege nicht gefunden hat)

*edit* Code verbessert. Mapeditor gemacht! Erstellt eine Datei data.txt
Steuern:
Rechte Maustaste = räumen
Linke Maustaste = Tile setzen

1 - Stein
2 - Start
3 - Ziel
(zu Testzwecken)
5 - Berg
6 - Schlamm

Code: [AUSKLAPPEN]
lod=Input("Load Data?   ")
If lod=0 Then max=Input("Max?   ")

If lod=1
   x=ReadFile("data.txt")
   While Not Eof(x)
      c$=ReadLine$(x)
      max=max+1
   Wend
   CloseFile x
EndIf

Graphics max*20,max*20+20,32,2
Dim dat(max,max)

If lod=1
   x=ReadFile("data.txt")
   While Not Eof(x)
      y=y+1
      c$=ReadLine$(x)
      c$=Right$(c$,Len(c$)-5)
      tx=0
      While Instr(c$,",")>0
         pos=Instr(c$,",")
         tx=tx+1
         dat(tx,y)=Left$(c$,pos-1)
         c$=Right$(c$,Len(c$)-pos)
      Wend
      tx=tx+1
      dat(tx,y)=c$
   Wend
   CloseFile x
EndIf
         

draw=1

SetBuffer BackBuffer()

While Not KeyDown(1)
   Cls
   If KeyDown(2) Then draw=1
   If KeyDown(3) Then draw=2
   If KeyDown(4) Then draw=3
   If KeyDown(6) Then draw=6
   If KeyDown(7) Then draw=7
   
   If MouseDown(1)
      posx=MouseX()/20+1
      posy=MouseY()/20+1
      If posx<1 Then posx=1
      If posx>max Then posx=max
      If posy<1 Then posy=1
      If posy>max Then posy=max
      dat(posx,posy)=draw
   EndIf
   If MouseDown(2)
      posx=MouseX()/20+1
      posy=MouseY()/20+1
      If posx<1 Then posx=1
      If posx>max Then posx=max
      If posy<1 Then posy=1
      If posy>max Then posy=max
      dat(posx,posy)=0
   EndIf
   
   For x=1 To max
      For y=1 To max
         If dat(x,y)=0 Then Color 125,125,125
         If dat(x,y)=1 Then Color 255,0,0
         If dat(x,y)=2 Then Color 0,0,255
         If dat(x,y)=3 Then Color 0,255,0
         If dat(x,y)=6 Then Color 125,125,255
         If dat(x,y)=7 Then Color 128,0,0
         posx=(x-1)*20
         posy=(y-1)*20
         Rect posx,posy,20,20
      Next
   Next
   
   If KeyHit(28)
      f=WriteFile("data.txt")
      For y=1 To max
         tstr$="Data "
         For x=1 To max
            tstr$=tstr$+dat(x,y)+","
         Next
         tstr$=Left$(tstr$,Len(tstr$)-1)
         WriteLine f,tstr$
      Next
      CloseFile f
   EndIf
   Delay 0
   Flip
Wend
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.
  • Zuletzt bearbeitet von StepTiger am Fr, Aug 11, 2006 17:15, insgesamt 7-mal bearbeitet
 

$tankY

 BeitragDo, Aug 10, 2006 0:22
Antworten mit Zitat
Benutzer-Profile anzeigen
Code: [AUSKLAPPEN]
Data 0,0,0,0,0,0,2,0,0,0,0,0,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,1,1,1,1,1,0,1,1,1,1,1,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,1,1,0,1,1,1,1,1,1,1,1,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,0,1,1,1,1,1,1,1,1,1,1,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,3

spuckt "Es gibt keinen Weg" aus!

StepTiger

 BeitragDo, Aug 10, 2006 0:35
Antworten mit Zitat
Benutzer-Profile anzeigen
hmm... komisch

kommentier den part einfach aus, dann gehts.

ich habs oben mal auf deins umgeändert

SO

oben jetzt komplett so, dass es auch mit deinen einstellungen den error nur gibt, wenn es auch so ist ^^
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.
 

$tankY

 BeitragDo, Aug 10, 2006 0:43
Antworten mit Zitat
Benutzer-Profile anzeigen
Wirklich komisch, hab eben nochma geschaut, liegt daran, dass nach den Data-Reihen keine Leerzeichen sind, wieso auch immer...
Das wäre im Mapeditor dann:
Code: [AUSKLAPPEN]
WriteLine f,tstr$+" "

StepTiger

 BeitragDo, Aug 10, 2006 0:46
Antworten mit Zitat
Benutzer-Profile anzeigen
nö wieso

meine map war auch im map editor erstellt ^^
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.

StepTiger

 BeitragDo, Aug 10, 2006 23:43
Antworten mit Zitat
Benutzer-Profile anzeigen
ENDLICH MAL EINE BAHNBRECHENDE VERÄNDERUNG!

Hier der komplett neue, verbesserte, auf jeden Fall den richtigen, kürzesten und besten Weg findende...
Code: siehe oben
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer:
AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t
Gewinner: BP Code Compo #2
Π=3.141592653589793238...<--- und das aus dem kopf Laughing
Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser.

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group