aboutsummaryrefslogtreecommitdiff
path: root/demos/groupsPriority.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'demos/groupsPriority.tcl')
-rw-r--r--demos/groupsPriority.tcl233
1 files changed, 233 insertions, 0 deletions
diff --git a/demos/groupsPriority.tcl b/demos/groupsPriority.tcl
new file mode 100644
index 0000000..eaef4c8
--- /dev/null
+++ b/demos/groupsPriority.tcl
@@ -0,0 +1,233 @@
+# 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."
+}
+
+
+set w .groups_priority
+catch {destroy $w}
+toplevel $w
+wm title $w "Zinc Groups priority Demonstration"
+wm iconname $w Groups
+
+set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
+
+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
+
+
+###########################################
+# Text zone
+###########################################
+
+text $w.text -relief sunken -borderwidth 2 -height 12
+pack $w.text -expand yes -fill both
+
+$w.text insert end "There are two groups (a red one and a green one) each containing\n4 rectangles. Those rectangles display their current priority.\nThe following operations are possible:\n Mouse Button 1 for dragging objects.\n Mouse Button 2 for dragging a colored group.\n Key + on a rectangle to raise it inside its group.\n Key - on a rectangle to lower it inside its group.\n Key l on a rectangle to lower its colored group.\n Key r on a rectangle to raise its colored group.\n Key t on a rectangle to change its group (but not its color!).\n Key 0-9 on a rectangle to set the priority to 0-9\nRaising or lowering an item inside a group modify its priority if necessary"
+
+###########################################
+# Zinc
+###########################################
+set zinc_width 600
+set zinc_height 500
+zinc $w.zinc -width $zinc_width -height $zinc_height -font 10x20 -borderwidth 3 -relief sunken
+pack $w.zinc
+
+#########################################################################"
+# Creating the redish group
+set group1 [$w.zinc add group 1 -visible 1]
+
+set counter 0
+# Adding 4 rectangles with text to redish group
+foreach data { {200 100 red} {210 210 red1} {390 110 red2} {395 215 red3} } {
+ set counter [expr $counter+ 2]
+ set centerx [lindex $data 0]
+ set centery [lindex $data 1]
+ set color [lindex $data 2]
+
+ # this small group is for merging together :
+ # the rectangle and the text showing its name
+ set g [$w.zinc add group $group1 -visible 1 -atomic 1 -sensitive 1 -priority $counter]
+ set rec [$w.zinc add rectangle $g "[expr $centerx-100] [expr $centery-60] [expr $centerx+100] [expr $centery+60]" -fillcolor $color -filled 1]
+
+ set txt [$w.zinc add "text" $g -position "$centerx $centery" -text "pri=$counter" -anchor center]
+
+ # Some bindings for dragging the rectangle or the full group
+ $w.zinc bind $g <1> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B1-Motion> "itemDrag $g %x %y"
+ $w.zinc bind $g <2> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B2-Motion> "groupDrag $g %x %y"
+}
+
+#########################################################################"
+# Creating the greenish group
+set group2 [$w.zinc add group 1 -visible 1]
+set counter 0
+
+# Adding 4 rectangles with text to greenish group
+foreach data {{200 300 green1} {210 410 green2} {390 310 green3} {395 415 green4}} {
+ incr counter
+ set centerx [lindex $data 0]
+ set centery [lindex $data 1]
+ set color [lindex $data 2]
+
+ # this small group is for merging together a rectangle
+ # and the text showing its priority
+ set g [$w.zinc add group $group2 -atomic 1 -sensitive 1 -priority $counter]
+
+ set rec [$w.zinc add rectangle $g "[expr $centerx-100] [expr $centery-60] [expr $centerx+100] [expr $centery+60]" -fillcolor $color -filled 1]
+
+ set txt [$w.zinc add text $g -position "$centerx $centery" -text "pri=$counter" -anchor center]
+
+ # Some bindings for dragging the rectangle or the full group
+ $w.zinc bind $g <1> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B1-Motion> "itemDrag $g %x %y"
+ $w.zinc bind $g <2> "itemStartDrag $g %x %y"
+ $w.zinc bind $g <B2-Motion> "groupDrag $g %x %y"
+}
+
+
+#########################################################################"
+# adding the key bindings
+
+# the focus on the widget is ABSOLUTELY necessary for key bindings!
+focus $w.zinc
+
+bind $w.zinc <KeyPress-r> raiseGroup
+bind $w.zinc <KeyPress-l> lowerGroup
+bind $w.zinc <KeyPress-plus> raise
+
+bind $w.zinc <KP_Add> raise
+bind $w.zinc <KeyPress-minus> lower
+bind $w.zinc <KP_Subtract> lower
+bind $w.zinc <KeyPress-t> toggleItemGroup
+
+for {set i 0} {$i<=9} {incr i} {
+ bind $w.zinc <KeyPress-$i> "setPriorrity $i"
+ bind $w.zinc <KeyPress-KP_$i> "setPriorrity $i"
+}
+
+# The following binding is currently not possible only text items
+# with focus can get a KeyPress or KeyRelease event
+# $zinc->bind($g '<KeyPress>' [\&raise $g]
+
+####################################withtype#####################################"
+# Definition of all callbacks
+
+
+proc updateLabel {group} {
+ global w
+ set priority [$w.zinc itemcget $group -priority]
+ # we get the text item from this group:
+ set textitem [$w.zinc find withtype text ".$group."]
+ $w.zinc itemconfigure $textitem -text "pri=$priority"
+}
+
+proc setPriorrity {priority} {
+ global w
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ $w.zinc itemconfigure $item -priority $priority
+ updateLabel $item
+}
+
+
+# Callback to lower a small group of a rectangle and a text
+proc lower {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ $w.zinc lower $item
+ updateLabel $item
+}
+
+
+# Callback to raise a small group of a rectangle and a text
+proc raise {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ $w.zinc raise $item
+ updateLabel $item
+}
+
+# Callback to raise the group of groups of a rectangle and a text
+proc lowerGroup {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ set coloredGroup [$w.zinc group $item]
+ $w.zinc lower $coloredGroup
+}
+
+# Callback to raise the group of groups of a rectangle and a text
+proc raiseGroup {} {
+ global w
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+ #return unless $item
+ set coloredGroup [$w.zinc group $item]
+ $w.zinc raise $coloredGroup
+ updateLabel $item
+}
+
+# Callback to change puts raise
+#the group of groups of a rectangle and a text
+proc toggleItemGroup {} {
+ global group1
+ global group2
+ global w
+
+ # to get the item under the cursor!
+ set item [$w.zinc find withtag current]
+
+ # return unless $item
+ set newgroup ""
+ if {$group1 == [$w.zinc group $item]} {
+ set newgroup $group2
+ } else {
+ set newgroup $group1
+ }
+ $w.zinc chggroup $item $newgroup 1
+ updateLabel $item
+}
+
+# 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;
+}
+
+# Callback for moving an item
+proc groupDrag {item x y} {
+ global x_orig y_orig
+ global w
+ set coloredGroup [$w.zinc group $item]
+ $w.zinc translate $coloredGroup [expr $x-$x_orig] [expr $y-$y_orig];
+ set x_orig $x;
+ set y_orig $y;
+}
+
+
+
generated by cgit v1.1 at 2024-07-01 11:28:13 +0000