06-10-2025, 02:38 PM
Yep, it worked.
Here is the latest version which finally works the way it should!
There are still some nifty features I would like to add - see "TO DO" comments toward top of code.
Also, there are plenty of interesting things we could try - see "BEYOND SIMPLE CONWAY" comments.
Enjoy
Here is the latest version which finally works the way it should!
There are still some nifty features I would like to add - see "TO DO" comments toward top of code.
Also, there are plenty of interesting things we could try - see "BEYOND SIMPLE CONWAY" comments.
Enjoy
Code: (Select All)
' LIFF v1.02
' BY SOFTINTHEHEADWARE
' A VERSION OF JOHN CONWAY'S GAME OF LIFE
' for more info see https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
' -----------------------------------------------------------------------------
' New in this version
' -----------------------------------------------------------------------------
' * Fixed logic issues, program now works as expected!
' * Fixed population count
' -----------------------------------------------------------------------------
' Instructions
' -----------------------------------------------------------------------------
' 1. Choose whether organisms will be allowed to age.
' Select "n" for classic Conway's Game of Life where organisms don't age,
' or "y" for aging, where organisms are born and grow with each generation,
' and then die of old age after 5 generations.
' 2. Choose whether organisms are placed randomly on the virtual planet.
' 3. If you selected random, enter # of organisms to generate (or 0 to pick a random number).
' The specified number of organisms are added to the virtual planet.
' 4. If you selected NOT random, an editor opens where you place each organism manually.
' a. Use mouse to position the cursor.
' b. Left click to add an organism at the cursor position.
' If aging is enabled, click again to make the organism older.
' c. Right click to remove organism at the cursor position.
' d. Press "r" to randomly add a new organism.
' e. When finished adding organisms, press Escape to begin the simulation.
' 5. The simulation proceeds according to the rules of Conway's Game of Life
' * If a cell / space is empty, and surrounded by 2 or 3 organisms,
' a new organism is born on that space.
' * If a cell is occupied by an organism
' - If the organism has 2 or 3 neighbors, it survives to the next generation.
' - If the organism only has 1 or no neighbors, it dies of loneliness.
' - If the organism has 4 or more neighbors, it dies of overcrowding.
' * Statistics are displayed at the top:
' - current generation #
' - grand total of all organisms ever born / died
' - running total of organisms born & died in the current generation
' - current population
' * The simulation proceeds at 2 generations per second
' - To speed up the simulation, press up or right or + or page up
' - To slow down the simulation, press down or left or - or page down
' * Press the spacebar to pause the simulation, press it again to continue.
' * Press Escape to exit the current simulation.
' * The simulation exits when no organisms are alive or the user presses Escape.
' 6. The final statistics for the simulation are displayed:
' - The final generation number reached
' - Grand total organisms born/died for all generations.
' - Number of births/deaths in the last generation.
' - Final population.
' 7. Select whether to play again. If you choose "y", continue back at 1.
' -----------------------------------------------------------------------------
' Patterns
' -----------------------------------------------------------------------------
' Certain patterns are known to remain stable, repeat / oscillate,
' eventually die, or "move" with each generation ("spaceships").
' Many of these have popular names. Here are the main known patterns:
' .... .... ....
' .OO. --> .OO. --> .OO. --> "Block" = stable
' .OO. .OO. .OO.
' .... .... ....
' .OO.
' O..O <-- "Beehive" = stable
' .OO.
' .OO.
' O..O <-- "Loaf" = stable
' .O O
' ..O.
' OO.
' O.O <-- "Boat" = stable
' .O.
' .O.
' O.O <-- "Tub" = stable
' .O.
' ...OO
' ....O
' ...O. <-- "Canoe" = stable
' O.O..
' OO...
' Some patterns die quickly:
' .... ....
' ..O. ....
' .O.. --> .OO. --> Dies
' .O.. ....
' .... ....
' ..... .....
' ...O. .....
' ..O.. --> ..O.. --> Dies
' .O... .....
' ..... .....
' Some patterns change for several generations and eventually resolve into a stable pattern:
' ...... ...... ...... ......
' .OOO.. ...O.. ..OO.. ..OO..
' .O.... --> ..OO.. --> ..OO.. --> .O..O. --> Stable
' ...... ..O... ..OO.. ..OO..
' ...... ...... ...... ......
' ...... ...... ...... ......
' ..... ..... .....
' ..O.. ..... ..O..
' ..O.. --> .OOO. --> .O.O. --> Stable
' ..O.. .OOO. .O.O.
' ..O.. ..... ..O..
' ..... ..... .....
' ...... ......
' ...O.. ..OO..
' .OO... --> .O..O. --> Stable
' ..O... .O..O.
' ...... ..OO..
' ...... ......
' Some patterns oscillate back and forth:
' ..... .....
' ..O.. .....
' ..O.. --> .OOO. --> "Blinker" oscillates
' ..O.. .....
' ..... .....
' ..O.
' O..O --> "Toad" (phase 2) oscillates
' O..O
' .O..
' OO..
' OO.. --> "Beacon" (phase 2) oscillates
' ..OO
' ..OO
' ..OOO...OOO..
' .............
' O....O.O....O
' O....O.O....O
' O....O.O....O
' ..OOO...OOO.. --> "Pulsar" (phase 3) oscillates
' .............
' ..OOO...OOO..
' O....O.O....O
' O....O.O....O
' O....O.O....O
' .............
' ..OOO...OOO..
' ...OOO...
' ..O...O..
' .O.....O.
' .........
' O.......O --> "Penta-decathalon" (phase 15) oscillates
' O.......O
' .........
' .O.....O.
' ..O...O..
' ...OOO...
' .........
' ...O.O...
' .OOO.OOO.
' O...O...O
' O.O...O.O --> "Cloverleaf" oscillates
' .OO.O.OO.
' O.O...O.O
' O...O...O
' .OOO.OOO.
' ...O.O...
' ........... ........... ...........
' ........... .....O..... ....OOO....
' ........... .....O..... ...........
' ........... .....O..... ..O.....O..
' .....O..... --> (TBD) --> ........... ..O.....O.. --> Repeats / oscillates
' ....OOO.... .OOO...OOO. ..O.....O..
' ........... ........... ...........
' ........... .....O..... ....OOO....
' ........... .....O..... ...........
' ........... .....O..... ...........
' ........... ........... ...........
' ......... ......... ....O....
' ......... ...OOO... ...OOO...
' ..OOOOO.. ..O...O.. ..OOOOO..
' ..OOOOO.. .O.....O. .OO...OO.
' ..OOOOO.. --> .O.....O. --> OOO...OOO --> oscillates
' ..OOOOO.. .O.....O. .OO...OO.
' ..OOOOO.. ..O...O.. ..OOOOO..
' ......... ...OOO... ...OOO...
' ......... ......... ....O....
' ............... ............... ...............
' ............... ............... ...............
' ............... .......O....... ......OOO......
' ......OOO...... ......OOO...... .....O...O.....
' .....O...O..... .....OOOOO..... .....O...O.....
' ....O.....O.... ....O.....O.... ...OO.....OO...
' ...O...O...O... ...OO..O..OO... ..O....O.....O.
' ...O..O.O..O... --> ..OOO.O.O.OOO.. --> ..O...O.O....O. --> oscillates
' ...O...O...O... ...OO..O..OO... ..O....O.....O.
' ....O.....O.... ....O.....O.... ...OO.....OO...
' .....O...O..... .....OOOOO..... .....O...O.....
' ......OOO...... ......OOO...... .....O...O.....
' ............... .......O....... ......OOO......
' ............... ............... ...............
' ............... ............... ...............
' ............... ............... .......O.......
' .......O....... ......OOO...... .......O.......
' ......OOO...... ............... ...............
' .....O.O.O..... .....O.O.O..... .....O.O.O.....
' .....O...O..... .....OO.OO..... .....OOOOO.....
' ...OO.....OO... ...OO.....OO... ...OO.OOO.OO...
' ..O....O....O.. .O..O..O..O..O. ....OO.O.OO....
' .OOO..O.O..OOO. --> .O.O..O.O..O.O. --> OO.OOOO.OOOO.OO --> oscillates
' ..O....O....O.. .O..O..O..O..O. ....OO.O.OO....
' ...OO....OO.... ...OO.....OO... ...OO.OOO.OO...
' .....O...O..... .....OO.OO..... .....OOOOO.....
' .....O.O.O..... .....O.O.O..... .....O.O.O.....
' ......OOO...... ............... ...............
' .......O....... ......OOO...... .......O.......
' ............... ............... .......O.......
' ............... ............... ...............
' ............... ............... .......O.......
' ......O.O...... ......OOO...... ......O.O......
' .....O.O.O..... ......OOO...... ......O.O......
' ............... ............... .......O.......
' ...O.......O... ............... ...............
' ..O.........O.. ..OO.......OO.. ..OO.......OO.. --> oscillates
' ...O.......O... --> ..OO.......OO.. --> .O..O.....O..O.
' ..O.........O.. ..OO.......OO.. ..OO.......OO..
' ...O.......O... ............... ...............
' ............... ............... .......O.......
' .....O.O.O..... ......OOO...... ......O.O......
' ......O.O...... ......OOO...... ......O.O......
' ............... ............... .......O.......
' ............... ............... ...............
' Some patterns oscillate in such a way that they "move" around the world
' with each generation. These are called "spaceships":
' ..O
' O.O <-- "Glider" spaceship
' .OO
' .OOOO
' O...O <-- "Lightweight spaceship (LWSS)"
' ....O
' O..O.
' ..O...
' O...O.
' .....O <- "Middleweight spaceship (MWSS)"
' O....O
' .OOOOO
' ..OO...
' O....O.
' ......O <-- "Heavyweight spaceship (HWSS)"
' O.....O
' .OOOOOO
' OOOOO.............
' O....O.......OO...
' O...........OO.OOO
' .O.........OO.OOOO
' ...OO...OO.OO..OO.
' .....O....O..O....
' ......O.O.O.O.....
' .......O.......... <-- "Hammerhead" spaceship
' .......O..........
' ......O.O.O.O.....
' .....O....O..O....
' ...OO...OO.OO..OO.
' .O.........OO.OOOO
' O...........OO.OOO
' O....O.......OO...
' OOOOO.............
' Some patterns continue for several generations but ultimately die:
' ...... ...... ...... ...... ......
' ...... ..OO.. .OO... ..O... ......
' .O.... --> ..OO.. --> ...O.. --> ...O.. --> ..OO.. --> Death
' ..OOO. ...O.. .OO... ..O... ......
' ...... ...... ...... ...... ......
' ...... ...... ...... ...... ......
' Other patterns:
' .....
' ..O..
' .O.O. "Tub"
' ..O..
' .....
' .....
' ..O..
' .O.O. "Boat"
' ..OO.
' .....
' ......
' .O.OO. "Snake"
' .OO.O.
' ......
' ......
' ......
' ..OO..
' ..O.O. "Ship"
' ...OO.
' ......
' ......
' .OO...
' .O..O. "Aircraft carrier"
' ...OO.
' ......
' ......
' ..OO..
' .O..O. "Beehive"
' ..OO..
' ......
' ......
' ..O...
' .O.O.. "Barge"
' ..O.O.
' ...O..
' ......
' .......
' .......
' ....OO. "Python"
' .O.O.O.
' .OO....
' .......
' .......
' ..O....
' .O.O... "Long boat"
' ..O..O.
' ....OO.
' .......
' ......
' .OO...
' .O.O.. "Eater", "Fish hook"
' ...O..
' ...OO.
' ......
' .......
' ..OOO..
' .......
'
' ...........
' ....OOO....
' ...........
' ..O.....O..
' ..O.....O..
' ..O.....O..
' ...........
' ....OOO....
'
' .......
' ..OOO..
' ..O....
' ...O...
' .......
' -----------------------------------------------------------------------------
' TO DO
' -----------------------------------------------------------------------------
' * add macro keys to editor to automatically draw given patterns at the cursor position
' * add option to select how many generations organisms live before dying of old age
' * option detect when the world is stuck in an endlessly repeating pattern (upto n frames) and exit
' * bigger 32-bit hires screen, more cells
' * show statistics on how many survived to what age, cause of death, etc.
' * save/playback history of a world
' * editor ability to save / load a given generation or start pattern
' * pause at any generation and edit or step back/forward
' * add keyboard option back to editor
' -----------------------------------------------------------------------------
' BEYOND SIMPLE CONWAY
' -----------------------------------------------------------------------------
' Future challenge = expand to other types of organisms, environment,
' ecosystem, evolution?
'
' Including parameters for
' * food
' * different species or creature types that make up a food chain
' - animals vs plants vs microscopic life
' - predators vs prey
' - parasites
' - algae, plankton
' - plants drop seeds to reproduce, need water, seek light
' - single cell creatures divide to reproduce
' - complex animals mate to reproduce
' - larger animals eat smaller / simpler
' * attributes
' - fuel / energy
' - health / "hit points"
' - strength
' - speed
' - eyesight or other senses
' - (attributes where a high score balances out by making another attribute low)
' * evolving behavior
' * reproduction passes on traits / mutations (simple genetics)
' * weather
' * terrain
' * excretion of waste / disease
' * ecosystem
' * mating behavior / selection / competition
' * track an individual organism's DNA or "heritage"
' DECLARE CONSTANTS
Const cMinCount = 1
Const cMaxCount = 529
Const cKeyDelay = 5
' Codes for reading keypresses with _BUTTON
Const KeyCode_Escape = 2
Const KeyCode_Spacebar = 58
Const KeyCode_0 = 12
Const KeyCode_1 = 3
Const KeyCode_2 = 4
Const KeyCode_3 = 5
Const KeyCode_4 = 6
Const KeyCode_5 = 7
Const KeyCode_6 = 8
Const KeyCode_7 = 9
Const KeyCode_8 = 10
Const KeyCode_9 = 11
Const KeyCode_A = 31
Const KeyCode_B = 49
Const KeyCode_C = 47
Const KeyCode_D = 33
Const KeyCode_E = 19
Const KeyCode_F = 34
Const KeyCode_G = 35
Const KeyCode_H = 36
Const KeyCode_I = 24
Const KeyCode_J = 37
Const KeyCode_K = 38
Const KeyCode_L = 39
Const KeyCode_M = 51
Const KeyCode_N = 50
Const KeyCode_O = 25
Const KeyCode_P = 26
Const KeyCode_Q = 17
Const KeyCode_R = 20
Const KeyCode_S = 32
Const KeyCode_T = 21
Const KeyCode_U = 23
Const KeyCode_V = 48
Const KeyCode_W = 18
Const KeyCode_X = 46
Const KeyCode_Y = 22
Const KeyCode_Z = 45
Const KeyCode_Up = 329
Const KeyCode_Down = 337
Const KeyCode_Left = 332
Const KeyCode_Right = 334
Const KeyCode_Minus = 13
Const KeyCode_Equal = 14
Const KeyCode_BkSp = 15
Const KeyCode_Ins = 339
Const KeyCode_Del = 340
Const KeyCode_Home = 328
Const KeyCode_End = 336
Const KeyCode_PgUp = 330
Const KeyCode_PgDn = 338
Const KeyCode_BracketLeft = 27
Const KeyCode_BracketRight = 28
Const KeyCode_CtrlRight = 286
Const KeyCode_Enter = 29
' COLOR CODES FOR PRINTING TEXT
Const cBlackT = 0
Const cBlueT = 1
Const cGreenT = 2
Const cLtBlueT = 3
Const cRedT = 4
Const cPurpleT = 5
Const cOrangeT = 6
Const cWhiteT = 7
Const cGrayT = 8
Const cPeriwinkleT = 9
Const cLtGreenT = 10
Const cCyanT = 11
Const cLtRedT = 12
Const cPinkT = 13
Const cYellowT = 14
Const cLtGrayT = 15
' START THE MAIN ROUTINE
Liff
' FINISHED, EXIT PROGRAM
System
' /////////////////////////////////////////////////////////////////////////////
Sub Liff
' DECLARE VARIABLES
Dim RoutineName As String: RoutineName = "Liff"
ReDim org%(0, 0, 0) ' array(column, row, generation)
Dim popu As Long
Dim a$
Dim r$
Dim iCount As Long
Dim ax, ay As Integer
Dim axOld, ayOld As Integer
Dim MinCol, MaxCol, MinRow, MaxRow As Integer
Dim MaxOrgs As Long
Dim k$
Dim gen As Long
Dim sLine As String
Dim CountPos As Integer
Dim born As Long
Dim died As Long
Dim lived As Long
Dim gone As Long
Dim family As Long
Dim North As Integer
Dim South As Integer
Dim East As Integer
Dim West As Integer
Dim age As Integer
Dim speed As Long
Dim bLeftClick As Integer
Dim bRightClick As Integer
Dim bOldLeftClick As Integer
Dim bOldRightClick As Integer
Dim arrKeyState(0 To 512) As Integer
Dim bAdded As Integer
Dim MaxAge As Integer
Dim reason$
' MAIN LOOP
Do
' INITIALIZE
Randomize Timer ' always put this at the start of a program that uses random numbers
MinRow = 1
MaxRow = _Height - 2 ' # of rows available (minus 2 rows which we use to show instructions)
MinCol = 1
MaxCol = _Width ' # of columns on the screen
ReDim org%(MinCol To MaxCol, MinRow To MaxRow, 1 To 2) ' set size of array
MaxOrgs = MaxCol * MaxRow ' what's the most # of organisms that can fit on the screen?
bLeftClick = _FALSE: bOldLeftClick = _FALSE
bRightClick = _FALSE: bOldRightClick = _FALSE
For iCount = LBound(arrKeyState) To UBound(arrKeyState)
arrKeyState(iCount) = _FALSE
Next iCount
reason$ = "TBD"
' SHOW TITLE
Cls , cBlackT ' clear screen and make it black
Color cLtGreenT, cBlackT ' set print color to light green on black
Print
Print " # ### ### ###"
Print " # # # #"
Print " # # ## ###"
Print " # # # #"
Print " ### ### # ###"
Print
Color cWhiteT, cBlackT ' set print color to white on black
' ASK USER TO ENTER PREFERENCES...
' PLACE RANDOMLY?
Do
Input "Allow organisms to age (y/n)"; a$
a$ = _Trim$(a$) ' remove extra spaces
a$ = LCase$(a$) ' force to lowercase
If a$ <> "y" And a$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until a$ = "y" Or a$ = "n"
If a$ = "y" Then MaxAge = 5 Else MaxAge = 1
' PLACE RANDOMLY?
Do
Input "Place the organisms randomly (y/n)"; r$
r$ = _Trim$(r$) ' remove extra spaces
r$ = LCase$(r$) ' force to lowercase
If r$ <> "y" And r$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until r$ = "y" Or r$ = "n"
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 1
' IF RANDOMLY, THEN HOW MANY?
If r$ = "y" Then
Do
Print "How many organisms (1-" + _ToStr$(MaxOrgs) + ", or 0 for random)"
Input popu
If popu >= 1 Or popu <= MaxOrgs Then
' User selected a valid number
Exit Do ' stop asking (exit the do loop)
ElseIf popu = 0 Then
' Select a random number of organisms to make
popu = RandomNumber%(1, MaxOrgs)
Else
' Value is not valid, let the user know and keep asking
Print "*** Value out of range. Type a number 1-" + _ToStr$(MaxOrgs) + ". ***"
End If
Loop
Print
Print "Simulation will proceed with " + _ToStr$(popu) + " organisms."
Print
End If
' INITIALIZE ORGANISM ARAY
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
org%(ax, ay, 2) = 0 ' 2 is the next generation
Next ax
Next ay
' PLACE ORGANISMS
Cls
If r$ = "y" Then
' PLACE EACH ORGANISM RANDOMLY...
For iCount = 1 To popu
bAdded = PlaceRandomOrganism%(org%(), 2, MaxAge)
Next iCount
ElseIf r$ = "n" Then
' MANUALLY PLACE ORGANISMS...
' SHOW INSTRUCTIONS
Color cYellowT, cBlackT ' set print color to yellow on black
sLine = "Mouse selects location. Left click & right click to add/remove organisms."
Locate 1, 1: Print sLine;
sLine = "Press R to add randomly. Escape starts simulation. Population: "
Locate 2, 1: Print sLine;
CountPos = Len(sLine) + 1
' SHOW SCREEN AS A GRID TO HELP PLACEMENT
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
DrawOrganism org%(), ax, ay, 2, GetBgColor%(ax, ay), GetBgColor%(ax, ay), MaxAge
Next ax
Next ay
' RESET COUNT
popu = 0 ' no organisms placed yet
' PLACE CURSOR AT TOP LEFT
ax = MinCol: axOld = ax ' MaxCol
ay = MinRow: ayOld = ay ' MaxRow
' HIDE MOUSE POINTER
_MouseHide
' LOOP UNTIL USER HAS FINISH PLACING ORGANISMS
' array and mouse coordinates (ax, ay, axOld, ayOld) are 1-based
' drawing on screen starting at row 3, so ay+2
Do
' ERASE OLD
If axOld <> ax Or ayOld <> ay Then
DrawOrganism org%(), axOld, ayOld, 2, cGreenT, GetBgColor%(axOld, ayOld), MaxAge
End If
' Draw cursor at current location
DrawOrganism org%(), ax, ay, 2, GetBgColor%(ax, ay), cGreenT, MaxAge
' RESET OLD
axOld = ax
ayOld = ay
' READ MOUSE
Do While _MouseInput: Loop
ax = _MouseX
ay = _MouseY
bLeftClick = _MouseButton(1)
bRightClick = _MouseButton(2)
' VERSION FOR HI-RES SCREEN:
'ax = (_MouseX \ _FontWidth) * _FontWidth
'ay = (_MouseY \ _FontHeight) * _FontHeight
' CHECK BOUNDARIES
If ax < MinCol Then ax = MinCol Else If ax > MaxCol Then ax = MaxCol
If ay < MinRow Then ay = MinRow Else If ay > MaxRow Then ay = MaxRow
'If ax < 1 Then ax = 1 Else If ax > _Width Then ax = _Width
'If ay < 1 Then ay = 1 Else If ay > _Height Then ay = _Height
' DID THEY CLICK?
If bLeftClick Then
If bOldLeftClick = _FALSE Then
If org%(ax, ay, 2) = 0 Then popu = popu + 1
org%(ax, ay, 2) = org%(ax, ay, 2) + 1
If org%(ax, ay, 2) > MaxAge Then org%(ax, ay, 2) = 1
bOldLeftClick = _TRUE
End If
Else
bOldLeftClick = _FALSE
End If
If bRightClick Then
If bOldRightClick = _FALSE Then
If org%(ax, ay, 2) > 0 Then popu = popu - 1
org%(ax, ay, 2) = 0
bOldRightClick = _TRUE
End If
Else
bOldRightClick = _FALSE
End If
' Read keyboard
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
' DON'T ACCEPT ANY MORE INPUT UNTIL THE LAST PRESSED KEY IS RELEASED
If _Button(KeyCode_R) = _TRUE Then
If arrKeyState(KeyCode_R) = _FALSE Then
arrKeyState(KeyCode_R) = _TRUE
' TRY TO RANDOMLY PLACE AN ORGANISM
If PlaceRandomOrganism(org%(), 2, MaxAge) = _TRUE Then
popu = popu + 1
Else
' PlaceRandomOrganism returned _FALSE
' so we are full, exit edit mode
Exit Do
End If
End If
Else
arrKeyState(KeyCode_R) = _FALSE
End If
' Check which keys were pressed
If _Button(KeyCode_Escape) = _TRUE Then
' Exit edit mode
Exit Do
End If
' SHOW POPULATION
Color cLtGreenT, cBlackT
Locate 2, CountPos: Print _ToStr$(popu) + " ";
' Govern speed of loop to 60 frames per second:
_Limit 60
Loop Until _KeyDown(27) ' escape key exit
' RESTORE MOUSE
_MouseShow "default": _Delay 0.5
' CLEAR KEYBOARD BUFFER
_KeyClear
End If
' THE CYCLE OF LIFE
speed = 2
gen = 0
lived = popu ' total that ever lived
gone = 0 ' total that have ever died
Do
Cls
gen = gen + 1 ' INCREASE GENERATION
' SHOW GENERATION
Color cYellowT, cBlackT
Locate 1, 1: Print "Generation: " + _ToStr$(gen);
' SHOW TOTAL THAT EVER LIVED
Color cLtGreenT, cBlackT
Locate 1, 25: Print "Total ever born: " + _ToStr$(lived);
' SHOW TOTAL THAT EVER DIED
Color cLtGrayT, cBlackT
Locate 1, 50: Print "Total ever died: " + _ToStr$(gone);
' SHOW BIRTHS
Color cCyanT, cBlackT
Locate 2, 1: Print "Births: " + _ToStr$(born) + " ";
' SHOW DEATHS
Color cPurpleT, cBlackT
Locate 2, 25: Print "Deaths: " + _ToStr$(died) + " ";
' SHOW POPULATION
Color cLtGreenT, cBlackT
Locate 2, 50: Print "Population: " + _ToStr$(popu) + " ";
' RESET THIS GENERATION'S STATISTICS
born = 0
died = 0
' SETUP FOR NEXT ROUND
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
' COPY NEXT GENERATION TO CURRENT
org%(ax, ay, 1) = org%(ax, ay, 2)
' AND DRAW THE NEXT ORGANISM
DrawOrganism org%(), ax, ay, 1, cGreenT, cBlackT, MaxAge
Next ax
Next ay
' BORN, LIVE, DIE
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
' COUNT NEIGHBORS
family = 0
' GET NEIGHBORS' POSITIONS
' WRAP AROUND THE EDGES (THE WORLD IS ROUND!)
If ax = MinCol Then
West = MaxCol
East = ax + 1
ElseIf ax = MaxCol Then
West = ax - 1
East = MinCol
Else
West = ax - 1
East = ax + 1
End If
If ay = MinRow Then
North = MaxRow
South = ay + 1
ElseIf ay = MaxRow Then
North = ay - 1
South = MinRow
Else
North = ay - 1
South = ay + 1
End If
' Check NW neighbor
If org%(West, North, 1) > 0 Then family = family + 1
' Check N neighbor
If org%(ax, North, 1) > 0 Then family = family + 1
' Check NE neighbor
If org%(East, North, 1) > 0 Then family = family + 1
' Check W neighbor
If org%(West, ay, 1) > 0 Then family = family + 1
' Check E neighbor
If org%(East, ay, 1) > 0 Then family = family + 1
' Check SW neighbor
If org%(West, South, 1) > 0 Then family = family + 1
' Check S neighbor
If org%(ax, South, 1) > 0 Then family = family + 1
' Check SE neighbor
If org%(East, South, 1) > 0 Then family = family + 1
' SEE WHO LIVES / DIES / IS BORN
' look at current generation (x, y, 1)
' to update next generation (x, y, 2)
If org%(ax, ay, 1) = 0 Then
' REPRODUCTION?
If family = 3 Then
' BIRTH
org%(ax, ay, 2) = 1
popu = popu + 1 ' ** POPULATION INCREASES BY 1 **
born = born + 1 ' INCREASE COUNT BORN THIS GENERATION
lived = lived + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER BORN
End If
ElseIf org%(ax, ay, 1) > 0 Then
' LIVE OR DIE?
If family < 2 Then
' DIED OF LONELINESS
org%(ax, ay, 2) = 0
popu = popu - 1 ' ** POPULATION DECREASES BY 1 **
died = died + 1 ' INCREASE COUNT DIED THIS GENERATION
gone = gone + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER DIED
ElseIf family > 3 Then
' DIED OF OVERCROWDING
org%(ax, ay, 2) = 0
popu = popu - 1 ' ** POPULATION DECREASES BY 1 **
died = died + 1 ' INCREASE COUNT DIED THIS GENERATION
gone = gone + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER DIED
ElseIf family = 2 Or family = 3 Then
' LIFE GOES ON
If MaxAge > 1 Then
' AGING! 1 = newborn, 5 = maximum age
org%(ax, ay, 2) = org%(ax, ay, 2) + 1
' DIED OF OLD AGE
If org%(ax, ay, 2) > 5 Then
' DIED OF OLD AGE
org%(ax, ay, 2) = 0
popu = popu - 1 ' ** POPULATION DECREASES BY 1 **
died = died + 1 ' INCREASE COUNT DIED THIS GENERATION
gone = gone + 1 ' INCREASE COUNT OF ALL ORGANISMS EVER DIED
End If
End If
End If
End If
' REFRESH SCREEN
_Display
Next ax
Next ay
' RE-COUNT POPULATION (BRUTE FORCE METHOD, SINCE NORMAL METHODS DON'T SEEM TO WORK WHEN AGING IS ENABLED)
popu = 0
For ay = MinRow To MaxRow
For ax = MinCol To MaxCol
If org%(ax, ay, 2) > 0 Then
popu = popu + 1
End If
Next ax
Next ay
' If population falls to zero then exit
If popu < 1 Then reason$ = "no organisms survived": Exit Do
' PROCESS KEYBOARD INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
If _Button(KeyCode_Escape) Then
' ESCAPE = EXIT
reason$ = "cancelled": Exit Do
ElseIf _Button(KeyCode_Spacebar) Then
' SPACEBAR = PAUSE
Color cBlackT, cWhiteT
Locate 1, 1: Print "PAUSED - PRESS ANY KEY TO CONTINUE";
_Display
_KeyClear: _Delay 1
Sleep
_KeyClear: _Delay 1
Color cWhiteT, cBlackT
Locate 1, 1: Print " ";
ElseIf _Button(KeyCode_Equal) Or _Button(KeyCode_Right) Or _Button(KeyCode_Up) Or _Button(KeyCode_PgUp) Then
' + OR RIGHT ARROW OR UP ARROW OR PAGE UP = INCREASE SPEED
speed = speed + 1
If speed > 1000 Then speed = 1000
ElseIf _Button(KeyCode_Minus) Or _Button(KeyCode_Left) Or _Button(KeyCode_Down) Or _Button(KeyCode_PgDn) Then
' - OR LEFT ARROW OR DOWN ARROW OR PAGE DOWN = SLOW DOWN
speed = speed - 1
If speed < 1 Then speed = 1
End If
' CLEAR KEYBOARD BUFFER
_KeyClear
' increment generation counter
gen = gen + 1
' REFRESH SCREEN
_Display
' LIMIT TO 2 GENERATIONS / SECOND
_Limit speed
Loop
' RESTORE NORMAL SCREEN REFRESH
_AutoDisplay
' CLEAR KEYBOARD BUFFER
_KeyClear: _Delay 1
' PLAY AGAIN?
Cls
Color cWhiteT, cBlackT
Print "SIMULATION OVER (" + reason$ + ")."
Print
' SHOW FINAL STATS
Print "Final statistics:"
Color cYellowT, cBlackT: Print "Generation : " + _ToStr$(gen)
Color cLtGreenT, cBlackT: Print "Total ever born : " + _ToStr$(lived)
Color cLtGrayT, cBlackT: Print "Total ever died : " + _ToStr$(gone)
Color cCyanT, cBlackT: Print "Last generation births: " + _ToStr$(born)
Color cPurpleT, cBlackT: Print "Last generation Deaths: " + _ToStr$(died)
Color cLtGreenT, cBlackT: Print "Final population : " + _ToStr$(popu)
Print
Color cWhiteT, cBlackT
Do
Input "Start over and try again (y/n)"; a$
a$ = _Trim$(a$) ' remove extra spaces
a$ = LCase$(a$) ' force to lowercase
If a$ <> "y" And a$ <> "n" Then
Print "*** Please type y or n ***"
End If
Loop Until a$ = "y" Or a$ = "n"
If a$ = "n" Then Exit Do
Loop
End Sub ' Life
' /////////////////////////////////////////////////////////////////////////////
Function GetBgColor% (ax%, ay%)
If IsOdd%(ay%) Then
If IsOdd%(ax%) Then
GetBgColor% = cBlackT
Else
GetBgColor% = cGrayT
End If
Else
If IsOdd%(ax%) Then
GetBgColor% = cGrayT
Else
GetBgColor% = cBlackT
End If
End If
End Function ' GetBgColor%
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if an organism was placed
' only should return _FALSE if no more empty spaces
Function PlaceRandomOrganism% (org%(), gen%, MaxAge%)
Dim bResult As Integer
Dim MinCol, MaxCol As Integer
Dim MinRow, MaxRow As Integer
Dim age As Integer
Dim ax, ay As Integer
Dim dx, dy As Integer
Dim iCount As Integer
Dim iMax As Integer
' Initialize
MinCol = LBound(org%, 1)
MaxCol = UBound(org%, 1)
MinRow = LBound(org%, 2)
MaxRow = UBound(org%, 2)
' Calculate maximum possible count
dx = 1 - MinCol
dy = 1 - MinRow
iMax = (MaxCol + dx) * (MaxRow + dy)
' Count # currently present
iCount = 0
For ax = MinCol To MaxCol
For ay = MinRow To MaxRow
If org%(ax, ay, gen%) > 0 Then iCount = iCount + 1
Next ay
Next ax
' If room for more, place one randomly
bResult = (iCount < iMax)
If bResult = _TRUE Then
' KEEP LOOKING FOR A RANDOM UNOCCUPIED LOCATION
Do
ax = RandomNumber%(MinCol, MaxCol) ' SELECT A RANDOM COLUMN
ay = RandomNumber%(MinRow, MaxRow) ' SELECT A RANDOM ROW
' MAKE SURE IT'S NOT ALREADY OCCUPIED
If org%(ax, ay, gen%) = 0 Then
age = RandomNumber%(1, MaxAge%)
org%(ax, ay, gen%) = age
DrawOrganism org%(), ax, ay, gen%, cGreenT, cBlackT, MaxAge%
Exit Do ' break out of loop and move on to the next organism
End If
Loop
End If
' Return result
PlaceRandomOrganism = bResult
End Function ' PlaceRandomOrganism
' /////////////////////////////////////////////////////////////////////////////
Sub DrawOrganism (org%(), ax%, ay%, gen%, fgColor%, bgColor%, MaxAge%)
Color fgColor%, bgColor%
Locate ay% + 2, ax%
Print GetOrganism$(org%(ax%, ay%, gen%), MaxAge%);
End Sub ' DrawOrganism
' /////////////////////////////////////////////////////////////////////////////
' Return different picture based on age:
' 1 = [.] = newborn
' 2 = [o] = kid
' 3 = [O] = fully grown
' 4 = [0] = old!
' 5 = [@] = really old!
Function GetOrganism$ (age%, MaxAge%)
Dim org$
If MaxAge% > 1 Then
Select Case age%
Case 1:
org$ = "."
Case 2:
org$ = "o"
Case 3:
org$ = "O"
Case 4:
org$ = "0"
Case 5:
org$ = "@"
Case Else:
org$ = " "
End Select
Else
If age% > 0 Then
'org$ = "O"
org$ = Chr$(177)
Else
org$ = " "
End If
End If
GetOrganism$ = org$
End Function ' GetOrganism
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max inclusive.
' Make sure you put Randomize Timer at the start of your program
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
' Use to pretty print _TRUE and _FALSE values.
Function TrueFalse$ (myValue%)
TrueFalse$ = _IIf(myValue%, "_TRUE", "_FALSE")
End Function ' TrueFalse$
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if number n is even
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
Function IsEven% (n)
If n Mod 2 = 0 Then
IsEven% = _TRUE
Else
IsEven% = _FALSE
End If
End Function ' IsEven%
' /////////////////////////////////////////////////////////////////////////////
' Returns _TRUE if number n is odd
' https://slaystudy.com/qbasic-program-to-check-if-number-is-even-or-odd/
Function IsOdd% (n)
If n Mod 2 = 1 Then
IsOdd% = _TRUE
Else
IsOdd% = _FALSE
End If
End Function ' IsOdd%