Image-Magick-PixelMosaic

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Perl extension Image::Magick::PixelMosaic.

0.00_01  Sun Jun 22 02:33:18 2008
  - original version; created by h2xs 1.23 with options
    -B -X Image::Magick::PixelMosaic

0.01 Thu Jun 26 2008 (JST)
  - first release

0.02 Fri Jun 27 2008 (JST)
  - removed requirment for perl version.
  - changed/fixed POD comment.
  - appended POD test.

0.03 Fri Jul 04 2008 (JST)
  - fixed requested Image::Magick version (-> 6.2.4)
  - append test case t/04_pod_coverage.t
  - modify normalize parmaeter value for Image::Magick->getPixels
  - change my email address (use cpan.org)

META.yml  view on Meta::CPAN

# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
name:         Image-Magick-PixelMosaic
version:      0.03
version_from: lib/Image/Magick/PixelMosaic.pm
installdirs:  site
requires:
    Image::Magick:                 6.2.4

distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.30_01

Makefile.PL  view on Meta::CPAN

use ExtUtils::MakeMaker;
WriteMakefile(
    NAME              => 'Image::Magick::PixelMosaic',
    VERSION_FROM      => 'lib/Image/Magick/PixelMosaic.pm',
    PREREQ_PM         => {
      Image::Magick => q/6.2.4/
    }, # e.g., Module::Name => 1.1
    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
      (ABSTRACT_FROM  => 'lib/Image/Magick/PixelMosaic.pm', # retrieve abstract from module
       AUTHOR         => 'KATOU Akira <turugina@cpan.org>') : ()),
);

README  view on Meta::CPAN

   perl Makefile.PL
   make
   make test
   make install

DEPENDENCIES

This module requires these other modules and libraries:

  Image::Magick

COPYRIGHT AND LICENCE


Copyright (C) 2008 by KATOU Akira (turugina)

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.

lib/Image/Magick/PixelMosaic.pm  view on Meta::CPAN

package Image::Magick::PixelMosaic;

use strict;
use warnings;

our $VERSION = '0.03';
$VERSION = eval $VERSION;  # see L<perlmodstyle>

use Image::Magick;

=head1 NAME

Image::Magick::PixelMosaic - Pixelized mosaic filter for Image::Magick.

=head1 SYNOPSIS

  use Image::Magick;
  use Image::Magick::PixelMosaic;

  my $img = Image::Magick->new;
  $img->Read('hoge.jpg');
  my $pix = Image->Magick::PixelMosaic->new;
  $pix->src($img);

  # generates 4x4 pixelized mosaic on area (100,120)-(180,160)
  $pix->pixelize('80x40+100+120', [4,4]);

    
=head1 DESCRIPTION

This module generates pixelized mosaic on parts of images using L<Image::Magick>.

=head1 METHODS

=over 3

=item new [src => $obj]

Creates an C<Image::Magick::PixelMosaic> object.

Optional C<src> parameter expects C<Image::Magick> object.

  my $pix = Image::Magick::PixelMosaic->new(src => $img);

is equal to

  my $pix = Image::Magick::PixelMosaic->new;
  $pix->src($img);

=item src, src($obj)

Get or set Image::Magick object.

=item pixelize C<geometry> => I<geometry>, C<pixelsize> => I<pixel width&height>

Generates pixelized mosaic on specified geometry.

C<geomerty> must be specified as geometry form I<'WxH+X+Y'>.

C<pixelsize> must be specified as one of 'WxH', [W,H] or W (height==width).

All of W, H, X and Y must be non-negative integer.

lib/Image/Magick/PixelMosaic.pm  view on Meta::CPAN

When height/width of image are '20x30' and

  $pix->pixelize('20x20+1+5', [4,6])

is called, efefctive pixelized area will be '16x24+1+5'.

=back

=head1 SEE ALSO

L<Image::Magick>

=head1 TODO

accept width/heigh/x/y options.

more pixel color decision algorithm (currently use average of pixel area)

=head1 AUTHOR

KATOU Akira (turugina) E<lt>turugina@cpan.orgE<gt>

lib/Image/Magick/PixelMosaic.pm  view on Meta::CPAN

  $self->src($opt_{src}) if exists $opt_{src};

  return $self;
}

sub src
{
  my ($self, $obj) = @_;

  if ( $obj ) {
    if (!$obj->isa('Image::Magick')) {
      die "specified object is not an Image::Magick";
    }
    $self->{src} = $obj;
  }
  return $self->{src};
}

sub pixelize
{
  my ($self, %opt) = @_;

  if (!$self->{src}) {
    die q/source Image::Magick object must be set before calling pixelize()/;
  }
  my $img = $self->{src};

  my ($geo,$psize) = @opt{qw/geometry pixelsize/};

  if (!$geo) {
    die q/geometry must be specified/;
  }
  if (!$psize) {
    die q/pixel size must be specified/;

t/00_prereqs.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 2;
BEGIN { use_ok(q/Image::Magick/) };
BEGIN { use_ok(q/Image::Magick::PixelMosaic/) };

t/01_property.t  view on Meta::CPAN

use strict;
use warnings;

package Dummy;
sub new { bless [],$_[0] }

package main;

use Test::More tests => 13;

use Image::Magick;
use Image::Magick::PixelMosaic;

## new 1
my $pix = Image::Magick::PixelMosaic->new;
ok( $pix );
is( $pix->src, undef );

undef $pix;


## new 2
my $img = Image::Magick->new;
$pix = Image::Magick::PixelMosaic->new(src=>$img);
ok( $pix );
is( ref $pix->src, ref $img );

$pix = Image::Magick::PixelMosaic->new(src=>undef);
ok( $pix );
is( $pix->src, undef );

undef $pix;

## new (type error)
$@ = undef;
eval { Image::Magick::PixelMosaic->new(src=>Dummy->new) };
ok ( $@ );


## src
$pix = Image::Magick::PixelMosaic->new;
is( $pix->src, undef );
is( ref $pix->src($img), ref $img );
is( ref $pix->src, ref $img );
is( ref $pix->src(undef), ref $img );
is( ref $pix->src, ref $img );

## src (type error)
$@ = undef;
eval { $pix->src(Dummy->new); };
ok ( $@ );

t/02_pixelize.t  view on Meta::CPAN

use strict;
use warnings;

use Test::More tests => 14;

use Image::Magick;
use Image::Magick::PixelMosaic;

my $pix = Image::Magick::PixelMosaic->new;


my $img = _create_img([4,4],
  [[0xf00000, 0x00f000, 0x0, 0x0],
   [0x0000f0, 0x0,      0x0, 0x0],
   [0x0,      0x0,      0x0, 0x0],
   [0x0,      0x0,      0x0, 0x0]]);

$pix->src($img);

t/02_pixelize.t  view on Meta::CPAN

$pxs = _get_pixels($img);
is( scalar(grep { $_ == 0xf00000 } @$pxs[0,3,6,9,12,15,18,21,24]), 9 );
is( scalar(grep { $_ == 0x00f000 } @$pxs[1,4,7,10,13,16,19,22]), 8 );
is( scalar(grep { $_ == 0x0000f0 } @$pxs[2,5,8,11,14,17,20,23]), 8 );

sub _create_img
{
  my ( $size, $pxs ) = @_;

  my $img = Image::Magick->new;
  $img->Read(q/xc:Black/);

  $img->Resize(geometry => join('x',@$size));

  my $y=0;
  for my $col ( @$pxs ) {
    my $x=0;
    for my $px ( @$col ) {
      $img->Set(qq/pixel[$x,$y]/ => sprintf("#%06x", $px));
    }