PureBasic Forum
http://forums.purebasic.com/english/

Conway's game of life
http://forums.purebasic.com/english/viewtopic.php?f=16&t=72704
Page 1 of 1

Author:  Fig [ Wed Apr 24, 2019 8:01 pm ]
Post subject:  Conway's game of life

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

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/