You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
108 lines
2.2 KiB
108 lines
2.2 KiB
import Html exposing (..)
|
|
import Html.Attributes exposing (..)
|
|
import Html.App as App
|
|
import Html.Events exposing (..)
|
|
import Random
|
|
import Color exposing (..)
|
|
import Time exposing (Time, second)
|
|
|
|
|
|
main =
|
|
App.program
|
|
{ init = (init size)
|
|
, view = view
|
|
, update = update
|
|
, subscriptions = subscriptions
|
|
}
|
|
|
|
size = 36
|
|
|
|
-- MODEL
|
|
|
|
type alias State = Maybe Int
|
|
type alias Automaton = List (Int, Int)
|
|
|
|
type alias Model =
|
|
{ states : List State
|
|
, system : Automaton
|
|
}
|
|
|
|
|
|
init : Int -> (Model, Cmd Msg)
|
|
init n = (Model (List.map Just [1 .. size]) [], Random.generate Update (genAut n))
|
|
|
|
|
|
|
|
-- UPDATE
|
|
|
|
type Msg
|
|
= Step
|
|
| Regen
|
|
| Update Automaton
|
|
| Sort
|
|
|
|
zip = List.map2 (,)
|
|
|
|
genAut : Int -> Random.Generator Automaton
|
|
genAut n = Random.map (zip [1 .. n]) (Random.list n <| Random.int 1 n)
|
|
|
|
step : Automaton -> State -> State
|
|
step ls s0 = case s0 of
|
|
Nothing -> Nothing
|
|
Just s -> List.filter (\(a,b) -> a == s) ls |> List.head |> Maybe.map snd
|
|
|
|
cmp l r = case (l, r) of
|
|
(Nothing, Nothing) -> EQ
|
|
(Nothing, Just n) -> LT
|
|
(Just n, Nothing) -> GT
|
|
(Just n, Just m) -> compare n m
|
|
|
|
update : Msg -> Model -> (Model, Cmd Msg)
|
|
update msg model =
|
|
case msg of
|
|
Step -> (Model (List.map (step model.system) model.states) model.system, Cmd.none)
|
|
|
|
Regen ->
|
|
init size
|
|
|
|
Update newAut ->
|
|
(Model model.states newAut, Cmd.none)
|
|
|
|
Sort ->
|
|
(Model (List.sortWith cmp model.states) model.system, Cmd.none)
|
|
|
|
|
|
-- SUBSCRIPTIONS
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model =
|
|
Time.every (0.1 * second) (\a -> Step)
|
|
|
|
|
|
|
|
-- VIEW
|
|
|
|
(=>) = (,)
|
|
|
|
state2Color : State -> Color
|
|
state2Color s = case s of
|
|
Nothing -> Color.black
|
|
Just n -> hsl (degrees (toFloat n)*77) 1.0 (0.8 - 0.6 * (toFloat n)/size)
|
|
|
|
color2String : Color -> String
|
|
color2String c = let rgb = toRgb c in "rgb(" ++ toString rgb.red ++ ", " ++ toString rgb.green ++ ", " ++ toString rgb.blue ++ ")"
|
|
|
|
block : Color -> Html msg
|
|
block c = div [style ["background-color" => color2String c, "width" => "100px", "height" => "100px", "display" => "inline-block"]] []
|
|
|
|
view : Model -> Html Msg
|
|
view model =
|
|
div []
|
|
( button [ onClick Regen ] [ text "Regenerate" ]
|
|
:: button [ onClick Sort ] [ text "Sort" ]
|
|
:: br [] []
|
|
:: List.map (block << state2Color) model.states
|
|
)
|
|
|
|
|
|
|
|
|