Conway's game of life without borders.

Game development specific discussions.
D.J.Peters
Posts: 8431
Joined: May 28, 2005 3:28
Contact:

Conway's game of life without borders.

Postby D.J.Peters » Dec 14, 2021 0:26

It's not an infinity grid in size but no screen borders.
Maybe you have to use the Sleep command.

If you brake down the rules of Conway's game of life it becomes:

if neighbours=3 or (Cell=1 and neighbours=2) then newCell=1 else newCell=0

Or with other words a cell with 3 neighbours wins every game cycle, independent the cell was died before or not. ;-)

By the way it's a good example that an short/optimized term must not be the fastes !
(For the code/CPU it's faster to ask if the cell is alive=1 or died=0 before.)

Joshy

file: game_of_life.bas

Code: Select all

sub GameOfLife(oldGenerationImage as any ptr, _
               newGenerationImage as any ptr)
  dim as integer iW,iH,iPitch
  dim as ubyte ptr pI,pO
  imageinfo oldGenerationImage,iw,ih,,iPitch,pI
  imageinfo newGenerationImage,iw,ih,,      ,pO
  dim as ubyte ptr ri0=pI+(iH-1)*iPitch ' input row[last]
  dim as ubyte ptr ri1=pI               ' input row[0]
  dim as ubyte ptr ri2=ri1+iPitch       ' input row[1]
  dim as ubyte ptr ro1=pO               ' output row[0]
  dim as ubyte cell
  dim as integer neighbours,iLeft,iMidle,iRight

#macro one_cell
  neighbours  = ri0[iLeft]: neighbours += ri0[iMidle]: neighbours += ri0[iRight]
  neighbours += ri1[iLeft]:        cell = ri1[iMidle]: neighbours += ri1[iRight]
  neighbours += ri2[iLeft]: neighbours += ri2[iMidle]: neighbours += ri2[iRight]
  if cell=1 then
    if (neighbours<2 orelse neighbours>3) then ro1[iMidle]=0 else ro1[iMidle]=1
  elseif neighbours=3 then
    ro1[iMidle]=1
  else
    ro1[iMidle]=0
  endif 
#endmacro 

#macro one_row
  iLeft=iW-1:iMidle=0:iRight=1
  for x as integer = 1 to iW-1
    one_cell
    iLeft=iMidle:iMidle=iRight:iRight+=1
  next
  iRight=0 : one_cell
#endmacro

  for y as integer = 1 to iH-1
    one_row
    ri0=ri1 : ri1=ri2 : ri2+=iPitch : ro1+=iPitch
  next
  ri2=pI ' last row becomes row[0]
  one_row
end sub

'
' main
'
dim as integer iW,iH
screeninfo iW,iH
randomize timer()
' 1/2 size
iW=(iW\2) : iH=(ih\2)
' 3/4 size
'iW=(iW\4)*3 : iH=(ih\4)*3

screenres iW,iH,8
palette 1,255,255,255

var oldPopulation = ImageCreate(iW,iH,0)
var newPopulation = ImageCreate(iW,iH,0)

for i as integer = 1 to 100000
  pset oldPopulation,(100+rnd*(iW-200),100+rnd*(iH-200)),1
next

dim as integer fps,frames
dim as double tStart = timer()
while inkey()=""
  GameOfLife(oldPopulation,newPopulation)
  put (0,0),newPopulation,PSET
  draw string (0,0),"fps: " & fps
  swap oldPopulation,newPopulation
  frames+=1
  if (frames mod 60)=0 then
    dim as double tNow=timer()
    fps=60/(tNow-tStart)
    tStart=tNow
  end if
  'sleep 1
wend
D.J.Peters
Posts: 8431
Joined: May 28, 2005 3:28
Contact:

Re: Conway's game of life without borders.

Postby D.J.Peters » Dec 14, 2021 3:20

This are the same but without allocated images it used the hidden and visible page of the ScreenSet() command.
Note I don't use Flip() instead ScreenSet() is the key for flicker free blitting.

Joshy

Code: Select all

sub GameOfLife(pI as ubyte ptr, _
               pO as ubyte ptr, _
               iW as integer, _
               iH as integer, _
               iP as integer)
  dim as ubyte ptr ri0=pI+(iH-1)*iP ' input row[last]
  dim as ubyte ptr ri1=pI           ' input row[0]
  dim as ubyte ptr ri2=ri1+iP       ' input row[1]
  dim as ubyte ptr ro1=pO           ' output row[0]
  dim as ubyte cell=any
  dim as integer neighbours=any,iLeft=any,iMidle=any,iRight=any

  iW-=1:iH-=1
#macro one_cell
  neighbours  = ri0[iLeft]: neighbours += ri0[iMidle]: neighbours += ri0[iRight]
  neighbours += ri1[iLeft]:        cell = ri1[iMidle]: neighbours += ri1[iRight]
  neighbours += ri2[iLeft]: neighbours += ri2[iMidle]: neighbours += ri2[iRight] 
  if cell=1 then
    if (neighbours<2 orelse neighbours>3) then ro1[iMidle]=0 else ro1[iMidle]=1
  elseif neighbours=3 then
    ro1[iMidle]=1
  else
    ro1[iMidle]=0
  endif 
#endmacro 

#macro one_row
 
  iLeft=iW:iMidle=0:iRight=1
  for x as integer = 1 to iW
    one_cell : iLeft=iMidle:iMidle=iRight:iRight+=1
  next
  ' last cell in a row becomes first cell in the same row !
  iRight=0 : one_cell
#endmacro
  for y as integer = 1 to iH
    one_row : ri0=ri1 : ri1=ri2 : ri2+=iP : ro1+=iP
  next
  ' last row becomes first row !
  ri2=pI : one_row
end sub

'
' main
'
dim as integer iW,iH
screeninfo iW,iH
randomize timer()
' 1/2 size
iW=(iW\2) : iH=(ih\2)
' 3/4 size
'iW=(iW\4)*3 : iH=(ih\4)*3
dim as ubyte ptr pOld,pNew
dim as integer iP

screenres iW,iH,8,2
screenset 0
pNew=screenptr()
screenset 1,0
pOld=screenptr()
screeninfo iW,iH,,,iP
palette 1,255,255,255
for i as integer = 1 to 100000
  pset (100+rnd*(iW-200),100+rnd*(iH-200)),1
next
dim as integer fps,frames
dim as double tStart = timer()
while inkey()=""
  ' pNew is the hidden page
  GameOfLife(pOld,pNew,iW,iH,iP)
  draw string (0,0),"fps: " & fps
  screenset 1,0 ' show pNew
  ' after screenset pOld is the hidden page
  GameOfLife(pNew,pOld,iW,iH,iP)
  draw string (0,0),"fps: " & fps
  screenset 0,1 ' show pOLd

  frames+=2 ' count two frames
  if (frames mod 60)=0 then
    dim as double tNow=timer()
    fps=60/(tNow-tStart): tStart=tNow
  end if
  'sleep 1
wend
srvaldez
Posts: 2888
Joined: Sep 25, 2005 21:54

Re: Conway's game of life without borders.

Postby srvaldez » Dec 14, 2021 15:41

nice Joshy :-)
I get about 630+ fps
badidea
Posts: 2438
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Conway's game of life without borders.

Postby badidea » Dec 14, 2021 23:28

A version, not optimised for speed, but with colors. White for newborn cells, Red for cells that had 3 neighbours, Green for cells that had 2 neighbours.

Code: Select all

const as long SW = 800, SH = 600 'screen width & height
screenres SW, SH, 32
width SW \ 8, SH \ 16

const as long CSZ = 10 'cell size
const as long NCX = SW \ CSZ, NCY = SH \ CSZ 'number of cells in x & y direction

dim as long cell(0 to 1, 0 to NCX - 1, 0 to NCY - 1) '2 cell grids

const as long ALIVE = 1
const as long DEAD = 0

dim shared as long colour(0 to 7) = {_
   &hff000000, &hff0000ff, &hff00ff00, &hffff0000, _
   &hff00ffff, &hffffff00, &hffff00ff, &hffffffff}

sub init_cells(cell() as long, layer as long)
   for x as long = 0 to NCX - 1
      for y as long = 0 to NCY - 1
         cell(layer, x, y) = iif(rnd < 0.2, ALIVE, DEAD)
      next
   next
end sub

sub draw_cells(cell() as long, layer as long)
   dim as long c
   for x as long = 0 to NCX - 1
      for y as long = 0 to NCY - 1
         'c = iif(cell(layer, x, y) = DEAD, &hff000000, &hffffffff)
         c = colour(cell(layer, x, y))
         line(x * CSZ, y * CSZ)-step(CSZ - 2, CSZ - 2), c, bf
      next
   next
end sub

function count_neighbours(cell() as long, x as long, y as long, layer as long) as long
   dim as long x_nb, y_nb 'neighbour x & y
   dim as long sum = 0
   for xi as long = -1 to +1
      x_nb = x + xi
      if x_nb < 0 then
         x_nb = NCX - 1
      elseif x_nb >= NCX then
         x_nb = 0
      end if
      for yi as long = -1 to +1
         if xi = 0 and yi = 0 then continue for 'skip self
         y_nb = y + yi
         if y_nb < 0 then
            y_nb = NCY - 1
         elseif y_nb >= NCY then
            y_nb = 0
         end if
         'sum += cell(layer, x_nb, y_nb)
         if cell(layer, x_nb, y_nb) <> DEAD then sum +=1
      next
   next
   return sum
end function

sub update_cells(cell() as long, from_layer as long)
   dim as long neighbours, to_layer = from_layer xor 1
   for x as long = 0 to NCX - 1
      for y as long = 0 to NCY - 1
         neighbours = count_neighbours(cell(), x, y, from_layer)
         if cell(from_layer, x, y) = DEAD then
            if neighbours = 3 then
               cell(to_layer, x, y) = 7 'ALIVE
            else
               cell(to_layer, x, y) = DEAD
            end if
         else 'cell is alive
            if neighbours < 2 or neighbours > 3 then
               cell(to_layer, x, y) = DEAD
            else
               cell(to_layer, x, y) = neighbours 'ALIVE
            end if
         end if
      next
   next
end sub

'init cells
dim as long layer = 0
randomize timer
init_cells(cell(), layer)

while not multikey(1) 'escape key
   update_cells(cell(), layer)
   layer xor= 1
   draw_cells(cell(), layer)
   sleep 100
   'getkey()
wend
getkey()

A bit sad that this game of life often (always?) ends up in a pretty dead state with only some 3 cell blinkers remaining.
D.J.Peters
Posts: 8431
Joined: May 28, 2005 3:28
Contact:

Re: Conway's game of life without borders.

Postby D.J.Peters » Dec 15, 2021 0:32

@badidea I made some small changes to your code it's more 32/64-bit friendly and a cellsize of 1 is legal now also :-)

Joshy

Code: Select all

type tIndex as uinteger ' the native is fast for 32/64-bit
type tColor as ulong ' use ulong allways
type tCell  as ubyte

const as tCell ALIVE = 1
const as tCell DEAD  = 0
const as integer CELLSIZE = 3
const as integer SW = 800, SH = 600 'screen width & height

dim shared as tCell cell(1,SW \ CELLSIZE, SH \ CELLSIZE) '2 cell grids
dim shared as tColor colors(0 to 7) = {_
   &hff000000, &hff0000ff, &hff00ff00, &hffff0000, _
   &hff00ffff, &hffffff00, &hffff00ff, &hffffffff}

sub init_cells(cell() as tCell, layer as tIndex)
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    cell(layer, x, y) = iif(rnd < 0.2, ALIVE, DEAD)
  next y,x
end sub

sub draw_cells(cell() as tCell, layer as tIndex)
  dim as tColor c
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    c = colors(cell(layer, x, y))
    line(x * CELLSIZE, y * CELLSIZE) - step(CELLSIZE - 1, CELLSIZE - 1), c, bf
  next y,x
end sub

function count_neighbours(cell() as tCell, x as tIndex, y as tIndex, layer as tIndex) as integer
  dim as integer x_nb, y_nb 'neighbour x & y
  dim as integer sum = 0
  for xi as integer = -1 to +1
    x_nb = x + xi
    if x_nb < 0 then
      x_nb = ubound(cell,2)
    elseif x_nb > ubound(cell,2) then
      x_nb = 0
    end if
    for yi as integer = -1 to +1
      if xi = 0 and yi = 0 then continue for 'skip self
      y_nb = y + yi
      if y_nb < 0 then
        y_nb = ubound(cell,3)
      elseif y_nb >ubound(cell,3) then
        y_nb = 0
      end if
      if cell(layer, x_nb, y_nb) <> DEAD then sum +=1
    next
  next
  return sum
end function

sub update_cells(cell() as tCell, from_layer as integer)
  dim as integer neighbours, to_layer = from_layer xor 1
  for x as integer = 0 to ubound(cell,2)
    for y as integer = 0 to ubound(cell,3)
      neighbours = count_neighbours(cell(), x, y, from_layer)
      if cell(from_layer, x, y) = DEAD then
        if neighbours = 3 then
          cell(to_layer, x, y) = 7 'ALIVE
        else
          cell(to_layer, x, y) = DEAD
        end if
      else 'cell is alive
        if neighbours < 2 or neighbours > 3 then
          cell(to_layer, x, y) = DEAD
        else
          cell(to_layer, x, y) = neighbours 'ALIVE
        end if
      end if
    next
  next
end sub
'
' main
'
screenres SW, SH, 32
width SW \ 8, SH \ 16

dim as tIndex layer = 0
randomize timer()
init_cells(cell(), layer)
while not multikey(1) 'escape key
  update_cells(cell(), layer)
  layer xor= 1
  draw_cells(cell(), layer)
  'sleep 1
wend
badidea
Posts: 2438
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Conway's game of life without borders.

Postby badidea » Dec 15, 2021 23:17

yes, that is better. I was tired of typing 'integer' so many times.
With slightly modified 'game rules' you gets some structures that look like grain boundaries (https://en.wikipedia.org/wiki/Grain_boundary):

Code: Select all

type tIndex as uinteger ' the native is fast for 32/64-bit
type tColor as ulong ' use ulong allways
type tCell  as ubyte

const as tCell ALIVE = 1
const as tCell DEAD  = 0
const as integer CELLSIZE = 3
const as integer SW = 800, SH = 600 'screen width & height

dim shared as tCell cell(1,SW \ CELLSIZE - 1, SH \ CELLSIZE - 1) '2 cell grids
dim shared as tColor colors(0 to 7) = {_
   &hff000000, &hff0000ff, &hff00ff00, &hffff0000, _
   &hff00ffff, &hffffff00, &hffff00ff, &hffffffff}

sub init_cells(cell() as tCell, layer as tIndex)
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    cell(layer, x, y) = iif(rnd < 0.2, ALIVE, DEAD)
  next y,x
end sub

sub draw_cells(cell() as tCell, layer as tIndex)
  dim as tColor c
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    c = colors(cell(layer, x, y))
    line(x * CELLSIZE, y * CELLSIZE) - step(CELLSIZE - 1, CELLSIZE - 1), c, bf
  next y,x
end sub

function count_neighbours(cell() as tCell, x as tIndex, y as tIndex, layer as tIndex) as integer
  dim as integer x_nb, y_nb 'neighbour x & y
  dim as integer sum = 0
  for xi as integer = -1 to +1
    x_nb = x + xi
    if x_nb < 0 then
      x_nb = ubound(cell,2)
    elseif x_nb > ubound(cell,2) then
      x_nb = 0
    end if
    for yi as integer = -1 to +1
      if xi = 0 and yi = 0 then continue for 'skip self
      y_nb = y + yi
      if y_nb < 0 then
        y_nb = ubound(cell,3)
      elseif y_nb >ubound(cell,3) then
        y_nb = 0
      end if
      if cell(layer, x_nb, y_nb) <> DEAD then sum +=1
    next
  next
  return sum
end function

sub update_cells(cell() as tCell, from_layer as integer)
  dim as integer neighbours, to_layer = from_layer xor 1
  for x as integer = 0 to ubound(cell,2)
    for y as integer = 0 to ubound(cell,3)
      neighbours = count_neighbours(cell(), x, y, from_layer)
      if cell(from_layer, x, y) = DEAD then
        if neighbours = 4 then
          cell(to_layer, x, y) = 7 'ALIVE
        else
          cell(to_layer, x, y) = DEAD
        end if
      else 'cell is alive
        if neighbours < 1 or neighbours > 4 then
          cell(to_layer, x, y) = DEAD
        else
          cell(to_layer, x, y) = neighbours 'ALIVE
        end if
      end if
    next
  next
end sub
'
' main
'
screenres SW, SH, 32
width SW \ 8, SH \ 16

dim as tIndex layer = 0
randomize timer()
init_cells(cell(), layer)
while not multikey(1) 'escape key
  update_cells(cell(), layer)
  layer xor= 1
  draw_cells(cell(), layer)
  sleep 10
wend

It was drawing 1 row and 1 column off-screen, so I changed line 10 to:

Code: Select all

dim shared as tCell cell(1, SW \ CELLSIZE - 1, SH \ CELLSIZE - 1) '2 cell grids

I did not know the syntax next y,x
badidea
Posts: 2438
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Conway's game of life without borders.

Postby badidea » Dec 20, 2021 0:27

The B3/S12345 'maze generator':

Code: Select all

type tIndex as uinteger ' the native is fast for 32/64-bit
type tColor as ulong ' use ulong allways
type tCell  as ubyte

const as tCell ALIVE = 1
const as tCell DEAD  = 0
const as integer CELLSIZE = 2
const as integer SW = 800, SH = 600 'screen width & height

dim shared as tCell cell(1,SW \ CELLSIZE - 1, SH \ CELLSIZE - 1) '2 cell grids
dim shared as tColor colors(0 to 7) = {_
   &hff000000, &hff0000ff, &hff00ff00, &hffff0000, _
   &hff00ffff, &hffffff00, &hffff00ff, &hffffffff}

sub init_cells(cell() as tCell, layer as tIndex)
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    cell(layer, x, y) = iif(rnd < 0.02, ALIVE, DEAD)
  next y,x
end sub

sub draw_cells(cell() as tCell, layer as tIndex)
  dim as tColor c
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    c = colors(cell(layer, x, y))
    line(x * CELLSIZE, y * CELLSIZE) - step(CELLSIZE - 1, CELLSIZE - 1), c, bf
  next y,x
end sub

function count_neighbours(cell() as tCell, x as tIndex, y as tIndex, layer as tIndex) as integer
  dim as integer x_nb, y_nb 'neighbour x & y
  dim as integer sum = 0
  for xi as integer = -1 to +1
    x_nb = x + xi
    if x_nb < 0 then
      x_nb = ubound(cell,2)
    elseif x_nb > ubound(cell,2) then
      x_nb = 0
    end if
    for yi as integer = -1 to +1
      if xi = 0 and yi = 0 then continue for 'skip self
      y_nb = y + yi
      if y_nb < 0 then
        y_nb = ubound(cell,3)
      elseif y_nb >ubound(cell,3) then
        y_nb = 0
      end if
      if cell(layer, x_nb, y_nb) <> DEAD then sum +=1
    next
  next
  return sum
end function

sub update_cells(cell() as tCell, from_layer as integer)
  dim as integer neighbours, to_layer = from_layer xor 1
  for x as integer = 0 to ubound(cell,2)
    for y as integer = 0 to ubound(cell,3)
      neighbours = count_neighbours(cell(), x, y, from_layer)
      if cell(from_layer, x, y) = DEAD then
        if neighbours = 3 then
          cell(to_layer, x, y) = neighbours 'ALIVE '(born)
        else
          cell(to_layer, x, y) = DEAD
        end if
      else 'cell is alive
        if neighbours >= 1 and neighbours <= 5 then
          cell(to_layer, x, y) = 2 'neighbours 'ALIVE
        else
          cell(to_layer, x, y) = DEAD '(dies)
        end if
      end if
    next
  next
end sub
'
' main
'
screenres SW, SH, 32
width SW \ 8, SH \ 16

dim as tIndex layer = 0
randomize timer()
init_cells(cell(), layer)
while not multikey(1) 'escape key
  update_cells(cell(), layer)
  layer xor= 1
  draw_cells(cell(), layer)
  sleep 10
wend

More Life-like cellular automata: https://www.conwaylife.com/wiki/List_of ... r_automata

This one was missing in the list. I named it the B5678/S5678 'racetrack generator':

Code: Select all

type tIndex as uinteger ' the native is fast for 32/64-bit
type tColor as ulong ' use ulong allways
type tCell  as ubyte

const as tCell ALIVE = 1
const as tCell DEAD  = 0
const as integer CELLSIZE = 2
const as integer SW = 800, SH = 600 'screen width & height

dim shared as tCell cell(1,SW \ CELLSIZE - 1, SH \ CELLSIZE - 1) '2 cell grids
dim shared as tColor colors(0 to 8) = {_
   &hff000000, &hff0000ff, &hff00ff00, &hffff0000, _
   &hff00ffff, &hffffff00, &hffff00ff, &hffffffff, &hff000000}

sub init_cells(cell() as tCell, layer as tIndex)
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    cell(layer, x, y) = iif(rnd < 0.5, ALIVE, DEAD)
  next y,x
end sub

sub draw_cells(cell() as tCell, layer as tIndex)
  dim as tColor c
  for x as tIndex = 0 to ubound(cell,2)
  for y as tIndex = 0 to ubound(cell,3)
    c = colors(cell(layer, x, y))
    line(x * CELLSIZE, y * CELLSIZE) - step(CELLSIZE - 1, CELLSIZE - 1), c, bf
  next y,x
end sub

function count_neighbours(cell() as tCell, x as tIndex, y as tIndex, layer as tIndex) as integer
  dim as integer x_nb, y_nb 'neighbour x & y
  dim as integer sum = 0
  for xi as integer = -1 to +1
    x_nb = x + xi
    if x_nb < 0 then
      x_nb = ubound(cell,2)
    elseif x_nb > ubound(cell,2) then
      x_nb = 0
    end if
    for yi as integer = -1 to +1
      if xi = 0 and yi = 0 then continue for 'skip self
      y_nb = y + yi
      if y_nb < 0 then
        y_nb = ubound(cell,3)
      elseif y_nb >ubound(cell,3) then
        y_nb = 0
      end if
      if cell(layer, x_nb, y_nb) <> DEAD then sum +=1
    next
  next
  return sum
end function

'B5678/S5678

sub update_cells(cell() as tCell, from_layer as integer)
  dim as integer neighbours, to_layer = from_layer xor 1
  for x as integer = 0 to ubound(cell,2)
    for y as integer = 0 to ubound(cell,3)
      neighbours = count_neighbours(cell(), x, y, from_layer)
      if cell(from_layer, x, y) = DEAD then
        if neighbours >= 5 and neighbours <= 8 then
          cell(to_layer, x, y) = neighbours 'ALIVE '(born)
        else
          cell(to_layer, x, y) = DEAD
        end if
      else 'cell is alive
        if neighbours >= 4 and neighbours <= 8 then
          cell(to_layer, x, y) = neighbours 'ALIVE
        else
          cell(to_layer, x, y) = DEAD '(dies)
        end if
      end if
    next
  next
end sub
'
' main
'
screenres SW, SH, 32
width SW \ 8, SH \ 16

dim as tIndex layer = 0
randomize timer()
init_cells(cell(), layer)
while not multikey(1) 'escape key
  update_cells(cell(), layer)
  layer xor= 1
  draw_cells(cell(), layer)
  sleep 10
wend
Gunslinger
Posts: 62
Joined: Mar 08, 2016 19:10
Location: The Netherlands

Re: Conway's game of life without borders.

Postby Gunslinger » Dec 26, 2021 19:55

Hi, i like to share my version of game of life with a little modification.
Looks like a race track generator now because of the modification i did.
Press escape to exit.

Code: Select all

const scr_w = 1920
const scr_h = 1080
screenres scr_w, scr_h, 8, 2, 0
screenset 1

dim shared a(-1 to scr_w, -1 to scr_h) as ubyte ' alive
dim shared n(scr_w-1, scr_h-1) as ubyte             ' neighbors
dim count as ubyte
dim as integer mx, my, mb

for i as integer = 0 to scr_w*scr_h
   a(rnd*scr_w, rnd*rnd*scr_h) = 1
next

do
   for y as integer = 0 to scr_h-1
      for x as integer = 0 to scr_w-1
         count = a(x-1, y-1) + a(x  , y-1) + a(x+1, y-1) +_
               a(x-1, y  )               + a(x+1, y  ) +_
               a(x-1, y+1) + a(x  , y+1) + a(x+1, y+1)
         n(x,y) = count
      next
   next
   
   for y as integer = 0 to scr_h-1
      for x as integer = 0 to scr_w-1
         'pset (x, y), n(x,y)
         if (a(x, y) = 1 and n(x, y) = 2) or n(x, y) < 4 then
            pset (x, y), n(x, y) * 15
            a(x, y) = 1
         else
            pset (x, y), n(x, y) * 15
            a(x, y) = 0
         end if
      next
   next
   
   ScreenSync
   screencopy 1, 0
loop while inkey<>chr(27)

sleep

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 5 guests