Page 1 sur 1

Grains de sable

Publié : mar. 20/mars/2018 14:28
par Kangax
Je me suis amusé à faire cette petite animation.
Espace pour changer la gravité et Echap pour quitter.
Marche mieux compilé sans debuggeur.

Je suis preneur de toute idée pour continuer ou conseil pour progresser.

Code : Tout sélectionner

If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, 600, 600, "Sable", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,600,600,0,0,0,#PB_Screen_NoSynchronization )=0
   MessageRequester("Error", "Can't open the sprite system", 0)
   End
 EndIf
 

#PopulationSize=800;nombre de grains
#TailleEcranX=600
#TailleEcranY=600
d=0
Style=10
Structure Sable
  positionx.i
  positiony.i
  Attirance.i[8]
  Stock.i[8]
  Libre.i[8]
  Couleur.i
EndStructure
 
 Global Dim Grain.sable(#PopulationSize) ; Les grains de sable
 Global Dim Carte.i (60,60) ; La carte ou on va les poser
 Global PopulationReelle.i=0
 Global AngleRadiant.f=5*#PI/4
 
 Declare CreationDesGrains()
 Declare Mouvement()
  
;Dessin des sprites
CreateSprite(0,10,10,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(0))
Circle (5,5,5,#Red)
StopDrawing()

CreateSprite(1,10,10,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(1))
Circle (5,5,5,#Yellow)
StopDrawing()

CreateSprite(2,10,10,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(2))
Circle (5,5,5,#Green)
StopDrawing()

Procedure CreationDesGrains()
  
  For j=0 To 59 ; vidage de la carte sauf sur les bords
      For k=0 To 59
        If j=0 Or j=59 Or k=0 Or k=59
          Carte(j,k)=1
        Else 
          Carte(j,k)=0  
        EndIf
      
    Next k
    Next j
   
    For i=1 To #PopulationSize
      X=Random(58,2)
      Y=Random(58,2)
      C=Random(1)
      If Carte (X,Y) = 0
        PopulationReelle=PopulationReelle+1
      Grain(i)\positionx=X
      Grain(i)\positiony=Y
      If Y>30
        Grain(i)\Couleur=0
      Else
        Grain(i)\Couleur=1
      EndIf
      
      Carte (X,Y) = 1
      For j=0 To 7
        Grain(i)\Attirance[j]=0
        Grain(i)\Stock[j]=1000
        Grain(i)\Libre[j]=0
      Next j
      
    Else 
      i=i-1 ; Je refais un tirage tant que tout le monde n'a pas trouvé sa place
    EndIf
      Next i
      
    EndProcedure
 
 


Procedure Mouvement()
  For i=1 To PopulationReelle
    
    For j=0 To 7
      
      Grain(i)\Stock[j] = Grain(i)\Stock[j] - Grain(i)\Attirance[j]
      
      Next j
      
      For j=0 To 7 ; butée pour ne pas dépasser la plage maxi de l'entier
          If Grain(i)\Stock[j] < -1 :  Grain(i)\Stock[j] = -1
          EndIf
        Next j
         ;Gestion des libertées
     If Carte (Grain(i)\positionx,(Grain(i)\positiony-1))=0 
         Grain(i)\Libre[0]=1 
       Else
         Grain(i)\Libre[0]=0
       EndIf
      
        If Carte ((Grain(i)\positionx)+1,(Grain(i)\positiony)-1)=0 
          Grain(i)\Libre[1]=1
          Else
         Grain(i)\Libre[1]=0
      EndIf
      
      If Carte ((Grain(i)\positionx)+1,(Grain(i)\positiony))=0 
        Grain(i)\Libre[2]=1 
        Else
         Grain(i)\Libre[2]=0
     EndIf
     
     If Carte ((Grain(i)\positionx)+1,(Grain(i)\positiony)+1)=0 
       Grain(i)\Libre[3]=1 
       Else
         Grain(i)\Libre[3]=0
      EndIf
      
     If Carte ((Grain(i)\positionx),(Grain(i)\positiony)+1)=0 
       Grain(i)\Libre[4]=1 
       Else
         Grain(i)\Libre[4]=0
      EndIf
      
     If Carte ((Grain(i)\positionx)-1,(Grain(i)\positiony)+1)=0 
       Grain(i)\Libre[5]=1 
       Else
         Grain(i)\Libre[5]=0
      EndIf
      
      If Carte ((Grain(i)\positionx)-1,(Grain(i)\positiony))=0 
        Grain(i)\Libre[6]=1 
        Else
         Grain(i)\Libre[6]=0
      EndIf
      
      If Carte ((Grain(i)\positionx)-1,(Grain(i)\positiony)-1)=0 
        Grain(i)\Libre[7]=1 
        Else
         Grain(i)\Libre[7]=0
     EndIf
    ; On bouge si possible 
     If Grain(i)\Stock[0]<=0 And Grain(i)\Libre[0]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positiony=Grain(i)\positiony-1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[0]=1000
       For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
       EndIf
       
      
     If Grain(i)\Stock[1]<=0  And Grain(i)\Libre[1]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positionx=Grain(i)\positionx+1
       Grain(i)\positiony=Grain(i)\positiony-1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[1]=1000
      For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
       EndIf
     
     If Grain(i)\Stock[2]<=0 And Grain(i)\Libre[2]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positionx=Grain(i)\positionx+1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[2]=1000
      For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
     EndIf
     
     If Grain(i)\Stock[3]<=0 And Grain(i)\Libre[3]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positionx=Grain(i)\positionx+1
       Grain(i)\positiony=Grain(i)\positiony+1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[3]=1000
      For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
     EndIf
     
     If Grain(i)\Stock[4]<=0 And Grain(i)\Libre[4]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positiony=Grain(i)\positiony+1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
        Grain(i)\Stock[4]=1000
        For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j        
     EndIf
     
     If Grain(i)\Stock[5]<=0 And Grain(i)\Libre[5]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positionx=Grain(i)\positionx-1
       Grain(i)\positiony=Grain(i)\positiony+1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[5]=1000
     For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
     EndIf
     
     If Grain(i)\Stock[6]<=0 And Grain(i)\Libre[6]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positionx=Grain(i)\positionx-1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[6]=1000
       For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
           EndIf
     
     If Grain(i)\Stock[7]<=0 And Grain(i)\Libre[7]=1 
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=0
       Grain(i)\positionx=Grain(i)\positionx-1 
       Grain(i)\positiony=Grain(i)\positiony-1
       Carte ((Grain(i)\positionx),(Grain(i)\positiony))=1
       Grain(i)\Stock[7]=1000
      For j=0 To 7
       Grain(i)\Libre[j]=0
       Next j  
    EndIf
        Next i
   
  EndProcedure
  
            
  CreationDesGrains()

  
Repeat
   Repeat:Until WindowEvent()=0
   FlipBuffers()
   ClearScreen(#Black)
   ExamineKeyboard()
   Mouvement()
 Select Degree(AngleRadiant)
   Case 0 
    DisplaySprite(1,595,300) 
   Case 45
     DisplaySprite(1,595,5)  
   Case 90
      DisplaySprite(1,300,5)  
   Case 135
     DisplaySprite(1,5,5)
    Case 180
    DisplaySprite(1,5,300)  
    Case 225
     DisplaySprite(1,5,595)  
   Case 270
     DisplaySprite(1,300,595)  
   Case 315 
     DisplaySprite(1,595,595)  
 EndSelect
 
     
 For i=1 To PopulationReelle
   If Grain(i)\Couleur=0
     DisplaySprite(0,Grain(i)\positionx*10,Grain(i)\positiony*10)
       Else
     DisplaySprite(2,Grain(i)\positionx*10,Grain(i)\positiony*10)
     EndIf
         Next i
                  
         If KeyboardPushed(#PB_Key_Space) And a=0
           a=1
           
           AngleRadiant.f=AngleRadiant+#PI/4
           
           If Degree(AngleRadiant)>=350
             AngleRadiant=0
           EndIf
           
         For i=1 To PopulationReelle
           If AngleRadiant>=0 And AngleRadiant<#PI
             Grain(i)\Attirance[0]=Int(100*Sin(AngleRadiant))-Random (Style)
              Else
               Grain(i)\Attirance[0]=0
            EndIf
           
           If AngleRadiant>=7*#PI/4 Or (0<=AngleRadiant And AngleRadiant<3*#PI/4)
             Grain(i)\Attirance[1]=Int(100*Sin(AngleRadiant+#PI/4))-Random (Style)
             Else
             Grain(i)\Attirance[1]=0
          EndIf
           
           If AngleRadiant>=3*#PI/2 Or AngleRadiant<#PI/2
             Grain(i)\Attirance[2]=Int(100*Sin(AngleRadiant+#PI/2))-Random (Style)
          
         Else
             Grain(i)\Attirance[2]=0
          EndIf
           
           If AngleRadiant>=5*#PI/4 Or AngleRadiant<#PI/4
             Grain(i)\Attirance[3]=Int(100*Sin(AngleRadiant+3*#PI/4))-Random (Style)
          
          Else
             Grain(i)\Attirance[3]=0
          EndIf
           
             If AngleRadiant>=#PI And AngleRadiant<2*#PI
               Grain(i)\Attirance[4]=Int(100*Sin(AngleRadiant-#PI))-Random (Style)
          
           Else
             Grain(i)\Attirance[4]=0
          EndIf
           
           If AngleRadiant>=3*#PI/4 And AngleRadiant<7*#PI/4
             Grain(i)\Attirance[5]=Int(100*Sin(AngleRadiant-3*#PI/4))-Random (Style)
          
           Else
           Grain(i)\Attirance[5]=0
           EndIf
           
           If AngleRadiant>=#PI/2 And AngleRadiant<3*#PI/2
             Grain(i)\Attirance[6]=Int(100*Sin(AngleRadiant-#PI/2))-Random (Style)
          
           Else
           Grain(i)\Attirance[6]=0
           EndIf
           
           If AngleRadiant>#PI/4 And AngleRadiant<5*#PI/4
             Grain(i)\Attirance[7]=Int(100*Sin(AngleRadiant-#PI/4))-Random (Style)
            Else
             Grain(i)\Attirance[7]=0
            EndIf
            
      Next i
    EndIf
    If KeyboardReleased(#PB_Key_Space)
      a=0  
    EndIf

    Until KeyboardPushed(#PB_Key_Escape)

    
   

Re: Grains de sable

Publié : mar. 20/mars/2018 15:23
par SPH
Pas mal pour un debut. Ca m'a amusé 8)

Re: Grains de sable

Publié : mar. 20/mars/2018 16:01
par falsam
SPH a écrit :Pas mal pour un debut. Ca m'a amusé 8)
Pas mal ? mais non pas du tout. Au contraire c'est bien :wink:

je pense que tu peux remplacer (Ligne 277)

Code : Tout sélectionner

If KeyboardPushed(#PB_Key_Space) And a=0
    a=1
    
    AngleRadiant.f=AngleRadiant+#PI/4
...
par

Code : Tout sélectionner

If KeyboardReleased(#PB_Key_Space)    
    AngleRadiant.f=AngleRadiant+#PI/4
...
et supprimer (Ligne 342)

Code : Tout sélectionner

If KeyboardReleased(#PB_Key_Space)
    a=0  
EndIf

Re: Grains de sable

Publié : mar. 20/mars/2018 16:30
par Fig
Je trouve ça très sympa ! :D

Je n'arrive pas à savoir si les grains roulent les uns sur les autres ou s'ils restent dans la même colonne en descendant, ça va trop vite.

Sinon, peut être que le code est un petit peu verbeux, à mon avis on peut faire la même chose en beaucoup moins de ligne.

Mais ça reste une super idée plutôt bien réalisée. 8)

Re: Grains de sable

Publié : sam. 31/mars/2018 17:52
par Kwai chang caine
C'est un sablier mode "tremblement de terre", mais c'est vrai l'effet est cool !!
Merci pour le partage 8)

Re: Grains de sable

Publié : jeu. 05/avr./2018 8:20
par G-Rom
Sympa, ca me fait pensé un peu à powder toy

tu peu améllioré le code de cette facon :

Code : Tout sélectionner

Dim carte(60,60)
en

Code : Tout sélectionner

Dim carte(60*60)
tu peu acceder facilement au indice de cette manière :

Code : Tout sélectionner

Index = x + width * y
60 dans ton cas

et pareilement en inverse :

Code : Tout sélectionner

x = Index % width
y = Index / width
C'est plus rapide de cette manière.

idem pour les mise à zéro :

Code : Tout sélectionner

For j=0 To 7
	Grain(i)\Libre[j]=0
Next j 
par

Code : Tout sélectionner

FillMemory(@Grain(i)\Libre[0],SizeOf(integer)*8,0)
y a aussi les sin() que tu peu remplacer par une table précalculé.

Re: Grains de sable

Publié : jeu. 05/avr./2018 10:54
par Kangax
Merci beaucoup pour vos messages et conseils.

Re: Grains de sable

Publié : ven. 06/avr./2018 23:07
par ICE
La prochaine version de Chipmunk4PB aura une démo similaire de grains de sable.