diff options
author | cvs2svn | 2005-06-10 10:29:11 +0000 |
---|---|---|
committer | cvs2svn | 2005-06-10 10:29:11 +0000 |
commit | 960cdf29197bc3f5922110cf26627aa9709ac79b (patch) | |
tree | 7d6e4a472376b203d21826c2230b4a8c6a9024bd /Perl/demos/Tk/demos/zinc_lib/groups_priority.pl | |
parent | 3fc9c4bc1d6f70db41ad418992bf3d461059d3c0 (diff) | |
download | tkzinc-960cdf29197bc3f5922110cf26627aa9709ac79b.zip tkzinc-960cdf29197bc3f5922110cf26627aa9709ac79b.tar.gz tkzinc-960cdf29197bc3f5922110cf26627aa9709ac79b.tar.bz2 tkzinc-960cdf29197bc3f5922110cf26627aa9709ac79b.tar.xz |
This commit was manufactured by cvs2svn to create branch 'bogue40'.
Diffstat (limited to 'Perl/demos/Tk/demos/zinc_lib/groups_priority.pl')
-rw-r--r-- | Perl/demos/Tk/demos/zinc_lib/groups_priority.pl | 261 |
1 files changed, 0 insertions, 261 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/groups_priority.pl b/Perl/demos/Tk/demos/zinc_lib/groups_priority.pl deleted file mode 100644 index e7f872d..0000000 --- a/Perl/demos/Tk/demos/zinc_lib/groups_priority.pl +++ /dev/null @@ -1,261 +0,0 @@ -#!/usr/bin/perl -w -# $Id$ -# This simple demo has been developped by C. Mertz <mertz@cena.fr> - -package groups_priority; # for avoiding symbol sharing between different demos - -use vars qw( $VERSION ); -($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/); - -use Tk; -use Tk::Zinc; - -use strict; - -my $mw = MainWindow->new(); - -# The explanation displayed when running this demo -my $text = $mw->Text(-relief => 'sunken', -borderwidth => 2, - -height => 12); -$text->pack(qw/-expand yes -fill both/); - -$text->insert('0.0', -'There are two groups (a red one and a green one) each containing - 4 rectangles. Those rectangles display their current priority. -The following operations are possible: - "Mouse Button 1" for dragging objects. - "Mouse Button 2" for dragging a colored group. - "Key +" on a rectangle to raise it inside its group. - "Key -" on a rectangle to lower it inside its group. - "Key l" on a rectangle to lower its colored group. - "Key r" on a rectangle to raise its colored group. - "Key t" on a rectangle to change its group (but not its color!). - "Key [0-9] on a rectangle to set the priority to [0-9] -Raising or lowering an item inside a group modify its priority if necessary'); - -# Creating the zinc widget -my $zinc = $mw->Zinc(-width => 600, -height => 500, - -font => "10x20", # usually fonts are sets in resources - # but for this example it is set in the code! - -borderwidth => 3, -relief => 'sunken', - )->pack; - -#########################################################################" -# Creating the redish group -my $group1 = $zinc->add('group', 1, -visible => 1); - -my $counter=0; -# Adding 4 rectangles with text to redish group -foreach my $data ( [200,100, 'red'], [210,210,'red1'], - [390,110,'red2'], [395,215,'red3'] ) { - $counter += 2; - my ($centerx,$centery,$color) = @{$data}; - # this small group is for merging together : - # the rectangle and the text showing its name - my $g = $zinc->add('group', $group1, - -visible => 1, - -atomic => 1, - -sensitive => 1, - -priority => $counter, - ); - my $rec = $zinc->add('rectangle', $g, [$centerx-100,$centery-60, - $centerx+100, $centery+60], - -fillcolor => $color, -filled => 1, - ); - my $txt = $zinc->add('text', $g, - -position => [$centerx,$centery], - -text => "pri=$counter", - -anchor => 'center', - ); - # Some bindings for dragging the rectangle or the full group - $zinc->bind($g, '<ButtonPress-1>' => [\&press, $g, \&motion]); - $zinc->bind($g, '<ButtonRelease-1>' => \&release); - $zinc->bind($g, '<ButtonPress-2>' => [\&press, $g, \&groupMotion]); - $zinc->bind($g, '<ButtonRelease-2>' => \&release); -} - -#########################################################################" -# Creating the greenish group -my $group2 = $zinc->add('group', 1, -visible => 1); -$counter=0; - -# Adding 4 rectangles with text to greenish group -foreach my $data ( [200,300,'green1'], [210,410,'green2'], - [390,310,'green3'], [395,415,'green4'] ) { - $counter++; - my ($centerx,$centery,$color) = @{$data}; - # this small group is for merging together a rectangle - # and the text showing its priority - my $g = $zinc->add('group', $group2, - -atomic => 1, - -sensitive => 1, - -priority => $counter, - ); - my $rec = $zinc->add('rectangle', $g, [$centerx-100,$centery-60, - $centerx+100, $centery+60], - -fillcolor => $color, -filled => 1, - ); - my $txt = $zinc->add('text', $g, - -position => [$centerx,$centery], - -text => "pri=$counter", - -anchor => 'center', - ); - # Some bindings for dragging the rectangle or the full group - $zinc->bind($g, '<ButtonPress-1>' => [\&press, $g, \&motion]); - $zinc->bind($g, '<ButtonRelease-1>' => \&release); - $zinc->bind($g, '<ButtonPress-2>' => [\&press, $g, \&groupMotion]); - $zinc->bind($g, '<ButtonRelease-2>' => \&release); -} - - -#########################################################################" -# adding the key bindings - -# the focus on the widget is ABSOLUTELY necessary for key bindings! -$zinc->Tk::focus(); - -$zinc->Tk::bind('<KeyPress-r>' => \&raiseGroup); -$zinc->Tk::bind('<KeyPress-l>' => \&lowerGroup); -$zinc->Tk::bind('<KeyPress-plus>' => \&raise); -$zinc->Tk::bind('<KeyPress-KP_Add>' => \&raise); -$zinc->Tk::bind('<KeyPress-minus>' => \&lower); -$zinc->Tk::bind('<KeyPress-KP_Subtract>' => \&lower); -$zinc->Tk::bind('<KeyPress-t>' => \&toggleItemGroup); - -my @KP_MAPPINGS = qw (Insert End Down Next Left Begin Right Home Up Prior); - -for my $i (0..9) { - $zinc->Tk::bind("<KeyPress-$i>" => [\&setPriorrity, $i]); - my $code = $KP_MAPPINGS[$i]; - $zinc->Tk::bind("<KeyPress-KP_$code>" => [\&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]); - -#########################################################################" -# Definition of all callbacks - -sub updateLabel { - my ($group) = @_; - my $priority = $zinc->itemcget($group, -priority); - # we get the text item from this group: - my $textitem = $zinc->find('withtype', 'text', ".$group."); - $zinc->itemconfigure($textitem, -text => "pri=$priority"); -} - -sub setPriorrity { - my ($zinc, $priority) = @_; - my $item = $zinc->find('withtag', 'current'); - return unless $item; - $zinc->itemconfigure ($item, -priority => $priority); - &updateLabel($item); -} - - -# Callback to lower a small group of a rectangle and a text -sub lower { - my ($zinc) = @_; - # to get the item under the cursor! - my $item = $zinc->find('withtag', 'current'); - return unless $item; - $zinc->lower($item); - &updateLabel($item); -} - -# Callback to raise a small group of a rectangle and a text -sub raise { - my ($zinc) = @_; - # to get the item under the cursor! - my $item = $zinc->find('withtag', 'current'); - return unless $item; - $zinc->raise($item); - &updateLabel($item); -} - -# Callback to raise the group of groups of a rectangle and a text -sub lowerGroup { - my ($zinc) = @_; - # to get the item under the cursor! - my $item = $zinc->find('withtag', 'current'); - return unless $item; - my $coloredGroup = $zinc->group($item); - $zinc->lower($coloredGroup); -} - -# Callback to raise the group of groups of a rectangle and a text -sub raiseGroup { - my ($zinc) = @_; - # to get the item under the cursor! - my $item = $zinc->find('withtag', 'current'); - return unless $item; - my $coloredGroup = $zinc->group($item); - $zinc->raise($coloredGroup); - &updateLabel($item); -} - -# Callback to change the group of groups of a rectangle and a text -sub toggleItemGroup { - my ($zinc) = @_; - # to get the item under the cursor! - my $item = $zinc->find('withtag', 'current'); - return unless $item; - my $newgroup; - if ($group1 == $zinc->group($item)) { - $newgroup = $group2; - } - else { - $newgroup = $group1; - } - - $zinc->chggroup($item,$newgroup,1); ## the lats argument is true for mainting $item' position - &updateLabel($item); -} - -# callback for starting a drag -my ($x_orig, $y_orig); -sub press { - my ($zinc, $group, $action) = @_; - my $ev = $zinc->XEvent(); - $x_orig = $ev->x; - $y_orig = $ev->y; - $zinc->Tk::bind('<Motion>', [$action, $group]); -} - -# Callback for moving a small group of a rectangle and a text -sub motion { - my ($zinc, $group) = @_; - my $ev = $zinc->XEvent(); - my $x = $ev->x; - my $y = $ev->y; - - $zinc->translate($group, $x-$x_orig, $y-$y_orig); - $x_orig = $x; - $y_orig = $y; -} - -# Callback for moving a group of groups of a rectangle and a text -sub groupMotion { - my ($zinc, $group) = @_; - my $ev = $zinc->XEvent(); - my $x = $ev->x; - my $y = $ev->y; - - my $coloredGroup = $zinc->group($group); - $zinc->translate($coloredGroup, $x-$x_orig, $y-$y_orig); - $x_orig = $x; - $y_orig = $y; -} - -# Callback when releasing the mouse button. It removes any motion callback -sub release { - my ($zinc) = @_; - $zinc->Tk::bind('<Motion>', ''); -} - - -Tk::MainLoop(); - - -1; |