GD

 view release on metacpan or  search on metacpan

GD.xs  view on Meta::CPAN

			int *x1, int *y1, int *x2, int *y2)
{
   *x  = gdImageSX(src);
   *y  = gdImageSY(src);
   *x1 = *x - 1;
   *y1 = *y - 1;
   *x2 = *x / 2;
   *y2 = *y / 2;
}

/* helper macros for image transformations */
#define GDGetImagePixel(im,x,y) \
	gdImageTrueColor(im) ? \
	gdImageTrueColorPixel(im,x,y) : \
	gdImagePalettePixel(im,x,y)

#define GDSetImagePixel(im,x,y,p) \
	gdImageTrueColor(im) ? \
	(gdImageTrueColorPixel(im,x,y) = p) : \
	(gdImagePalettePixel(im,x,y) = p)

#define GDCopyImagePixel(dst,dx,dy,src,sx,sy) \
	gdImageTrueColor(src) ? \
	(gdImageTrueColorPixel(dst,dx,dy)=gdImageTrueColorPixel(src,sx,sy)) : \
	(gdImagePalettePixel(dst,dx,dy)=gdImagePalettePixel(src,sx,sy))

/* Check the image format being returned */
void
gd_chkimagefmt(GD__Image image, int truecolor) {
  if ((image != NULL)
      && !truecolor) {			/* return a palette image */
     if (gdImageTrueColor(image)) {
	gdImageTrueColorToPalette(image,1,gdMaxColors);
     }
  }
}

/* GLOBAL THREAD-SAFE DATA */

#ifdef START_MY_CXT

#define MY_CXT_KEY "GD::_guts" XS_VERSION
typedef struct {
  /* Current image true color default
   *  0 - create palette based images by default
   *  1 - create true color images by default
   */
  int truecolor_default;
} my_cxt_t;
#define truecolor_default MY_CXT.truecolor_default

START_MY_CXT
#endif

MODULE = GD		PACKAGE = GD

INCLUDE: const-xs.inc

void
VERSION_STRING()
    PPCODE:
    mXPUSHp(GD_VERSION_STRING,sizeof(GD_VERSION_STRING)-1);

void
LIBGD_VERSION()
    PPCODE:
    mXPUSHn(GD_VERSION/10000.0);

#if GD_VERSION >= 20101

bool
supportsFileType(char *filename, int writing=0)
  PROTOTYPE: $;$
  CODE:
    RETVAL = gdSupportsFileType(filename, writing);
  OUTPUT:
    RETVAL

#endif

BOOT:
{
#ifdef START_MY_CXT
   MY_CXT_INIT;
#endif
   truecolor_default = 0;
}

MODULE = GD		PACKAGE = GD::Image	PREFIX=gd

# Set the new image true color default
#   0 - create palette based images by default
#   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");

GD.xs  view on Meta::CPAN

    RETVAL = newSVpvn((char*) data,size);
    gdFree(data);
  OUTPUT:
    RETVAL

#endif

#ifdef HAVE_AVIF
SV*
gdavif(image, ...)
  GD::Image	image
         PROTOTYPE: $;$$
  PREINIT:
	SV* errormsg;
	void*         data;
	int           size;
        int           quality; // -1 for default
        int           speed;   // 6 is default
  CODE:
    if (items > 1) {
      quality=(int)SvIV(ST(1));
      speed=items > 2 ? (int)SvIV(ST(2)) : 6; // AVIF_SPEED_DEFAULT
      data = (void *) gdImageAvifPtrEx(image,&size,quality,speed);
    }
    else
      data = (void *) gdImageAvifPtr(image,&size);
    if (data == NULL) {
      errormsg = perl_get_sv("@",0);
      if (errormsg != NULL)
        sv_setpv(errormsg,"libgd was not built with avif support\n");
      else
        croak("gdImageAvifPtr error");
      XSRETURN_EMPTY;
    }
    RETVAL = newSVpvn((char*) data,size);
    gdFree(data);
  OUTPUT:
    RETVAL

#endif

int
gdtransparent(image, ...)
	GD::Image	image
  PROTOTYPE: $;$
  PREINIT:
	int color;
  CODE:
	if (items > 1) {
          color=(int)SvIV(ST(1));
          gdImageColorTransparent(image,color);
        }
        RETVAL = gdImageGetTransparent(image);
  OUTPUT:
	RETVAL

void
gdgetBounds(image)
	GD::Image	image
  PROTOTYPE: $
  PPCODE:
    mXPUSHi(gdImageSX(image));
    mXPUSHi(gdImageSY(image));

int
gdisTrueColor(image)
	GD::Image	image
  PROTOTYPE: $
  CODE:
    RETVAL = gdImageTrueColor(image);
  OUTPUT:
    RETVAL

void
gdtrueColorToPalette(image, dither=0, colors=gdMaxColors)
	GD::Image	image
	int		dither
	int		colors
  PROTOTYPE: $;$$
  CODE:
    gdImageTrueColorToPalette(image,dither,colors);

GD::Image
gdcreatePaletteFromTrueColor(image, dither=0, colors=gdMaxColors)
	GD::Image	image
	int		dither
	int		colors
  PROTOTYPE: $;$$
  CODE:
    RETVAL = gdImageCreatePaletteFromTrueColor(image,dither,colors);
    if (!RETVAL)
      croak("gdImageCreatePaletteFromTrueColor error");
  OUTPUT:
    RETVAL

#if GD_VERSION >= 20100

GD::Image
gdneuQuant(image, colors=gdMaxColors, samplefactor=5)
	GD::Image	image
	int		colors
	int		samplefactor
  PROTOTYPE: $;$$
  CODE:
    RETVAL = gdImageNeuQuant(image,colors,samplefactor);
    if (!RETVAL)
      XSRETURN_UNDEF;
  OUTPUT:
    RETVAL

# beware of CVE 2019-6977 https://bugs.php.net/bug.php?id=77270
# refuse to match truecolor with palette
int
gdcolorMatch(image, im2)
	GD::Image	image
	GD::Image	im2
  PROTOTYPE: $$
  CODE:
#if GD_VERSION <= 20205
  if (gdImageTrueColor(image) ^ gdImageTrueColor(im2))
    XSRETURN_UNDEF;
  else
#endif
    RETVAL = gdImageColorMatch(image,im2);
  OUTPUT:
    RETVAL

#endif

void
gdrgb(image,color)
	GD::Image	image
	int		color
  PROTOTYPE: $$
  PPCODE:
    mXPUSHi(gdImageRed(image,color));
    mXPUSHi(gdImageGreen(image,color));
    mXPUSHi(gdImageBlue(image,color));

void
gdalpha(image,color)
	GD::Image	image
	int		color
  PROTOTYPE: $$
  PPCODE:
    mXPUSHi(gdImageAlpha(image,color));

int
gdboundsSafe(image,x,y)
	GD::Image	image
	int		x
	int		y
  PROTOTYPE: $$$
  CODE:
    RETVAL = gdImageBoundsSafe(image,x,y);
    if (RETVAL == 0)
      XSRETURN_UNDEF;
  OUTPUT:
    RETVAL

int
gdgetPixel(image,x,y)
	GD::Image	image
	int		x
	int		y
  PROTOTYPE: $$$
  CODE:
    RETVAL = gdImageGetPixel(image,x,y);
  OUTPUT:
    RETVAL

void
gdsetPixel(image,x,y,color)
	GD::Image	image
	int		x
	int		y
	int		color
  PROTOTYPE: $$$$
  CODE:
    gdImageSetPixel(image,x,y,color);

GD::Image
gdcopyRotate90(src)
	GD::Image	src
  PROTOTYPE: $
  PREINIT:
	int x, y, x1, y1, x2, y2, i, j;
  CODE:
	get_xformbounds(src, &x, &y, &x1, &y1, &x2, &y2);
	RETVAL = gd_cloneDim(src, y, x);

	for (j=0; j<y; j++) {
	   for (i=0; i<x; i++) {
	      GDCopyImagePixel(RETVAL, y1-j, i, src, i, j);
	   }
	}
  OUTPUT:
  	RETVAL

GD::Image
gdcopyRotate180(src)
	GD::Image	src
  PROTOTYPE: $
  PREINIT:
	int x, y, x1, y1, x2, y2, i, j;

GD.xs  view on Meta::CPAN


void
gdcharUp(image,font,x,y,c,color)
	GD::Image	image
	GD::Font	font
	int		x
	int		y
	char *		c
	int		color
  PROTOTYPE: $$$$$$
  CODE:
    gdImageCharUp(image,font,x,y,*c,color);

void
gdstring(image,font,x,y,s,color)
	GD::Image	image
	GD::Font	font
	int		x
	int		y
	char *		s
	int		color
  PROTOTYPE: $$$$$$
  CODE:
    gdImageString(image,font,x,y,(unsigned char*)s,color);

void
gdstringUp(image,font,x,y,s,color)
	GD::Image	image
	GD::Font	font
	int		x
	int		y
	char *		s
	int		color
  PROTOTYPE: $$$$$$
  CODE:
    gdImageStringUp(image,font,x,y,(unsigned char*)s,color);

void
gdstringFT(image,fgcolor,fontname,ptsize,angle,x,y,string,...)
        SV *	        image
        int             fgcolor
	char *          fontname
	double          ptsize
	double          angle
	int		x
        int             y
        char *          string
  PROTOTYPE: $$$$$$$$;$
  PREINIT:
	  gdImagePtr img;
	  int        brect[8];
	  char       *err;
          char       *a;
	  SV*        errormsg;
          HV*        hash;
          SV**       value;
	  int        i;
          int        hdpi;
          int        vdpi;
          gdFTStringExtra strex;
  PPCODE:
  {
#ifndef HAVE_FT
  	errormsg = perl_get_sv("@",0);
	sv_setpv(errormsg,"libgd was not built with FreeType font support\n");
	XSRETURN_EMPTY;
#endif
        if (sv_isobject(image) && sv_derived_from(image, "GD::Image")) {
          IV tmp = SvIV((SV*)SvRV(image));
          img = (gdImagePtr) tmp;
        } else {
          img = NULL;
        }

        if (items == 9) {  /* hashref options at end */
          if (SvTYPE(SvRV(ST(8))) != SVt_PVHV)
            croak ("Usage: $gd->stringFT(image,fgcolor,fontname,ptsize,angle,x,y,string,[{options}])");
          hash  = (HV*)SvRV(ST(8));
          strex.flags       = 0;
          strex.linespacing = 0;
          strex.charmap     = 0;
          if ((value = hv_fetchs(hash,"linespacing",0))) {
            strex.flags |= gdFTEX_LINESPACE;
            strex.linespacing = SvNV(*value);
          }
          if ((value = hv_fetchs(hash,"charmap",0))) {
            strex.flags |= gdFTEX_CHARMAP;
            if (strEQ(SvPV_nolen(*value),"Unicode"))
              strex.charmap = gdFTEX_Unicode;
            else if (strEQ(SvPV_nolen(*value),"Shift_JIS"))
              strex.charmap = gdFTEX_Shift_JIS;
            else if (strEQ(SvPV_nolen(*value),"Big5"))
              strex.charmap = gdFTEX_Big5;
            else
              croak("Unknown charmap %s",SvPV_nolen(*value));
          }
#ifdef VERSION_33
          if ((value = hv_fetchs(hash,"resolution",0))) {
            strex.flags |= gdFTEX_RESOLUTION;
            a = SvPV_nolen(*value);
            if (sscanf(a,"%d,%d",&hdpi,&vdpi) == 2) {
              strex.hdpi = hdpi;
              strex.vdpi = vdpi;
            }
          }
          if ((value = hv_fetchs(hash,"kerning",0))) {
            if (!SvTRUE(*value)) {
              strex.flags |= gdFTEX_DISABLE_KERNING;
            }
            else
              strex.flags &= gdFTEX_DISABLE_KERNING;
          }
#endif
          err = gdImageStringFTEx(img,brect,fgcolor,fontname,ptsize,angle,x,y,string,&strex);
        }

        else {
          err = gdImageStringFT(img,brect,fgcolor,fontname,ptsize,angle,x,y,string);
        }
        if (err) {
          errormsg = perl_get_sv("@",0);

GD.xs  view on Meta::CPAN

        PERL_UNUSED_ARG(radius);
        PERL_UNUSED_ARG(textRadius);
        PERL_UNUSED_ARG(fillPortion);
        PERL_UNUSED_ARG(fontname);
        PERL_UNUSED_ARG(points);
        PERL_UNUSED_ARG(top);
        PERL_UNUSED_ARG(bottom);
        PERL_UNUSED_ARG(fgcolor);
  	errormsg = perl_get_sv("@",0);
	sv_setpv(errormsg,"libgd was not built with FreeType support\n");
	XSRETURN_EMPTY;
#endif
  }
  OUTPUT:
    RETVAL

int
gduseFontConfig(image,flag)
     SV*         image
     int         flag
  PROTOTYPE: $$
  CODE:
  {
    PERL_UNUSED_ARG(image);
#ifdef HAVE_FONTCONFIG
    RETVAL = gdFTUseFontConfig(flag);
#else
    SV* errormsg;
    PERL_UNUSED_ARG(flag);
    errormsg = perl_get_sv("@",0);
    sv_setpv(errormsg,"libgd was not built with fontconfig support\n");
    XSRETURN_EMPTY;
#endif
  }
  OUTPUT:
    RETVAL

void
gdalphaBlending(image,blending)
     GD::Image       image
     int             blending
  PROTOTYPE: $$
  CODE:
    gdImageAlphaBlending(image,blending);

void
gdsaveAlpha(image,saveAlphaArg)
     GD::Image       image
     int             saveAlphaArg
  PROTOTYPE: $$
  CODE:
    gdImageSaveAlpha(image,saveAlphaArg);

void
gdclip(image,...)
	GD::Image	image
  PROTOTYPE: $;$$$$
  PREINIT:
        int		coords[4];
        int             i;
  PPCODE:
    if (items == 5) {
      for (i=0; i<4; i++)
        coords[i] = (int)SvIV(ST(i+1));
      gdImageSetClip(image,coords[0],coords[1],coords[2],coords[3]);
    }
    else if (items > 1) /* something weird */
      croak("Usage: $gd->clip() or $gd->clip(x1,x2,y1,y2)");
    
    gdImageGetClip(image,&coords[0],&coords[1],&coords[2],&coords[3]);
    EXTEND(sp,4);
    for (i=0; i<4; i++)
      mPUSHi(coords[i]);

void
gdsetAntiAliased(image,color)
     GD::Image       image
     int             color
  PROTOTYPE: $$
  CODE:
    gdImageSetAntiAliased(image,color);

void
gdsetAntiAliasedDontBlend(image,color,flag=1)
     GD::Image       image
     int             color
     int             flag
  PROTOTYPE: $$$
  CODE:
    gdImageSetAntiAliasedDontBlend(image,color,flag);

MODULE = GD		PACKAGE = GD::Font	PREFIX=gd

GD::Font
gdload(packname="GD::Font",fontpath)
     char * packname
     char * fontpath
  PROTOTYPE: $$
  PREINIT:
       int             fontfile;
       int             datasize;
       SV*             errormsg;
       char            errstr[256];
       gdFontPtr       font;
       unsigned char   word[4];
       char*           fontdata;
  CODE:
    PERL_UNUSED_ARG(packname);
    fontfile = open(fontpath,O_RDONLY);
    if (fontfile < 0) {
      errormsg = perl_get_sv("@",0);
      snprintf(errstr,256,"could not open font file %s: %s",fontpath,strerror(errno));
      sv_setpv(errormsg,errstr);
      XSRETURN_EMPTY;
    }
    font = (gdFontPtr)safemalloc(sizeof(gdFont));
    if (font == NULL)
      croak("safemalloc() returned NULL while trying to allocate font struct.\n");
    /* read header from font - note that the file is assumed to be littleendian*/
    if (read(fontfile,word,4) < 4)
      croak("error while reading font file: %s",strerror(errno));



( run in 0.560 second using v1.01-cache-2.11-cpan-5511b514fd6 )