develooper Front page | perl.golf | Postings from January 2005

Feel free to shrink this bit of silliness

From:
Phil Carmody
Date:
January 7, 2005 00:48
Subject:
Feel free to shrink this bit of silliness
Message ID:
20050107084751.2788.qmail@web25402.mail.ukl.yahoo.com
I threw this together last night just for fun, and I reckon that
it could probably be made pretty tiny; particularly if the numeric 
command-line arguments were ditched and turned into constants 
(24 lines of 72 chars, say), and maybe if the selection of sweetie
types was scrapped, and just '@' used.

My intended use is as spoiler space in puzzle newsgroups, something 
like the following:

$ ./candies.pl 72 20 .1 'Have a sweetie as you scroll past'

Anyway, here it is, in fully-verbose form.


#!/usr/bin/perl -Tw

my $w=int(shift @ARGV);
my $h=int(shift @ARGV);
my $n=shift(@ARGV);
my $message=' '.join(' ', @ARGV).' ';
my $meslen=length($message);
if($n<1) { $n=int(($w*$h-3*$meslen)*$n/3); }

my @sweeties=('@','@','@','O','#');

my @canvas=('�'x$w)x$h;
my $margin=($w-$meslen)>>1;

substr($canvas[$h/2-1],$margin-1,$meslen)=' 'x$meslen;
substr($canvas[$h/2],$margin-1,$meslen)=$message;
substr($canvas[$h/2+1],$margin-1,$meslen)=' 'x$meslen;

while($n--) 
{
    my $sweetie=$sweeties[int(rand(@sweeties))];
    if(rand()<0.8)
    {
        # horizontal
        my($x,$y) = (int(rand($h)), int(rand($w-2)));
        if(substr($canvas[$x],$y,3) eq '���') {
substr($canvas[$x],$y,3)=">$sweetie<"; }
    }
    else
    {
        # vertical
        my($x,$y) = (int(rand($h-2)), int(rand($w)));
        if((substr($canvas[$x],$y,1) eq '�') &&
            (substr($canvas[$x+1],$y,1) eq '�') &&
            (substr($canvas[$x+2],$y,1) eq '�')) 
        { 
            substr($canvas[$x],$y,1)='v'; 
            substr($canvas[$x+1],$y,1)=$sweetie; 
            substr($canvas[$x+2],$y,1)='^'; 
        }
    }
}
map{$_=~tr/�/ /}(@canvas);
print join("\n", @canvas), "\n";


Phil

=====
When inserting a CD, hold down shift to stop the AutoRun feature
In the Device Manager, disable the SbcpHid device.
http://www.cs.princeton.edu/~jhalderm/cd3/


		
__________________________________ 
Do you Yahoo!? 
The all-new My Yahoo! - Get yours free! 
http://my.yahoo.com 
 




nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About