It is currently Mon Sep 23, 2019 4:42 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: Conway's game of life
PostPosted: Wed Apr 24, 2019 8:01 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 302
Location: Côtes d'Azur, France
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)

_________________
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.70 LTS


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 1 post ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 3 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye