All pastes #97401 Raw Edit

Mr_Person

public text v1 · immutable
#97401 ·published 2006-07-23 18:14 UTC
rendered paste body
#!/usr/bin/perl

use strict;
use warnings;

use Image::Magick;

my @rectangles;

my $image = Image::Magick->new();

print "Read " . int($image->Read('in.bmp')) . " image(s).\n";
my ($width, $height) = $image->Get('columns', 'rows');
print "Image is " . $width . "x" . $height . "\n";
$image->Separate(channel=> 'Blue');
$image->Threshold(threshold => 50000);
#$image->Set(depth => 16, colorspace => 'RGB');
my $raw = $image->ImageToBlob(magick => 'GRAY', depth => 8);
my @bits = unpack('C*', $raw);
#$image = Image::Magick->new();
#$image->Set(size => $width . 'x' . $height);
#$image->ReadImage('xc:black');
foreach my $x (0..$width-1) {
        foreach my $y (0..$height-1) {
                my $point = "$x,$y";
                my $pixel = $bits[$y*$width + $x];
                if($pixel > 0) {
                        $image->Draw(primitive => 'point', points => $point, fill => 'green');
                        processPoint($x, $y);
                }
        }
}
print "Found " . scalar(@rectangles) . " rectangle(s).\n";
foreach(@rectangles) {
        #$image->Draw(primitive => 'rectangle', points => "$_->[0],$_->[1] $_->[2],$_->[3]", stroke => 'green', fill => 'none');
        $image->Draw(primitive => 'line', points => "$_->[0],$_->[1] $_->[2],$_->[1]", stroke => 'green');
        my $x = $_->[0] + (($_->[2] - $_->[0])/2);
        my $y = $_->[1] + (($_->[3] - $_->[1])/2);
        $image->Draw(primitive => 'point', points => "$x,$y", fill => 'blue');
        $image->Draw(primitive => 'point', points => "$x,$y", fill => 'red');
}
$image->Write(filename=>'out.bmp');

sub processPoint {
        my ($x, $y) = @_;

        my $foundRectangle = 0;
        foreach(@rectangles) {
                if(inRectangle($_, $x, $y)) {
                        $foundRectangle = 1;
                        last;
                }
        }

        if(!$foundRectangle) {
                push @rectangles, [$x,$y,$x,$y];
        }
}

sub inRectangle {
        my ($rectangle, $x, $y) = @_;

        if($x >= $rectangle->[0] - 1 && $x <= $rectangle->[2] + 1 &&
                $y >= $rectangle->[1] - 1 && $y <= $rectangle->[3] + 1) {

                if($x < $rectangle->[0]) {
                        $rectangle->[0] = $x;
                } elsif($x > $rectangle->[2]) {
                        $rectangle->[2] = $x;
                }

                if($y < $rectangle->[1]) {
                        $rectangle->[1] = $y;
                } elsif($y > $rectangle->[3]) {
                        $rectangle->[3] = $y;
                }

                return 1;
        } else {
                return 0;
        }
}