Speed Control

elm-package.json

{
    "version": "1.0.0",
    "summary": "helpful summary of your project, less than 80 characters",
    "repository": "https://github.com/user/project.git",
    "license": "BSD3",
    "source-directories": [
        "."
    ],
    "exposed-modules": [],
    "dependencies": {
        "elm-lang/core": "3.0.0 <= v < 4.0.0",
        "evancz/elm-effects": "2.0.1 <= v < 3.0.0",
        "evancz/elm-html": "4.0.2 <= v < 5.0.0",
        "evancz/elm-http": "3.0.0 <= v < 4.0.0",
        "evancz/start-app": "2.0.2 <= v < 3.0.0"
    },
    "elm-version": "0.16.0 <= v < 0.17.0"
}

SpeedControl.elm

import Html exposing (..) 
import Html.Attributes as HA exposing (type', min, max, step)
import Html.Events exposing (..)
import Graphics.Element exposing (..)
import Time exposing (Time, millisecond)
import Color exposing (blue, white)
import StartApp 
import Effects exposing (Effects, Never)
import Task exposing (Task)
import String


type alias Model =
  { interval : Time
  , lastTock : Time
  , step : Int }

type Action = Tick Time | UpdateInterval String

init : (Model, Effects Action)
init = 
  (Model (1000*millisecond) 0 0, Effects.tick Tick)

update : Action -> Model -> (Model, Effects Action)
update action model =
  case action of
    Tick time -> 
      if (time-model.lastTock)>model.interval 
      then (Model model.interval time ((model.step+1)%5), Effects.tick Tick)
      else (model, Effects.tick Tick)
    UpdateInterval str -> 
      case String.toFloat str of
        Err _ -> 
          (model , Effects.tick Tick)
        Ok float ->
          ({model | interval = (float*millisecond)}, Effects.tick Tick)


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
     
onRange : Signal.Address Action -> Html.Attribute
onRange address = 
  on "input" targetValue (\str -> Signal.message address (UpdateInterval str))

view : Signal.Address Action -> Model -> Html
view address model =
  div []
  [ fromElement (blocks model.step)
  , br [] []
  , text ("moving every "++ (toString model.interval) ++ " milliseconds")
  , br [] []
  , input 
    [ type' "range"
    , HA.min "100"
    , HA.max "2500"
    , HA.step "100"
    , HA.value <| toString model.interval
    , onRange address] [] ]

app : StartApp.App Model
app = StartApp.start
  { init = init
  , update = update
  , view = view
  , inputs = []
  }
 
main : Signal Html
main = app.html

port tasks : Signal (Task Never ())
port tasks = app.tasks

SpeedControl2.elm

import Graphics.Element exposing (..)
import Time exposing (Time)
import Color exposing (blue, white)

import Html exposing (..)
import Html.Attributes as HA
import Html.Events exposing (..)
import String

-- SIGNALS

-- this Mailbox will receive the range events
rangeInfo : Signal.Mailbox String
rangeInfo = Signal.mailbox "1000"

rangeInput : Signal Int -- The signal of range events converted to useful floats
rangeInput = 
  rangeInfo.signal
  |> Signal.map String.toInt
  |> Signal.map Result.toMaybe
  |> Signal.map (Maybe.withDefault 0)

inputs : Signal (Int, Int) 
inputs = 
  Signal.map2 (,) (Time.fps 30) rangeInput -- Signal (delta since last frame, interval)
  |> Signal.foldp update (0,0, 1000) 
  |> Signal.dropRepeats -- drop the repeats caused by the extra frame
  |> Signal.map (\(s, a, i)-> (s, i)) -- extract only the step and the interval


main : Signal Html
main =
  Signal.map view inputs
  

-- UPDATE

update : (Time, Int) -> (Int, Float, Int) -> (Int, Float, Int)
update (delta, interval) (step, acc, _) =
  if (acc + delta) > toFloat interval 
  then ((step+1)%5, 0, interval)
  else (step, acc+delta, interval)

-- 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

-- event handler for the range event 
onRange : Signal.Address String -> Html.Attribute
onRange address = 
  on "input" targetValue (\str -> Signal.message address str)

view : (Int, Int) -> Html
view (step, interval) =
  div []
  [ fromElement <| blocks step
  , br [] []
  , text ("moving every "++ (toString interval) ++ " milliseconds")
  , br [] []
  , input 
    [ HA.type' "range"
    , HA.min "100"
    , HA.max "2500"
    , HA.step "100"
    , HA.value <| toString interval
    , onRange rangeInfo.address] [] ]