Concatenation main + classe Wheel

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;