From 3080cceb259221e197eb59b72f65b85c36774389 Mon Sep 17 00:00:00 2001 From: miljenko Date: Fri, 20 Jul 2007 17:08:39 +0000 Subject: [PATCH] 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: --- annotations.tcl | 240 ++++++++++-------------------------------------- editor.tcl | 4 +- 2 files changed, 49 insertions(+), 195 deletions(-) diff --git a/annotations.tcl b/annotations.tcl index c12bb58..0be38ad 100644 --- 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 "$cancelcmd" - bind $wi "popupAnnotationApply $c $wi $target" + bind $wi "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 "$cancelcmd" - bind $wi "$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 5aeffc0..61341d8 100755 --- 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 { -- 2.39.5