PureBasic

Forums PureBasic
Nous sommes le Ven 19/Juil/2019 11:15

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 
Auteur Message
 Sujet du message: Grains de sable
MessagePosté: Mar 20/Mar/2018 14:28 
Hors ligne

Inscription: Jeu 29/Juin/2017 16:23
Messages: 8
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:
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)

   
   


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Mar 20/Mar/2018 15:23 
Hors ligne
Avatar de l’utilisateur

Inscription: Mer 09/Nov/2005 9:53
Messages: 3980
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 ////
Portable LENOVO ideapad 110-17ACL 64 bits
Version de PB : 5.70LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Mar 20/Mar/2018 16:01 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6846
Localisation: IDF (Yvelines)
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:
If KeyboardPushed(#PB_Key_Space) And a=0
    a=1
   
    AngleRadiant.f=AngleRadiant+#PI/4
...
par
Code:
If KeyboardReleased(#PB_Key_Space)   
    AngleRadiant.f=AngleRadiant+#PI/4
...
et supprimer (Ligne 342)
Code:
If KeyboardReleased(#PB_Key_Space)
    a=0 
EndIf

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.70 LTS
➽ Je papote aussi sur http://purebasic.chat

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP techniques


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Mar 20/Mar/2018 16:30 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1121
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 : 5.45LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Sam 31/Mar/2018 17:52 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6637
Localisation: Isere
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


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Jeu 05/Avr/2018 8:20 
Hors ligne

Inscription: Dim 10/Jan/2010 5:29
Messages: 3411
Sympa, ca me fait pensé un peu à powder toy

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

Code:
Dim carte(60,60)


en

Code:
Dim carte(60*60)


tu peu acceder facilement au indice de cette manière :

Code:
Index = x + width * y
60 dans ton cas

et pareilement en inverse :

Code:
x = Index % width
y = Index / width


C'est plus rapide de cette manière.

idem pour les mise à zéro :

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


par

Code:
FillMemory(@Grain(i)\Libre[0],SizeOf(integer)*8,0)


y a aussi les sin() que tu peu remplacer par une table précalculé.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Jeu 05/Avr/2018 10:54 
Hors ligne

Inscription: Jeu 29/Juin/2017 16:23
Messages: 8
Merci beaucoup pour vos messages et conseils.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Grains de sable
MessagePosté: Ven 06/Avr/2018 23:07 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 18/Nov/2010 15:26
Messages: 42
La prochaine version de Chipmunk4PB aura une démo similaire de grains de sable.


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 8 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 3 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye