Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
import Graphics.Element exposing (..)
import Color exposing (blue, white)
import Task exposing (Task)
import Signal exposing (Mailbox, Address)
import Html exposing (Attribute, input)
import Html.Attributes exposing (type')
import Html.Events exposing (on, targetValue)
import Json.Decode exposing (Decoder)
import String
-- SIGNALS
main : Signal Element
main =
Signal.map (view actionMailbox.address) modelSignal
actionMailbox : Mailbox Action
actionMailbox = Signal.mailbox Tick
modelAndTaskSignal : Signal (Model, Task () ())
modelAndTaskSignal =
Signal.foldp update (initModel, Task.succeed ()) actionMailbox.signal
modelSignal : Signal Model
modelSignal =
Signal.map fst modelAndTaskSignal
taskSignal : Signal (Task () ())
taskSignal =
Signal.map snd modelAndTaskSignal
port tasks : Signal (Task () ())
port tasks =
taskSignal
port initialTask : Task () ()
port initialTask =
Signal.send actionMailbox.address Tick
-- ACTIONS
type Action
= Tick
| SetInterval String
| NoOp
-- MODEL
type alias Model =
{ interval : Float
, step : Int
}
initModel : Model
initModel = Model 500 0
-- UPDATE
queueTick : Float -> Task () ()
queueTick interval =
Task.sleep interval `Task.andThen` (\_ -> Signal.send actionMailbox.address Tick)
update : Action -> (Model, Task () ()) -> (Model, Task () ())
update action (model,_) =
case action of
Tick ->
({ model | step = if model.step < 5 then model.step + 1 else 0 }, queueTick model.interval)
SetInterval interval ->
({ model | interval = (String.toFloat interval |> Result.withDefault model.interval)}, Task.succeed ())
NoOp ->
(model, Task.succeed ())
-- VIEW
blocks : Int -> Element
blocks step =
let
block index =
spacer 50 50
|> color (if index == step then blue else white)
in
List.map block [0..5]
|> flow right
targetValueFloat : Decoder Float
targetValueFloat =
Json.Decode.at ["target", "value"] Json.Decode.float
onRange : Address Action -> Attribute
onRange address =
on "input" targetValue (\str -> Signal.message address (SetInterval str))
slider : Address Action -> Element
slider address =
input
[ type' "range"
, onRange address
, Html.Attributes.min "20"
, Html.Attributes.max "1000"
]
[]
|> Html.toElement 200 200
view : Address Action -> Model -> Element
view address model =
flow down
[ blocks model.step
, slider address
]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment