PureBasic

Forums PureBasic
Nous sommes le Sam 24/Aoû/2019 8:45

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 4 messages ] 
Auteur Message
 Sujet du message: Jeu de la vie de Conway... En musique.
MessagePosté: Mar 23/Avr/2019 20:50 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1121
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:
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)

_________________
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


Dernière édition par Fig le Mer 24/Avr/2019 20:44, édité 2 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Jeu de la vie de Conway... En musique.
MessagePosté: Mar 23/Avr/2019 22:01 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8739
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 :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Jeu de la vie de Conway... En musique.
MessagePosté: Mar 23/Avr/2019 23:03 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2788
Localisation: Klyntar
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.71 Beta 1 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Jeu de la vie de Conway... En musique.
MessagePosté: Mer 24/Avr/2019 20:24 
Hors ligne
Avatar de l’utilisateur

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


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 4 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