
set Name [unique2 $Composite.pos]
set Parent $Name
#------------------------------------------
canvas $Name -height 40 -insertbackground red -relief groove -scrollregion {0c 0c 10c 10c} -selectforeground purple -width 40
place $Name -relx 0.24 -rely 0.06 -relwidth 0.14 -relheight 0.12 -anchor nw

global Procs
set Procs($Name) {{bind $Name <B1-Motion>} draw_position {$Name.callback}}
bind $Name <B1-Motion> {draw_position %W %x %y}

proc draw_position {can x y} {
  set color [get_widget_value $can insertbackground]
  if {$x > [winfo width $can]} {set x [winfo width $can]}
  if {$y > [winfo height $can]} {set y [winfo height $can]}
  if {$x < 0} {set x 0}
  if {$y < 0} {set y 0}
  catch "$can delete x"
  catch "$can delete y"
  $can create line $x 0 $x [winfo height $can] -tag x -fill $color
  $can create line 0 $y [winfo width $can] $y -tag y -fill $color
  $can.callback $can $x $y
}
proc $Name.callback {w x y} {
  puts "position at $x $y"
  # Add your code here.
}
