aboutsummaryrefslogtreecommitdiff
path: root/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl374
1 files changed, 0 insertions, 374 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl
deleted file mode 100644
index cf117a5..0000000
--- a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl
+++ /dev/null
@@ -1,374 +0,0 @@
-#!/usr/bin/perl
-#
-# This short script tries to demonstrate with a simple example what you can
-# do with Tk Zinc widget, in particular how to use group item, clipping, and
-# transformations.
-# $Id$
-# this demo has been developped by D. Etienne etienne@cena.fr
-#
-
-use vars qw( $VERSION );
-($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
-
-use Tk;
-# Zinc module is loaded...
-use Tk::Zinc;
-
-
-# We create a classical root widget called MainWindow; then we create Zinc
-# widget child with size, color and relief attributes, and we display it using
-# the geometry manager called 'pack'.
-my $mw = MainWindow->new;
-$mw->geometry("320x565");
-$mw->resizable(0,0);
-my $zinc = $mw->Zinc(-width => 300, -height => 500, -backcolor => 'gray70',
- -borderwidth => 3, -relief => 'sunken');
-$zinc->pack;
-
-# Then we create a gray filled rectangle, in which we will display explain text.
-$zinc->add('rectangle', 1 , [10, 400, 290, 490],
- -linewidth => 0,
- -filled => 1,
- -fillcolor => 'gray80',
- );
-my $text = $zinc->add('text', 1,
- -position => [150, 445],
- -anchor => 'center',
- );
-
-# Create the Wheel object (see Wheel.pm)
-my $wheel = Wheel->new($zinc, 150, 500, 100);
-
-# Display comment
-&comment("Strike any key to begin");
-
-# Create Tk binding
-$mw->Tk::bind('<Key>', \&openmode);
-
-
-
-MainLoop;
-
-
-
-# Callback bound to '<Key>' event when wheel is unmapped
-sub openmode {
- return if $wheel->ismoving;
- # set binding to unmap the wheel
- $mw->Tk::bind('<Key>', \&closemode);
- # set binding to rotate the hand
- $zinc->bind($wheel, '<1>', sub {$wheel->rotatehand(300)});
- # map the wheel
- $wheel->show(150, 150);
- # and then inform user
- &comment("Click on the wheel to rotate the hand.\n".
- "Strike any other key to hide the wheel.");
-}
-
-# Callback bound to '<Key>' event when wheel is already mapped
-sub closemode {
- return if $wheel->ismoving;
- # set binding to map the wheel
- $mw->Tk::bind('<Key>', \&openmode);
- # unmap the wheel
- $wheel->hide(150, 400);
- # and then inform user
- &comment("Strike any key to show the wheel");
-}
-
-# Just display comment
-sub comment {
- my $string = shift;
- $zinc->itemconfigure($text, -text => $string);
-}
-
-
-
-#=============================================================================
-# Wheel Class
-#=============================================================================
-package Wheel;
-
-use strict 'vars';
-use Carp;
-
-
-#====================
-# Object constructor
-#====================
-sub new {
- my ($proto, $widget, $x, $y, $radius) = @_;
-
- # object attributes
- my $self = {
- 'widget' => $widget, # widget reference
- 'origin' => [$x, $y], # origin coordinates
- 'radius' => $radius, # wheel radius
- 'topgroup' => undef, # top Group item
- 'itemclip' => undef, # id of item which clips the wheel
- 'hand' => undef, # id of item wich represents the hand
- 'angle' => 60, # the angle between hand and jackpot
- 'stepsnumber' => 10, # animations parameters
- 'afterdelay' => 60,
- 'shrinkrate' => 0.8, # zoom parameters
- 'zoomrate' => 1.1
- };
- bless $self;
-
- # First, we create a new Group item for the wheel. Why a Group item ?
- # At least two reasons. Wheel object consists of several Zinc items,
- # we'll see below; it moves when it is mapped or unmapped, grows when
- # you hit the jackpot. So, it's more easy to apply such transformations
- # to a structured items set, using Group capability, rather than apply
- # to each item separately or using canvas-like Tags mechanism.
- # Second reason refers to clipping. When it is mapped or unmapped, wheel
- # object is drawn inside a circle with variant radius; clipping is a
- # specific property of Group item
-
- # That's why we create a Group item in the top group, and set its
- # coordinates.
- $self->{topgroup} = $widget->add('group', 1, -visible => 0);
- $widget->coords($self->{topgroup}, [$x, $y]);
- # All the following items will be created in this group...
-
- # Create the invisible Arc item used to clip the wheel, centered on the
- # group origin.
- $self->{itemclip} = $widget->add('arc', $self->{topgroup},
- [-$radius, -$radius, $radius, $radius],
- -visible => 0,
- );
- $widget->itemconfigure($self->{topgroup}, -clip => $self->{itemclip});
-
- # Create the wheel with 6 filled Arc items centered on the group origin
- my $i = 0;
- for my $color (qw(magenta blue cyan green yellow red)) {
- $widget->add('arc', $self->{topgroup},
- [-$radius, -$radius, $radius, $radius],
- -visible => 1,
- -filled => 1,
- -closed => 1,
- -extent => 60,
- -pieslice => 1,
- -fillcolor => $color,
- -linewidth => 0,
- -startangle => 60*$i ,
- -tags => [$self],
- );
- $i++;
- }
-
- # Create the Text item representing the jackpot.
- $widget->add('text', $self->{topgroup},
- -position => [0, -$radius+20],
- -font =>
- '-adobe-helvetica-bold-o-normal--34-240-100-100-p-182-iso8859-1',
- -anchor => 'center',
- -text => "\$",
- );
-
- # Create the closed Curve item representing the hand.
- # In order to make processing easier, its rotation axis will be placed
- # on the group origin.
- $self->{hand} = $widget->add('curve', $self->{topgroup},
- [0, -$radius + 10, 20, -$radius + 40,
- 6, -$radius + 40, 20, 10,
- -20, 10, -6, -$radius + 40,
- -20, -$radius + 40],
- -linewidth => 3,
- -linecolor => 'gray40',
- -filled => 1,
- -fillcolor => 'gray80',
- -closed => 1,
- -tags => [$self]);
- # Then, we apply rotation to the hand using the Zinc 'rotation' method.
- $widget->rotate($self->{hand}, 3.1416/3);
-
- # Then we unmap the wheel; in fact, Group item is translated and its
- # clipping circle is shrunk to a point.
- $self->_clipAndTranslate($self->{shrinkrate}**$self->{stepsnumber});
-
- return $self;
-
-}
-
-#================
-# Public methods
-#================
-
-# Return 1 if wheel is moving (opening or closing animation)
-sub ismoving {
- my $self = shift;
- return 1 if $self->{opening} or $self->{closing};
-}
-
-# Display wheel with animation effect
-sub show {
- my ($self, $x, $y) = @_;
- # simple lock management
- return if $self->{opening} or $self->{closing};
- $self->{opening} = 1;
- # start animation
- $self->_open($x, $y, 0);
-}
-
-
-# Unmap wheel with animation effect
-sub hide {
- my ($self, $x, $y) = @_;
- # simple lock management
- return if $self->{opening} or $self->{closing};
- $self->{closing} = 1;
- # start animation
- $self->_close($x, $y, 0);
-}
-
-
-# Just rotate the hand with animation effect.
-sub rotatehand {
- my $self = shift;
- my $angle = shift;
- return if $self->{turning};
- $angle = 360 unless $angle;
- $self->{angle} += $angle;
- if ($self->{angle} % 360 == 0) {
- $self->{fortune} = 1;
- }
- $self->_rotatehand(2*3.1416*$angle/360);
-}
-
-
-#=================
-# Private methods
-#=================
-
-# Generate opening animation; see below _clipAndTranslate method for
-# Zinc specific use.
-sub _open {
- my ($self, $x, $y, $cnt) = @_;
- my $widget = $self->{widget};
- my $group = $self->{topgroup};
- # first step of animation
- if ($cnt == 0) {
- $widget->itemconfigure($group, -visible => 1);
- my @pos = $widget->coords($group);
- $x = ($x - $pos[0])/$self->{stepsnumber};
- $y = ($y - $pos[1])/$self->{stepsnumber};
- # last step
- } elsif ($cnt == $self->{stepsnumber}) {
- $self->{opening} = undef;
- return;
- }
- $cnt++;
- # move and grow the wheel
- $self->_clipAndTranslate(1/$self->{shrinkrate}, $x, $y);
- # process the animation using the 'after' Tk defering method
- $widget->after($self->{afterdelay}, sub {$self->_open($x, $y, $cnt)});
-}
-
-
-# Generate closing animation; see below _clipAndTranslate method for
-# Zinc specific use.
-sub _close {
- my ($self, $x, $y, $cnt) = @_;
- my $widget = $self->{widget};
- my $group = $self->{topgroup};
- # first step of animation
- if ($cnt == 0) {
- my @pos = $widget->coords($group);
- $x = ($x - $pos[0])/$self->{stepsnumber};
- $y = ($y - $pos[1])/$self->{stepsnumber};
- # last step
- } elsif ($cnt == $self->{stepsnumber}) {
- $widget->itemconfigure($group, -visible => 0);
- $self->{closing} = undef;
- return;
- }
- $cnt++;
- # move and shrink the wheel
- $self->_clipAndTranslate($self->{shrinkrate}, $x, $y);
- # process the animation using the 'after' Tk defering method
- $widget->after($self->{afterdelay}, sub {$self->_close($x, $y, $cnt)});
-}
-
-
-# Generate hand rotation animation.
-sub _rotatehand {
- my ($self, $angle, $cnt) = @_;
- my $widget = $self->{widget};
- my $group = $self->{topgroup};
- $self->{turning} = 1;
- # first step of animation
- if (not $cnt) {
- $angle /= $self->{stepsnumber};
- # last step
- } elsif ($cnt == $self->{stepsnumber}) {
- if ($self->{fortune}) {
- $self->_fortune;
- } else {
- $self->{turning} = undef;
- }
- return;
- }
- $cnt++;
- # use 'rotation' Zinc method.
- $widget->rotate($self->{hand}, $angle);
-
- # process the animation using the 'after' Tk defering method
- $widget->after($self->{afterdelay}, sub {$self->_rotatehand($angle, $cnt)});
-
-}
-
-# Generate growing animation to notify jackpot
-sub _fortune {
- my ($self, $cnt) = @_;
- $cnt = 0 unless $cnt;
- my $zf;
- my $widget = $self->{widget};
- my $group = $self->{topgroup};
- my @pos = $widget->coords($group);
- # last step of animation
- if ($cnt == 6) {
- $self->{fortune} = undef;
- $self->{turning} = undef;
- return;
- # event steps : wheel grows
- } elsif ($cnt == 0 or $cnt % 2 == 0) {
- $zf = $self->{zoomrate};
- # odd steps : wheel is shrunk
- } else {
- $zf = 1/$self->{zoomrate};
- }
- $cnt++;
-
- # Now, we apply scale transformation to the Group item, using the 'scale'
- # Zinc method. Note that we reset group coords before scaling it, in order
- # that the origin of the transformation corresponds to the center of the
- # wheel. When scale is done, we restore previous coords of group.
- $widget->coords($group, [0, 0]);
- $widget->scale($group, $zf, $zf);
- $widget->coords($group, \@pos);
-
- # process the animation using the 'after' Tk defering method
- $widget->after(100, sub {$self->_fortune($cnt)});
-
-}
-
-# Update group clipping and translation, using 'scale' and 'translate'
-# Zinc methods.
-sub _clipAndTranslate {
-
- my ($self, $shrinkfactor, $x, $y) = @_;
- $x = 0 unless $x;
- $y = 0 unless $y;
- $self->{widget}->scale($self->{itemclip}, $shrinkfactor, $shrinkfactor);
- if ($Tk::Zinc::VERSION lt "3.297") {
- $self->{widget}->translate($self->{topgroup}, $x, $y);
- } else {
- my ($xc, $yc) = $self->{widget}->coords($self->{topgroup});
- $self->{widget}->coords($self->{topgroup}, [$xc + $x, $yc + $y]);
- }
-
-}
-
-
-1;
generated by cgit v1.1 at 2024-05-18 17:57:47 +0000