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