module Cellular exposing (..) import Html exposing (..) import Html.Events exposing (..) import Html.Attributes exposing (id, class, classList, style) import Array import Random import Window import Task import Time exposing (Time, second) cellSize : Int cellSize = 10 + 2 type Cell = Alive | Dead type alias Board = Array.Array (Array.Array Cell) type alias Rule = Int -> Cell -> Cell type alias Model = { board : Board , rule : Rule , info : String } initModel : Model initModel = { board = Array.empty --, board = modify 4 4 Alive <| modify 5 5 Alive <| modify 6 5 Alive <| modify 6 4 Alive <| modify 6 3 Alive <| Array.repeat h <| Array.repeat w Dead , rule = (\livingNeighbours cell -> case cell of Alive -> if livingNeighbours < 2 || livingNeighbours > 3 then Dead else Alive _ -> if livingNeighbours == 3 then Alive else Dead) , info = "" } type Msg = NoOp | Step | SetBoard Board | InitializeBoard Window.Size viewRow row = tr [] <| Array.toList <| Array.map (\c -> let cellClass = case c of Alive -> "alive" Dead -> "dead" in td [ class ("cell " ++ cellClass) ] [] ) row viewBoard : Board -> Html Msg viewBoard board = let numCols = Array.length <| Maybe.withDefault Array.empty <| Array.get 0 board calculatedWidth = numCols * cellSize tableWidth = (toString calculatedWidth) ++ "px" in table [ style [ ("width", tableWidth) ] ] <| Array.toList <| Array.map (\r -> viewRow r) board view : Model -> Html Msg view model = div [ onClick Step ] [ viewBoard model.board , div [] [ text model.info ] ] modify : Int -> Int -> Cell -> Board -> Board modify x y newState board = case Array.get y board of Just oldRow -> let newRow = Array.set x newState oldRow newBoard = Array.set y newRow board in newBoard Nothing -> board valueAt : Int -> Int -> Board -> Cell valueAt r c board = Maybe.withDefault Dead <| Array.get c <| Maybe.withDefault Array.empty (Array.get r board) surroundings : Int -> Int -> Board -> Int surroundings r c board = let living cell = case cell of Alive -> 1 _ -> 0 ul = living <| valueAt (r - 1) (c - 1) board uc = living <| valueAt (r - 1) c board ur = living <| valueAt (r - 1) (c + 1) board ml = living <| valueAt r (c - 1) board mr = living <| valueAt r (c + 1) board ll = living <| valueAt (r + 1) (c - 1) board lc = living <| valueAt (r + 1) c board lr = living <| valueAt (r + 1) (c + 1) board in ul + uc + ur + ml + mr + ll + lc + lr replaceRow : Rule -> Board -> Int -> Array.Array Cell -> Array.Array Cell replaceRow rule board rn row = let prevRow = Maybe.withDefault Array.empty <| Array.get (rn - 1) board nextRow = Maybe.withDefault Array.empty <| Array.get (rn + 1) board in Array.indexedMap (\cn cell -> rule (surroundings rn cn board) cell ) row step : Rule -> Board -> Board step rule board = Array.indexedMap (replaceRow rule board) board update : Msg -> Model -> (Model, Cmd Msg) update msg model = case msg of Step -> ( { model | board = step model.rule model.board }, Cmd.none ) SetBoard board -> ( { model | board = board }, Cmd.none ) InitializeBoard size -> let numRows = size.height // cellSize + 1 numCols = size.width // cellSize + 1 in ( model, Random.generate SetBoard (generateRandom numRows numCols) ) _ -> ( model, Cmd.none ) generateRandom : Int -> Int -> Random.Generator Board generateRandom nr nc = Random.map Array.fromList <| Random.list nr <| Random.map Array.fromList <| Random.list nc <| Random.map (\n -> if n == 1 then Alive else Dead) (Random.int 1 4) subscriptions : Model -> Sub Msg subscriptions model = Sub.batch [ Time.every (second/3) (\_ -> Step) , Window.resizes InitializeBoard ] main = Html.program { init = (initModel, Task.perform InitializeBoard Window.size) , view = view , update = update , subscriptions = subscriptions }