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.

Category Application