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
}