Life! V1.0

[Diroga]

i had a mac that had a game like yours red_Marvin. you would click out a bunch of black dots and watch them multiply! yes more fun then watching grass grow or paint dry.

[Pyrodap]

wow red_Marvin - that was great... well.. i guess so far you win - this is an open-ended competition - if anybody else wants to code an entry - you're welcome to!

seriously that's some nice code - very cool

[Deleter]

thats odd...it doesn't seem to work right when I run it. it just makes them all die, regardless of whether they have 2/3 neighbors or not...

edit: here's my version, its longer, but supports an infinite (not limited by map size, rather by the maxcells constant) cell system and works for me.

edit edit: new code in lower thread.

[red_Marvin]

@Deleter: I suppose it's my program you're talking about?

Have you tried leaving the line blank?
Does the problem occur for every pattern?
To check: Do the R-pentamino:
--##
##--
--#--
It shouldn't stabilize any time soon...

Could you perhaps change the code to make it output what the
contents of the life and birth strings are?


Anyone else have this problem?


Edit: Also Deleter: Esc doesn't seem to quit the program for me,
both in edit mode and running...

[Deleter]

new code: (I forgot to add until multikey(1) after the loop :oops: )
also, hold right mouse and move the mouse around when in edit mode, it moves the camera. you can now see the world to the exent of an Integer's boundaries

edit: yeah I pressed enter, and I tried making the default 23/3 mover
#--
-##
##-

it just turns things blue and thats it.
it also does this to the flasher
-#-
-#-
-#-

Code:

'Based on Conway's Game of Life
'Coded For Freebasic by Deleter
'uses slots to allow for an infinite world

'*******************************************************************************
'Subs                                                                          *
'*******************************************************************************
Declare Sub EditCells() 'editing sub
Declare Sub HandleCells () 'cell running sub
Declare Sub SpawnCell( argX As Integer, argY As Integer ) 'cell creating sub
Declare Sub KillCell( argX As Integer, argY As Integer )'cell destroying sub
Declare Sub HandleMouse() 'Handle the mouse for editing mode
Declare Sub DrawCells() 'draw the cells
Declare Sub ParseRules( argRules As String ) 'parse a text string entered rule set

'*******************************************************************************
'Functions                                                                     *
'*******************************************************************************
Declare Function Neighbors( argX As Integer, argY As Integer ) As Byte 'find amount of neighbors
Declare Function Alive( argX As Integer, argY As Integer ) As Byte 'find if a certain x and y contains a living cell
Declare Function OpenCellSlot () As Integer
Declare Function GoingToBeAlive( argX As Integer, argY As Integer ) As Byte

'*******************************************************************************
'Constants                                                                     *
'*******************************************************************************
'logic
Const True = -1
Const False = Not True
'used for mode
Const Editing = 0
Const RunningCont = 1
Const RunningTurn = 2
'engine constant
Const MaxCells = 5000
Const Scale = 5
'*******************************************************************************
'Types                                                                         *
'*******************************************************************************
Type CellType 'Cell Slot type
    Alive As Byte

    X As Integer
    Y As Integer
    Generation As Integer
    Neighbors As Integer
End Type

Type MouseType 'keep track of mouse
    Left As Byte
    LeftUsed As Byte
    Right As Byte
    RightX As Integer
    RightY As Integer
End Type

'*******************************************************************************
'Variables                                                                     *
'*******************************************************************************
Dim Shared Cell( -1 To MaxCells - 1 ) As CellType
Dim Shared CurGeneration As Integer
Dim Shared CurMode As Byte
Dim Shared Mouse As MouseType

Dim Shared Birth( 7 ) As Integer
Dim Shared Live( 7 ) As Integer
Dim TempRules As String

Dim Shared OffX As Integer'what is 0,0 onscreen?
Dim Shared OffY As Integer'^

Dim TempX As Integer, TempY As Integer
Dim TempTime As Double

Dim ShowPage As Byte
Dim WorkPage As Byte

CurGeneration = 0
CurMode = Editing
OffX = 400
OffY = 300

screen 19, 32, 2

Print "Press 'E' at any time to go into edit mode"
Print "Press 'C' at any time to go into continous run mode"
Print "Press 'T' at any time to go into turn-based run mode"
Print "(Press [ENTER] To go to next turn)"
Print "Press 'Esc' at any time to quit the simulation"
Print
Input "Input Desired Rules To Continue "; TempRules

ParseRules( TempRules )

cls
WorkPage = 0
ShowPage = 1
ScreenSet WorkPage, ShowPage

Do
    
    If MultiKey( 18 ) Then CurMode = Editing 'e
    If MultiKey( 46 ) Then CurMode = RunningCont 'c
    If MultiKey( 20 ) Then CurMode = RunningTurn 't
    
    'if in editing mode
    If CurMode = Editing Then
        'then run the editing sub
        HandleMouse
        EditCells
        TempTime = Timer - 1 'we don't want any delay
    
    'if in running in continous mode
    ElseIf CurMode = RunningCont Then
        'then handle cells. delay is to control how fast its going
        TempTime = Timer + .1 'min of 1/10th of a second per generation
        HandleCells

    'if in running turn based
    ElseIf CurMode = RunningTurn Then
        
        'and if user presses enter
        If MultiKey( 28 ) Then
            'delay so pressing enter once goes only one generation
            TempTime = Timer + .2
            HandleCells
        End If
    End If
    
    'gfx
    Cls
    Locate 1, 1
    If CurMode = Editing Then Print "Editing - Rules "; TempRules;" - Generation:";
    If CurMode = RunningCont Then Print "Running Continuous - Rules "; TempRules;" -  Generation: ";
    If CurMode = RunningTurn Then Print "Running Turn-Based - Rules "; TempRules;" -  Generation:";
    Print CurGeneration
    
    'If CurMode = Editing Then
        GetMouse TempX, TempY
        Print "X:"; Int( ( TempX - OffX ) / Scale ) ;" Y:"; Int( ( TempY - OffY ) / Scale )
        Print Neighbors ( Int( ( TempX - OffX ) / Scale ) , Int( ( TempY - OffY ) / Scale ) )
    
    'End If
    
    DrawCells
    
    Swap WorkPage, ShowPage
    ScreenSet WorkPage, ShowPage
    
    'Delay Loop
    Do
        If MultiKey( 18 ) Then CurMode = Editing 'e
        If MultiKey( 46 ) Then CurMode = RunningCont 'c
        If MultiKey( 18 ) Then CurMode = RunningTurn 't    
    Loop Until Timer > TempTime
    
Loop Until MultiKey( 1 )

'*******************************************************************************
'Cell running sub - goes through and creates, kills, and updates cells         *
'*******************************************************************************
Sub EditCells()
    Dim TempX As Integer, TempY As Integer
    
    If Mouse.Left = True And Mouse.LeftUsed = False Then
        GetMouse TempX, TempY
        TempX = Int( ( TempX - OffX ) / Scale )
        TempY = Int( ( TempY - OffY ) / Scale )
        
        'if its already alive
        If Alive( TempX, TempY ) = True Then
            'then kill it
            KillCell( TempX, TempY )
        
        'if there is nothing alive
        Else
            'then make a new cell
            CurGeneration -= 1
            SpawnCell( TempX, TempY )
            CurGeneration += 1
        
        End If
        'don't keep switching the state, user has to release mouse before making new/kiling
        Mouse.LeftUsed = True
    End If
    
End Sub
        
Sub HandleCells ()
    Dim TempCell As Integer
    Dim TempX As Integer, TempY As Integer
    Dim TempCheckX As Integer, TempCheckY As Integer
    Dim TempCheckRules As Integer
    
    'first count neighbors before making new cells and killing cells
    For TempCell = 0 To MaxCells - 1
        If Cell( TempCell ).Alive = True Then
            Cell( TempCell ).Neighbors = Neighbors( Cell( TempCell ).X, Cell( TempCell ).Y )
        End If
    Next TempCell
    
    'then make new cells
    '3. Any dead cell with exactly three neighbors comes to life.
    For TempCell = 0 To MaxCells - 1
        If Cell( TempCell ).Alive = True Then
            If Cell( TempCell ).Generation = CurGeneration Then 'don't spawn off of new cells
                
                For TempX = -1 To 1
                    For TempY = -1 To 1
                        
                        TempCheckX = Cell( TempCell ).X + TempX
                        TempCheckY = Cell( TempCell ).Y + TempY
                        
                        'if not already alive
                        If Abs( TempX )+ Abs( TempY ) <> 0 And Alive( TempCheckX, TempCheckY ) = False Then
                      
                            For TempCheckRules = 0 To 7
                                
                                'if has right number for birth

                                
                                If Neighbors( TempCheckX, TempCheckY ) = Birth( TempCheckRules ) Then
                                    
                                    'make new cell
                                    SpawnCell( TempCheckX, TempCheckY )
                                    exit for
                                
                                End If
                            
                            Next TempCheckRules
                            
                        End If
                    Next TempY
                Next TempX
                
            End If
        End If
    Next TempCell

    'then kill other cells
    '1. Any live cell with less than two neighbors dies of loneliness.
    '2. Any live cell with more than three neighbors dies of crowding.
    '4. Any live cell with two or three neighbors lives, unchanged, to the next generation.
    'im doing 234/3
    For TempCell = 0 To MaxCells - 1
        'if its alive
        If Cell( TempCell ).Alive = True Then
            
            'if its not the new generation
            If Cell( TempCell ).Generation < CurGeneration + 1 Then
                
                'kill it by default
                Cell( TempCell ).Alive = False
                
                For TempCheckRules = 0 To 7
                    
                    'If it does have the right amount of neighbors
                    If Cell( TempCell ).Neighbors = Live( TempCheckRules ) Then

                        'revive and bring it into the new generation
                        Cell( TempCell ).Alive = True
                        Cell( TempCell ).Generation = CurGeneration + 1
                        
                    End If
                Next TempCheckRules
                                
           End If
        
        End If
    
    Next TempCell
        
    CurGeneration +=1            

End Sub

Sub SpawnCell( argX As Integer, argY As Integer )
    If GoingToBeAlive( argX , argY ) = True Then Exit Sub
    
    TempNewCell = OpenCellSlot
    Cell( TempNewCell ).Alive = True
    Cell( TempNewCell ).X = argX
    Cell( TempNewCell ).Y = argY
    Cell( TempNewCell ).Generation = CurGeneration + 1
    
End Sub

Sub KillCell( argX As Integer, argY As Integer )
    Dim TempCell As Integer
    
    For TempCell = 0 to MaxCells - 1
        If Cell( TempCell ).X = argX Then
            If Cell( TempCell ).Y = argY Then
                Cell( TempCell ).Alive = False
                Exit Sub
            End if
        End If
    Next TempCell

End Sub

Sub HandleMouse ()
    Dim TempButtons
    Dim TempX as Integer, TempY As Integer
    
    GetMouse TempX, TempY, , TempButtons

    If TempButtons And 1 Then
        Mouse.Left = True
    Else
        Mouse.Left = False
        Mouse.LeftUsed = False
    End If
    
    If TempButtons And 2 Then
        
        If Mouse.Right = False Then
            Mouse.Right = True
            Mouse.RightX = TempX
            Mouse.RightY = TempY
        
        End If
    
    ElseIf Mouse.Right = True Then
        OffX -= ( Mouse.RightX - TempX )
        OffY -= ( Mouse.RightY - TempY )
        Mouse.Right = False
    
    End If
    
    
End Sub

Sub DrawCells()
    Dim TempCell
    
    For TempCell = 0 To MaxCells - 1
        
        'if the cell is alive
        If Cell( TempCell ).Alive = True Then
            
            'then draw it using the 0,0 offset
            TempX = Cell( TempCell ).X * Scale + OffX
            TempY = Cell( TempCell ).Y * Scale + OffY
            Line ( TempX , TempY  )-( TempX + Scale - 1 , TempY+ Scale - 1  ), Rgb( &hFF, &hFF, &hFF ), bf
        
        End If
    
    Next TempCell
        
End Sub

Sub ParseRules( argRules As String )
    Dim TempChr As Integer
    Dim TempLiveBirth As Byte
    
    TempLiveBirth = 0
    
    For TempChr = 0 to 7
        Birth( TempChr ) = -1
        Live( TempChr ) = -1
    Next TempChr
        
    For TempChr = 1 To Len( argRules )
    
        If Mid$( argRules, TempChr, 1 ) = "/" Then
            TempLiveBirth = TempChr
        ElseIf TempLiveBirth = 0 Then
            Live( TempChr - 1 ) = Val( Mid$( argRules, TempChr, 1 ) )
        Else
            Birth( TempChr - TempLiveBirth ) = Val( Mid$( argRules, TempChr, 1 ) )
        End If
    
    Next TempChr
        
End Sub
    
        

Function Neighbors( argX As Integer, argY As Integer ) As Byte
    Dim TempCount As Integer
    Dim TempX As Integer, TempY As Integer
    
    TempCount = 0
    
    For TempX = -1 To 1
        For TempY = -1 To 1
            'make sure we aren't checking the original cell
            If Abs( TempX ) + Abs( TempY ) > 0 Then
                If Alive( argX + TempX, argY + TempY ) = True Then TempCount += 1
            End If
            
        Next TempY
    Next TempX
    
    Return TempCount
End Function

Function Alive( argX As Integer, argY As Integer ) As Byte
    Dim TempCell
    
    For TempCell = 0 to MaxCells - 1
        If Cell( TempCell ).X = argX Then
            If Cell( TempCell ).Y = argY Then
                If Cell( TempCell ).Alive = True And Cell( TempCell ).Generation = CurGeneration Then Return True
            End if
        End If
    Next TempCell
    
    Return False
End Function

Function OpenCellSlot() As Integer
    Dim TempCell
    
    For TempCell = 0 To MaxCells - 1
        If Cell( TempCell ).Alive = False Then Return TempCell
    Next TempCell
    
    Return -1 'if no open slots, just stick it in the ignored slot
End Function

Function GoingToBeAlive( argX As Integer, argY As Integer ) As Byte
    Dim TempCell
    
    For TempCell = 0 to MaxCells - 1
        If Cell( TempCell ).X = argX Then
            If Cell( TempCell ).Y = argY Then
                If Cell( TempCell ).Alive = True And Cell( TempCell ).Generation = CurGeneration + 1 Then Return True
            End if
        End If
    Next TempCell
    
    Return False
End Function

[red_Marvin]

That's weird, does it do that with other configs too like 1/1
and one dot?

[Deleter]

yep 1/1 and one dot turns blue, I am supposed to press space after I make the thing right?

[red_Marvin]

Umm to the left there should be the text Mode: Evolution or Mode: Edit.
You change the mode with spacebar and edit is the mode where you can
change the "patterns" (with LMB to make a cell alive and RMB to"kill" it).
If the pattern hasn't changed at all since the last iteration in evolution
mode, the word STABLE should be printed at the bottom of the screen
and the mode should change to edit.
Does this happen?

[Deleter]

I press spacebar once, and it flashed evolution really fast, then turns everything blue, without changing a thing on the configuration. It then goes back to saying edit.

[red_Marvin]

What fbc version are you using? I'm using fbc .13

I also have a new version here with some changes and bugfixes
(But not your's Deleter, I'm completely clueless :-? )

[syntax="qbasic"]'
' Conway's Game of Life by red_Marvin 2005
'
' ATTENTION: Coded for FreeBASIC only!
'
' In the beginning please enter the Life/Birth criteria wich specifies
' when a cell survives and is born. Example: 23/3 (Conway's original
' rules) means that a living cell survives to the next iteration if
' it has two or three neighbours and a dead cell becomes living if
' it has exactly 3 neighbours. If left blank, Conway's original
' rules is used.
'
' Toggle between edit and evolution mode with space bar.
'
' Press c to clear the board during edit mode.
'
' Press left mouse button on the board during edit mode to set a
' cell as alive. Press right mouse button to set a cell as dead.
'
' The board is (theoretically) shaped as a torus which means that cells
' at the edges of the board affect each other.
'
' The colors symbolizes the age of the cell/empty space
' White is a living cell and the colours goes towards yellow as time flows.
' Blue is a dead cell/empty space which goes towards black with time.
'
' Press ESC to quit DUH
'
' *---------------------------------------------------------------------------*
' | |
' | This space is for rent, 50€/month. Contact me at red_Marvin@hotmail.com |
' | |
' *---------------------------------------------------------------------------*
'
option explicit ' I was taught on a programming course that it's always good to
' declare your variables, no mather what. It's also a good place
' to explain what they do if sometimes a little cryptic .

dim world(0 to 2, 0 to 199, 0 to 199) as integer ' The "Map" (2,x,y) is the age.
dim criteria as string ' A "life and death" kind of important variable.
dim div as integer ' The small difference between life and death.
dim life as string ' If the sum of neighbours is in this string it will survive if alive.
dim birth as string ' If the sum of neighbours is in this string it will be born if dead.
dim current as integer ' Points to which part of the world matrix is the one to read from.
dim keytrap as string ' What it says.
dim mx as integer ' Mouse coordinates
dim my as integer ' ^
dim mb as integer ' ^
dim omx as integer ' Old mouse coordinates
dim omy as integer ' ^
dim omb as integer ' ^
dim mc as integer ' Color of the pixel that the mouse pointer overwrites
dim omc as integer ' Old ^
dim x as integer ' Variously used coordinates
dim y as integer ' ^
dim action as integer ' Stops the loop if nothing happened during the iteration
dim wx as integer ' World matrix coordinates
dim wy as integer ' ^
dim rx as integer ' Relative coordinates
dim ry as integer ' ^
dim tx as integer ' Neighbour state test coordinates =(wcoord and rcoord)
dim ty as integer ' merged and checked for out of this world values.
dim neighboursum as integer ' Sum of the cells around the one being checked.
dim actcell as integer ' The state of the currently checked cell.
dim futcell as integer ' The future state of the currently checked cell.
dim iteration as integer ' The number of iterations
dim i as integer ' Uh whatever

screen 14,32,2,1 ' Set up the screen: 320x240 32bpp two pages and fullscreen
setmouse ,,0 ' Hide the default cursor, it's way too clumsy!

windowtitle "Conway's Game of Life by red_Marvin 2005" ' Guess!

' --- Start screen where you enter the life/birth criteria
color &hff00
locate 2,2
print "Conway's Game of Life"
color &hff0000
locate 4,2
print "by red_Marvin 2005"
color &h404040
locate 6,2
print "Please look at the comments at the"
locate 7,2
print "beginning for instructions on how"
locate 8,2
print "to use this program."
locate 10,2
color &hffffff
input "Life/Birth Criteria:",criteria

' --- Dividing of the criteria string into the life/birth strings
div=instr(criteria,"/")
if div=1 then
life=""
birth=right$(criteria,len(criteria)-1)
elseif div>1 then
life=left$(criteria,div-1)
birth=right$(criteria,len(criteria)-div)
else
criteria="23/3"
life="23"
birth="3"
end if

cls

current=0 ' we start reading from the first part of the "map"

' --- Main loop
do
do:keytrap=inkey$:loop until keytrap="" ' To make shure the user releases the key.

screenset 0,0 'I won't do dubble buffering when the mouse is shown, it would be too slow.

color &hffffff ' Make sure the user knows what mode it is. ...and stuff
locate 2,30
print criteria
color &h404040
locate 4,30rint "Mode:"
color &hff00
locate 5,30rint "Edit "
line (0,0)-(201,201),&h404040,b ' Redraw the frame.

' --- The edit loop
do
keytrap=inkey$ ' Oh like you don't know.

locate 27,2 ' Print what iteration it is
color &hffffff
print "Iteration:";iteration;space$(16)

getmouse mx,my,,mb ' Check the mouse coordinates

if mx<>omx or my<>omy or mb<>omb then ' If the mouse status has changed...
pset (omx,omy),omc ' Eradicate the old mouse pixel.
omc=point(mx,my) ' Make sure the new mouse background is saved

' If mouse clicked on the board then put/erase a cell at the place...
if mb=1 and mx>0 and mx<201 and my>0 and my<201 then world(current,mx-1,my-1)=1:world(2,mx-1,my-1)=1:omc=&hffffff
if mb=2 and mx>0 and mx<201 and my>0 and my<201 then world(current,mx-1,my-1)=0:world(2,mx-1,my-1)=0:omc=0

' If the mouse clicked then eradicate all traces of the "STATIC" label.
if mb then locate 28,2: print space$(6)

' V Change mouse pixel color depending on if it's on the board or not.
if mx>0 and mx<201 and my>0 and my<201 then mc=&hff00 else mc=&hff0000

pset (mx,my),mc ' Draw the cursor.

' Move values on the variable conveyor belt
omx=mx
omy=my
omb=mb
end if

if lcase$(keytrap)="c" then ' If ce is pressed then clear the world...
for i=0 to 1
for y=0 to 199 ' Clear the array
for x=0 to 199
world(i,x,y)=0
world(2,x,y)=0
next
next
next

pset (omx,omy),omc ' Eradicate the old mouse pixel.
line (1,1)-(200,200),0,bf ' Clear the visible board.
omc=point(mx,my) ' Make sure the new mouse background is saved
pset (mx,my),mc ' Draw the cursor.

iteration=0 ' Reset the iteration counter and make sure we know it.
locate 27,2
color &hffffff
print "Iteration:";iteration;space$(16)

locate 28,2 ' Eradicate all traces of the "STATIC" label.
print space$(6)

end if

loop until keytrap=chr$(32) or keytrap=chr$(27)

if keytrap=chr$(27) then end ' D U H

do:keytrap=inkey$:loop until keytrap="" ' To make sure the user releases the key.

screenset 1,0 ' Set double buffer mode.

color &hffffff ' Make sure the user knows what mode it is. ...and stuff
locate 2,30
print criteria
color &h404040
locate 4,30rint "Mode:"
color &hff0000
locate 5,30rint "Evolution"
locate 28,2 ' Recognize this? Hmmm. What can it be?
print space$(6)
line (0,0)-(201,201),&h404040,b ' Redraw the frame.

' --- The evolution loop
do
action=0 'Nothing has moved yet, we're in the beginning of the loop DUH

for wy=0 to 199 ' Check every map position...
for wx=0 to 199

neighboursum=0 ' Reset the counter. You're all aloooone Mwahahaaa

for ry=-1 to 1 'Check the neighbours
for rx=-1 to 1
if ry=0 and rx=0 then
actcell=world(current,wx,wy) ' The middle cell
else
tx=wx+rx:if tx>199 then tx=0 else if tx<0 then tx=199 ' Edge merging
ty=wy+ry:if ty>199 then ty=0 else if ty<0 then ty=199
neighboursum=neighboursum+world(current,tx,ty) ' Sum it up
end if
next
next

futcell=0 ' Assume the cell dies. (It does if it doesn't meet the criteria)

'If the neighboursum is in the list...
if instr(life,trim$(str$(neighboursum)))>0 and actcell=1 then 'Surviveal?
futcell=1 ' It survives.
elseif instr(birth,trim$(str$(neighboursum)))>0 and actcell=0 then 'Birth?
futcell=1 ' It is born.
end if

if actcell=futcell then ' If it hasn't changed since last time...
' ...it gets older...
if world(2,wx,wy)<255 and world(2,wx,wy)>0 then world(2,wx,wy)=world(2,wx,wy)+1
else
world(2,wx,wy)=1 ' ...Else reset the age
action=1 ' Oooh movement! Continue iterating...
end if

world(current+1 and 1,wx,wy)=futcell ' Set the state on the map.
select case futcell ' Draw the cell.
case 1
pset(wx+1,wy+1),rgb(255,255,256-world(2,wx,wy))
case 0
pset(wx+1,wy+1),rgb(0,0,256-world(2,wx,wy))
end select

next
next

locate 27,2 ' Show the number of iterations.
color &hffffff
print "Iteration:";iteration;space$(16)

if action=0 then ' Tell if there's no movement
locate 28,2
color &hff0000
print "STATIC" ' <---
end if

wait &h3da,8 ' You want to see what's happening, do'nt you
screencopy

current=current+1 and 1 ' Flip the read/write positions

iteration=iteration+1 ' Add ...whatever the number is to the iteration counter

keytrap=inkey$
loop until keytrap=chr$(32) or keytrap=chr$(27) or action=0 ' Well what did you expect?
loop while keytrap <> chr$(27)[/syntax]