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 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 =
    { width : Int
    , height : Int
    , board : Board
    , rule : Rule
    }

initModel : Int -> Int -> Model
initModel w h =
    { width = w
    , height = h
    --, board = Array.repeat h <| Array.repeat w Dead
    --, board = modify 3 2 Alive <| Array.repeat h <| Array.repeat w Dead
    , board = modify 4 4 Alive <| modify 4 3 Alive <| modify 3 4 Alive <| modify 3 2 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


viewRow row =
    tr
        []
        <|
        Array.toList
        <|
        Array.map (\c ->
            let
                colour =
                    case c of
                        Alive ->
                            "yellow"
                        Dead ->
                            "grey"
            in
                td
                [ style
                    [ ("background-color", colour)
                    ]
                ]
                [text (toString c)]
        ) 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
        ]
        [ text "cellular-elm"
        , 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 ->
            --TODO: insert rules
            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 )
        _ ->
            ( model, Cmd.none )

subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.batch
        [ Time.every second (\_ -> Step)
        ]

main =
    Html.program
        { init = ((initModel 20 10), Cmd.none)
        , view = view
        , update = update
        , subscriptions = subscriptions
        }