Rectangle, circle (oval) AND TEXT annotations are configured using single proc.

(a major code cleanup will follow)

Bug found by:
Submitted by:
Reviewed by:
Approved by:
Obtained from:

diff --git a/annotations.tcl b/annotations.tcl
index c12bb58e2fdefd59a78efb9ddce7fd64c839cfd8..0be38ad322f0d8edabb3da75bd0c6857c8f3b256 100644 (file)
--- a/annotations.tcl
+++ b/annotations.tcl
@@ -25,11 +25,10 @@ proc annotationConfig { c target } {
            popupAnnotationDialog $c $target "true"
        }
        rectangle {
-           # popupRectDialog $c $target "true"
            popupAnnotationDialog $c $target "true"
        }
        text {
-           textConfig $c $target 
+           popupAnnotationDialog $c $target "true"
        }
        default {
            puts "Unknown type [nodeType $target] for target $target"
@@ -309,10 +308,9 @@ proc drawRect {rectangle} {
 
 
 proc popupAnnotationDialog { c target modify } {
-    global newrect newoval defFillColor
-    global $target
-    global width rad
-    global fontfamily fontsize defTextFontFamily defTextFontSize
+    global $target newrect newoval 
+    global width rad fontfamily fontsize
+    global defFillColor defTextColor defTextFontFamily defTextFontSize
 
     # do nothing, return, if coords are empty
     if { $target == 0 \
@@ -320,7 +318,6 @@ proc popupAnnotationDialog { c target modify } {
            && [$c coords "$newoval"] == "" } {
        return
     }
-
     if { $target == 0 } {
        set width 1
        set rad 25
@@ -350,7 +347,7 @@ proc popupAnnotationDialog { c target modify } {
        set label [lindex [lsearch -inline [set $target] "label *"] 1]
        set lcolor [lindex [lsearch -inline [set $target] "labelcolor *"] 1]
        set bordercolor [lindex [lsearch -inline [set $target] "border *"] 1]
-       set annotationType [lindex [lsearch -inline [set $target] "type *"] 1]
+       set annotationType [nodeType $target]
     }
 
     if { $color == "" } { set color $defFillColor }
@@ -446,20 +443,6 @@ proc popupAnnotationDialog { c target modify } {
     fontupdate $wi.text.lab.name fontfamily $fontfamily
     fontupdate $wi.text.lab.name fontsize $fontsize
 
-    # fill color, border color
-    frame $wi.colors -relief groove -bd 2
-    # color selection controls
-    label $wi.colors.label -text "Fill color:"
-
-    label $wi.colors.color -text $color -width 8 \
-       -bg $color -fg $lcolor
-    button $wi.colors.bg -text "Color" -command \
-       "popupColor bg $wi.colors.color true"
-    pack $wi.colors.label $wi.colors.color $wi.colors.bg \
-       -side left -padx 2 -pady 2 -anchor w -fill x
-    pack $wi.colors -side top -fill x
-
-
     $fontmenu delete 0
     foreach f [lsort -dictionary [font families]] {
        $fontmenu add radiobutton -value "$f" -label $f \
@@ -474,6 +457,21 @@ proc popupAnnotationDialog { c target modify } {
            -command [list fontupdate $wi.text.lab.name fontsize $f]
     }
  
+if { "$annotationType" == "rectangle" || "$annotationType" == "oval" } {
+
+    # fill color, border color
+    frame $wi.colors -relief groove -bd 2
+    # color selection controls
+    label $wi.colors.label -text "Fill color:"
+
+    label $wi.colors.color -text $color -width 8 \
+       -bg $color -fg $lcolor
+    button $wi.colors.bg -text "Color" -command \
+       "popupColor bg $wi.colors.color true"
+    pack $wi.colors.label $wi.colors.color $wi.colors.bg \
+       -side left -padx 2 -pady 2 -anchor w -fill x
+    pack $wi.colors -side top -fill x
+
     # border selection controls
     frame $wi.border -relief groove -bd 2
     label $wi.border.label -text "Border color:"
@@ -494,6 +492,8 @@ proc popupAnnotationDialog { c target modify } {
        -side left -padx 2 -pady 2 -anchor w -fill x
     pack $wi.border -side top -fill x
 
+}
+
 if { $annotationType == "rectangle" } {
     frame $wi.radius -relief groove -bd 2
     scale $wi.radius.rad -from 0 -to [expr int($maxrad)] \
@@ -514,11 +514,11 @@ if { $annotationType == "rectangle" } {
     }
     
     frame $wi.butt -borderwidth 6
-    button $wi.butt.apply -text $applytext -command "popupAnnotationApply $c $wi $target"
+    button $wi.butt.apply -text $applytext -command "popupAnnotationApply $c $wi $target $annotationType"
 
     button $wi.butt.cancel -text "Cancel" -command $cancelcmd
     bind $wi <Key-Escape> "$cancelcmd" 
-    bind $wi <Key-Return> "popupAnnotationApply $c $wi $target"
+    bind $wi <Key-Return> "popupAnnotationApply $c $wi $target $annotationType"
     pack $wi.butt.cancel $wi.butt.apply -side right
     pack $wi.butt -side bottom
 
@@ -536,7 +536,7 @@ proc destroyNewRect { c } {
 }
 
 
-proc popupAnnotationApply { c wi target } {
+proc popupAnnotationApply { c wi target type } {
     global newrect newoval annotation_list
     global $target
     global changed
@@ -545,34 +545,38 @@ proc popupAnnotationApply { c wi target } {
 
     # attributes
     set caption [string trim [$wi.text.lab.name get]]
-    set color [$wi.colors.color cget -text]
     set labelcolor [$wi.text.lab.name cget -fg]
-    set bordercolor [$wi.border.color cget -text]
     set coords [$c coords "$target"]
     set iconcoords "iconcoords"
 
+    if {"$type" == "rectangle" || "$type" == "oval" } {
+       set color [$wi.colors.color cget -text]
+       set bordercolor [$wi.border.color cget -text]
+    }
+
     if { $target == 0 } {
        # Create a new annotation object
        set target [newObjectId annotation]
        global $target
        lappend annotation_list $target
-       set coords [$c coords $newrect]
-       if { "$coords" == "" } {
+       if {"$type" == "rectangle" } {
+           set coords [$c coords $newrect]
+        } elseif { "$type" == "oval" } {
            set coords [$c coords $newoval]
-           set annotationType "oval"
-       } else {
-           set annotationType "rectangle"
        }
     } else {
        set coords [getNodeCoords $target]
-       set annotationType [lindex [lsearch -inline [set $target] "type *"] 1]
     }
     set $target {}
     lappend $iconcoords $coords
-    lappend $target $iconcoords "color $color" \
-       "label {$caption}" "labelcolor $labelcolor" \
-       "fontfamily {$fontfamily}" "fontsize $fontsize" \
-       "width $width" "border $bordercolor" "rad $rad"
+    lappend $target $iconcoords "label {$caption}" "labelcolor $labelcolor" \
+       "fontfamily {$fontfamily}" "fontsize $fontsize"
+    if {"$type" == "rectangle" || "$type" == "oval" } {
+       lappend $target "color $color" "width $width" "border $bordercolor" 
+    }
+    if {"$type" == "rectangle" } {
+       lappend $target "rad $rad"
+    }
 
     set ef {}
     if {"$textBold" == 1}   { lappend ef bold} 
@@ -581,12 +585,14 @@ proc popupAnnotationApply { c wi target } {
     if {"$ef" != ""} { lappend $target "effects {$ef}"}
 
     # draw it
-    if { $annotationType == "rectangle" } {
+    if { $type == "rectangle" } {
         drawRect $target
         destroyNewRect $c
-    } elseif { $annotationType == "oval" } {
+    } elseif { $type == "oval" } {
         drawOval $target
         destroyNewoval $c
+    } elseif { $type == "text" } {
+        drawText $target
     }
 
     set changed 1
@@ -730,7 +736,7 @@ proc textEnter { c x y } {
     setNodeCanvas $object $curcanvas
 
     lappend annotation_list $object
-    textConfig $c $object 
+    popupAnnotationDialog $c $object "false"
 }
 
 
@@ -745,7 +751,7 @@ proc drawText {text} {
     }
     set x [expr {[lindex $coords 0] * $zoom}]
     set y [expr {[lindex $coords 1] * $zoom}]
-    set color [lindex [lsearch -inline [set $text] "color *"] 1]
+    set color [lindex [lsearch -inline [set $text] "labelcolor *"] 1]
     if { $color == "" } {
        set color $defTextColor
     }
@@ -771,115 +777,6 @@ proc drawText {text} {
 }
 
 
-proc textConfig { c target } {
-    global $target defTextColor defTextFont defTextFontFamily defTextFontSize
-    global fontfamily fontsize
-
-    set color [lindex [lsearch -inline [set $target] "color *"] 1]
-    set label [lindex [lsearch -inline [set $target] "label *"] 1]
-    set fontfamily [lindex [lsearch -inline [set $target] "fontfamily *"] 1]
-    set fontsize [lindex [lsearch -inline [set $target] "fontsize *"] 1]
-    set font [list "$fontfamily" $fontsize]
-
-    set textBold 0
-    set textItalic 0
-    set textUnderline 0
-    set effects [lindex [lsearch -inline [set $target] "effects *"] 1]
-    if { [lsearch $effects bold ] != -1} {set textBold 1}
-    if { [lsearch $effects italic ] != -1} {set textItalic 1}
-    if { [lsearch $effects underline ] != -1} {set textUnderline 1}
-
-    if { $fontfamily == "" } { set fontfamily $defTextFontFamily }
-    if { $fontsize == "" } { set fontsize $defTextFontSize }
-
-    set wi .popup
-    catch {destroy $wi}
-    toplevel $wi
-
-    wm transient $wi .
-    wm resizable $wi 1 1
-    wm title $wi "Configure text"
-
-    entry $wi.text -background white
-    frame $wi.prop 
-    frame $wi.action
-    pack $wi.text $wi.prop -anchor nw -side top  -fill x
-    pack $wi.action -side top 
-
-    frame $wi.prop.font -relief groove -bd 2
-    label $wi.prop.font.label -text "Font:"
-    set fontmenu [tk_optionMenu $wi.prop.font.menu fontfamily "$fontfamily"]
-    set sizemenu [tk_optionMenu $wi.prop.font.size fontsize "$fontsize"]
-
-    pack $wi.prop.font.label $wi.prop.font.menu \
-       $wi.prop.font.size -side left -pady 2
-
-    frame $wi.prop.format -relief groove -bd 2
-    label $wi.prop.format.label -text "Effects:"
-    pack $wi.prop.font $wi.prop.format -side top -pady 2 -anchor w -fill x
-
-    # color selection 
-    if { $color == "" } {
-       set color $defTextColor
-    }
-    button $wi.prop.format.fg -text "Color" -command \
-       "popupColor fg $wi.text false"
-    checkbutton $wi.prop.format.bold -text "Bold" -variable textBold \
-       -command [list fontupdate $wi.text bold]
-    checkbutton $wi.prop.format.italic -text "Italic" -variable textItalic \
-       -command [list fontupdate $wi.text italic]
-    checkbutton $wi.prop.format.underline -text "Underline" \
-       -variable textUnderline \
-       -command [list fontupdate $wi.text underline]
-
-    if {$textBold == 1} {      $wi.prop.format.bold select
-    } else {                   $wi.prop.format.bold deselect }
-    if {$textItalic == 1} {    $wi.prop.format.italic select
-    } else {                   $wi.prop.format.italic deselect }
-    if {$textUnderline == 1} { $wi.prop.format.underline select
-    } else {                   $wi.prop.format.underline deselect }
-
-    pack $wi.prop.format.label \
-        $wi.prop.format.fg \
-        $wi.prop.format.bold \
-        $wi.prop.format.italic \
-        $wi.prop.format.underline \
-        -side left -pady 2 ;# -fill both
-
-    $wi.text insert end $label
-    $wi.text configure -font [list "$fontfamily" $fontsize $effects] -fg $color
-
-    $fontmenu delete 0
-    foreach f [lsort -dictionary [font families]] {
-       $fontmenu add radiobutton -value "$f" -label $f \
-           -variable fontfamily \
-           -command [list fontupdate $wi.text fontfamily $f]
-    }
- 
-    $sizemenu delete 0
-    foreach f {8 9 10 11 12 14 16 18 20 22 24 26 28 36 48 72} {
-       $sizemenu add radiobutton -value "$f" -label $f \
-           -variable fontsize \
-           -command [list fontupdate $wi.text fontsize $f]
-    }
- 
-    set applycmd "textConfigApply $c $wi $target "
-    set cancelcmd "destroy $wi"
-
-    button $wi.action.apply -text "Apply" -command "$applycmd"
-    button $wi.action.cancel -text "Cancel" -command "$cancelcmd"
-    bind $wi <Key-Escape> "$cancelcmd" 
-    bind $wi <Key-Return> "$applycmd"
-
-    pack $wi.action.apply $wi.action.cancel -side left ;# -fill x
-
-    after 100 {
-       focus .popup.text
-       grab .popup
-    }
-    return
-}
-
 proc fontupdate { label type args} {
     global fontfamily fontsize
     global textBold textItalic textUnderline
@@ -901,49 +798,6 @@ proc fontupdate { label type args} {
 }
 
 
-proc textConfigApply { c wi target } {
-    global annotation_list
-    global $target
-    global fontfamily fontsize textBold textItalic textUnderline
-    global changed
-
-    # new text attributes
-    set caption [string trim [$wi.text get]]
-    # set color [$wi.prop.format.fg cget -fg]
-    set color [$wi.text cget -fg]
-    set iconcoords "iconcoords"
-
-    # build the oval object
-    if { $target == 0 } {
-       # XXX what is the purpose of this? --> leftover from copy/paste
-       xxx xxx xxx
-       set target [newObjectId "target"]
-       global $target
-       lappend annotation_list $target
-       set coords [$c coords $newtext]
-    } else {
-       set coords [getNodeCoords $target]
-    }
-       
-    set $target {}
-    lappend $iconcoords $coords
-    lappend $target $iconcoords "color $color" "label {$caption}"\
-       "fontfamily {$fontfamily}" "fontsize $fontsize"
-    set ef {}
-    if {"$textBold" == 1} { lappend ef bold } 
-    if {"$textItalic" == 1} { lappend ef italic } 
-    if {"$textUnderline" == 1} { lappend ef underline } 
-    if {"$ef" != ""} { lappend $target "effects {$ef}" }
-
-    # draw it
-    drawText $target
-    set changed 1
-    updateUndoLog
-    redrawAll
-
-    destroy $wi 
-}
-
 # from Practical Programming in Tcl and Tk, page 190
 proc Call_Trace {{file stdout}} {
     puts $file "*** Tcl Call Trace:"

diff --git a/editor.tcl b/editor.tcl
index 5aeffc0d3dd3b08adbecd4ebdde8d1767391e9d8..61341d84527bfe9bc9a69a2722184120a81c3100 100755 (executable)
--- a/editor.tcl
+++ b/editor.tcl
@@ -1,4 +1,4 @@
-# $Id: editor.tcl,v 1.62.2.9 2007/07/20 15:15:37 miljenko Exp $ 
+# $Id: editor.tcl,v 1.62.2.10 2007/07/20 17:08:39 miljenko Exp $ 
 #
 # Copyright 2004, 2005 University of Zagreb, Croatia.  All rights reserved.
 #
@@ -2311,7 +2311,7 @@ proc popupConfigDialog { c } {
     }
     text {
        destroy $wi
-       textConfig $c $target
+       annotationConfig $c $target
        return
     }
     link {