aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl289
1 files changed, 283 insertions, 6 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl
index fd343bd..f2340f9 100644
--- a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl
+++ b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl
@@ -11,12 +11,6 @@ use Tk;
# Zinc module is loaded...
use Tk::Zinc;
-# to find the Wheel class. Should be included in this source file!
-use lib Tk->findINC('demos/zinc_pm');
-
-# my Wheel object class too. See below...
-use Wheel;
-
# 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
@@ -86,3 +80,286 @@ sub comment {
}
+
+#=============================================================================
+# 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);
+ $self->{widget}->translate($self->{topgroup}, $x, $y);
+
+}
+
+
+1;