retroforth/example/conways-life.retro

119 lines
3.7 KiB
Text
Raw Normal View History

# Conway's Game of Life
The Game of Life, also known simply as Life, is a cellular automaton
devised by the British mathematician John Horton Conway in 1970.
The universe of the Game of Life is an infinite, two-dimensional
orthogonal grid of square cells, each of which is in one of two
possible states, alive or dead, (or populated and unpopulated,
respectively). Every cell interacts with its eight neighbours, which
are the cells that are horizontally, vertically, or diagonally
adjacent. At each step in time, the following transitions occur:
- Any live cell with fewer than two live neighbours dies, as if by
underpopulation.
- Any live cell with two or three live neighbours lives on to the
next generation.
- Any live cell with more than three live neighbours dies, as if
by overpopulation.
- Any dead cell with exactly three live neighbours becomes a live
cell, as if by reproduction.
The initial pattern constitutes the seed of the system. The first
generation is created by applying the above rules simultaneously to
every cell in the seed; births and deaths occur simultaneously, and
the discrete moment at which this happens is sometimes called a tick.
Each generation is a pure function of the preceding one. The rules
continue to be applied repeatedly to create further generations.
Taken from `https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life`
# The Code
This is my take on implementing this in RETRO.
I first wrote a quick helper to inline a representation of part
of the world.
~~~
:w/l [ $. eq? [ #0 ] [ #1 ] choose , ] s:for-each ;
~~~
I then define the intitial world. This is a 20x20 grid.
~~~
'World d:create
'.................... w/l
'.................... w/l
'.................... w/l
'..ooo............... w/l
'....o............... w/l
'...o................ w/l
'.................... w/l
'.................... w/l
'.................... w/l
'.................... w/l
'.................... w/l
'....ooo............. w/l
'.................... w/l
'.................... w/l
'.................... w/l
'........ooo......... w/l
'.......ooo.......... w/l
'.................... w/l
'.................... w/l
'.................... w/l
~~~
Space is also reserved for the *next generation*.
~~~
'Next d:create
#20 #20 * allot
~~~
~~~
{{
'Surrounding var
:get (rc-v)
dup-pair [ #0 #19 n:between? ] bi@ and
[ &World + [ #20 * ] dip + fetch ] [ drop-pair #0 ] choose ;
:neighbor? (rc-) get &Surrounding v:inc-by ;
:NW (rc-rc) dup-pair [ n:dec ] bi@ neighbor? ;
:NN (rc-rc) dup-pair [ n:dec ] dip neighbor? ;
:NE (rc-rc) dup-pair [ n:dec ] dip n:inc neighbor? ;
:WW (rc-rc) dup-pair n:dec neighbor? ;
:EE (rc-rc) dup-pair n:inc neighbor? ;
:SW (rc-rc) dup-pair [ n:inc ] dip n:dec neighbor? ;
:SS (rc-rc) dup-pair [ n:inc ] dip neighbor? ;
:SE (rc-rc) dup-pair [ n:inc ] bi@ neighbor? ;
:count (rc-rcn)
#0 !Surrounding NW NN NE
WW EE
SW SS SE @Surrounding ;
:alive (rc-n)
count #2 #3 n:between? [ #1 ] if; #0 ;
:dead (rc-n)
count #3 eq? [ #1 ] if; #0 ;
:new-state (rc-n)
dup-pair get #1 eq? &alive &dead choose ;
:set (nrc-) &Next + [ #20 * ] dip + store ;
:cols (r-)
#20 [ I over swap new-state rot rot set ] times<with-index> drop ;
:output (n-) n:-zero? [ $o ] [ $. ] choose c:put sp ;
---reveal---
:display (-)
nl &World #20 [ #20 [ fetch-next output ] times nl ] times drop ;
:gen (-)
#20 [ I cols ] times<with-index> &Next &World #20 #20 * copy ;
}}
{{
:divide #20 [ $- c:put ] times sp 'Gen:_ s:put dup n:put nl ;
---reveal---
:gens (n-) #0 swap [ display divide n:inc gen ] times drop ;
}}
#12 gens