diff options
Diffstat (limited to 'Perl/demos/Tk/demos/zinc_lib/window-contours.pl')
-rw-r--r-- | Perl/demos/Tk/demos/zinc_lib/window-contours.pl | 112 |
1 files changed, 0 insertions, 112 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/window-contours.pl b/Perl/demos/Tk/demos/zinc_lib/window-contours.pl deleted file mode 100644 index 9f16f95..0000000 --- a/Perl/demos/Tk/demos/zinc_lib/window-contours.pl +++ /dev/null @@ -1,112 +0,0 @@ -#!/usr/bin/perl -w -# $Id$ -# This simple demo has been developped by C. Mertz <mertz@cena.fr> - -package window_contours; # for avoiding symbol collision 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(); - - -# Creating the zinc widget -my $zinc = $mw->Zinc(-width => 600, -height => 500, - -font => "9x15", # usually fonts are sets in resources - # but for this example it is set in the code! - -borderwidth => 3, -relief => 'sunken', - )->pack; - -# The explanation displayed when running this demo -$zinc->add('text', 1, - -position=> [10,10], - -text => 'These "windows" are simply rectangles holed by 4 smaller -rectangles. The text appears behind the window glasses. -You can drag text or "windows".', - -font => "10x20", - ); - -# Text in background -my $backtext = $zinc->add('text', 1, - -position=> [50,200], - -text => "This text appears\nthrough holes of curves", - -font => "-adobe-helvetica-bold-o-normal--34-240-100-100-p-182-iso8859-1", - ); - -my $window = $zinc->add('curve', 1, [100,100 , 300,100, 300,400 , 100,400 ], - -closed => 1, -visible => 1, -filled => 1, - -fillcolor => "grey66", - ); - -my $aGlass= $zinc->add('rectangle', 1, [120,120 , 190,240]); -$zinc->contour($window, 'add', +1, $aGlass); - -$zinc->translate($aGlass, 90,0); -$zinc->contour($window, 'add', +1, $aGlass); - -$zinc->translate($aGlass, 0,140); -$zinc->contour($window, 'add', +1, $aGlass); - -$zinc->translate($aGlass, -90,0); -$zinc->contour($window, 'add', +1, $aGlass); - -# deleting $aGlass which is no more usefull -$zinc->remove($aGlass); - -# cloning $window -my $window2 = $zinc->clone($window); - -# changing its background, moving it and scaling it! -$zinc->itemconfigure($window2, -fillcolor => "grey50"); -$zinc->translate($window2, 30,50); -$zinc->scale($window, 0.8, 0.8); - - - - -# adding drag and drop callback to the two windows and backtext -foreach my $item ($window, $window2, $backtext) { - # Some bindings for dragging the items - $zinc->bind($item, '<ButtonPress-1>' => [\&press, $item, \&motion]); - $zinc->bind($item, '<ButtonRelease-1>' => \&release); -} - -# callback for starting a drag -my ($x_orig, $y_orig); -sub press { - my ($zinc, $item, $action) = @_; - my $ev = $zinc->XEvent(); - $x_orig = $ev->x; - $y_orig = $ev->y; - $zinc->Tk::bind('<Motion>', [$action, $item]); -} - -# Callback for moving an item -sub motion { - my ($zinc, $item) = @_; - my $ev = $zinc->XEvent(); - my $x = $ev->x; - my $y = $ev->y; - - $zinc->translate($item, $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; |