i have some source code, its similar a fluid, in runs from up to down.
means u have a list and the point that is lower your current height goto target.
'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
AGK 108 (B)19 + AppGameKit V2 Alpha .. : Windows 8.1 Pro 64 Bit : AMD Radeon R7 265 : Mac mini OS X 10.10 (Yosemite)
