Page 1 of 1

Conway's game of life

Posted: Wed Apr 24, 2019 8:01 pm
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)

Re: Conway's game of life

Posted: Thu Nov 17, 2022 2:45 pm
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: :)

Re: Conway's game of life

Posted: Sat Nov 19, 2022 1:02 am
by SPH
GG 8)

Re: Conway's game of life

Posted: Mon Jan 16, 2023 12:20 pm
by Kwai chang caine
Nice, thanks for sharing 8)

Re: Conway's game of life

Posted: Tue Jan 17, 2023 10:33 am
by infratec