Pixel life

[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