if 0 {<<br>>
[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

[WikiDbImage timeliner.jpg]

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} {
        if {$x%50 == 0} {
            $w create line $x 8 $x 0
            $w create text $x 8 -text $x -anchor n
        } else {
            $w create line $x 5 $x 0
        }
    }
 #  bind $w <Motion> {wm title . [expr int([%W canvasx %x]/$::timeliner::(-zoom))]}
    bind $w <Motion> {timeliner::title %W %x ; timeliner::movehair %W %x}
    bind $w <1> {timeliner::zoom %W %x 1.25}
    bind $w <2> {timeliner::hair %W %x}
    bind $w <3> {timeliner::zoom %W %x 0.8}
 }
 proc timeliner::movehair {w x} {
    variable ""
    if {[llength [$w find withtag hair]]} {
        set x [$w canvasx $x]
        $w move hair [expr {$x - $(x)}] 0
        set (x) $x
    }
 }
 proc timeliner::hair {w x} {
    variable ""
    if {[llength [$w find withtag hair]]} {
        $w delete hair
    } else {
        set (x) [$w canvasx $x]
        $w create line $(x) 0 $(x) [$w cget -height] \
                  -tags hair -width 1 -fill red
    }
 }
 proc timeliner::title {w x} {
    variable ""
    wm title . [expr int([$w canvasx $x]/$(-zoom))]
 }
 proc timeliner::zoom {w x factor} {
    variable ""
    $w scale all 0 0 $factor 1
    set (-zoom) [expr {$(-zoom)*$factor}]
    $w config -scrollregion [$w bbox all]
    if {[llength [$w find withtag hair]]} {
        $w delete hair
        set (x) [$w canvasx $x]
        $w create line $(x) 0 $(x) [$w cget -height] \
                  -tags hair -width 1 -fill red
    }
 }
if 0 {<<br>>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:<<br>>}
 proc timeliner::add {w type name time args} {
    variable ""
    regexp {(\d+)(-(\d+))?} $time -> from - to
    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-5] $y0 $x1 $y1] eq ""} break
            }
        }
    }
    set id [$w create rect $x0 $y0 $x1 $y1 -fill $fill -outline $outline]
    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 "!"} {
            # modified by buchs $w itemconfig $tid -font "[$w itemcget $tid -font] bold"
            # appropriately handles return of TkDefaultFont
            set fontused [font actual [$w itemcget $tid -font]]
            set fontbold [regsub -- {-weight [^ ]*} $fontused {-weight bold}]
            $w itemconfig $tid -font "$fontbold"
        }
    }
    $w config -scrollregion [$w bbox all]
 }
if 0 {<<br>>Here's a sample application, featuring a concise history of music in terms of
composers:<<br>>}
 scrollbar .x -ori hori -command {.c xview}
 pack      .x -side bottom -fill x
 canvas    .c -bg white -width 600 -height 300 -xscrollcommand {.x set}
 pack      .c -fill both -expand 1
 timeliner::create .c -from 1400 -to 2000
 
if 0 {<<br>>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:
<<br>>}
 foreach {shorthand type} {* era  x bgitem - item} {
    interp alias {} $shorthand {} timeliner::add .c $type
 }
#-- Now for the data to display (written pretty readably):
 * {Middle Ages} 1400-1450
 - Dufay 1400-1474
 * Renaissance    1450-1600
 - Desprez 1440-1521
 - Luther 1483-1546
 - {Columbus discovers America} 1492
 - Palestrina 1525-1594 !
 - Lasso 1532-1594
 - Byrd 1543-1623
 * Baroque        1600-1750
 - Dowland 1563-1626
 - Monteverdi 1567-1643
 - Schütz 1585-1672
 - Purcell 1659-1695
 - Telemann 1681-1767
 - Rameau 1683-1764
 - Bach,J.S. 1685-1750 !
 - Händel 1685-1759
 x {30-years war} 1618-1648
 * {Classic era}  1750-1810
 - Haydn 1732-1809 !
 - Boccherini 1743-1805
 - Mozart 1756-1791 !
 - Beethoven 1770-1828 !
 * {Romantic era} 1810-1914
 - {Mendelssohn Bartholdy} 1809-1847
 - Chopin 1810-1849
 - Liszt 1811-1886
 - Verdi 1813-1901
 x {French revolution} 1789-1800
 * {Modern era}   1914-2000
 - Ravel 1875-1937 !
 - Bartók 1881-1945
 - Stravinskij 1882-1971
 - Varèse 1883-1965
 - Prokof'ev 1891-1953
 - Milhaud 1892-1974
 - Honegger 1892-1955
 - Hindemith 1895-1963
 - Britten 1913-1976
 x WW1 1914-1918
 x WW2 1938-1945

 bind . <Escape> {exec wish $argv0 &; exit}
 bind . <F1> {console show}
 
if 0 {<<br>>
[US] Nice. I took the freedom to add a red hair. Toggle on/off with middle button.
<<br>>
''[escargo]'' - Note that not all user interfaces will provide three mouse buttons, like
the laptop I'm using right now.
<<br>>
[RS]: Thanks for your interest and comments. 
Testing the hair, I find that my mouse has a middle button, but Tk seems not to respond to it :(  
I noted however that someone changed references to the "anonymous array" "" into the namespace path ::timeliner:: . That is redundant and less convenient, should the name of the namespace change. 
So I changed back references like
   $::timeliner::(-zoom)
to the equivalent (as long as we're in the ::timeliner namespace)
   $(-zoom)
That's why I declare ''variable ""'', and that's what the anonymous array was created for - 
beautiful minimal syntax ... :)
----
Sep-4-2004 [JM] If you want to map events in minutes (like activities in a working day) 
you can see this very same code, with just a few lines modified [timeliner (minutes instead of years)]

----
[AMG]: Somebody munged the encoding, so I fixed it back using [[[encoding convertfrom] utf-8]].  
Please be careful when editing pages.

----
Jan-28-2009 [buchs]: I added some code to the bolding section, to enable handling a return of TkDefaultFont.
----
!!!!!!
%| [Arts and crafts of Tcl-Tk programming] | [Category Application] |%
!!!!!!
}