Jeu de la vie de Conway... En musique.

Programmation avancée de jeux en PureBasic
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Jeu de la vie de Conway... En musique.

Message par Fig »

Une explication du jeu de la vie de Conway
https://fr.wikipedia.org/wiki/Jeu_de_la_vie

Archive avec le code, samples et l'image du cadenas:
http://dl.free.fr/gIew2zYyY

Image

Je ne suis pas musicien donc les samples peuvent surement être améliorés pour obtenir quelque chose de plus sympa encore...

Clic droit pour mettre une note ou la supprimer.
Clic gauche pour verrouiller un emplacement (et empêcher qu'il change) ou le libérer.

Code : Tout sélectionner

Sx.i=800:Sy.i=600
If InitSound()=0 Or InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, Sx,Sy, "Conway's music right Clic to note, left clic to lock", #PB_Window_SystemMenu )=0 Or OpenWindowedScreen(WindowID(0),0,0,Sx,Sy, 0, 0, 0)=0
  MessageRequester("Error", "Can't open the sprite system", 0)
  End
EndIf
UseJPEGImageDecoder()
Global SQx.i=16,SQy.i=9,Squarex.i=Int(Sx/SQx),Squarey.i=Int(Sy/SQy),Avx.i=0,currentA.i=0,currentB.i=1
Global Dim Note(SQx,SQy,2) ;,0 =note to play  ,2= state locked
LoadSprite(3,"padlock.jpg")
For i=0 To SQy-1   
    Read.s sounds.s
    If LoadSound(i,sounds)=0:MessageRequester("Error", "Can't load sound", 0):EndIf
Next i
DataSection
    Data.s "keyboard1.wav","keyboard2.wav","keyboard3.wav","keyboard4.wav"
    Data.s "Bass.wav","Hats.wav","Conga.wav","Snare.wav","Kick.wav"
EndDataSection

Procedure PlayTrack()
    Avx=(Avx+1)%SQx
    If Avx=0
        currentA=(currentA+1)%2
        currentB=(currentB+1)%2
        For i=0 To SQx-1
            For j=0 To SQy-1
                som=0
                If note(i,j,2)=1:Continue:EndIf
                For a=-1 To 1
                    For b=-1 To 1
                        If a=0 And b=0:Continue:EndIf
                        If i+a<0 Or j+b<0 Or i+a=SQx Or j+b=SQy:Continue:EndIf 
                        som=som+note(i+a,j+b,currentA)
                    Next b
                Next a
                If som=1:Continue:EndIf
                If som=3:note(i,j,currentB)=1:EndIf
                If som<2 Or som>3:note(i,j,currentB)=0:EndIf
            Next j
        Next i
    EndIf
    
    For i=0 To SQy-1
        If Note(Avx,i,0)<>0
            PlaySound(i,#PB_Sound_MultiChannel)
        EndIf
    Next i
EndProcedure
AddWindowTimer(0, 0, 100)
BindEvent(#PB_Event_Timer,@PlayTrack())
;case sprite
CreateSprite(0,Squarex,Squarey)
StartDrawing(SpriteOutput(0))
    Box(1,1,Squarex-2,Squarey-2,RGB(128,128,128))
StopDrawing()
;mouse sprite
CreateSprite(1,20,20)
StartDrawing(SpriteOutput(1))
    Box(0,0,20,20,$FFFFFF)
    Box(2,2,18,18,$000000)
StopDrawing()
;play bar sprite
CreateSprite(2,Squarex,Squarey*Sqy,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(2))
    Box(0,0,20,20,$FFFFFF)
StopDrawing()
Repeat
    Repeat
        Event = WindowEvent()        
    Until Event = 0
    ExamineKeyboard()
    ExamineMouse()
    X.i=MouseX()/Squarex
    Y.i=MouseY()/Squarey
    ClearScreen(RGB(0,0,0))
    If MouseButton(#PB_MouseButton_Left)
        If leftbutton=0
            leftbutton=1
            If note(x,y,currentA)=1
                note(x,y,currentB)=0
                note(x,y,currentA)=0
            Else
                note(x,y,currentB)=1
                note(x,y,currentA)=1
            EndIf
        EndIf
    Else
        leftbutton=0
    EndIf    
    If MouseButton(#PB_MouseButton_Right)
        If rightbutton=0
            rightbutton=1
            If note(x,y,2)=1
                note(x,y,2)=0
            Else
                note(x,y,2)=1
            EndIf
        EndIf
    Else
        rightbutton=0
    EndIf        
    ;affiche le tableau de notes
    ;display all notes
    For j=0 To SQy-1
        For i=0 To SQx-1
            If note(i,j,currentA)=1 Or note(i,j,currentB)=1
                DisplayTransparentSprite(0,i*Squarex,j*Squarey,255,$FFFFFF)
            Else 
                DisplaySprite(0,i*Squarex,j*Squarey)
            EndIf
            If note(i,j,2)=1
                DisplayTransparentSprite(3,i*Squarex+squarex/2-SpriteWidth(3)/2,j*Squarey+squarey/2-SpriteHeight(3)/2)
            EndIf
        Next i
    Next j
    DisplayTransparentSprite(2,Avx*Squarex,0,100,#Green)
    DisplayTransparentSprite(1,MouseX(),MouseY())
    FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
Dernière modification par Fig le mer. 24/avr./2019 20:44, modifié 2 fois.
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
Ar-S
Messages : 9472
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Jeu de la vie de Conway... En musique.

Message par Ar-S »

Salut Fig, j'ai un lag monstrueux avec ma souris (haut dpi).. :(
Je le testerai à l'occasion sur mon portable. En tout cas j'ai découvert ce "jeu de la vie" que je ne connaissais pas :)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
venom
Messages : 3071
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :

Re: Jeu de la vie de Conway... En musique.

Message par venom »

Bonjour Fig,

Ta demo fonctionne très bien chez moi (souris "norma"l). J'avoue que je ne connaissais pas ce "jeu de la vie", meme avec la notice et ta demo je n'ai pas tout compris. :lol: Apparemment ça créer et tue des cellules si j'ai bien compris ?
Merci pour le partage.







@++
Windows 10 x64, PureBasic 5.73 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Avatar de l’utilisateur
Fig
Messages : 1176
Inscription : jeu. 14/oct./2004 19:48

Re: Jeu de la vie de Conway... En musique.

Message par Fig »

Bonjour à tous,

Désolé Ars pour ton problème de souris... Je verrai pour implémenter la prise en charge des souris rapides, mais il faut avouer que c'est pénible à faire. ^^

J'ai corrigé un bug dans les règles d'évolution du jeu de la vie que j'avais codé (une lettre manquait dans le nom d'une variable). Maintenant ça fonctionne bien.

Bonne soirée. :wink:
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
Répondre