direct access to pixels

[rmabry]

The PerlMagick doc concerning "direct access to pixels" tantalizingly suggests what I need. But I have no clue how to use it. Any "pointers" (heh heh) would be appreciated; a tiny example would be most welcome.

Code: Select all

GetAuthenticPixels ... return authentic pixels as a C pointer

A "C pointer" in Perl sounds interesting and dangerous. Regardless, I can get what looks to be a pointer (it gives large numbers that change each time) like so, but I don't know what to do with it.

Code: Select all

use Image::Magick;
$image = new Image::Magick;
$image->ReadImage('rose:'); 

$pixelptr = $image->GetAuthenticPixels( height=>3, width=>2, x=>5, y=>5);

I tried naively treating the pointer as being to an array, but was unable to read any elements

In any case, using Fx and/or GetPixel/SetPixel is very slow, for obvious reasons,so I'm looking for something more efficient for manipulating large numbers of pixels. (I've perused an earlier post, HERE, which seemed to end uncertainly.)

Thanks,

Rick

[magick]

GetAuthenticPixels() returns a Perl blob and you are right, its not safe as you could overflow the buffer. We could transfer it to a Perl safe buffer but the design was to keep it lightning fast for Perl users that have a need for speed. You are tasked with unpacking the binary blob which requires you to first check to see how many channels are in the image and the storage type of the pixels. For example, a RGB image from an HDRI version of ImageMagick returns red, green, and float values for width * height pixel packets.

Recall that GetVirtualPixels() allows you to grab pixels outside the image canvas.

[rmabry]

I'll try then to see if I can grok blobs.

Why, though, is there a GetPixels() method, but no corresponding SetPixels() (only the singular SetPixel())?

Rick

[magick]

Its likely writing the SetPixels() method was a challenge we were not prepared to tackle at the time we developed the GetPixels() method. Would you care to volunteer to write the method and contribute it to the PerlMagick user community?

[rmabry]

Its likely writing the SetPixels() method was a challenge we were not prepared to tackle at the time we developed the GetPixels() method. Would you care to volunteer to write the method and contribute it to the PerlMagick user community?

I'd love to, were I only equipped to do so. Not even knowing what a Blob is (and I doubt I'll be grokking that mess), I'm probably the wrong person. I'd certainly give it a try, though, since it can perhaps be understood by looking at the existing GetPixels(), GetPixel(), and (especially) SetPixel() methods.

Is everything one should know contained in quantum.xs? That's what I edit for puny debugging and experimenting.

Rick

[magick]

You want to edit quantum.xs.in. quantum.xs is built from quantum.xs.in. However, you could edit quantum.xs so you don't need to reconfigure for each build. Just make sure you save a backup in case its overwritten when you reconfigure the ImageMagick distribution.

[rmabry]

Here is a slight modification of SetPixel to make a nicely functioning multi-pixel version: SetPixels. It is working for me and is very, very fast compared with repeating calls to SetPixel (or using Fx).

Like SetPixel, though, it is only designed for the usual channel families (RGB, etc.).

The call is identical to SetPixel, except for the following.

(a) The array of expected floats (normalized quanta) should have length equal to (region width) * (region height) * (number of channels).

(b) The call accepts the region's x, y, width, and height or an equivalent geom string.

Incidentally, I don't understand why SetPixel has a 'geom' key when the width and height components of that make no sense. Also, SetPixel accepts an undocumented 'normalize' key (normalized values are expected by default), which I left in the SetPixels version.

You can call it like so --- just fill an array with appropriately sequenced quanta.

Code: Select all

# example: two channels, a 3x2 region of such pre-prepared pixels, to start at the (10,12) coordinate
@pixels = ($r1, $g1, $r2, $g2, $r3, $g3, $r4, $g4, $r5, $g5, $r6, $g6);
$image->SetPixels(x => 10, y => 12, width => 3, height => 2, channel => "RG", color => \@pixels);

If you pass too few quanta it will just process those you gave it with no error. Too many quanta will also give no error; only those that fill the region will be used. That behavior could be improved, I guess.

Anyway, here it is.

The comments (marked by faux <RDM></RDM> tags) show where something was added or (in just one line) deleted.

I don't know how to contribute this through any Git-bidness.

Code: Select all

#
###############################################################################
#                                                                             #
#                                                                             #
#                                                                             #
#   S e t P i x e l s                                                          #
#                                                                             #
#                                                                             #
#                                                                             #
###############################################################################
#
#
void
SetPixels(ref,...)
  Image::Magick::Q16HDRI ref = NO_INIT
  ALIAS:
    setpixel = 1
    setPixel = 2
  PPCODE:
  {
    AV
      *av;

    char
      *attribute;

    ChannelType
      channel,
      channel_mask;

    ExceptionInfo
      *exception;

    Image
      *image;

    MagickBooleanType
      normalize;

    RectangleInfo
      region;

    register ssize_t
      i;

    register Quantum
      *q;

    ssize_t
      option;

    struct PackageInfo
      *info;

    SV
      *perl_exception,
      *reference;  /* reference is the SV* of ref=SvIV(reference) */

    PERL_UNUSED_VAR(ref);
    PERL_UNUSED_VAR(ix);
    exception=AcquireExceptionInfo();
    perl_exception=newSVpv("",0);
    reference=SvRV(ST(0));
    av=(AV *) reference;
    info=GetPackageInfo(aTHX_ (void *) av,(struct PackageInfo *) NULL,
      exception);
    image=SetupList(aTHX_ reference,&info,(SV ***) NULL,exception);
    if (image == (Image *) NULL)
      {
        ThrowPerlException(exception,OptionError,"NoImagesDefined",
          PackageName);
        goto PerlException;
      }
    av=(AV *) NULL;
    normalize=MagickTrue;
    region.x=0;
    region.y=0;
    region.width=image->columns;
    region.height=1;
    if (items == 1)
      (void) ParseAbsoluteGeometry(SvPV(ST(1),na),&region);
    channel=DefaultChannels;
    for (i=2; i < items; i+=2)
    {
      attribute=(char *) SvPV(ST(i-1),na);
      switch (*attribute)
      {
        case 'C':
        case 'c':
        {
          if (LocaleCompare(attribute,"channel") == 0)
            {
              ssize_t
                option;

              option=ParseChannelOption(SvPV(ST(i),na));
              if (option < 0)
                {
                  ThrowPerlException(exception,OptionError,"UnrecognizedType",
                    SvPV(ST(i),na));
                  return;
                }
              channel=(ChannelType) option;
              break;
            }
          if (LocaleCompare(attribute,"color") == 0)
            {
              if (SvTYPE(ST(i)) != SVt_RV)
                {
                  char
                    message[MagickPathExtent];

                  (void) FormatLocaleString(message,MagickPathExtent,
                    "invalid %.60s value",attribute);
                  ThrowPerlException(exception,OptionError,message,
                    SvPV(ST(i),na));
                }
              av=(AV *) SvRV(ST(i));
              break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
        case 'g':
        case 'G':
        {
          if (LocaleCompare(attribute,"geometry") == 0)
            {
              (void) ParseAbsoluteGeometry(SvPV(ST(i),na),&region);
              break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
# <RDM: added the following>
        case 'h':
        case 'H':
        {
          if (LocaleCompare(attribute,"height") == 0)
            {
              region.height=SvIV(ST(i));
              break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
# </RDM>
        case 'N':
        case 'n':
        {
          if (LocaleCompare(attribute,"normalize") == 0)
            {
              option=ParseCommandOption(MagickBooleanOptions,MagickFalse,
                SvPV(ST(i),na));
              if (option < 0)
                {
                  ThrowPerlException(exception,OptionError,"UnrecognizedType",
                    SvPV(ST(i),na));
                  break;
                }
             normalize=option != 0 ? MagickTrue : MagickFalse;
             break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
# <RDM: added>
        case 'w':
        case 'W':
        {
          if (LocaleCompare(attribute,"width") == 0)
            {
              region.width=SvIV(ST(i));
              break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
# </RDM>
        case 'x':
        case 'X':
        {
          if (LocaleCompare(attribute,"x") == 0)
            {
              region.x=SvIV(ST(i));
              break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
        case 'y':
        case 'Y':
        {
          if (LocaleCompare(attribute,"y") == 0)
            {
              region.y=SvIV(ST(i));
              break;
            }
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
        default:
        {
          ThrowPerlException(exception,OptionError,"UnrecognizedAttribute",
            attribute);
          break;
        }
      }
    }
    (void) SetImageStorageClass(image,DirectClass,exception);
    channel_mask=SetImageChannelMask(image,channel);
   #<RDM: replace the following line ...>
   # q=GetAuthenticPixels(image,region.x,region.y,1,1,exception); 
   # </RDM>
   # <RDM: ... with the following line.> 
    q=GetAuthenticPixels(image, region.x, region.y, region.width, region.height, exception);
   # </RDM> 
    if ((q == (Quantum *) NULL) || (av == (AV *) NULL) ||
        (SvTYPE(av) != SVt_PVAV))
      PUSHs(&sv_undef);
    else
      {
        double
          scale;

        register ssize_t
          i;

# <RDM: added j, jmax for some accounting>
        register ssize_t
          j, jmax;
# </RDM
        i=0;
# <RDM>
        j=0;
        jmax = region.width * region.height; 
# </RDM>
        scale=1.0;
        if (normalize != MagickFalse)
          scale=QuantumRange;
# <RDM> 
# Loop until array of color bytes or number of pixels (times channels) in region is used up.
# (Should an error be thrown if those are not the same?)
 while ((j < jmax) && (i < av_len(av)))
      {
# </RDM> 
        if (((GetPixelRedTraits(image) & UpdatePixelTrait) != 0) &&
            (i <= av_len(av)))
          {
            SetPixelRed(image,ClampToQuantum(scale*SvNV(*(
              av_fetch(av,i,0)))),q);
            i++;
          }
        if (((GetPixelGreenTraits(image) & UpdatePixelTrait) != 0) &&
            (i <= av_len(av)))
          {
            SetPixelGreen(image,ClampToQuantum(scale*SvNV(*(
              av_fetch(av,i,0)))),q);
            i++;
          }
        if (((GetPixelBlueTraits(image) & UpdatePixelTrait) != 0) &&
            (i <= av_len(av)))
          {
            SetPixelBlue(image,ClampToQuantum(scale*SvNV(*(
              av_fetch(av,i,0)))),q);
            i++;
          }
        if ((((GetPixelBlackTraits(image) & UpdatePixelTrait) != 0) &&
            (image->colorspace == CMYKColorspace)) && (i <= av_len(av)))
          {
           SetPixelBlack(image,ClampToQuantum(scale*
              SvNV(*(av_fetch(av,i,0)))),q);
            i++;
          }
        if (((GetPixelAlphaTraits(image) & UpdatePixelTrait) != 0) &&
            (i <= av_len(av)))
          {
            SetPixelAlpha(image,ClampToQuantum(scale*
              SvNV(*(av_fetch(av,i,0)))),q);
            i++;
          }
# <RDM>
	j++;
	q += image->number_channels;
       } 
      # end while
# </RDM>
        (void) SyncAuthenticPixels(image,exception);
      }
     
    (void) SetImageChannelMask(image,channel_mask);

  PerlException:
    InheritPerlException(exception,perl_exception);
    exception=DestroyExceptionInfo(exception);
    SvREFCNT_dec(perl_exception);
  }

I tried to make as few mods as possible to SetPixel for this.

Rick

[magick]

Thank you for the SetPixels() contribution to PerlMagick in ImageMagck version 7. Look for it in the next point release of ImageMagick.

[rmabry]

Terrific, thanks. (Note to self: As of this writing there is this: ImageMagick-7.0.7-25, 2018-03-04 07:50.)

[E. Fudd Wabbitwy]

Rick,

Did you edit source code and re-compile, or was text in a script somewhere?

Thanks.
--
Elm. F.