Wikipedia:
Marching squares is a computer graphics algorithm that generates contours for a two-dimensional scalar field (rectangular array of individual numerical values)
Code: Select all
EnableExplicit
Structure MetaBall
x.f
y.f
xd.f
yd.f
f.f
EndStructure
#Wid = 600
#Hig = 600
#Res = 60
#Size = #Wid / #Res
#Threshold = 1.0
#NrMetaBalls = 25
Global Dim Metaball.MetaBall(#NrMetaBalls)
Global Dim Field.f(#Res, #Res)
Procedure Initialize()
Protected n
OpenWindow(0, 0, 0, #Wid, #Hig, "Marching Squares")
CanvasGadget(0, 0, 0, #Wid, #Hig)
For n = 0 To #NrMetaBalls - 1
Metaball(n)\x = #Wid / 2
Metaball(n)\y = #Hig / 2
Metaball(n)\f = (n + 1) * 750
Next
EndProcedure
Procedure Update()
Protected x, y, xb.f, yb.f, f.f
Protected n, t.f = ElapsedMilliseconds() * 0.00002
For n = 0 To #NrMetaBalls - 1
With Metaball(n)
\xd = Cos(t * (n + 1))
\yd = Sin(t * (n + 1))
\x + (#wid * 0.5 - \x) * 0.08 + Sin(\xd) * \yd * (n + 1)
\y + (#hig * 0.5 - \y) * 0.08 + Cos(\yd) * \xd * (n + 1)
EndWith
Next
For y = 0 To #Res - 1
yb = y * #Size
For x = 0 To #Res - 1
xb = x * #Size
f = 0
For n = 0 To #NrMetaBalls - 1
f + 1.0 / (Pow(Metaball(n)\x - xb, 2) + Pow(Metaball(n)\y - yb, 2) + 0.000000001) * Metaball(n)\f
Next
Field(x, y) = f / #NrMetaBalls
Next
Next
EndProcedure
Macro I(a_, b_)
((1 - f#b_) / (f#a_ - f#b_))
EndMacro
Procedure MarchingSquares()
Protected x, y, corner
Protected.f f0, f1, f2, f3
StartVectorDrawing(CanvasVectorOutput(0))
VectorSourceColor(RGBA(55,55,55,255))
FillVectorOutput()
ScaleCoordinates(DesktopScaledX(#Size), DesktopScaledY(#Size))
VectorSourceColor(RGBA(255,255,255,255))
For y = 0 To #Res - 2
For x = 0 To #Res - 2
f0 = Field(x, y)
f1 = Field(x + 1, y)
f2 = Field(x, y + 1)
f3 = Field(x + 1, y + 1)
corner = 0
If f0 > #Threshold
corner | %1000
EndIf
If f1 > #Threshold
corner | %0100
EndIf
If f2 > #Threshold
corner | %0010
EndIf
If f3 > #Threshold
corner | %0001
EndIf
If corner > %0000 And corner < %1111
Select corner
Case %0001
MovePathCursor(x + I(3,2), y + 1)
AddPathLine(x + 1, y + I(3,1))
Case %0010
MovePathCursor(x, y + I(2,0))
AddPathLine(x + I(3,2), y + 1)
Case %0011
MovePathCursor(x, y + I(2,0))
AddPathLine(x + 1, y + I(3,1))
Case %0100
MovePathCursor(x + I(1,0), y)
AddPathLine(x + 1, y + I(3,1))
Case %0101
MovePathCursor(x + I(1,0), y)
AddPathLine(x + I(3,2), y + 1)
Case %0110
MovePathCursor(x + I(1,0), y)
AddPathLine(x + 1, y + I(3,1))
MovePathCursor(x, y + I(2,0))
AddPathLine(x + I(3,2), y + 1)
Case %0111
MovePathCursor(x, y + I(2,0))
AddPathLine(x + I(1,0), y)
Case %1000
MovePathCursor(x, y + I(2, 0))
AddPathLine(x + I(1,0), y)
Case %1001
MovePathCursor(x, y + I(2, 0))
AddPathLine(x + I(1,0), y)
MovePathCursor(x + I(3,2), y + 1)
AddPathLine(x + 1, y + I(3,1))
Case %1010
MovePathCursor(x + I(1,0), y)
AddPathLine(x + I(3,2), y + 1)
Case %1011
MovePathCursor(x + I(1,0), y)
AddPathLine(x + 1, y + I(3,1))
Case %1100
MovePathCursor(x, y + I(2,0))
AddPathLine(x + 1, y + I(3,1))
Case %1101
MovePathCursor(x, y + I(2,0))
AddPathLine(x + I(3,2), y + 1)
Case %1110
MovePathCursor(x + I(3,2), y + 1)
AddPathLine(x + 1, y + I(3,1))
EndSelect
EndIf
Next
Next
StrokePath(0.35)
StopVectorDrawing()
EndProcedure
Initialize()
Repeat
Update()
MarchingSquares()
Delay(25)
Until WindowEvent() = #PB_Event_CloseWindow
