Conway's game of life

Game development specific discussions.
Post Reply
ron77
Posts: 212
Joined: Feb 21, 2019 19:24

Conway's game of life

Post by ron77 »

hello all...

here is a code of Conway's game of life - try it out and tell me if it works properly as it should - i have a feeling something is not right with the algorithm...

Code: Select all

SCREEN 19

DIM x AS INTEGER = 99, y AS INTEGER = 36
DIM grid(0 TO 100,0 TO 37) AS INTEGER
DIM As Integer gen, n, nei, was


RANDOMIZE TIMER


FOR x AS INTEGER = 0 TO 100
   FOR y AS INTEGER = 0 TO 37
      grid(x,y) = INT(RND*2)      
   NEXT
NEXT

SUB game(arr() AS INTEGER, was AS INTEGER, nei AS integer)
   DIM n AS INTEGER
   FOR x AS INTEGER =1 TO 99
      FOR y AS INTEGER = 1 TO 36
         'IF x-1 < 1 THEN x = 1
         'IF x +1 > 99 THEN x = 99
         'IF y-1 < 1 THEN y = 1
         'IF y +1> 36 THEN y = 36
         nei = arr( x - 1, y - 1) +arr( x , y - 1)
      nei = nei + arr( x + 1, y -1)
      nei = nei + arr( x - 1, y) + arr( x + 1, y)
      nei = nei + arr( x - 1, y + 1)
      nei = nei + arr( x, y + 1) +arr( x + 1, y + 1)
      was =arr( x, y)
      If was =0 Then
        If nei =3 Then n =1 Else n =0
      Else
        If nei =3  Or nei =2 Then n =1 Else n =0
      End IF
      arr(x,y) = n
      NEXT
   NEXT
END SUB


SUB PRINT_TO_SCREEN(x AS INTEGER, y AS INTEGER, arr()AS integer)
   IF (arr(x,y)) = 1 THEN
      LOCATE y, x : PRINT CHR(219);
   ELSEIF (arr(x,y)) = 0 THEN
      LOCATE y, x : PRINT " ";
      
   ENDIF
END SUB


SUB print_grid(grid() AS INTEGER)
   FOR x AS INTEGER = 0 TO 100
      FOR y AS INTEGER = 0 TO 37
         PRINT_TO_SCREEN(x,y,grid())
      NEXT
   NEXT
END SUB

DIM s AS STRING = "in memory of JOHN HORTON CONWAY 1937 - 2020"
DIM t AS STRING = "CONWAY'S GAME OF LIFE"
LOCATE 15, (LOWORD(WIDTH) - LEN(s)) SHR 1 : PRINT s
LOCATE 18, (LOWORD(WIDTH) - LEN(t)) SHR 1 : PRINT t
SLEEP 
CLS

DO 
   GAME(grid(),was,nei)
   sleep 100
   PRINT_GRID(grid())
LOOP UNTIL INKEY = CHR(27)
SLEEP
ron77
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Conway's game of life

Post by counting_pine »

I think that you will need to keep the state of arr(,) unmodified until you’ve finished checking for neighbours.
This probably means maintaining a separate copy of the array, or at least the last couple of columns of it (seeing that you are sweeping the array from the left to right).
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: Conway's game of life

Post by angros47 »

Yes, it's the most common mistake made when writing a Conway's life program: using the same array both as source and destination, because in that way some cells are overwritten when they are still needed to compute the values for other cells.

The same thing is necessary when writing a convolution filter.

By the way, the simplest solution is to use two arrays, but if you want to use a single array you can use different bits for each cell (so far, only one bit is used, a cell can have only values 0 and 1: by adding the possibility to have value 2 and 3 an implementation that uses a single array would be possible)
ron77
Posts: 212
Joined: Feb 21, 2019 19:24

Re: Conway's game of life

Post by ron77 »

thank you :) you where right...

updated working code:

Code: Select all

SCREEN 19

DIM x AS INTEGER = 99, y AS INTEGER = 36
DIM SHARED AS INTEGER grid(0 TO 100,0 TO 37), _new_grid(0 TO 100, 0 TO 37)
DIM As Integer gen, n, nei, was


RANDOMIZE TIMER


FOR x AS INTEGER = 0 TO 100
   FOR y AS INTEGER = 0 TO 37
      grid(x,y) = INT(RND*2)      
   NEXT
NEXT

SUB game(arr() AS INTEGER, was AS INTEGER, nei AS INTEGER, arr2() AS INTEGER)
   DIM n AS INTEGER
   FOR x AS INTEGER =1 TO 99
      FOR y AS INTEGER = 1 TO 36
         'IF x-1 < 1 THEN x = 1
         'IF x +1 > 99 THEN x = 99
         'IF y-1 < 1 THEN y = 1
         'IF y +1> 36 THEN y = 36
         nei = arr( x - 1, y - 1) +arr( x , y - 1)
      nei = nei + arr( x + 1, y -1)
      nei = nei + arr( x - 1, y) + arr( x + 1, y)
      nei = nei + arr( x - 1, y + 1)
      nei = nei + arr( x, y + 1) +arr( x + 1, y + 1)
      was =arr( x, y)
      If was =0 Then
        If nei =3 Then n =1 Else n =0
      Else
        If nei =3  Or nei =2 Then n =1 Else n =0
      End IF
      arr2(x,y) = n
      NEXT
   NEXT
END SUB

SUB swap_grid(arr1() AS INTEGER, arr2() AS INTEGER)
   FOR x AS INTEGER = 0 TO 100
      FOR y AS INTEGER = 0 TO 37
         arr1(x,y) = arr2(x,y)
      NEXT
   NEXT
END SUB

SUB PRINT_TO_SCREEN(x AS INTEGER, y AS INTEGER, arr()AS integer)
   IF (arr(x,y)) = 1 THEN
      LOCATE y, x : PRINT CHR(219);
   ELSEIF (arr(x,y)) = 0 THEN
      LOCATE y, x : PRINT " ";
      
   ENDIF
END SUB


SUB print_grid(grid() AS INTEGER)
   FOR x AS INTEGER = 0 TO 100
      FOR y AS INTEGER = 0 TO 37
         PRINT_TO_SCREEN(x,y,grid())
      NEXT
   NEXT
END SUB

DIM s AS STRING = "in memory of JOHN HORTON CONWAY 1937 - 2020"
DIM t AS STRING = "CONWAY'S GAME OF LIFE"
LOCATE 15, (LOWORD(WIDTH) - LEN(s)) SHR 1 : PRINT s
LOCATE 18, (LOWORD(WIDTH) - LEN(t)) SHR 1 : PRINT t
SLEEP 
CLS

DO 
   GAME(grid(),was,nei, _new_grid())
   sleep 100
   SWAP_GRID(grid(),_new_grid())
   SLEEP 100
   PRINT_GRID(grid())
LOOP UNTIL INKEY = CHR(27)
SLEEP
ron77 :)

Image
Last edited by ron77 on Feb 10, 2021 13:03, edited 4 times in total.
sero
Posts: 59
Joined: Mar 06, 2018 13:26
Location: USA

Re: Conway's game of life

Post by sero »

ron77 wrote:Conway's game of life
Nice work. Thought I'd add my own pixelated version of your code:

Code: Select all

dim shared as long W = 640
dim shared as long H = 480

screenres W, H, 32
W -= 1
H -= 1

DIM SHARED AS long grid(0 TO W,0 TO H), _new_grid(0 TO W, 0 TO H)
DIM As long gen, n, nei, was
DIM as long x, y


RANDOMIZE TIMER


FOR x = 0 TO W
   FOR y = 0 TO H
      grid(x,y) = INT(RND*2)     
   NEXT
NEXT

SUB game(arr() AS long, was AS long, nei AS long, arr2() AS long)
   DIM n AS long
   FOR x AS long =1 TO (W-1)
      FOR y AS long = 1 TO (H-1)
         'IF x-1 < 1 THEN x = 1
         'IF x +1 > 99 THEN x = 99
         'IF y-1 < 1 THEN y = 1
         'IF y +1> 36 THEN y = 36
         nei = arr( x - 1, y - 1) +arr( x , y - 1)
      nei = nei + arr( x + 1, y -1)
      nei = nei + arr( x - 1, y) + arr( x + 1, y)
      nei = nei + arr( x - 1, y + 1)
      nei = nei + arr( x, y + 1) +arr( x + 1, y + 1)
      was =arr( x, y)
      If was =0 Then
        If nei =3 Then n =1 Else n =0
      Else
        If nei =3  Or nei =2 Then n =1 Else n =0
      End IF
      arr2(x,y) = n
      NEXT
   NEXT
END SUB

SUB swap_grid(arr1() AS long, arr2() AS long)
   FOR x AS long = 0 TO (W-1)
      FOR y AS long = 0 TO (H-1)
         arr1(x,y) = arr2(x,y)
      NEXT
   NEXT
END SUB

SUB PRINT_TO_SCREEN(x AS long, y AS long, arr()AS long)
  IF (arr(x,y)) = 1 THEN
    pset(x,y),rgb(255,255,255)
  ELSEIF (arr(x,y)) = 0 THEN
    pset(x,y),rgb(0,0,0)
  ENDIF
END SUB


SUB print_grid(grid() AS long)
   FOR x AS long = 0 TO (W-1)
      FOR y AS long = 0 TO (H-1)
         PRINT_TO_SCREEN(x,y,grid())
      NEXT
   NEXT
END SUB

DIM s AS STRING = "in memory of JOHN HORTON CONWAY 1937 - 2020"
DIM t AS STRING = "CONWAY'S GAME OF LIFE"
LOCATE 15, (LOWORD(WIDTH) - LEN(s)) SHR 1 : PRINT s
LOCATE 18, (LOWORD(WIDTH) - LEN(t)) SHR 1 : PRINT t
SLEEP
CLS

DO
   GAME(grid(),was,nei, _new_grid())
   SWAP_GRID(grid(),_new_grid())
   screenlock()
     PRINT_GRID(grid())
   screenunlock()
   sleep 15
LOOP UNTIL INKEY = CHR(27)
SLEEP
Last edited by sero on Feb 12, 2021 3:28, edited 1 time in total.
ron77
Posts: 212
Joined: Feb 21, 2019 19:24

Re: Conway's game of life

Post by ron77 »

thank you @Sero for the beautiful pixel version of the game :)

and thank you @counting_pine and @angros47 for the help to fix the code... :)

and also thanks to Hesekiel from the FB discord server for the help with the code also :)

ron77
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Conway's game of life

Post by D.J.Peters »

Code: Select all

sub GameOfLive(i as ubyte ptr, _
               o as ubyte ptr, _
               w as uinteger, _
               rM as uinteger)
  if (rM < w) then o[rM]=0 : return
  dim as uinteger w1=w-1
  if (rM>(w*w1)) then o[rM]=0 : return
  dim as long iw=rM mod w
  if (iw=0 ) then o[rM]=0 : return
  if (iw=w1) then o[rM]=0 : return
  dim as uinteger rU = rM - w
  dim as uinteger rD = rM + w
  dim as uinteger nb = any
  nb  = i[rU-1] + i[rU] + i[rU+1]
  nb += i[rM-1]     +     i[rM+1]
  nb += i[rD-1] + i[rD] + i[rD+1]
  if (nb = 3) or (i[rM] and (nb=2)) then
   o[rM] = 1
  else
   o[rM] = 0
  end if
end sub

const GAME_WIDTH = 512
const GAME_SIZE  = GAME_WIDTH*GAME_WIDTH
'
' main
'
'randomize timer()
screenres GAME_WIDTH,GAME_WIDTH,8,2
screenset 1,0
var iImg = ImageCreate(GAME_WIDTH,GAME_WIDTH,0)
var oImg = ImageCreate(GAME_WIDTH,GAME_WIDTH,0)
dim as ubyte ptr pIn,pOut
ImageInfo iImg,,,,,pIn
ImageInfo oImg,,,,,pOut
for y as uinteger = 0 to GAME_WIDTH-1
  for x as uinteger = 0 to GAME_WIDTH-1
    if rnd()>.5 then pset iImg,(x,y),1
  next
next

dim as integer fps,frames
dim as double tStart = timer()
while inkey()=""
  for id as uinteger = 0 to GAME_SIZE-1
    GameOfLive(pIn,pOut,GAME_WIDTH,ID)
  next
  swap pIn,pOut
  frames+=1
  if (frames mod 60)=0 then
    dim as double tNow=timer()
    fps=60/(tNow-tStart)
    tStart=tNow
  end if
  draw string oImg,(0,0),"fps: " & fps
  put (0,0),oImg,PSET
  flip
wend
sleep
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Conway's game of life

Post by BasicCoder2 »

Good old game of life usually one of the first programs a beginner might write.
Here is one of the old ones I wrote some time ago dug out of the archives.
Personally I find dark blue on black hard on the eyes.

Code: Select all

SCREENRES 480,480,32
dim as integer v,p,q,s,c
const WW = 120   'world width
const WH = 120   'world height
dim  as integer world1(WW,WH)
dim  as integer world2(WW,WH)  'hold results
dim  as integer generations
dim  as integer mag
mag = 4
'initialize start'


for y as integer = 1 to 12
    for x as integer = 1 to 37
        read world1(x+50,y+50)
    next x
next y

        
do
    
    'display world1
    screenlock
    for y as integer = 0 to WH-1
        for x as integer = 0 to WW-1
            if world1(x,y)=1 then
                line(x*mag,y*mag)-(x*mag+mag,y*mag+mag),rgb(255,255,255),bf
            else
                line(x*mag,y*mag)-(x*mag+mag,y*mag+mag),rgb(0,0,0),bf
            end if
        next x
    next y
    generations = generations + 1
    locate 2,1
    print "  generations: ";generations
    line (0,0)-(WW*mag-1,WH*mag-1),rgb(255,0,0),b
    screenunlock
    
  'compute next generation
  c = 0
  FOR x as integer = 0 TO WH-1
    FOR y as integer = 0 TO WW-1
      s = 0
      v = world1(x, y)
      FOR a as integer = -1 TO 1
        FOR b as integer = -1 TO 1
          p = x + a
          q = y + b
          if p<0 then p=WW-1
          if p>WW-1 then p=0
          if q<0 then q=WH-1
          if q>WH-1 then q=0
          s = s + world1(p, q)
        NEXT b
      NEXT a
      IF v = 1 THEN s = s - 1
      IF s < 2 THEN v = 0
      IF s > 3 THEN v = 0
      IF s = 3 THEN v = 1
      IF v = 1 THEN c = c + 1
      world2 (x,y) = v
    NEXT y
  NEXT x

  'copy new generation
  FOR x as integer = 0 TO WH-1
    FOR y as integer = 0 TO WW-1
      world1(x,y) = world2(x,y)
    NEXT y
  NEXT x
  
  sleep 2

loop until multikey(&H01)

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,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,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,0
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,0
data 0,1,1,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,0
data 0,1,1,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,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,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,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,0
data 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,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,0,0,1,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,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0

thebigh
Posts: 43
Joined: Dec 14, 2018 11:11

Re: Conway's game of life

Post by thebigh »

You can cut the running time down by not copying from one array to another. Just have a single array of dimensions WIDTH x HEIGHT x 2. One of the two layers contains the current generation that you're reading from and the other contains the next generation that you're writing to. Then at the end you just swap which layer you consider to be the current and which the next.
thebigh
Posts: 43
Joined: Dec 14, 2018 11:11

Re: Conway's game of life

Post by thebigh »

Here's my version. It should show what I mean

Code: Select all

#define SIZE 160
#define PIX 4
#define NXT (1-CURR)
#define WHITE rgb(255,255,255)
#define FRAMERATE 1./25

declare sub draw_world( world() as uinteger, CURR as uinteger)
declare sub iterate_world( world() as uinteger, CURR as uinteger)
declare function mm( i as integer ) as uinteger

screenres SIZE*PIX, SIZE*PIX, 32
dim as uinteger world( 0 to SIZE-1, 0 to SIZE-1, 0 to 1 ), CURR = 0
dim as double timed

'randomize world
for x as uinteger = 0 to SIZE - 1
    for y as uinteger = 0 to SIZE - 1
        world(x, y, CURR) = int(rnd*2)
    next y
next x

while inkey()=""
    timed = timer
    draw_world( world(), CURR )
    iterate_world( world(), CURR )
    CURR = NXT
    while timer < timed + FRAMERATE
    wend
    line (0,0)-(PIX*SIZE, PIX*SIZE), 0, BF
wend

sub draw_world( world() as uinteger, CURR as uinteger)
    for x as integer = 0 to SIZE-1
        for y as integer = 0 to SIZE-1
            if world(x, y, CURR) = 1 then line (PIX*x, PIX*y)-(PIX*(x+1), PIX*(y+1)), WHITE, BF
        next y
    next x
end sub

sub iterate_world( world() as uinteger, CURR as uinteger)
    dim as integer sum
    for x as integer = 0 to SIZE-1
        for y as integer = 0 to SIZE-1
            sum = world( mm(x-1), mm(y-1), CURR ) + world( mm(x), mm(y-1), CURR ) _
                + world( mm(x+1), mm(y-1), CURR ) + world( mm(x-1), mm(y), CURR ) _
                + world( mm(x+1), mm(y), CURR ) + world( mm(x-1), mm(y+1), CURR ) _
                + world( mm(x), mm(y+1), CURR ) + world( mm(x+1), mm(y+1), CURR )
            world( x, y, NXT ) = 0
            if sum = 3 then world( x, y, NXT ) = 1
            if sum = 2 and world( x, y, CURR ) = 1 then world( x, y, NXT ) = 1
        next y
    next x
end sub

function mm( i as integer ) as uinteger
    if i=-1 then return SIZE-1
    if i=SIZE then return 0
    return i
end function
Last edited by thebigh on Mar 10, 2021 13:47, edited 1 time in total.
ron77
Posts: 212
Joined: Feb 21, 2019 19:24

Re: Conway's game of life

Post by ron77 »

@thebigh your code has an runtime - error and crashes as soon as it starts to run..

Code: Select all

Aborting due to runtime error 6 (out of bounds array access) at line 46 of fb_game_of_life_one_array.bas::ITERATE_WORLD()
you might wanna examine your code...

i'm on win 10 64 bit ide fbedit compiler fbc 32bit
thebigh
Posts: 43
Joined: Dec 14, 2018 11:11

Re: Conway's game of life

Post by thebigh »

I can't reproduce the runtime error but I think I fixed the bug, which was in the mm function. Try it now.

Did at least the stuff with CURR and NXT make sense?
ron77
Posts: 212
Joined: Feb 21, 2019 19:24

Re: Conway's game of life

Post by ron77 »

hi @thebigh

your code works without runtime error - good job - i got to find time to learn your code it's fascinating... just one array!

and here is a nice picture of your version of game of life - congratulation!

Image

to check for runtime errors you simple compile the bas file with additional parameters such as "fbc -s console -gen gas -Wc -Ofast -exx" that what i use it will compile your code to an executable and will show if there are any errors on run time (i give credit to poal doe who thought me this and gave the exact parameters) i think you can check the FB documentation for what each building parameters is for - basically you run the exe in command prompt and if it crashes or anything it will show the type of runtime error

ron77
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Conway's game of life

Post by BasicCoder2 »

@ron77
i got to find time to learn your code it's fascinating... just one array
There are still two 2d arrays except they are now stored in a 3d array.
The source and destination of the computation is swapped with each cycle.
It is faster to swap an index number to an array than to copy a whole array.
Here is my version again but using one 3d array

Code: Select all

SCREENRES 480,480,32
dim as integer v,p,q,s,c
const WW = 120   'world width
const WH = 120   'world height
dim  as integer world(WW,WH,0 to 1)  '3d array of two 2d layers
dim  as integer generations
dim  as integer mag
mag = 4
'initialize start'
for y as integer = 1 to 12
    for x as integer = 1 to 37
        read world(x+50,y+50,0)
    next x
next y


dim as integer src,des   'source and destination
src = 0
des = 1

do
   
    'display world1
    screenlock
    for y as integer = 0 to WH-1
        for x as integer = 0 to WW-1
            if world(x,y,src)=1 then
                line(x*mag,y*mag)-(x*mag+mag,y*mag+mag),rgb(255,255,255),bf
            else
                line(x*mag,y*mag)-(x*mag+mag,y*mag+mag),rgb(0,0,0),bf
            end if
        next x
    next y
    generations = generations + 1
    locate 2,1
    print "  generations: ";generations
    line (0,0)-(WW*mag-1,WH*mag-1),rgb(255,0,0),b
    screenunlock
   
  'compute next generation
  c = 0
  FOR x as integer = 0 TO WH-1
    FOR y as integer = 0 TO WW-1
      s = 0
      v = world(x, y, src)
      FOR a as integer = -1 TO 1
        FOR b as integer = -1 TO 1
          p = x + a
          q = y + b
          if p<0 then p=WW-1
          if p>WW-1 then p=0
          if q<0 then q=WH-1
          if q>WH-1 then q=0
          s = s + world(p, q,src)
        NEXT b
      NEXT a
      IF v = 1 THEN s = s - 1
      IF s < 2 THEN v = 0
      IF s > 3 THEN v = 0
      IF s = 3 THEN v = 1
      IF v = 1 THEN c = c + 1
      world (x,y,des) = v      'place in destination array
    NEXT y
  NEXT x

  'now swap src and des
  if src = 0 then
      src = 1
      des = 0
  else
      src = 0
      des = 1
  end if
  
 
  sleep 2

loop until multikey(&H01)

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,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,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,0
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,0
data 0,1,1,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,0
data 0,1,1,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,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,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,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,0
data 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,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,0,0,1,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,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Conway's game of life

Post by D.J.Peters »

here are a fullscreen version of game of life

Joshy

Code: Select all

' file: gameoflife_fb.bas

#define DIED 0
#define LIFE 1
sub GameOfLife(oldGeneration as any ptr, _
               newGeneration as any ptr)
  dim as integer x=any,y=any,w=any,h=any,p=any
  dim as ubyte ptr o=any,n=any
  dim as integer m=any,u=any,d=any
  dim as integer neighbors=any
  imageinfo oldGeneration,w,h,,p,o
  imageinfo newGeneration, , ,, ,n
  w-=2:h-=2
  for y = 1 to h
    m=y*p+1 : u=m-p : d=m+p
    for x = 1 to w
      neighbors = o[u-1]+o[u]+o[u+1] + _
                  o[m-1]  +   o[m+1] + _
                  o[d-1]+o[d]+o[d+1]            
      
      if o[m] then
        if neighbors<2 orelse neighbors>3 then n[m]=DIED else n[m]=LIFE
      else
        if neighbors=3 then n[m]=LIFE else n[m]=DIED
      end if      
      u+=1:m+=1:d+=1
    next
  next  
end sub
'
' main
'
randomize timer()
dim as integer iWidth,iHeight
screeninfo iWidth,iHeight
screenres iWidth,iHeight,,2,40
screenset 1,0
palette LIFE,255,255,255
dim as any ptr oldGeneration = imagecreate(iWidth,iHeight,LIFE)
dim as any ptr newGeneration = imagecreate(iWidth,iHeight)
line oldGeneration,(0,0)-(iWidth-1,iHeight-1),DIED,B
for i as integer = 1 to 10000
  'circle oldGeneration,(rnd*iWidth,rnd*iHeight),rnd*iHeight,DIED ',,,,F
  line oldGeneration,(rnd*iWidth,rnd*iHeight)-step(10,10),DIED,BF
next  

dim as double tNow,tLast=timer()
dim as integer iFrames,iFps
while inkey()=""
  GameOfLife(oldGeneration,newGeneration)
  
  put (0,0),newGeneration,PSET
  locate 1,1 : print "fps: " & iFps
  flip
  iFrames+=1 : if iFrames mod 24=0 then tNow=timer():iFps=24/(tNow-tLast):tLast=tNow
  swap oldGeneration,newGeneration
  
wend
Post Reply