From: Tony Cook <tony@develop=help.com>
Date: Fri, 15 Apr 2005 10:48:27 +0000 (+0000)
Subject: - newer versions of GIMP add a line to gradient files before the
X-Git-Tag: Imager-0.48^2~186
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/817ba871e954a070b7676baca71fe1bbde2f4311

- newer versions of GIMP add a line to gradient files before the
  segment count giving a descriptive name of the gradient.
  Imager::Fountain can now read and write such gradient files.  The
  interface is a bit indirect, but I'd like to preserve
  Imager::Fountain as a blessed array ref for now.
---

diff --git a/Changes b/Changes
index 171951fd..6481e8a9 100644
--- a/Changes
+++ b/Changes
@@ -1047,6 +1047,13 @@ Revision history for Perl extension Imager.
 - Makefile.PL now adds rules to generate a suitable META.yml to the
   generated Makefile.
 - added sample code for handling images uploaded via a HTML form.
+- saving a GIMP gradiant file with Imager::Fountain->save has always been
+  broken.  Fixed it and added tests.
+- newer versions of GIMP add a line to gradient files before the
+  segment count giving a descriptive name of the gradient.  
+  Imager::Fountain can now read and write such gradient files.  The
+  interface is a bit indirect, but I'd like to preserve
+  Imager::Fountain as a blessed array ref for now.
 
 =================================================================
 
diff --git a/MANIFEST b/MANIFEST
index ecf42e7d..023a4429 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -197,6 +197,7 @@ testimg/maxval_256.ppm
 testimg/maxval_4095_asc.ppm
 testimg/maxval_65536.ppm
 testimg/maxval_asc.ppm
+testimg/newgimpgrad.ggr Test GIMP Gradient file (newer type)
 testimg/nocmap.gif
 testimg/palette.png
 testimg/palette_out.png
diff --git a/TODO b/TODO
index 936a3710..e62d662c 100644
--- a/TODO
+++ b/TODO
@@ -18,7 +18,7 @@ not commitments.
 - examples for fountain filter in Imager::Filters
 - allow Imager::Fountain to take color descriptions (eg. blue, FF000)
   instead of color objects for c0 and c1.
-- support newer GIMP gradient files with the Name line
+- support newer GIMP gradient files with the Name line (done)
 - provide access to right-side bearing information from the bounding box
   function
 - capture TIFF read warnings (i_warnings tag?) (done)
diff --git a/lib/Imager/Fountain.pm b/lib/Imager/Fountain.pm
index 10500e81..af7d2f68 100644
--- a/lib/Imager/Fountain.pm
+++ b/lib/Imager/Fountain.pm
@@ -28,8 +28,17 @@ file or you can build them from scratch.
 
 =item read(gimp=>$filename)
 
-  Loads a gradient from the given GIMP gradient file, and returns a
-  new Imager::Fountain object.
+=item read(gimp=>$filename, name=>\$name)
+
+Loads a gradient from the given GIMP gradient file, and returns a
+new Imager::Fountain object.
+
+If the name parameter is supplied as a scalar reference then any name
+field from newer GIMP gradient files will be returned in it.
+
+  my $gradient = Imager::Fountain->read(gimp=>'foo.ggr');
+  my $name;
+  my $gradient2 = Imager::Fountain->read(gimp=>'bar.ggr', name=>\$name);
 
 =cut
 
@@ -44,7 +53,10 @@ sub read {
       return;
     }
 
-    return $class->_load_gimp_gradient($fh, $opts{gimp});
+    my $trash_name;
+    my $name_ref = $opts{name} && ref $opts{name} ? $opts{name} : \$trash_name;
+
+    return $class->_load_gimp_gradient($fh, $opts{gimp}, $name_ref);
   }
   else {
     warn "$class::read: Nothing to do!";
@@ -54,8 +66,18 @@ sub read {
 
 =item write(gimp=>$filename)
 
+=item write(gimp=>$filename, name=>$name)
+
 Save the gradient to a GIMP gradient file.
 
+The second variant allows the gradient name to be set (for newer
+versions of the GIMP).
+
+  $gradient->write(gimp=>'foo.ggr')
+    or die Imager->errstr;
+  $gradient->write(gimp=>'bar.ggr', name=>'the bar gradient')
+    or die Imager->errstr;
+
 =cut
 
 sub write {
@@ -69,7 +91,7 @@ sub write {
       return;
     }
 
-    return $self->_save_gimp_gradient($fh, $opts{gimp});
+    return $self->_save_gimp_gradient($fh, $opts{gimp}, $opts{name});
   }
   else {
     warn "Nothing to do\n";
@@ -283,18 +305,22 @@ Does the work of loading a GIMP gradient file.
 =cut
 
 sub _load_gimp_gradient {
-  my ($class, $fh, $name) = @_;
+  my ($class, $fh, $filename, $name) = @_;
 
   my $head = <$fh>;
   chomp $head;
   unless ($head eq 'GIMP Gradient') {
-    $Imager::ERRSTR = "$name is not a GIMP gradient file";
+    $Imager::ERRSTR = "$filename is not a GIMP gradient file";
     return;
   }
   my $count = <$fh>;
   chomp $count;
+  if ($count =~ /^name:\s?(.*)/i) {
+    ref $name and $$name = $1;
+    $count = <$fh>; # try again
+  }
   unless ($count =~ /^\d$/) {
-    $Imager::ERRSTR = "$name is missing the segment count";
+    $Imager::ERRSTR = "$filename is missing the segment count";
     return;
   }
   my @result;
@@ -322,18 +348,23 @@ Does the work of saving to a GIMP gradient file.
 =cut
 
 sub _save_gimp_gradient {
-  my ($self, $fh, $name) = @_;
+  my ($self, $fh, $filename, $name) = @_;
 
   print $fh "GIMP Gradient\n";
+  defined $name or $name = '';
+  $name =~ tr/ -~/ /cds;
+  if ($name) {
+    print $fh "Name: $name\n";
+  }
   print $fh scalar(@$self),"\n";
   for my $row (@$self) {
     printf $fh "%.6f %.6f %.6f ",@{$row}[0..2];
     for my $i (0, 1) {
       for ($row->[3+$i]->rgba) {
-        printf $fh, "%.6f ", $_;
+        printf $fh "%.6f ", $_/255.0;
       }
     }
-    print $fh @{$row}[5,6];
+    print $fh "@{$row}[5,6]";
     unless (print $fh "\n") {
       $Imager::ERRSTR = "write error: $!";
       return;
diff --git a/t/t61filters.t b/t/t61filters.t
index 65e45048..dcf49d60 100644
--- a/t/t61filters.t
+++ b/t/t61filters.t
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use Imager qw(:handy);
-use Test::More tests => 45;
+use Test::More tests => 54;
 Imager::init_log("testout/t61filters.log", 1);
 # meant for testing the filters themselves
 my $imbase = Imager->new;
@@ -103,6 +103,37 @@ SKIP:
      "compare test image and diff image");
 }
 
+# newer versions of gimp add a line to the gradient file
+my $name;
+my $f5 = Imager::Fountain->read(gimp=>'testimg/newgimpgrad.ggr',
+                                name => \$name);
+ok($f5, "read newer gimp gradient")
+  or print "# ",Imager->errstr,"\n";
+is($name, "imager test gradient", "check name read correctly");
+$f5 = Imager::Fountain->read(gimp=>'testimg/newgimpgrad.ggr');
+ok($f5, "check we handle case of no name reference correctly")
+  or print "# ",Imager->errstr,"\n";
+
+# test writing of gradients
+ok($f2->write(gimp=>'testout/t61grad1.ggr'), "save a gradient")
+  or print "# ",Imager->errstr,"\n";
+undef $name;
+my $f6 = Imager::Fountain->read(gimp=>'testout/t61grad1.ggr', 
+                                name=>\$name);
+ok($f6, "read what we wrote")
+  or print "# ",Imager->errstr,"\n";
+ok(!defined $name, "we didn't set the name, so shouldn't get one");
+
+# try with a name
+ok($f2->write(gimp=>'testout/t61grad2.ggr', name=>'test gradient'),
+   "write gradient with a name")
+  or print "# ",Imager->errstr,"\n";
+undef $name;
+my $f7 = Imager::Fountain->read(gimp=>'testout/t61grad2.ggr', name=>\$name);
+ok($f7, "read what we wrote")
+  or print "# ",Imager->errstr,"\n";
+is($name, "test gradient", "check the name matches");
+
 sub test {
   my ($in, $params, $out) = @_;
 
diff --git a/testimg/newgimpgrad.ggr b/testimg/newgimpgrad.ggr
new file mode 100644
index 00000000..b39bff4d
--- /dev/null
+++ b/testimg/newgimpgrad.ggr
@@ -0,0 +1,4 @@
+GIMP Gradient
+Name: imager test gradient
+1
+0.000000 0.500000 1.000000 0.000000 0.000000 0.000000 1.000000 1.000000 1.000000 1.000000 1.000000 0 0