Life Experiments

[bplus]

Well @James D Jarvis you did it now, you rekindled my interest in Conway's Life.

For starters add that mem copy method to old code for testing different Line Lengths for Seeds, maybe call it "Life in the Fast Lane!" but it was speedy enough before that I had to use limit the loops!

Anyway different line lengths for seed on a 140 x 140 array. It stays symmetric until we hit top or bottom before the other side does, right and left seem to always be symmetric.

Code: (Select All)

Option _Explicit '   by bplus  2019-09-20   mod to Life Line Seed Experiment 2022-08-17
_Title "Life Line Seed Experiment"
DefLng A-Z
Const xmax = 700, ymax = 700, n = 140, s = 5
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 0
Dim g, x, y, r, nc, wait$ 'nc is neighbor count
Dim a(0 To n + 1, 0 To n + 1), ng(0 To n + 1, 0 To n + 1) ' a() is Life array, ng() is next generation
Color &HFFFFFF00, &HFF080021: r = 35

Do 'seed for Conway's Life Classic

    ' Using lines of different lengths if line is odd symmetric results, even maybe not top and bottom differ << nope it depends !

    Cls
    g = 0: r = r - 1: If r = 1 Then r = 68
    For y = 0 To n + 1
        For x = 0 To n + 1 'for symmetric line blocks
            If y = n / 2 And x > r And x < (n + 1 - r) Then a(x, y) = 1 Else a(x, y) = 0
            If a(x, y) = 1 Then
                Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s - 2, s - 2), &HFFFFFFFF, BF
            Else
                Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s - 2, s - 2), &HFF000000, BF
            End If
        Next
    Next
    ' Sleep refuses to cooperate with _KeyClear!  So a full stop Input statement.
    Locate 1, 1: Input "This is the line seed. Press enter to continue..."; wait$

    '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    ' Run through the generations use any key to stop run and reseed with new line length.

    '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    While InKey$ <> " " And _KeyDown(27) = 0 'run life until spacebar detected
        For x = 1 To n
            For y = 1 To n
                nc = 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)
                If a(x, y) Then ' a is alive Classic Conway's Life Rules for survival
                    If nc = 2 Or nc = 3 Then ng(x, y) = 1 Else ng(x, y) = 0
                Else 'birth?
                    If nc = 3 Then ng(x, y) = 1 Else ng(x, y) = 0
                End If
            Next
        Next
        Line (0, 0)-Step(xmax, ymax), &H11080021, BF
        For y = 1 To n
            For x = 1 To n
                If a(x, y) Then 'this separates into individual cells for Classic look
                    Line ((x - 1) * s + 1, (y - 1) * s + 1)-Step(s - 2, s - 2), &HFFFFFFFF, BF
                End If
            Next
        Next
        Locate 1, 1: Print "Seed:"; r; "  Gen:"; g
        _Display
        LngArrCopy ng(), a() ' good! looks like mem copy works
        g = g + 1
        _Display
        _Limit 30
    Wend

Loop Until _KeyDown(27)
Cls: End

Sub LngArrCopy (A&(), copyB&())
    'ReDim copyB&(LBound(A&) To UBound(A&)) 'container for _memget is ready
    Dim m As _MEM
    m = _Mem(A&())
    _MemGet m, m.OFFSET, copyB&()
    _MemFree m '<<<<<<<<<<<<<<<<<<<<<<<<<< like freeimage very important
End Sub