Tuesday, 29 July 2014

"Hey, I could probably automate that in perl, and make it a game."

cat kitten sword robot space pink white bumblebee bee helmet

Code under the cut.  Rules for the game:  player one chooses an image, and the other players need to come up with descriptive words for what's on it.  Then, you run the command on the best set of words (maybe you don't want to use all of them because you end up with legos.  Maybe you get points if you only use like 1 word, but if you use 9 or more, but get legos, you lose points).  If the image itself, or the character, or an obviously "these images are related somehow" match happens, then the seekers get the point.  If not, then the player who chose the original image gets a point.  So under these rules, the Bee and Puppycat image gets a point, and I lose two points because I didn't find B&PC, and I ended up with legos when I used 10 words.



#! /usr/bin/perl -w
use URI::Escape;
use LWP::UserAgent;
use Data::Dumper;
use HTML::Parser;
use Getopt::Std;
use POSIX;

# How many images to montage.
$opts{m} = 16;
getopts('m:',\%opts);

# Get the words
my @words = @ARGV;
my $q_string = join '+', @words;

# Generate the image search file url
my $url = 'https://www.google.com/search?q=QUERYQUERY&safe=off&tbm=isch';
$url =~ s/QUERYQUERY/$q_string/;

# Get the request.
my $ua = LWP::UserAgent->new;
$ua->agent('Mozilla/5.0 (Windows NT 6.2; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/32.0.1667.0 Safari/537.36');
my $response = $ua->get($url);


# Parse out until we only have an array of the image files
if ($response->is_success) {
    $data = $response->content;
    $data =~ s/\n//g;
    
    @split = split /<img/, $response->content;
    $split[0] = '';
    
    @images = ();
    foreach $part (@split) {
        if ($part =~ /src/) {
            $part =~ s/onload.*$//;
            if ($part =~ /div/) { $part = ""; }
            my $file = $part;
            $file =~ s/^.*src="//;
            $file =~ s/".*$//;
            if ($file =~ /http/) {
                print "$file\n";
                push @images, $file;
            }
        }
    }
}

# Setup the output
mkdir("/tmp/w2i/");

# Construct the Command to montage them all together.

$tile = '';
if (sqrt($opts{m}) - int(sqrt($opts{m})) == 0) {
    $tile = sqrt($opts{m}) . "x" . sqrt($opts{m});
}
else {
    $tile = floor(sqrt($opts{m})) . "x" . ceil(sqrt($opts{m}));
}
$cmd = "montage -geometry 200x200+2+2 -tile $tile -frame 2 -border 2 ";

# Randomly select from the 100 we know of, and choose m of them randomly, and download the file.
%filter = (); # Exclude if we randomly choose badly
for ($i = 0; $i < $opts{m}; $i++) {
    my $file;
    do { $file = $images[rand @images];}
    while (exists($filter{$file}));
    $filter{$file} = 1;
    
    print "$file\n";
    system("wget -q $file -O /tmp/w2i/$i.jpg");
    $cmd .= " /tmp/w2i/$i.jpg ";
}

# Do it.
system("$cmd /tmp/w2i/${q_string}.jpg");

No comments:

Post a Comment