Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Life
#7
(08-13-2022, 04:46 PM)bplus Wrote: One of the challenges of Conway's "Game" of Life is to find initial starting patterns that do not die out. Making Life Immortal!

Nice, but I see problems:

1) colors should be stored in unsigned longs
2) use $COLOR:32
3) inkey$ was being called multiple times
4) tight loop waiting for key could cause overheating - use _LIMIT or _SLEEP
5) arrays were being moved one element at a time - use _MEMCOPY to speed it up
6) _DISPLAY after updates are complete is nicer

Here's a version with most of the issues fixed.

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

Screen _NewImage(800, 600, 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

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

'INITIALIZE

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

'grid size
gx = 400
gy = 235
'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.  Fixed pattern A"
Locate 13, xtxt
Print "3.  Random pattern partial"
Locate 14, xtxt
Print "4.  Manually draw using mouse pointer.  Left click when finished."
Locate 15, xtxt
Print "5.  Fixed pattern B"
Locate 20, xtxt
Input "Choose 1-5: ", start1

'start1 = 5

'=================== random 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

'=============================== fixed pattern
If start1 = 2 Then
    gx = 400
    gy = 235
    res1 = 4

    For j = 105 To 300 Step 12
        For k = 80 To 160
            mn(j, k) = 1
        Next k
    Next j
    For j = 1 To gx
        For k = 1 To gy
            If mn(j, k) <> 1 Then
                mn(j, k) = 0
            End If
        Next k
    Next j
End If

'=============================== random partial
If start1 = 3 Then
    For j = 1 To gx
        For k = 1 To gy
            mn(j, k) = 0
        Next k
    Next j

    For j = 40 To gx Step 1
        tt = Int(gy / 2)
        t = Int(Rnd * tt) + 40
        For k = 10 To t
            mn(j, k) = 1
        Next k
    Next j
End If

'================================draw with mouse pointer
If start1 = 4 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

'=============================== fixed pattern - lines
If start1 = 5 Then

    For k = 110 To gy - 80 Step 25
        For j = 80 To gx - 80
            mn(j, k) = 1
        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"
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: 3 Guest(s)