Grains de sable

Programmation avancée de jeux en PureBasic
Kangax
Messages : 8
Inscription : jeu. 29/juin/2017 16:23

Grains de sable

Message 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)

    
   
Avatar de l’utilisateur
SPH
Messages : 4722
Inscription : mer. 09/nov./2005 9:53

Re: Grains de sable

Message par SPH »

Pas mal pour un debut. Ca m'a amusé 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
falsam
Messages : 7244
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: Grains de sable

Message 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
Configuration : Windows 11 Famille 64-bit - PB 6.03 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Grains de sable

Message 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)
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 6.00LTS - 64 bits
Avatar de l’utilisateur
Kwai chang caine
Messages : 6962
Inscription : sam. 23/sept./2006 18:32
Localisation : Isere

Re: Grains de sable

Message 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)
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic
G-Rom
Messages : 3626
Inscription : dim. 10/janv./2010 5:29

Re: Grains de sable

Message 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é.
Kangax
Messages : 8
Inscription : jeu. 29/juin/2017 16:23

Re: Grains de sable

Message par Kangax »

Merci beaucoup pour vos messages et conseils.
ICE
Messages : 42
Inscription : jeu. 18/nov./2010 15:26

Re: Grains de sable

Message par ICE »

La prochaine version de Chipmunk4PB aura une démo similaire de grains de sable.
Répondre