set color(inactive) #0000a0
set color(active) #00ffff
set robsfont [font create -family Palatino -size 12]
 
 

# dialTrig - tells where to put the text around the circle.

proc dialTrig {sc counter radius} {
 global endpoint canh
 set endpoint(xt) \
  [expr int(($radius)*(sin(($counter*(6.283/$sc))-(3.1415/$sc))))]
 set endpoint(yt) \
  [expr int(($radius)*(cos(($counter*(6.283/$sc))-(3.1415/$sc))))]
 set endpoint(xt) [expr $canh/2+$endpoint(xt)]
 set endpoint(yt) [expr $canh/2-$endpoint(yt)]
}
 

# dialPoly - creates arc obects in the canvas: arc objects
#  are created using the following syntax:
#  window create arc x1 y1 x2 y2 -extent degrees -fill color1 \
#    -outline color2 -width linewidth -style style -start startplace
#
#  where x1, x2, y1, y2 are bounding coordinates of the circle that
#  contains the arc, degrees is the angular extent of the arc,
# color1 is the color of the ionterior of the arc, color2 is
# the color of the line encasing the arc, linewidth is the width
# of the line encasing the arc, style tells what typ of arc (just the
# arc or a wedge), and startplace tells where the arc starts: 0 is
#  the 3 o'clock posiotion, 90 is the 12 o'clock position.

proc dialPoly {w count radius unit} {
 global polypointx polypointy color sc canh
 set bbox(1) [expr $canh/2 - $radius]
 set bbox(2) [expr $canh/2 + $radius]
 $w create arc $bbox(1) $bbox(1) $bbox(2) $bbox(2) \
  -extent [expr 360/$sc] -fill $color(inactive) \
  -outline gray83 -width 2 -style pieslice \
  -start [expr 90-$count*(360./$sc)] \
  -tags "$unit wedge$unit"
}
 

# cyclical - creates the circles in the canvas... here, there are three
# "scales" - month, day, hour - thus three separate segements to this
# procedure.  Commenting for the month circles applies to the other
# two scales as well.

proc cyclical {w period} {

 global endpoint polypointx polypointy robsfont canw canh sc color
 
## the month circles.
 set sc 12 ;# number of sections of the circle.
 
 set count 0 ;# a counter.
 
 # this foreach loop creates the arc polygons
 #  (wedges) for the month circle.
 #
 foreach month {Ja Fe Mr Ap My Jn\
   Jl Au Se Oc No De Ja} {
  set count [expr $count+1] ;# counter increments. "incr count"
       # does same thing.
  dialPoly $w $count [expr $canh/2.5 + 15] month
 }
 
 # this next section creates the "select All months" circle inside
 # the wedges
 #
 set radius [expr $canh/2.5];  # the radius of the
      # month circle is the size
      # of the canvas divided by 2.5.

 set x1 [expr $canh/2 - $radius] ; set x2 [expr $canh/2 +$radius]
 $w create oval $x1 $x1 $x2 $x2 -fill $color(inactive) \
  -outline gray83 -width 2 -tags "month allSelector allmonth"
 
 # this next section creates the gray circle inside the select all Months
 # circle, on which the rest of the legend is built.
 #
 set radius [expr $canh/2.5 - 10]
 set x1 [expr $canh/2 - $radius] ; set x2 [expr $canh/2 +$radius]
 $w create oval $x1 $x1 $x2 $x2 -fill gray75 -outline gray83 -width 2

 # this next secion places the text for each month in the proper place.
 #
 set count 0
 foreach month {Ja Fe Mr Ap My Jn\
  Jl Au Se Oc No De Ja} {
  incr count
  dialTrig $sc $count [expr $canh/2.5 + 25]
  $w create text $endpoint(xt) $endpoint(yt) \
   -text $month -fill Black -font $robsfont
 }

## the day circles.
 set sc 31
 for {set day 1} {$day <= 32} {incr day} {
  dialPoly $w $day [expr $canh/3.5 + 15] day
 }
 
 set radius [expr $canh/3.5]
 set x1 [expr $canh/2-$radius] ; set x2 [expr $canh/2 +$radius]
 $w create oval $x1 $x1 $x2 $x2 -fill $color(inactive) \
  -outline gray83 -width 2 -tags "day allSelector allday"

 set radius [expr $canh/3.5 - 10]
 set x1 [expr $canh/2-$radius] ; set x2 [expr $canh/2 +$radius]
 $w create oval $x1 $x1 $x2 $x2 -fill gray75 -outline gray83 -width 2

 for {set day 1} {$day < 32} {incr day} {
  dialTrig $sc $day [expr $canh/3.5 + 25]
  $w create text $endpoint(xt) $endpoint(yt) \
   -text $day -fill Black -font $robsfont
 }

## the hour circles.
 set sc 24
 foreach hour {00 01 02 03 04 05 06 07 08 09 10 11 12 \
    13 14 15 16 17 18 19 20 21 22 23 00} {
  set count [expr $count+1]
  dialPoly $w $count [expr $canh/6. + 15] hour
 }

 set radius [expr $canh/6.]
 set x1 [expr $canh/2-$radius] ; set x2 [expr $canh/2 +$radius]
 $w create oval $x1 $x1 $x2 $x2 -fill $color(inactive) \
   -outline gray83 -width 2 -tags "hour allSelector allhour"

 set radius [expr $canh/6. - 10]
 set x1 [expr $canh/2-$radius] ; set x2 [expr $canh/2 +$radius]
 $w create oval $x1 $x1 $x2 $x2 -fill gray75 -outline gray83 -width 2
 

 set count 0
 foreach hour {00 01 02 03 04 05 06 07 08 09 10 11 12 \
    13 14 15 16 17 18 19 20 21 22 23 00} {
  incr count
  dialTrig $sc $count [expr $canh/6. + 25]
   $w create text $endpoint(xt) $endpoint(yt) \
  -text $hour -font $robsfont -fill Black
  }
}
 

#  * * *
# itemSelect --
#  This procedure changes the color of the polygon selected.
# c -- the name of the window

proc itemSelect {c unit} {
     global color flag
 set tagslist [$c gettags current] ; # a list of all the tags of
       # the wedge selected.

 # if a wedge is selected, turn off the allSelect circle.
 #
 $c itemconfig all$unit -fill $color(inactive)

 # toggle the color of the wedge... if on, turn it off, and v.v.
 #
     set fill [lindex [$c itemconfig current -fill] 4]
     if {$fill == $color(active)} {
  $c itemconfig current -fill $color(inactive)
     } else {
  $c itemconfig current -fill $color(active)

  # turn on all wedges and allSelect ciclres of interior scales
  #  if none are selected (default is an allSelect).
  #
  set flag 1
  if {$unit == "month"} {
   foreach item [$c find withtag day] {
     if {[lindex [$c itemconfig $item -fill] 4] \
    == $color(active)} {
      set flag 0

      break
     }

     set flag 1
   }
   if {$flag == 1} {
    foreach item [$c find withtag hour] {
     if {[lindex [$c itemconfig $item -fill] 4] \
    == $color(active)} {
      set flag 0

      break
     }

     set flag 1
    }
   }
   if {$flag == 1} {
    $c itemconfig day -fill $color(active)
    $c itemconfig hour -fill $color(active)
   }
  } elseif {$unit == "day"} {
   foreach item [$c find withtag hour] {
     if {[lindex [$c itemconfig $item -fill] 4] \
    == $color(active)} {
      set flag 0

      break
     }

     set flag 1
   }
   if {$flag == 1} {
    $c itemconfig hour -fill $color(active)
   }

  }
 }
 
 

}
 

proc allSelect {c unit} {

 global color
  set tagslist [$c gettags current]; # a list of all the tags of
       # the allSelect circle or wedge
       # selected.
 
 # toggle the color of the allSelect circle and all the wedges.
 #
 set fill [lindex [$c itemconfig current -fill] 4]
 
 if {$fill == $color(active)} {
  $c itemconfig current -fill $color(inactive)
  if {[lsearch $tagslist allmonth] != -1} {
   $c itemconfig month -fill $color(inactive)
  } elseif {[lsearch $tagslist allday] != -1} {
   $c itemconfig day -fill $color(inactive)
  } elseif {[lsearch $tagslist allhour] != -1} {
   $c itemconfig hour -fill $color(inactive)
  } elseif {[lsearch $tagslist allyear] != -1} {
   $c itemconfig year -fill $color(inactive)
  }

 } else {

  $c itemconfig current -fill $color(active)
  if {[lsearch $tagslist allmonth] != -1} {
    $c itemconfig month -fill $color(active)
  } elseif {[lsearch $tagslist allday] != -1} {
   $c itemconfig day -fill $color(active)
  } elseif {[lsearch $tagslist allhour] != -1} {
   $c itemconfig hour -fill $color(active)
  } elseif {[lsearch $tagslist allyear] != -1} {
   $c itemconfig year -fill $color(active)
  }

 }

}

proc linear {c} {
 global color robsfont
 set region {0 0 1400 50}

 frame $c.c
 scrollbar $c.c.hscroll -orient horiz -command "$c.c.can xview"
 canvas $c.c.can -height 50 -width 400 \
       -xscrollcommand "$c.c.hscroll set" -scrollregion $region \
  -relief sunken -bd 1
 pack $c.c -fill both -expand yes
 pack $c.c.can $c.c.hscroll -side top

 set boxlength 100
 set count 0
 foreach year {1990 1991 1992 1993 1994 1995 1996 1997 1998 1999} {
  set xs [expr 200 + $count*$boxlength]
  set xe [expr 198 + ($count+1)*$boxlength]
  set xt [expr 148 + ($count+1)*$boxlength]

  $c.c.can create rect $xs 20 $xe 35 -fill $color(inactive) \
   -width 1 -outline gray83 -tags "year wedgeyear"
 
  $c.c.can create text $xt 10 -text $year -font $robsfont
  incr count
 }
 $c.c.can create rect 200 36 1198 44 -fill $color(inactive) \
   -width 1 -outline gray83 -tags "year allyear allSelect"

$c.c.can bind wedgeyear <1> "itemSelect $c.c.can year"
$c.c.can bind allyear <1> "allSelect $c.c.can year"

}
 

## main body:

set canh 400 ;# add linh and canh and use result for HEIGHT in HTML
set canw 400 ;# use canw for WIDTH in HTML
set linh 100

canvas .c -height $canh -width $canw -relief sunken -bd 1
canvas .l -height $linh -width $canw -relief sunken -bd 1

pack .c .l -side top ;# "-side top" puts first item (.c) above second (.l)

.c bind wedgemonth <1> "itemSelect .c month"
.c bind wedgeday <1> "itemSelect .c day"
.c bind wedgehour <1> "itemSelect .c hour"
;  # click on any polygon in .c with
       #   the wedge* tag and it
       #   will run itemSelect procedure
       #   with that item.

.c bind allmonth <1> "allSelect .c month"
.c bind allday <1> "allSelect .c day"
.c bind allhour <1> "allSelect .c hour"
     # click on any allSelect circle...

# create the circles legend...
cyclical .c 1

# create the timeline legend...
linear .l

frame .t -relief raised -bd 1 -height 100 -width 400

label .t.1 -wraplength 300 -font $robsfont -text "
Clikcing on any of the wedges of the cycle or any of the years of the timeline \
selects that unit for query or display.  Cliking on a wedge of a certain scale \
automatically selects all units of time for finer scales, unless a unit of time \
at a finer scale has already been selected.  Clicking on any of the circles inside \
the wedges selects all (or selects none) of the wedges at that scale.
"

pack .t -side top -expand yes -fill both
pack .t.1