steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

game-of-life: cleanup play/stop and some count-neighbors.

windows-high-dpi
John Benediktsson 2018-03-12 08:43:05 -07:00
parent 18a3bd0c4c
commit bf010ba1a5
1 changed files with 9 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
extra/game-of-life/game-of-life.factor
View File

@ -23,23 +23,25 @@ IN: game-of-life
] map! drop ; ] map! drop ;
:: wraparound ( x min max -- y ) :: wraparound ( x min max -- y )
x min fixnum< [ max ] [ x max fixnum> min x ? ] if ; inline x min < [ max ] [ x max > min x ? ] if ; inline
:: count-neighbors ( grid -- counts ) :: count-neighbors ( grid -- counts )
grid grid-dim { fixnum fixnum } declare :> ( rows cols ) grid grid-dim { fixnum fixnum } declare :> ( rows cols )
rows 1 - { fixnum } declare :> max-rows
cols 1 - { fixnum } declare :> max-cols
rows [ cols <byte-array> ] replicate :> neighbors rows [ cols <byte-array> ] replicate :> neighbors
grid { array } declare [| row j | grid { array } declare [| row j |
j 1 fixnum-fast 0 rows 1 fixnum-fast wraparound j 1 - 0 max-rows wraparound
j j
j 1 fixnum+fast 0 rows 1 fixnum-fast wraparound j 1 + 0 max-rows wraparound
[ neighbors nth-unsafe { byte-array } declare ] tri@ :> [ neighbors nth-unsafe { byte-array } declare ] tri@ :>
( above same below ) ( above same below )
row { bit-array } declare [| cell i | row { bit-array } declare [| cell i |
cell [ cell [
i 1 fixnum-fast 0 cols 1 fixnum-fast wraparound i 1 - 0 max-cols wraparound
i i
i 1 fixnum+fast 0 cols 1 fixnum-fast wraparound i 1 + 0 max-cols wraparound
[ [ above [ 1 fixnum+fast ] change-nth-unsafe ] tri@ ] [ [ above [ 1 fixnum+fast ] change-nth-unsafe ] tri@ ]
[ nip [ same [ 1 fixnum+fast ] change-nth-unsafe ] bi@ ] [ nip [ same [ 1 fixnum+fast ] change-nth-unsafe ] bi@ ]
@ -156,18 +158,14 @@ SYMBOL: last-click
] change-size relayout-1 ; ] change-size relayout-1 ;
:: com-play ( gadget -- ) :: com-play ( gadget -- )
gadget timer>> thread>> [ gadget timer>> restart-timer ;
gadget timer>> start-timer
] unless ;
:: com-step ( gadget -- ) :: com-step ( gadget -- )
gadget grid>> next-step gadget grid>> next-step
gadget relayout-1 ; gadget relayout-1 ;
:: com-stop ( gadget -- ) :: com-stop ( gadget -- )
gadget timer>> thread>> [ gadget timer>> stop-timer ;
gadget timer>> stop-timer
] when ;
:: com-clear ( gadget -- ) :: com-clear ( gadget -- )
gadget grid>> [ clear-bits ] each gadget grid>> [ clear-bits ] each