
-----------------------------------
Catalyst
Fri Mar 12, 2004 12:39 am

[source] Metaballs
-----------------------------------
An implementation that went from idea to finish in 12 minutes
go me

const sizeX := 40
const sizeY := 40
View.Set ("offscreenonly,graphics:400;400,nobuttonbar")
var field : array 0 .. sizeX, 0 .. sizeY of real
var edge : array 0 .. sizeX, 0 .. sizeY of real
function distanceH (x1, y1, x2, y2 : real) : real
    result ((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
end distanceH
var ballCount : int := 3
var ballX, ballY, ballRad : array 1 .. ballCount of real

const threshold := 1

proc DrawField
    for i : 0 .. sizeX - 1
        for k : 0 .. sizeY - 1
            if (edge (i, k) = 1) then
                drawfillbox (i * (maxx div sizeX), k * (maxy div sizeY), (i + 1) * (maxx div sizeX), (k + 1) * (maxy div sizeY), 0)
            elsif (edge (i, k) = 2) then
                drawfillbox (i * (maxx div sizeX), k * (maxy div sizeY), (i + 1) * (maxx div sizeX), (k + 1) * (maxy div sizeY), 56)
            end if
        end for
    end for
end DrawField

proc EvaluateField
    var holdSum : real := 0
    for i : 0 .. sizeX - 1
        for k : 0 .. sizeY - 1
            edge (i, k) := 0
            holdSum := 0
            for j : 1 .. ballCount
                holdSum += (ballRad (j) * ballRad (j)) / (distanceH (ballX (j), ballY (j), i * (maxx div sizeX), k * (maxy div sizeY)) + 0.001)
            end for
            field (i, k) := holdSum
        end for
    end for
    for i : 1 .. sizeX - 2
        for k : 1 .. sizeY - 2
            if (field (i, k) > threshold) then
                edge (i, k) := 2
            end if
            for j : -1 .. 1
                for l : -1 .. 1
                    if (field (i + j, k + l) < threshold) and (field (i, k) > threshold) then
                        edge (i, k) := 1
                    end if
                end for
            end for
        end for
    end for

end EvaluateField

proc DrawBalls
    for i : 1 .. ballCount
        drawoval (round (ballX (i)), round (ballY (i)), 3, 3, 103)
        drawoval (round (ballX (i)), round (ballY (i)), round (ballRad (i)), round (ballRad (i)), 42)
    end for
end DrawBalls


ballX (1) := 100 * 0.58
ballY (1) := 100 * 0.58
ballRad (1) := 100 * 0.58

ballX (2) := 300 * 0.58
ballY (2) := 300 * 0.58
ballRad (2) := 100 * 0.58

ballX (3) := 100 * 0.58
ballY (3) := 300 * 0.58
ballRad (3) := 100 * 0.58

var x, y, z : int
loop
    mousewhere (x, y, z)
    EvaluateField
    DrawField
    DrawBalls
    for i : 1 .. ballCount
        if sqrt ((ballX (i) - x) * (ballX (i) - x) + (ballY (i) - y) * (ballY (i) - y)) 