diff options
Diffstat (limited to 'demos/clipping.tcl')
| -rw-r--r-- | demos/clipping.tcl | 123 |
1 files changed, 0 insertions, 123 deletions
diff --git a/demos/clipping.tcl b/demos/clipping.tcl deleted file mode 100644 index 4d0fa28..0000000 --- a/demos/clipping.tcl +++ /dev/null @@ -1,123 +0,0 @@ -# these simple samples have been developped by C. Mertz mertz@cena.fr in perl -# tcl version by Jean-Paul Imbert imbert@cena.fr - -if {![info exists zincDemo]} { - error "This script should be run from the zinc-widget demo." -} - -namespace eval clippingDemo { - variable w .clipping - catch {destroy $w} - toplevel $w - wm title $w "Zinc Clipping Demonstration" - wm iconname $w "Clipping" - - variable defaultfont [font create -family Helvetica -size 14 -weight normal] - - 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 $defaultfont -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 - - variable displayClippingItemBackground 0 - variable 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} - - - variable clippedGroup [$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} - - ############### 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] - - - $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 curve $tanGroup {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] - - $w.zinc add rectangle $blueGroup {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 itemconfigure $clippedGroup -clip $clippingItem - - - ###################### drag and drop callbacks ############ - # for both tanGroup and blueGroup - - $w.zinc bind $tanGroup <1> "::clippingDemo::itemStartDrag $tanGroup %x %y" - $w.zinc bind $tanGroup <B1-Motion> "::clippingDemo::itemDrag $tanGroup %x %y" - $w.zinc bind $blueGroup <1> "::clippingDemo::itemStartDrag $blueGroup %x %y" - $w.zinc bind $blueGroup <B1-Motion> "::clippingDemo::itemDrag $blueGroup %x %y" - - - - # callback for starting a drag - variable xOrig "" - variable yOrig "" - - 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 ####### - 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 displayClippingArea {} { - variable clippingItem - variable w - variable displayClippingItemBackground - $w.zinc itemconfigure $clippingItem -filled $displayClippingItemBackground - } - - proc clipCommand {} { - variable clip - variable clippedGroup - variable clippingItem - variable w - - if {$clip} { - $w.zinc itemconfigure $clippedGroup -clip $clippingItem - } else { - $w.zinc itemconfigure $clippedGroup -clip "" - } - } -} |