TripleRotatingWheel
0001 #!/usr/bin/perl
0002
0003 #$Id: TripleRotatingWheel demo by zentara 2003/11/01
0004
0005 # Idea derived from the wheelOfFortune.pl demo by:
0006 # $Id: wheelOfFortune.pl,v 1.4 2003/09/15 12:25:05 mertz Exp $
0007 # this demo has been developped by D. Etienne etienne@cena.fr
0008 #
0009
0010 use Tk;
0011 use Tk::Zinc;
0012
0013 my @win =(); # an array to store winning wheel values, can range from
0014 # () to (1,1,1)
0015
0016 # We create a classical root widget called MainWindow; then we create Zinc
0017 # widget child with size, color and relief attributes, and we display it using
0018 # the geometry manager called 'pack'.
0019 my $mw = MainWindow->new;
0020 $mw->geometry("700x600");
0021
0022 $mw->resizable(0,0);
0023
0024 my $zinc = $mw->Zinc(-width => 700, -height => 565,
0025 -backcolor => 'black',
0026 -borderwidth => 3, -relief => 'sunken');
0027 $zinc->pack;
0028
0029 # Then we create a gray filled rectangle, in which we will display explain text.
0030 $zinc->add('rectangle', 1 , [200, 400, 490, 490],
0031 -linewidth => 2,
0032 -filled => 1,
0033 -fillcolor => 'SkyBlue',
0034 );
0035 my $text = $zinc->add('text', 1,
0036 -position => [350, 445],
0037 -anchor => 'center',
0038 );
0039
0040 $zinc->add('rectangle', 1 , [250,275,450,325], #(xpos1,ypos1,xpos2,ypos2)
0041 -linewidth => 2,
0042 -filled => 1,
0043 -fillcolor => 'Orange',
0044 );
0045
0046 my $wintext = $zinc->add('text', 1,
0047 -position => [350, 300],
0048 -anchor => 'center',
0049 );
0050
0051 #create winning wheel markers
0052 #create first triangle, then clone and translate
0053 my $tr1 = $zinc->add('triangles', 1,
0054 [0,20,20,20,10,50],
0055 -fan => 1,
0056 -colors => 'Orange',
0057 -visible => 1,
0058 );
0059 my $tr2 = $zinc->clone($tr1);
0060 my $tr3 = $zinc->clone($tr1);
0061 $zinc->translate($tr1,130,0);
0062 $zinc->translate($tr2,340,0);
0063 $zinc->translate($tr3,550,0);
0064
0065
0066
0067 # Create the Wheel object (see Wheel.pm)
0068 my $wheel1 = Wheel->new($zinc, 350, 500, 100); #start xpos,ypos,mag
0069 my $wheel2 = Wheel->new($zinc, 350, 500, 100);
0070 my $wheel3 = Wheel->new($zinc, 350, 500, 100);
0071
0072 # Display comment
0073 &comment("Strike any key to begin");
0074 &wincomment("READY");
0075
0076 # Create Tk binding
0077 $mw->Tk::bind('<Key>', \&openmode);
0078
0079 my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit(0)})
0080 ->pack;
0081
0082 MainLoop;
0083
0084 # Callback bound to '<Key>' event when wheel is unmapped
0085 sub openmode {
0086 # set binding to unmap the wheel
0087 $mw->Tk::bind('<Key>', \&closemode);
0088 # set binding to rotate the hand
0089 $zinc->bind($wheel1, '<1>', sub {spin()});
0090 $zinc->bind($wheel2, '<1>', sub {spin()});
0091 $zinc->bind($wheel3, '<1>', sub {spin()});
0092 # map the wheel
0093 $wheel1->show(140, 150);
0094 $wheel2->show(350, 150);
0095 $wheel3->show(560, 150);
0096
0097 # and then inform user
0098 &comment("Click on any wheel to play.\n".
0099 "Strike any key to hide the wheels.");
0100 }
0101
0102 sub spin {
0103 return if $wheel1->ismoving;
0104 return if $wheel2->ismoving;
0105 return if $wheel3->ismoving;
0106
0107 @win=();
0108 &wincomment("PLAYING");
0109 $wheel1->rotatewheel(int rand(360));
0110 $wheel2->rotatewheel(int rand(360));
0111 $wheel3->rotatewheel(int rand(360));
0112 # print "\@win->@win\n";
0113 }
0114
0115
0116 # Callback bound to '<Key>' event when wheel is already mapped
0117 sub closemode {
0118 return if $wheel1->ismoving;
0119 return if $wheel2->ismoving;
0120 return if $wheel3->ismoving;
0121
0122 # set binding to map the wheel
0123 $mw->Tk::bind('<Key>', \&openmode);
0124 # unmap the wheel
0125 $wheel1->hide(350, 400);
0126 $wheel2->hide(350, 400);
0127 $wheel3->hide(350, 400);
0128 # and then inform user
0129 &comment("Strike any key to show the wheel");
0130 }
0131
0132 # Just display comment
0133 sub comment {
0134 my $string = shift;
0135 $zinc->itemconfigure($text, -text => $string);
0136 }
0137
0138 # display winning comment
0139 sub wincomment {
0140 my $string = shift;
0141 $zinc->itemconfigure($wintext, -text => $string);
0142 }
0143
0144 sub displaywin {
0145 if($#win == -1){&wincomment("NO WIN")}
0146 if($#win == 0){&wincomment("SINGLE")}
0147 if($#win == 1){&wincomment("DOUBLE")}
0148 if($#win == 2){&wincomment("TRIPLE")}
0149
0150 #restore disabled mouse click for next spin
0151 $zinc->bind($wheel1, '<1>', sub {spin()});
0152 $zinc->bind($wheel2, '<1>', sub {spin()});
0153 $zinc->bind($wheel3, '<1>', sub {spin()});
0154 }
0155
0156 #=============================================================================
0157 # Wheel Class
0158 #=============================================================================
0159 package Wheel;
0160
0161 use strict 'vars';
0162 use Carp;
0163 #====================
0164 # Object constructor
0165 #====================
0166 sub new {
0167 my ($proto, $widget, $x, $y, $radius) = @_;
0168
0169 # object attributes
0170 my $self = {
0171 'widget' => $widget, # widget reference
0172 'origin' => [$x, $y], # origin coordinates
0173 'radius' => $radius, # wheel radius
0174 'topgroup' => undef, # top Group item
0175 'itemclip' => undef, # id of item which clips the wheel
0176 'hand' => undef, # id of item wich represents the hand
0177 #'angle' => 60, # the angle between hand and jackpot
0178 'angle' => 0, # the angle between hand and jackpot
0179 'stepsnumber' => 10, # animations parameters
0180 'afterdelay' => 60,
0181 'shrinkrate' => 0.8, # zoom parameters
0182 'zoomrate' => 1.1,
0183
0184 };
0185 bless $self;
0186
0187 # First, we create a new Group item for the wheel. Why a Group item ?
0188 # At least two reasons. Wheel object consists of several Zinc items,
0189 # we'll see below; it moves when it is mapped or unmapped, grows when
0190 # you hit the jackpot. So, it's more easy to apply such transformations
0191 # to a structured items set, using Group capability, rather than apply
0192 # to each item separately or using canvas-like Tags mechanism.
0193 # Second reason refers to clipping. When it is mapped or unmapped, wheel
0194 # object is drawn inside a circle with variant radius; clipping is a
0195 # specific property of Group item
0196
0197 # That's why we create a Group item in the top group, and set its
0198 # coordinates.
0199 $self->{topgroup} = $widget->add('group', 1, -visible => 0);
0200 $widget->coords($self->{topgroup}, [$x,$y]);
0201
0202 #print " start widget coords-> $x $y\n";
0203
0204 # All the following items will be created in this group...
0205 # Create the invisible Arc item used to clip the wheel, centered on the
0206 # group origin.
0207 $self->{itemclip} = $widget->add('arc', $self->{topgroup},
0208 [-$radius, -$radius, $radius, $radius],
0209 -visible => 0,
0210 );
0211 $widget->itemconfigure($self->{topgroup}, -clip => $self->{itemclip});
0212
0213 # Create the wheel with 6 filled Arc items centered on the group origin
0214 my $i = 0;
0215 for my $color (qw(magenta blue cyan green yellow red)) {
0216 $widget->add('arc', $self->{topgroup},
0217 [-$radius, -$radius, $radius, $radius],
0218 -visible => 1,
0219 -filled => 1,
0220 -closed => 1,
0221 -extent => 60,
0222 -pieslice => 1,
0223 -fillcolor => $color,
0224 -linewidth => 1,
0225 -startangle => 60*$i ,
0226 -tags => [$self],
0227 );
0228 $i++;
0229 }
0230
0231 # Create the Text item representing the jackpot.
0232 $widget->add('text', $self->{topgroup},
0233 -position => [0, -$radius+20],
0234 -font =>
0235 '-adobe-helvetica-bold-o-normal--34-240-100-100-p-182-iso8859-1',
0236 -anchor => 'center',
0237 -text => "\$",
0238 );
0239
0240
0241 # Then we unmap the wheel; in fact, Group item is translated and its
0242 # clipping circle is shrunk to a point.
0243 $self->_clipAndTranslate($self->{shrinkrate}**$self->{stepsnumber});
0244 return $self;
0245 }
0246
0247 #================
0248 # Public methods
0249 #================
0250
0251 # Return 1 if wheel is moving (opening or closing animation)
0252 sub ismoving {
0253 my $self = shift;
0254 return 1 if $self->{opening} or $self->{closing} or $self->{turning};
0255 }
0256
0257 # Display wheel with animation effect
0258 sub show {
0259 my ($self, $x, $y) = @_;
0260 # simple lock management
0261 return if $self->{opening} or $self->{closing};
0262 $self->{opening} = 1;
0263 # start animation
0264 $self->_open($x, $y, 0);
0265 }
0266
0267
0268 # Unmap wheel with animation effect
0269 sub hide {
0270 my ($self, $x, $y) = @_;
0271 # simple lock management
0272 return if $self->{opening} or $self->{closing};
0273 $self->{closing} = 1;
0274 # start animation
0275 $self->_close($x, $y, 0);
0276 }
0277
0278
0279 # Just rotate the hand with animation effect.
0280 sub rotatewheel {
0281 my $self = shift;
0282 print "wheel-> $self->{topgroup}";
0283 my $angle = shift;
0284 print " angle->$angle\n";
0285
0286 return if $self->{turning};
0287
0288 #prevent "double-clicking", so mouse is disabled
0289 #until current play is over
0290 $zinc->bind($wheel1, '<1>', sub {});
0291 $zinc->bind($wheel2, '<1>', sub {});
0292 $zinc->bind($wheel3, '<1>', sub {});
0293
0294 $angle = 0 unless $angle;
0295 my $oldangle = $self->{angle};
0296 $self->{angle} = $angle;
0297
0298 if ((330 < $angle)||($angle < 30)) {
0299 $self->{fortune} = 1;
0300 push (@win, $self->{fortune});
0301 }
0302 $self->_rotatewheel(2*3.1416*($angle + 1440 - $oldangle)/360);
0303 #the 1440 above gives at least 2 full spins each play
0304 }
0305
0306 #=================
0307 # Private methods
0308 #=================
0309
0310 # Generate opening animation; see below _clipAndTranslate method for
0311 # Zinc specific use.
0312 sub _open {
0313 my ($self, $x, $y, $cnt) = @_;
0314 my $widget = $self->{widget};
0315 my $group = $self->{topgroup};
0316 # first step of animation
0317 if ($cnt == 0) {
0318 $widget->itemconfigure($group, -visible => 1);
0319 my @pos = $widget->coords($group);
0320 $x = ($x - $pos[0])/$self->{stepsnumber};
0321 $y = ($y - $pos[1])/$self->{stepsnumber};
0322 # last step
0323 } elsif ($cnt == $self->{stepsnumber}) {
0324 $self->{opening} = undef;
0325 return;
0326 }
0327 $cnt++;
0328 # move and grow the wheel
0329 $self->_clipAndTranslate(1/$self->{shrinkrate}, $x, $y);
0330 # process the animation using the 'after' Tk defering method
0331 $widget->after($self->{afterdelay}, sub {$self->_open($x, $y, $cnt)});
0332 }
0333
0334
0335 # Generate closing animation; see below _clipAndTranslate method for
0336 # Zinc specific use.
0337 sub _close {
0338 my ($self, $x, $y, $cnt) = @_;
0339 my $widget = $self->{widget};
0340 my $group = $self->{topgroup};
0341 # first step of animation
0342 if ($cnt == 0) {
0343 my @pos = $widget->coords($group);
0344 $x = ($x - $pos[0])/$self->{stepsnumber};
0345 $y = ($y - $pos[1])/$self->{stepsnumber};
0346 # last step
0347 } elsif ($cnt == $self->{stepsnumber}) {
0348 $widget->itemconfigure($group, -visible => 0);
0349 $self->{closing} = undef;
0350 return;
0351 }
0352 $cnt++;
0353 # move and shrink the wheel
0354 $self->_clipAndTranslate($self->{shrinkrate}, $x, $y);
0355 # process the animation using the 'after' Tk defering method
0356 $widget->after($self->{afterdelay}, sub {$self->_close($x, $y, $cnt)});
0357
0358 &main::wincomment("READY");
0359 }
0360
0361 # Generate hand rotation animation.
0362 sub _rotatewheel {
0363 my ($self, $angle, $cnt) = @_;
0364 my $widget = $self->{widget};
0365 my $group = $self->{topgroup};
0366
0367 #grab position of widget
0368 my @pos = $widget->coords($group);
0369 my $x = ($pos[0]);
0370 my $y = ($pos[1]);
0371
0372 $self->{turning} = 1;
0373 # first step of animation
0374 if (not $cnt) {
0375 $angle /= $self->{stepsnumber};
0376
0377 # last step
0378 } elsif ($cnt == $self->{stepsnumber}) {
0379 if ($self->{fortune}) {
0380 $self->_fortune;
0381 } else {
0382 $self->{turning} = undef;
0383 }
0384
0385 &main::displaywin();
0386 return;
0387 }
0388 $cnt++;
0389 # use 'rotation' Zinc method.
0390
0391 $widget->rotate($self->{topgroup}, $angle);
0392 # process the animation using the 'after' Tk defering method
0393
0394 #needed to keep wheel stationary while rotating
0395 $widget->coords($self->{topgroup},[$x,$y]);
0396
0397 $widget->after($self->{afterdelay}, sub {$self->_rotatewheel($angle, $cnt)});
0398
0399 }
0400
0401 # Generate growing animation to notify jackpot
0402 sub _fortune {
0403 my ($self, $cnt) = @_;
0404 $cnt = 0 unless $cnt;
0405 my $zf;
0406 my $widget = $self->{widget};
0407 my $group = $self->{topgroup};
0408 my @pos = $widget->coords($group);
0409 # last step of animation
0410 if ($cnt == 6) {
0411 $self->{fortune} = undef;
0412 $self->{turning} = undef;
0413 return;
0414 # event steps : wheel grows
0415 } elsif ($cnt == 0 or $cnt % 2 == 0) {
0416 $zf = $self->{zoomrate};
0417 # odd steps : wheel is shrunk
0418 } else {
0419 $zf = 1/$self->{zoomrate};
0420 }
0421 $cnt++;
0422
0423 # Now, we apply scale transformation to the Group item, using the 'scale'
0424 # Zinc method. Note that we reset group coords before scaling it, in order
0425 # that the origin of the transformation corresponds to the center of the
0426 # wheel. When scale is done, we restore previous coords of group.
0427 $widget->coords($group, [0, 0]);
0428 $widget->scale($group, $zf, $zf);
0429 $widget->coords($group, \@pos);
0430
0431 # process the animation using the 'after' Tk defering method
0432 $widget->after(100, sub {print "\007";$self->_fortune($cnt)});
0433 &main::displaywin();
0434 }
0435
0436
0437 # Update group clipping and translation, using 'scale' and 'translate'
0438 # Zinc methods.
0439 sub _clipAndTranslate {
0440 my ($self, $shrinkfactor, $x, $y) = @_;
0441 $x = 0 unless $x;
0442 $y = 0 unless $y;
0443 $self->{widget}->scale($self->{itemclip}, $shrinkfactor, $shrinkfactor);
0444 $self->{widget}->translate($self->{topgroup}, $x, $y);
0445 }
0446 1;