transition animations

Main.elm

module Main exposing (..)

import Browser
import Html exposing (Html, button, div, span, text)
import Html.Attributes exposing (style)
import Html.Events exposing (onClick)
import Timeline exposing (Timeline)



-- MAIN


main : Program () (Timeline Model) (Timeline.Msg Msg)
main =
    Browser.element
        { init = \flags -> Timeline.init 2000 init
        , update = Timeline.update update
        , view = Timeline.view view
        , subscriptions = Timeline.subscriptions (\_ -> Sub.none)
        }



-- MODEL


type alias Model =
    { a : Bool
    , b : Bool
    }


init : ( Model, Cmd Msg )
init =
    ( { a = False, b = False }, Cmd.none )



-- UPDATE


type Msg
    = ToggleA
    | ToggleB


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        ToggleA ->
            ( { model | a = not model.a }, Cmd.none )

        ToggleB ->
            ( { model | b = not model.b }, Cmd.none )



-- VIEW


view : Timeline Model -> Html Msg
view timeline =
    let
        progressA =
            timeline
                |> Timeline.map .a
                |> Timeline.progress 2000

        progressB =
            timeline
                |> Timeline.map .b
                |> Timeline.progress 2000

        color bool float =
            let
                adjusted =
                    if bool then
                        float

                    else
                        1.0 - float
            in
            style "color" ("hsl(1, 0%, " ++ (String.fromFloat <| adjusted * 100) ++ "%)")

        render action progress =
            case progress of
                Timeline.At value _ ->
                    div []
                        [ button [ onClick action ] [ text "Toggle" ]
                        , div [ color value 0.0 ]
                            [ text <|
                                if value then
                                    "HELLO!"

                                else
                                    "GOODBYE!"
                            ]
                        ]

                Timeline.Transition from value f ->
                    div []
                        [ button [ onClick action ] [ text "Toggle" ]
                        , div [ color value f ]
                            [ text <|
                                if value then
                                    "HELLO!"

                                else
                                    "GOODBYE!"
                            ]
                        ]
    in
    div []
        [ render ToggleA progressA
        , render ToggleB progressB
        ]

Timeline.elm

module Timeline exposing
    ( Msg(..)
    , Progress(..)
    , Timeline
    , init
    , map
    , progress
    , subscriptions
    , update
    , value
    , view
    )

import Browser.Events
import Html exposing (Html)
import Time exposing (Posix)


type alias Event t =
    { time : Posix, value : t }


mapEvent : (t -> s) -> Event t -> Event s
mapEvent f e =
    Event e.time (f e.value)


type alias Timeline t =
    { current : Event t
    , history : List (Event t)
    , limit : Int
    , now : Posix
    }


type Msg m
    = Msg m
    | UpdateTime Posix


init : Int -> ( model, Cmd msg ) -> ( Timeline model, Cmd (Msg msg) )
init limit ( model, cmd ) =
    ( new limit model, Cmd.map Msg cmd )


update : (msg -> model -> ( model, Cmd msg )) -> (Msg msg -> Timeline model -> ( Timeline model, Cmd (Msg msg) ))
update update_ msg timeline =
    case msg of
        UpdateTime posix ->
            ( { timeline | now = posix }, Cmd.none )

        Msg msg_ ->
            let
                ( newModel, cmd ) =
                    update_ msg_ (value timeline)
            in
            ( timeline |> push { value = newModel, time = timeline.now }
            , Cmd.map Msg cmd
            )


subscriptions : (model -> Sub msg) -> Timeline model -> Sub (Msg msg)
subscriptions subscriptions_ timeline =
    Sub.batch
        [ Browser.Events.onAnimationFrame UpdateTime

        -- Time.every 500 UpdateTime
        , timeline |> value |> subscriptions_ |> Sub.map Msg
        ]


view : (Timeline model -> Html msg) -> (Timeline model -> Html (Msg msg))
view view_ =
    view_ >> Html.map Msg


new : Int -> t -> Timeline t
new limit t =
    Timeline { value = t, time = Time.millisToPosix 0 } [] limit (Time.millisToPosix 0)


push : Event t -> Timeline t -> Timeline t
push e timeline =
    let
        now =
            e.time
    in
    if e.value == timeline.current.value then
        { timeline
            | now = now
        }

    else
        { timeline
            | current = e
            , history =
                timeline.current
                    :: (case timeline.history of
                            [] ->
                                []

                            first :: _ ->
                                if timeDiff timeline.current.time first.time > timeline.limit then
                                    []

                                else
                                    timeline.history
                       )
            , now = now
        }


value : Timeline t -> t
value =
    .current >> .value


reverseNonEmpty : ( a, List a ) -> ( a, List a )
reverseNonEmpty ( a, list ) =
    let
        revapp : ( List a, a, List a ) -> ( a, List a )
        revapp ( ls, c, rs ) =
            case rs of
                [] ->
                    ( c, ls )

                r :: rss ->
                    revapp ( c :: ls, r, rss )
    in
    revapp ( [], a, list )


map : (t -> s) -> Timeline t -> Timeline s
map f { current, history, now, limit } =
    let
        ( first, rest ) =
            reverseNonEmpty ( current, history )

        mapf =
            mapEvent f

        initial =
            { current = mapf first, history = [], now = first.time, limit = limit }
    in
    List.foldl
        (\e t -> push (mapf e) t)
        initial
        rest
        |> (\timeline -> { timeline | now = now })


type Progress t
    = At t Int
    | Transition t t Float


progress : Int -> Timeline t -> Progress t
progress duration timeline =
    progressHelper timeline.now duration timeline.current timeline.history


progressHelper : Posix -> Int -> Event t -> List (Event t) -> Progress t
progressHelper now duration e events =
    case events of
        [] ->
            At e.value (timeDiff now e.time)

        prev :: [] ->
            spring 1.0 (timeDiff now e.time) duration
                |> (\springPos ->
                        if springPos == 0 then
                            At e.value (timeDiff now e.time)

                        else
                            Transition prev.value e.value springPos
                   )

        prev :: rest ->
            let
                midProgress =
                    progressHelper now duration prev rest
            in
            case midProgress of
                At prevValue _ ->
                    spring 1.0 (timeDiff now e.time) duration
                        |> (\springPos ->
                                if springPos == 0 then
                                    At e.value (timeDiff now e.time)

                                else
                                    Transition prevValue e.value springPos
                           )

                Transition prevPrevValue prevValue transitionSpringPos ->
                    spring (1 - transitionSpringPos)
                        (timeDiff now e.time)
                        duration
                        |> (\springPos ->
                                if springPos == 0 then
                                    At e.value (timeDiff now e.time)

                                else
                                    Transition prevValue e.value springPos
                           )


timeDiff : Posix -> Posix -> Int
timeDiff a b =
    abs <|
        Time.posixToMillis a
            - Time.posixToMillis b


{-| critically dampened spring function that hits 0.003 at t = 1.0,
greater than that, we return 0.
-}
spring : Float -> Int -> Int -> Float
spring x0 complete duration =
    let
        dt =
            toFloat complete / toFloat duration
    in
    if dt > 1.0 then
        0.0

    else
        (x0 + 8 * x0 * dt) * (e ^ (-8 * dt))