Colored Timestamps

I noticed a fun post in early December that implements a mapping between current time and a "unique" RGBA color. I thought it might be fun to use Factor to implement a colored clock.

The basic concept is to map the 4,294,967,296 unique RGBA colors to seconds, which gives just over 136 years of unique colors.

timestamp>rgba

We calculate timestamps as an offset from Dennis Ritchie's birthday:

: start-date ( -- timestamp )
    1941 9 9 <date> ; inline

The offset is an elapsed number of seconds from the start date:

: elapsed ( timestamp -- seconds )
    start-date time- duration>seconds >integer ;

The conversion from a timestamp into a unique RGBA color does successive divmod operations to map into Red, Green, Blue, and Alpha values:

: timestamp>rgba ( timestamp -- color/f )
    elapsed dup 0 32 2^ between? [
        24 2^ /mod 16 2^ /mod 8 2^ /mod
        [ 255 /f ] 4 napply <rgba>
    ] [ drop f ] if ;

You can try it for yourself, showing how the values change over time:

IN: scratchpad start-date timestamp>rgba .
T{ rgba
    { red 0.0 }
    { green 0.0 }
    { blue 0.0 }
    { alpha 0.0 }
}

IN: scratchpad now timestamp>rgba .
T{ rgba
    { red 0.5176470588235295 }
    { green 0.3803921568627451 }
    { blue 0.4313725490196079 }
    { alpha 0.3333333333333333 }
}

<rgba-clock>

Let's use the timestamp>rgba word to make an updating "colored clock". Specifically, we can use an arrow model to update a label every second to create an RGBA clock:

: update-colors ( color label -- )
    [ font>> background<< ]
    [ [ <solid> ] dip [ interior<< ] [ boundary<< ] 2bi ]
    2bi ;

: <rgba-clock> ( -- gadget )
    f <label-control>
        time get over '[
            [ timestamp>rgba _ update-colors ]
            [ timestamp>hms ] bi
        ] <arrow> >>model
        "HH:MM:SS" >>string
        monospace-font >>font ;

Use the gadget. word to try it in your listener, and watch it update:

IN: scratchpad <rgba-clock> gadget.

The code for this is on my Github.