Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl -w use strict; use Socket; use IO::Socket; use Tk; #This program sends UDP packets on port 9628 which the astute will not +ice #spells out "WMBT" on any common telephone keypad. my $y=0; #Y position of the paddle. my $dir=0; #Direction the paddle should move. my @ballstat= (0,0,0,0); #(X,Y,dx,dy) my $ball = <<'END_OF_BALL_DATA'; /* XPM */ static char * BALL_xpm[] = { "10 10 1 1", "W c #FFFFFFFFFFFF", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW"}; END_OF_BALL_DATA my $paddle = <<'END_OF_PIXMAP_DATA'; /* XPM */d static char * PADDLE_xpm[] = { "10 80 1 1", "W c #FFFFFFFFFFFF", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW", "WWWWWWWWWW"}; END_OF_PIXMAP_DATA my ($him, $width, $height, $multiplier, $left, $player); #Set this to 0 for the left/starting side, 1 for the right, receiving +side. $left = 0; #CHANGE this if the monitors have different resolutions. Multiplier s +hould #be (Height of this monitor) / (Height of other monitor) For me, on th +is #machine, that's 1.36. The other machine should be set to 1.0. $multiplier = 1.0; #Set this to the IP address of the other machine. $player = "192.168.0.1"; socket(SOCKET, PF_INET, SOCK_DGRAM, getprotobyname("udp")); my $server = IO::Socket::INET->new(LocalPort => 9628, Proto => "udp") or die "Couldn't be a udp server on port 9628 : $@\n"; my $pw = MainWindow->new(-background=>"#FFFFFF"); my $bw = MainWindow->new(-background=>"#FFFFFF"); $width = $pw->screenwidth; $height = $pw->screenheight; print("I read a resolution of $width x $height\n"); $pw->Label(-image => $pw->Pixmap(-data => $paddle))->pack; $bw->Label(-image => $bw->Pixmap(-data => $ball))->pack; $pw->overrideredirect(1); $bw->overrideredirect(1); if ($left) {$bw->withdraw();} else { @ballstat=($width/2,$height/2,5,3); } while(1){ select(undef,undef,undef,.02); #The poor man's HiRes sleep timer. if($y==0) {$dir++;$y+=3;} if($y==$height-40) {$dir--;$y-=3;} if($ballstat[1]+5>$y+40) {$y+=3;} else {$y-=3;} if($ballstat[1]<=0){$ballstat[3]*=-1;} if($ballstat[1]>=$height-20){$ballstat[3]*=-1;} if(($left)&&($ballstat[0]<=0)) { &send_and_receive(); } if(!($left)&&($ballstat[0]>=$width-10)) { &send_and_receive(); } if (($left) && ($ballstat[0]>=$width-10)){$ballstat[2]*=-1;} if (!($left) && ($ballstat[0]<=0)){$ballstat[2]*=-1;} $ballstat[0]+=$ballstat[2]; $ballstat[1]+=$ballstat[3]; $pw->geometry("+".(($width-10)*$left)."+$y"); $bw->geometry("+".$ballstat[0]."+".$ballstat[1]); $pw->update; $bw->update; } sub send_and_receive { $ballstat[1] /= $multiplier; #Differences in resolution; $ballstat[1]%=$height; if ($ballstat[3]<0) { $ballstat[1]-=(2*$ballstat[1]); } send(SOCKET, $ballstat[1], 0, sockaddr_in(9628,inet_aton("$player")) +) == length ( $ballstat[1]) or die "Can't send the UDP packet!\n$!\n"; $bw->withdraw(); $ballstat[2] = 0; $ballstat[3] = 0; while ($him = $server->recv($ballstat[1], 4, 0)) { print "@ballstat $ballstat[1] received!\n"; $ballstat[1]*=$multiplier; #Because of differences in resolution. + :-P if ($ballstat[1] > $height) { $ballstat[1] = $height; } if ($left) {$ballstat[2]=5;} else {$ballstat[2]=-5;} $ballstat[3]=3; if ($ballstat[1]<0) { $ballstat[1]-=(2*$ballstat[1]); $ballstat[3]*=-1; } $ballstat[1]%=$height; $bw->deiconify(); $bw->raise(); last; } }

In reply to Trans-OS PONG simulator! by wombat

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



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others exploiting the Monastery: (3)
As of 2024-03-19 05:49 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found