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
}