cellular-elm/Main.elm

module Cellular exposing (..)

import Html exposing (..)
import Html.Events exposing (..)
import Html.Attributes exposing (id, class, classList, style)

import Array
import Random
import Time exposing (Time, second)


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
    }

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)
    }


type Msg
    = NoOp
    | Step
    | SetBoard Board


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 =
    table
        []
        <|
        Array.toList
        <|
        Array.map (\r -> viewRow r) board

view : Model -> Html Msg
view model =
    div
        [ onClick Step
        ]
        [ viewBoard model.board
        ]

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 )
        _ ->
            ( 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)
        ]

main =
    Html.program
        { init = (initModel, Random.generate SetBoard (generateRandom 50 100))
        , view = view
        , update = update
        , subscriptions = subscriptions
        }