diff options
Diffstat (limited to 'demos/atomicGroups.tcl')
| -rw-r--r-- | demos/atomicGroups.tcl | 184 |
1 files changed, 0 insertions, 184 deletions
diff --git a/demos/atomicGroups.tcl b/demos/atomicGroups.tcl deleted file mode 100644 index 2bf782b..0000000 --- a/demos/atomicGroups.tcl +++ /dev/null @@ -1,184 +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 atomicGroups { - variable w .atomicGroups - catch {destroy $w} - toplevel $w - wm title $w "Zinc Atomicity Demonstration" - wm iconname $w "Atomic" - - variable defaultfont [font create -family Helvetica -size 14 -weight normal] - - grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 6 -column 0 -pady 10 - grid [button $w.code -text "See Code" -command "showCode $w"] -row 6 -column 1 -pady 10 - - grid [zinc $w.zinc -width 500 -height 350 -font $defaultfont -borderwidth 0] \ - -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 groupsGroupAtomicity 0 - variable redGroupAtomicity 0 - variable greenGroupAtomicity 0 - - $w.zinc add "text" 1 -font $defaultfont -text "- There are 3 groups: a red group containing 2 redish objects\na green group containing 2 greenish objects,\nand groupsGroup containing both previous groups.\n- You can make some groups atomic or not by depressing \nthe toggle buttons at the bottom of the window\n- Try and then click on some items to observe that callbacks\n are then different: they modify either the item, or 2 items of\n a group or all items" -anchor "nw" -position "10 10" - - - ############### creating the top group with its bindings ############################### - variable groupsGroup [$w.zinc add group 1 -visible 1 -atomic $groupsGroupAtomicity -tags groupsGroup] - - # the following callbacks will be called only if "groupsGroup" IS atomic - $w.zinc bind $groupsGroup <1> ::atomicGroups::modifyBitmapBg - $w.zinc bind $groupsGroup <ButtonRelease-1> ::atomicGroups::modifyBitmapBg - - ############### creating the redGroup, with its binding and its content ################ - # the redGroup may be atomic, that is is makes all children as a single object - # and sensitive to redGroup callbacks - variable redGroup [$w.zinc add group $groupsGroup -visible 1 -atomic $redGroupAtomicity -sensitive 1 -tags redGroup] - - # the following callbacks will be called only if "groupsGroup" IS NOT-atomic - # and if "redGroup" IS atomic - $w.zinc bind $redGroup <1> "::atomicGroups::modifyItemLines $redGroup" - $w.zinc bind $redGroup <ButtonRelease-1> "::atomicGroups::modifyItemLines $redGroup" - - - variable rc [$w.zinc add arc $redGroup {100 200 140 240} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags redCircle] - variable rr [$w.zinc add rectangle $redGroup {300 200 400 250} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags redRectangle] - - # the following callbacks will be called only if "groupsGroup" IS NOT atomic - # and if "redGroup" IS NOT atomic - $w.zinc bind $rc <1> ::atomicGroups::toggleColor - $w.zinc bind $rc <ButtonRelease-1> ::atomicGroups::toggleColor - $w.zinc bind $rr <1> ::atomicGroups::toggleColor - $w.zinc bind $rr <ButtonRelease-1> ::atomicGroups::toggleColor - - ############### creating the greenGroup, with its binding and its content ################ - # the greenGroup may be atomic, that is is makes all children as a single object - # and sensitive to greenGroup callbacks - variable greenGroup [$w.zinc add group $groupsGroup -visible 1 -atomic $greenGroupAtomicity -sensitive 1 -tags greenGroup] - - # the following callbacks will be called only if "groupsGroup" IS NOT atomic - # and if "greenGroup" IS atomic - $w.zinc bind $greenGroup <1> "::atomicGroups::modifyItemLines $greenGroup" - $w.zinc bind $greenGroup <ButtonRelease-1> "::atomicGroups::modifyItemLines $greenGroup" - - variable gc [$w.zinc add arc $greenGroup {100 270 140 310} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags greenCircle] - - variable gr [$w.zinc add rectangle $greenGroup {300 270 400 320} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags greenRectangle] - # the following callbacks will be called only if "groupsGroup" IS NOT atomic - # and if "greenGroup" IS NOT atomic - $w.zinc bind $gc <1> ::atomicGroups::toggleColor - $w.zinc bind $gc <ButtonRelease-1> ::atomicGroups::toggleColor - $w.zinc bind $gr <1> ::atomicGroups::toggleColor - $w.zinc bind $gr <ButtonRelease-1> ::atomicGroups::toggleColor - - - variable currentBg "" - ###################### groupsGroup callback ############## - - proc modifyBitmapBg {} { - variable currentBg - variable rc - variable rr - variable gc - variable gr - variable w - if {$currentBg=="AlphaStipple2"} { - set currentBg {} - } else { - set currentBg AlphaStipple2 - } - foreach item "$rc $rr $gc $gr" { - $w.zinc itemconfigure $item -fillpattern $currentBg - } - } - - #################### red/greenGroup callback ############## - proc modifyItemLines {gr} { - variable w - - set children [$w.zinc find withtag ".$gr*"] - # we are using a pathtag (still undocumented feature of 3.2.6) to get items of an atomic group! - # we could also temporary modify the groups (make it un-atomic) to get its child - - set currentLineWidth [$w.zinc itemcget [lindex $children 0] -linewidth] - - if {$currentLineWidth == 3} { - set currentLineWidth 0 - } else { - set currentLineWidth 3 - } - foreach item $children { - $w.zinc itemconfigure $item -linewidth $currentLineWidth - } - - } - - - ##################### items callback ###################### - proc toggleColor {} { - variable w - set item [$w.zinc find withtag current] - set fillcolor [$w.zinc itemcget $item -fillcolor] - regexp {([a-z]+)(\d)} $fillcolor "" color num - - #my ($color $num) = $fillcolor =~ /("a-z"+)(\d)/ - if {$num == 2} { - set val 1 - set num 4 - } else { - set num 2 - } - $w.zinc itemconfigure $item -fillcolor "$color$num" - } - - proc atomicOrNot {gr} { - variable w - set val [lindex [$w.zinc itemconfigure $gr -atomic] 4] - if {$val==1} { - $w.zinc itemconfigure $gr -atomic 0 - } else { - $w.zinc itemconfigure $gr -atomic 1 - } - updateFoundItems - } - - - ###################### toggle buttons at the bottom #### - - grid [checkbutton $w.cb -text "groupsGroup is atomic" -variable ::atomicGroups::groupsGroupAtomicity \ - -command "::atomicGroups::atomicOrNot $groupsGroup"] -row 1 -column 0 -sticky w - grid [checkbutton $w.cb2 -text "red group is atomic" -foreground red4 \ - -variable ::atomicGroups::redGroupAtomicity \ - -command "::atomicGroups::atomicOrNot $redGroup"] -row 2 -column 0 -sticky w - grid [checkbutton $w.cb3 -text "green group is atomic" -foreground green4 \ - -variable ::atomicGroups::greenGroupAtomicity \ - -command "::atomicGroups::atomicOrNot $greenGroup"] -row 3 -column 0 -sticky w - - grid [label $w.lb2 -text "Following command '$w.zinc find overlapping 0 200 500 400', returns:"] \ - -row 4 -column 0 -columnspan 2 -pady 10 - grid [label $w.label -text ""] \ - -row 5 -column 0 -columnspan 2 - - - ##### to update the list of enclosed items - proc updateFoundItems {} { - variable w - set found [$w.zinc find overlapping 0 200 500 400] - set str "" - foreach item $found { - set tags [$w.zinc itemcget $item -tags] - set str "$str $tags" - } - $w.label configure -text $str - } - - # to init the list of enclosed items - updateFoundItems -} |