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 }