josiah47 has asked for the wisdom of the Perl Monks concerning the following question:

Hello, I would like to be able to pass the memory of GD::Image object to the inline C code instead of saving to file and then opening that in the inline C. Is this possible and if so, can someone lead me to some docs or examples...

use Inline C => DATA => LIBS => '-lgd'; use GD::Image; use Barcode::Code128; my $labelgd = new GD::Image(808,200); my $white = $labelgd->colorAllocate(255,255,255); my $black = $labelgd->colorAllocate(0,0,0); my $red = $labelgd->colorAllocate(255, 0, 0); my $arg_ref; my @text; push (@text,{ 'ptsize' => 112, 'xcoord' => 40, 'ycoord' => 135, 'text' + => 'location' }); push (@text,{ 'ptsize' => 14, 'xcoord' => 40, 'ycoord' => 190, 'text' +=> 'L'.'recid' }); $arg_ref->{'text'} = \@text; # Process Text objects to be placed on label my $font = '/usr/share/fonts/truetype/liberation/LiberationMono-Bold.t +tf'; if ($arg_ref->{'text'}) { for (my $i = 0; $i < scalar @{$arg_ref->{'text'}}; $i++) { $labelgd->stringFT( -$black, $font, @{$arg_ref->{'text'}[$i]}{'ptsize'}, @{$arg_ref->{'text'}[$i]}{'angle'} ? @{$arg_ref->{'text'}[ +$i]}{'angle'} : 0, @{$arg_ref->{'text'}[$i]}{'xcoord'}, @{$arg_ref->{'text'}[$i]}{'ycoord'}, @{$arg_ref->{'text'}[$i]}{'text'} ); } } my $labelgdfile = "label.png"; open (PNG, "> ".$labelgdfile) or die "Can't write $labelgdfile: $!\n"; binmode (PNG); print PNG $labelgd->png; close (PNG); my $raw_image = pack "H*" , process_image($labelgdfile); # ~warn $raw_image,$raw_width,$raw_height; #~ warn $raw_image; __END__ __C__ #include <gd.h> #include <stdio.h> #include <stdlib.h> #include <string.h> void abort_(const char * s, ...) { va_list args; va_start(args, s); vfprintf(stderr, s, args); fprintf(stderr, "\n"); va_end(args); abort(); } SV* process_image(char* file_name) { FILE *fp = fopen(file_name, "rb"); if (!fp) abort_("[read_png_file] File %s could not be opened fo +r reading", file_name); gdImagePtr im; im = gdImageCreateFromPng(fp); char *raw_hex_image_string = (char *)malloc( ( gdImageSX(im) * + gdImageSY(im))+1); raw_hex_image_string[0] = '\0'; int y; for (y=0; y<gdImageSY(im); y++) { int x; for (x=0; x<gdImageSX(im); x+=4) { int four_tuple[4]; int k = 0; for ( k=0; k<= 3; k++) { int pixel; pixel = gdImageGetPixel(im,(x+k),y); if (gdImageRed(im,pixel) > 0 || gdImag +eGreen(im,pixel) > 0 || gdImageBlue(im,pixel) > 0) { four_tuple[k] = 1; } else { four_tuple[k] = 0; } } int first_nibble = 0; first_nibble = (first_nibble << 1) | four_tupl +e[0]; first_nibble = (first_nibble << 1) | four_tupl +e[1]; first_nibble = (first_nibble << 1) | four_tupl +e[2]; first_nibble = (first_nibble << 1) | four_tupl +e[3]; char hexval; switch ( first_nibble ) { case 0: hexval = '0'; break; case 1: hexval = '1'; break; case 2: hexval = '2'; break; case 3: hexval = '3'; break; case 4: hexval = '4'; break; case 5: hexval = '5'; break; case 6: hexval = '6'; break; case 7: hexval = '7'; break; case 8: hexval = '8'; break; case 9: hexval = '9'; break; case 10: hexval = 'A'; break; case 11: hexval = 'B'; break; case 12: hexval = 'C'; break; case 13: hexval = 'D'; break; case 14: hexval = 'E'; break; case 15: hexval = 'F'; break; default: hexval = 'F'; break; } int o; for(o=0; raw_hex_image_string[o]!='\0'; ++o); raw_hex_image_string[o]=hexval; raw_hex_image_string[o+1]='\0'; } } gdImageDestroy(im); fclose(fp); SV * retval = newSVpvf("%s", raw_hex_image_string); free(raw_hex_image_string); return retval; }

Replies are listed 'Best First'.
Re: Passing GD::Image object to Inline C
by Anonymous Monk on Aug 19, 2014 at 12:38 UTC

    On perl side, use the in-memory open for the image file. C code needs a different import method; should be a trivial modification. Like this perhaps (completely untested):

    open(PNG, '>', \my $img_data); ...; print PNG ... process_image($img_data); __C__ SV* process_image(SV *image_data) { { STRLEN dlen; SV *data = SvPV(image_data, dlen); gdImagePtr im = gdImageCreateFromPngPtr(dlen, data); ... }

Re: Passing GD::Image object to Inline C
by Anonymous Monk on Aug 19, 2014 at 12:02 UTC
    From PerlXS http://perldoc.perl.org/perlxstut.html Look for "More about XSUB arguments" - shows how to pass by reference, you should be able to apply this is Inline C since it utilizes XS.