140 lines
3.6 KiB
Elm
140 lines
3.6 KiB
Elm
import Automaton exposing (..)
|
|
import Grid exposing (..)
|
|
import Lazy.Zipper
|
|
|
|
import Color exposing (Color)
|
|
import Dict exposing (Dict)
|
|
import Html exposing (..)
|
|
import Html.App as App
|
|
import Html.Attributes exposing (style)
|
|
import Html.Events exposing (onClick)
|
|
import Random
|
|
import Time
|
|
|
|
main =
|
|
App.program
|
|
{ init = init
|
|
, view = view
|
|
, update = update
|
|
, subscriptions = subscriptions
|
|
}
|
|
|
|
width = 34
|
|
height = 31
|
|
states = 10
|
|
inputs = 3
|
|
outputs = 3
|
|
visSize = "20px"
|
|
freq = 0.3 * Time.second
|
|
|
|
-- MODEL
|
|
|
|
type alias World = Grid (Maybe Int)
|
|
type alias AutomatonT = Automaton Int Int
|
|
type alias Model =
|
|
{ grid : World
|
|
, system : AutomatonT
|
|
, neighbours : List (Maybe Int)
|
|
}
|
|
|
|
init : (Model, Cmd Msg)
|
|
init =
|
|
( { grid = generate width height initCell
|
|
, system = []
|
|
, neighbours = []
|
|
}, Random.generate NewRandomAut (genAut states inputs) )
|
|
|
|
|
|
initCell x y = case (x, y) of
|
|
(18, 16) -> Just 3
|
|
(17, 16) -> Just 1
|
|
_ -> Just 2
|
|
|
|
-- UPDATE
|
|
|
|
type Msg
|
|
= Update World
|
|
| NewRandomAut AutomatonT
|
|
| Regen
|
|
| Init
|
|
| BigStep
|
|
|
|
output m = case m of
|
|
Nothing -> 1
|
|
Just s -> 1 + s % outputs
|
|
|
|
counts : List Int -> Dict Int Int
|
|
counts ls = let
|
|
succ n = case n of
|
|
Just m -> Just (m + 1)
|
|
Nothing -> Just 1
|
|
in List.foldr (\x m -> Dict.update x succ m) Dict.empty ls
|
|
|
|
uniqSingleton : List Int -> Maybe Int
|
|
uniqSingleton ls = let cs = counts ls
|
|
in case Dict.toList cs of
|
|
[(n, 1), (m, 3)] -> Just n
|
|
[(n, 3), (m, 1)] -> Just m
|
|
[(1, 2), (2, 2)] -> Just 3
|
|
[(1, 2), (3, 2)] -> Just 2
|
|
[(2, 2), (3, 2)] -> Just 1
|
|
_ -> Nothing
|
|
|
|
getNBOutputs : World -> Maybe Int
|
|
getNBOutputs grid = grid
|
|
|> getNeighbours
|
|
|> List.filterMap identity
|
|
|> uniqSingleton
|
|
--|> List.map output
|
|
--|> List.map2 (\x y -> x * y) [2,2,1,0]
|
|
--|> List.sum
|
|
--|> \x -> 1 + x % inputs
|
|
|
|
step2 : AutomatonT -> Maybe Int -> Maybe Int -> Maybe Int
|
|
step2 aut s i = case i of
|
|
Nothing -> s
|
|
Just i2 -> Automaton.step aut s i2
|
|
|
|
cellStep : AutomatonT -> World -> Maybe Int
|
|
cellStep aut grid = let
|
|
i = getNBOutputs grid
|
|
s = extract grid
|
|
t = step2 aut s i
|
|
in t
|
|
|
|
update : Msg -> Model -> (Model, Cmd Msg)
|
|
update msg model =
|
|
case msg of
|
|
Update grid -> ({ model | grid = grid }, Cmd.none)
|
|
NewRandomAut aut -> ({ model | system = aut }, Cmd.none)
|
|
Regen -> (model, Random.generate NewRandomAut (genAut states inputs))
|
|
BigStep -> ({ model | grid = model.grid =>> cellStep model.system }, Cmd.none)
|
|
Init -> ({ model | grid = generate width height initCell }, Cmd.none)
|
|
|
|
|
|
-- SUBSCRIPTIONS
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model = Time.every freq (\a -> BigStep)
|
|
|
|
|
|
-- VIEW
|
|
|
|
(=>) = (,)
|
|
|
|
output2Color : Int -> Color
|
|
output2Color n = Color.hsl (degrees (toFloat n)*77) 1.0 (0.8 - 0.6 * (toFloat n + 0.5)/outputs)
|
|
|
|
color2String : Color -> String
|
|
color2String c = let rgb = Color.toRgb c in "rgb(" ++ toString rgb.red ++ ", " ++ toString rgb.green ++ ", " ++ toString rgb.blue ++ ")"
|
|
|
|
block aut grid = let
|
|
col = output2Color <| output <| extract grid
|
|
but = text "" -- button [ onClick (Update (Grid.edit (\_ -> cellStep aut grid) grid)) ] [ text "." ]
|
|
in div [style ["background-color" => color2String col, "width" => visSize, "height" => visSize, "display" => "inline-block"]] [ but ]
|
|
|
|
view model = let
|
|
butts = model.grid =>> block model.system
|
|
listm = Grid.toList butts
|
|
viewm = List.map (\row -> div [style ["height" => visSize]] row) listm
|
|
in div [] <| viewm ++ [button [onClick BigStep] [text "big step"], button [onClick Regen] [text "regenerate"], button [onClick Init] [text "restart"]]
|