Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::Zinc; my $motion_flag = 0; my $count = 0; my $delay = 50; #adjust for speed of your computer my $speed = 1000 - $delay; my $width = 700; my $height = 600; my ($leftscore,$rightscore)=(0,0); my ($up,$left)=(0,0); my $serve = 'left'; my $randx; my $randy; my $dx; my $dy; my $lauto = 0; my $rauto = 0; my @hits = (-1,1); my $mw = MainWindow->new; $mw->geometry($width.'x'.$height); $mw->resizable(0,0); my $zinc = $mw->Zinc(-width => $width, -height => $height - 35, -backcolor => 'black', -borderwidth => 3, -relief => 'sunken', )->pack; # Then we create a gray filled rectangle, in which we will display exp +lain text. my $message = $zinc->add('rectangle', 1 , [200, 400, 490, 490], -linewidth => 2, -visible => 0, -filled => 1, -fillcolor => 'SkyBlue', ); my $text = $zinc->add('text', 1, -position => [350, 445], -visible => 0, -anchor => 'center', -priority => 2 ); my $leftgroup= $zinc->add('group',1,-visible=> 1); $zinc->translate($leftgroup,0,281); my $rightgroup= $zinc->add('group',1,-visible=> 1); $zinc->translate($rightgroup,700,281); #pong paddles my $leftpaddle = $zinc->add('rectangle',$leftgroup ,[0,-20, 20,20], -linewidth => 2, -filled => 1, -fillcolor => 'red', ); my $rightpaddle = $zinc->add('rectangle',$rightgroup, [0,-20,-20,20], -linewidth => 2, -filled => 1, -fillcolor => 'red', ); #my $pongx #a circle is bounded by a square box, specify 2 diagonal points my $pong = $zinc->add('arc',1, [30, -20, 50, 0], -fillcolor => "yellow +", -filled => 1); ###################################################################### +######## # Display comment &comment("Hit Enter to begin. $serve is serving Up arrow inreases speed Down arrow decreases speed Escape to pause "); #set key binding $mw->Tk::bind('<Return>', \&start); $mw->Tk::bind('<a>', sub{ my($x1,$y1) = $zinc->coords($leftgroup); $zinc->translate($leftgroup,0,-40) unless $y +1 <= 40 }); $mw->Tk::bind('<z>', sub {my($x1,$y1) = $zinc->coords($leftgroup); $zinc->translate($leftgroup,0,40) unless $y1 +>= 535 }); $mw->Tk::bind('<k>', sub{my($x1,$y1) = $zinc->coords($rightgroup); $zinc->translate($rightgroup,0,-40) unless $y +1 <= 40 }); $mw->Tk::bind('<m>', sub{my($x1,$y1) = $zinc->coords($rightgroup); $zinc->translate($rightgroup,0,40) unless $y1 + >= 535 }); $mw->Tk::bind('<Up>', sub{$delay = ($delay -1) unless $delay <= 1; $speed = 1000 - $delay; $mw->update }); $mw->Tk::bind('<Down>', sub{$delay = ($delay + 1)unless $delay >= 1000 +; $speed = 1000 - $delay; $mw->update}); my $f1 = $mw->Frame->pack(-side => 'left', -fill => 'both', -expand => + 1,); my $lscore = $f1->Label(-textvariable => \$leftscore, -bg => 'black +', -fg =>'red')-> pack( -side => 'left', -fill => 'both', -expand => '1',) +; $f1->Label(-text => "<-- a-up\nz-down", -bg => 'green',)-> pack( -side => 'left', -fill => 'both', -expand => '1',) +; my $f2 = $f1->Frame->pack(-side => 'left', -fill => 'both', -expand => + 1,); $f2->Label(-text => "Left AutoPlay", -bg => 'grey')->pack; my $checkl = $f2->Checkbutton(offvalue => 0, onvalue => 1, state => 'normal', variable => \$lauto)->pack; $f1->Label(-text => "", -bg => 'black',)-> pack( -side => 'left', -fill => 'both', -expand => '1',) +; my $closebutton = $f1->Button(text => 'Exit', -command => sub{Tk::exit +(0)})-> pack( -side => 'left', -fill => 'both', -expand => '0' +); my $f3 = $f1->Frame->pack(-side => 'left', -fill => 'both', -expand => + 1,); $f3->Label(-text => "Speed", -bg => 'black',-fg =>'green')-> pack( -side => 'left', -fill => 'both', -expand => '1',); my $smeter = $f3->Label(-textvariable => \$speed, -bg => 'black',-f +g =>'green')-> pack( -side => 'left', -fill => 'both', -expand => '1',); $f1->Label(-text => "", -bg => 'black',)-> pack( -side => 'left', -fill => 'both', -expand => '1',) +; my $newgamebutton = $f1->Button(text => "New\nGame", -command => \&new +game)-> pack( -side => 'left', -fill => 'both', -expand => '0' +); $f1->Label(-text => "", -bg => 'black',)-> pack( -side => 'left', -fill => 'both', -expand => '1',) +; my $f4 = $f1->Frame->pack(-side => 'left', -fill => 'both', -expand => + 1,); $f4->Label(-text => 'Right Autoplay', -bg => 'grey')->pack; my $checkr = $f4->Checkbutton(offvalue => 0, onvalue => 1, state => 'normal', variable => \$rauto)->pack; $f1->Label(-text => "k-up-->\nm-down", -bg => 'green')-> pack( -side => 'left', -fill => 'both', -expand => '1',); my $rscore = $f1->Label(-textvariable => \$rightscore, -bg => 'black', +-fg =>'red')-> pack( -side => 'left', -fill => 'both', -expand => '1',); MainLoop; sub start { $zinc->itemconfigure($message,-visible => 0); $zinc->itemconfigure($text,-visible => 0); $checkl->configure(state =>'disable'); $checkr->configure(state =>'disable'); if($lauto == 1){$mw->Tk::bind('<a>', sub{}); $mw->Tk::bind('<z>', sub{}); } if($rauto == 1){$mw->Tk::bind('<k>', sub{}); $mw->Tk::bind('<m>', sub{}); } $randx = 10 + int rand(5); $randy = 5 + int rand(2); $dx = $randx; $dy = $randy; $count =0; $motion_flag = 1; $mw->Tk::bind('<Return>', sub{}); &startaction; } sub stopaction{ $motion_flag = 0; $mw->Tk::bind('<Return>', \&start); } sub startaction { $mw->Tk::bind('<Escape>', \&stopaction); push (@hits,shift(@hits)); #circular list to modify ball movement $dx = $randx; $dy = $randy; #print "$dx $dy\n"; # for debugging if($serve eq 'left'){$zinc->translate($pong,int rand (100),0);$serve = + '';} if($serve eq 'right'){$dx = -$dx; $zinc->translate($pong,600 - int rand (100),0);$serve = '';} my($x1,$y1,$xc1,$yc1) = $zinc->bbox($pong); #print "pong-> $x1 $y1 $xc1 $yc1\n"; #for debugging my($xl,$yl)= $zinc->coords($leftgroup); #print "leftpaddle ->$yl\n"; #for debugging my($xr,$yr)= $zinc->coords($rightgroup); #print "rightpaddle ->$yr\n"; #for debugging my $mid = $y1/2 + $yc1/2; #midpoint of pong ball if($up){$dy = -$dy}; if($left){$dx = -$dx} $zinc->translate($pong,$dx,$dy); if($rauto == 1){$zinc->translate($rightgroup,0,$mid - $yr)} if($lauto == 1){$zinc->translate($leftgroup,0,$mid - $yl)} if($y1 <= 0){$up = 0} #top bounce if($y1 >= 535){$up = 1}; #bottom bounce #if($x1 >= 680){$left = 1} #right bounce if(($xc1 >= 680)and((($mid)<($yr+20))and(($mid)>($yr-20)))) {$left = 1; $randx = $randx + 2*$hits[0]/$randx; $randy = $randy + 2*$hits[0]/$randy; } elsif($xc1 >=700){&win('left')} #if($x1 <= 0){$left = 0} #left bounce if(($x1 <= 20)and((($mid)<($yl+20))and(($mid)>($yl-20)))) {$left = 0; $randx = $randx + 2*$hits[0]/$randx; $randy = $randy + 2*$hits[0]/$randy; } elsif($x1<=0){&win('right')} if($motion_flag == 1){ $zinc->after($delay, sub {startaction()})} else {return} } sub resetpos{ $zinc->treset($pong); } # Just display comment sub comment { $zinc->itemconfigure($message,-visible => 1); $zinc->itemconfigure($text,-visible => 1); my $string = shift; $zinc->itemconfigure($text, -text => $string); } # display win sub win { my $string = shift; if($string eq 'left'){$leftscore++;$serve = 'left';$left = 0} if($string eq 'right'){$rightscore++;$serve = 'right';$left = 1} $mw->update; print ("\007"); &comment("Hit Enter to begin. $serve is serving Up arrow inreases speed Down arrow decreases speed Escape to pause "); $motion_flag=0; $zinc->treset($pong); $mw->Tk::bind('<Return>', sub{$motion_flag = 1;&start}); } sub newgame{ $motion_flag = 0; $count = 0; ($leftscore,$rightscore)=(0,0); ($up,$left)=(0,0); $serve = 'left'; my $lauto = 0; my $rauto = 0; &comment("Hit Enter to begin. $serve is serving Up arrow inreases speed Down arrow decreases speed Escape to pause "); $checkl->configure(state =>'normal'); $checkr->configure(state =>'normal'); $motion_flag=0; $zinc->treset($pong); $mw->update; $mw->Tk::bind('<Return>', sub{$motion_flag = 1;&start}); }

In reply to PONG with TkZinc by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (4)
    As of 2020-10-28 08:35 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My favourite web site is:












      Results (260 votes). Check out past polls.

      Notices?