Re: Factor

Factor: the language, the theory, and the practice.

Time My Meeting

Wednesday, May 1, 2024

#ui

Recently, I bumped into Time My Meeting, a cute website that runs a timer for how long a meeting has run and then shows you a fun comparison versus something memorable that has taken a similar amount of time.

I thought it might make a nice demo in Factor:

Our program starts with a list of things that take time and how many milliseconds they take:

CONSTANT: THINGS-THAT-TAKE-TIME {
    ! <10 seconds
    { "A single frame of a film" 100 }
    { "It would take light to go around the Earth" 133 }
    { "A blink of an eye" 400 }
    { "The time it takes light to reach Earth from the moon" 1255 }
    { "The fastest Formula 1 pit stop" 1820 }
    { "The fastest 1/4 mile drag race time" 3580 }
    { "The fastest Rubik's cube solve" 4221 }
    { "The fastest 40-yard time at the NFL Combine" 4240 }
    { "The fastest 1 liter beer chug" 4370 }
    { "A skippable Youtube ad" 5000 }
    { "A full bull ride" 8000 }
    { "The fastest 100m sprint" 9580 }

    ! 10 Seconds
    { "The Wright Brothers first flight" 12000 }
    { "The fastest 200m sprint" 19190 }
    { "The fastest 50m freestyle swim lap" 21300 }
    { "The Westminster Kennel Club dog agility record" 28440 }
    { "A typical television ad" 30000 }
    { "The fastest NASCAR lap at Daytona" 40364 }
    { "The fastest 400m sprint" 43030 }
    { "The fastest NASCAR lap at Talladega" 44270 }
    { "The fastest 100m freestyle swim lap" 47050 }
}

We need a small word to turn those milliseconds into a useful string:

: human-time ( milliseconds -- string )
    1000 / dup 60 <
    [ "%.1f seconds" sprintf ]
    [ seconds duration>human-readable ] if ;

We may also need to know what the next thing that takes time will be, based on the total elapsed time:

: next-thing-that-takes-time ( elapsed-millis -- elt )
    THINGS-THAT-TAKE-TIME [ second < ] with find nip ;

Command-Line

First, we are going to make a simple word to run this on the command-line, iterating through the things that take time and then sleeping the appropriate amount of time, and then printing them out as they pass:

: time-my-meeting. ( -- )
    now THINGS-THAT-TAKE-TIME [
        [ milliseconds pick time+ sleep-until ]
        [ human-time "%s (%s)\n" printf flush ] bi
    ] assoc-each drop ;

You can run it and get something like this:

IN: scratchpad time-my-meeting.
A single frame of a film (0.1 seconds)
It would take light to go around the Earth (0.1 seconds)
A blink of an eye (0.4 seconds)
The time it takes light to reach Earth from the moon (1.3 seconds)
The fastest Formula 1 pit stop (1.8 seconds)
The fastest 1/4 mile drag race time (3.6 seconds)
The fastest Rubik's cube solve (4.2 seconds)
The fastest 40-yard time at the NFL Combine (4.2 seconds)
The fastest 1 liter beer chug (4.4 seconds)
A skippable Youtube ad (5.0 seconds)
A full bull ride (8.0 seconds)
The fastest 100m sprint (9.6 seconds)
The Wright Brothers first flight (12.0 seconds)
...

User Interface

We are also going to build the interface shown above, starting with a gadget that stores a timer, a total elapsed time in milliseconds, and a meeting start timestamp.

TUPLE: meeting-gadget < track timer total start ;

There are different strategies for building user interfaces, depending on the data model, and how composable or how separate the elements being displayed are from each other.

In the interest of tutorials, I want to demonstrate one strategy below that uses local variables to bind the elements to each other, allowing them to be updated in a kind of reactive manner. It is a long word, but the structure of the code matches somewhat to the rendered output that we are going for.

:: <meeting-gadget> ( -- gadget )
    vertical meeting-gadget new-track dup :> meeting
        COLOR: #f7f08b <solid> >>interior
        0 >>total

        "" <label> :> current-text
        "" <label> :> current-time

        "" <label> :> total-time
        "" <label> :> start-time

        THINGS-THAT-TAKE-TIME first first2 human-time
        [ <label> ] bi@ :> ( next-text next-time )

        [
            meeting total>>
            meeting [ now dup ] change-start drop swap time- duration>milliseconds +
            dup meeting total<<

            dup next-thing-that-takes-time first2
            over next-text string>> = [ 2drop ] [
                next-text string>> current-text string<<
                next-time string>> current-time string<<
                human-time
                next-time string<<
                next-text string<<
            ] if

            human-time total-time string<<
        ] f 100 milliseconds <timer> >>timer

        vertical <track>
            current-text f track-add
            current-time f track-add
        "This meeting is longer than..." <labeled-gadget> f track-add

        vertical <track>
            total-time f track-add
            start-time f track-add
        "It has been going on for..." <labeled-gadget> f track-add

        vertical <track>
            next-text f track-add
            next-time f track-add
        "The next milestone is..." <labeled-gadget> f track-add

        "Start" <label> :> start-label
        "Reset" <label> :> reset-label

        horizontal <track>
            start-label [
                drop
                meeting
                dup start>> [
                    0 >>total now timestamp>hms
                    "Started at " prepend start-time string<<
                ] unless
                now >>start
                timer>> dup thread>>
                [ stop-timer "Resume" start-label string<< ]
                [ start-timer "Pause" start-label string<< ] if
            ] <border-button> f track-add

            reset-label [
                drop
                meeting 0 >>total f >>start timer>> stop-timer
                "Start" start-label string<<
                "" current-text string<<
                "" current-time string<<
                "" total-time string<<
                "" start-time string<<
                THINGS-THAT-TAKE-TIME first first2 human-time
                next-time string<<
                next-text string<<
            ] <border-button> f track-add
        f track-add ;

And, then a main entrypoint to open a window when the vocabulary is run:

MAIN-WINDOW: time-my-meeting
    { { title "Time My Meeting" } }
    <meeting-gadget> >>gadgets ;

With a smidge of improved fonts and better gadget spacing, this is now available in my GitHub.

You can try it out!