! Copyright (C) 2011 Your name. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays calendar colors.constants combinators kernel locals math math.functions namespaces opengl sequences sequences.generalizations timers tools.continuations ui ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets.canvas ui.gadgets.panes ui.gadgets.tracks ui.gadgets.worlds ui.gestures ui.render ; IN: life SYMBOL: started SYMBOL: paused SYMBOL: stopped TUPLE: cell alive? col row ; TUPLE: board < canvas cells state { timer } ; CONSTANT: BOARD-SIZE 301 CONSTANT: CELL-SIZE 10 SYMBOL: game-board : (board) ( -- board ) game-board get ; : max-cell ( -- x ) BOARD-SIZE CELL-SIZE / truncate ; :: coor>index ( col row -- index ) row max-cell * col + ; :: change-cell ( index -- ) index (board) cells>> [ [ not ] change-alive? ] change-nth ; : board-on-click ( gadget -- ) dup hand-click-rel first2 [ CELL-SIZE / truncate ] bi@ coor>index change-cell relayout-1 ; board H{ { T{ button-up } [ board-on-click ] } } set-gestures : draw-cells ( cells -- ) [| cell | cell alive?>> [ COLOR: red ] [ COLOR: white ] if gl-color CELL-SIZE [ cell col>> * 1 + ] [ cell row>> * 1 + ] bi 2array CELL-SIZE 1 - dup 2array gl-fill-rect ] each ; M: board draw-gadget* ( gadget -- ) cells>> [ draw-cells ] when* ; ! ANCHORS SYMBOLS: topleft bottomleft topright bottomright left right bottom top normal ; :: alive-count ( indexes -- count ) (board) cells>> :> cells indexes [ cells nth ] map 0 [ alive?>> [ 1 + ] when ] reduce ; :: get-neighbours-indexes ( cell index -- indexes ) cell col>> :> col cell row>> :> row max-cell 1 - :> max { { [ col 0 = row 0 = and ] [ 1 max-cell max-cell 1 + 3array ] } { [ row max = col max = and ] [ index max-cell - index 1 - index max-cell - 1 - 3array ] } { [ row max = col 0 = and ] [ index 1 + index max-cell - index max-cell - 1 + 3array ] } { [ row 0 = col max = and ] [ index 1 - index max-cell + index max-cell + 1 - 3array ] } { [ col 0 = ] [ index 1 + index max-cell - index max-cell - 1 + index max-cell + index max-cell + 1 + 5 narray ] } { [ row 0 = ] [ index 1 + index 1 - index max-cell + index max-cell + 1 + index max-cell + 1 - 5 narray ] } { [ col max = ] [ index 1 - index max-cell - index max-cell - 1 - index max-cell + index max-cell + 1 - 5 narray ] } { [ row max = ] [ index 1 + index 1 - index max-cell - index max-cell - 1 - index max-cell - 1 + 5 narray ] } [ index 1 + index 1 - index max-cell - index max-cell - 1 - index max-cell - 1 + index max-cell + index max-cell + 1 + index max-cell + 1 - 8 narray ] } cond ; : get-neighbours-alive ( cell index -- alives ) get-neighbours-indexes alive-count ; :: update-cell ( cell index -- ) cell index get-neighbours-alive :> alives cell alive?>> [ { { [ alives 2 < ] [ index change-cell ] } { [ alives [ 2 = ] [ 3 = ] bi or ] [ ] } { [ alives 3 > ] [ index change-cell ] } } cond ] [ alives 3 = [ index change-cell ] when ] if ; : update-cells ( -- ) (board) cells>> [| cell index | cell index update-cell ] each-index ; : tick ( board -- ) dup state>> started = [ update-cells relayout-1 ] [ drop ] if ; M: board graft* ( gadget -- ) [ [ tick ] curry 100 milliseconds every ] keep timer<< ; M: board ungraft* ( gadget -- ) [ stop-timer f ] change-timer drop ; :: init-cells ( -- ) max-cell iota [| x row | max-cell iota [| y col | cell new f >>alive? row >>row col >>col ] map-index ] map-index concat (board) cells<< ; :: init-game ( -- ) board new-canvas BOARD-SIZE dup 2array >>dim stopped >>state game-board set-global init-cells ; : start-game ( -- ) started (board) state<< ; : pause-game ( -- ) paused (board) state<< ; : stop-game ( -- ) stopped (board) state<< init-cells ; : step-game ( -- ) update-cells (board) relayout-1 ; : build-button-bar ( -- gadget ) horizontal { 5 5 } >>gap "Start" [ drop start-game ] f track-add "Pause" [ drop pause-game ] f track-add "Step" [ drop step-game ] f track-add { 1 1 } 1 track-add "Stop" [ drop stop-game ] f track-add ; : build-ui ( -- gadget ) vertical { 5 5 } >>gap (board) 1 track-add build-button-bar f track-add { 5 5 } { 1 1 } >>fill ; : main ( -- ) [ init-game build-ui world-attributes new "Life Game in Factor" >>title { close-button minimize-button normal-title-bar } >>window-controls open-window ] with-ui ;