JM I took the freedom to modify this code from Richard Suchenwirth (just a few lines, by the way) to have a version of this timeliner that handles events in minutes instead of years...
if 0 {Richard Suchenwirth 2004-08-10 - Yet another thing to do with a canvas: history visualisation of a horizontal time-line, for which a year 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 year is displayed in the toplevel's title. Normal items can be a single year, like the Columbus example, or a range of years, for instance for lifetimes of persons. (The example shows that Mozart didn't live long...) }
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]
}if 0 {Here's a sample application, featuring a concise history of music in terms of composers:}
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
}if 0 {
These nifty shorthands for adding items make data specification a breeze
- compare the original call, and the shorthand:
timeliner::add .c item Purcell 1659-1695
- Purcell 1659-1695
With an additional "!" argument you can make the text of an item bold:}
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
- Lunch 8/25/2004 13:00 8/25/2004 14:00
bind . <Escape> {exec wish $argv0 &; exit}
bind . <F1> {console show}