- "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
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.
