Marching square (metaballs 2D)

Sujets variés concernant le développement en PureBasic
crisot
Messages : 98
Inscription : lun. 30/août/2004 21:03

Marching square (metaballs 2D)

Message par crisot »

Voici un petit exemple de marching square, ici montré avec quelques metaballs.

J'ai commenté le source autant que possible, mais pour ceux que cela intéresse, un petit tour sur google ne sera pas du luxe pour une compréhension plus avancée.

Code : Tout sélectionner

EnableExplicit

Global.l i, j, k, l
Define.f val=48       ; isovaleur, c'est le seuil auquel on dessine une ligne
Define.l res=32       ; resolution: Le nombre de fois où on divise l'écran... 

DataSection
  
  ; voici les 16 cas du marching square
  ; la première valeur correspond au nombre de lignes à tracer x2
  ; les paires de valeurs suivantes correspondent aux arrêtes à joindre par les lignes
  datas:
  Data.l 0            ; 0000 format DCBA (voir plus bas)
  Data.l 2, 0,3       ; 0001
  Data.l 2, 0,1       ; 0010
  Data.l 2, 1,3       ; 0011
  Data.l 2, 1,2       ; 0100
  Data.l 4, 0,3, 1,2  ; 0101 par exemple ici nous traçons 2 lignes, qui joignent les arrêtes 0-3 et 1-2
  Data.l 2, 0,2       ; 0110
  Data.l 2, 2,3       ; 0111
  Data.l 2, 2,3       ; 1000
  Data.l 2, 0,2       ; 1001
  Data.l 4, 2,3, 0,1  ; 1010
  Data.l 2, 1,2       ; 1011
  Data.l 2, 1,3       ; 1100
  Data.l 2, 0,1       ; 1101
  Data.l 2, 0,3       ; 1110
  Data.l 0            ; 1111
  
  ; ces 4 positions correspondent au centre des 4 arrêtes AB (0) BC (1) CD (2) DA (3)
  Data.f 0.5, 1       ;     D--2--C       Les 4 coins sont notés A B C D
  Data.f 1, 0.5       ; 3-> |     |       Les 4 arrêtes numérotées de 0 à 3
  Data.f 0.5, 0       ;     |     | <-1
  Data.f 0, 0.5       ;     A--0--B
  
EndDataSection

Procedure exit(text$)
  If text$ : Debug (text$) : EndIf
  End  
EndProcedure



If Not(InitMouse() And InitKeyboard() And InitSprite())
  exit("Can't init something")
EndIf

Define.l win=OpenWindow(#PB_Any, 0, 0, 1024, 1024, "", #PB_Window_ScreenCentered)
If Not(win) : exit("Can't open window") : EndIf
Define.l width=WindowWidth(win), height=WindowHeight(win)
Define.f stepx=width/res, stepy=height/res ; step x et step y = écran / résolution
If Not(OpenWindowedScreen(WindowID(win),0, 0, width, height))
exit("Can't open screen") : EndIf

Restore datas

Dim cnt(15)
Dim lines(15, 3)

For j=0 To 15
  Read.l cnt(j)
  For i=0 To cnt(j)-1
    Read.l lines(j, i)
  Next
Next

Dim posx.f(3) : Dim posy.f(3)
For i=0 To 3
  Read.f posx(i)
  Read.f posy(i)
Next

Dim lvl.f(res, res)

Global event
Define run=#True

Define.f t=0

While run
  
  t+0.01
  
  ; on nettoie la grille
  
  For j=0 To res
    For i=0 To res      
      lvl(i, j)=0
    Next
  Next
  
  ; on place quelques metaball sur la grille
  
  For k=0 To 5
    Define.f ballx, bally, balld
    ballx=(0.5+Cos(t+k*2.5)*0.5)*res  ; position x de la metaball
    bally=(0.5+Sin(t*1.5+k)*0.5)*res  ; position y de la metaball
    balld=res*res                     ; diametre de la metaball
    
    For j=0 To res
      For i=0 To res
        lvl(i, j)+balld/(Pow(ballx-i,2)+Pow(bally-j, 2))
      Next
    Next
  Next
  
  ClearScreen(0)
  StartDrawing(ScreenOutput())
  
  ; on dessine la grille dépendante de la résolution
  
  For i=0 To res
    LineXY(i*stepx, 0 ,i*stepx, height, $A00000)
    LineXY(0, i*stepy, width, i*stepy, $A00000)   
  Next
  
  ; on trace les metaballs
  
  For j=0 To res-1
    For i=0 To res-1
      
      ; détermination du cas dans lequel on se trouve
      
      Define cas.l = 0
      If lvl(i+0, j+1) > val : cas+1 : EndIf ; coin A
      If lvl(i+1, j+1) > val : cas+2 : EndIf ; coin B
      If lvl(i+1, j+0) > val : cas+4 : EndIf ; coin C
      If lvl(i+0, j+0) > val : cas+8 : EndIf ; coin D
      
      ; interpolation des arrêtes
      ; si vous êtes curieux vous pouvez commenter toute cette boucle "for k" jusqu'au prochain commentaire
      ; il est alors conseillé de monter fortement en résolution
      
      For k=0 To cnt(cas)-1
        Define.l side=lines(cas, k)
        Define.f a, b
        
        If side=0
          a=lvl(i+0, j+1)
          b=lvl(i+1, j+1)-a
          posx(0)=(val-a)/b
        EndIf
        
        If side=2
          a=lvl(i+0, j+0)
          b=lvl(i+1, j+0)-a
          posx(2)=(val-a)/b
        EndIf
        
        If side=1
          a=lvl(i+1, j+0)
          b=lvl(i+1, j+1)-a
          posy(1)=(val-a)/b
        EndIf
        
        If side=3
          a=lvl(i+0, j+0)
          b=lvl(i+0, j+1)-a
          posy(3)=(val-a)/b
        EndIf
      Next
      
      ; traçage des lignes
      
      For k=0 To cnt(cas)-1 Step 2
        Define.f xa, ya, xb, yb
        xa=posx(lines(cas, k))
        ya=posy(lines(cas, k))
        xb=posx(lines(cas, k+1))
        yb=posy(lines(cas, k+1))
        LineXY((i+xa)*stepx, (j+ya)*stepy, (i+xb)*stepx, (j+yb)*stepy, $ffffff)
      Next
      
    Next
  Next
  
  StopDrawing()
  
  FlipBuffers()  
  
  If ExamineKeyboard()
    If KeyboardReleased(#PB_Key_Escape)
      run=#False
    EndIf  
  EndIf
  
  Repeat
    Event = WindowEvent()
    Select Event
      Case #PB_Event_CloseWindow
        run=#False
    EndSelect
  Until Event=0
Wend

exit("")
Avatar de l’utilisateur
SPH
Messages : 4721
Inscription : mer. 09/nov./2005 9:53

Re: Marching square (metaballs 2D)

Message par SPH »

Pas mal 8)
http://HexaScrabble.com/
!i!i!i!i!i!i!i!i!i!
!i!i!i!i!i!i!
!i!i!i!
//// Informations ////
Intel Core i7 4770 64 bits - GTX 650 Ti
Version de PB : 6.00 - 64 bits
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Marching square (metaballs 2D)

Message par Micoute »

C'est beaucoup mieux que pas mal, merci pour le partage.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Guillot
Messages : 521
Inscription : jeu. 25/juin/2015 16:18

Re: Marching square (metaballs 2D)

Message par Guillot »

allez, maintenant en 3D !
Avatar de l’utilisateur
microdevweb
Messages : 1798
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

Re: Marching square (metaballs 2D)

Message par microdevweb »

Très réussit
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
crisot
Messages : 98
Inscription : lun. 30/août/2004 21:03

Re: Marching square (metaballs 2D)

Message par crisot »

Guillot a écrit :allez, maintenant en 3D !
:) Dés que j'ai une paire d'heures libres devant moi :)

Après y'aura la partie optimisation à bosser... :)
Répondre