From 0c518c95e4d1c3270fbc67143a6351ee81bb68f0 Mon Sep 17 00:00:00 2001 From: lecoanet Date: Fri, 7 May 2004 10:51:56 +0000 Subject: Switched from pack to grid; Demos are put in a namespace --- demos/clipping.tcl | 165 +++++++++++++++++++++++++++-------------------------- 1 file changed, 85 insertions(+), 80 deletions(-) (limited to 'demos/clipping.tcl') diff --git a/demos/clipping.tcl b/demos/clipping.tcl index 435a581..e7346fa 100644 --- a/demos/clipping.tcl +++ b/demos/clipping.tcl @@ -5,114 +5,119 @@ if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } -set w .clipping -catch {destroy $w} -toplevel $w -wm title $w "Zinc Clipping Demonstration" -wm iconname $w "Clipping" +namespace eval clippingDemo { + variable w .clipping + catch {destroy $w} + toplevel $w + wm title $w "Zinc Clipping Demonstration" + wm iconname $w "Clipping" -set defaultfont [font create -family Helvetica -size 10 -weight bold] + variable defaultfont [font create -family Helvetica -size 10 -weight bold] -frame $w.buttons -pack $w.buttons -side bottom -fill x -pady 2m -button $w.buttons.dismiss -text Dismiss -command "destroy $w" -button $w.buttons.code -text "See Code" -command "showCode $w" -pack $w.buttons.dismiss $w.buttons.code -side left -expand 1 + grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 2 -column 0 -pady 10 + grid [button $w.code -text "See Code" -command "showCode $w"] -row 2 -column 1 -pady 10 + grid [zinc $w.zinc -width 700 -height 600 -font 10x20 -borderwidth 3 \ + -relief sunken] -row 0 -column 0 -columnspan 2 -sticky news + grid columnconfigure $w 0 -weight 1 + grid columnconfigure $w 1 -weight 1 + grid rowconfigure $w 0 -weight 2 -zinc $w.zinc -width 700 -height 600 -font 10x20 -borderwidth 3 -relief sunken -pack $w.zinc + variable displayClippingItemBackground 0 + variable clip 1 -set display_clipping_item_background 0 -set clip 1 + $w.zinc add text 1 -font $defaultfont -text "You can drag and drop the objects.\nThere are two groups of objects a tan group and a blue group\nTry to move them and discover the clipping area which is a curve.\nwith two contours" -anchor nw -position {10 10} -$w.zinc add text 1 -font $defaultfont -text "You can drag and drop the objects.\nThere are two groups of objects a tan group and a blue group\nTry to move them and discover the clipping area which is a curve.\nwith two contours" -anchor nw -position {10 10} + variable clippedGroup [$w.zinc add group 1 -visible 1] -set clipped_group [$w.zinc add group 1 -visible 1] + variable clippingItem [$w.zinc add curve $clippedGroup {10 100 690 100 690 590 520 350 350 590 180 350 10 590} -closed 1 -priority 1 -fillcolor tan2 -linewidth 0 -filled $displayClippingItemBackground] + $w.zinc contour $clippingItem add +1 {200 200 500 200 500 250 200 250} -set clipping_item [$w.zinc add curve $clipped_group {10 100 690 100 690 590 520 350 350 590 180 350 10 590} -closed 1 -priority 1 -fillcolor tan2 -linewidth 0 -filled $display_clipping_item_background] -$w.zinc contour $clipping_item add +1 {200 200 500 200 500 250 200 250} + ############### creating the tanGroup objects ################ + # the tanGroup is atomic that is is makes all children as a single object + # and sensitive to tanGroup callbacks + variable tanGroup [$w.zinc add group $clippedGroup -visible 1 -atomic 1 -sensitive 1] + -############### creating the tan_group objects ################ -# the tan_group is atomic that is is makes all children as a single object -# and sensitive to tan_group callbacks -set tan_group [$w.zinc add group $clipped_group -visible 1 -atomic 1 -sensitive 1] - + $w.zinc add arc $tanGroup {200 220 280 300} -filled 1 -linewidth 1 -startangle 45 -extent 270 -pieslice 1 -closed 1 -fillcolor tan + -$w.zinc add arc $tan_group {200 220 280 300} -filled 1 -linewidth 1 -startangle 45 -extent 270 -pieslice 1 -closed 1 -fillcolor tan - + $w.zinc add curve $tanGroup {400 400 440 450 400 500 500 500 460 450 500 400} -filled 1 -fillcolor tan -linecolor tan + -$w.zinc add curve $tan_group {400 400 440 450 400 500 500 500 460 450 500 400} -filled 1 -fillcolor tan -linecolor tan - + ############### creating the blueGroup objects ################ + # the blueGroup is atomic too that is is makes all children as a single object + # and sensitive to blueGroup callbacks + variable blueGroup [$w.zinc add group $clippedGroup -visible 1 -atomic 1 -sensitive 1] -############### creating the blue_group objects ################ -# the blue_group is atomic too that is is makes all children as a single object -# and sensitive to blue_group callbacks -set blue_group [$w.zinc add group $clipped_group -visible 1 -atomic 1 -sensitive 1] + $w.zinc add rectangle $blueGroup {570 180 470 280} -filled 1 -linewidth 1 -fillcolor blue2 -$w.zinc add rectangle $blue_group {570 180 470 280} -filled 1 -linewidth 1 -fillcolor blue2 + $w.zinc add curve $blueGroup {200 400 200 500 300 500 300 400 300 300} -filled 1 -fillcolor blue -linewidth 0 -$w.zinc add curve $blue_group {200 400 200 500 300 500 300 400 300 300} -filled 1 -fillcolor blue -linewidth 0 + $w.zinc itemconfigure $clippedGroup -clip $clippingItem -$w.zinc itemconfigure $clipped_group -clip $clipping_item + ###################### drag and drop callbacks ############ + # for both tanGroup and blueGroup -###################### drag and drop callbacks ############ -# for both tan_group and blue_group + $w.zinc bind $tanGroup <1> "::clippingDemo::itemStartDrag $tanGroup %x %y" + $w.zinc bind $tanGroup "::clippingDemo::itemDrag $tanGroup %x %y" + $w.zinc bind $blueGroup <1> "::clippingDemo::itemStartDrag $blueGroup %x %y" + $w.zinc bind $blueGroup "::clippingDemo::itemDrag $blueGroup %x %y" -$w.zinc bind $tan_group <1> "itemStartDrag $tan_group %x %y" -$w.zinc bind $tan_group "itemDrag $tan_group %x %y" -$w.zinc bind $blue_group <1> "itemStartDrag $blue_group %x %y" -$w.zinc bind $blue_group "itemDrag $blue_group %x %y" + # callback for starting a drag + variable xOrig "" + variable yOrig "" -# callback for starting a drag -set x_orig "" -set y_orig "" - -proc itemStartDrag {item x y} { - global x_orig y_orig - set x_orig $x - set y_orig $y -} - -# Callback for moving an item -proc itemDrag {item x y} { - global x_orig y_orig - global w - $w.zinc translate $item [expr $x-$x_orig] [expr $y-$y_orig]; - set x_orig $x; - set y_orig $y; -} + proc itemStartDrag {item x y} { + variable xOrig + variable yOrig + set xOrig $x + set yOrig $y + } + # Callback for moving an item + proc itemDrag {item x y} { + variable xOrig + variable yOrig + variable w + $w.zinc translate $item [expr $x-$xOrig] [expr $y-$yOrig]; + set xOrig $x; + set yOrig $y; + } -###################### toggle buttons at the bottom ####### -frame $w.row -pack $w.row -checkbutton $w.row.show -text "Show clipping item" -variable display_clipping_item_background -command "display_clipping_area" -checkbutton $w.row.clip -text Clip -variable clip -command "clipcommand " -pack $w.row.show $w.row.clip -proc display_clipping_area {} { - global clipping_item - global w - global display_clipping_item_background - $w.zinc itemconfigure $clipping_item -filled $display_clipping_item_background -} + ###################### toggle buttons at the bottom ####### + grid [frame $w.row] -row 1 -column 0 -columnspan 2 + checkbutton $w.row.show -text "Show clipping item" \ + -variable ::clippingDemo::displayClippingItemBackground \ + -command "::clippingDemo::displayClippingArea" + checkbutton $w.row.clip -text Clip -variable ::clippingDemo::clip \ + -command "::clippingDemo::clipCommand" + pack $w.row.show $w.row.clip -side left -proc clipcommand {} { - global clip - global clipped_group - global clipping_item - global w + proc displayClippingArea {} { + variable clippingItem + variable w + variable displayClippingItemBackground + $w.zinc itemconfigure $clippingItem -filled $displayClippingItemBackground + } - if {$clip} { - $w.zinc itemconfigure $clipped_group -clip $clipping_item - } else { - $w.zinc itemconfigure $clipped_group -clip "" + proc clipCommand {} { + variable clip + variable clippedGroup + variable clippingItem + variable w + + if {$clip} { + $w.zinc itemconfigure $clippedGroup -clip $clippingItem + } else { + $w.zinc itemconfigure $clippedGroup -clip "" + } } } -- cgit v1.1