GD

 view release on metacpan or  search on metacpan

GD.xs  view on Meta::CPAN

#       define PERL_SUBVERSION  SUBVERSION
        /* Replace PERL_PATCHLEVEL with PERL_VERSION */
        /* Replace: 0 */
#   endif
#endif

#if (PERL_VERSION == 5) && (PERL_SUBVERSION==3)
#ifndef PL_na
# define PL_na na
#endif
#ifndef SvPV_nolen
# define SvPV_nolen(sv) SvPV(sv, PL_na)
#endif
#endif /* 5.00503 */

#ifndef dMY_CXT
# define dMY_CXT (void)0
#endif
#ifndef PERL_UNUSED_ARG
# define PERL_UNUSED_ARG(x) ((void)sizeof(x))
#endif

#ifndef mPUSHp
#define mPUSHp(p,l)	PUSHs(sv_2mortal(newSVpvn((p), (l))))
#endif
#ifndef mPUSHi
#define mPUSHi(i)	PUSHs(sv_2mortal(newSViv((i))))
#endif
#ifndef mPUSHn
#define mPUSHn(n)	PUSHs(sv_2mortal(newSVnv((n))))
#endif
#ifndef mXPUSHp
# define mXPUSHp(p,l)	STMT_START { EXTEND(sp,1); mPUSHp((p), (l)); } STMT_END
#endif
#ifndef mXPUSHi
# define mXPUSHi(i)	STMT_START { EXTEND(sp,1); mPUSHi((i)); } STMT_END
#endif
#ifndef mXPUSHn
# define mXPUSHn(i)	STMT_START { EXTEND(sp,1); mPUSHn((i)); } STMT_END
#endif
#ifndef hv_fetchs
# define hv_fetchs(H, K, L) hv_fetch((H), (K), sizeof(K)-1, (L))
#endif

#if defined(_MSC_VER) && _MSC_VER < 1900
# define snprintf _snprintf
#endif

#ifndef START_MY_CXT
static int truecolor_default = 0;
#endif

#include "const-c.inc"

typedef gdImagePtr	GD__Image;
typedef gdFontPtr	GD__Font;
typedef PerlIO          * InputStream;

#ifdef PERL_OBJECT
#  ifdef WIN32
#define GDIMAGECREATEFROMPNG(x)  gdImageCreateFromPng((FILE*)x)
#define GDIMAGECREATEFROMXBM(x)  gdImageCreateFromXbm((FILE*)x)
#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg((FILE*)x)
#define GDIMAGECREATEFROMGIF(x)  gdImageCreateFromGif((FILE*)x)
#define GDIMAGECREATEFROMWBMP(x) gdImageCreateFromWBMP((FILE*)x)
#define GDIMAGECREATEFROMBMP(x)  gdImageCreateFromBmp((FILE*)x)
#define GDIMAGECREATEFROMTIFF(x) gdImageCreateFromTiff((FILE*)x)
#define GDIMAGECREATEFROMGD(x)   gdImageCreateFromGd((FILE*)x)
#define GDIMAGECREATEFROMGD2(x)  gdImageCreateFromGd2((FILE*)x)
#define GDIMAGECREATEFROMGD2PART(x,a,b,c,d) gdImageCreateFromGd2Part((FILE*)x,a,b,c,d)
#define GDIMAGECREATEFROMWEBP(x)  gdImageCreateFromWebp((FILE*)x)
#define GDIMAGECREATEFROMHEIF(x)  gdImageCreateFromHeif((FILE*)x)
#define GDIMAGECREATEFROMAVIF(x)  gdImageCreateFromAvif((FILE*)x)
#  endif
#else
#  ifdef USE_PERLIO
#define GDIMAGECREATEFROMPNG(x) gdImageCreateFromPng(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMXBM(x) gdImageCreateFromXbm(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGIF(x)  gdImageCreateFromGif(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMWBMP(x) gdImageCreateFromWBMP(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMBMP(x)  gdImageCreateFromBmp(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMTIFF(x) gdImageCreateFromTiff(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGD(x) gdImageCreateFromGd(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGD2(x) gdImageCreateFromGd2(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMGD2PART(x,a,b,c,d) gdImageCreateFromGd2Part(PerlIO_findFILE(x),a,b,c,d)
#define GDIMAGECREATEFROMWEBP(x) gdImageCreateFromWebp(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMHEIF(x) gdImageCreateFromHeif(PerlIO_findFILE(x))
#define GDIMAGECREATEFROMAVIF(x) gdImageCreateFromAvif(PerlIO_findFILE(x))
#  else
#define GDIMAGECREATEFROMPNG(x) gdImageCreateFromPng(x)
#define GDIMAGECREATEFROMXBM(x) gdImageCreateFromXbm(x)
#define GDIMAGECREATEFROMJPEG(x) gdImageCreateFromJpeg(x)
#define GDIMAGECREATEFROMGIF(x) gdImageCreateFromGif(x)
#define GDIMAGECREATEFROMWBMP(x) gdImageCreateFromWBMP(x)
#define GDIMAGECREATEFROMBMP(x)  gdImageCreateFromBmp(x)
#define GDIMAGECREATEFROMTIFF(x) gdImageCreateFromTiff(x)
#define GDIMAGECREATEFROMGD(x) gdImageCreateFromGd(x)
#define GDIMAGECREATEFROMGD2(x) gdImageCreateFromGd2(x)
#define GDIMAGECREATEFROMGD2PART(x,a,b,c,d) gdImageCreateFromGd2Part(x,a,b,c,d)
#define GDIMAGECREATEFROMWEBP(x) gdImageCreateFromWebp(x)
#define GDIMAGECREATEFROMHEIF(x) gdImageCreateFromHeif(x)
#define GDIMAGECREATEFROMAVIF(x) gdImageCreateFromAvif(x)
#  endif
#endif

#define littleendian(a) \
    (a[3]<<24)+(a[2]<<16)+(a[1]<<8)+a[0]

/* definitions required to create images from in-memory buffers */
		     
typedef struct bufIOCtx {
  gdIOCtx    ctx;
  char*      data;
  int        length;
  int        pos;
} bufIOCtx;

typedef struct bufIOCtx *bufIOCtxPtr;

static int bufGetC (gdIOCtxPtr ctx) {
  bufIOCtxPtr bctx = (bufIOCtxPtr) ctx;

  if (bctx->pos >= bctx->length) return EOF;
  return bctx->data[bctx->pos];
}

static int bufGetBuf (gdIOCtxPtr ctx, void* buf, int len) {
  bufIOCtxPtr bctx = (bufIOCtxPtr) ctx;
  int remain,rlen;

  remain = bctx->length - bctx->pos;
  if (remain >= len) {
    rlen = len;
  } else {
    if (remain <= 0) return EOF;
    rlen = remain;
  }
  memcpy(buf,(void*)(bctx->data + bctx->pos),rlen);
  bctx->pos += rlen;
  return rlen;
}

static int bufSeek (gdIOCtxPtr ctx, const int pos) {
  bufIOCtxPtr bctx = (bufIOCtxPtr) ctx;
  bctx->pos = pos;
  if (bctx->pos > bctx->length)
    bctx->pos = bctx->length;
  return TRUE;
}

GD.xs  view on Meta::CPAN

#   1 - create true color images by default
int
gdtrueColor(packname="GD::Image", ...)
	char *	packname
  PROTOTYPE: $$
  PREINIT:
        dMY_CXT;
        int previous_value = truecolor_default;
  CODE:
        PERL_UNUSED_ARG(packname);
        if (items > 1)
          truecolor_default = (int)SvIV(ST(1));
        RETVAL = previous_value;
  OUTPUT:
        RETVAL

GD::Image
gd_new(packname="GD::Image", x=64, y=64, ...)
	char *	packname
	int	x
	int	y
  PROTOTYPE: $;$$$
  PREINIT:
        gdImagePtr theImage;
        dMY_CXT;
        int truecolor = truecolor_default;
  CODE:
    PERL_UNUSED_ARG(packname);
    if (items > 3)
      truecolor = (int)SvIV(ST(3));
    if (truecolor) {
      theImage = (GD__Image) gdImageCreateTrueColor(x,y);
      if (!theImage)
        croak("gdImageCreateTrueColor error");
    } else {
      theImage = (GD__Image) gdImageCreate(x,y);
      if (!theImage)
        croak("gdImageCreate error");
    }
    RETVAL = theImage;
  OUTPUT:
    RETVAL

#if GD_VERSION >= 20101

bool
gd_file(image, filename)
      GD::Image image
      char *	filename
  PROTOTYPE: $$
  CODE:
    RETVAL = gdImageFile(image, filename);
  OUTPUT:
    RETVAL

#endif

    
#ifdef HAVE_PNG
GD::Image
gd_newFromPng(packname="GD::Image", filehandle, ...)
	char *	packname
	InputStream	filehandle
  PROTOTYPE: $$;$
  PREINIT:
        dMY_CXT;
        int truecolor = truecolor_default;
  CODE:
	PERL_UNUSED_ARG(packname);
	RETVAL = (GD__Image) GDIMAGECREATEFROMPNG(filehandle);
        if (!RETVAL)
          croak("gdImageCreateFromPng error");
        if (items > 2) truecolor = (int)SvIV(ST(2));
	gd_chkimagefmt(RETVAL, truecolor);
  OUTPUT:
	RETVAL

GD::Image
gdnewFromPngData(packname="GD::Image", imageData, ...)
	char *	packname
	SV *	imageData
  PROTOTYPE: $$;$
  PREINIT:
	gdIOCtx* ctx;
        char*    data;
        STRLEN   len;
	dMY_CXT;
        int truecolor = truecolor_default;
  CODE:
	PERL_UNUSED_ARG(packname);
	data = SvPV(imageData,len);
        ctx = newDynamicCtx(data,len);
	RETVAL = (GD__Image) gdImageCreateFromPngCtx(ctx);
        (ctx->gd_free)(ctx);
        if (!RETVAL)
          croak("gdImageCreateFromPngCtx error");
        if (items > 2) truecolor = (int)SvIV(ST(2));
	gd_chkimagefmt(RETVAL, truecolor);
  OUTPUT:
	RETVAL

#endif

#ifdef HAVE_GD2
GD::Image
gdnewFromGdData(packname="GD::Image", imageData)
	char *	packname
	SV *	imageData
  PROTOTYPE: $$
  PREINIT:
        char*    data;
        STRLEN   len;
  CODE:
	PERL_UNUSED_ARG(packname);
	data = SvPV(imageData,len);
	RETVAL = (GD__Image) gdImageCreateFromGdPtr(len,(void*) data);
        if (!RETVAL)
          croak("gdImageCreateFromGdPtr error");
  OUTPUT:
	RETVAL

GD::Image
gdnewFromGd2Data(packname="GD::Image", imageData)
	char *	packname
	SV *	imageData
  PROTOTYPE: $$
  PREINIT:
          char*    data;
          STRLEN   len;
  CODE:
        PERL_UNUSED_ARG(packname);
	data = SvPV(imageData,len);
	RETVAL = (GD__Image) gdImageCreateFromGd2Ptr(len,(void*) data);
        if (!RETVAL)
          croak("gdImageCreateFromGd2Ptr error");
  OUTPUT:
	RETVAL

#endif

#ifdef HAVE_JPEG
GD::Image
gdnewFromJpegData(packname="GD::Image", imageData, ...)
	char *	packname
	SV *    imageData
  PROTOTYPE: $$;$
  PREINIT:
	gdIOCtx* ctx;
        char*    data;
        STRLEN   len;
	dMY_CXT;
	int     truecolor = truecolor_default;
  CODE:
	PERL_UNUSED_ARG(packname);
	data = SvPV(imageData,len);
        ctx = newDynamicCtx(data,len);

GD.xs  view on Meta::CPAN


#endif

void
gdDESTROY(image)
	GD::Image	image
  PROTOTYPE: $
  CODE:
	gdImageDestroy(image);

SV* gdSTORABLE_freeze(image,cloning)
     GD::Image image
     int       cloning
  PROTOTYPE: $$
  CODE:
     {
       void*     data;
       int       size;

       if (cloning) XSRETURN_UNDEF;
       data = gdImageGd2Ptr(image,0,GD2_FMT_COMPRESSED,&size);
       if (!data)
         croak("gdImageGd2Ptr error");
       RETVAL = newSVpvn((char*)data,size);
       gdFree(data);
     }
  OUTPUT:
     RETVAL

void gdSTORABLE_thaw(object,cloning,serialized)
     SV*      object
     int      cloning
     SV*      serialized
  PREINIT:
     STRLEN    length;
     void*     data;
     GD__Image image;
  CODE:
     {
       if (cloning) XSRETURN_UNDEF;
       data = (void*) SvPV(serialized,length);
       image = gdImageCreateFromGd2Ptr(length,data);
       if (!image)
         croak("gdImageCreateFromGd2Ptr error");
       sv_setiv(SvRV(object),(IV)image);
     }

#ifdef HAVE_PNG
SV*
gdpng(image, ...)
	GD::Image	image
  PROTOTYPE: $;$
  PREINIT:
  CODE:
  {
	void*         data;
	int           size;
	int           level;
        if (items > 1) {
	  level = (int)SvIV(ST(1));
	  data  = (void *) gdImagePngPtrEx(image,&size,level);
          if (!data)
            croak("gdImagePngPtrEx error");
	} else {
	  data = (void *) gdImagePngPtr(image,&size);
          if (!data)
            croak("gdImagePngPtr error");
	}
	RETVAL = newSVpvn((char*) data,size);
	gdFree(data);
  }
  OUTPUT:
    RETVAL

#endif

#ifdef HAVE_JPEG
SV*
gdjpeg(image,quality=-1)
  GD::Image	image
  int           quality
  PROTOTYPE: $
  PREINIT:
	SV* errormsg;
	void*         data;
	int           size;
  CODE:
    data = (void *) gdImageJpegPtr(image,&size,quality);
    if (data == NULL) {
      errormsg = perl_get_sv("@",0);
      if (errormsg != NULL)
        sv_setpv(errormsg,"libgd was not built with jpeg support\n");
      else
        croak("gdImageJpegPtr error");
      XSRETURN_EMPTY;
    }
    RETVAL = newSVpvn((char*) data,size);
    gdFree(data);
  OUTPUT:
    RETVAL

#endif

SV*
gdgifanimbegin(image,globalcm=-1,loops=-1)
  GD::Image	image
  int           globalcm
  int           loops
  PROTOTYPE: $$$
  PREINIT:
	void*         data;
	int           size;
  CODE:
#ifdef HAVE_GIFANIM
    data = (void *) gdImageGifAnimBeginPtr(image,&size,globalcm,loops);
    if (!data)
      croak("gdImageGifAnimBeginPtr error");
    RETVAL = newSVpvn((char*) data,size);
    gdFree(data);
#else
    PERL_UNUSED_ARG(data);
    PERL_UNUSED_ARG(size);
    PERL_UNUSED_ARG(image);
    PERL_UNUSED_ARG(globalcm);
    PERL_UNUSED_ARG(loops);
    die("libgd 2.0.33 or higher required for animated GIF support");
#endif



( run in 2.833 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )