new topic     » goto parent     » topic index » view thread      » older message » newer message

It's been a long time since my last (small) contribution, so I'm sending
this. I  hope you'll like it.
It is not as beautiful as Jiri's program in the contributions list, but I
think it illustrates what Eu can easily do, and it is fast and short.
Rob, will you please catalog it on the contributions list?
Excuses for the meaningless variable names and minimal doc.
Enjoy!
Carlos Valdes
-------------------------------------------------------------------------

-------------<THE GAME OF LIFE, Program by J. Carlos Valdes O.>
------------          <jcarlosvo at hotmail.com>
------------            Mexico, august 2000

--  Initial screen randomly generated each game, but soon aquires
--          standard shapes and configurations.
-- When stabilized automatically adds new cells, changes colors and
restarts
--    Toroidal screen: top bottom and left right continuous

include get.e
include file.e
include graphics.e
without type_check

constant L_ROWS= 50
constant L_COLS= 80
global atom s --delay
s=0

procedure delay(atom cc)
    --variable delay between screens
    atom t
    if cc='e' then
  abort(1)
    end if
    if cc='+' then
s-=0.01
    end if
    if s<0 then
s=0
    end if
    if cc='-' then
s+=0.01
    end if
    if s>0.2 then
s=0.2
    end if
    t=time()
    while time()-t<s do
    end while
end procedure

procedure beeps()
    --generates sound
    for j=1 to 10000 do
      sound(1000)
    end for
    sound(0)
end procedure

function calc_pan(object y)
--calculate next screen according to std. rules
object x
integer a,b,c,d,e
x=repeat(0,L_COLS)
x=repeat(x,L_ROWS)
for i = 1 to L_ROWS by 1 do
    for j = 1 to L_COLS by 1 do
a=i-1
if a=0 then
     a=L_ROWS
end if
b=i+1
if b=L_ROWS+1 then
     b=1
end if
c=j-1
if c=0 then
     c=L_COLS
end if
d=j+1
if d=L_COLS+1 then
     d=1
end if
e=y[a][c]+y[a][j]+y[a][d]+
   y[i][c]+        y[i][d]+
   y[b][c]+y[b][j]+y[b][d]
    if e=0 or e=1 then  --cell dies from isolation
x[i][j]=0
    end if
    if e=2 then
x[i][j]=y[i][j]    --cell lives
    end if
    if e=3 then
x[i][j]=1
    end if
    if e>=4 then        --cell dies from overpopulation
x[i][j]=0
    end if
    end for
end for
return x
end function

procedure draw_pan(object z)
--draw screen
object y
y=z
for i=1  to L_ROWS by 1 do
    for j=1 to L_COLS by 1 do
if z[i][j]=1 then
     y[i][j]='O'
else
     y[i][j]=' '
end if
    end for
end for
    for i=1 to L_ROWS-1 do
position(i,1)
puts(1,y[i])
    end for
    position(L_ROWS,1)
    puts(1,y[L_ROWS][1..L_COLS-1])
end procedure

function gene_pan(object z)
--generates new cells on previous stabilized screen
for i=1 to L_COLS by 1 do
     z[floor(L_ROWS/3)+rand(floor(L_ROWS/3))]
      [floor(L_COLS/3)+rand(floor(L_COLS/3))]=1
end for
return z
end function

atom cc
object u,v,w
integer a,b,c,d

cursor(NO_CURSOR)
a=text_rows(L_ROWS)
--? video_config()

puts(1,"THE GAME OF LIFE, Program by Carlos Valdes\n")
puts(1,"\nPlease remember: e to exit at any time,"&
" + faster, - slower, Enter to begin")
if wait_key()='e' then
    abort(1)
end if

w=repeat(0,5)   --store 5 configs to detect stagnation
u=repeat(0,L_COLS)
u=repeat(u,L_ROWS)
v=u
while 1 do
    u=gene_pan(u)
    b=rand(8)
    c=rand(7)+8 --skip blinking chars:  do not use c=16
    bk_color(b)
    text_color(c)
    clear_screen()
    beeps()
  while 1 do
    draw_pan(u)
    u=calc_pan(u)
    w[5]=w[4]
    w[4]=w[3]
    w[3]=w[2]
    w[2]=w[1]
    w[1]=u
    d=0
    for i=2 to 5 by 1 do
if compare(u,w[i])=0 then
     d=1
     exit
end if
    end for
    if d=1 then
exit
    end if
    cc=get_key()
    delay(cc)
  end while
end while
-------------------------------------------------------------



_________________________________________________________________________
Get Your Private, Free E-mail from MSN Hotmail at http://www.hotmail.com.

Share information about yourself, create your own public profile at
http://profiles.msn.com.

new topic     » goto parent     » topic index » view thread      » older message » newer message

Search



Quick Links

User menu

Not signed in.

Misc Menu