Pixel life

[James D Jarvis]

An attempt to do Conways' game of life as two images without using defined arrays. Not sure it works right but it simulates working right.  The overall program can surely be trimmed down. I posted this on a facebook group a couple weeks a go and figured.. heck why not post it here?

Code: (Select All)

'pixel_life

' an attmept to repilicate Conway's game of life without arrays by using 2 images

'not sure if I got it working right just yet

'feel free to fiddle with it, press <esc> to exit the program at any time

'there are multiple start states you can change by editing the comments

Dim Shared xmax, ymax

xmax = 400: ymax = 400 'change these as you wish , high numbers may be slow on older machines

Dim Shared s0 As Long

Dim Shared s1 As Long

Dim Shared klr As _Unsigned Long

s0 = _NewImage(xmax, ymax, 32)

s1 = _NewImage(xmax, ymax, 32)

Screen s0

_Title "Pixel Life      <esc> to exit"

'_FullScreen

Randomize Timer

klr = _RGB32(30, 200, 0)

'use comments to change starting population of dots

'rand_gen0

test_genA

'test_genB

'test_mousepop

t = 0

rr = 0: gg = 80: bb = 0

Do

    _Limit 6 'I want to be able to see the changes as the generations go on

    gg = gg + 2

    t = t + 1

    _PutImage (0, 0), s1, s0

    update_gen

Loop Until InKey$ = Chr$(27)

_Dest s0

Print t, " generations"

End



Sub test_genA

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    PSet (xmax \ 2, ymax \ 2 - 2), klr

    PSet (xmax \ 2, ymax \ 2 - 1), klr

    PSet (xmax \ 2, ymax \ 2), klr

    PSet (xmax \ 2, ymax \ 2 + 1), klr

    PSet (xmax \ 2, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 1, ymax \ 2), klr

    PSet (xmax \ 2 - 1, ymax \ 2), klr

End Sub

Sub test_genB

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    PSet (xmax \ 2, ymax \ 2), klr

    PSet (xmax \ 2 + 1, ymax \ 2), klr

    PSet (xmax \ 2 + 2, ymax \ 2 + 1), klr

    PSet (xmax \ 2, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 1, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 2, ymax \ 2 + 2), klr

    PSet (xmax \ 2 + 3, ymax \ 2 + 2), klr

End Sub

Sub test_mousepop

    _Dest s1

    Screen s1

    Cls , _RGB32(0, 0, 0)

    Do

        ' press space when done drawing

        Do While _MouseInput

            mx = _MouseX

            my = _MouseY

            If mx > 0 And mx < xmax And my > 0 And my < ymax Then

                If _MouseButton(2) Then

                    PSet (mx, my), klr

                End If

            End If

        Loop

    Loop Until InKey$ = Chr$(32)

    Screen s0

    _Dest s0

End Sub

Sub rand_gen0

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    For y = 0 To ymax - 1

        For x = 0 To xmax - 1

            If Rnd * 30 < 2 Then PSet (x, y), klr

        Next

    Next

    _Dest s0

End Sub

Sub update_gen

    'change each generation

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    _Dest s0

    For y = 0 To ymax - 1

        For x = 0 To xmax - 1

            update_cell x, y

        Next

    Next

End Sub

Sub update_cell (sx, sy)

    'check each cell for neighbors and update life

    _Source s0

    _Dest s1

    ds = -1 'set to -1 because we are going to count the cell itself and ignore it this way

    If sx > 1 Then x0 = sx - 1 Else x0 = 0

    If sy > 1 Then y0 = sy - 1 Else y0 = 0

    If sx < xmax - 1 Then x1 = sx + 1 Else x1 = xmax - 1

    If sy < ymax - 1 Then y1 = sy + 1 Else y1 = ymax - 1

    For y = y0 To y1

        For x = x0 To x1

            If Point(x, y) <> _RGB32(0, 0, 0) Then ds = ds + 1

        Next

    Next

    Select Case ds

        Case 0, 1

            PSet (sx, sy), _RGB32(0, 0, 0)

        Case 2,3

            PSet (sx, sy), klr

       ' Case 3     'yeah this was strange... keeping it here as comments for reasons

        '    If Point(sx, sy) = _RGB32(0, 0, 0) Then PSet (sx, sy), klr Else PSet (sx, sy), klr

        Case Is > 3

            PSet (sx, sy), _RGB32(0, 0, 0)

    End Select

End Sub

[bplus]

I like this version with lots of expansion room because using pixels.

Tip: use odd number pixels for each side so the symmetry remains after the the cells hit the border of the screen. You need the seed centered on the one middle position.

Funny I was just doing a demo on developing a Conway Life proggie.

Oh I give this idea of using pixels and screen for an array a greenish Gold Star!
   

[James D Jarvis]

Funny I was just doing a demo on developing a Conway Life proggie.

I saw your post in help me! and realized I hadn't posted this here a couple weeks ago.

[bplus]

Funny I was just doing a demo on developing a Conway Life proggie.

I saw your post in help me! and realized I hasn't posted this here a couple weeks ago.

Yes someone was complimenting your code here at another forum when we got on subject of Conway's Life.

[James D Jarvis]

Funny I was just doing a demo on developing a Conway Life proggie.

I saw your post in help me! and realized I hasn't posted this here a couple weeks ago.

Yes someone was complimenting your code here at another forum when we got on subject of Conway's Life.

Cool.

[bplus]

Just changed 3 numbers the x and y max and the _Limit, let it run through supper and came back to another version of "Mandala Life":

Code: (Select All)

'pixel_life
' an attmept to repilicate Conway's game of life without arrays by using 2 images
'not sure if I got it working right just yet
'feel free to fiddle with it, press <esc> to exit the program at any time
'there are multiple start states you can change by editing the comments
Dim Shared xmax, ymax
xmax = 401: ymax = 401 'change these as you wish , high numbers may be slow on older machines
Dim Shared s0 As Long
Dim Shared s1 As Long
Dim Shared klr As _Unsigned Long
s0 = _NewImage(xmax, ymax, 32)
s1 = _NewImage(xmax, ymax, 32)
Screen s0
_Title "Pixel Life      <esc> to exit"
'_FullScreen
Randomize Timer
klr = _RGB32(30, 200, 0)
'use comments to change starting population of dots
'rand_gen0
test_genA
'test_genB
'test_mousepop
t = 0
rr = 0: gg = 80: bb = 0
Do
    _Limit 2 'I want to be able to see the changes as the generations go on
    gg = gg + 2
    t = t + 1
    _PutImage (0, 0), s1, s0
    update_gen
Loop Until InKey$ = Chr$(27)
_Dest s0
Print t, " generations"
End

Sub test_genA
    _Dest s1
    Cls , _RGB32(0, 0, 0)
    PSet (xmax \ 2, ymax \ 2 - 2), klr
    PSet (xmax \ 2, ymax \ 2 - 1), klr
    PSet (xmax \ 2, ymax \ 2), klr
    PSet (xmax \ 2, ymax \ 2 + 1), klr
    PSet (xmax \ 2, ymax \ 2 + 2), klr
    PSet (xmax \ 2 + 1, ymax \ 2), klr
    PSet (xmax \ 2 - 1, ymax \ 2), klr
End Sub
Sub test_genB
    _Dest s1
    Cls , _RGB32(0, 0, 0)
    PSet (xmax \ 2, ymax \ 2), klr
    PSet (xmax \ 2 + 1, ymax \ 2), klr
    PSet (xmax \ 2 + 2, ymax \ 2 + 1), klr
    PSet (xmax \ 2, ymax \ 2 + 2), klr
    PSet (xmax \ 2 + 1, ymax \ 2 + 2), klr
    PSet (xmax \ 2 + 2, ymax \ 2 + 2), klr
    PSet (xmax \ 2 + 3, ymax \ 2 + 2), klr
End Sub
Sub test_mousepop
    _Dest s1
    Screen s1
    Cls , _RGB32(0, 0, 0)
    Do
        ' press space when done drawing
        Do While _MouseInput
            mx = _MouseX
            my = _MouseY
            If mx > 0 And mx < xmax And my > 0 And my < ymax Then
                If _MouseButton(2) Then
                    PSet (mx, my), klr
                End If
            End If
        Loop
    Loop Until InKey$ = Chr$(32)
    Screen s0
    _Dest s0
End Sub
Sub rand_gen0
    _Dest s1
    Cls , _RGB32(0, 0, 0)
    For y = 0 To ymax - 1
        For x = 0 To xmax - 1
            If Rnd * 30 < 2 Then PSet (x, y), klr
        Next
    Next
    _Dest s0
End Sub
Sub update_gen
    'change each generation
    _Dest s1
    Cls , _RGB32(0, 0, 0)
    _Dest s0
    For y = 0 To ymax - 1
        For x = 0 To xmax - 1
            update_cell x, y
        Next
    Next
End Sub
Sub update_cell (sx, sy)
    'check each cell for neighbors and update life
    _Source s0
    _Dest s1
    ds = -1 'set to -1 because we are going to count the cell itself and ignore it this way
    If sx > 1 Then x0 = sx - 1 Else x0 = 0
    If sy > 1 Then y0 = sy - 1 Else y0 = 0
    If sx < xmax - 1 Then x1 = sx + 1 Else x1 = xmax - 1
    If sy < ymax - 1 Then y1 = sy + 1 Else y1 = ymax - 1
    For y = y0 To y1
        For x = x0 To x1
            If Point(x, y) <> _RGB32(0, 0, 0) Then ds = ds + 1
        Next
    Next
    Select Case ds
        Case 0, 1
            PSet (sx, sy), _RGB32(0, 0, 0)
        Case 2, 3
            PSet (sx, sy), klr
            ' Case 3     'yeah this was strange... keeping it here as comments for reasons
            '    If Point(sx, sy) = _RGB32(0, 0, 0) Then PSet (sx, sy), klr Else PSet (sx, sy), klr
        Case Is > 3
            PSet (sx, sy), _RGB32(0, 0, 0)
    End Select
End Sub

[James D Jarvis]

slapped this after updatgen in the main loop and it has an interesting effect. 

Code: (Select All)

    mutation = Int(Rnd * 100)

    Select Case mutation

        Case Is < 10

            PSet (xmax \ 2, ymax \ 2), klr

        Case 10, 11

            Circle (xmax \ 2, ymax \ 2), Int(2 + Rnd * 10), klr

        Case 12

            dx = (1 + Rnd * 12)

            Line (xmax \ 2 - dx, ymax \ 2 - dx)-(xmax \ 2 + dx, ymax \ 2 + dx), klr, B

    End Select

[bplus]

OK here is another Mutation: Pixel Life 2

Code: (Select All)

Option _Explicit
_Title "pixel Life 2" ' b+ 2023-10-15
' inspired by James Jarvis Pixel Life

Dim As Long XPixels, YPixels
XPixels = 401 ' so we can do perfect symmetry
YPixels = 401 ' ditto

Screen _NewImage(XPixels, YPixels, 12) ' the 12 only allows 16 colors
_ScreenMove 400, 150

Dim As Long s2, x, y, xx, yy, nc, gen
s2 = _NewImage(XPixels, YPixels, 12)

Do
    _Dest 0
    _PutImage , s2, 0
    _Display

    ' update s2
    _Source 0
    _Dest s2
    Line (0, 0)-(XPixels - 1, YPixels - 1), 9, B ' draw eternal white border seed and sun!
    Line (1, 1)-(XPixels - 2, YPixels - 2), 0, BF ' clear inside
    For y = 1 To YPixels - 2
        For x = 1 To XPixels - 2
            nc = 0
            For yy = -1 To 1
                For xx = -1 To 1
                    If Point(x + xx, y + yy) Then nc = nc + 1
                Next
            Next
            If Point(x, y) Then nc = nc - 1
            If nc = 2 Then
                PSet (x, y), 9
            ElseIf nc = 3 Then
                PSet (x, y), 10
            End If
        Next
    Next
    gen = gen + 1
    _Title "Gen:" + Str$(gen)
    If gen < 300 Then _Limit 100 Else _Limit 1
Loop Until _KeyDown(27)

[James D Jarvis]

tried using a random character as the image seed and it can produce interesting results like in this image where the little blobs in the top and the bottom shot out of the main shape.

Code: (Select All)

Sub test_genletter

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    _PrintString (xmax \ 2 - 4, ymax \ 2 - 8), Chr$(33 + Rnd * 222)

End Sub

[James D Jarvis]

the results a few generations into placing a string of spaced out characters.

Code: (Select All)

Sub test_input

    Input "enter starting phrase "; pp$

    Cls

    _Dest s1

    Cls , _RGB32(0, 0, 0)

    _PrintString (xmax \ 2 - _PrintWidth(pp$) / 2, ymax \ 2 - 8), pp$

End Sub