Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Life
#13
Using the suggestions from the replies, here is the latest version:

3 patterns from the Life wiki have been added

And...I added a line drawing option, but due to my low skill level it's kind of a problem.   I tried using 'right click' to exit but I don't fully understand how to apply or capture a right mouse click to get out of a loop.   So i changed it to use the ENTER key.   Anyway I'd like to know how to just use the mouse and right click, if anyone can suggest a solution.   Cheers.

Code: (Select All)
' Game of Life based on the 1970 game by John Conway, James2464 Aug 2022

Screen _NewImage(1700, 1000, 32)
_ScreenMove (_DesktopWidth - _Width) \ 2, 20
Randomize Timer

$Resize:Off

Const xblack = _RGB32(0, 0, 0)
Const xwhite = _RGB32(255, 255, 255)
Const xred = _RGB32(255, 0, 0)
Const xgreen = _RGB32(125, 255, 125)
Const xblue = _RGB32(0, 0, 255)
Const xyellow = _RGB32(150, 125, 0)
Const xpink = _RGB32(255, 0, 255)
Const xcyan = _RGB32(0, 255, 255)
Const xbrown = _RGB32(80, 0, 0)
Const xdarkgreen = _RGB32(0, 128, 0)
Const xlightgray = _RGB32(110, 110, 110)
Const xdarkgray = _RGB32(10, 10, 10)

Dim c1~&(100)
c1~&(0) = xblack
c1~&(1) = xwhite
c1~&(2) = xred
c1~&(3) = xgreen
c1~&(4) = xblue
c1~&(5) = xyellow
c1~&(6) = xpink
c1~&(7) = xcyan
c1~&(8) = xbrown
c1~&(9) = xdarkgreen
c1~&(10) = xlightgray
c1~&(11) = xdarkgray

'================================================================================================================
'================================================================================================================
'================================================================================================================

'load data patterns

Dim methuselah52513M(16, 16)
For k = 1 To 16
    For j = 1 To 16
        Read methuselah52513M(j, k)
    Next j
Next k

Dim gosper(36, 9)
For k = 1 To 9
    For j = 1 To 36
        Read gosper(j, k)
    Next j
Next k




'INITIALIZE

Cls
Dim mn(1000, 800)
Dim dp(1000, 800)
Dim aj(1000, 800)

'grid size
gx = 350
gy = 200
'resolution (1=smallest)
res1 = 4

Cls
xtxt = 20

Locate 10, xtxt
Print "Select starting pattern"
Locate 11, xtxt
Print "1.  Full screen random scatter"
Locate 12, xtxt
Print "2.  Free draw with mouse"
Locate 13, xtxt
Print "3.  Line draw with mouse"
Locate 14, xtxt
Print "4.  Methuselah 52513M"
Locate 15, xtxt
Print "5.  R-Pentomino"
Locate 16, xtxt
Print "6.  Gosper Glider Gun"

Locate 20, xtxt
Input "Choose 1-6: ", start1

'=================== random scatter full
If start1 = 1 Then
    For j = 1 To gx
        For k = 1 To gy
            r = Int(Rnd * 10)
            If r < 3 Then
                mn(j, k) = 1
            Else
                mn(j, k) = 0
            End If
        Next k
    Next j
End If

'=============================== free draw with mouse
If start1 = 2 Then
    'use mouse to draw starting pattern

    'draw STARTING GRID
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j
    Do

        Do While _MouseInput
        Loop
        x% = _MouseX
        y% = _MouseY
        'Locate 1, 1
        'Print x%, y%
        x1 = Int(x% / res1)
        y1 = Int(y% / res1)
        mn(x1, y1) = 1
        'mn(x1 - 1, y1 - 1) = 1
        'mn(x1 + 1, y1 - 1) = 1
        'mn(x1 + 1, y1 + 1) = 1
        'mn(x1, y1 + 1) = 1
        'mn(x1 + 1, y1) = 1
        'mn(x1, y1 - 1) = 1
        'draw  GRID
        For j = 1 To gx
            For k = 1 To gy
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Next k
        Next j

        lc% = _MouseButton(1)
    Loop Until lc% = -1
End If

'=============================== random partial
If start1 = 3 Then

    'use mouse to draw lines
    'left click once to start line
    'left click again to finish line
    'right click when finished

    Cls
    Locate 10, 20
    Print "CREATE HORIZONTAL AND VERTICAL LINES"
    Locate 11, 20
    Print "Instructions:  left click in two places"
    Locate 12, 20
    Print "then the line will appear."
    Locate 14, 20
    Print "press ENTER when finished"
    Locate 15, 20
    Print "then left click TWICE to proceed"
    Locate 20, 20
    Print "press any key to begin"
    Sleep

    'draw STARTING GRID
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    Do
        Do


            Do While lc% = -1
                Do While _MouseInput
                Loop
                lc% = _MouseButton(1)
            Loop


            Do While _MouseInput
            Loop
            x% = _MouseX
            y% = _MouseY
            x1 = Int(x% / res1)
            y1 = Int(y% / res1)
            'Locate 3, 1
            'Print x1, y1
            lc% = _MouseButton(1)
        Loop Until lc% = -1

        'register first point that was clicked
        mn(x1, y1) = 1

        Do While lc% = -1
            Do While _MouseInput
            Loop
            lc% = _MouseButton(1)
        Loop





        Do
            'get second point location

            Do While _MouseInput
            Loop
            x% = _MouseX
            y% = _MouseY
            x2 = Int(x% / res1)
            y2 = Int(y% / res1)
            'Locate 5, 1
            'Print x1; y1; ">"; x2; y2
            lc% = _MouseButton(1)
        Loop Until lc% = -1

        Do While lc% = -1
            Do While _MouseInput
            Loop
            lc% = _MouseButton(1)
        Loop





        'determine if line is horizontal or vertical
        If x2 >= x1 Then xd1 = x2 - x1
        If x2 < x1 Then xd1 = x1 - x2
        If y2 >= y1 Then yd1 = y2 - y1
        If y2 < y1 Then yd1 = y1 - y2

        'create horizontal line
        If xd1 >= yd1 Then
            If x1 < x2 Then
                For j = x1 To x2
                    mn(j, y1) = 1
                Next j
            Else
                For j = x2 To x1
                    mn(j, y1) = 1
                Next j
            End If

        End If



        'create vertical line
        If xd1 < yd1 Then
            If y1 < y2 Then
                For k = y1 To y2
                    mn(x1, k) = 1
                Next k
            Else
                For k = y2 To y1
                    mn(x1, k) = 1
                Next k

            End If

        End If



        'draw  GRID
        For j = 1 To gx
            For k = 1 To gy
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Next k
        Next j



        Do While _MouseInput
        Loop
        fl = 0
        If InKey$ = Chr$(13) Then fl = 1
    Loop Until fl = 1


End If

'================================ Methuselah 52513M
If start1 = 4 Then

    'set location
    xp1 = 200
    yp1 = 120

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 16
        For j = 1 To 16
            mn(xp1 + j, yp1 + k) = methuselah52513M(j, k)
        Next j
    Next k

End If

'=============================== R-Pentomino
If start1 = 5 Then
    mn(200, 100) = 1
    mn(200, 101) = 1
    mn(201, 102) = 1
    mn(202, 102) = 1
    mn(203, 102) = 1
End If


'================================ Gosper glider gun
If start1 = 6 Then

    'set location
    xp1 = 50
    yp1 = 50

    'draw initial array
    For j = 1 To gx
        For k = 1 To gy
            Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
        Next k
    Next j

    'update with pattern array at set location xp1,yp1

    For k = 1 To 9
        For j = 1 To 36
            mn(xp1 + j, yp1 + k) = gosper(j, k)
        Next j
    Next k


End If





'================================================================================================================
'================================================================================================================
'================================================================================================================

Cls
Locate 10, xtxt
Print "Press space bar to show starting pattern."
Locate 15, xtxt
Print "Then press space bar again to start algorithm."
Locate 16, xtxt
Print "While running, press 't' to toggle to thermal cam view."

Do: _Limit 10
Loop Until Len(InKey$)

'draw STARTING GRID
For j = 1 To gx
    For k = 1 To gy
        Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
    Next k
Next j

Do: _Limit 10
Loop Until Len(InKey$)

'================================================================================================================
'================================================================================================================
'================================================================================================================

Dim As _MEM m0, m1
m0 = _Mem(dp(0, 0))
m1 = _Mem(mn(0, 0))

Do

    'COPY ARRAY

    'For j = 1 To gx
    '    For k = 1 To gy
    '    dp(j, k) = mn(j, k)
    'Next k
    'Next j

    _MemCopy m1, m1.OFFSET, m1.SIZE To m0, m0.OFFSET

    '================ SCAN FIRST ROW =============================

    'top left corner
    aj(1, 1) = dp(1, 2) + dp(2, 1) + dp(2, 2)

    'main portion of top row
    For j = 2 To gx - 1
        aj(j, 1) = dp(j - 1, 1) + dp(j + 1, 1) + dp(j - 1, 2) + dp(j, 2) + dp(j + 1, 2)
    Next j

    'top right corner
    aj(gx, 1) = dp(gx - 1, 1) + dp(gx - 1, 2) + dp(gx, 2)

    '=============SCAN SECOND TO SECOND LAST ROW=================

    For k = 2 To gy - 1

        'scan first position only
        aj(1, k) = dp(1, k - 1) + dp(2, k - 1) + dp(2, k) + dp(2, k + 1) + dp(1, k + 1)

        'scan main portion of current row
        For j = 2 To gx - 1
            aj(j, k) = dp(j - 1, k - 1) + dp(j, k - 1) + dp(j + 1, k - 1) + dp(j - 1, k) + dp(j + 1, k) + dp(j - 1, k + 1) + dp(j, k + 1) + dp(j + 1, k + 1)
        Next j

        'scan end position only
        aj(gx, k) = dp(gx, k - 1) + dp(gx - 1, k - 1) + dp(gx - 1, k) + dp(gx - 1, k + 1) + dp(gx, k + 1)

    Next k

    '======================SCAN LAST ROW=======================

    'bottom left corner
    aj(1, gy) = dp(1, gy - 1) + dp(2, gy - 1) + dp(2, gy)

    'main portion of last row
    For j = 2 To gx - 1
        aj(j, gy) = dp(j - 1, gy) + dp(j + 1, gy) + dp(j - 1, gy - 1) + dp(j, gy - 1) + dp(j + 1, gy - 1)
    Next j

    'bottom right corner
    aj(gx, gy) = dp(gx - 1, gy) + dp(gx - 1, gy - 1) + dp(gx, gy - 1)

    '=======================APPLY RULES AND UPDATE GRID========================

    'rule 1 - if cell was dead and had exactly 3 neighbours, it becomes alive
    'rule 2 - if cell was alive and had <2 or >3 neighbours, it becomes dead

    For k = 1 To gy
        For j = 1 To gx
            If dp(j, k) = 0 Then
                If aj(j, k) = 3 Then
                    mn(j, k) = 1
                End If
            End If
            If dp(j, k) = 1 Then
                If aj(j, k) < 2 Or aj(j, k) > 3 Then
                    mn(j, k) = 0
                End If
            End If
        Next j
    Next k

    '=======================DRAW NEW UPDATED GRID=============================
    For j = 1 To gx
        For k = 1 To gy
            If tog1 = 0 Then
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(mn(j, k)), BF
            Else
                Line (j * res1, k * res1)-(j * res1 + res1, k * res1 + res1), c1~&(aj(j, k)), BF
            End If
        Next k
    Next j

    _Display
    i$ = InKey$
    If i$ = "t" Then tog1 = tog1 Xor 1

Loop Until i$ = "x"

End


'=========================================== Known patterns from LifeWiki (Conwaylife.com)


'Methuselah 52513M
Data 1,1,1,0,0,1,1,0,1,0,1,1,0,1,1,1
Data 1,1,0,1,0,1,1,1,0,0,0,0,1,0,1,0
Data 0,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1
Data 0,0,1,0,0,1,1,0,0,0,1,0,0,1,0,0
Data 0,0,1,0,0,0,0,0,1,0,1,0,0,0,1,1
Data 1,0,0,0,0,1,1,0,0,0,1,1,1,0,1,0
Data 0,0,0,1,1,0,0,1,0,0,1,0,1,0,0,1
Data 0,0,1,1,1,1,0,1,0,0,1,0,1,1,0,0
Data 1,1,0,1,1,0,0,1,1,0,0,0,0,0,1,1
Data 1,0,1,1,1,1,0,1,0,0,0,0,1,1,1,0
Data 1,0,0,0,1,1,1,1,0,0,1,1,1,0,0,0
Data 0,1,1,1,1,1,1,1,1,1,1,0,0,1,1,1
Data 1,1,0,0,0,1,0,1,1,1,0,1,0,1,1,1
Data 0,1,1,0,1,1,1,1,1,1,0,0,0,1,0,1
Data 1,0,1,0,0,0,0,0,1,1,1,1,0,1,0,0
Data 1,1,1,0,1,0,1,0,1,1,0,0,0,0,0,1


'Gosper glider gun
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1
Data 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1
Data 1,1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 1,1,0,0,0,0,0,0,0,0,1,0,0,0,1,0,1,1,0,0,0,0,1,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
Reply


Messages In This Thread
Life - by james2464 - 08-13-2022, 01:19 AM
RE: Life - by johnno56 - 08-13-2022, 10:36 AM
RE: Life - by James D Jarvis - 08-13-2022, 01:18 PM
RE: Life - by bplus - 08-13-2022, 04:46 PM
RE: Life - by james2464 - 08-13-2022, 05:31 PM
RE: Life - by ChiaPet - 08-14-2022, 12:11 AM
RE: Life - by bplus - 08-13-2022, 10:28 PM
RE: Life - by james2464 - 08-14-2022, 12:36 AM
RE: Life - by ChiaPet - 08-14-2022, 12:41 AM
RE: Life - by james2464 - 08-14-2022, 01:17 AM
RE: Life - by dcromley - 08-14-2022, 02:33 AM
RE: Life - by james2464 - 08-14-2022, 07:21 PM
RE: Life - by james2464 - 08-14-2022, 07:27 PM
RE: Life - by ChiaPet - 08-14-2022, 08:21 PM
RE: Life - by bplus - 08-14-2022, 10:03 PM
RE: Life - by james2464 - 08-15-2022, 12:39 AM
RE: Life - by bplus - 08-15-2022, 01:42 AM
RE: Life - by james2464 - 08-15-2022, 01:27 PM
RE: Life - by Pete - 08-15-2022, 05:25 AM
RE: Life - by james2464 - 08-15-2022, 01:35 PM
RE: Life - by bplus - 08-15-2022, 02:13 PM
RE: Life - by james2464 - 08-16-2022, 01:32 AM
RE: Life - by dcromley - 08-15-2022, 06:49 PM
RE: Life - by james2464 - 08-16-2022, 02:19 AM



Users browsing this thread: 6 Guest(s)