Image-Magick
view release on metacpan or search on metacpan
% February 1997 %
% %
% %
% Copyright @ 1999 ImageMagick Studio LLC, a non-profit organization %
% dedicated to making software imaging solutions freely available. %
% %
% You may not use this file except in compliance with the License. You may %
% obtain a copy of the License at %
% %
% https://imagemagick.org/script/license.php %
% %
% Unless required by applicable law or agreed to in writing, software %
% distributed under the License is distributed on an "AS IS" BASIS, %
% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. %
% See the License for the specific language governing permissions and %
% limitations under the License. %
% %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% PerlMagick is an objected-oriented Perl interface to ImageMagick. Use
% the module to read, manipulate, or write an image or image sequence from
% within a Perl script. This makes PerlMagick suitable for Web CGI scripts.
%
*/
/*
Include declarations.
*/
#if defined(__cplusplus) || defined(c_plusplus)
extern "C" {
#endif
#define PERL_NO_GET_CONTEXT
#include <MagickCore/MagickCore.h>
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <math.h>
#undef tainted
#if defined(__cplusplus) || defined(c_plusplus)
}
#endif
/*
Define declarations.
*/
#ifndef aTHX_
#define aTHX_
#define pTHX_
#define dTHX
#endif
#define DegreesToRadians(x) (MagickPI*(x)/180.0)
#define EndOf(array) (&array[NumberOf(array)])
#define MagickPI 3.14159265358979323846264338327950288419716939937510
#define MaxArguments 35
#ifndef na
#define na PL_na
#endif
#define NumberOf(array) (sizeof(array)/sizeof(*array))
#define PackageName "Image::Magick"
#if PERL_VERSION <= 6
#define PerlIO FILE
#define PerlIO_importFILE(f, fl) (f)
#define PerlIO_findFILE(f) NULL
#endif
#ifndef sv_undef
#define sv_undef PL_sv_undef
#endif
#define AddImageToRegistry(sv,image) \
{ \
if (magick_registry != (SplayTreeInfo *) NULL) \
{ \
(void) AddValueToSplayTree(magick_registry,image,image); \
(sv)=newSViv(PTR2IV(image)); \
} \
}
#define DeleteImageFromRegistry(reference,image) \
{ \
if (magick_registry != (SplayTreeInfo *) NULL) \
{ \
if (GetImageReferenceCount(image) == 1) \
(void) DeleteNodeByValueFromSplayTree(magick_registry,image); \
image=DestroyImage(image); \
sv_setiv(reference,0); \
} \
}
#define InheritPerlException(exception,perl_exception) \
{ \
char \
message[MagickPathExtent]; \
\
if ((exception)->severity != UndefinedException) \
{ \
(void) FormatLocaleString(message,MagickPathExtent,"Exception %d: %s%s%s%s",\
(exception)->severity, (exception)->reason ? \
GetLocaleExceptionMessage((exception)->severity,(exception)->reason) : \
"Unknown", (exception)->description ? " (" : "", \
(exception)->description ? GetLocaleExceptionMessage( \
(exception)->severity,(exception)->description) : "", \
(exception)->description ? ")" : ""); \
if ((perl_exception) != (SV *) NULL) \
{ \
if (SvCUR(perl_exception)) \
sv_catpv(perl_exception,"\n"); \
sv_catpv(perl_exception,message); \
} \
} \
}
#define ThrowPerlException(exception,severity,tag,reason) \
(void) ThrowMagickException(exception,GetMagickModule(),severity, \
tag,"`%s'",reason); \
/*
Typedef and structure declarations.
*/
typedef enum
{
NullReference = 0,
ArrayReference = (~0),
RealReference = (~0)-1,
FileReference = (~0)-2,
ImageReference = (~0)-3,
IntegerReference = (~0)-4,
StringReference = (~0)-5
} MagickReference;
typedef struct _Arguments
{
const char
*method;
ssize_t
type;
} Arguments;
struct ArgumentList
{
ssize_t
integer_reference;
double
real_reference;
const char
*string_reference;
Image
*image_reference;
SV
*array_reference;
FILE
*file_reference;
size_t
length;
};
struct PackageInfo
{
ImageInfo
*image_info;
};
typedef void
*Image__Magick; /* data type for the Image::Magick package */
/*
Static declarations.
*/
static struct
Methods
{
const char
*name;
Arguments
arguments[MaxArguments];
} Methods[] =
{
{ "Comment", { {"comment", StringReference} } },
{ "Label", { {"label", StringReference} } },
{ "AddNoise", { {"noise", MagickNoiseOptions}, {"attenuate", RealReference},
{"channel", MagickChannelOptions} } },
{ "Colorize", { {"fill", StringReference}, {"blend", StringReference} } },
{ "Border", { {"geometry", StringReference}, {"width", IntegerReference},
{"height", IntegerReference}, {"fill", StringReference},
{"bordercolor", StringReference}, {"color", StringReference},
{"compose", MagickComposeOptions} } },
{ "Blur", { {"geometry", StringReference}, {"radius", RealReference},
{"sigma", RealReference}, {"channel", MagickChannelOptions} } },
{ "Chop", { {"geometry", StringReference}, {"width", IntegerReference},
{"height", IntegerReference}, {"x", IntegerReference},
{"y", IntegerReference}, {"gravity", MagickGravityOptions} } },
{ "Crop", { {"geometry", StringReference}, {"width", IntegerReference},
{"height", IntegerReference}, {"x", IntegerReference},
{"y", IntegerReference}, {"fuzz", StringReference},
{"gravity", MagickGravityOptions} } },
{ "Despeckle", { { (const char *) NULL, NullReference } } },
{ "Edge", { {"radius", RealReference} } },
{ "Emboss", { {"geometry", StringReference}, {"radius", RealReference},
{"sigma", RealReference} } },
{ "Enhance", { { (const char *) NULL, NullReference } } },
{ "Flip", { { (const char *) NULL, NullReference } } },
{ "Flop", { { (const char *) NULL, NullReference } } },
{ "Frame", { {"geometry", StringReference}, {"width", IntegerReference},
{"height", IntegerReference}, {"inner", IntegerReference},
{"outer", IntegerReference}, {"fill", StringReference},
{"color", StringReference}, {"compose", MagickComposeOptions} } },
{ "Implode", { {"amount", RealReference},
{"interpolate", MagickInterpolateOptions} } },
{ "Magnify", { { (const char *) NULL, NullReference } } },
{ "MedianFilter", { {"geometry", StringReference},
{"width", IntegerReference}, {"height", IntegerReference},
{"channel", MagickChannelOptions} } },
{ "Minify", { { (const char *) NULL, NullReference } } },
{ "OilPaint", { {"radius", RealReference}, {"sigma", RealReference} } },
{ "ReduceNoise", { {"geometry", StringReference},
{"width", IntegerReference},{"height", IntegerReference},
{"channel", MagickChannelOptions} } },
{ "Roll", { {"geometry", StringReference}, {"x", IntegerReference},
{"y", IntegerReference} } },
{ "Rotate", { {"degrees", RealReference},
{"background", StringReference} } },
{ "Sample", { {"geometry", StringReference}, {"width", IntegerReference},
{"height", IntegerReference} } },
/*
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% %
% %
% %
% s t r E Q c a s e %
% %
% %
% %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% strEQcase() compares two strings and returns 0 if they are the
% same or if the second string runs out first. The comparison is case
% insensitive.
%
% The format of the strEQcase routine is:
%
% ssize_t strEQcase(const char *p,const char *q)
%
% A description of each parameter follows:
%
% o p: a character string.
%
% o q: a character string.
%
%
*/
static ssize_t strEQcase(const char *p,const char *q)
{
char
c;
ssize_t
i;
for (i=0 ; (c=(*q)) != 0; i++)
{
if ((isUPPER((unsigned char) c) ? toLOWER(c) : c) !=
(isUPPER((unsigned char) *p) ? toLOWER(*p) : *p))
return(0);
p++;
q++;
}
return(((*q == 0) && (*p == 0)) ? i : 0);
}
/*
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% %
% %
% %
% I m a g e : : M a g i c k %
% %
% %
% %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%
*/
MODULE = Image::Magick PACKAGE = Image::Magick
PROTOTYPES: ENABLE
BOOT:
MagickCoreGenesis("PerlMagick",MagickFalse);
SetWarningHandler(NULL);
SetErrorHandler(NULL);
magick_registry=NewSplayTree((int (*)(const void *,const void *))
NULL,(void *(*)(void *)) NULL,(void *(*)(void *)) NULL);
void
UNLOAD()
PPCODE:
{
if (magick_registry != (SplayTreeInfo *) NULL)
magick_registry=DestroySplayTree(magick_registry);
MagickCoreTerminus();
}
double
constant(name,argument)
char *name
ssize_t argument
#
###############################################################################
# #
# #
# #
# A n i m a t e #
# #
# #
# #
###############################################################################
#
#
void
Animate(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
AnimateImage = 1
animate = 2
animateimage = 3
PPCODE:
{
ExceptionInfo
*exception;
Image
*image;
ssize_t
i;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
package_info=(struct PackageInfo *) NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
package_info=ClonePackageInfo(info,exception);
if (items == 2)
SetAttribute(aTHX_ package_info,NULL,"server",ST(1),exception);
else
if (items > 2)
for (i=2; i < items; i+=2)
SetAttribute(aTHX_ package_info,image,SvPV(ST(i-1),na),ST(i),
exception);
(void) AnimateImages(package_info->image_info,image,exception);
(void) CatchImageException(image);
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# A p p e n d #
# #
# #
# #
###############################################################################
#
#
void
Append(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
AppendImage = 1
append = 2
appendimage = 3
PPCODE:
{
AV
*av;
char
*attribute;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
i,
stack;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
attribute=NULL;
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
stack=ParseCommandOption(MagickBooleanOptions,MagickFalse,
SvPV(ST(i),na));
if (stack < 0)
{
ThrowPerlException(exception,OptionError,"UnrecognizedType",
SvPV(ST(i),na));
return;
}
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=AppendImages(image,stack != 0 ? MagickTrue : MagickFalse,exception);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# A v e r a g e #
# #
# #
# #
###############################################################################
#
#
void
Average(ref)
Image::Magick ref=NO_INIT
ALIAS:
AverageImage = 1
average = 2
averageimage = 3
PPCODE:
{
AV
*av;
char
*p;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
image=EvaluateImages(image,MeanEvaluateOperator,exception);
if (image == (Image *) NULL)
goto PerlException;
/*
Create blessed Perl array for the returned image.
*/
av=newAV();
ST(0)=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
info=GetPackageInfo(aTHX_ (void *) av,info,exception);
(void) FormatLocaleString(info->image_info->filename,MagickPathExtent,
"average-%.*s",(int) (MagickPathExtent-9),
((p=strrchr(image->filename,'/')) ? p+1 : image->filename));
(void) CopyMagickString(image->filename,info->image_info->filename,
MagickPathExtent);
SetImageInfo(info->image_info,0,exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# B l o b T o I m a g e #
# #
# #
# #
###############################################################################
#
#
void
BlobToImage(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
BlobToImage = 1
blobtoimage = 2
blobto = 3
PPCODE:
{
AV
*av;
char
**keep,
**list,
**p;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
ac,
i,
n,
number_images;
STRLEN
*length;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
number_images=0;
ac=(items < 2) ? 1 : items-1;
length=(STRLEN *) NULL;
list=(char **) AcquireQuantumMemory((size_t) ac+1UL,sizeof(*list));
if (list == (char **) NULL)
{
ThrowPerlException(exception,ResourceLimitError,
"MemoryAllocationFailed",PackageName);
goto PerlException;
}
length=(STRLEN *) AcquireQuantumMemory((size_t) ac+1UL,sizeof(*length));
if (length == (STRLEN *) NULL)
{
ThrowPerlException(exception,ResourceLimitError,
list[n]=(char *) (SvPV(ST(i+2),length[n]));
continue;
}
n++;
}
list[n]=(char *) NULL;
keep=list;
for (i=number_images=0; i < n; i++)
{
image=BlobToImage(info->image_info,list[i],length[i],exception);
if (image == (Image *) NULL)
break;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
number_images++;
}
}
/*
Free resources.
*/
for (i=0; i < n; i++)
if (list[i] != (char *) NULL)
for (p=keep; list[i] != *p++; )
if (*p == (char *) NULL)
{
list[i]=(char *) RelinquishMagickMemory(list[i]);
break;
}
PerlException:
if (list)
list=(char **) RelinquishMagickMemory(list);
if (length)
length=(STRLEN *) RelinquishMagickMemory(length);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) number_images);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# C h a n n e l F x #
# #
# #
# #
###############################################################################
#
#
void
ChannelFx(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
ChannelFxImage = 1
channelfx = 2
channelfximage = 3
PPCODE:
{
AV
*av;
char
*attribute,
expression[MagickPathExtent];
ChannelType
channel,
channel_mask;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
i;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
attribute=NULL;
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
{
if (LocaleCompare(attribute,"expression") == 0)
{
(void) CopyMagickString(expression,SvPV(ST(i),na),
MagickPathExtent);
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
channel_mask=SetImageChannelMask(image,channel);
image=ChannelFxImage(image,expression,exception);
if (image != (Image *) NULL)
(void) SetImageChannelMask(image,channel_mask);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception); /* can't return warning messages */
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# C l o n e #
# #
# #
# #
###############################################################################
#
#
void
Clone(ref)
Image::Magick ref=NO_INIT
ALIAS:
CopyImage = 1
copy = 2
copyimage = 3
CloneImage = 4
clone = 5
cloneimage = 6
Clone = 7
PPCODE:
{
AV
*av;
ExceptionInfo
*exception;
HV
*hv;
Image
*clone,
*image;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
/*
Create blessed Perl array for the returned image.
*/
av=newAV();
ST(0)=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
for ( ; image; image=image->next)
{
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# C L O N E #
# #
# #
# #
###############################################################################
#
#
void
CLONE(ref,...)
SV *ref;
CODE:
{
PERL_UNUSED_VAR(ref);
if (magick_registry != (SplayTreeInfo *) NULL)
{
Image
*p;
ResetSplayTreeIterator(magick_registry);
p=(Image *) GetNextKeyInSplayTree(magick_registry);
while (p != (Image *) NULL)
{
ReferenceImage(p);
p=(Image *) GetNextKeyInSplayTree(magick_registry);
}
}
}
#
###############################################################################
# #
# #
# #
# C o a l e s c e #
# #
# #
# #
###############################################################################
#
#
void
Coalesce(ref)
Image::Magick ref=NO_INIT
ALIAS:
CoalesceImage = 1
coalesce = 2
coalesceimage = 3
PPCODE:
{
AV
*av;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
image=CoalesceImages(image,exception);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# C o m p a r e #
# #
# #
# #
###############################################################################
#
#
void
Compare(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
CompareImages = 1
compare = 2
compareimage = 3
PPCODE:
{
AV
*av;
char
*attribute;
double
distortion;
ExceptionInfo
*exception;
HV
*hv;
Image
*difference_image,
*image,
*reconstruct_image;
MetricType
metric;
ssize_t
i,
option;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
av=NULL;
attribute=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvPV(ST(i),na));
if (option < 0)
{
ThrowPerlException(exception,OptionError,"UnrecognizedType",
SvPV(ST(i),na));
break;
}
metric=(MetricType) option;
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
difference_image=CompareImages(image,reconstruct_image,metric,&distortion,
exception);
if (difference_image != (Image *) NULL)
{
difference_image->error.mean_error_per_pixel=distortion;
AddImageToRegistry(sv,difference_image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception); /* can't return warning messages */
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# C o m p l e x I m a g e s #
# #
# #
# #
###############################################################################
#
#
void
ComplexImages(ref)
Image::Magick ref=NO_INIT
ALIAS:
ComplexImages = 1
compleximages = 2
PPCODE:
{
AV
*av;
char
*attribute,
*p;
ComplexOperator
op;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
op=UndefinedComplexOperator;
if (items == 2)
{
ssize_t
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=ComplexImages(image,op,exception);
if (image == (Image *) NULL)
goto PerlException;
/*
Create blessed Perl array for the returned image.
*/
av=newAV();
ST(0)=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
info=GetPackageInfo(aTHX_ (void *) av,info,exception);
(void) FormatLocaleString(info->image_info->filename,MagickPathExtent,
"complex-%.*s",(int) (MagickPathExtent-9),
((p=strrchr(image->filename,'/')) ? p+1 : image->filename));
(void) CopyMagickString(image->filename,info->image_info->filename,
MagickPathExtent);
SetImageInfo(info->image_info,0,exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# C o m p a r e L a y e r s #
# #
# #
# #
###############################################################################
#
#
void
CompareLayers(ref)
Image::Magick ref=NO_INIT
ALIAS:
CompareImagesLayers = 1
comparelayers = 2
compareimagelayers = 3
PPCODE:
{
AV
*av;
char
*attribute;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
LayerMethod
method;
ssize_t
i,
option;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
SvPV(ST(i),na));
if (option < 0)
{
ThrowPerlException(exception,OptionError,"UnrecognizedType",
SvPV(ST(i),na));
break;
}
method=(LayerMethod) option;
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=CompareImagesLayers(image,method,exception);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# D e s t r o y #
# #
# #
# #
###############################################################################
#
#
void
DESTROY(ref)
Image::Magick ref=NO_INIT
PPCODE:
{
SV
*reference;
PERL_UNUSED_VAR(ref);
if (sv_isobject(ST(0)) == 0)
croak("ReferenceIsNotMyType");
reference=SvRV(ST(0));
switch (SvTYPE(reference))
{
case SVt_PVAV:
{
char
message[MagickPathExtent];
const SV
*key;
HV
*hv;
GV
**gvp;
struct PackageInfo
*info;
SV
*sv;
/*
Array (AV *) reference
*/
(void) FormatLocaleString(message,MagickPathExtent,"package%s%p",
XS_VERSION,(void *) reference);
hv=gv_stashpv(PackageName, FALSE);
if (!hv)
break;
gvp=(GV **) hv_fetch(hv,message,(long) strlen(message),FALSE);
if (!gvp)
break;
sv=GvSV(*gvp);
if (sv && (SvREFCNT(sv) == 1) && SvIOK(sv))
{
info=INT2PTR(struct PackageInfo *,SvIV(sv));
DestroyPackageInfo(info);
}
key=hv_delete(hv,message,(long) strlen(message),G_DISCARD);
(void) key;
break;
}
case SVt_PVMG:
{
Image
*image;
/*
Blessed scalar = (Image *) SvIV(reference)
*/
image=INT2PTR(Image *,SvIV(reference));
if (image != (Image *) NULL)
DeleteImageFromRegistry(reference,image);
break;
}
default:
break;
}
}
#
###############################################################################
# #
# #
# #
# D i s p l a y #
# #
# #
# #
###############################################################################
#
#
void
Display(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
DisplayImage = 1
display = 2
displayimage = 3
PPCODE:
{
ExceptionInfo
*exception;
Image
*image;
ssize_t
i;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
package_info=(struct PackageInfo *) NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
package_info=ClonePackageInfo(info,exception);
if (items == 2)
SetAttribute(aTHX_ package_info,NULL,"server",ST(1),exception);
else
if (items > 2)
for (i=2; i < items; i+=2)
SetAttribute(aTHX_ package_info,image,SvPV(ST(i-1),na),ST(i),
exception);
(void) DisplayImages(package_info->image_info,image,exception);
(void) CatchImageException(image);
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# E v a l u a t e I m a g e s #
# #
# #
# #
###############################################################################
#
#
void
EvaluateImages(ref)
Image::Magick ref=NO_INIT
ALIAS:
EvaluateImages = 1
evaluateimages = 2
PPCODE:
{
AV
*av;
char
*attribute,
*p;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
MagickEvaluateOperator
op;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
op=MeanEvaluateOperator;
if (items == 2)
{
ssize_t
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=EvaluateImages(image,op,exception);
if (image == (Image *) NULL)
goto PerlException;
/*
Create blessed Perl array for the returned image.
*/
av=newAV();
ST(0)=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
info=GetPackageInfo(aTHX_ (void *) av,info,exception);
(void) FormatLocaleString(info->image_info->filename,MagickPathExtent,
"evaluate-%.*s",(int) (MagickPathExtent-9),
((p=strrchr(image->filename,'/')) ? p+1 : image->filename));
(void) CopyMagickString(image->filename,info->image_info->filename,
MagickPathExtent);
SetImageInfo(info->image_info,0,exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# F e a t u r e s #
# #
# #
# #
###############################################################################
#
#
void
Features(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
FeaturesImage = 1
features = 2
featuresimage = 3
PPCODE:
{
#define ChannelFeatures(channel,direction) \
{ \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].angular_second_moment[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].contrast[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].contrast[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].variance_sum_of_squares[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].inverse_difference_moment[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].sum_average[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].sum_variance[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].sum_entropy[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].entropy[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].difference_variance[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].difference_entropy[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].measure_of_correlation_1[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].measure_of_correlation_2[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_features[channel].maximum_correlation_coefficient[direction]); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
}
AV
*av;
char
*attribute,
message[MagickPathExtent];
ChannelFeatures
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
count=0;
for ( ; image; image=image->next)
{
ssize_t
j;
channel_features=GetImageFeatures(image,distance,exception);
if (channel_features == (ChannelFeatures *) NULL)
continue;
count++;
for (j=0; j < 4; j++)
{
for (i=0; i < (ssize_t) GetPixelChannels(image); i++)
{
PixelChannel channel=GetPixelChannelChannel(image,i);
PixelTrait traits=GetPixelChannelTraits(image,channel);
if (traits == UndefinedPixelTrait)
continue;
EXTEND(sp,14*(i+1)*count);
ChannelFeatures(channel,j);
}
}
channel_features=(ChannelFeatures *)
RelinquishMagickMemory(channel_features);
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# F l a t t e n #
# #
# #
# #
###############################################################################
#
#
void
Flatten(ref)
Image::Magick ref=NO_INIT
ALIAS:
FlattenImage = 1
flatten = 2
flattenimage = 3
PPCODE:
{
AV
*av;
char
*attribute,
*p;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
PixelInfo
background_color;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
background_color=image->background_color;
if (items == 2)
(void) QueryColorCompliance((char *) SvPV(ST(1),na),AllCompliance,
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image->background_color=background_color;
image=MergeImageLayers(image,FlattenLayer,exception);
if (image == (Image *) NULL)
goto PerlException;
/*
Create blessed Perl array for the returned image.
*/
av=newAV();
ST(0)=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
info=GetPackageInfo(aTHX_ (void *) av,info,exception);
(void) FormatLocaleString(info->image_info->filename,MagickPathExtent,
"flatten-%.*s",(int) (MagickPathExtent-9),
((p=strrchr(image->filename,'/')) ? p+1 : image->filename));
(void) CopyMagickString(image->filename,info->image_info->filename,
MagickPathExtent);
SetImageInfo(info->image_info,0,exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception); /* return messages in string context */
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# F x #
# #
# #
# #
###############################################################################
#
#
void
Fx(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
FxImage = 1
fx = 2
fximage = 3
PPCODE:
{
AV
*av;
char
*attribute,
expression[MagickPathExtent];
ChannelType
channel,
channel_mask;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
i;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
attribute=NULL;
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
{
if (LocaleCompare(attribute,"expression") == 0)
{
(void) CopyMagickString(expression,SvPV(ST(i),na),
MagickPathExtent);
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
channel_mask=SetImageChannelMask(image,channel);
image=FxImage(image,expression,exception);
if (image != (Image *) NULL)
(void) SetImageChannelMask(image,channel_mask);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception); /* can't return warning messages */
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# G e t #
# #
# #
# #
###############################################################################
#
#
void
Get(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
GetAttributes = 1
GetAttribute = 2
get = 3
getattributes = 4
getattribute = 5
PPCODE:
{
char
*attribute,
color[MagickPathExtent];
const char
*value;
ExceptionInfo
*exception;
Image
*image;
long
j;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*s;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
XSRETURN_EMPTY;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL && !info)
XSRETURN_EMPTY;
EXTEND(sp,items);
for (i=1; i < items; i++)
{
attribute=(char *) SvPV(ST(i),na);
s=NULL;
switch (*attribute)
{
case 'A':
case 'a':
{
if (LocaleCompare(attribute,"adjoin") == 0)
if (LocaleCompare(attribute,"y-resolution") == 0)
{
if (image != (Image *) NULL)
s=newSVnv(image->resolution.y);
PUSHs(s ? sv_2mortal(s) : &sv_undef);
continue;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
break;
}
if (image == (Image *) NULL)
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute)
else
{
value=GetImageProperty(image,attribute,exception);
if (value != (const char *) NULL)
{
s=newSVpv(value,0);
PUSHs(s ? sv_2mortal(s) : &sv_undef);
}
else
if (*attribute != '%')
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute)
else
{
char
*meta;
meta=InterpretImageProperties(info ? info->image_info :
(ImageInfo *) NULL,image,attribute,exception);
s=newSVpv(meta,0);
PUSHs(s ? sv_2mortal(s) : &sv_undef);
meta=(char *) RelinquishMagickMemory(meta);
}
}
}
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* can't return warning messages */
}
#
###############################################################################
# #
# #
# #
# G e t A u t h e n t i c P i x e l s #
# #
# #
# #
###############################################################################
#
#
void *
GetAuthenticPixels(ref,...)
Image::Magick ref = NO_INIT
ALIAS:
getauthenticpixels = 1
GetImagePixels = 2
getimagepixels = 3
CODE:
{
char
*attribute;
ExceptionInfo
*exception;
Image
*image;
RectangleInfo
region;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
void
*blob = NULL;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
region.x=0;
region.y=0;
region.width=image->columns;
region.height=1;
if (items == 1)
(void) ParseAbsoluteGeometry(SvPV(ST(1),na),®ion);
for (i=2; i < items; i+=2)
{
attribute=(char *) SvPV(ST(i-1),na);
ThrowPerlException(exception,OptionError,"UnrecognizedOption",
attribute);
break;
}
case 'Y':
case 'y':
{
if (LocaleCompare(attribute,"y") == 0)
{
region.y=SvIV(ST(i));
continue;
}
ThrowPerlException(exception,OptionError,"UnrecognizedOption",
attribute);
break;
}
case 'W':
case 'w':
{
if (LocaleCompare(attribute,"width") == 0)
{
region.width=(size_t) SvIV(ST(i));
continue;
}
ThrowPerlException(exception,OptionError,"UnrecognizedOption",
attribute);
break;
}
}
}
blob=(void *) GetAuthenticPixels(image,region.x,region.y,region.width,
region.height,exception);
if (blob != (void *) NULL)
goto PerlEnd;
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
PerlEnd:
RETVAL = blob;
}
OUTPUT:
RETVAL
#
###############################################################################
# #
# #
# #
# G e t V i r t u a l P i x e l s #
# #
# #
# #
###############################################################################
#
#
void *
GetVirtualPixels(ref,...)
Image::Magick ref = NO_INIT
ALIAS:
getvirtualpixels = 1
AcquireImagePixels = 2
acquireimagepixels = 3
CODE:
{
char
*attribute;
const void
*blob = NULL;
ExceptionInfo
*exception;
Image
*image;
RectangleInfo
region;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
region.x=0;
region.y=0;
region.width=image->columns;
region.height=1;
if (items == 1)
(void) ParseAbsoluteGeometry(SvPV(ST(1),na),®ion);
for (i=2; i < items; i+=2)
{
attribute=(char *) SvPV(ST(i-1),na);
ThrowPerlException(exception,OptionError,"UnrecognizedOption",
attribute);
break;
}
case 'Y':
case 'y':
{
if (LocaleCompare(attribute,"y") == 0)
{
region.y=SvIV(ST(i));
continue;
}
ThrowPerlException(exception,OptionError,"UnrecognizedOption",
attribute);
break;
}
case 'W':
case 'w':
{
if (LocaleCompare(attribute,"width") == 0)
{
region.width=(size_t) SvIV(ST(i));
continue;
}
ThrowPerlException(exception,OptionError,"UnrecognizedOption",
attribute);
break;
}
}
}
blob=(const void *) GetVirtualPixels(image,region.x,region.y,region.width,
region.height,exception);
if (blob != (void *) NULL)
goto PerlEnd;
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
PerlEnd:
RETVAL = (void *) blob;
}
OUTPUT:
RETVAL
#
###############################################################################
# #
# #
# #
# G e t A u t h e n t i c M e t a c o n t e n t #
# #
# #
# #
###############################################################################
#
#
void *
GetAuthenticMetacontent(ref,...)
Image::Magick ref = NO_INIT
ALIAS:
getauthenticmetacontent = 1
GetMetacontent = 2
getmetacontent = 3
CODE:
{
ExceptionInfo
*exception;
Image
*image;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
void
*blob = NULL;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
blob=(void *) GetAuthenticMetacontent(image);
if (blob != (void *) NULL)
goto PerlEnd;
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
PerlEnd:
RETVAL = blob;
}
OUTPUT:
RETVAL
#
###############################################################################
# #
# #
# #
# G e t V i r t u a l M e t a c o n t e n t #
# #
# #
# #
###############################################################################
#
#
void *
GetVirtualMetacontent(ref,...)
Image::Magick ref = NO_INIT
ALIAS:
getvirtualmetacontent = 1
CODE:
{
ExceptionInfo
*exception;
Image
*image;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
void
*blob = NULL;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
blob=(void *) GetVirtualMetacontent(image);
if (blob != (void *) NULL)
goto PerlEnd;
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
PerlEnd:
RETVAL = blob;
}
OUTPUT:
RETVAL
#
###############################################################################
# #
# #
# #
# H i s t o g r a m #
# #
# #
# #
###############################################################################
#
#
void
Histogram(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
HistogramImage = 1
histogram = 2
histogramimage = 3
PPCODE:
{
AV
*av;
char
message[MagickPathExtent];
PixelInfo
*histogram;
ExceptionInfo
*exception;
Image
*image;
ssize_t
i,
count;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
size_t
number_colors;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
av=newAV();
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
count=0;
for ( ; image; image=image->next)
{
histogram=GetImageHistogram(image,&number_colors,exception);
if (histogram == (PixelInfo *) NULL)
continue;
count+=(ssize_t) number_colors;
EXTEND(sp,6*count);
for (i=0; i < (ssize_t) number_colors; i++)
{
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",
histogram[i].red);
PUSHs(sv_2mortal(newSVpv(message,0)));
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",
histogram[i].green);
PUSHs(sv_2mortal(newSVpv(message,0)));
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",
histogram[i].blue);
PUSHs(sv_2mortal(newSVpv(message,0)));
if (image->colorspace == CMYKColorspace)
{
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",
histogram[i].black);
PUSHs(sv_2mortal(newSVpv(message,0)));
}
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",
histogram[i].alpha);
PUSHs(sv_2mortal(newSVpv(message,0)));
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",(double)
histogram[i].count);
PUSHs(sv_2mortal(newSVpv(message,0)));
}
histogram=(PixelInfo *) RelinquishMagickMemory(histogram);
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# G e t P i x e l #
# #
# #
# #
###############################################################################
#
#
void
GetPixel(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
getpixel = 1
getPixel = 2
PPCODE:
{
AV
*av;
char
*attribute;
const Quantum
*p;
ExceptionInfo
*exception;
Image
*image;
MagickBooleanType
normalize;
RectangleInfo
region;
ssize_t
i,
option;
struct PackageInfo
*info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
normalize=MagickTrue;
region.x=0;
region.y=0;
region.width=image->columns;
region.height=1;
if (items == 1)
(void) ParseAbsoluteGeometry(SvPV(ST(1),na),®ion);
for (i=2; i < items; i+=2)
{
region.y=SvIV(ST(i));
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
p=GetVirtualPixels(image,region.x,region.y,1,1,exception);
if (p == (const Quantum *) NULL)
PUSHs(&sv_undef);
else
{
double
scale;
scale=1.0;
if (normalize != MagickFalse)
scale=1.0/QuantumRange;
if ((GetPixelRedTraits(image) & UpdatePixelTrait) != 0)
PUSHs(sv_2mortal(newSVnv(scale*GetPixelRed(image,p))));
if ((GetPixelGreenTraits(image) & UpdatePixelTrait) != 0)
PUSHs(sv_2mortal(newSVnv(scale*GetPixelGreen(image,p))));
if ((GetPixelBlueTraits(image) & UpdatePixelTrait) != 0)
PUSHs(sv_2mortal(newSVnv(scale*GetPixelBlue(image,p))));
if (((GetPixelBlackTraits(image) & UpdatePixelTrait) != 0) &&
(image->colorspace == CMYKColorspace))
PUSHs(sv_2mortal(newSVnv(scale*GetPixelBlack(image,p))));
if ((GetPixelAlphaTraits(image) & UpdatePixelTrait) != 0)
PUSHs(sv_2mortal(newSVnv(scale*GetPixelAlpha(image,p))));
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# G e t P i x e l s #
# #
# #
# #
###############################################################################
#
#
void
GetPixels(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
getpixels = 1
getPixels = 2
PPCODE:
{
AV
*av;
char
*attribute;
const char
*map;
ExceptionInfo
*exception;
Image
*image;
MagickBooleanType
normalize,
status;
RectangleInfo
region;
ssize_t
i,
option;
struct PackageInfo
*info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
map="RGB";
if (image->alpha_trait != UndefinedPixelTrait)
map="RGBA";
if (image->colorspace == CMYKColorspace)
{
map="CMYK";
if (image->alpha_trait != UndefinedPixelTrait)
if (status == MagickFalse)
PUSHs(&sv_undef);
else
{
EXTEND(sp,(ssize_t) (strlen(map)*region.width*region.height));
for (i=0; i < (ssize_t) (strlen(map)*region.width*region.height); i++)
PUSHs(sv_2mortal(newSVnv(pixels[i])));
}
pixels_info=RelinquishVirtualMemory(pixels_info);
}
else
{
MemoryInfo
*pixels_info;
Quantum
*pixels;
pixels_info=AcquireVirtualMemory(strlen(map)*region.width,
region.height*sizeof(*pixels));
if (pixels_info == (MemoryInfo *) NULL)
{
ThrowPerlException(exception,ResourceLimitError,
"MemoryAllocationFailed",PackageName);
goto PerlException;
}
pixels=(Quantum *) GetVirtualMemoryBlob(pixels_info);
status=ExportImagePixels(image,region.x,region.y,region.width,
region.height,map,QuantumPixel,pixels,exception);
if (status == MagickFalse)
PUSHs(&sv_undef);
else
{
EXTEND(sp,(ssize_t) (strlen(map)*region.width*region.height));
for (i=0; i < (ssize_t) (strlen(map)*region.width*region.height); i++)
PUSHs(sv_2mortal(newSViv(pixels[i])));
}
pixels_info=RelinquishVirtualMemory(pixels_info);
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# I m a g e T o B l o b #
# #
# #
# #
###############################################################################
#
#
void
ImageToBlob(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
ImageToBlob = 1
imagetoblob = 2
toblob = 3
blob = 4
PPCODE:
{
char
filename[MagickPathExtent];
ExceptionInfo
*exception;
Image
*image,
*next;
ssize_t
i;
struct PackageInfo
*info,
*package_info;
size_t
length;
ssize_t
scene;
SV
*perl_exception,
*reference;
void
*blob;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
package_info=(struct PackageInfo *) NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
package_info=ClonePackageInfo(info,exception);
for (i=2; i < items; i+=2)
SetAttribute(aTHX_ package_info,image,SvPV(ST(i-1),na),ST(i),exception);
(void) CopyMagickString(filename,package_info->image_info->filename,
MagickPathExtent);
scene=0;
for (next=image; next; next=next->next)
{
(void) CopyMagickString(next->filename,filename,MagickPathExtent);
next->scene=(size_t) scene++;
}
SetImageInfo(package_info->image_info,(unsigned int)
GetImageListLength(image),exception);
EXTEND(sp,(ssize_t) GetImageListLength(image));
for ( ; image; image=image->next)
{
length=0;
blob=ImagesToBlob(package_info->image_info,image,&length,exception);
if (blob != (char *) NULL)
{
PUSHs(sv_2mortal(newSVpv((const char *) blob,length)));
blob=(unsigned char *) RelinquishMagickMemory(blob);
}
if (package_info->image_info->adjoin)
break;
}
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
}
#
###############################################################################
# #
# #
# #
# L a y e r s #
# #
# #
# #
###############################################################################
#
#
void
Layers(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
Layers = 1
layers = 2
OptimizeImageLayers = 3
optimizelayers = 4
optimizeimagelayers = 5
PPCODE:
{
AV
*av;
char
*attribute;
CompositeOperator
compose;
ExceptionInfo
*exception;
HV
*hv;
Image
*image,
*layers;
LayerMethod
method;
ssize_t
i,
option,
sp;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
break;
}
/*
Adjust offset with gravity and virtual canvas.
*/
SetGeometry(image,&geometry);
(void) ParseAbsoluteGeometry(image->geometry,&geometry);
geometry.width=source->page.width != 0 ? source->page.width :
source->columns;
geometry.height=source->page.height != 0 ? source->page.height :
source->rows;
GravityAdjustGeometry(image->page.width != 0 ? image->page.width :
image->columns,image->page.height != 0 ? image->page.height :
image->rows,image->gravity,&geometry);
CompositeLayers(image,compose,source,geometry.x,geometry.y,exception);
source=DestroyImageList(source);
break;
}
}
if (layers != (Image *) NULL)
image=layers;
else
image=CloneImage(image,0,0,MagickTrue,exception);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# M a g i c k T o M i m e #
# #
# #
# #
###############################################################################
#
#
SV *
MagickToMime(ref,name)
Image::Magick ref=NO_INIT
char *name
ALIAS:
magicktomime = 1
CODE:
{
char
*mime;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
mime=MagickToMime(name);
RETVAL=newSVpv(mime,0);
mime=(char *) RelinquishMagickMemory(mime);
}
OUTPUT:
RETVAL
#
###############################################################################
# #
# #
# #
# M o g r i f y #
# #
# #
# #
###############################################################################
#
#
void
Mogrify(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
Comment = 1
CommentImage = 2
Label = 3
LabelImage = 4
AddNoise = 5
AddNoiseImage = 6
Colorize = 7
ColorizeImage = 8
Border = 9
BorderImage = 10
Blur = 11
BlurImage = 12
Chop = 13
ChopImage = 14
Crop = 15
CropImage = 16
Despeckle = 17
DespeckleImage = 18
Edge = 19
EdgeImage = 20
Emboss = 21
EmbossImage = 22
Enhance = 23
EnhanceImage = 24
Flip = 25
FlipImage = 26
Flop = 27
FlopImage = 28
Frame = 29
FrameImage = 30
Implode = 31
ImplodeImage = 32
Magnify = 33
MagnifyImage = 34
MedianFilter = 35
MedianConvolveImage = 36
Minify = 37
MinifyImage = 38
OilPaint = 39
OilPaintImage = 40
ReduceNoise = 41
ReduceNoiseImage = 42
Roll = 43
RollImage = 44
Rotate = 45
RotateImage = 46
Sample = 47
SampleImage = 48
Scale = 49
ScaleImage = 50
Shade = 51
ShadeImage = 52
Sharpen = 53
SharpenImage = 54
Shear = 55
ShearImage = 56
Spread = 57
SpreadImage = 58
Swirl = 59
break;
}
case 154: /* SortPixels */
{
(void) SortImagePixels(image,exception);
break;
}
case 155: /* Integral */
{
image=IntegralImage(image,exception);
break;
}
}
if (next != (Image *) NULL)
(void) CatchImageException(next);
if ((region_info.width*region_info.height) != 0)
(void) SetImageRegionMask(image,WritePixelMask,
(const RectangleInfo *) NULL,exception);
if (image != (Image *) NULL)
{
number_images++;
if (next && (next != image))
{
image->next=next->next;
if (image->next != (Image *) NULL)
image->next->previous=image;
DeleteImageFromRegistry(*pv,next);
}
sv_setiv(*pv,PTR2IV(image));
next=image;
}
if (*pv)
pv++;
}
PerlException:
if (reference_vector)
reference_vector=(SV **) RelinquishMagickMemory(reference_vector);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) number_images);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# M o n t a g e #
# #
# #
# #
###############################################################################
#
#
void
Montage(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
MontageImage = 1
montage = 2
montageimage = 3
PPCODE:
{
AV
*av;
char
*attribute;
ExceptionInfo
*exception;
HV
*hv;
Image
*image,
*next;
PixelInfo
transparent_color;
MontageInfo
*montage_info;
ssize_t
i,
sp;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
attribute=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
for (next=image; next; next=next->next)
(void) TransparentPaintImage(next,&transparent_color,
TransparentAlpha,MagickFalse,exception);
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=MontageImageList(info->image_info,montage_info,image,exception);
montage_info=DestroyMontageInfo(montage_info);
if (image == (Image *) NULL)
goto PerlException;
if (transparent_color.alpha != TransparentAlpha)
for (next=image; next; next=next->next)
(void) TransparentPaintImage(next,&transparent_color,
TransparentAlpha,MagickFalse,exception);
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# M o r p h #
# #
# #
# #
###############################################################################
#
#
void
Morph(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
MorphImage = 1
morph = 2
morphimage = 3
PPCODE:
{
AV
*av;
char
*attribute;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
i,
number_frames;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
av=NULL;
attribute=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
switch (*attribute)
{
case 'F':
case 'f':
{
if (LocaleCompare(attribute,"frames") == 0)
{
number_frames=SvIV(ST(i));
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=MorphImages(image,(size_t) number_frames,exception);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception); /* can't return warning messages */
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# M o s a i c #
# #
# #
# #
###############################################################################
#
#
void
Mosaic(ref)
Image::Magick ref=NO_INIT
ALIAS:
MosaicImage = 1
mosaic = 2
mosaicimage = 3
PPCODE:
{
AV
*av;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
struct PackageInfo
*info;
SV
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
image=MergeImageLayers(image,MosaicLayer,exception);
/*
Create blessed Perl array for the returned image.
*/
av=newAV();
ST(0)=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
(void) CopyMagickString(info->image_info->filename,image->filename,
MagickPathExtent);
SetImageInfo(info->image_info,0,exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception); /* return messages in string context */
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# P e r c e p t u a l H a s h #
# #
# #
# #
###############################################################################
#
#
void
PerceptualHash(ref)
Image::Magick ref = NO_INIT
ALIAS:
PerceptualHashImage = 1
perceptualhash = 2
perceptualhashimage = 3
PPCODE:
{
AV
*av;
ChannelPerceptualHash
*channel_phash;
char
message[MagickPathExtent];
ExceptionInfo
*exception;
Image
*image;
ssize_t
count;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
av=newAV();
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
count=0;
for ( ; image; image=image->next)
{
ssize_t
i;
channel_phash=GetImagePerceptualHash(image,exception);
if (channel_phash == (ChannelPerceptualHash *) NULL)
continue;
count++;
for (i=0; i < (ssize_t) GetPixelChannels(image); i++)
{
ssize_t
j;
PixelChannel channel=GetPixelChannelChannel(image,i);
PixelTrait traits=GetPixelChannelTraits(image,channel);
if (traits == UndefinedPixelTrait)
continue;
EXTEND(sp,((ssize_t) GetPixelChannels(image)*
MaximumNumberOfPerceptualHashes*
(ssize_t) channel_phash[0].number_colorspaces*(i+1)*count));
for (j=0; j < MaximumNumberOfPerceptualHashes; j++)
{
ssize_t
k;
for (k=0; k < (ssize_t) channel_phash[0].number_colorspaces; k++)
{
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",
channel_phash[channel].phash[k][j]);
PUSHs(sv_2mortal(newSVpv(message,0)));
}
}
}
channel_phash=(ChannelPerceptualHash *)
RelinquishMagickMemory(channel_phash);
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# P i n g #
# #
# #
# #
###############################################################################
#
#
void
Ping(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
PingImage = 1
ping = 2
pingimage = 3
PPCODE:
{
AV
*av;
char
**keep,
**list,
**p;
ExceptionInfo
*exception;
Image
*image,
*next;
int
n;
MagickBooleanType
status;
ssize_t
ac,
i;
STRLEN
*length;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception,
*reference;
size_t
count;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
package_info=(struct PackageInfo *) NULL;
ac=(items < 2) ? 1 : items-1;
list=(char **) AcquireQuantumMemory((size_t) ac+1UL,sizeof(*list));
keep=list;
length=(STRLEN *) NULL;
if (list == (char **) NULL)
{
ThrowPerlException(exception,ResourceLimitError,
"MemoryAllocationFailed",PackageName);
goto PerlException;
}
{
(void) CopyMagickString(package_info->image_info->filename,list[i],
MagickPathExtent);
image=PingImage(package_info->image_info,exception);
if (image == (Image *) NULL)
break;
if ((package_info->image_info->file != (FILE *) NULL) ||
(package_info->image_info->blob != (void *) NULL))
DisassociateImageStream(image);
count+=GetImageListLength(image);
EXTEND(sp,4*(ssize_t) count);
for (next=image; next; next=next->next)
{
PUSHs(sv_2mortal(newSViv((ssize_t) next->columns)));
PUSHs(sv_2mortal(newSViv((ssize_t) next->rows)));
PUSHs(sv_2mortal(newSViv((ssize_t) GetBlobSize(next))));
PUSHs(sv_2mortal(newSVpv(next->magick,0)));
}
image=DestroyImageList(image);
}
/*
Free resources.
*/
for (i=0; i < n; i++)
if (list[i] != (char *) NULL)
for (p=keep; list[i] != *p++; )
if (*p == NULL)
{
list[i]=(char *) RelinquishMagickMemory(list[i]);
break;
}
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
if (list && (list != keep))
list=(char **) RelinquishMagickMemory(list);
if (keep)
keep=(char **) RelinquishMagickMemory(keep);
if (length)
length=(STRLEN *) RelinquishMagickMemory(length);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
}
#
###############################################################################
# #
# #
# #
# P r e v i e w #
# #
# #
# #
###############################################################################
#
#
void
Preview(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
PreviewImage = 1
preview = 2
previewimage = 3
PPCODE:
{
AV
*av;
ExceptionInfo
*exception;
HV
*hv;
Image
*image,
*preview_image;
PreviewType
preview_type;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
info=GetPackageInfo(aTHX_ (void *) av,info,exception);
preview_type=GammaPreview;
if (items > 1)
preview_type=(PreviewType)
ParseCommandOption(MagickPreviewOptions,MagickFalse,SvPV(ST(1),na));
for ( ; image; image=image->next)
{
preview_image=PreviewImage(image,preview_type,exception);
if (preview_image == (Image *) NULL)
goto PerlException;
AddImageToRegistry(sv,preview_image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception); /* can't return warning messages */
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# Q u e r y C o l o r #
# #
# #
# #
###############################################################################
#
#
void
QueryColor(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
querycolor = 1
PPCODE:
{
char
*name;
ExceptionInfo
*exception;
PixelInfo
color;
ssize_t
i;
SV
*perl_exception;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (items == 1)
{
const ColorInfo
**colorlist;
size_t
colors;
colorlist=GetColorInfoList("*",&colors,exception);
EXTEND(sp,(ssize_t) colors);
for (i=0; i < (ssize_t) colors; i++)
{
PUSHs(sv_2mortal(newSVpv(colorlist[i]->name,0)));
}
colorlist=(const ColorInfo **)
RelinquishMagickMemory((ColorInfo **) colorlist);
goto PerlException;
}
EXTEND(sp,5*items);
for (i=1; i < items; i++)
{
name=(char *) SvPV(ST(i),na);
if (QueryColorCompliance(name,AllCompliance,&color,exception) == MagickFalse)
{
PUSHs(&sv_undef);
continue;
}
PUSHs(sv_2mortal(newSViv((ssize_t) floor(color.red+0.5))));
PUSHs(sv_2mortal(newSViv((ssize_t) floor(color.green+0.5))));
PUSHs(sv_2mortal(newSViv((ssize_t) floor(color.blue+0.5))));
if (color.colorspace == CMYKColorspace)
PUSHs(sv_2mortal(newSViv((ssize_t) floor(color.black+0.5))));
if (color.alpha_trait != UndefinedPixelTrait)
PUSHs(sv_2mortal(newSViv((ssize_t) floor(color.alpha+0.5))));
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# Q u e r y C o l o r N a m e #
# #
# #
# #
###############################################################################
#
#
void
QueryColorname(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
querycolorname = 1
PPCODE:
{
AV
*av;
char
message[MagickPathExtent];
ExceptionInfo
*exception;
Image
*image;
PixelInfo
target_color;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
EXTEND(sp,items);
for (i=1; i < items; i++)
{
(void) QueryColorCompliance(SvPV(ST(i),na),AllCompliance,&target_color,
exception);
(void) QueryColorname(image,&target_color,SVGCompliance,message,
exception);
PUSHs(sv_2mortal(newSVpv(message,0)));
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# Q u e r y F o n t #
# #
# #
# #
###############################################################################
#
#
void
QueryFont(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
queryfont = 1
PPCODE:
{
char
*name,
message[MagickPathExtent];
ExceptionInfo
*exception;
ssize_t
i;
SV
*perl_exception;
volatile const TypeInfo
*type_info;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (items == 1)
{
const TypeInfo
**typelist;
size_t
types;
typelist=GetTypeInfoList("*",&types,exception);
EXTEND(sp,(ssize_t) types);
for (i=0; i < (ssize_t) types; i++)
{
PUSHs(sv_2mortal(newSVpv(typelist[i]->name,0)));
}
typelist=(const TypeInfo **) RelinquishMagickMemory((TypeInfo **)
typelist);
goto PerlException;
}
EXTEND(sp,10*items);
for (i=1; i < items; i++)
{
name=(char *) SvPV(ST(i),na);
type_info=GetTypeInfo(name,exception);
if (type_info == (TypeInfo *) NULL)
{
PUSHs(&sv_undef);
continue;
}
if (type_info->name == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->name,0)));
if (type_info->description == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->description,0)));
if (type_info->family == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->family,0)));
if (type_info->style == UndefinedStyle)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(CommandOptionToMnemonic(MagickStyleOptions,
type_info->style),0)));
if (type_info->stretch == UndefinedStretch)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(CommandOptionToMnemonic(MagickStretchOptions,
type_info->stretch),0)));
(void) FormatLocaleString(message,MagickPathExtent,"%.20g",(double)
type_info->weight);
PUSHs(sv_2mortal(newSVpv(message,0)));
if (type_info->encoding == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->encoding,0)));
if (type_info->foundry == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->foundry,0)));
if (type_info->format == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->format,0)));
if (type_info->metrics == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->metrics,0)));
if (type_info->glyphs == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(type_info->glyphs,0)));
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# Q u e r y F o n t M e t r i c s #
# #
# #
# #
###############################################################################
#
#
void
QueryFontMetrics(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
queryfontmetrics = 1
PPCODE:
{
AffineMatrix
affine,
current;
AV
*av;
char
*attribute;
double
x,
y;
DrawInfo
*draw_info;
ExceptionInfo
*exception;
GeometryInfo
geometry_info;
Image
*image;
MagickBooleanType
status;
MagickStatusType
flags;
ssize_t
i,
type;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
TypeMetric
metrics;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
package_info=(struct PackageInfo *) NULL;
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
break;
}
}
}
draw_info->affine.sx=current.sx*affine.sx+current.ry*affine.rx;
draw_info->affine.rx=current.rx*affine.sx+current.sy*affine.rx;
draw_info->affine.ry=current.sx*affine.ry+current.ry*affine.sy;
draw_info->affine.sy=current.rx*affine.ry+current.sy*affine.sy;
draw_info->affine.tx=current.sx*affine.tx+current.ry*affine.ty+current.tx;
draw_info->affine.ty=current.rx*affine.tx+current.sy*affine.ty+current.ty;
if (draw_info->geometry == (char *) NULL)
{
draw_info->geometry=AcquireString((char *) NULL);
(void) FormatLocaleString(draw_info->geometry,MagickPathExtent,
"%.20g,%.20g",x,y);
}
status=GetTypeMetrics(image,draw_info,&metrics,exception);
(void) CatchImageException(image);
if (status == MagickFalse)
PUSHs(&sv_undef);
else
{
PUSHs(sv_2mortal(newSVnv(metrics.pixels_per_em.x)));
PUSHs(sv_2mortal(newSVnv(metrics.pixels_per_em.y)));
PUSHs(sv_2mortal(newSVnv(metrics.ascent)));
PUSHs(sv_2mortal(newSVnv(metrics.descent)));
PUSHs(sv_2mortal(newSVnv(metrics.width)));
PUSHs(sv_2mortal(newSVnv(metrics.height)));
PUSHs(sv_2mortal(newSVnv(metrics.max_advance)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.x1)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.y1)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.x2)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.y2)));
PUSHs(sv_2mortal(newSVnv(metrics.origin.x)));
PUSHs(sv_2mortal(newSVnv(metrics.origin.y)));
}
draw_info=DestroyDrawInfo(draw_info);
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* can't return warning messages */
}
#
###############################################################################
# #
# #
# #
# Q u e r y M u l t i l i n e F o n t M e t r i c s #
# #
# #
# #
###############################################################################
#
#
void
QueryMultilineFontMetrics(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
querymultilinefontmetrics = 1
PPCODE:
{
AffineMatrix
affine,
current;
AV
*av;
char
*attribute;
double
x,
y;
DrawInfo
*draw_info;
ExceptionInfo
*exception;
GeometryInfo
geometry_info;
Image
*image;
MagickBooleanType
status;
MagickStatusType
flags;
ssize_t
i,
type;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
TypeMetric
metrics;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
package_info=(struct PackageInfo *) NULL;
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
break;
}
}
}
draw_info->affine.sx=current.sx*affine.sx+current.ry*affine.rx;
draw_info->affine.rx=current.rx*affine.sx+current.sy*affine.rx;
draw_info->affine.ry=current.sx*affine.ry+current.ry*affine.sy;
draw_info->affine.sy=current.rx*affine.ry+current.sy*affine.sy;
draw_info->affine.tx=current.sx*affine.tx+current.ry*affine.ty+current.tx;
draw_info->affine.ty=current.rx*affine.tx+current.sy*affine.ty+current.ty;
if (draw_info->geometry == (char *) NULL)
{
draw_info->geometry=AcquireString((char *) NULL);
(void) FormatLocaleString(draw_info->geometry,MagickPathExtent,
"%.20g,%.20g",x,y);
}
status=GetMultilineTypeMetrics(image,draw_info,&metrics,exception);
(void) CatchException(exception);
if (status == MagickFalse)
PUSHs(&sv_undef);
else
{
PUSHs(sv_2mortal(newSVnv(metrics.pixels_per_em.x)));
PUSHs(sv_2mortal(newSVnv(metrics.pixels_per_em.y)));
PUSHs(sv_2mortal(newSVnv(metrics.ascent)));
PUSHs(sv_2mortal(newSVnv(metrics.descent)));
PUSHs(sv_2mortal(newSVnv(metrics.width)));
PUSHs(sv_2mortal(newSVnv(metrics.height)));
PUSHs(sv_2mortal(newSVnv(metrics.max_advance)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.x1)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.y1)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.x2)));
PUSHs(sv_2mortal(newSVnv(metrics.bounds.y2)));
PUSHs(sv_2mortal(newSVnv(metrics.origin.x)));
PUSHs(sv_2mortal(newSVnv(metrics.origin.y)));
}
draw_info=DestroyDrawInfo(draw_info);
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* can't return warning messages */
}
#
###############################################################################
# #
# #
# #
# Q u e r y F o r m a t #
# #
# #
# #
###############################################################################
#
#
void
QueryFormat(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
queryformat = 1
PPCODE:
{
char
*name;
ExceptionInfo
*exception;
ssize_t
i;
SV
*perl_exception;
volatile const MagickInfo
*magick_info;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (items == 1)
{
char
format[MagickPathExtent];
const MagickInfo
**format_list;
size_t
types;
format_list=GetMagickInfoList("*",&types,exception);
EXTEND(sp,(ssize_t) types);
for (i=0; i < (ssize_t) types; i++)
{
(void) CopyMagickString(format,format_list[i]->name,MagickPathExtent);
LocaleLower(format);
PUSHs(sv_2mortal(newSVpv(format,0)));
}
format_list=(const MagickInfo **)
RelinquishMagickMemory((MagickInfo *) format_list);
goto PerlException;
}
EXTEND(sp,8*items);
for (i=1; i < items; i++)
{
name=(char *) SvPV(ST(i),na);
magick_info=GetMagickInfo(name,exception);
if (magick_info == (const MagickInfo *) NULL)
{
PUSHs(&sv_undef);
continue;
}
if (magick_info->description == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(magick_info->description,0)));
if (magick_info->magick_module == (char *) NULL)
PUSHs(&sv_undef);
else
PUSHs(sv_2mortal(newSVpv(magick_info->magick_module,0)));
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# Q u e r y O p t i o n #
# #
# #
# #
###############################################################################
#
#
void
QueryOption(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
queryoption = 1
PPCODE:
{
char
**options;
ExceptionInfo
*exception;
ssize_t
i,
j,
option;
SV
*perl_exception;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
EXTEND(sp,8*items);
for (i=1; i < items; i++)
{
option=ParseCommandOption(MagickListOptions,MagickFalse,(char *)
SvPV(ST(i),na));
options=GetCommandOptions((CommandOption) option);
if (options == (char **) NULL)
PUSHs(&sv_undef);
else
{
for (j=0; options[j] != (char *) NULL; j++)
PUSHs(sv_2mortal(newSVpv(options[j],0)));
options=DestroyStringList(options);
}
}
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# R e a d #
# #
# #
# #
###############################################################################
#
#
void
Read(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
ReadImage = 1
read = 2
readimage = 3
PPCODE:
{
AV
*av;
char
**keep,
**list,
**p;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
int
n;
MagickBooleanType
status;
ssize_t
ac,
i,
number_images;
STRLEN
*length;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception, /* Perl variable for storing messages */
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
package_info=(struct PackageInfo *) NULL;
number_images=0;
ac=(items < 2) ? 1 : items-1;
list=(char **) AcquireQuantumMemory((size_t) ac+1UL,sizeof(*list));
keep=list;
length=(STRLEN *) NULL;
if (list == (char **) NULL)
{
{
image=ReadImages(package_info->image_info,
package_info->image_info->filename,exception);
if (image != (Image *) NULL)
DisassociateImageStream(image);
}
if (image == (Image *) NULL)
break;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
number_images++;
}
}
/*
Free resources.
*/
for (i=0; i < n; i++)
if (list[i] != (char *) NULL)
for (p=keep; list[i] != *p++; )
if (*p == (char *) NULL)
{
list[i]=(char *) RelinquishMagickMemory(list[i]);
break;
}
PerlException:
if (package_info != (struct PackageInfo *) NULL)
DestroyPackageInfo(package_info);
if (list && (list != keep))
list=(char **) RelinquishMagickMemory(list);
if (keep)
keep=(char **) RelinquishMagickMemory(keep);
if (length)
length=(STRLEN *) RelinquishMagickMemory(length);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) number_images);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# R e m o t e #
# #
# #
# #
###############################################################################
#
#
void
Remote(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
RemoteCommand = 1
remote = 2
remoteCommand = 3
PPCODE:
{
AV
*av;
ExceptionInfo
*exception;
ssize_t
i;
SV
*perl_exception,
*reference;
struct PackageInfo
*info;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
for (i=1; i < items; i++)
(void) RemoteDisplayCommand(info->image_info,(char *) NULL,(char *)
SvPV(ST(i),na),exception);
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
}
#
###############################################################################
# #
# #
# #
# S e t #
# #
# #
# #
###############################################################################
#
#
void
Set(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
SetAttributes = 1
SetAttribute = 2
set = 3
setattributes = 4
setattribute = 5
PPCODE:
{
ExceptionInfo
*exception;
Image
*image;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (items == 2)
SetAttribute(aTHX_ info,image,"size",ST(1),exception);
else
for (i=2; i < items; i+=2)
SetAttribute(aTHX_ info,image,SvPV(ST(i-1),na),ST(i),exception);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) (SvCUR(perl_exception) != 0));
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# S e t P i x e l #
# #
# #
# #
###############################################################################
#
#
void
SetPixel(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
setpixel = 1
setPixel = 2
PPCODE:
{
AV
*av;
char
*attribute;
ChannelType
channel,
channel_mask;
ExceptionInfo
*exception;
Image
*image;
MagickBooleanType
normalize;
Quantum
*q;
RectangleInfo
region;
ssize_t
i,
option;
struct PackageInfo
*info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
av=(AV *) NULL;
normalize=MagickTrue;
region.x=0;
region.y=0;
scale=QuantumRange;
if (((GetPixelRedTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelRed(image,ClampToQuantum(scale*SvNV(*(
av_fetch(av,i,0)))),q);
i++;
}
if (((GetPixelGreenTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelGreen(image,ClampToQuantum(scale*SvNV(*(
av_fetch(av,i,0)))),q);
i++;
}
if (((GetPixelBlueTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelBlue(image,ClampToQuantum(scale*SvNV(*(
av_fetch(av,i,0)))),q);
i++;
}
if ((((GetPixelBlackTraits(image) & UpdatePixelTrait) != 0) &&
(image->colorspace == CMYKColorspace)) && (i <= av_len(av)))
{
SetPixelBlack(image,ClampToQuantum(scale*
SvNV(*(av_fetch(av,i,0)))),q);
i++;
}
if (((GetPixelAlphaTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelAlpha(image,ClampToQuantum(scale*
SvNV(*(av_fetch(av,i,0)))),q);
i++;
}
(void) SyncAuthenticPixels(image,exception);
}
(void) SetImageChannelMask(image,channel_mask);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# S e t P i x e l s #
# #
# #
# #
###############################################################################
#
#
void
SetPixels(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
setpixels = 1
setPixels = 2
PPCODE:
{
AV
*av;
char
*attribute;
ChannelType
channel,
channel_mask;
ExceptionInfo
*exception;
Image
*image;
Quantum
*q;
RectangleInfo
region;
ssize_t
i;
struct PackageInfo
*info;
SV
*perl_exception,
*reference; /* reference is the SV* of ref=SvIV(reference) */
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
reference=SvRV(ST(0));
av=(AV *) reference;
info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
exception);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
av=(AV *) NULL;
region.x=0;
region.y=0;
region.width=image->columns;
region.height=1;
if (items == 1)
(void) ParseAbsoluteGeometry(SvPV(ST(1),na),®ion);
channel=DefaultChannels;
{
SetPixelRed(image,ClampToQuantum(scale*SvNV(*(
av_fetch(av,i,0)))),q);
i++;
}
if (((GetPixelGreenTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelGreen(image,ClampToQuantum(scale*SvNV(*(
av_fetch(av,i,0)))),q);
i++;
}
if (((GetPixelBlueTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelBlue(image,ClampToQuantum(scale*SvNV(*(
av_fetch(av,i,0)))),q);
i++;
}
if ((((GetPixelBlackTraits(image) & UpdatePixelTrait) != 0) &&
(image->colorspace == CMYKColorspace)) && (i <= av_len(av)))
{
SetPixelBlack(image,ClampToQuantum(scale*
SvNV(*(av_fetch(av,i,0)))),q);
i++;
}
if (((GetPixelAlphaTraits(image) & UpdatePixelTrait) != 0) &&
(i <= av_len(av)))
{
SetPixelAlpha(image,ClampToQuantum(scale*
SvNV(*(av_fetch(av,i,0)))),q);
i++;
}
n++;
q+=image->number_channels;
}
(void) SyncAuthenticPixels(image,exception);
}
(void) SetImageChannelMask(image,channel_mask);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# S m u s h #
# #
# #
# #
###############################################################################
#
#
void
Smush(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
SmushImage = 1
smush = 2
smushimage = 3
PPCODE:
{
AV
*av;
char
*attribute;
ExceptionInfo
*exception;
HV
*hv;
Image
*image;
ssize_t
i,
offset,
stack;
struct PackageInfo
*info;
SV
*av_reference,
*perl_exception,
*reference,
*rv,
*sv;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
sv=NULL;
attribute=NULL;
av=NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
hv=SvSTASH(reference);
av=newAV();
av_reference=sv_2mortal(sv_bless(newRV((SV *) av),hv));
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
SvPV(ST(i),na));
if (stack < 0)
{
ThrowPerlException(exception,OptionError,"UnrecognizedType",
SvPV(ST(i),na));
return;
}
break;
}
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
default:
{
ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
attribute);
break;
}
}
}
image=SmushImages(image,stack != 0 ? MagickTrue : MagickFalse,offset,
exception);
if (image == (Image *) NULL)
goto PerlException;
for ( ; image; image=image->next)
{
AddImageToRegistry(sv,image);
rv=newRV(sv);
av_push(av,sv_bless(rv,hv));
SvREFCNT_dec(sv);
}
exception=DestroyExceptionInfo(exception);
ST(0)=av_reference;
SvREFCNT_dec(perl_exception);
XSRETURN(1);
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
sv_setiv(perl_exception,(IV) SvCUR(perl_exception) != 0);
SvPOK_on(perl_exception);
ST(0)=sv_2mortal(perl_exception);
XSRETURN(1);
}
#
###############################################################################
# #
# #
# #
# S t a t i s t i c s #
# #
# #
# #
###############################################################################
#
#
void
Statistics(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
StatisticsImage = 1
statistics = 2
statisticsimage = 3
PPCODE:
{
#define ChannelStatistics(channel) \
{ \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
(double) channel_statistics[channel].depth); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].minima/QuantumRange); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].maxima/QuantumRange); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].mean/QuantumRange); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].standard_deviation/QuantumRange); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].kurtosis); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].skewness); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
(void) FormatLocaleString(message,MagickPathExtent,"%.20g", \
channel_statistics[channel].entropy); \
PUSHs(sv_2mortal(newSVpv(message,0))); \
}
AV
*av;
char
message[MagickPathExtent];
ChannelStatistics
*channel_statistics;
ExceptionInfo
*exception;
Image
*image;
ssize_t
count;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
av=newAV();
SvREFCNT_dec(av);
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
count=0;
for ( ; image; image=image->next)
{
ssize_t
i;
channel_statistics=GetImageStatistics(image,exception);
if (channel_statistics == (ChannelStatistics *) NULL)
continue;
count++;
for (i=0; i < (ssize_t) GetPixelChannels(image); i++)
{
PixelChannel channel=GetPixelChannelChannel(image,i);
PixelTrait traits=GetPixelChannelTraits(image,channel);
if (traits == UndefinedPixelTrait)
continue;
EXTEND(sp,8*(i+1)*count);
ChannelStatistics(channel);
}
EXTEND(sp,8*(i+1)*count);
ChannelStatistics(CompositePixelChannel);
channel_statistics=(ChannelStatistics *)
RelinquishMagickMemory(channel_statistics);
}
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception);
}
#
###############################################################################
# #
# #
# #
# S y n c A u t h e n t i c P i x e l s #
# #
# #
# #
###############################################################################
#
#
void
SyncAuthenticPixels(ref,...)
Image::Magick ref = NO_INIT
ALIAS:
Syncauthenticpixels = 1
SyncImagePixels = 2
syncimagepixels = 3
CODE:
{
ExceptionInfo
*exception;
Image
*image;
MagickBooleanType
status;
struct PackageInfo
*info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
status=SyncAuthenticPixels(image,exception);
if (status != MagickFalse)
return;
PerlException:
InheritPerlException(exception,perl_exception);
exception=DestroyExceptionInfo(exception);
SvREFCNT_dec(perl_exception); /* throw away all errors */
}
#
###############################################################################
# #
# #
# #
# W r i t e #
# #
# #
# #
###############################################################################
#
#
void
Write(ref,...)
Image::Magick ref=NO_INIT
ALIAS:
WriteImage = 1
write = 2
writeimage = 3
PPCODE:
{
char
filename[MagickPathExtent];
ExceptionInfo
*exception;
Image
*image,
*next;
ssize_t
i,
number_images,
scene;
struct PackageInfo
*info,
*package_info;
SV
*perl_exception,
*reference;
PERL_UNUSED_VAR(ref);
PERL_UNUSED_VAR(ix);
exception=AcquireExceptionInfo();
perl_exception=newSVpv("",0);
number_images=0;
package_info=(struct PackageInfo *) NULL;
if (sv_isobject(ST(0)) == 0)
{
ThrowPerlException(exception,OptionError,"ReferenceIsNotMyType",
PackageName);
goto PerlException;
}
reference=SvRV(ST(0));
image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
if (image == (Image *) NULL)
{
ThrowPerlException(exception,OptionError,"NoImagesDefined",
PackageName);
goto PerlException;
}
scene=0;
for (next=image; next; next=next->next)
next->scene=(size_t) scene++;
package_info=ClonePackageInfo(info,exception);
if (items == 2)
SetAttribute(aTHX_ package_info,NULL,"filename",ST(1),exception);
else
if (items > 2)
for (i=2; i < items; i+=2)
SetAttribute(aTHX_ package_info,image,SvPV(ST(i-1),na),ST(i),
exception);
( run in 1.571 second using v1.01-cache-2.11-cpan-75ffa21a3d4 )