Prima-Image-Magick
view release on metacpan or search on metacpan
Revision history for Perl extension Prima::Image::Magick.
0.01 - original version
0.02 - copy Image::Magick namespace into Prima::Image
0.03 - build on win32
0.04-5 - upgrade for recent versions of ImageMagick
0.06 - force-convert 16-bit (and higher) image data into 8-bits
0.07 - compatibility fixes
0.08 - compatibility fixes
{
"abstract" : "Juggle images between Prima and Image::Magick",
"author" : [
"Dmitry Karasik <dmitry@karasik.eu.org>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010",
"license" : [
"unknown"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"ExtUtils::MakeMaker" : "0"
}
},
"configure" : {
"requires" : {
"ExtUtils::MakeMaker" : "0"
}
},
"runtime" : {
"requires" : {
"Image::Magick" : "0",
"Prima" : "0"
}
}
},
"release_status" : "stable",
"version" : "0.08",
"x_serialization_backend" : "JSON::PP version 2.27400_02"
}
---
abstract: 'Juggle images between Prima and Image::Magick'
author:
- 'Dmitry Karasik <dmitry@karasik.eu.org>'
build_requires:
ExtUtils::MakeMaker: '0'
configure_requires:
ExtUtils::MakeMaker: '0'
dynamic_config: 1
generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010'
license: unknown
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: '1.4'
name: Prima-Image-Magick
no_index:
directory:
- t
- inc
requires:
Image::Magick: '0'
Prima: '0'
version: '0.08'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
#include "perl.h"
#include "XSUB.h"
#include "prima.h"
#include <magick/MagickCore.h>
#include "mag.h"
#ifdef __cplusplus
}
#endif
MODULE = Prima::Image::Magick PACKAGE = Prima::Image::Magick
BOOT:
{
prima_bootcheck();
}
void
convert_to_magick(prima_image,magick_image)
PROTOTYPE: DISABLE
PPCODE:
dst_bpp = 24;
} else {
croak("Cannot convert this image type to magick");
}
bitcopyproc = get_prima_bitcopy_proc( pim.category, pim.bpp, dst_bpp );
/* prepare magick image */
sv = SvRV( ST( 1));
if ( SvTYPE( sv) != SVt_PVAV)
croak("Image::Magick object is not SVt_PVAV");
hv = ( HV*) SvSTASH( sv);
av = ( AV*) sv;
if (( info = AcquireImageInfo()) == NULL)
croak("cannot AcquireMagickInfo()");
info-> colorspace = colorspace;
sprintf( info-> size = sizebuf, "%dx%d", pim. width, pim. height);
ip = AcquireImage( info);
info-> size = NULL;
DestroyImageInfo( info);
if ( ip == NULL)
)) {
free( buffer);
DestroyImage( ip);
magick_croak("ImportImagePixels", &ip-> exception);
}
#if MagickLibVersion > 0x676
ip->colorspace = colorspace;
#endif
free( buffer);
/* store as Image::Magick object */
sv = newSViv(( IV) ip);
av_push( av, sv_bless( newRV( sv), hv));
SvREFCNT_dec( sv);
}
void
convert_to_prima(magick_image,prima_image)
PROTOTYPE: DISABLE
PPCODE:
{
#endif
unsigned char * buffer;
SV * sv, **ssvv;
AV * av;
long n;
/* get down to imagemagick object */
sv = SvRV( ST(0));
if ( SvTYPE( sv) != SVt_PVAV)
croak("Image::Magick object is not an array");
av = ( AV*) sv;
n = av_len( av);
switch ( n) {
case -1:
croak("Image::Magick object is empty");
case 0:
if ( !( ssvv = av_fetch(av,0,0)))
croak("cannot fetch image from Image::Magick object");
sv = *ssvv;
if ( !sv || !sv_isobject(sv) || SvTYPE(SvRV(sv)) != SVt_PVMG)
croak("Image from Image::Magick object is invalid");
ip = ( Image *) SvIV( SvRV( sv));
break;
default:
croak("Image::Magick object contains more than one image, unsupported");
}
/* prepare prima object */
allocate_prima_image(
ST( 1),
ip-> columns,
ip-> rows,
ip-> colorspace != GRAYColorspace
);
read_prima_image_data( ST( 1), &pim);
Makefile.PL view on Meta::CPAN
my $v = $1;
$v =~ s/\.//g;
if ($v < 641) {
$magicklib = '-lMagick';
} elsif ( `pkg-config --libs MagickCore` =~ /^(.+)$/ ) {
$magicklib = $1;
}
}
WriteMakefile(
NAME => 'Prima::Image::Magick',
VERSION_FROM => 'lib/Prima/Image/Magick.pm',
PREREQ_PM => {
'Prima' => 0,
'Image::Magick' => 0,
},
ABSTRACT_FROM => 'lib/Prima/Image/Magick.pm',
AUTHOR => 'Dmitry Karasik <dmitry@karasik.eu.org>',
LIBS => [ "$l $magicklib" ],
DEFINE => $d,
INC => $i,
OBJECT => "prima\$(OBJ_EXT) mag\$(OBJ_EXT) Magick\$(OBJ_EXT)",
);
Prima-Image-Magick version 0.01
==============================
Prima::Image::Magick - Juggle images between Prima and Image::Magick
INSTALLATION
To install this module type the following:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
Prima
Image::Magick
COPYRIGHT AND LICENCE
Copyright (C) 2007 by Dmitry Karasik
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.
example/example.pl view on Meta::CPAN
use lib qw(./blib/lib ./blib/arch);
use Prima qw(Application ImageViewer Label);
use Image::Magick;
use Prima::Image::Magick qw(:all);
my $p = Prima::Image-> new( width => 10, height => 10);
$p-> begin_paint;
$p-> clear;
$p-> line(0,0,9,9);
$p-> line(0,9,9,0);
$p-> end_paint;
my @types;
example/example.pl view on Meta::CPAN
my $gaussian = $p-> dup;
$gaussian-> Resize( width => 100, height => 100, filter => 'Gaussian');
push @types, [ $gaussian, 'gaussian' ];
my $cubic = $p-> dup;
$cubic-> Resize( width => 100, height => 100, filter => 'Cubic');
push @types, [ $cubic, 'cubic' ];
Prima::MainWindow-> new(
text => 'Prima::Image::Magick demo',
)-> insert( map {
[ 'Prima::Label' =>
pack => { expand => 1, fill => 'both' },
text => "$$_[1] scaling"
], [ 'Prima::ImageViewer' =>
pack => { expand => 1, fill => 'both' },
image => $$_[0]
] } @types
);
lib/Prima/Image/Magick.pm view on Meta::CPAN
# $Id: Magick.pm,v 1.6 2012/01/03 16:47:16 dk Exp $
package Prima::Image::Magick;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( prima_to_magick magick_to_prima );
our %EXPORT_TAGS = ( all => \@EXPORT_OK );
our $VERSION = '0.08';
require XSLoader;
XSLoader::load('Prima::Image::Magick', $VERSION);
use Prima;
use Image::Magick;
# proxy Image::Magick methods into Prima::Image
{
no strict 'refs';
my $v = join('|', @Image::Magick::EXPORT);
my $package = 'Image::Magick';
if (my @isa = grep { /Image::Magick/ } @Image::Magick::ISA) {
$package = $isa[0];
}
my %d = map { $_ => 1 } grep { !/^([a-z_].*|[A-Z_]+|$v|Prima)$/ } keys %{$package . '::'};
# delete aliases
for my $meth ( keys %d) {
if ( exists $d{"${meth}Image"}) {
delete $d{"${meth}Image"};
next;
}
}
lib/Prima/Image/Magick.pm view on Meta::CPAN
exists $self-> {__ImageMagickStorage} and
0 == $self-> {__ImageMagickStorage}->[0]--;
convert_to_prima( $self-> {__ImageMagickStorage}->[1], $self);
delete $self-> {__ImageMagickStorage};
}
sub prima_to_magick
{
my ( $p) = @_;
die "Not a Prima::Image object" unless $p and $p->isa('Prima::Image');
my $m = Image::Magick-> new();
convert_to_magick( $p, $m);
$m;
}
sub magick_to_prima
{
my ( $m, %h) = @_;
die "Not an Image::Magick object" unless $m and $m->isa('Image::Magick');
my $p = Prima::Image-> new;
convert_to_prima( $m, $p);
$p;
}
*Prima::Image::Magick = \&prima_to_magick;
*Image::Magick::Prima = \&magick_to_prima;
1;
__END__
=head1 NAME
Prima::Image::Magick - Juggle images between Prima and Image::Magick
=head1 SYNOPSIS
use Prima::Image::Magick;
my $i = Prima::Image-> new( ... ); # native prima images
$i-> MedianFilter( radius => 5); # can call Image::Magick methods
=head1 DESCRIPTION
Allows transformations between L<Prima> images and L<Image::Magick> images.
Exports all methods found on C<Image::Magick> into C<Prima::Image> space, thus
opening the possibilities of ImageMagick for Prima images.
=head1 Prima::Image API
The mutator methods found on C<Image::Magick> namespace are wrapped and
imported into C<Prima::Image> space, so that an image is implictly converted
to C<Image::Magick> and back, so that for example
$prima_image-> Edge( radius => 5);
is actually the same as
my $m = prima_to_magick( $prima_image);
$m-> Edge( radius => 5);
$prima_image = magick_to_prima( $m);
except that C<$prima_image> internally remains the same perl object.
lib/Prima/Image/Magick.pm view on Meta::CPAN
$prima_image-> EndMagick;
is same as
my $m = prima_to_magick( $prima_image);
$m-> Edge( radius => 5);
$m-> Enhance;
$prima_image = magick_to_prima( $m);
=head1 Prima::Image::Magick API
=over
=item prima_to_magick $magick_image
Returns a deep copy of C<$magick_image> stored in a new instance of C<Prima::Image>
object. C<$magick_image> must contain exactly one ImageMagick bitmap. This means that
empty objects and objects f.ex. after C< Read('file1', 'file2') > cannot be used here.
Use C<Image::Magick::Deconstruct> to break image sequence into constituent parts.
Exported either by explicit request or as a part of C<use Prima::Image::Magick ':all'> call.
=item prima_to_magick $prima_image
Returns a deep copy of C<$prima_image> stored in a new instance of C<Image::Magick>
object.
Exported either by explicit request or as a part of C<use Prima::Image::Magick ':all'> call.
=item convert_to_magick $prima_image, $magick_image
Copies content of C<$prima_image> to C<$magick_image>. Not to be called directy
unless really necessary; the method is not exported, and its syntax may change
in future.
=item convert_to_prima $magick_image, $prima_image
Copies content of C<$magick_image> to C<$prima_image>. Not to be called directy
unless really necessary; the method is not exported, and its syntax may change
in future.
=back
=head1 SEE ALSO
L<Prima>, L<Image::Magick>, L<examples/example.pl>.
=head1 AUTHOR
Dmitry Karasik, E<lt>dmitry@karasik.eu.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2007 by Dmitry Karasik
This library is free software; you can redistribute it and/or modify
t/Prima-Image-Magick.t view on Meta::CPAN
use Test::More tests => 18;
eval {
use Prima::noX11;
require Prima;
};
ok(not($@), 'require Prima'); warn $@ if $@;
eval {
require Prima::Image::Magick;
};
ok(not($@), 'require Prima::Image::Magick'); warn $@ if $@;
use Prima::Image::Magick qw(:all);
my $i = Prima::Image-> new(
width => 4,
height => 4,
type => im::Byte,
data =>
'*** '.
'* *'.
'*** '.
'* '
t/Prima-Image-Magick.t view on Meta::CPAN
{
my ( $i, $type, $typedesc, $typecmp) = @_;
$i = $i-> dup;
$i-> type( $type);
my $m;
eval {
$m = prima_to_magick( $i);
};
ok(( not($@) and $m and ref($m) eq 'Image::Magick'), "prima_to_magick $typedesc");
warn $@ if $@;
my $j;
eval {
$j = magick_to_prima( $m);
};
ok(( not($@) and $j and ref($j) eq 'Prima::Image'), "magick_to_prima $typedesc");
warn $@ if $@;
( run in 1.249 second using v1.01-cache-2.11-cpan-beeb90c9504 )