aboutsummaryrefslogtreecommitdiff
path: root/Perl/demos/Tk/demos/zinc_lib/window-contours.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/demos/Tk/demos/zinc_lib/window-contours.pl')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/window-contours.pl112
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;