Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Zinc: TripleRotatingWheel

by zentara (Archbishop)
on Nov 01, 2003 at 23:17 UTC ( #303854=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info zentara
Description: I recently posted a zinc demo which had rotating hands on 3 wheels at Gambling Game

Well, the question came up, why not just rotate the wheels? So here it is, it shows the true speed and power of Zinc. screenshot

Edit, BazB use square brackets for link to the other node.

#!/usr/bin/perl

#$Id: TripleRotatingWheel demo by zentara 2003/11/01 

# Idea derived from the wheelOfFortune.pl demo by:   
# $Id: wheelOfFortune.pl,v 1.4 2003/09/15 12:25:05 mertz Exp $  
# this demo has been developped by D. Etienne etienne@cena.fr  
#  

use Tk;
use Tk::Zinc;

my @win =(); # an array to store winning wheel values, can range from 
             # () to (1,1,1)  

# 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("700x600");

$mw->resizable(0,0);

my $zinc = $mw->Zinc(-width => 700, -height => 565,
                    -backcolor => 'black',
                     -borderwidth => 3, -relief => 'sunken');
$zinc->pack;

# Then we create a gray filled rectangle, in which we will display exp
+lain text. 
$zinc->add('rectangle', 1 , [200, 400, 490, 490],
           -linewidth => 2,
           -filled => 1,
           -fillcolor => 'SkyBlue',
           );
my $text = $zinc->add('text', 1,
                      -position => [350, 445],
                      -anchor => 'center',
                      );

$zinc->add('rectangle', 1 , [250,275,450,325], #(xpos1,ypos1,xpos2,ypo
+s2) 
           -linewidth => 2,
           -filled => 1,
           -fillcolor => 'Orange',
           );

my $wintext = $zinc->add('text', 1,
                      -position => [350, 300],
                      -anchor => 'center',
                      );

#create winning wheel markers 
#create first triangle, then clone and translate 
my $tr1 = $zinc->add('triangles', 1,
                     [0,20,20,20,10,50],
                     -fan => 1,
                     -colors => 'Orange',
                     -visible => 1,
                     );
my $tr2 = $zinc->clone($tr1);
my $tr3 = $zinc->clone($tr1);
$zinc->translate($tr1,130,0);
$zinc->translate($tr2,340,0);
$zinc->translate($tr3,550,0);



# Create the Wheel object (see Wheel.pm) 
my $wheel1 = Wheel->new($zinc, 350, 500,  100); #start xpos,ypos,mag 
my $wheel2 = Wheel->new($zinc, 350, 500, 100);
my $wheel3 = Wheel->new($zinc, 350, 500, 100);

# Display comment 
&comment("Strike any key to begin");
&wincomment("READY");

# Create Tk binding 
$mw->Tk::bind('<Key>', \&openmode);

my $closebutton = $mw->Button(text => 'Exit', -command => sub{Tk::exit
+(0)})
               ->pack;

MainLoop;

# Callback bound to '<Key>' event when wheel is unmapped 
sub openmode {
    # set binding to unmap the wheel 
    $mw->Tk::bind('<Key>', \&closemode);
    # set binding to rotate the hand 
    $zinc->bind($wheel1, '<1>', sub {spin()});
    $zinc->bind($wheel2, '<1>', sub {spin()});
    $zinc->bind($wheel3, '<1>', sub {spin()});
    # map the wheel 
    $wheel1->show(140, 150);
    $wheel2->show(350, 150);
    $wheel3->show(560, 150);

    # and then inform user 
    &comment("Click on any wheel to play.\n".
             "Strike any key to hide the wheels.");
}

sub spin {
    return if $wheel1->ismoving;
    return if $wheel2->ismoving;
    return if $wheel3->ismoving;

  @win=();
  &wincomment("PLAYING");
          $wheel1->rotatewheel(int rand(360));
          $wheel2->rotatewheel(int rand(360));
          $wheel3->rotatewheel(int rand(360));
#  print "\@win->@win\n"; 
 }


# Callback bound to '<Key>' event when wheel is already mapped  
sub closemode {
    return if $wheel1->ismoving;
    return if $wheel2->ismoving;
    return if $wheel3->ismoving;

    # set binding to map the wheel 
    $mw->Tk::bind('<Key>', \&openmode);
    # unmap the wheel 
    $wheel1->hide(350, 400);
    $wheel2->hide(350, 400);
    $wheel3->hide(350, 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);
}

# display winning comment  
sub wincomment {
    my $string = shift;
    $zinc->itemconfigure($wintext, -text => $string);
}

sub displaywin {
  if($#win == -1){&wincomment("NO WIN")}
  if($#win == 0){&wincomment("SINGLE")}
  if($#win == 1){&wincomment("DOUBLE")}
  if($#win == 2){&wincomment("TRIPLE")}

 #restore disabled mouse click for next spin 
  $zinc->bind($wheel1, '<1>',  sub {spin()});
  $zinc->bind($wheel2, '<1>', sub {spin()});
  $zinc->bind($wheel3, '<1>', sub {spin()});
}

#=====================================================================
+======== 
#                 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 
        'angle' => 0,         # 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 ite
+m ? 
    # At least two reasons. Wheel object consists of several Zinc item
+s,   
    # we'll see below; it moves when it is mapped or unmapped, grows w
+hen   
    # you hit the jackpot. So, it's more easy to apply such transforma
+tions  
    # to a structured items set, using Group capability, rather than a
+pply  
    # 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]);
#print "  start widget coords-> $x $y\n";     

    # All the following items will be created in this group... 
    # Create the invisible Arc item used to clip the wheel, centered o
+n the 
    # group origin. 
    $self->{itemclip} = $widget->add('arc',  $self->{topgroup},
                                     [-$radius, -$radius, $radius, $ra
+dius],
                                     -visible => 0,
                                     );
    $widget->itemconfigure($self->{topgroup}, -clip => $self->{itemcli
+p});

    # Create the wheel with 6 filled Arc items centered on the group o
+rigin 
    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 => 1,
                     -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 => "\$",
                 );


    # Then we unmap the wheel; in fact, Group item is translated and i
+ts 
    # 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} or $self->{turnin
+g};
}

# 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 rotatewheel {
    my $self = shift;
    print "wheel-> $self->{topgroup}";
    my $angle = shift;
print "  angle->$angle\n";

    return if $self->{turning};

#prevent "double-clicking", so mouse is disabled 
#until current play is over 
$zinc->bind($wheel1, '<1>', sub {});
$zinc->bind($wheel2, '<1>', sub {});
$zinc->bind($wheel3, '<1>', sub {});
    $angle = 0  unless $angle;
    my $oldangle = $self->{angle};
    $self->{angle} = $angle;

    if ((330 < $angle)||($angle < 30)) {
        $self->{fortune} = 1;
        push (@win, $self->{fortune});
    }
    $self->_rotatewheel(2*3.1416*($angle + 1440 - $oldangle)/360);
    #the 1440 above gives at least 2 full spins each play   
}

#================= 
# 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, $cn
+t)});

&main::wincomment("READY");
}

# Generate hand rotation animation. 
sub _rotatewheel {
    my ($self, $angle, $cnt) = @_;
    my $widget = $self->{widget};
    my $group = $self->{topgroup};

#grab position of widget 
my @pos = $widget->coords($group);
my $x = ($pos[0]);
my $y = ($pos[1]);

    $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;
        }

        &main::displaywin();
        return;
    }
    $cnt++;
    # use 'rotation' Zinc method. 

    $widget->rotate($self->{topgroup}, $angle);
# process the animation using the 'after' Tk defering method 
#needed to keep wheel stationary while rotating 
$widget->coords($self->{topgroup},[$x,$y]);

    $widget->after($self->{afterdelay}, sub {$self->_rotatewheel($angl
+e, $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 {print "\007";$self->_fortune($cnt)});
    &main::displaywin();
}


# 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, $shrinkfa
+ctor);
    $self->{widget}->translate($self->{topgroup}, $x, $y);
}
1;
Replies are listed 'Best First'.
Re: Zinc: TripleRotatingWheel
by Anonymous Monk on Nov 03, 2003 at 09:23 UTC
    Thanks for your demo.... we will replace the previous one with yours in the next Tk::Zinc release (3.2.96). Any perl monk demo is welcome and will be credited, of course... Christophe Mertz.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://303854]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2020-09-25 21:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    If at first I donít succeed, I Ö










    Results (141 votes). Check out past polls.

    Notices?