An explanation of Conway's game of life:
https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
File with code, sound samples and lock's picture:
http://dl.free.fr/gIew2zYyY
inspiration from here:
https://youtu.be/IAiTL6lglXc
I'm not a musician so the samples can surely be improved to get something more fun ...
Right click to put a note or delete it.
Left click to lock a location (and prevent it from changing) or release it.
Conway's game of life in music
Conway's game of life in music
There are 2 methods to program bugless.
But only the third works fine.
Win10, Pb x64 5.71 LTS
But only the third works fine.
Win10, Pb x64 5.71 LTS
Re: Conway's game of life in music
Ups.. I didn't noticed this thread before.
Unfortunately I can not download the project via the provided link.
Unfortunately I can not download the project via the provided link.
Re: Conway's game of life in music
Here is the code...
I lost the music's sample and padlock sprite I am sorry.
I lost the music's sample and padlock sprite I am sorry.
Code: Select all
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)
There are 2 methods to program bugless.
But only the third works fine.
Win10, Pb x64 5.71 LTS
But only the third works fine.
Win10, Pb x64 5.71 LTS