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.
111 lines
2.8 KiB
111 lines
2.8 KiB
import Grid exposing (..)
|
|
import RingList exposing (..)
|
|
import Automaton exposing (..)
|
|
|
|
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
|
|
, view = view
|
|
, update = update
|
|
, subscriptions = subscriptions
|
|
}
|
|
|
|
width = 62
|
|
height = 33
|
|
states = 3
|
|
inputs = 2
|
|
outputs = 3
|
|
visSize = "20px"
|
|
freq = 0.3 * 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 = Grid.generate width height initCell
|
|
, system = []
|
|
, neighbours = []
|
|
}, Random.generate NewRandomAut (genAut states inputs) )
|
|
|
|
|
|
initCell x y = case (x > 5, y > 5) of
|
|
(True, _) -> Just 1
|
|
(_, True) -> Just 1
|
|
_ -> Just (1 + (x + y * width) % states)
|
|
|
|
-- UPDATE
|
|
|
|
type Msg
|
|
= Update World
|
|
| NewRandomAut AutomatonT
|
|
| Regen
|
|
| BigStep
|
|
|
|
output m = case m of
|
|
Nothing -> 1
|
|
Just s -> 1 + s % outputs
|
|
|
|
getNBOutputs grid = let
|
|
ret = grid |> Grid.getNeighbours |> List.map output |> List.sum
|
|
in 1 + ret % inputs
|
|
|
|
cellStep : AutomatonT -> World -> Maybe Int
|
|
cellStep aut grid = let
|
|
i = getNBOutputs grid
|
|
s = grid |> Grid.extract
|
|
t = Automaton.step 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 = Grid.extend (cellStep model.system) model.grid }, Cmd.none)
|
|
|
|
|
|
-- SUBSCRIPTIONS
|
|
|
|
subscriptions : Model -> Sub Msg
|
|
subscriptions model = Time.every freq (\a -> BigStep)
|
|
|
|
|
|
-- VIEW
|
|
|
|
(=>) = (,)
|
|
|
|
output2Color : Int -> Color
|
|
output2Color n = hsl (degrees (toFloat n)*77) 1.0 (0.8 - 0.6 * (toFloat n + 0.5)/outputs)
|
|
|
|
color2String : Color -> String
|
|
color2String c = let rgb = toRgb c in "rgb(" ++ toString rgb.red ++ ", " ++ toString rgb.green ++ ", " ++ toString rgb.blue ++ ")"
|
|
|
|
block aut grid = let
|
|
col = output2Color <| output <| Grid.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
|
|
dupmodel = Grid.duplicate model.grid
|
|
butts = Grid.map (block model.system) dupmodel
|
|
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"]]
|
|
|