Taqoz and Game of Life
Christof Eb.
Posts: 1,214
Inspired by Ross https://forums.parallax.com/discussion/176007/a-lua-luau#latest ( post # 7 ) I wanted to know a little bit about Game of Life and possible speed with Taqoz. So here is a port for Taqoz V2.8. Output to the Ansi terminal.
Have fun,
Christof
`
\ -- Mode: Forth --
\ https://gist.github.com/nfunato/5018107
\ Conway's Game of Life
\ originally from http://rosettacode.org/wiki/Conway's.Game.of.Life#Forth
\ see also http://en.wikipedia.org/wiki/Conway's.Game.of.Life
\ -------------------------------------------------------------------
IFDEF LIFE
oldorg org
FORGET LIFE }
pub LIFE PRINT" GameOfLifeB.fth" ;
0 bytes oldorg
\ The fast wrapping requires dimensions that are powers of 2.
\ CWE: switched for slower wrapping ==> any width allowed
\ (for playing just size, you may set terminal size to 64x17)
alias := constant
- 80 constant .width.
- 30 constant .height.
-
nrows .width. * 2* ;
1 nrows constant .row.
.height. nrows constant .size.
.size. .width. - 1- := wrapper - \ create$ world .size. allot
- .size. bytes world
- world value old
- old .width. + value new
- clear-world world .size. erase ;
- flip-world new old to new to old ;
- foreach-row ( xt -- ) .size. 0 do i over execute .row. +loop drop ;
-
row+ .row. + ;
- row- .row. - ;
- col+ 1+ ;
\ : col- 1- dup .width. and + ; \ avoid borrow into row - col- 1- dup .width. // 0= if .width. + then ; \ for any width
\ : wrap ( i -- i ) [ .size. .width. - 1- ] literal and ;
\ : wrap wrapper and ;
\ : wrap ; - wow@ ( i -- 0/1 ) ( wrap ) old + c@ ;
- wow! ( 0/1 i -- ) ( wrap ) old + c! ;
- ow@ ( i -- 0/1 ) old + c@ ;
- nw! ( 0/1 i -- ) new + c! ;
-
sum-neighbors ( i -- i n )
dup col- row- wow@ over row- wow@ + over col+ row- wow@ +
over col- wow@ + over col+ wow@ +
over col- row+ wow@ + over row+ wow@ + over col+ row+ wow@ + ; - long gen \ generation
- clear clear-world 0 gen ! ;
- age flip-world 1 gen +! ;
- \ the core Game of Life rules: just 3=>born, 2or3=>still alive, else=>die
- gencell ( i -- ) sum-neighbors over ow@ or 3 = 1 and swap nw! ;
- genrow ( i -- ) .width. over + swap do i gencell loop ;
\ : gen ( -- ) ['] genrow foreach-row age ; - gen ( -- ) ' genrow foreach-row age ;
32 := bl - emit-pos ( 0/1-- ) if '*' else bl then emit ;
- showrow ( i -- ) crlf old + .width. over + swap do i c@ emit-pos loop ;
- show ( -- ) ' showrow foreach-row crlf ." Generation " gen @ . ;
- \ alias %XY at-xy
- \ : home 0 0 at-xy ;
- life ( -- ) key drop begin gen %home show key until ;
\ -------------------------------------------------------------------
\ patterns
\
- \ char | constant '|'
- pat' ( i addr len -- )
rot dup 2swap over + swap do
i c@ '|' = if drop row+ dup else
i c@ bl = 1+ over wow! col+ then
loop 2drop ; - count dup len$ ;
- pat ( i c-addr -- ) count pat' ;
- \ sample usage: "pentomino test-pat"
- \ (also you may try "' pentomino test-pat" for random image)
- ini' ( qp x y -- ) .width. * + swap clear pat page %home show ;
- ini ( qp -- ) .width. 2/ .height. 2 - ini' ;
- nex ( -- ) gen %home show ;
- {
- test-pat' ( qp -- )
begin
key case
[char] x of 1 endof
[char] n of nex 0 endof
( do nothing ) 0
endcase
until ; - test-pat ini test-pat' ;
} - \ still lifes
- block. " |" ;
- beehive " **|* *| **" ;
- loaf " **|* *| * *| *" ;
- boat " **|* *| *" ;
- \ oscillators
- blinker " ***" ; \ period 2
- toad " ***| ***" ; \ period 2
- beacon " || **| **" ; \ period 2
- clock " *| || *" ; \ period 2
- pulsar " *****|* *" ; \ period 3 after prelude
- decathlon " **********" ; \ period 15 after prelude
- pulsar3 " " ; \ not yet implemented
- \ spaceships
- glider " *| *|***" ;
- lwss " ****|* | *| *" ; \ light weight space ship
- ship " ****|* *| *| *" ; \ another lwss
- \ breeder (if wide screen)
- 1d-breeder " ******** ***** *** ******* *****" ;
\ : test-1db 1d-breeder .width. 2/ 2/ .height. 2 - ini' test-pat' ; - \ long life
- pentomino " **| **| *" ; \ finally still
- pi. " | **|" ; \ finally oscillator
- diehard " *|**| * ***" ; \ die off after 130-gen
- acorn " *| *|** ***" ; \ spawn 13 gliders in 5206-gen (if wide)
\ -------------------------------------------------------------------
\ some usage demos
\
\ clear 0 glider ini life
{
clear 0 glider ini life
*
*
Generation 0 ok
gen show
* *
**
*
Generation 1 ok
- clear 500 pulsar show
- life
- }
- tst
\ clear
0 blinker
ini
10 for
lap gen lap
%home show \ lap
.lap
next
;
\ 128 * 32
\ Generation 10 35,466,424 cycles= 177,332,120ns @200MHz ok
\ 80 * 30 mit display: 24,029,273 cycles= 120,146,365ns @200MHz ok
\ 80 * 30 ohne display: 17,574,728 cycles= 87,873,640ns @200MHz ok
`
Comments
Impressive ... I think. I get lost about 3 lines in ...