More Animations

We'll work through a couple more examples that deal with time.

Example: Stopwatch

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

Merging Time and Other Signals

Both kinds of Events 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

Finite State Machines

Next, we'll look at how to update our stopwatch in response to Events. 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 RunStates and edges of TickOr Msgs.

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

Refactoring Events

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

Example: Drawing Stacks

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.

Basic Functionality

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:

  • a now time, which is the most recent Time value reported by the ticker;
  • a start time, which is the Time when the given operation was initiated; and
  • an end 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 Msgs 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 Msgs 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))

Finite State Machines

Let's start to tackle the transitions between states in response to Events. 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.

Input Fields

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

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.

Fading

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.

  • Prevent Pushing when the field is empty.
  • Generalize to stacks of arbitrary size.
  • The approach we have been taking is rather low-level, explicitly manipulating current, start, and finish times for animations. Build higher-level abstractions that allow smoothly interpolating between two shapes, and use them to refactor the examples.