[rt #71469] make default text color non-transparent

diff --git a/FT2/FT2.pm b/FT2/FT2.pm
index b2d1f4dd69366b510ff5a9819dc2dcabf6765771..dc950d793cde56794e40cc17acb061b90e313c3e 100644 (file)
--- a/FT2/FT2.pm
+++ b/FT2/FT2.pm
@@ -22,7 +22,7 @@ BEGIN {
 
 sub new {
   my $class = shift;
-  my %hsh=(color=>Imager::Color->new(255,0,0,0),
+  my %hsh=(color=>Imager::Color->new(255,0,0,255),
           size=>15,
           @_);
 

diff --git a/FT2/t/t10ft2.t b/FT2/t/t10ft2.t
index 5149571651804a7ed7bfb2b9f847f3db4f3d1602..785fdf873246cd8ceb8e97daab74578dc6e0d9fd 100644 (file)
--- a/FT2/t/t10ft2.t
+++ b/FT2/t/t10ft2.t
@@ -1,11 +1,11 @@
 #!perl -w
 use strict;
-use Test::More tests => 189;
+use Test::More tests => 193;
 use Cwd qw(getcwd abs_path);
 
 use Imager qw(:all);
 
-use Imager::Test qw(diff_text_with_nul is_color3);
+use Imager::Test qw(diff_text_with_nul is_color3 is_color4 isnt_image);
 
 -d "testout" or mkdir "testout";
 
@@ -21,7 +21,7 @@ SKIP:
 
   my $fontname=$ENV{'TTFONTTEST'} || $deffont;
 
-  -f $fontname or skip("cannot find fontfile $fontname", 188);
+  -f $fontname or skip("cannot find fontfile $fontname", 189);
 
 
   my $bgcolor=i_color_new(255,0,0,0);
@@ -515,7 +515,24 @@ SKIP:
     ok($font, "found font by drive relative path")
       or print "# path $drive_path\n";
   }
-
+  { # RT 71469
+    my $font1 = Imager::Font->new(file => $deffont, type => "ft2", index => 0);
+    my $font2 = Imager::Font::FT2->new(file => $deffont, index => 0);
+
+    for my $font ($font1, $font2) {
+      print "# ", join(",", $font->{color}->rgba), "\n";
+
+      my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
+
+      ok($im->string(text => "T", font => $font, y => 15),
+        "draw with default color")
+       or print "# ", $im->errstr, "\n";
+      my $work = Imager->new(xsize => 20, ysize => 20);
+      my $cmp = $work->copy;
+      $work->rubthrough(src => $im);
+      isnt_image($work, $cmp, "make sure something was drawn");
+    }
+  }
 }
 
 sub align_test {

diff --git a/T1/T1.pm b/T1/T1.pm
index 8febba5691592fd954bb91cc81b0e714b0064ada..80663ba9f3269cc0380de2b8b3cfb9ec071a8816 100644 (file)
--- a/T1/T1.pm
+++ b/T1/T1.pm
@@ -35,7 +35,7 @@ sub t1_set_aa_level {
 
 sub new {
   my $class = shift;
-  my %hsh=(color=>Imager::Color->new(255,0,0,0),
+  my %hsh=(color=>Imager::Color->new(255,0,0,255),
           size=>15,
           @_);
 

diff --git a/T1/t/t20oo.t b/T1/t/t20oo.t
index 0aa57433f3748c25c08aef7c91a70492a549e32a..16935c4134c0027e25cd4b637cf8ddb43dd24c78 100644 (file)
--- a/T1/t/t20oo.t
+++ b/T1/t/t20oo.t
@@ -1,7 +1,8 @@
 #!/usr/bin/perl -w
 use strict;
 use Imager;
-use Test::More tests => 9;
+use Imager::Test qw(isnt_image);
+use Test::More tests => 13;
 
 # extracted from t/t36oofont.t
 
@@ -60,6 +61,25 @@ ok($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
    "write t36oofont1.ppm")
   or print "# ",$img->errstr,"\n";
 
+{ # RT 71469
+  my $font1 = Imager::Font->new(file => $fontname_pfb, type => "t1");
+  my $font2 = Imager::Font::T1->new(file => $fontname_pfb);
+
+  for my $font ($font1, $font2) {
+    print "# ", join(",", $font->{color}->rgba), "\n";
+
+    my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
+
+    ok($im->string(text => "T", font => $font, y => 15),
+       "draw with default color")
+      or print "# ", $im->errstr, "\n";
+    my $work = Imager->new(xsize => 20, ysize => 20);
+    my $cmp = $work->copy;
+    $work->rubthrough(src => $im);
+    isnt_image($work, $cmp, "make sure something was drawn");
+  }
+}
+
 unless ($ENV{IMAGER_KEEP_FILES}) {
   unlink "testout/t36oofont1.ppm";
 }

diff --git a/W32/W32.pm b/W32/W32.pm
index 2360736184e8e252dfd15aa740350458ff8bc05d..34a699f3f64cf75df0bc9605c4326e0c356c8cef 100644 (file)
--- a/W32/W32.pm
+++ b/W32/W32.pm
@@ -22,7 +22,13 @@ BEGIN {
 # since Win32's HFONTs include the size information this
 # is just a stub
 sub new {
-  my ($class, %opts) = @_;
+  my $class = shift;
+  my %opts =
+      (
+       color => Imager::Color->new(255, 0, 0),
+       size => 15,
+       @_,
+      );
 
   return bless \%opts, $class;
 }

diff --git a/W32/t/t10win32.t b/W32/t/t10win32.t
index 10057e2c85645543eda87f00cd90992dd3efd3f3..03f0bbbe7297351ce96c05c995625d84ee6055ba 100644 (file)
--- a/W32/t/t10win32.t
+++ b/W32/t/t10win32.t
@@ -1,8 +1,8 @@
 #!perl -w
 use strict;
-use Test::More tests => 55;
+use Test::More tests => 59;
 use Imager qw(:all);
-use Imager::Test qw(diff_text_with_nul);
+use Imager::Test qw(diff_text_with_nul isnt_image);
 ++$|;
 
 ok(-d "testout" or mkdir("testout"), "testout directory");
@@ -207,4 +207,23 @@ SKIP:
     diff_text_with_nul("utf8 dash\0dash vs dash - channel", "$dash\0$dash", $dash,
                       font => $font, channel => 1, utf8 => 1);
   }
+
+  { # RT 71469
+    my $font1 = Imager::Font->new(face => $fontname, type => "w32");
+    my $font2 = Imager::Font::W32->new(face => $fontname );
+
+    for my $font ($font1, $font2) {
+      print "# ", join(",", $font->{color}->rgba), "\n";
+
+      my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
+
+      ok($im->string(text => "T", font => $font, y => 15),
+        "draw with default color")
+       or print "# ", $im->errstr, "\n";
+      my $work = Imager->new(xsize => 20, ysize => 20);
+      my $cmp = $work->copy;
+      $work->rubthrough(src => $im);
+      isnt_image($work, $cmp, "make sure something was drawn");
+    }
+  }
 }

diff --git a/lib/Imager/Font.pm b/lib/Imager/Font.pm
index a7e13bd220ba40be8f6168e6fb95575c22c9703a..3600f4099e152aafd7cdffbb21e9623ccee1553f 100644 (file)
--- a/lib/Imager/Font.pm
+++ b/lib/Imager/Font.pm
@@ -51,7 +51,7 @@ sub new {
   my $class = shift;
   my $self = {};
   my ($file, $type, $id);
-  my %hsh=(color => Imager::Color->new(255,0,0,0),
+  my %hsh=(color => Imager::Color->new(255,0,0,255),
           size => 15,
           @_);
 

diff --git a/lib/Imager/Font/Truetype.pm b/lib/Imager/Font/Truetype.pm
index c68a45a8fac24250aef7be18efbaab0f19295988..7ad972d0ab6379b15097b699ab8c39d4d10938e7 100644 (file)
--- a/lib/Imager/Font/Truetype.pm
+++ b/lib/Imager/Font/Truetype.pm
@@ -9,7 +9,7 @@ $VERSION = "1.011";
 
 sub new {
   my $class = shift;
-  my %hsh=(color=>Imager::Color->new(255,0,0,0),
+  my %hsh=(color=>Imager::Color->new(255,0,0,255),
           size=>15,
           @_);
 

diff --git a/t/t36oofont.t b/t/t36oofont.t
index 7d24f800f0bf1ae1d21ffee227e35bd65ab30205..2982681531c56397ad7e7abcb3e4543e5775a8af 100644 (file)
--- a/t/t36oofont.t
+++ b/t/t36oofont.t
@@ -10,10 +10,15 @@ use strict;
 
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
-use Test::More tests => 12;
+use Test::More tests => 16;
 
 BEGIN { use_ok('Imager') };
 
+BEGIN {
+  require Imager::Test;
+  Imager::Test->import(qw(isnt_image));
+}
+
 -d "testout" or mkdir "testout";
 
 Imager->open_log(log => "testout/t36oofont.log");
@@ -28,7 +33,7 @@ die $Imager::ERRSTR unless $red;
 SKIP:
 {
   $Imager::formats{"tt"} && -f $fontname_tt
-    or skip("FT1.x missing or disabled", 10);
+    or skip("FT1.x missing or disabled", 14);
 
   my $img=Imager->new(xsize=>300, ysize=>100) or die "$Imager::ERRSTR\n";
 
@@ -73,6 +78,25 @@ SKIP:
   my @has_chars = $font->has_chars(string=>"\x01A");
   ok(!$has_chars[0], "has_chars list 0");
   ok($has_chars[1], "has_chars list 1");
+
+  { # RT 71469
+    my $font1 = Imager::Font->new(file => $fontname_tt, type => "tt");
+    my $font2 = Imager::Font::Truetype->new(file => $fontname_tt);
+
+    for my $font ($font1, $font2) {
+      print "# ", join(",", $font->{color}->rgba), "\n";
+
+      my $im = Imager->new(xsize => 20, ysize => 20, channels => 4);
+
+      ok($im->string(text => "T", font => $font, y => 15),
+        "draw with default color")
+       or print "# ", $im->errstr, "\n";
+      my $work = Imager->new(xsize => 20, ysize => 20);
+      my $cmp = $work->copy;
+      $work->rubthrough(src => $im);
+      isnt_image($work, $cmp, "make sure something was drawn");
+    }
+  }
 }
 
 ok(1, "end");