Just tried to program the game of "Life" by John Conway (1970)
Fun project so far!
Fun project so far!
Code: (Select All)
'The game of Life
'Based on the 1970 game by John Conway
'James2464 Aug 2022
Screen _NewImage(1650, 1000, 32)
_ScreenMove 0, 0
Randomize Timer
$Resize:Off
Const pi = 3.1415926
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 = 60
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 While InKey$ = ""
Loop
'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 While InKey$ = ""
Loop
'================================================================================================================
'================================================================================================================
'================================================================================================================
flag1 = 0
Do While flag1 = 0
'BEGIN
'COPY ARRAY
For j = 1 To gx
For k = 1 To gy
dp(j, k) = mn(j, k)
Next k
Next j
'================ 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
If InKey$ = "t" Then tog1 = tog1 + 1
If InKey$ = "x" Then flag1 = 1
If tog1 > 1 Then tog1 = 0
Loop