Metaball 2D Demo - 10 lines - GameCreators Forum

Author

Message

Azrael

19

Years of Service

User Offline

Joined: 2nd Mar 2005

Location: Germany

Posted: 6th May 2006 20:35

Link

You may already know Metaballs from other popular Demos. I just tried this in DBP. 3D was a bit to slow, but I'm working on it, so im made it in 2D. It's based on the Marching Cube Algorithm.

The Code is not optimized and the Demo a bit monochrome, I know.

I hope you like it though.

Set window off : Sync on : Sync rate 0 : Sync : Set display mode 800, 600, 32 : Randomize Timer() : Global MBCount = 6 : Dim Grid(80, 60) As float : Dim TLT(15, 8) As integer : Dim Metaballs(MBCount - 1, 2) As float : Dim Path(MBCount - 1, 9, 3) As float : pf As Float : pi As integer : For i = 0 To MBCount - 1 : Metaballs(i, 0) = Rnd(800)/10.0 : Metaballs(i, 1) = Rnd(600)/10.0 : Metaballs(i, 2) = 1.5 : Next : For i = 1 To 5 : null = Make vector2(i) : Next
For i = 0 To MBCount - 1 : For j = 0 To 9 : v# = Rnd(3600)*0.1 : Path(i, j, 0) = Rnd(800)/10.0 : Path(i, j, 1) = Rnd(600)/10.0 : Path(i, j, 2) = Cos(v#) : Path(i, j, 3) = Sin(v#) : Next : Path(i, 9, 0) = Path(i, 0, 0) : Path(i, 9, 1) = Path(i, 0, 1) : Path(i, 9, 2) = Path(i, 0, 2) : Path(i, 9, 3) = Path(i, 0, 3) : Next : For i = 0 To 15 : For j = 0 To 8 : Read TLT(i, j) : Next : Next
Ink 0, 0 : Do : Cls 0xA0A0A0 : For i = 0 To MBCount - 1 : Inc pf, 0.002 : If pf > 1 : Inc pi : pf = 0 : Endif : If pi = 9 : pi = 0 : Endif : Set vector2 1, Path(i, pi, 0), Path(i, pi, 1) : Set vector2 2, Path(i, pi, 2), Path(i, pi, 3) : Set vector2 3, Path(i, pi + 1, 0), Path(i, pi + 1, 1) : Set vector2 4, Path(i, pi + 1, 2), Path(i, pi + 1, 3) : Hermite vector2 5, 1, 2, 3, 4, pf : Metaballs(i, 0) = X vector2(5) : Metaballs(i, 1) = Y vector2(5) : Next
For y = 0 To 60 : For x = 0 To 80 : Grid(x, y) = SumMB(x, y) : Next : Next : Lock pixels : For y = 1 To 58 : For x = 1 To 78 : Dot x*10, y*10 : Index = 0 : If Grid(x + 0, y + 0) > 1 : Inc Index, 1 : Endif : If Grid(x + 1, y + 0) > 1 : Inc Index, 2 : Endif :  If Grid(x + 1, y + 1) > 1 : Inc Index, 4 : Endif : If Grid(x + 0, y + 1) > 1 : Inc Index, 8 : Endif : i = 0 : b = 0 : While TLT(Index, i) > -1 : Select TLT(Index, i) 
Case 1 : xn# = x + (1 - Grid(x + 0, y + 0))/(Grid(x + 1, y + 0) - Grid(x + 0, y + 0)) : yn# = y : Endcase : Case 2 : xn# = x + 1 : yn# = y + (1 - Grid(x + 1, y + 0))/(Grid(x + 1, y + 1) - Grid(x + 1, y + 0)) : Endcase : Case 3 : xn# = x + (1 - Grid(x + 0, y + 1))/(Grid(x + 1, y + 1) - Grid(x + 0, y + 1)) : yn# = y + 1 : C = 0xFF00 : Endcase : Case 4 : xn# = x : yn# = y + (1 - Grid(x + 0, y + 0))/(Grid(x + 0, y + 1) - Grid(x + 0, y + 0)) : Endcase : Endselect
If b = 0 : xt# = xn# : yt# = yn# : b = 1 : Else : Line xt#*10, yt#*10, xn#*10, yn#*10 : Line xt#*10 + 1, yt#*10, xn#*10 + 1, yn#*10 : Line xt#*10, yt#*10 + 1, xn#*10, yn#*10 + 1 : b = 0 : Endif : Inc i : Endwhile : Next : Next : Unlock pixels : Sync : Loop
Function SumMB(x As float, y As float)
  For i = 0 To MBCount - 1 : Inc v#, Sqrt(Metaballs(i, 2)^2/((x - Metaballs(i, 0))^2 + (y - Metaballs(i, 1))^2)) : Next
Endfunction v#
Data -1, -1, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  2,  4, -1, -1, -1, -1, -1, -1, -1, 2,  3, -1, -1, -1, -1, -1, -1, -1, 1,  2,  2,  3,  3,  4,  4,  1, -1, 3,  1, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1,  3,  1, -1, -1, -1, -1, -1, -1, -1,  1,  2,  2,  3,  3,  4,  4,  1, -1,  2,  3, -1, -1, -1, -1, -1, -1, -1, 2,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1

+ Code Snippet

Set window off : Sync on : Sync rate 0 : Sync : Set display mode 800, 600, 32 : Randomize Timer() : Global MBCount = 6 : Dim Grid(80, 60) As float : Dim TLT(15, 8) As integer : Dim Metaballs(MBCount - 1, 2) As float : Dim Path(MBCount - 1, 9, 3) As float : pf As Float : pi As integer : For i = 0 To MBCount - 1 : Metaballs(i, 0) = Rnd(800)/10.0 : Metaballs(i, 1) = Rnd(600)/10.0 : Metaballs(i, 2) = 1.5 : Next : For i = 1 To 5 : null = Make vector2(i) : Next
For i = 0 To MBCount - 1 : For j = 0 To 9 : v# = Rnd(3600)*0.1 : Path(i, j, 0) = Rnd(800)/10.0 : Path(i, j, 1) = Rnd(600)/10.0 : Path(i, j, 2) = Cos(v#) : Path(i, j, 3) = Sin(v#) : Next : Path(i, 9, 0) = Path(i, 0, 0) : Path(i, 9, 1) = Path(i, 0, 1) : Path(i, 9, 2) = Path(i, 0, 2) : Path(i, 9, 3) = Path(i, 0, 3) : Next : For i = 0 To 15 : For j = 0 To 8 : Read TLT(i, j) : Next : Next
Ink 0, 0 : Do : Cls 0xA0A0A0 : For i = 0 To MBCount - 1 : Inc pf, 0.002 : If pf > 1 : Inc pi : pf = 0 : Endif : If pi = 9 : pi = 0 : Endif : Set vector2 1, Path(i, pi, 0), Path(i, pi, 1) : Set vector2 2, Path(i, pi, 2), Path(i, pi, 3) : Set vector2 3, Path(i, pi + 1, 0), Path(i, pi + 1, 1) : Set vector2 4, Path(i, pi + 1, 2), Path(i, pi + 1, 3) : Hermite vector2 5, 1, 2, 3, 4, pf : Metaballs(i, 0) = X vector2(5) : Metaballs(i, 1) = Y vector2(5) : Next
For y = 0 To 60 : For x = 0 To 80 : Grid(x, y) = SumMB(x, y) : Next : Next : Lock pixels : For y = 1 To 58 : For x = 1 To 78 : Dot x*10, y*10 : Index = 0 : If Grid(x + 0, y + 0) > 1 : Inc Index, 1 : Endif : If Grid(x + 1, y + 0) > 1 : Inc Index, 2 : Endif :  If Grid(x + 1, y + 1) > 1 : Inc Index, 4 : Endif : If Grid(x + 0, y + 1) > 1 : Inc Index, 8 : Endif : i = 0 : b = 0 : While TLT(Index, i) > -1 : Select TLT(Index, i) 
Case 1 : xn# = x + (1 - Grid(x + 0, y + 0))/(Grid(x + 1, y + 0) - Grid(x + 0, y + 0)) : yn# = y : Endcase : Case 2 : xn# = x + 1 : yn# = y + (1 - Grid(x + 1, y + 0))/(Grid(x + 1, y + 1) - Grid(x + 1, y + 0)) : Endcase : Case 3 : xn# = x + (1 - Grid(x + 0, y + 1))/(Grid(x + 1, y + 1) - Grid(x + 0, y + 1)) : yn# = y + 1 : C = 0xFF00 : Endcase : Case 4 : xn# = x : yn# = y + (1 - Grid(x + 0, y + 0))/(Grid(x + 0, y + 1) - Grid(x + 0, y + 0)) : Endcase : Endselect
If b = 0 : xt# = xn# : yt# = yn# : b = 1 : Else : Line xt#*10, yt#*10, xn#*10, yn#*10 : Line xt#*10 + 1, yt#*10, xn#*10 + 1, yn#*10 : Line xt#*10, yt#*10 + 1, xn#*10, yn#*10 + 1 : b = 0 : Endif : Inc i : Endwhile : Next : Next : Unlock pixels : Sync : Loop
Function SumMB(x As float, y As float)
  For i = 0 To MBCount - 1 : Inc v#, Sqrt(Metaballs(i, 2)^2/((x - Metaballs(i, 0))^2 + (y - Metaballs(i, 1))^2)) : Next
Endfunction v#
Data -1, -1, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  2,  4, -1, -1, -1, -1, -1, -1, -1, 2,  3, -1, -1, -1, -1, -1, -1, -1, 1,  2,  2,  3,  3,  4,  4,  1, -1, 3,  1, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1,  3,  1, -1, -1, -1, -1, -1, -1, -1,  1,  2,  2,  3,  3,  4,  4,  1, -1,  2,  3, -1, -1, -1, -1, -1, -1, -1, 2,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1

I may improve this the next time. I have the space.

Oh, and here the uncompressed Code:

Set window off
Sync on : Sync rate 0 : Sync
Set display mode 800, 600, 32
Randomize Timer()
Type TMB
  x As float
  y As float
  r As float
Endtype
Type TP
  px As float
  py As float
  tx As float
  ty As float
Endtype

MBCount = 6

Dim Grid(80, 60)  As float
Dim TLT(15, 8)    As integer
Dim Metaballs(MBCount - 1) As TMB
Dim Path(MBCount - 1, 9) As TP

pf As Float
pi As integer

For i = 0 To Array count(Metaballs(0))
  Metaballs(i).x = Rnd(800)/10.0
  Metaballs(i).y = Rnd(600)/10.0
  Metaballs(i).r = 1.5
Next

For i = 1 To 5
  null = Make vector2(i)
Next

For i = 0 To Array count(Metaballs(0))
  For j = 0 To 9
    v# = Rnd(3600)*0.1
    Path(i, j).px = Rnd(800)/10.0
    Path(i, j).py = Rnd(600)/10.0
    Path(i, j).tx = Cos(v#)
    Path(i, j).ty = Sin(v#)
  Next
  Path(i, 9) = Path(i, 0)
Next

For i = 0 To 15 : For j = 0 To 8 : Read TLT(i, j) : Next : Next
Ink 0, 0
Do
  Cls 0xA0A0A0
  For i = 0 To Array count(Metaballs(0))
    Inc pf, 0.002
    If pf > 1 : Inc pi : pf = 0 : Endif
    If pi = 9 Then pi = 0
    Set vector2 1, Path(i, pi).px, Path(i, pi).py
    Set vector2 2, Path(i, pi).tx, Path(i, pi).ty
    Set vector2 3, Path(i, pi + 1).px, Path(i, pi + 1).py
    Set vector2 4, Path(i, pi + 1).tx, Path(i, pi + 1).ty
    Hermite vector2 5, 1, 2, 3, 4, pf
    Metaballs(i).x = X vector2(5)
    Metaballs(i).y = Y vector2(5)
  Next
  For y = 0 To 60
    For x = 0 To 80
      Grid(x, y) = SumMB(x, y)
    Next
  Next
  Lock pixels
  For y = 1 To 58
    For x = 1 To 78
      Dot x*10, y*10
      Index = 0
      If Grid(x + 0, y + 0) > 1 Then Inc Index, 1
      If Grid(x + 1, y + 0) > 1 Then Inc Index, 2
      If Grid(x + 1, y + 1) > 1 Then Inc Index, 4
      If Grid(x + 0, y + 1) > 1 Then Inc Index, 8
      i = 0
      b = 0
      While TLT(Index, i) > -1
        Select TLT(Index, i)
          Case 1
            xn# = x + (1 - Grid(x + 0, y + 0))/(Grid(x + 1, y + 0) - Grid(x + 0, y + 0))
            yn# = y
          Endcase
          Case 2
            xn# = x + 1
            yn# = y + (1 - Grid(x + 1, y + 0))/(Grid(x + 1, y + 1) - Grid(x + 1, y + 0))
          Endcase
          Case 3
            xn# = x + (1 - Grid(x + 0, y + 1))/(Grid(x + 1, y + 1) - Grid(x + 0, y + 1))
            yn# = y + 1
            C = 0xFF00
          Endcase
          Case 4
            xn# = x
            yn# = y + (1 - Grid(x + 0, y + 0))/(Grid(x + 0, y + 1) - Grid(x + 0, y + 0))
          Endcase
        Endselect
        If b = 0
          xt# = xn#
          yt# = yn#
          b = 1
        Else
          Line xt#*10, yt#*10, xn#*10, yn#*10
          Line xt#*10 + 1, yt#*10, xn#*10 + 1, yn#*10
          Line xt#*10, yt#*10 + 1, xn#*10, yn#*10 + 1
          b = 0
        Endif
        Inc i
      Endwhile
    Next
  Next
  Unlock pixels
  Sync
Loop

Function SumMB(x As float, y As float)
  For i = 0 To Array count(Metaballs(0))
    Inc v#, Sqrt(Metaballs(i).r^2/((x - Metaballs(i).x)^2 + (y - Metaballs(i).y)^2))
  Next
Endfunction v#

Data -1, -1, -1, -1, -1, -1, -1, -1, -1   `Case 0
Data  1,  4, -1, -1, -1, -1, -1, -1, -1   `Case 1
Data  1,  2, -1, -1, -1, -1, -1, -1, -1   `Case 2
Data  2,  4, -1, -1, -1, -1, -1, -1, -1   `Case 3
Data  2,  3, -1, -1, -1, -1, -1, -1, -1   `Case 4
Data  1,  2,  2,  3,  3,  4,  4,  1, -1   `Case 5
Data  3,  1, -1, -1, -1, -1, -1, -1, -1   `Case 6
Data  3,  4, -1, -1, -1, -1, -1, -1, -1   `Case 7
Data  3,  4, -1, -1, -1, -1, -1, -1, -1   `Case 8
Data  3,  1, -1, -1, -1, -1, -1, -1, -1   `Case 9
Data  1,  2,  2,  3,  3,  4,  4,  1, -1   `Case 10
Data  2,  3, -1, -1, -1, -1, -1, -1, -1   `Case 11
Data  2,  4, -1, -1, -1, -1, -1, -1, -1   `Case 12
Data  1,  2, -1, -1, -1, -1, -1, -1, -1   `Case 13
Data  1,  4, -1, -1, -1, -1, -1, -1, -1   `Case 14
Data -1, -1, -1, -1, -1, -1, -1, -1, -1   `Case 15

+ Code Snippet

Set window off
Sync on : Sync rate 0 : Sync
Set display mode 800, 600, 32
Randomize Timer()
Type TMB
  x As float
  y As float
  r As float
Endtype
Type TP
  px As float
  py As float
  tx As float
  ty As float
Endtype

MBCount = 6

Dim Grid(80, 60)  As float
Dim TLT(15, 8)    As integer
Dim Metaballs(MBCount - 1) As TMB
Dim Path(MBCount - 1, 9) As TP

pf As Float
pi As integer

For i = 0 To Array count(Metaballs(0))
  Metaballs(i).x = Rnd(800)/10.0
  Metaballs(i).y = Rnd(600)/10.0
  Metaballs(i).r = 1.5
Next

For i = 1 To 5
  null = Make vector2(i)
Next

For i = 0 To Array count(Metaballs(0))
  For j = 0 To 9
    v# = Rnd(3600)*0.1
    Path(i, j).px = Rnd(800)/10.0
    Path(i, j).py = Rnd(600)/10.0
    Path(i, j).tx = Cos(v#)
    Path(i, j).ty = Sin(v#)
  Next
  Path(i, 9) = Path(i, 0)
Next

For i = 0 To 15 : For j = 0 To 8 : Read TLT(i, j) : Next : Next
Ink 0, 0
Do
  Cls 0xA0A0A0
  For i = 0 To Array count(Metaballs(0))
    Inc pf, 0.002
    If pf > 1 : Inc pi : pf = 0 : Endif
    If pi = 9 Then pi = 0
    Set vector2 1, Path(i, pi).px, Path(i, pi).py
    Set vector2 2, Path(i, pi).tx, Path(i, pi).ty
    Set vector2 3, Path(i, pi + 1).px, Path(i, pi + 1).py
    Set vector2 4, Path(i, pi + 1).tx, Path(i, pi + 1).ty
    Hermite vector2 5, 1, 2, 3, 4, pf
    Metaballs(i).x = X vector2(5)
    Metaballs(i).y = Y vector2(5)
  Next
  For y = 0 To 60
    For x = 0 To 80
      Grid(x, y) = SumMB(x, y)
    Next
  Next
  Lock pixels
  For y = 1 To 58
    For x = 1 To 78
      Dot x*10, y*10
      Index = 0
      If Grid(x + 0, y + 0) > 1 Then Inc Index, 1
      If Grid(x + 1, y + 0) > 1 Then Inc Index, 2
      If Grid(x + 1, y + 1) > 1 Then Inc Index, 4
      If Grid(x + 0, y + 1) > 1 Then Inc Index, 8
      i = 0
      b = 0
      While TLT(Index, i) > -1
        Select TLT(Index, i)
          Case 1
            xn# = x + (1 - Grid(x + 0, y + 0))/(Grid(x + 1, y + 0) - Grid(x + 0, y + 0))
            yn# = y
          Endcase
          Case 2
            xn# = x + 1
            yn# = y + (1 - Grid(x + 1, y + 0))/(Grid(x + 1, y + 1) - Grid(x + 1, y + 0))
          Endcase
          Case 3
            xn# = x + (1 - Grid(x + 0, y + 1))/(Grid(x + 1, y + 1) - Grid(x + 0, y + 1))
            yn# = y + 1
            C = 0xFF00
          Endcase
          Case 4
            xn# = x
            yn# = y + (1 - Grid(x + 0, y + 0))/(Grid(x + 0, y + 1) - Grid(x + 0, y + 0))
          Endcase
        Endselect
        If b = 0
          xt# = xn#
          yt# = yn#
          b = 1
        Else
          Line xt#*10, yt#*10, xn#*10, yn#*10
          Line xt#*10 + 1, yt#*10, xn#*10 + 1, yn#*10
          Line xt#*10, yt#*10 + 1, xn#*10, yn#*10 + 1
          b = 0
        Endif
        Inc i
      Endwhile
    Next
  Next
  Unlock pixels
  Sync
Loop

Function SumMB(x As float, y As float)
  For i = 0 To Array count(Metaballs(0))
    Inc v#, Sqrt(Metaballs(i).r^2/((x - Metaballs(i).x)^2 + (y - Metaballs(i).y)^2))
  Next
Endfunction v#


Data -1, -1, -1, -1, -1, -1, -1, -1, -1   `Case 0
Data  1,  4, -1, -1, -1, -1, -1, -1, -1   `Case 1
Data  1,  2, -1, -1, -1, -1, -1, -1, -1   `Case 2
Data  2,  4, -1, -1, -1, -1, -1, -1, -1   `Case 3
Data  2,  3, -1, -1, -1, -1, -1, -1, -1   `Case 4
Data  1,  2,  2,  3,  3,  4,  4,  1, -1   `Case 5
Data  3,  1, -1, -1, -1, -1, -1, -1, -1   `Case 6
Data  3,  4, -1, -1, -1, -1, -1, -1, -1   `Case 7
Data  3,  4, -1, -1, -1, -1, -1, -1, -1   `Case 8
Data  3,  1, -1, -1, -1, -1, -1, -1, -1   `Case 9
Data  1,  2,  2,  3,  3,  4,  4,  1, -1   `Case 10
Data  2,  3, -1, -1, -1, -1, -1, -1, -1   `Case 11
Data  2,  4, -1, -1, -1, -1, -1, -1, -1   `Case 12
Data  1,  2, -1, -1, -1, -1, -1, -1, -1   `Case 13
Data  1,  4, -1, -1, -1, -1, -1, -1, -1   `Case 14
Data -1, -1, -1, -1, -1, -1, -1, -1, -1   `Case 15

It's not identical, because I was using types before compressing :-(

Back to top

Profile PM Email Website

MikeS

Retired Moderator

21

Years of Service

User Offline

Joined: 2nd Dec 2002

Location: United States

Posted: 7th May 2006 01:48

Link

Awesome, very very cool!!

A book? I hate book. Book is stupid.
(Formerly Yellow)

Back to top

Profile PM Email

Freddy 007

19

Years of Service

User Offline

Joined: 30th Nov 2004

Location: Denmark

Posted: 7th May 2006 03:21

Link

Yes, very nice indeed!

Galaxy Storm

Back to top

Profile PM Email

musty

18

Years of Service

User Offline

Joined: 6th Apr 2006

Location: Istanbul

Posted: 7th May 2006 09:25

Link

Azrael that is really cool. Can you provide a little explanation about how it works?

"Ignorance is bliss." Cypher from the movie The Matrix

Back to top

Profile PM Email

Azrael

19

Years of Service

User Offline

Joined: 2nd Mar 2005

Location: Germany

Posted: 7th May 2006 12:39

Link

OK, here's an update:

Set window off : Set display mode 800, 600, 32 : Sync on : Sync rate 0 : Sync : Randomize Timer() : Global MBCount = 7 : Dim Grid(80, 60) As float : Dim TLT(15, 8) As integer : Dim Metaballs(MBCount - 1, 5) As float : pf As float : pi As integer : xn As float : yn As float : xt As float : yt As float : For i = 0 To MBCount - 1 : Metaballs(i, 0) = Rnd(800)*0.1 : Metaballs(i, 1) = Rnd(600)*0.1 : Metaballs(i, 2) = 1.5 : Next
For i = 0 To 15 : For j = 0 To 8 : Read TLT(i, j) : Next : Next : Ink 0, 0 : Do : Cls 0xFFFFFF : Set cursor 0, 0 : Print Screen fps() : For i = 0 To MBCount - 1 : For y = Int(Metaballs(i, 1) - Metaballs(i, 2)*MBCount) To Int(Metaballs(i, 1) + Metaballs(i, 2)*MBCount) : For x = Int(Metaballs(i, 0) - Metaballs(i, 2)*MBCount) To Int(Metaballs(i, 0) + Metaballs(i, 2)*MBCount) :  : If x > 0 And x < 80 And y > 0 And y < 60 : Grid(x, y) = SumMB(x, y) : Endif : Next : Next : Next
For i = 0 To MBCount - 1 : For j = 0 To MBCount - 1 : d# = Sqrt((Metaballs(i, 0) - Metaballs(j, 0))^2 + (Metaballs(i, 1) - Metaballs(j, 1))^2) : If d# > 0.01 : Inc Metaballs(i, 3), (Metaballs(i, 0) - Metaballs(j, 0))/d#*.05 : Inc Metaballs(i, 4), (Metaballs(i, 1) - Metaballs(j, 1))/d#*.05 : Inc Metaballs(i, 5), 0.1/d# : Dec Metaballs(i, 0), Metaballs(i, 3)/Screen fps()/2 : Dec Metaballs(i, 1), Metaballs(i, 4)/Screen fps()/2
If Metaballs(i, 0) < 0 : Metaballs(i, 3) = -Metaballs(i, 3) : Endif : If Metaballs(i, 0) >80 : Metaballs(i, 3) = -Metaballs(i, 3) : Endif : If Metaballs(i, 1) < 0 : Metaballs(i, 4) = -Metaballs(i, 4) : Endif : If Metaballs(i, 1) >60 : Metaballs(i, 4) = -Metaballs(i, 4) : Endif : Endif : Next : Next : For y = 1 To 58 : For x = 1 To 78 : Index = 0 : If Grid(x + 0, y + 0) > 1 : Inc Index, 1 : Endif
If Grid(x + 1, y + 0) > 1 : Inc Index, 2 : Endif : If Grid(x + 1, y + 1) > 1 : Inc Index, 4 : Endif : If Grid(x + 0, y + 1) > 1 : Inc Index, 8 : Endif : i = 0 : b = 0 : While TLT(Index, i) > -1 : Select TLT(Index, i) : Case 1 : xn = x*1.0 + (1 - Grid(x + 0, y + 0))/(Grid(x + 1, y + 0) - Grid(x + 0, y + 0))*1.0 : yn = y*1.0 : Endcase : Case 2 : xn = x*1.0 + 1 : yn = y*1.0 + (1 - Grid(x + 1, y + 0))/(Grid(x + 1, y + 1) - Grid(x + 1, y + 0))*1.0 : Endcase
Case 3 : xn = x*1.0 + (1 - Grid(x + 0, y + 1))/(Grid(x + 1, y + 1) - Grid(x + 0, y + 1))*1.0 : yn = y*1.0 + 1 : Endcase : Case 4 : xn = x*1.0 : yn = y*1.0 + (1 - Grid(x + 0, y + 0))/(Grid(x + 0, y + 1) - Grid(x + 0, y + 0))*1.0 : Endcase : Endselect : If b = 0 : xt = xn : yt = yn : b = 1 : Else : Line xt*10, yt*10, xn*10, yn*10 : Line xt*10 + 1, yt*10, xn*10 + 1, yn*10 : Line xt*10, yt*10 + 1, xn*10, yn*10 + 1 : b = 0 : Endif : Inc i : Endwhile : Next : Next : Sync : Loop
Function SumMB(x As float, y As float)
  V As float = 0 : For i = 0 To MBCount - 1 : Inc V, Sqrt(Metaballs(i, 2)^2/((x - Metaballs(i, 0))^2 + (y - Metaballs(i, 1))^2 + 0.1)) : Next
Endfunction V
Data -1, -1, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  2,  4, -1, -1, -1, -1, -1, -1, -1, 2,  3, -1, -1, -1, -1, -1, -1, -1, 1,  2,  2,  3,  3,  4,  4,  1, -1, 3,  1, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1,  3,  1, -1, -1, -1, -1, -1, -1, -1,  1,  2,  2,  3,  3,  4,  4,  1, -1,  2,  3, -1, -1, -1, -1, -1, -1, -1, 2,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1

+ Code Snippet

Set window off : Set display mode 800, 600, 32 : Sync on : Sync rate 0 : Sync : Randomize Timer() : Global MBCount = 7 : Dim Grid(80, 60) As float : Dim TLT(15, 8) As integer : Dim Metaballs(MBCount - 1, 5) As float : pf As float : pi As integer : xn As float : yn As float : xt As float : yt As float : For i = 0 To MBCount - 1 : Metaballs(i, 0) = Rnd(800)*0.1 : Metaballs(i, 1) = Rnd(600)*0.1 : Metaballs(i, 2) = 1.5 : Next
For i = 0 To 15 : For j = 0 To 8 : Read TLT(i, j) : Next : Next : Ink 0, 0 : Do : Cls 0xFFFFFF : Set cursor 0, 0 : Print Screen fps() : For i = 0 To MBCount - 1 : For y = Int(Metaballs(i, 1) - Metaballs(i, 2)*MBCount) To Int(Metaballs(i, 1) + Metaballs(i, 2)*MBCount) : For x = Int(Metaballs(i, 0) - Metaballs(i, 2)*MBCount) To Int(Metaballs(i, 0) + Metaballs(i, 2)*MBCount) :  : If x > 0 And x < 80 And y > 0 And y < 60 : Grid(x, y) = SumMB(x, y) : Endif : Next : Next : Next
For i = 0 To MBCount - 1 : For j = 0 To MBCount - 1 : d# = Sqrt((Metaballs(i, 0) - Metaballs(j, 0))^2 + (Metaballs(i, 1) - Metaballs(j, 1))^2) : If d# > 0.01 : Inc Metaballs(i, 3), (Metaballs(i, 0) - Metaballs(j, 0))/d#*.05 : Inc Metaballs(i, 4), (Metaballs(i, 1) - Metaballs(j, 1))/d#*.05 : Inc Metaballs(i, 5), 0.1/d# : Dec Metaballs(i, 0), Metaballs(i, 3)/Screen fps()/2 : Dec Metaballs(i, 1), Metaballs(i, 4)/Screen fps()/2
If Metaballs(i, 0) < 0 : Metaballs(i, 3) = -Metaballs(i, 3) : Endif : If Metaballs(i, 0) >80 : Metaballs(i, 3) = -Metaballs(i, 3) : Endif : If Metaballs(i, 1) < 0 : Metaballs(i, 4) = -Metaballs(i, 4) : Endif : If Metaballs(i, 1) >60 : Metaballs(i, 4) = -Metaballs(i, 4) : Endif : Endif : Next : Next : For y = 1 To 58 : For x = 1 To 78 : Index = 0 : If Grid(x + 0, y + 0) > 1 : Inc Index, 1 : Endif
If Grid(x + 1, y + 0) > 1 : Inc Index, 2 : Endif : If Grid(x + 1, y + 1) > 1 : Inc Index, 4 : Endif : If Grid(x + 0, y + 1) > 1 : Inc Index, 8 : Endif : i = 0 : b = 0 : While TLT(Index, i) > -1 : Select TLT(Index, i) : Case 1 : xn = x*1.0 + (1 - Grid(x + 0, y + 0))/(Grid(x + 1, y + 0) - Grid(x + 0, y + 0))*1.0 : yn = y*1.0 : Endcase : Case 2 : xn = x*1.0 + 1 : yn = y*1.0 + (1 - Grid(x + 1, y + 0))/(Grid(x + 1, y + 1) - Grid(x + 1, y + 0))*1.0 : Endcase
Case 3 : xn = x*1.0 + (1 - Grid(x + 0, y + 1))/(Grid(x + 1, y + 1) - Grid(x + 0, y + 1))*1.0 : yn = y*1.0 + 1 : Endcase : Case 4 : xn = x*1.0 : yn = y*1.0 + (1 - Grid(x + 0, y + 0))/(Grid(x + 0, y + 1) - Grid(x + 0, y + 0))*1.0 : Endcase : Endselect : If b = 0 : xt = xn : yt = yn : b = 1 : Else : Line xt*10, yt*10, xn*10, yn*10 : Line xt*10 + 1, yt*10, xn*10 + 1, yn*10 : Line xt*10, yt*10 + 1, xn*10, yn*10 + 1 : b = 0 : Endif : Inc i : Endwhile : Next : Next : Sync : Loop
Function SumMB(x As float, y As float)
  V As float = 0 : For i = 0 To MBCount - 1 : Inc V, Sqrt(Metaballs(i, 2)^2/((x - Metaballs(i, 0))^2 + (y - Metaballs(i, 1))^2 + 0.1)) : Next
Endfunction V
Data -1, -1, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  2,  4, -1, -1, -1, -1, -1, -1, -1, 2,  3, -1, -1, -1, -1, -1, -1, -1, 1,  2,  2,  3,  3,  4,  4,  1, -1, 3,  1, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1, 3,  4, -1, -1, -1, -1, -1, -1, -1,  3,  1, -1, -1, -1, -1, -1, -1, -1,  1,  2,  2,  3,  3,  4,  4,  1, -1,  2,  3, -1, -1, -1, -1, -1, -1, -1, 2,  4, -1, -1, -1, -1, -1, -1, -1,  1,  2, -1, -1, -1, -1, -1, -1, -1,  1,  4, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1

This looks more like a liquid. The metaballs are attracting each other.

>>Can you provide a little explanation about how it works?

I think this website does it much better than me:

http://www.exaflop.org/docs/marchcubes/

or this site:

http://www.essi.fr/~lingrand/MarchingCubes/algo.html

Back to top

Profile PM Email Website

Freddy 007

19

Years of Service

User Offline

Joined: 30th Nov 2004

Location: Denmark

Posted: 7th May 2006 17:26

Link

That's even prettier.

Galaxy Storm

Back to top

Profile PM Email

musty

18

Years of Service

User Offline

Joined: 6th Apr 2006

Location: Istanbul

Posted: 7th May 2006 22:31 Edited at: 7th May 2006 22:31

Link

Thanx for the great resources.

As soon as my mother has her operation and comes back home I'll try to code my own version. At least I'll try.

"Ignorance is bliss." Cypher from the movie The Matrix

Back to top

Profile PM Email

Hawkeye

20

Years of Service

User Offline

Joined: 19th Sep 2003

Location: SC, USA

Posted: 11th May 2006 02:19

Link

The first version runs at maybe 1.5 fps, the second rips along at 3... but a very cool effect indeed

I am but mad north north-west; when the wind is southerly I know a hawk from a handsaw - Hamlet, Hamlet

Back to top

Profile PM Email Website

Pricey

21

Years of Service

User Offline

Joined: 22nd Feb 2003

Location:

Posted: 11th May 2006 23:27

Link

this just stops compiling about half way through
might be using the old dbpro... dunno

:: 3Ghz Pentium 4 / Hyper Threading, 1024mb RAM, 250GB HDD, 256mb Radeon 9600XT Graphics ::

Back to top

Profile PM Email

Azrael

19

Years of Service

User Offline

Joined: 2nd Mar 2005

Location: Germany

Posted: 12th May 2006 15:44

Link

I have compiled and uploaded the latest Version:
Link: http://home.arcor.de/azrael_lite/RARS/MB.rar

I'm working on an even faster Algorithm which allows to handle more than 10 Metaballs. May I can add some colors to have some eye candy - will see.

Back to top

Profile PM Email Website

Sorry your browser is not supported!

The 20 Line Challenge / Metaball 2D Demo - 10 lines