PureBasic

Bonjour,

voici un code qui reproduit l'effet "Metaballs" (désolé c'est pas tres commenté, voir même pas du tout

)

vous aurez besoin de l'image suivante dans le répertoire du programme :

If InitSprite () = 0 Or InitKeyboard()= 0
   MessageRequester ("Erreur", "Impossible d'initialiser directx",#PB_MessageRequester_Ok)
   End
EndIf

;---------- Plein écran  ----------
#WindowWidth    = 640
#WindowHeight   = 480
If OpenScreen(#WindowWidth, #WindowHeight, 32, "Starfield") = 0
   MessageRequester ("Erreur", "Impossible d'ouvrir l'écran",#PB_MessageRequester_Ok)
   End
EndIf
;----------------------------------

UsePNGImageDecoder()

EnableDebugger

nSprite = CatchSprite(#PB_Any, ?IMGMeta)
If nSprite = 0
  MessageRequester ("Erreur", "Erreur à l'ouverture de la metaball !", #PB_MessageRequester_Ok)
  End
EndIf

Structure maStruct
  PixelB.c
  PixelG.c
  PixelR.c
  PixelA.c
EndStructure


Global SpriteWidth  = SpriteWidth (nSprite)
Global SpriteHeight = SpriteHeight(nSprite)
Global Dim PixelMeta.c (SpriteWidth,SpriteHeight)
DisplaySprite (nSprite, 0, 0)

StartDrawing (ScreenOutput ())
For X = 0 To SpriteWidth
  For Y = 0 To SpriteHeight
    PixelMeta(X,Y) = Red (Point(X,Y))
  Next
Next

StopDrawing()

ClearScreen(0)
FlipBuffers()
ClearScreen (0)

Structure MetaBall
  X.w
  Y.w
  x2.f
  y2.f 
  Rayon.c
EndStructure

#NbMetaBalls = 10

Dim TabMeta.MetaBall (#NbMetaBalls)

For i = 1 To #NbMetaBalls
  TabMeta(i)\X = Random(#WindowWidth-SpriteWidth) ;#WindowWidth / 2
  TabMeta(i)\Y = Random (#WindowHeight-SpriteHeight) ;#WindowHeight / 2
  TabMeta(i)\x2 = Random (50) - 25
  TabMeta(i)\y2 = Random (50) - 25
  
Next

EnableDebugger
CallDebugger

Procedure DisplayMeta(*Meta.MetaBall)
   
  Buffer = DrawingBuffer() + (*Meta\X) << 2
  Pitch   = DrawingBufferPitch()
  
  Flag = 0
   
  For X = 0 To SpriteWidth
    ptr = Buffer + X<<2
    For Y = 0 To SpriteHeight
      *Pixel.maStruct = ptr + ((*Meta\Y) + Y) * Pitch
      coulR.c = *Pixel\PixelR
      coulMetaR.c = PixelMeta(X,Y) ;\PixelR

      If coulR.c > 0
        Flag = 1
      EndIf        
      
      r2.w = (coulR + coulMetaR)
      If r2 >= 128
        r2 = 255
      EndIf
      
      *Pixel\PixelR = r2
      *Pixel\PixelG = 0
      *Pixel\PixelB = 0 
      
    Next
  Next
  
  If Flag = 1
    *Meta\x2 = (*Meta\x2) / 10
    *Meta\y2 = (*Meta\y2) / 10
    Flag = 0
  EndIf
  
EndProcedure


Repeat

  ClearScreen (0)
  
  If StartDrawing (ScreenOutput ())
    
    For i = 1 To #NbMetaBalls
      TabMeta(i)\x2 = ((TabMeta(i)\x2) * 0.98) + Random (2) - 1
      TabMeta(i)\y2 = ((TabMeta(i)\y2) * 0.98) + Random (2) - 1
      
      If (TabMeta(i)\X + TabMeta(i)\x2) >= (#WindowWidth-SpriteWidth) Or (TabMeta(i)\X + TabMeta(i)\x2) <= 0
        TabMeta(i)\x2 = -TabMeta(i)\x2
      EndIf
      
      If (TabMeta(i)\Y + TabMeta(i)\y2) >= (#WindowHeight-SpriteHeight) Or (TabMeta(i)\Y + TabMeta(i)\y2) <= 0
        TabMeta(i)\y2 = -TabMeta(i)\y2
      EndIf
      
      TabMeta(i)\X = TabMeta(i)\X + TabMeta(i)\x2
      TabMeta(i)\Y = TabMeta(i)\Y + TabMeta(i)\y2    
      DisplayMeta(@TabMeta(i))
    Next
   
    StopDrawing ()
  EndIf
  
  FlipBuffers ()
  
  ExamineKeyboard ()
Until KeyboardPushed (#PB_Key_Escape) Or WindowEvent() = #PB_Event_CloseWindow



End

DataSection
IMGMeta: IncludeBinary "MetaBallSeb.png"

; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 66
; FirstLine = 39
; Folding = -
; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 93
; FirstLine = 81
; Folding = -

est-ce que quelqu'un aurais une idée d'optimisation de la fonction DisplayMeta pour que le calcul de la metaball se fasse le plus rapidement possible... svp ??

tiens deja comme ça , ça va pas forcement plus vite, mais ça ne plante plus !!

ta version si dessus plante avec le debugger actif !

Code : Tout sélectionner

If InitSprite () = 0 Or InitKeyboard()= 0
    MessageRequester ("Erreur", "Impossible d'initialiser directx",#PB_MessageRequester_Ok)
    End
EndIf

;---------- Plein écran  ----------
#WindowWidth    = 1024
#WindowHeight   = 768
If OpenScreen(#WindowWidth, #WindowHeight, 32, "Starfield") = 0
    MessageRequester ("Erreur", "Impossible d'ouvrir l'écran",#PB_MessageRequester_Ok)
    End
EndIf
;----------------------------------

UsePNGImageDecoder()



nSprite = CatchSprite(#PB_Any, ?IMGMeta)
If nSprite = 0
    MessageRequester ("Erreur", "Erreur à l'ouverture de la metaball !", #PB_MessageRequester_Ok)
    End
EndIf

Structure maStruct
    PixelB.c
    PixelG.c
    PixelR.c
    PixelA.c
EndStructure


Global SpriteWidth  = SpriteWidth (nSprite)
Global SpriteHeight = SpriteHeight(nSprite)
Global Dim PixelMeta.c (SpriteWidth,SpriteHeight)
DisplaySprite (nSprite, 0, 0)

StartDrawing (ScreenOutput ())
For x = 0 To SpriteWidth-1
    For Y = 0 To SpriteHeight-1
        PixelMeta(x,Y) = Red (Point(x,Y))
    Next
Next

StopDrawing()

ClearScreen(0)
FlipBuffers()
ClearScreen (0)

Structure MetaBall
    x.w
    Y.w
    x2.f
    y2.f
    Rayon.c
EndStructure

#NbMetaBalls = 8

Dim TabMeta.MetaBall (#NbMetaBalls)

For i = 1 To #NbMetaBalls
    TabMeta(i)\x = Random(#WindowWidth-SpriteWidth) ;#WindowWidth / 2
    TabMeta(i)\Y = Random (#WindowHeight-SpriteHeight) ;#WindowHeight / 2
    TabMeta(i)\x2 = Random (50) - 25
    TabMeta(i)\y2 = Random (50) - 25
    
Next i




Procedure DisplayMeta(*Meta.MetaBall)
    
    Buffer = DrawingBuffer() + (*Meta\x) << 2
    Pitch   = DrawingBufferPitch()
    
    flag = 0
    
    For x = 0 To SpriteWidth-1
        ptr = Buffer + x<<2
        For Y = 0 To SpriteHeight-1
            *Pixel.maStruct = ptr + ((*Meta\Y) + Y) * Pitch
            coulR.c = *Pixel\PixelR
            coulMetaR.c = PixelMeta(x,Y) ;\PixelR
            
            If coulR.c > 0
                flag = 1
            EndIf       
            
            r2.w = (coulR + coulMetaR)
            If r2 >= 128
                r2 = 255
            EndIf
            
            *Pixel\PixelR = r2
            *Pixel\PixelG = 0
            *Pixel\PixelB = 0
            
        Next Y
    Next x
    
    If flag = 1
        *Meta\x2 = (*Meta\x2) / 10
        *Meta\y2 = (*Meta\y2) / 10
        flag = 0
    EndIf
    
EndProcedure


Repeat
    ExamineKeyboard ()
    
    
    If StartDrawing (ScreenOutput ())
        
        For i = 1 To #NbMetaBalls
            TabMeta(i)\x2 = ((TabMeta(i)\x2) * 0.98) + Random (2) - 1
            TabMeta(i)\y2 = ((TabMeta(i)\y2) * 0.98) + Random (2) - 1
            
            If (TabMeta(i)\x + TabMeta(i)\x2) >= (#WindowWidth-SpriteWidth) Or (TabMeta(i)\x + TabMeta(i)\x2) <= 0
                TabMeta(i)\x2 = -TabMeta(i)\x2
            EndIf
            
            If (TabMeta(i)\Y + TabMeta(i)\y2) >= (#WindowHeight-SpriteHeight) Or (TabMeta(i)\Y + TabMeta(i)\y2) <= 0
                TabMeta(i)\y2 = -TabMeta(i)\y2
            EndIf
            
            TabMeta(i)\x = TabMeta(i)\x + TabMeta(i)\x2
            TabMeta(i)\Y = TabMeta(i)\Y + TabMeta(i)\y2   
            DisplayMeta(@TabMeta(i))
        Next i
        
        StopDrawing ()
    EndIf
    
    FlipBuffers ()
    ClearScreen (0)
    
Until KeyboardPushed (#PB_Key_Escape) ;Or WindowEvent() = #PB_Event_CloseWindow



End

DataSection
IMGMeta: IncludeBinary "MetaBallSeb.png"

; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 66
; FirstLine = 39
; Folding = -
; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 93
; FirstLine = 81
; Folding = -

Merci Dobro !!

mais je n'arrive pas à voir ce que tu a modifié

oops pardon... tu a retiré les enabledebugger et calldebugger c'est ca ?

bombseb a écrit :oops pardon... tu a retiré les enabledebugger et calldebugger c'est ca ?

pas seulement !

j'ai modifier les lignes de tes boucles en ajoutant "-1" :

Code : Tout sélectionner

For x = 0 To SpriteWidth-1
    For Y = 0 To SpriteHeight-1

ainsi que celle plus bas !!

Code : Tout sélectionner

For x = 0 To SpriteWidth-1
        ptr = Buffer + x<<2
        For Y = 0 To SpriteHeight-1
            *Pixel.maStruct = ptr + ((*Meta\Y) + Y) * Pitch
            coulR.c = *Pixel\PixelR

j'ai ajouter "-1" apres SpriteWidth et SpriteHeight
car sinon on se retrouvait avec une erreur memoire sur la ligne
" *Pixel.maStruct = ptr + ((*Meta\Y) + Y) * Pitch "

le "Y" allait trop loin

Sinon, c'est joli

j'ai modifier les lignes de tes boucles en ajoutant "-1" :

aaaahh oui c'est vrai merci....

Sinon, c'est joli

merci

mais je ne suis pas le premier à coder cet effet

ça rame à mort sur mon athlon xp3500+ 2goddr
mais en tout cas c'est super chouette !
L'effet des metaballs est trés realiste.

ca rame à mort chez toi ???!!!

moi ca marche super bien sur mon athlon 2000+ / 1go
et encore mieux sur mon 3400+ / 1go

je ne comprend pas

(avec 8 metaballs)

Hi hi

J'avais le code modifié par Dobro.. avec 50 MBalls

:):)
J'ai baissé le nombren c'est dejà bien mieux

Ar-S a écrit :Hi hi

J'avais le code modifié par Dobro.. avec 50 MBalls :):)
J'ai baissé le nombren c'est dejà bien mieux

oooups

corrigé

tu a un processeur deca-core Dobro ?

bombseb a écrit :tu a un processeur deca-core Dobro ?

non! non ! un P4 2.8ghz Multithread avec une carte graphique Winfast A7600GT tdh

tiens je me suis inscrit sur ton forum Dobro,

j'ai vu que tu y a mis quelques-unes de mes sources

ca fait plaisir de savoir que ca peut servir à d'autres personnes
tu peux aussi poster le code des metaballs si tu veux

bombseb a écrit :tiens je me suis inscrit sur ton forum Dobro,

ok je viens de t'activer

j'ai trop eu de probleme avec les robot et autres connards, depuis je valide a la main....

j'ai vu que tu y a mis quelques-unes de mes sources ca fait plaisir de savoir que ca peut servir à d'autres personnes
tu peux aussi poster le code des metaballs si tu veux

oui je le fait !

PureBasic

Metaballs 2D

Metaballs 2D