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

game-of-life: small updates.

windows-high-dpi
John Benediktsson 2018-03-09 14:32:30 -08:00
parent efb2f0ed55
commit c24779d27e
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -35,13 +35,11 @@ CONSTANT: neighbors {
grid count-neighbors :> neighbors grid count-neighbors :> neighbors
grid [| row j | grid [| row j |
row [| cell i | row [| cell i |
i j neighbors nth nth :> n i j neighbors nth nth
cell [ cell [
n 2 3 between? i j grid nth set-nth 2 3 between? i j grid nth set-nth
] [ ] [
n 3 = [ 3 = [ t i j grid nth set-nth ] when
t i j grid nth set-nth
] when
] if ] if
] each-index ] each-index
] each-index ; ] each-index ;
@ -55,9 +53,6 @@ TUPLE: grid-gadget < gadget grid size timer ;
dup '[ _ [ grid>> next-step ] [ relayout-1 ] bi ] dup '[ _ [ grid>> next-step ] [ relayout-1 ] bi ]
f 1/5 seconds <timer> >>timer ; f 1/5 seconds <timer> >>timer ;
M: grid-gadget graft*
[ timer>> start-timer ] [ call-next-method ] bi ;
M: grid-gadget ungraft* M: grid-gadget ungraft*
[ timer>> stop-timer ] [ call-next-method ] bi ; [ timer>> stop-timer ] [ call-next-method ] bi ;
@ -88,7 +83,8 @@ M: grid-gadget pref-dim*
gadget grid>> [| row j | gadget grid>> [| row j |
row [| cell i | row [| cell i |
cell [ cell [
i j [ size * ] bi@ 2array { size size } gl-fill-rect i j [ size * ] bi@ 2array
{ size size } gl-fill-rect
] when ] when
] each-index ] each-index
] each-index ; ] each-index ;
@ -110,13 +106,16 @@ M: grid-gadget pref-dim*
M: grid-gadget draw-gadget* M: grid-gadget draw-gadget*
[ update-grid ] [ draw-cells ] [ draw-lines ] tri ; [ update-grid ] [ draw-cells ] [ draw-lines ] tri ;
SYMBOL: last-click
:: on-click ( gadget -- ) :: on-click ( gadget -- )
gadget size>> :> size gadget size>> :> size
gadget grid>> grid-dim :> ( rows cols ) gadget grid>> grid-dim :> ( rows cols )
gadget hand-rel first2 [ size /i ] bi@ :> ( i j ) gadget hand-rel first2 [ size /i ] bi@ :> ( i j )
i 0 cols 1 - between? i 0 cols 1 - between?
j 0 rows 1 - between? and [ j 0 rows 1 - between? and [
i j gadget grid>> nth [ not ] change-nth i j gadget grid>> nth
[ not dup last-click set ] change-nth
] when gadget relayout-1 ; ] when gadget relayout-1 ;
:: on-drag ( gadget -- ) :: on-drag ( gadget -- )
@ -125,7 +124,7 @@ M: grid-gadget draw-gadget*
gadget hand-rel first2 [ size /i ] bi@ :> ( i j ) gadget hand-rel first2 [ size /i ] bi@ :> ( i j )
i 0 cols 1 - between? i 0 cols 1 - between?
j 0 rows 1 - between? and [ j 0 rows 1 - between? and [
t i j gadget grid>> nth set-nth last-click get i j gadget grid>> nth set-nth
] when gadget relayout-1 ; ] when gadget relayout-1 ;
: on-scroll ( gadget -- ) : on-scroll ( gadget -- )