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

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
    }


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

surroundings : Array.Array Cell -> Array.Array Cell -> Int -> Array.Array Cell -> Int
surroundings prevRow nextRow ind row =
    let
        ul =
            case Array.get (ind - 1) prevRow of
                Just Alive -> 1
                _ -> 0
        uc =
            case Array.get ind prevRow of
                Just Alive -> 1
                _ -> 0
        ur =
            case Array.get (ind + 1) prevRow of
                Just Alive -> 1
                _ -> 0
        ml =
            case Array.get (ind - 1) row of
                Just Alive -> 1
                _ -> 0
        mr =
            case Array.get (ind + 1) row of
                Just Alive -> 1
                _ -> 0
        ll =
            case Array.get (ind - 1) nextRow of
                Just Alive -> 1
                _ -> 0
        lc =
            case Array.get ind nextRow of
                Just Alive -> 1
                _ -> 0
        lr =
            case Array.get (ind + 1) nextRow of
                Just Alive -> 1
                _ -> 0
    in
        ul + uc + ur + ml + mr + ll + lc + lr

replaceRow : Board -> Int -> Array.Array Cell -> Array.Array Cell
replaceRow 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
            case cell of
                Dead ->
                    if surroundings prevRow nextRow cn row > 0 then
                        Alive
                    else
                        Dead
                Alive ->
                    Dead
        ) row

step : Board -> Board
step board =
    Array.indexedMap (replaceRow board) board

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
    case msg of
        Step ->
            ( { model | board = step 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
        }