diff options
Diffstat (limited to 'demos/atomicGroups.tcl')
-rw-r--r-- | demos/atomicGroups.tcl | 333 |
1 files changed, 165 insertions, 168 deletions
diff --git a/demos/atomicGroups.tcl b/demos/atomicGroups.tcl index 0c3b8bb..a42593c 100644 --- a/demos/atomicGroups.tcl +++ b/demos/atomicGroups.tcl @@ -5,183 +5,180 @@ if {![info exists zincDemo]} { error "This script should be run from the zinc-widget demo." } - -set w .atomicGroups -catch {destroy $w} -toplevel $w -wm title $w "Zinc Atomicity Demonstration" -wm iconname $w "Atomic" - -set 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 - -zinc $w.zinc -width 500 -height 350 -font "10x20" -borderwidth 0 -pack $w.zinc - -set groups_group_atomicity 0 -set red_group_atomicity 0 -set green_group_atomicity 0 - -set display_clipping_item_background 0 -set clip 1 - -$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 groups_group 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 ############################### -set groups_group [$w.zinc add group 1 -visible 1 -atomic $groups_group_atomicity -tags groups_group] - -# the following callbacks will be called only if "groups_group" IS atomic -$w.zinc bind $groups_group <1> modify_bitmap_bg -$w.zinc bind $groups_group <ButtonRelease-1> modify_bitmap_bg - -############### creating the red_group, with its binding and its content ################ -# the red_group may be atomic, that is is makes all children as a single object -# and sensitive to red_group callbacks -set red_group [$w.zinc add group $groups_group -visible 1 -atomic $red_group_atomicity -sensitive 1 -tags red_group] - -# the following callbacks will be called only if "groups_group" IS NOT-atomic -# and if "red_group" IS atomic -$w.zinc bind $red_group <1> "modify_item_lines $red_group" -$w.zinc bind $red_group <ButtonRelease-1> "modify_item_lines $red_group" - - -set rc [$w.zinc add arc $red_group {100 200 140 240} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags red_circle] -set rr [$w.zinc add rectangle $red_group {300 200 400 250} -filled 1 -fillcolor red2 -linewidth 3 -linecolor white -tags red_rectangle] - -# the following callbacks will be called only if "groups_group" IS NOT atomic -# and if "red_group" IS NOT atomic -$w.zinc bind $rc <1> toggle_color -$w.zinc bind $rc <ButtonRelease-1> toggle_color -$w.zinc bind $rr <1> toggle_color -$w.zinc bind $rr <ButtonRelease-1> toggle_color - -############### creating the green_group, with its binding and its content ################ -# the green_group may be atomic, that is is makes all children as a single object -# and sensitive to green_group callbacks -set green_group [$w.zinc add group $groups_group -visible 1 -atomic $green_group_atomicity -sensitive 1 -tags green_group] - -# the following callbacks will be called only if "groups_group" IS NOT atomic -# and if "green_group" IS atomic -$w.zinc bind $green_group <1> "modify_item_lines $green_group" -$w.zinc bind $green_group <ButtonRelease-1> "modify_item_lines $green_group" - -set gc [$w.zinc add arc $green_group {100 270 140 310} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags green_circle] - -set gr [$w.zinc add rectangle $green_group {300 270 400 320} -filled 1 -fillcolor green2 -linewidth 3 -linecolor white -tags green_rectangle] -# the following callbacks will be called only if "groups_group" IS NOT atomic -# and if "green_group" IS NOT atomic -$w.zinc bind $gc <1> toggle_color -$w.zinc bind $gc <ButtonRelease-1> toggle_color -$w.zinc bind $gr <1> toggle_color -$w.zinc bind $gr <ButtonRelease-1> toggle_color - - - -set current_bg "" -###################### groups_group callback ############## - -proc modify_bitmap_bg {} { - global current_bg - global rc rr gc gr - global w - if {$current_bg=="AlphaStipple2"} { - set current_bg {} - } else { - set current_bg AlphaStipple2 - } - foreach item "$rc $rr $gc $gr" { - $w.zinc itemconfigure $item -fillpattern $current_bg +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 10 -weight bold] + + 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 10x20 -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/green_group callback ############## -proc modify_item_lines {gr} { - global 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 current_linewidth [$w.zinc itemcget [lindex $children 0] -linewidth] - if {$current_linewidth == 3} { - set current_linewidth 0 - } else { - set current_linewidth 3 - } - foreach item $children { - $w.zinc itemconfigure $item -linewidth $current_linewidth - } + #################### 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 toggle_color {} { - global 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 + ##################### 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" } - $w.zinc itemconfigure $item -fillcolor "$color$num" -} -proc atomic_or_not {gr} { - global 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 + 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 } - update_found_items -} - - -###################### toggle buttons at the bottom #### -frame $w.row -pack $w.row - -checkbutton $w.row.cb -text "groups_group is atomic" -variable groups_group_atomicity -command "atomic_or_not $groups_group" -pack $w.row.cb -anchor "w" -checkbutton $w.row.cb2 -text "red group is atomic" -foreground red4 -variable red_group_atomicity -command "atomic_or_not $red_group" -pack $w.row.cb2 -anchor w -checkbutton $w.row.cb3 -text "green group is atomic" -foreground green4 -variable green_group_atomicity -command "atomic_or_not $green_group" -pack $w.row.cb3 -anchor w - -label $w.row.lb -pack $w.row.lb -anchor w - -label $w.row.lb2 -text "Following command $w.zinc find overlapping 0 200 500 400 returns:" -pack $w.row.lb2 -anchor w -set label [pack [label $w.row.label -background gray95] -anchor w] - -##### to update the list of enclosed items -proc update_found_items {} { - global 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" + ###################### 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 } - $w.row.label configure -text $str -} -# to init the list of enclosed items -update_found_items + # to init the list of enclosed items + updateFoundItems +} |