timeliner (minutes instead of years)

JM Sep-4-2004, I took the freedom to adapt this code from Richard Suchenwirth (I had to change just a few lines, by the way) to have a version of this timeliner that handles events in minutes instead of years...

Assumption: If one event finishes, let's say at 9am, and another starts at the very same hour (9am), then there is no conflict.

Richard Suchenwirth 2004-08-10 - Yet another thing to do with a canvas: history visualisation of a horizontal time-line, for which a time scale is displayed on top. The following kinds of objects are so far available:

  • "eras", displayed in yellow below the timeline in boxes
  • "background items" that are grey and stretch over all the canvas in height
  • normal items, which get displayed as stacked orange bars

You can zoom in with <1>, out with <3> (both only in x direction). On mouse motion, the current time is displayed in the toplevel's title. Normal items can be a single minute, or a range of minutes and hours, for instance for duration of a meeting.

 namespace eval timeliner {
    variable ""
    array set "" {-zoom 1  -from 0 -to 2000}

 proc timeliner::create {w args} {
    variable ""
    array set "" $args
    #-- draw time scale
    for {set x [expr ($(-from)/50)*50]} {$x<=$(-to)} {incr x 10} {
        set hr "[clock format [expr $x * 60] -format %H:%M]"
        #puts  "[clock format [expr $x * 60] -format %b%e%H:%M]"
        if {$x%60 == 0} {
            $w create line $x 8 $x 0
            $w create text $x 8 -text $hr -anchor n
        } else {
            $w create line $x 5 $x 0
    bind $w <Motion> {wm title . [clock format [expr int([%W canvasx %x]/$::timeliner::(-zoom)) * 60]]}
    bind $w <1> {timeliner::zoom %W 1.25}
    bind $w <3> {timeliner::zoom %W 0.8}

 proc timeliner::zoom {w factor} {
    variable ""
    $w scale all 0 0 $factor 1
    set (-zoom) [expr {$(-zoom)*$factor}]
    $w config -scrollregion [$w bbox all]

if 0 {This command adds an object to the canvas. The code for "item" took me some effort, as it had to locate a free "slot" on the canvas, searching top-down:}

 proc timeliner::add {w type name dateF timeF dateT timeT args} {
    variable ""
    #regexp {(\d+)(-(\d+))?} $time -> from - to
    set from [tclTime $dateF $timeF]
    set to [tclTime $dateT $timeT]
    if {$to eq ""} {set to $from}
    set x0 [expr {$from*$(-zoom)}]
    set x1 [expr {$to*$(-zoom)}]
    switch -- $type {
        era    {set fill yellow; set outline black; set y0 20; set y1 40}
        bgitem {set fill gray; set outline {}; set y0 40; set y1 1024}
        item   {
            set fill orange
            set outline yellow
            for {set y0 60} {$y0<400} {incr y0 20} {
                set y1 [expr {$y0+18}]
                if {[$w find overlap [expr $x0+1] $y0 $x1 $y1] eq ""} break
    set id [$w create rect $x0 $y0 $x1 $y1 -fill $fill -outline $outline]
    #puts "ok $id"
    if {$type eq "bgitem"} {$w lower $id}
    set tid [$w create text [expr {$x0+5}] [expr {$y0+2}] -text $name -anchor nw]
    foreach arg $args {
        if {$arg eq "!"} {
            $w itemconfig $tid -font "[$w itemcget $tid -font] bold"
    $w config -scrollregion [$w bbox all]

Here's a sample application:

 proc tclTime {date time} {
    # tiempo original en minutos
    set timeO [expr [clock scan "$date $time"] / 60]

 proc ui {date time hours} {
   set center [tclTime $date $time]
   set from [expr $center - [expr $hours * 60]]
   set to   [expr $center + [expr $hours * 60]]
   scrollbar .x -ori hori -command {.c xview}
   pack      .x -side bottom -fill x
   set ancho [expr $to - $from]
   canvas    .c -bg white -width $ancho -height 150 -xscrollcommand {.x set}
   pack      .c -fill both -expand 1
   timeliner::create .c -from $from -to $to

These nifty shorthands for adding items make data specification a breeze - compare the original call, and the shorthand:

 timeliner::add .c item Meeting 8/25/2004 09:00 8/25/2004 10:00
 - Meeting 8/25/2004 09:00 8/25/2004 10:00
 With an additional "!" argument you can make the text of an item bold:
 - Breakfast 8/25/2004 08:00 8/25/2004 09:00 !

the next call defines the date and time in the center of our schedule, the last parameter sets how many hours to map around it

 ui 8/25/2004 12:00 6
 foreach {shorthand type} {* era  x bgitem - item} {
    interp alias {} $shorthand {} timeliner::add .c $type

#-- Now for the data to display (written pretty readably):
 * {Working Hours} 8/25/2004 08:00 8/25/2004 17:00
 x {Let's go home} 8/25/2004 17:00 8/25/2004 17:01
 - Breakfast       8/25/2004 08:00 8/25/2004 09:00
 - Meeting         8/25/2004 09:00 8/25/2004 10:00 !
 - "Coffee break"  8/25/2004 10:30 8/25/2004 10:45
 x Lunch           8/25/2004 13:00 8/25/2004 14:00
 - Conference      8/25/2004 14:00 8/25/2004 16:30 !
 - "Coffee break"  8/25/2004 15:30 8/25/2004 15:45

 bind . <Escape> {exec wish $argv0 &; exit}
 bind . <F1>     {console show}

HJG Removed references to history/years/composers.