Beispiel Weg Suche , Listen und Types
Übersicht

![]() |
Markus2Betreff: Beispiel Weg Suche , Listen und Types |
![]() Antworten mit Zitat ![]() |
---|---|---|
Beispiel für eine schnelle Weg Suche die ein Gefälle zum Ziel aufbaut .
Wie es geht : man legt einen Startpunkt und einen Endpunkt fest . Der Startpunkt wird einer Liste hinzugefügt und bekommt den Wert 1 . Alle Punkte drum herum die noch keinen Wert haben und auch keine Mauer sind bekommen den Wert +1 und werden einer neuen Liste hinzu gefügt welche wieder als Parameter dient . Das läuft dann so lange bis das Ziel gefunden wurde oder alle Punkte einen Wert bekommen haben . Code: [AUSKLAPPEN] 'MR Weg Suche 'Linke Maustaste = Anfang 'Rechte = Ziel 'Mittlere Maustaste zum Mauer malen '(FixedSys Font :) 'so nicht die Mauern setzen 'X ' X 'sonder immer so ! 'X 'XX ' X Strict Graphics 800,600 Type TPos Field x:Int Field y:Int Field w:Int Function Add:TPos(x:Int,y:Int,w:Int=0) Local T:TPos=New TPos T.x=x T.y=y T.w=0 Return T End Function End Type Global A:TList=CreateList() Global Ar:TPos[50,50] InitA() Global Fertig:Int Const Raster:Int=8 MainLoop() End Function MainLoop() Local xs:Int Local ys:Int Local xe:Int Local ye:Int AZeigen While Not KeyHit(KEY_ESCAPE) If MouseDown(3) Then SetAImmer MouseX()/Raster,MouseY()/Raster, -1 AZeigen EndIf If MouseDown(1) Then xs=MouseX()/Raster ys=MouseY()/Raster Start(xs,ys,xe,ye) AZeigen() EndIf If MouseDown(2) Then xe=MouseX()/Raster ye=MouseY()/Raster Start(xs,ys,xe,ye) AZeigen() EndIf Wend End Function Function AZeigen() Local p:TPos Local g:Double Cls For p = EachIn A If p.w > 0 Then g = p.w * 4 If g > 255 Then g = 255 SetColor g,g,g DrawRect p.x * Raster, p.y * Raster ,Raster,Raster Else If p.w < 0 Then SetColor 128, 0, 0 DrawRect p.x * Raster, p.y * Raster , Raster,Raster End If End If Next Flip EndFunction Function InitA() Local x:Int Local y:Int ClearList A For x=0 To 49 For y=0 To 49 Ar[x,y]=TPos.Add(x,y) A.addlast Ar[x,y] Next Next SetAImmer 20, 30, -1 SetAImmer 20, 31, -1 SetAImmer 20, 32, -1 SetAImmer 20, 33, -1 SetAImmer 20, 34, -1 SetAImmer 25, 30, -1 SetAImmer 25, 31, -1 SetAImmer 25, 32, -1 SetAImmer 25, 33, -1 SetAImmer 25, 34, -1 SetAImmer 20, 29, -1 SetAImmer 21, 29, -1 SetAImmer 22, 29, -1 SetAImmer 23, 29, -1 SetAImmer 24, 29, -1 SetAImmer 25, 29, -1 End Function Function ResetA() Local p:TPos For p = EachIn A If p.w > 0 Then p.w=0 EndIf Next End Function Function Start(xs:Int,ys:Int,xe:Int,ye:Int) ResetA() 'DebugLog "Gesamt Liste Count = " + A.Count() Fertig = 0 Local c:Int Local Col:TList=CreateList() c = 0 Local Anfang:TPos=TPos.Add(xs,ys,1) Local Ziel:TPos=TPos.Add(xe,ye) Col.Addlast Anfang Repeat c = c + 1 If (c Mod 250) = 0 Then AZeigen 'DebugLog "Übergabe Liste Count = " + Col.Count() Col = Vor(Ziel, Col) If Col.Count() = 0 Then Exit If Fertig = 1 Then Exit Forever 'Als weiß zeigen SetAImmer Anfang.x,Anfang.y,10000 SetAImmer Ziel.x,Ziel.y,10000 End Function Function Vor:TList(Ziel:TPos,Col:TList) Local L:TList=CreateList() Local p:TPos For P=EachIn Col Rundherum p,Ziel, L Next Return L End Function Function Rundherum(p:TPos,Ziel:TPos,Col:TList Var) If p.x = Ziel.x And p.y = Ziel.y Then Fertig = 1; Return SetA p.x - 1, p.y,p.w+1,Col SetA p.x, p.y - 1,p.w+1,Col SetA p.x + 1, p.y,p.w+1,Col SetA p.x, p.y + 1,p.w+1,Col SetA p.x-1,p.y-1,p.w+1,Col SetA p.x+1,p.y-1,p.w+1,Col SetA p.x+1,p.y+1,p.w+1,Col SetA p.x-1,p.y+1,p.w+1,Col End Function Function SetA(x:Int,y:Int,w:Int,Col:TList Var) If x<0 Then Return If y<0 Then Return If x>49 Then Return If y>49 Then Return Local p:TPos p=Ar[x,y] If p.w = 0 Then 'DebugLog "Merke "+x+" "+y+" "+w p.w = w Col.Addlast p EndIf End Function Function SetAImmer(x:Int,y:Int,w:Int) If x<0 Then Return If y<0 Then Return If x>49 Then Return If y>49 Then Return Local p:TPos p=Ar[x,y] p.w = w End Function |
||
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group