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