Life

[bplus]

Wow that video covers allot! And Pete be glad to know that math is Not Perfect, so they say, a hole?

Anyway been a fan of Conway's Life since early 90's with GW Basic. Use to write a variation with every new PL update.

Here is a favorite if you like colorful symmetric patterns that seem endless, Mandala Life:

Code: (Select All)

_Title "Mandala Life trans for QB64 11-06.82  2017-11-11 by bplus"
' From: quick life.bas SmallBASIC (not MS) B+ G7 stripped down to favorite setting
'
' To: the one out there who has checked out Conway's Life the last couple of days.
' For you, a working version (albeit highly modified) of Conway's Life code in QB64.
'
' Quote Rules (from Wiki):
' The universe of the Game of Life is an infinite two-dimensional orthogonal grid of square cells,
' each of which is in one of two possible states, alive or dead, or "populated" or "unpopulated".
' Every cell interacts with its eight neighbours, which are the cells that are horizontally,
' vertically, or diagonally adjacent. At each step in time, the following transitions occur:
' 1) Any live cell with fewer than two live neighbours dies, as if caused by underpopulation.
' 2) Any live cell with two or three live neighbours lives on to the next generation.
' 3) Any live cell with more than three live neighbours dies, as if by overpopulation.
' 4) Any dead cell with exactly three live neighbours becomes a live cell, as if by reproduction.
' The initial pattern constitutes the seed of the system.
' The first generation is created by applying the above rules simultaneously to every cell in the
' seed—births and deaths occur simultaneously, and the discrete moment at which this happens is
' sometimes called a tick (in other words, each generation is a pure function of the preceding one).
' The rules continue to be applied repeatedly to create further generations.
' (End Quote)

' Alas in practical applications we do not have infinite board to play Life, so at boundries rules
' break down as neighbor counts are only 5 max on edge and only 3 max at corners.

'This code is very easy to modify into other tests / demos:
' Try coloring by neighbor counts.
' Try other rules besides Classic 2,3 neighbors = survive, 3 neighbors = birth.
' Try regenration along the borders every other generation, which causes symetric beauties!
' Change an = the number of cells per side, even amounts that divide 700 (pixels per board side) work best.

Const xmax = 700
Const ymax = 700

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 20

'DEFINT A-Z
Dim qb&(15) 'thanks Andy Amaya for use with his sub qColor fore, back
qb&(0) = _RGB(0, 0, 0) '       black
qb&(1) = _RGB(0, 0, 128) '     blue
qb&(2) = _RGB(8, 128, 8) '     green
qb&(3) = _RGB(0, 128, 128) '   cyan
qb&(4) = _RGB(128, 0, 0) '     red
qb&(5) = _RGB(128, 0, 128) '   magenta
qb&(6) = _RGB(128, 64, 32) '   brown
qb&(7) = _RGB(168, 168, 168) ' white
qb&(8) = _RGB(128, 128, 128) ' grey
qb&(9) = _RGB(84, 84, 252) '   light blue
qb&(10) = _RGB(42, 252, 42) '  light green
qb&(11) = _RGB(0, 220, 220) '  light cyan
qb&(12) = _RGB(255, 0, 0) '    light red
qb&(13) = _RGB(255, 84, 255) ' light magenta
qb&(14) = _RGB(255, 255, 0) '  yellow
qb&(15) = _RGB(255, 255, 255) 'bright white

'test colors
'FOR i = 0 TO 15
'    PRINT i,
'    LINE (100, 100)-(500, 500), qb&(i), BF
'    _LIMIT 1
'NEXT

an = 140: s = Int(ymax / an): bigBlock = an * s: g = 0
Dim a(1 To an, 1 To an), ng(1 To an, 1 To an), ls(1 To an, 1 To an)

'seed for Conway's Life Classic
'FOR y = 2 TO an - 1
'    FOR x = 2 TO an - 1

'        ' a(x, y) = INT(RND * 2)  'for random mess

'        'for symmetric line
'        IF y = an / 2 OR y = an / 2 + 1 THEN a(x, y) = 1

'    NEXT
'NEXT

While InKey$ <> " "

    ' Mandala Life regeneration of Mandala like arrays, seeds every other generation along edges
    If g Mod 2 = 0 Then
        For x = 1 To an
            a(x, 1) = 1: a(x, an) = 1: a(1, x) = 1: a(an, x) = 1
        Next
    End If

    For x = 2 To an - 1
        For y = 2 To an - 1
            pc = a(x - 1, y - 1) + a(x - 1, y) + a(x - 1, y + 1) + a(x, y - 1) + a(x, y + 1) + a(x + 1, y - 1) + a(x + 1, y) + a(x + 1, y + 1)
            ls(x, y) = pc
            r$ = Right$(Str$(pc), 1)
            If a(x, y) Then 'cell is alive so what is surviveRule

                'Bplus favorite Mandala Life Rules for survival and birth
                If InStr("2346", r$) Then ng(x, y) = 1 Else ng(x, y) = 0

                'Classic Conway's Life Rules
                'IF INSTR("23", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0

            Else 'birth?

                'Bplus favorite Mandala Life Rules for survival and birth
                If InStr("34", r$) Then ng(x, y) = 1 Else ng(x, y) = 0

                'Classic Conway's Life Rules
                'IF INSTR("3", r$) THEN ng(x, y) = 1 ELSE ng(x, y) = 0
            End If
        Next
    Next

    'Bplus favorite Mandala Life Rules for survival and birth
    Line (1, 1)-(bigBlock, bigBlock), qb&(0), BF

    'Classic Conway's Life Rules
    'LINE (1, 1)-(bigBlock, bigBlock), qb&(1), BF
    For y = 1 To an
        For x = 1 To an
            If a(x, y) Then 'show old a with it's neighbor counts br yellow or black

                'Bplus favorite Mandala Life Rules for survival and birth
                Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s, s), qb&(0), BF

                'this separates into individual cells for Classic look
                'LINE ((x - 1) * s + 1, (y - 1) * s + 1)-STEP(s - 2, s - 2), qb&(15), BF

                'Mandala Life coloring by neighbor counts
            Else
                lc = ls(x, y)
                Select Case lc
                    Case 0: cl = 15 ' br white
                    Case 1: cl = 11 ' cyan
                    Case 2: cl = 7 '  low white, br gray
                    Case 3: cl = 10 ' light green
                    Case 4: cl = 9 '  blue
                    Case 5: cl = 13 ' violet
                    Case 6: cl = 12 ' br red
                    Case 7: cl = 4 '  dark red
                    Case 8: cl = 0 '  black
                End Select
                Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s, s), qb&(cl), BF

            End If
        Next
    Next
    _Display
    For y = 1 To an
        For x = 1 To an
            a(x, y) = ng(x, y) 'load a() with next generation data
        Next
    Next
    g = g + 1
    If g > 70 Then _Limit 1
Wend