[rt #67911] add gray, gray4, gray16 preset color palettes

Changes

@@ -23,6 +23,12 @@ Imager release history.  Older releases can be found in Changes.old
  - re-work and add tests for def_guess_type().  def_guess_type() no
    longer returns any random file extension as the file type.
 
+ - add gray4, gray16 and gray as presets for make_colors.
+   https://rt.cpan.org/Ticket/Display.html?id=67911
+
+ - add make_palette() method that produces a palette from one or more
+   images.
+
 Imager 0.86 - 31 Oct 2011
 ===========
 

Imager.pm

@@ -987,6 +987,25 @@ sub to_paletted {
   return $result;
 }
 
+sub make_palette {
+  my ($class, $quant, @images) = @_;
+
+  unless (@images) {
+    Imager->_set_error("make_palette: supply at least one image");
+    return;
+  }
+  my $index = 1;
+  for my $img (@images) {
+    unless ($img->{IMG}) {
+      Imager->_set_error("make_palette: image $index is empty");
+      return;
+    }
+    ++$index;
+  }
+
+  return i_img_make_palette($quant, map $_->{IMG}, @images);
+}
+
 # convert a paletted (or any image) to an 8-bit/channel RGB image
 sub to_rgb8 {
   my $self = shift;
@@ -4022,7 +4041,7 @@ sub Imager::ImgRaw::CLONE_SKIP { 1 }
 
 sub preload {
   # this serves two purposes:
-  # - a class method to load the file support modules included with Image
+  # - a class method to load the file support modules included with Imager
   #   (or were included, once the library dependent modules are split out)
   # - something for Module::ScanDeps to analyze
   # https://rt.cpan.org/Ticket/Display.html?id=6566
@@ -4458,6 +4477,9 @@ load_plugin() - L<Imager::Filters/load_plugin()>
 log() - L<Imager::ImageTypes/log()> - send a message to the debugging
 log.
 
+make_palette() - L<Imager::ImageTypes/make_palette()> - produce a
+color palette from one or more input images.
+
 map() - L<Imager::Transformations/"Color Mappings"> - remap color
 channel values
 

Imager.xs

@@ -135,6 +135,16 @@ i_log_entry(char *string, int level) {
   mm_log((level, "%s", string));
 }
 
+static SV *
+make_i_color_sv(pTHX_ const i_color *c) {
+  SV *sv;
+  i_color *col = mymalloc(sizeof(i_color));
+  *col = *c;
+  sv = sv_newmortal();
+  sv_setref_pv(sv, "Imager::Color", (void *)col);
+
+  return sv;
+}
 
 #define CBDATA_BUFSIZE 8192
 
@@ -368,6 +378,9 @@ static struct value_name make_color_names[] =
   { "mediancut", mc_median_cut, },
   { "mono", mc_mono, },
   { "monochrome", mc_mono, },
+  { "gray", mc_gray, },
+  { "gray4", mc_gray4, },
+  { "gray16", mc_gray16, },
 };
 
 static struct value_name translate_names[] =
@@ -2964,6 +2977,40 @@ Imager::ImgRaw
 i_img_to_rgb(src)
         Imager::ImgRaw src
 
+void
+i_img_make_palette(HV *quant_hv, ...)
+      PREINIT:
+        size_t count = items - 1;
+	i_quantize quant;
+	i_img **imgs = NULL;
+	ssize_t i;
+      PPCODE:
+        if (count <= 0)
+	  croak("Please supply at least one image (%d)", (int)count);
+        imgs = mymalloc(sizeof(i_img *) * count);
+	for (i = 0; i < count; ++i) {
+	  SV *img_sv = ST(i + 1);
+	  if (SvROK(img_sv) && sv_derived_from(img_sv, "Imager::ImgRaw")) {
+	    imgs[i] = INT2PTR(i_img *, SvIV((SV*)SvRV(img_sv)));
+	  }
+	  else {
+	    myfree(imgs);
+	    croak("Image %d is not an image object", i+1);
+          }
+	}
+        memset(&quant, 0, sizeof(quant));
+	quant.version = 1;
+	quant.mc_size = 256;
+        ip_handle_quant_opts(aTHX_ &quant, quant_hv);
+	i_quant_makemap(&quant, imgs, count);
+	EXTEND(SP, quant.mc_count);
+	for (i = 0; i < quant.mc_count; ++i) {
+	  SV *sv_c = make_i_color_sv(aTHX_ quant.mc_colors + i);
+	  PUSHs(sv_c);
+	}
+ 	ip_cleanup_quant_opts(aTHX_ &quant);
+
+
 void
 i_gpal(im, l, r, y)
         Imager::ImgRaw  im
@@ -3122,11 +3169,7 @@ i_getcolors(im, index, ...)
         colors = mymalloc(sizeof(i_color) * count);
         if (i_getcolors(im, index, colors, count)) {
           for (i = 0; i < count; ++i) {
-            i_color *pv;
-            SV *sv = sv_newmortal();
-            pv = mymalloc(sizeof(i_color));
-            *pv = colors[i];
-            sv_setref_pv(sv, "Imager::Color", (void *)pv);
+            SV *sv = make_i_color_sv(aTHX_ colors+i);
             PUSHs(sv);
           }
         }
@@ -3508,11 +3551,7 @@ i_glin(im, l, r, y)
 	  if (GIMME_V == G_ARRAY) {
             EXTEND(SP, count);
             for (i = 0; i < count; ++i) {
-              SV *sv;
-              i_color *col = mymalloc(sizeof(i_color));
-              *col = vals[i];
-              sv = sv_newmortal();
-              sv_setref_pv(sv, "Imager::Color", (void *)col);
+              SV *sv = make_i_color_sv(aTHX_ vals+i);
               PUSHs(sv);
             }
           }

imdatatypes.h

@@ -569,6 +569,9 @@ typedef enum i_make_colors_tag {
   mc_addi, /* Addi's algorithm */
   mc_median_cut, /* median cut - similar to giflib, hopefully */
   mc_mono, /* fixed mono color map */
+  mc_gray, /* 256 gray map */
+  mc_gray4, /* four step gray map */
+  mc_gray16, /* sixteen step gray map */
   mc_mask = 0xFF /* (mask for generator) */
 } i_make_colors;
 

lib/Imager/ImageTypes.pod

@@ -729,6 +729,18 @@ the region without specifying a mask.  For example:
   my $maskedimg = $img->masked(left => 100, top=>100,
                                right=>200, bottom=>200);
 
+=item make_palette()
+
+This doesn't perform an image conversion, but it can be used to
+construct a common palette for use in several images:
+
+  my @colors = Imager->make_palette(\%opts, @images);
+
+You must supply at least one image, even if the C<make_colors>
+parameter produces a fixed palette.
+
+On failure returns no colors and you can check C<< Imager->errstr >>.
+
 =back
 
 =head2 Tags
@@ -1020,6 +1032,11 @@ as good a result.
 C<mono>, C<monochrome> - a fixed black and white palette, suitable for
 producing bi-level images (eg. facsimile)
 
+=item *
+
+C<gray>, C<gray4>, C<gray16> - make fixed gray palette with 256, 4 or
+16 entries respectively.
+
 =back
 
 Other methods may be added in the future.

quant.c

@@ -9,6 +9,7 @@ static void makemap_webmap(i_quantize *);
 static void makemap_addi(i_quantize *, i_img **imgs, int count);
 static void makemap_mediancut(i_quantize *, i_img **imgs, int count);
 static void makemap_mono(i_quantize *);
+static void makemap_gray(i_quantize *, int step);
 
 static int makemap_palette(i_quantize *, i_img **imgs, int count);
 
@@ -72,6 +73,18 @@ i_quant_makemap(i_quantize *quant, i_img **imgs, int count) {
     makemap_mono(quant);
     break;
 
+  case mc_gray:
+    makemap_gray(quant, 1);
+    break;
+
+  case mc_gray4:
+    makemap_gray(quant, 85);
+    break;
+
+  case mc_gray16:
+    makemap_gray(quant, 17);
+    break;
+
   case mc_addi:
   default:
     makemap_addi(quant, imgs, count);
@@ -726,6 +739,19 @@ makemap_mono(i_quantize *quant) {
   quant->mc_count = 2;
 }
 
+static void
+makemap_gray(i_quantize *quant, int step) {
+  int gray = 0;
+  int i = 0;
+
+  while (gray < 256) {
+    setcol(quant->mc_colors+i, gray, gray, gray, 255);
+    ++i;
+    gray += step;
+  }
+  quant->mc_count = i;
+}
+
 static void
 makemap_webmap(i_quantize *quant) {
   int r, g, b;

t/t023palette.t

@@ -1,10 +1,10 @@
 #!perl -w
 # some of this is tested in t01introvert.t too
 use strict;
-use Test::More tests => 132;
+use Test::More tests => 154;
 BEGIN { use_ok("Imager"); }
 
-use Imager::Test qw(image_bounds_checks test_image is_color3 isnt_image);
+use Imager::Test qw(image_bounds_checks test_image is_color3 isnt_image is_color4);
 
 Imager->open_log(log => "testout/t023palette.log");
 
@@ -387,6 +387,57 @@ cmp_ok(Imager->errstr, '=~', qr/Channels must be positive and <= 4/,
   }
 }
 
+{
+  my $im = Imager->new(xsize => 1, ysize => 1);
+  my $im_bad = Imager->new;
+  {
+    my @map = Imager->make_palette({});
+    ok(!@map, "make_palette should fail with no images");
+    is(Imager->errstr, "make_palette: supply at least one image",
+       "check error message");
+  }
+  {
+    my @map = Imager->make_palette({}, $im, $im_bad, $im);
+    ok(!@map, "make_palette should fail with an empty image");
+    is(Imager->errstr, "make_palette: image 2 is empty",
+       "check error message");
+  }
+  {
+    my @map = Imager->make_palette({ make_colors => "mono" }, $im);
+    is(@map, 2, "mono should make 2 color palette")
+      or skip("unexpected color count", 2);
+    is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+    is_color4($map[1], 255, 255, 255, 255, "check map[1]");
+  }
+  {
+    my @map = Imager->make_palette({ make_colors => "gray4" }, $im);
+    is(@map, 4, "gray4 should make 4 color palette")
+      or skip("unexpected color count", 4);
+    is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+    is_color4($map[1], 85, 85, 85, 255, "check map[1]");
+    is_color4($map[2], 170, 170, 170, 255, "check map[2]");
+    is_color4($map[3], 255, 255, 255, 255, "check map[3]");
+  }
+  {
+    my @map = Imager->make_palette({ make_colors => "gray16" }, $im);
+    is(@map, 16, "gray16 should make 16 color palette")
+      or skip("unexpected color count", 4);
+    is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+    is_color4($map[1], 17, 17, 17, 255, "check map[1]");
+    is_color4($map[2], 34, 34, 34, 255, "check map[2]");
+    is_color4($map[15], 255, 255, 255, 255, "check map[15]");
+  }
+  {
+    my @map = Imager->make_palette({ make_colors => "gray" }, $im);
+    is(@map, 256, "gray16 should make 256 color palette")
+      or skip("unexpected color count", 4);
+    is_color4($map[0], 0, 0, 0, 255, "check map[0]");
+    is_color4($map[1], 1, 1, 1, 255, "check map[1]");
+    is_color4($map[33], 33, 33, 33, 255, "check map[2]");
+    is_color4($map[255], 255, 255, 255, 255, "check map[15]");
+  }
+}
+
 Imager->close_log;
 
 unless ($ENV{IMAGER_KEEP_FILES}) {