I kept making changes for speed...and changed the thermal colors.
Code: (Select All)
_Title "Game of Life as told by Chicken Little"
DefLng A-Z ' faster than spaghetti
gx = 200 ' grid size
gy = 150
res1 = 4 ' resolution (1=smallest)
sx = res1 - 1 ' step x
sy = res1 - 1 ' step y
Dim As _Unsigned Long c1(100)
Dim As _Byte mn(gx, gy), dp(gx, gy), aj(gx, gy), tc(gx, gy)
Dim As _MEM mdp, mmn, maj, mtc
mdp = _Mem(dp(0, 0))
mmn = _Mem(mn(0, 0))
maj = _Mem(aj(0, 0))
mtc = _Mem(tc(0, 0))
Screen _NewImage(gx * res1, gy * res1, 32)
_ScreenMove (_DesktopWidth - _Width) \ 2, 20
Randomize Timer
$Resize:Off
$Checking:Off
begin:
For i = 0 To 11
j = i * 22: k = 255 - j
If tog1 Or (i = 0) Then c1(i) = _RGB32(j, 0, 0) Else c1(i) = _RGB32(k, k, k)
Next i
For j = 1 To gx
For k = 1 To gy
mn(j, k) = -(Rnd > .5)
Next k
Next j
t$ = "Spacebar:restart (t)oggle thermal e(x)it" ' what to print
Cls
_PrintString (_Width \ 2 - Len(t$) * 4, _Height - 22), t$ ' print centered
Do: _Limit 100
_MemCopy mmn, mmn.OFFSET, mmn.SIZE To mdp, mdp.OFFSET
aj(1, 1) = dp(1, 2) + dp(2, 1) + dp(2, 2)
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
aj(gx, 1) = dp(gx - 1, 1) + dp(gx - 1, 2) + dp(gx, 2)
For k = 2 To gy - 1
aj(1, k) = dp(1, k - 1) + dp(2, k - 1) + dp(2, k) + dp(2, k + 1) + dp(1, k + 1)
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
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
aj(1, gy) = dp(1, gy - 1) + dp(2, gy - 1) + dp(2, gy)
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
aj(gx, gy) = dp(gx - 1, gy) + dp(gx - 1, gy - 1) + dp(gx, gy - 1)
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
If tog1 = 0 Then
_MemCopy mmn, mmn.OFFSET, mmn.SIZE To mtc, mtc.OFFSET
Else
_MemCopy maj, maj.OFFSET, maj.SIZE To mtc, mtc.OFFSET
End If
For j = 1 To gx
x = j * res1
For k = 1 To gy - 10
y = k * res1
Line (x, y)-Step(sx, sy), c1(tc(j, k)), BF
Next k
Next j
i$ = InKey$
If i$ = " " Then restarting = 1: GoTo begin
If i$ = "t" Then tog1 = tog1 Xor 1: GoTo begin
If i$ = "x" Then System
_Display
Loop