PureBoard

Verfasst: **05.09.2005 17:26**

Hallo Leute,
ich habe den bekannten Metaball-Algorithmus auf einer ebene (2d) angewandt. Das Programm zeichnet Kreise, die ineinander übergehen.

Es werden 10 Metaballs auf zufälligen Positionen erzeugt, die mit den anderen interagieren.
Man kann einen MetaBall zur interaktion mit der Maus direkt bewegen.

Eventuell könnt iher es in einem Spiel oder einer Demo oder sonstwas mit einsetzen, aber nehmt mich bitte mit in den Credits mit auf.

Code: Alles auswählen

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Fehler!","Konnte DirectX 7.0 nicht initialisieren!")
  End
EndIf

If OpenScreen(800,600,32,"Metaball 2D") = 0
  MessageRequester("Fehler!","Konnte einen 800x600 32 bit farbtiefe bildschirm nicht öffnen!")
  End
EndIf

;ll für einen metaball
Structure Metaball
  x.l
  y.l
  starke.f
EndStructure
NewList metaball.Metaball()

;Structure für die einstellungen
Structure einstellungen
  pegel.f ;ist der niveau pegel zum anzeigen
  
  x.l ;ist der rederbereich...
  y.l
  
  mausstarke.f ;ist die stärke des Maus-Metaball's...
EndStructure
Global einstellungen.einstellungen

;Procedure für den 2d abstand:
Procedure asd(x1.l,y1.l,x2.l,y2.l)
  x = x1 - x2
  y = y1 - y2
  ProcedureReturn x*x+y*y
EndProcedure

einstellungen\x = 200
einstellungen\y = 200
einstellungen\pegel = 2
einstellungen\mausstarke = 100

;~ tzene kreieren:
For _=0 To 10
  AddElement(metaball())
  metaball()\x = Random(einstellungen\x)
  metaball()\y = Random(einstellungen\y)
  metaball()\starke = 100 + Random(100)
Next

Repeat
  If ExamineMouse() <> 0
    mausx.l = MouseX()
    mausy.l = MouseY()
  EndIf
  
  If StartDrawing(ScreenOutput()) <> 0
    For x = 1 To einstellungen\x
      For y = 1 To einstellungen\y
        pegel.f = 0
        ForEach metaball()
          pegel + 1/asd(x,y,metaball()\x,metaball()\y)*metaball()\starke
        Next
        pegel + 1/asd(x,y,mausx,mausy) *einstellungen\mausstarke
        
        If pegel > einstellungen\pegel
          Plot(x,y,RGB(255,0,0))
        EndIf
      Next
    Next
    Stopdrawing()
  EndIf

  FlipBuffers()
  ClearScreen(0,0,0)
  
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Escape)
    exit = 1
  EndIf
  
Until exit = 1

Verfasst: **05.09.2005 17:43**

Wie wärs mit Stopdrawing ?

Leider finden alle Bewegungen sehr, sehr langsam statt.

Verfasst: **05.09.2005 17:47**

Hinzugefügt

...
Naja, ich habe keine ahnung warum das auch so ohne funktioniert hat...egal

.
Edit: Die Verzögerung war nur zu testzwecken -> rausgenommen.

Verfasst: **05.09.2005 21:42**

Juhuuuuu

ein kleiner Bereich mit einigen roten Kreisen, die wie verrückt flackern und etwa die Hälfte vom Bildschirm ist von kleinen roten Flecken übersäht.

Verfasst: **06.09.2005 10:23**

Also bei mir funktioniert es.

Und ich habe diese Metabälle auch gleich mal ein bisschen in Schwung versetzt:

Code: Alles auswählen

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 
  MessageRequester("Fehler!","Konnte DirectX 7.0 nicht initialisieren!") 
  End 
EndIf 

If OpenScreen(800,600,32,"Metaball 2D") = 0 
  MessageRequester("Fehler!","Konnte einen 800x600 32 bit farbtiefe bildschirm nicht öffnen!") 
  End 
EndIf 

;ll für einen metaball 
Structure Metaball 
  x.f
  y.f 
  xr.f
  yr.f
  starke.f 
EndStructure 
NewList metaball.Metaball() 

;Structure für die einstellungen 
Structure einstellungen 
  pegel.f ;ist der niveau pegel zum anzeigen 
  
  x.l ;ist der rederbereich... 
  y.l 
  
  mausstarke.f ;ist die stärke des Maus-Metaball's... 
EndStructure 
Global einstellungen.einstellungen 

;Procedure für den 2d abstand: 
Procedure asd(x1.l,y1.l,x2.l,y2.l) 
  x = x1 - x2 
  y = y1 - y2 
  ProcedureReturn x*x+y*y 
EndProcedure 

einstellungen\x = 200 
einstellungen\y = 200 
einstellungen\pegel = 2
einstellungen\mausstarke = 100 

;~ tzene kreieren: 
For _=0 To 20 
  AddElement(metaball()) 
  metaball()\x = Random(einstellungen\x) 
  metaball()\y = Random(einstellungen\y) 
  metaball()\xr = Random(20) / 10 - 1
  metaball()\yr = Random(20) / 10 - 1
  metaball()\starke = 100 + Random(100) 
Next 

Repeat 
  If ExamineMouse() <> 0 
    mausx.l = MouseX() 
    mausy.l = MouseY() 
  EndIf 
  
  If StartDrawing(ScreenOutput()) <> 0 
    For x = 1 To einstellungen\x 
      For y = 1 To einstellungen\y 
        pegel.f = 0 
        ForEach metaball() 
          pegel + 1/asd(x,y,metaball()\x,metaball()\y)*metaball()\starke 
        Next 
        pegel + 1/asd(x,y,mausx,mausy) *einstellungen\mausstarke 
        
        If pegel > einstellungen\pegel 
          Plot(x,y,RGB(255,0,0)) 
        EndIf 
      Next 
    Next 
    StopDrawing() 
  EndIf 
  
  ForEach metaball()
    metaball()\x + metaball()\xr
    metaball()\y + metaball()\yr
    If metaball()\x < 0 Or metaball()\x > einstellungen\x : metaball()\xr = -metaball()\xr : EndIf
    If metaball()\y < 0 Or metaball()\y > einstellungen\y : metaball()\yr = -metaball()\yr : EndIf
  Next

  FlipBuffers() 
  ClearScreen(0,0,0) 
  
  ExamineKeyboard() 
  If KeyboardPushed(#PB_Key_Escape) 
    exit = 1 
  EndIf 
  
Until exit = 1

Verfasst: **14.04.2006 11:17**

Hey cool

...
... Bloß sehr langsam. Außerdem sind die Punkte bei mir nur in nem kleinen bereich oben rechts.

Verfasst: **14.04.2006 11:48**

was is eigentlich mit RoWü... lebt der noch...?

Verfasst: **14.04.2006 16:50**

Der war bischen zu überheblich, bekam von den anderen usern was auf
die Nase und seit dem hören ma nichts mehr von ihm... übliche

Verfasst: **18.04.2006 19:45**

Das erinnert mich an Liquid Wars, kennt ihr das.

Das ist ganz lustig. Gibts für Linux und Windows.

Da hat man sowas wie ne Flüssigkeit und muss den ,,Feind,, umsprudeln oder so ähnlich

Oder kennt jemand dieses QuecksilberSpiel für die PSP, das ist auch cool. Aber ist halt eher was für den 3D-Metaball.

Naja, wie auch immer. Der Gedanke zählt.

PureBoard

2D Metaball

2D Metaball