overlay.tcl

# $Id$ #

#
# /** Some functions to draw on images' overlay. \file overlay.tcl \ingroup display */
#

namespace eval display {

    proc drawLine {img u1 v1 u2 v2
       {width 1}
       {color red}        
       {tag "jafar"} } {
  # draws a line from (u1,v1) to (u2,v2)
  # return the tk id of the line

  variable imageScale

  if {$imageScale($img) == 1.0} {
      return [.$img.$img create line $u1 $v1 $u2 $v2 \
      -fill $color -width $width -tags $tag]
  } else {
      set s $imageScale($img)
      return [.$img.$img create line [expr $s * $u1] [expr $s * $v1] [expr $s * $u2] [expr $s * $v2] \
      -fill $color -width $width -tags $tag]
  }
    }

    proc drawCross {img u v
        {size 3}
        {width 1}
        {color red}       
        {tag "jafar"} } {
  # draws a cross om img at (u,v)
  # return a list containing the two tk ids of the two lines

  variable imageScale

  # cross are not symmetric without the "+1"
  set u1 [expr $u-$size+1] 
  set u2 [expr $u+$size]
  set v1 [expr $v-$size+1]
  set v2 [expr $v+$size]
  if {$imageScale($img) == 1.0} {
      set id1 [.$img.$img create line $u $v1 $u $v2 \
       -fill $color -width $width -tags $tag]
      set id2 [.$img.$img create line $u1 $v $u2 $v \
       -fill $color -width $width -tags $tag]
  } else {
      set s $imageScale($img)
      set id1 [.$img.$img create line [expr $s * $u] [expr $s * $v1] [expr $s * $u] [expr $s * $v2] \
       -fill $color -width $width -tags $tag]
      set id2 [.$img.$img create line [expr $s * $u1] [expr $s * $v] [expr $s * $u2] [expr $s * $v] \
       -fill $color -width $width -tags $tag]
  }
  return "$id1 $id2"
    }

    proc drawInfiniteLine {img rho theta
         {width 1}
         {color red}
         {tag "jafar"} } {
  # draws a infiny line (ie across the image) with parameter (rho, theta)
  # return the tk id of the line

  variable imageScale

  # closest point to the origin
  set u0 [expr $rho * cos($theta)]
  set v0 [expr $rho * sin($theta)]
  # direction of the line
  set du [expr -sin($theta)]
  set dv [expr cos($theta)]

  # distance for infiny line
  set inf [expr [$img width] + [$img height]]
  # extremities
  set u1 [expr $u0+$inf*$du]
  set v1 [expr $v0+$inf*$dv]
  set u2 [expr $u0-$inf*$du]
  set v2 [expr $v0-$inf*$dv]

  if {$imageScale($img) == 1} {
      return [display::drawLine $img $u1 $v1 $u2 $v2 $width $color $tag]
  } else {
      set s $imageScale($img)
      return [display::drawLine $img [expr $s * $u1] [expr $s * $v1] [expr $s * $u2] [expr $s * $v2] $width $color $tag]
  }
    }

    proc drawSquare {img u v
         {size 3}
         {width 1}
         {color red}
         {tag "jafar"} } {
  # draws a square on img around pixel (u,v)
  # return the tk id of the rectangle

  variable imageScale

  set u1 [expr $u-$size]
  set u2 [expr $u+$size]
  set v1 [expr $v-$size]
  set v2 [expr $v+$size]
  if {$imageScale($img) == 1} {
      return [.$img.$img create rectangle $u1 $v1 $u2 $v2 \
      -width $width -outline $color -tags $tag]
  } else {
      set s $imageScale($img)
      return [.$img.$img create rectangle [expr $s * $u1] [expr $s * $v1] [expr $s * $u2] [expr $s * $v2] \
      -width $width -outline $color -tags $tag]
  }
    }

    proc drawRectangle {img u1 v1 u2 v2
      {width 1}
      {color red}
      {tag "jafar"} } {
  # draws a rectangle from (u0,v0) to (u1,v1)
  # return the tk id of the rectangle

  variable imageScale

  if {$imageScale($img) == 1} {
      return [.$img.$img create rectangle $u1 $v1 $u2 $v2 \
      -width $width -outline $color -tags $tag]
  } else {
      set s $imageScale($img)
      return [.$img.$img create rectangle [expr $s * $u1] [expr $s * $v1] [expr $s * $u2] [expr $s * $v2] \
      -width $width -outline $color -tags $tag]
  }
    }

    proc drawOrientedRectangle {img u v w h angle 
        {width 1}
        {color red}
        {tag "jafar"}} {
  # draws an oriented rectangle centered on (u,v) using a polygon
  # angle is the angle between the horizontal axis and the length (in rad)
  # return the tk id of the polygoon

  variable imageScale

  set cf1 [expr cos($angle) * 0.5]
  set cf2 [expr sin($angle) * 0.5]
  
  set x1 [expr $u - $cf1 * $h - $cf2 * $w]
  set y1 [expr $v + $cf2 * $h - $cf1 * $w]
  set x2 [expr $u + $cf1 * $h - $cf2 * $w]
  set y2 [expr $v - $cf2 * $h - $cf1 * $w]
  set x3 [expr 2 * $u - $x1]
  set y3 [expr 2 * $v - $y1]
  set x4 [expr 2 * $u - $x2]
  set y4 [expr 2 * $v - $y2]

  if {$imageScale($img) == 1} {
      return [.$img.$img create polygon $x1 $y1 $x2 $y2 $x3 $y3 $x4 $y4 \
      -width $width -outline $color -tags $tag -fill ""]
  } else {
      set s $imageScale($img)
      return [.$img.$img create polygon [expr $s * $x1] [expr $s * $y1] [expr $s * $x2] [expr $s * $y2] \
      [expr $s * $x3] [expr $s * $y3] [expr $s * $x4] [expr $s * $y4] \
      -width $width -outline $color -tags $tag -fill ""]
  }
    }

    proc drawEllipse {img u v uCov vCov uvCov
          {nSigma 3}
          {nbPoints 20}
          {width 1}
          {color red}
          {tag "jafar"} } {
  # draws the nSigma ellipse at mean x with covariance xCov
  # ellipse shape is approximated with a nbPoints polygon
  # return the tk id of the polygon 

  variable imageScale

  set points [display::ellipseToPolygone $u $v $uCov $vCov $uvCov $nSigma $nbPoints $imageScale($img)]
  
  return [.$img.$img create polygon $points \
        -width $width -outline $color -tags $tag -fill ""]
    }

  proc drawCircle {img u v
         {radius 3}
         {width 1}
         {color red}
         {tag "jafar"} } {
  # draws a circle on img around pixel (u,v)
  # return the tk id of the rectangle

  variable imageScale

  set u1 [expr $u-$radius]
  set u2 [expr $u+$radius]
  set v1 [expr $v-$radius]
  set v2 [expr $v+$radius]
  if {$imageScale($img) == 1} {
      return [.$img.$img create oval $u1 $v1 $u2 $v2 \
      -width $width -outline $color -tags $tag]
  } else {
      set s $imageScale($img)
      return [.$img.$img create oval [expr $s * $u1] [expr $s * $v1] [expr $s * $u2] [expr $s * $v2] \
      -width $width -outline $color -tags $tag]
  }
    } 

    proc drawText {img u v text
       {color red}
       {anchor "c"}
       {tag "jafar"} } {
  # add text on img at (u,v)
  # return the tk id of the text

  variable imageScale
  if {$imageScale($img) == 1} {
      return [.$img.$img create text $u $v -text $text \
      -anchor $anchor -fill $color -tags $tag]
  } else {
      set s $imageScale($img)
      return [.$img.$img create text [expr $s * $u] [expr $s * $v] -text $text \
      -anchor $anchor -fill $color -tags $tag]
  }
    }

    proc clearOverlay {img
           {tag "jafar"} } {
  # delete object draws on img with tag
  .$img.$img delete -tag $tag
    }

}

package provide display 1.0