Sorry your browser is not supported!

'BlitzBax 1.22

'MR Weg Suche

'Linke Maustaste = Anfang
'Rechte = Ziel
'Mittlere Maustaste zum Mauer malen

'so nicht die Mauern setzen
'X
' X

'sonder immer so !
'X
'XX
' X

Framework BRL.Blitz
Import BRL.Max2D
Import BRL.Graphics
Import BRL.GLMax2D
Import BRL.Pixmap
Import BRL.LinkedList
Import BRL.PolledInput

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