We'll work through a couple more examples that deal with time.
Previously, we implemented a counter controlled by increment and reset buttons. Now let's implement a "stopwatch" counter that increments every so often (say, every second), along with buttons that pause and resume the counter.
We start by identifying that, in addition to the count itself, the State
of our application needs to keep track of whether the stopwatch is currently Paused
or Playing
. In the latter case, we also keep track of the next Time
at which to update the count.
type alias State = (Int, RunState)
type RunState = Paused | Playing Time
We define the type Msg
to describe the messages sent as a result of button clicks. We will want to merge the signal of button Msg
s with a signal of Time
values, so we define an Event
type to describe the union of these two types.
type Msg = Start | Stop
type Event = NewTime Time | NewMsg (Time, Msg)
Both kinds of Event
s carry along the time at which an updated value is produced, but extracting this value is slightly annoying because we would have to use pattern matching to obtain the first component. Furthermore, we have previously seen this pattern of merging a signal with a ticker (in the fading dots example). So, instead of the Event
type definition above, we can factor this pattern more generally.
type TickOr msg = Tick | M msg
type alias Event = (Time, TickOr Msg)
Notice how we use the type variable msg
as an indication that we are going to instantiate it with the Msg
type. But, of course, we could have chosen to use any type variable we wish (except number
or comparable
or appendable
, which would be unnecessarily restrictive).
We can now define the following function to merge an arbitrary signal together with a ticker that takes an arbitrary signal:
mergeWithTicker : Time -> Signal msg -> Signal (Time, TickOr msg)
mergeWithTicker t sig =
let time = Time.every t in
Signal.merge
(Signal.map (\t -> (t, Tick)) time)
(Signal.map2 (\t m -> (t, M m )) (Signal.sampleOn sig time) sig)
After defining the channel ch
to pass along Start
and Stop
messages originating from the buttons we will draw, we merge its values with a ticker that updates ten times per second.
msgMailbox : Mailbox Msg
msgMailbox = mailbox Start
main =
let
state : Signal State
state = Signal.foldp upstate (0, Paused)
(mergeWithTicker (100 * Time.millisecond) msgMailbox.signal)
in
Signal.map2 view Window.dimensions state
Next, we'll look at how to update our stopwatch in response to Event
s. There are two kinds of RunState
states (Paused
and Playing
) and three kinds of TickOr Msg
messages (Tick
, M Start
, and M Stop
). So, we can think of the execution of our application in terms of a transition graph, where nodes are RunState
s and edges of TickOr Msg
s.
Notice that our diagram omits two transitions: there is no edge labeled Stop
from node Paused
and no edge labeled Start
from node Playing
. As a result, we will take care to make sure that our application does not enter one of these undefined configurations.
We define the upstate
function to handle each of the transitions above.
delay = 1 * Time.second
upstate : Event -> State -> State
upstate (now,tm) (n,p) = case (tm,p) of
(M Start, Paused) -> (n, Playing (now + delay))
(M Stop, Playing _) -> (n, Paused)
(Tick, Paused) -> (n, Paused)
(Tick, Playing end) -> if now < end then (n,p)
else (n+1, Playing (end + delay))
_ -> Debug.crash "upstate: impossible"
When processing the Start
message at time now
, the updated Playing
state records the time now + delay
at which the counter should be incremented. If a Tick
message is received while the stopwatch is Playing
, then the count is incremented if the current time is larger than the previously computed time at which to increment. Furthermore, the updated state includes the next time at which to updated the counter.
Notice that Elm requires us to handle all patterns, even though we intend to ensure that some will never be needed at run-time. In we do make a mistake, though, our application will crash with our error message. You may also find Debug.log
helpful during development. Open up the Web Console in your browser and take a look at any JavaScript errors raised.
Let's now draw our UI such that we never enter into one of the undefined configurations. We'll reuse the myButton
function we developed in previous lectures that uses the Collage
library to draw a nice, bordered button that changes colors. We'll draw a single button, and we'll set its message to send (either Start
or Stop
) depending on the current RunState
.
view (w,h) (n,p) =
let caption = n |> toString |> strStyle |> E.container btnW btnH E.middle in
let btn =
let makeMessage = Signal.message msgMailbox.address in
case (n,p) of
(0, Paused) -> myButton (makeMessage Start) "Start"
(_, Paused) -> myButton (makeMessage Start) "Resume"
(_, Playing _) -> myButton (makeMessage Stop) "Pause"
in
E.color Color.gray
<| E.container (w-1) (h-1) E.middle
<| E.flow E.down
<| List.intersperse vspace [ caption, btn ]
Rather than drawing multiple buttons, we draw a single one and choose the event appropriately. The partially applied function bound to makeMessage
helps reduce a bit of clutter.
We have been careful to convince ourselves, if not the language, that we will never attempt to follow an undefined transition at run-time. Alternatively, we could have chosen to define a single Msg
value called Toggle
or ()
, where upstate
toggles between the two RunState
s as above.
The rest of the drawing code is similar to examples we have seen before. Check out the source and demo for the details.
There's a cute way of reorganizing our setup that avoids the need to define new Msg
and TickOr
types. We keep the State
representation the same...
type alias State = (Int, RunState)
type RunState = Paused | Playing Time
... but define Msg
s to be functions that given the current Time
and State
produces an updated State
. Notice that Msg
is now simply a type alias
.
type alias Msg = (Time -> State -> State)
type alias Event = (Time, Msg)
We then break up the previous upstate
implementation into separate functions for each kind of message.
upstate : Event -> State -> State
upstate (now, f) st = f now st
start now (n,p) = case p of
Paused -> (n, Playing (now + delay))
_ -> Debug.crash "start: impossible"
stop now (n,p) = case p of
Playing _ -> (n, Paused)
_ -> Debug.crash "stop: impossible"
tick now (n,p) = case p of
Paused -> (n, Paused)
Playing end -> if now < end then (n,p)
else (n+1, Playing (end + delay))
Notice that start
, stop
, and tick
each have type Msg
. Wherever we used Start
and Stop
before, now we use start
and stop
.
msgMailbox = mailbox start
...
case (n,p) of
(0, Paused) -> myButton (makeMessage start) "Start"
(_, Paused) -> myButton (makeMessage start) "Resume"
(_, Playing _) -> myButton (makeMessage stop) "Pause"
...
Finally, we redefine mergeWithTicker
to use tick
instead of Tick
, to eliminate the wrapper M
data constructor from before, and to change its type signature.
mergeWithTicker : Time -> Signal Msg -> Signal Event
mergeWithTicker t sig =
let time = Time.every t in
Signal.merge
(Signal.map (\t -> (t, tick)) time)
(Signal.map2 (\t m -> (t, m )) (Signal.sampleOn sig time) sig)
Check out the source and demo for this version, which implements the same functionality as before. You may prefer this organization of this version to the previous, because it avoids the need to define new types Msg
and TickOr
.
Our next example will be an animation of a stack data structure. We'll make the simplifying assumption that our stack may contain at most five elements.
numRows = 5
We will start by getting the basic functionality to work. Then we will allow the user to specify what element to push using a text box. Finally, we will animate the push and pop operations so that the element being added or removed, respectively, will fade in or out.
We will restrict our stack to String
values, which will be represented as a List
. In addition, our State
will track whether the stack is in a Steady
state, or whether we are in the processing of Pushing
or Popping
.
type alias State = (List String, RunState)
type RunState = Steady | Pushing Time Time Time | Popping Time Time Time
In the latter two cases, we keep track of three Time
values:
now
time, which is the most recent Time
value reported by the ticker;start
time, which is the Time
when the given operation was initiated; andend
time, which is the Time
at which the given operation will be completed.We will start with an initially empty stack.
initState = ([], Steady)
We will use the TickOr
approach introduced earlier to help manage timed messages.
type Msg = Push String | Pop | Noop
type TickOr msg = Tick | M msg
type alias Event = (Time, TickOr Msg)
For brevity later in the code, we define wrappers for the different kinds of Msg
s that will be sent over our channel.
pop = Signal.message msgMailbox.address Pop
push s = Signal.message msgMailbox.address (Push s)
noop = Signal.message msgMailbox.address Noop
And, as before, we will define our application to update based on Msg
s sent over ch
as well as updates to the current Time
.
mergeWithTicker : Time -> Signal msg -> Signal (Time, TickOr msg)
mergeWithTicker t sig =
let time = Time.every t in
Signal.merge
(Signal.map (\t -> (t, Tick)) time)
(Signal.map2 (\t m -> (t, M m)) (Signal.sampleOn sig time) sig)
main =
Signal.map2 view Window.dimensions
(Signal.foldp upstate initState
(mergeWithTicker (100 * Time.millisecond) msgMailbox.signal))
Let's start to tackle the transitions between states in response to Event
s. We'll start out by always using the Steady
state.
upstate : Event -> State -> State
upstate (now,tm) (stack,rs) =
let error _ = Debug.crash "upstate: impossible" in
case (tm, rs) of
(M Noop, _) -> (stack, rs)
(Tick, Steady) -> (stack, rs)
(M Pop, Steady) -> case stack of
_::tail -> (tail, Steady)
_ -> error ()
(M (Push s), Steady) -> if List.length stack < numRows
then (s::stack, Steady)
else error ()
_ -> error ()
As with the stopwatch example, we use Debug.crash
for cases that (assuming we've gotten things right) will never be needed. In that example, we rendered a single button and set up its message to be in sync with the current State
. In contrast, in this example, we will always render both push and pop buttons, but we will disable them when appropriate.
To distinguish between enabled and disabled buttons, we first define a version of myButton
that colors the resulting button white
when the enabled
argument is False
.
myButton enabled evt s =
let mkBtn c =
C.collage wBtn hBtn [
C.filled c (C.rect wBtn hBtn)
, C.outlined lineStyle (C.rect wBtn hBtn)
, strStyle s |> C.toForm
]
in
let (x,y,z) =
if enabled
then (Color.lightYellow, Color.lightOrange, Color.lightBlue)
else (Color.white, Color.white, Color.white)
in
customButton evt (mkBtn x) (mkBtn y) (mkBtn z)
Then, we conditionally enable a button based on a predicate b
. To disable a button, we set its Msg
to Noop
so that it has no effect on the State
.
maybeButton b evt s =
if b then myButton True evt s
else myButton False noop s
Here's a bunch of code that renders the stack and buttons to manipulate it.
view : (Int,Int) -> State -> E.Element
view (w,h) (stack_,rs) =
let stack = List.reverse stack_
n = List.length stack
in
let eButtons =
E.flow E.down
<| List.intersperse vSep
[ maybeButton (rs == Steady && n < 5) (push "BLAH") "Push"
, maybeButton (rs == Steady && n > 0) pop "Pop"
]
in
let eStack =
let stackRect = C.rect wStackArea hStackArea
stackBack = [ stackRect |> C.filled Color.lightGray ]
stackFore = [ stackRect |> C.outlined lineStyle ]
stackElts =
stack |> List.indexedMap (\\i s ->
let
rect = C.rect wBtn hRow
box =
[ rect |> C.filled Color.lightCharcoal
, rect |> C.outlined C.defaultLine
, s |> strStyle |> E.container wBtn hRow E.middle |> C.toForm
]
move = C.move (0, center0 + toFloat (i*hRow))
center0 =
if numRows % 2 == 1
then -(((numRows-1)/2)*hRow)
else -(((numRows-1)/2)*hRow) - (hRow/2)
in
List.map move box
)
in
C.collage wStackArea hStackArea
(stackBack ++ List.concat stackElts ++ stackFore)
in
E.container (w-1) (h-1) E.middle
(E.flow E.right [eStack, hSep, eButtons])
Check out the source and demo for this version.
Now, instead of only pushing "BLAH"
values, let's add a text box so that the user can enter values. The Graphics.Input.Field
library provides the following function for creating text input fields.
field : Style -> (Content -> Message) -> String -> Content -> Element
Values of type Content
store the contents of a textbook in a String
, along with information about what text is highlighted;
type alias Content = { string : String, selection : Selection }
Notice that the second argument to field
must be a function that takes a single argument and returns a Signal.message
. Recall the following function from the Signal
library that is used to create Message
s.
message : Address a -> a -> Message
If we call message
with a single argument of type Address Content
, the resulting (function) is the type of value we need to pass as the second argument to field
.
So, let's create a mailbox for communicating Content
values from a text box.
contentMailbox : Mailbox F.Content
contentMailbox = mailbox F.noContent
We will "listen" to values from contentMailbox.signal
, and add its current value as a parameter to view
, because that's where we decide what value to Push
when the push button is clicked.
main =
Signal.map3 view
(Window.dimensions)
contentMailbox.signal
(Signal.foldp upstate initState
(mergeWithTicker (100 * Time.millisecond) contentMailbox.signal))
In the view
function, we define our field to send
updates to the contentMailbox
channel, and we display con
, the current Content
, in the field. We set up the push button to send
the String
value currently in the field.
view : (Int,Int) -> F.Content -> State -> E.Element
view (w,h) con state =
...
[ F.field fieldStyle (Signal.message contentMailbox.address) "" con
, maybeButton (rs == Steady && n < 5) (push con.string) "Push"
, maybeButton (rs == Steady && n > 0) pop "Pop"
]
...
fieldStyle : F.Style
fieldStyle =
let fs = F.defaultStyle in
let ts = T.defaultStyle in
{ fs | style = { ts | height = Just 20 }}
Check out the source and demo for this version.
Our final task is to animate the Push
and Pop
operations. We update the upstate
function to make use of Pushing
and Popping
constructors.
upstate (now,tm) (stack,rs) =
let error _ = Debug.crash "upstate: impossible" in
case (tm, rs) of
(M Noop, _) -> (stack, rs)
(Tick, Steady) -> (stack, rs)
(M Pop, Steady) -> (stack, Popping now now (now + delay))
(M (Push s), Steady) ->
if List.length stack < numRows
then (s::stack, Pushing now now (now + delay))
else error ()
(Tick, Popping _ start end) ->
case (now > end, stack) of
(True, _::tail) -> (tail, Steady)
(False, _) -> (stack, Popping now start end)
(True, []) -> error ()
(Tick, Pushing _ start end) ->
if now > end
then (stack, Steady)
else (stack, Pushing now start end)
_ -> error ()
Notice that the Pop
message does not immediately pop the stack, because the value s
on top of the stack will faded out slowly until time now + delay
.
When processing a new Tick
at time now
, we check to see whether now
is passed the end
of the given animation phase. If it is, we return to the Steady
state; otherwise, continue in the same animating state and track the new now
time.
As with the FadingDots
example from a previous lecture, we will use the alpha component of colors to smoothly fade objects in and out.
setAlpha : Float -> Color.Color -> Color.Color
setAlpha a c =
let rgb = Color.toRgb c in
Color.rgba rgb.red rgb.green rgb.blue a
setAlphaLS a ls = { ls | color = setAlpha a ls.color }
Inside the "loop" (the indexedMap
call) in view
, we check to see if the current state is Popping
or Pushing
and, if so, set the alpha component of the top element of the stack (which is represented in three parts: a solid rectangle, an outlined rectangle, and the text value of the element).
...
let a =
case (rs, i == n - 1) of
(Popping now start end, True) -> (end-now) / (end-start)
(Pushing now start end, True) -> (now-start) / (end-start)
_ -> 1.0
in
[ rect |> C.filled (setAlpha a Color.lightCharcoal) |> move
, rect |> C.outlined (setAlphaLS a C.defaultLine) |> move
, s |> T.fromString |> T.height 30 |> T.color (setAlpha a Color.black)
|> E.centered |> C.toForm |> move
])
...
Check out the source and demo for this final version.
Optional Exercises
Our solution can be improved in many, many ways.
Push
ing when the field is empty.