Conway's game of life

Advanced game related topics
User avatar
Fig
Enthusiast
Enthusiast
Posts: 351
Joined: Thu Apr 30, 2009 5:23 pm
Location: Côtes d'Azur, France

Conway's game of life

Post by Fig »

I realized not every body knows the original cellautomat.
[left click] to place cells, [Space] to begin generation.
see wikipedia page to learn different patterns:
https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
Pulsar:
Image
Space Ship: Glider
Image
Acorn
Image
etc...

Code: Select all

;Conway's game of life
;https://fr.wikipedia.org/wiki/Game_of_Life
;Press Space to begin generation
;Left clic to place a cell
Sx.i=800:Sy.i=600 ;resolution
#speed=250 ;speed
If InitSound()=0 Or InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, Sx,Sy, "Conway's game of life, left clic to place a cell, Space to begin generation", #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=80,SQy.i=60,Squarex.i=Int(Sx/SQx),Squarey.i=Int(Sy/SQy),currentA.i=0,currentB.i=1
Dim note.i(SQx,SQy,1)
timer.q=0

;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()

Repeat
    Repeat
        Event = WindowEvent()        
    Until Event = 0
    ExamineKeyboard()
    ExamineMouse()
    X.i=MouseX()/Squarex
    Y.i=MouseY()/Squarey
    ClearScreen(RGB(0,0,0))
    If KeyboardReleased(#PB_Key_Space)
        space=~space
    EndIf
    If KeyboardReleased(#PB_Key_R)
        For i=1 To 200+Random(300)
            xr.i=Random(SQx):yr.i=Random(SQy)
            note(xr,yr,0)=1
            note(xr,yr,1)=1
        Next i    
    EndIf
    
    If space=0 And 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 space<>0 And ElapsedMilliseconds()-timer>=#speed
        timer=ElapsedMilliseconds()
        ;inverse buffers
        currentA=(currentA+1)%2
        currentB=(currentB+1)%2
        For i=0 To SQx-1
            For j=0 To SQy-1
                som=0
                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
                note(i,j,currentB)=note(i,j,currentA)
                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
    
    ;affiche le tableau de notes
    ;display all notes
    For j=0 To SQy-1
        For i=0 To SQx-1
            If note(i,j,currentB)=1
                If space=0
                    DisplayTransparentSprite(0,i*Squarex,j*Squarey,255,$FFFFFF)
                Else
                    DisplayTransparentSprite(0,i*Squarex,j*Squarey,255,$FF0000)
                EndIf
            Else 
                DisplaySprite(0,i*Squarex,j*Squarey)
            EndIf
        Next i
    Next j
    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
User avatar
Psychophanta
Addict
Addict
Posts: 4968
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Conway's game of life

Post by Psychophanta »

Great :idea: :) one.
At the moment is the first funtional so known "game of life" version I have seen in all the forum. :idea: :)
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
User avatar
SPH
Enthusiast
Enthusiast
Posts: 268
Joined: Tue Jan 04, 2011 6:21 pm

Re: Conway's game of life

Post by SPH »

GG 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.73LTS - 32 bits
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Conway's game of life

Post by Kwai chang caine »

Nice, thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
infratec
Always Here
Always Here
Posts: 6817
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Conway's game of life

Post by infratec »

Post Reply