view release on metacpan or  search on metacpan

perl-libpng.c  view on Meta::CPAN

static SV *
perl_png_get_eXIf (perl_libpng_t * png)
{
    SV * exif = & PL_sv_undef;
#ifdef PNG_eXIf_SUPPORTED
    if (VALID (eXIf)) {
	png_uint_32 num_exif;
	png_bytep exif_buf;
	
	png_get_eXIf_1 (png->png, png->info, & num_exif, & exif_buf);
	exif = newSVpvn ((const char *) exif_buf, (STRLEN) num_exif);
    }
#else /*  PNG_eXIf_SUPPORTED */
    UNSUPPORTED (eXIf);
#endif /*  PNG_eXIf_SUPPORTED */
    return exif;
}

static void
perl_png_set_eXIf (perl_libpng_t * png, SV * exif)
{
#ifdef PNG_eXIf_SUPPORTED
    png_uint_32 num_exif;
    png_const_bytep exif_buf;
    STRLEN exif_len;
    
    exif_buf = (const png_bytep) SvPV (exif, exif_len);
    num_exif = (png_uint_32) exif_len;

    png_set_eXIf_1 (png->png, png->info, num_exif, (png_bytep) exif_buf);
#else /*  PNG_eXIf_SUPPORTED */
    UNSUPPORTED (eXIf);
#endif /*  PNG_eXIf_SUPPORTED */
}

/*
  Make a new entry in "split" using "name" as the key, with "len"
  bytes of memory. We tried newSV(len) but it didn't work,
  because we didn't know how to turn that into anything other
  than "undef", but assigning with an empty string but with the
  length of data that we need seems to work to get us the length
  of data we want, and the string value of the data that we
  insert is also accessible by Perl. 
*/

static void
perl_png_set_back(perl_libpng_t * png, HV * perl_color, int gamma_code,
		  int need_expand, double background_gamma)
{
    png_color_16 color;
#ifdef PNG_READ_BACKGROUND_SUPPORTED
    perl_png_hv_to_color_16 (perl_color, & color);
    png_set_background (png->png, & color, gamma_code,
			need_expand, background_gamma);
#else
    UNSUPPORTED("READ_BACKGROUND");
#endif /* READ_BACKGROUND */
}

static void
perl_png_init_io_x (perl_libpng_t * Png, SV * fpsv)
{
    FILE * fp;
    PerlIO *io;
    IO * scalar;
    scalar = sv_2io (fpsv);
    if (! scalar) {
	croak ("init_io: sv_2io failed: not an io scalar?");
    }
    io = IoIFP (scalar);
    if (! io) {
	croak ("init_io: IoIFP failed: scalar's file handle is NULL");
    }
    Png->io_sv = SvREFCNT_inc (fpsv);
    Png->memory_gets++;
    fp = PerlIO_findFILE (io);
    png_init_io (Png->png, fp);
    Png->init_io_done = 1;
}
 

static void
perl_png_set_quantize (perl_libpng_t * png, AV * palette,
		       int max_screen_colors, AV * histogram,
		       int full_quantize)
{
#ifdef PNG_READ_QUANTIZE_SUPPORTED
    int n_colors;
    png_colorp colors;
    png_uint_16p hist;

    perl_png_av_to_colors (png, palette, & colors, & n_colors);
    if (n_colors == 0) {
	croak ("set_quantize: empty palette");
    }
    hist = 0;
    if (av_len (histogram) + 1 > 0) {
	int hist_size;
	av_to_hist (png, histogram, & hist, & hist_size, n_colors);
    }
    png_set_quantize (png->png, colors, n_colors, max_screen_colors,
		      hist, full_quantize);
    PERL_PNG_FREE (colors);
    if (hist != 0) {
	PERL_PNG_FREE (hist);
    }
#else
    UNSUPPORTED(READ_QUANTIZE);
#endif /* #ifdef PNG_READ_QUANTIZE_SUPPORTED */
}


static void
perl_png_check_x_y (perl_libpng_t * png, int x, int y)
{
    if (x < 0 || y < 0) {
	croak ("x (%d) or y (%d) < 0", x, y);
    }
    if (x >= png->width) {
	croak ("x (%d) > width %d", x, png->width);
    }
    if (y >= png->height) {
	croak ("y (%d) > height %d", y, png->height);
    }
}

static void
perl_png_get_image_data (perl_libpng_t * png)
{
    png_get_IHDR (pngi, &png->width, &png->height,
		  &png->bit_depth, &png->color_type, 0,
		  UNUSED_ZERO_ARG, UNUSED_ZERO_ARG);
    if (!png->row_pointers) {
    	png->row_pointers = png_get_rows (pngi);
	png->row_pointers_ours = 0;
    }
    png->rowbytes = png_get_rowbytes (pngi);
    if (png->type != perl_png_read_obj) {