-# T r a n s f o r m #
-# #
-# #
-# #
-###############################################################################
-#
-#
-void
-Transform(ref,...)
- Image::Magick ref=NO_INIT
- ALIAS:
- TransformImage = 1
- transform = 2
- transformimage = 3
- PPCODE:
- {
- AV
- *av;
-
- char
- *attribute,
- *crop_geometry,
- *geometry;
-
- ExceptionInfo
- *exception;
-
- HV
- *hv;
-
- Image
- *clone,
- *image;
-
- register 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;
- 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;
- }
- info=GetPackageInfo(aTHX_ (void *) av,info,exception);
- /*
- Get attribute.
- */
- crop_geometry=(char *) NULL;
- geometry=(char *) NULL;
- for (i=2; i < items; i+=2)
- {
- attribute=(char *) SvPV(ST(i-1),na);
- switch (*attribute)
- {
- case 'c':
- case 'C':
- {
- if (LocaleCompare(attribute,"crop") == 0)
- {
- crop_geometry=SvPV(ST(i),na);
- break;
- }
- ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
- attribute);
- break;
- }
- case 'g':
- case 'G':
- {
- if (LocaleCompare(attribute,"geometry") == 0)
- {
- geometry=SvPV(ST(i),na);
- break;
- }
- ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
- attribute);
- break;
- }
- default:
- {
- ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
- attribute);
- break;
- }
- }
- }
- for ( ; image; image=image->next)
- {
- clone=CloneImage(image,0,0,MagickTrue,exception);
- if (clone == (Image *) NULL)
- goto PerlException;
- TransformImage(&clone,crop_geometry,geometry,exception);
- for ( ; clone; clone=clone->next)
- {
- AddImageToRegistry(sv,clone);
- 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);
- }
-\f
-#
-###############################################################################
-# #
-# #
-# #