global Procs
set Name [unique2 $Composite.dial]
set Parent $Name

#------------------------------------------
canvas $Name -height 60 -scrollregion {0c 0c 10c 10c} -width 60
pack $Name 

bind $Name <B1-Motion> "draw_indicator %W %x %y"
bind $Name <1> "draw_indicator %W %x %y"
bind $Name <Configure> "draw_dial %W"

set Procs($Name) ""
lappend Procs($Name) {bind $Name <1>}
lappend Procs($Name) {bind $Name <B1-Motion>}
lappend Procs($Name) {bind $Name <Configure>}
lappend Procs($Name) draw_dial
lappend Procs($Name) draw_indicator
lappend Procs($Name) set_dial
lappend Procs($Name) {$Name.callback}


proc draw_indicator {can x y} {
  set color [get_widget_value $can insertbackground]
  catch "$can delete i"
  if {[winfo width $can] < [winfo height $can]} { set size [winfo width $can]
  } else { set size [winfo height $can]}
  set x1 [expr $size /2]
  set y1 [expr $size /2]
  if [catch {set t [expr atan2($y-$y1,$x-$x1)]}] {set t 0}
  set len [expr $size / 3]
  if {$t > 1.57 && $t < 2.09} {set t 2.09}
  if {$t < 1.57 && $t > 1.04} {set t 1.04}
  set x2 [expr $len * cos($t)+$x1]
  set y2 [expr $len * sin($t)+$y1]
  if {$t < 1.57} {set t [expr $t+6.28]}
  set t [expr ($t-2.09)/5.23]

  # t is now between 0.0 and 1.0 inclusive
  $can.callback $t

  $can create line $x1 $y1 $x2 $y2 -tag i -width 2 -arrow last -fill $color
}

proc $Name.callback {t} {
  echo $t
}

proc set_dial {can val} {
  set color [get_widget_value $can insertbackground]
  set val [expr $val / 1000.0]
  if {$val > 1.0} {set val 1.0}
  if {$val < 0.0} {set val 0.0}
  $can.callback $val
  set t [expr $val*5.23+2.09]
  if {[winfo width $can] < [winfo height $can]} { set size [winfo width $can]
  } else { set size [winfo height $can]}
  set len [expr $size / 3]
  set x1 [expr $size /2]
  set y1 [expr $size /2]
  set x2 [expr $len * cos($t)+$x1]
  set y2 [expr $len * sin($t)+$y1]
  catch "$can delete i"
  $can create line $x1 $y1 $x2 $y2 -tag i -width 2 -arrow last -fill $color
}

proc draw_dial {can} {
  catch "$can delete a1"
  catch "$can delete a2"
  catch "$can delete i"
  if {[winfo width $can] < [winfo height $can]} { set size [winfo width $can]
  } else { set size [winfo height $can]}
  set size [expr $size - [$can cget -highlightthickness]]
  #$can config -width $size -height $size
  set bw [get_widget_value $can borderwidth]
  set rgb [winfo rgb . [get_widget_value $can background]]
  set r [expr [lindex $rgb 0]/256]
  set g [expr [lindex $rgb 1]/256]
  set b [expr [lindex $rgb 2]/256]
  set color [get_widget_value $can insertbackground]
  set rl [expr $r*2]; if {$rl > 255} {set rl 255}
  set gl [expr $g*2]; if {$gl > 255} {set gl 255}
  set bl [expr $b*2]; if {$bl > 255} {set bl 255}
  set rd [format "%x" [expr $r/2]]
  set gd [format "%x" [expr $g/2]]
  set bd [format "%x" [expr $b/2]]
  set rl [format "%x" $rl]
  set gl [format "%x" $gl]
  set bl [format "%x" $bl]
  if {[string length $rl] == 1} {set rl 0$rl}
  if {[string length $gl] == 1} {set gl 0$gl}
  if {[string length $bl] == 1} {set bl 0$bl}
  if {[string length $rd] == 1} {set rd 0$rd}
  if {[string length $gd] == 1} {set gd 0$gd}
  if {[string length $bd] == 1} {set bd 0$bd}
  set light #$rl$gl$bl
  set dark #$rd$gd$bd
  echo $light $dark

  $can create arc [expr 4+$bw] [expr 4+$bw] [expr $size-4-$bw] \
    [expr $size-4-$bw] -width 2\
    -start 45 -extent 180 -fill $light -tag a1 -style arc
  $can create arc [expr 4+$bw] [expr 4+$bw] [expr $size-4-$bw] \
    [expr $size-4-$bw] -width 2\
    -start 45 -extent -180 -fill $dark -tag a2 -style arc
  set l2 [expr $size / 10]
  set l1 [expr $size/2-$bw*2-8-$l2]
  set inc [expr 6.28 / 12.0]; #12 ticks
  for {set t $inc*4} {$t < 6.28+$inc*2} {set t [expr $t+$inc]} {
    set x1 [expr $size /2 + $l1 * cos($t)]
    set y1 [expr $size /2 + $l1 * sin($t)]
    set x2 [expr $l2 * cos($t)+$x1]
    set y2 [expr $l2 * sin($t)+$y1]
    catch "$can delete t$t"
    $can create line $x1 $y1 $x2 $y2 -tag t$t -fill $color
  }
  set l2 [expr $size / 20]
  set l1 [expr $size/2-$bw*2-8-$l2]
  set inc [expr 6.28 / 36.0]; #36 ticks
  for {set t $inc*12} {$t < 6.28+$inc*6} {set t [expr $t+$inc]} {
    set x1 [expr $size /2 + $l1 * cos($t)]
    set y1 [expr $size /2 + $l1 * sin($t)]
    set x2 [expr $l2 * cos($t)+$x1]
    set y2 [expr $l2 * sin($t)+$y1]
    catch "$can delete T$t"
    $can create line $x1 $y1 $x2 $y2 -tag T$t -fill $color
  }
}

