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

game-of-life: more ugly faster code.

windows-high-dpi
John Benediktsson 2018-03-11 11:31:20 -07:00
parent 2b1dc5a376
commit ac1029e8eb
1 changed files with 32 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,7 +1,7 @@
! Copyright (C) 2018 John Benediktsson ! Copyright (C) 2018 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: accessors arrays assocs bit-arrays calendar USING: accessors arrays assocs bit-arrays byte-arrays calendar
colors.constants combinators combinators.short-circuit fry colors.constants combinators combinators.short-circuit fry
kernel kernel.private locals math math.order math.private kernel kernel.private locals math math.order math.private
math.ranges namespaces opengl random sequences sequences.private math.ranges namespaces opengl random sequences sequences.private
@ -16,34 +16,41 @@ IN: game-of-life
: grid-dim ( grid -- rows cols ) : grid-dim ( grid -- rows cols )
[ length ] [ first length ] bi ; [ length ] [ first length ] bi ;
: random-grid! ( grid -- )
[
[ length>> ] [ underlying>> length random-bytes ] bi
bit-array boa
] 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 fixnum< [ max ] [ x max fixnum> 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 <iota> [| j | rows [ cols <byte-array> ] replicate :> neighbors
cols <iota> [| i | grid { array } declare [| row j |
{ -1 0 1 } [ row { bit-array } declare [| cell i |
{ -1 0 1 } [ cell [
2dup [ 0 eq? ] both? [ 2drop f ] [ { -1 0 1 } [| y |
[ i fixnum+fast 0 cols 1 - wraparound ] y j fixnum+fast 0 rows 1 fixnum-fast wraparound
[ j fixnum+fast 0 rows 1 - wraparound ] bi* neighbors nth-unsafe { byte-array } declare
{ fixnum fixnum } declare grid { -1 0 1 } [| x |
{ array } declare nth-unsafe x y [ 0 eq? ] both? [ drop ] [
{ bit-array } declare nth-unsafe x i fixnum+fast 0 cols 1 fixnum-fast wraparound
swap [ 1 fixnum+fast ] change-nth-unsafe
] if ] if
] with count ] with each
] map-sum ] each
] map ] when
] map ; ] each-index
] each-index neighbors ;
:: next-step ( grid -- ) :: next-step ( grid -- )
grid count-neighbors :> neighbors grid count-neighbors { array } declare :> neighbors
grid [| row j | grid { array } declare [| row j |
row [| cell i | j neighbors nth-unsafe { byte-array } declare :> neighbor-row
i j neighbors row { bit-array } declare [| cell i |
{ array } declare nth-unsafe i neighbor-row nth-unsafe
{ array } declare nth-unsafe
cell [ cell [
2 3 between? i j grid 2 3 between? i j grid
{ array } declare nth-unsafe { array } declare nth-unsafe
@ -94,8 +101,8 @@ M: grid-gadget pref-dim*
:: draw-cells ( gadget -- ) :: draw-cells ( gadget -- )
COLOR: black gl-color COLOR: black gl-color
gadget size>> :> size gadget size>> :> size
gadget grid>> [| row j | gadget grid>> { array } declare [| row j |
row [| cell i | row { bit-array } declare [| cell i |
cell [ cell [
i j [ size * ] bi@ 2array i j [ size * ] bi@ 2array
{ size size } gl-fill-rect { size size } gl-fill-rect
@ -169,10 +176,7 @@ SYMBOL: last-click
gadget relayout-1 ; gadget relayout-1 ;
:: com-random ( gadget -- ) :: com-random ( gadget -- )
gadget grid>> [ gadget grid>> random-grid! gadget relayout-1 ;
[ length>> ] [ underlying>> length random-bytes ] bi
bit-array boa
] map! drop gadget relayout-1 ;
:: com-glider ( gadget -- ) :: com-glider ( gadget -- )
gadget grid>> :> grid gadget grid>> :> grid