tests and fixes for corrrect handling of magic in T1
authorTony Cook <tony@develop-help.com>
Thu, 21 Feb 2013 09:46:08 +0000 (20:46 +1100)
committerTony Cook <tony@develop-help.com>
Thu, 21 Feb 2013 09:46:08 +0000 (20:46 +1100)
T1/T1.pm
T1/T1.xs
T1/t/t10type1.t

index 8c64a53..45a1cd5 100644 (file)
--- a/T1/T1.pm
+++ b/T1/T1.pm
@@ -87,14 +87,13 @@ sub _draw {
   if (exists $input{channel}) {
     $self->{t1font}->cp($input{image}{IMG}, $input{'x'}, $input{'y'},
                    $input{channel}, $input{size},
-                   $input{string}, length($input{string}), $input{align},
+                   $input{string}, $input{align},
                     $input{utf8}, $flags, $aa)
       or return;
   } else {
     $self->{t1font}->text($input{image}{IMG}, $input{'x'}, $input{'y'}, 
                      $input{color}, $input{size}, 
-                     $input{string}, length($input{string}), 
-                     $input{align}, $input{utf8}, $flags, $aa)
+                     $input{string}, $input{align}, $input{utf8}, $flags, $aa)
       or return;
   }
 
@@ -113,7 +112,7 @@ sub _bounding_box {
   $flags .= 's' if $input{strikethrough};
   $flags .= 'o' if $input{overline};
   return $self->{t1font}->bbox($input{size}, $input{string},
-                          length($input{string}), $input{utf8}, $flags);
+                              $input{utf8}, $flags);
 }
 
 # check if the font has the characters in the given string
@@ -123,7 +122,7 @@ sub has_chars {
   $self->_valid
     or return;
 
-  unless (defined $hsh{string} && length $hsh{string}) {
+  unless (defined $hsh{string}) {
     $Imager::ERRSTR = "No string supplied to \$font->has_chars()";
     return;
   }
@@ -155,7 +154,7 @@ sub glyph_names {
     or return Imager->_set_error("no string parameter passed to glyph_names");
   my $utf8 = _first($input{utf8} || 0);
 
-  return $self->{t1font}->glyph_name($string, $utf8);
+  return $self->{t1font}->glyph_names($string, $utf8);
 }
 
 sub set_aa_level {
index 6c973ea..162920d 100644 (file)
--- a/T1/T1.xs
+++ b/T1/T1.xs
@@ -36,7 +36,7 @@ i_t1_DESTROY(font)
 
 
 undef_int
-i_t1_cp(font,im,xb,yb,channel,points,str_sv, length(str),align,utf8=0,flags="",aa=1)
+i_t1_cp(font,im,xb,yb,channel,points,str_sv,align,utf8=0,flags="",aa=1)
  Imager::Font::T1xs     font
     Imager::ImgRaw     im
         i_img_dim     xb
@@ -52,11 +52,11 @@ i_t1_cp(font,im,xb,yb,channel,points,str_sv, length(str),align,utf8=0,flags="",a
                char *str;
                STRLEN len;
              CODE:
+               str = SvPV(str_sv, len);
 #ifdef SvUTF8
                if (SvUTF8(str_sv))
                  utf8 = 1;
 #endif
-               str = SvPV(str_sv, len);
                RETVAL = i_t1_cp(font, im, xb,yb,channel,points,str,len,align,
                                   utf8,flags,aa);
            OUTPUT:
@@ -64,24 +64,24 @@ i_t1_cp(font,im,xb,yb,channel,points,str_sv, length(str),align,utf8=0,flags="",a
 
 
 void
-i_t1_bbox(fontnum,point,str_sv,len_ignored,utf8=0,flags="")
+i_t1_bbox(fontnum,point,str_sv,utf8=0,flags="")
  Imager::Font::T1xs     fontnum
            double     point
                SV*    str_sv
                int     utf8
               char*    flags
             PREINIT:
-               char *str;
+               const char *str;
                STRLEN len;
               i_img_dim     cords[BOUNDING_BOX_COUNT];
                int i;
                int rc;
             PPCODE:
+               str = SvPV(str_sv, len);
 #ifdef SvUTF8
                if (SvUTF8(str_sv))
                  utf8 = 1;
 #endif
-               str = SvPV(str_sv, len);
                rc = i_t1_bbox(fontnum,point,str,len,cords,utf8,flags);
                if (rc > 0) {
                  EXTEND(SP, rc);
@@ -92,7 +92,7 @@ i_t1_bbox(fontnum,point,str_sv,len_ignored,utf8=0,flags="")
 
 
 undef_int
-i_t1_text(font,im,xb,yb,cl,points,str_sv,length(str),align,utf8=0,flags="",aa=1)
+i_t1_text(font,im,xb,yb,cl,points,str_sv,align,utf8=0,flags="",aa=1)
  Imager::Font::T1xs font
     Imager::ImgRaw     im
         i_img_dim     xb
@@ -108,11 +108,11 @@ i_t1_text(font,im,xb,yb,cl,points,str_sv,length(str),align,utf8=0,flags="",aa=1)
                char *str;
                STRLEN len;
              CODE:
+               str = SvPV(str_sv, len);
 #ifdef SvUTF8
                if (SvUTF8(str_sv))
                  utf8 = 1;
 #endif
-               str = SvPV(str_sv, len);
                RETVAL = i_t1_text(font,im, xb,yb,cl,points,str,len,align,
                                   utf8,flags,aa);
            OUTPUT:
@@ -130,11 +130,11 @@ i_t1_has_chars(font, text_sv, utf8 = 0)
         int count;
         int i;
       PPCODE:
+        text = SvPV(text_sv, len);
 #ifdef SvUTF8
         if (SvUTF8(text_sv))
           utf8 = 1;
 #endif
-        text = SvPV(text_sv, len);
         work = mymalloc(len);
         count = i_t1_has_chars(font, text, len, utf8, work);
         if (GIMME_V == G_ARRAY) {
@@ -164,7 +164,7 @@ i_t1_face_name(font)
         }
 
 void
-i_t1_glyph_name(font, text_sv, utf8 = 0)
+i_t1_glyph_names(font, text_sv, utf8 = 0)
  Imager::Font::T1xs font
         SV *text_sv
         int utf8
@@ -174,11 +174,11 @@ i_t1_glyph_name(font, text_sv, utf8 = 0)
         size_t len;
         char name[255];
       PPCODE:
+        text = SvPV(text_sv, work_len);
 #ifdef SvUTF8
         if (SvUTF8(text_sv))
           utf8 = 1;
 #endif
-        text = SvPV(text_sv, work_len);
         len = work_len;
         while (len) {
           unsigned long ch;
index 8d9be3b..7a58afb 100644 (file)
@@ -8,7 +8,7 @@ use Cwd qw(getcwd abs_path);
 
 #$Imager::DEBUG=1;
 
-plan tests => 108;
+plan tests => 120;
 
 ok($Imager::formats{t1}, "must have t1");
 
@@ -49,11 +49,11 @@ SKIP:
   my $bgcolor=Imager::Color->new(255,0,0,0);
   my $overlay=Imager::ImgRaw::new(200,70,3);
   
-  ok($fnum->cp($overlay,5,50,1,50.0,'XMCLH',5,1), "i_t1_cp");
+  ok($fnum->cp($overlay,5,50,1,50.0,'XMCLH',1), "i_t1_cp");
 
   i_line($overlay,0,50,100,50,$bgcolor,1);
 
-  my @bbox=$fnum->bbox(50.0,'XMCLH',5);
+  my @bbox=$fnum->bbox(50.0,'XMCLH');
   is(@bbox, 8, "i_t1_bbox");
   print "# bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
 
@@ -66,7 +66,7 @@ SKIP:
   $bgcolor=Imager::Color::set($bgcolor,200,200,200,0);
   my $backgr=Imager::ImgRaw::new(280,300,3);
 
-  ok($fnum->text($backgr,10,100,$bgcolor,150.0,'test',4,1,2), "i_t1_text");
+  ok($fnum->text($backgr,10,100,$bgcolor,150.0,'test',1,2), "i_t1_text");
 
   # "UTF8" tests
   # for perl < 5.6 we can hand-encode text
@@ -77,9 +77,9 @@ SKIP:
   my $text = pack("C*", 0x41, 0xC2, 0xA1, 0xE2, 0x80, 0x90, 0x41);
   my $alttext = "A\xA1A";
   
-  my @utf8box = $fnum->bbox(50.0, $text, length($text), 1);
+  my @utf8box = $fnum->bbox(50.0, $text, 1);
   is(@utf8box, 8, "utf8 bbox element count");
-  my @base = $fnum->bbox(50.0, $alttext, length($alttext), 0);
+  my @base = $fnum->bbox(50.0, $alttext, 0);
   is(@base, 8, "alt bbox element count");
   my $maxdiff = $fontname_pfb eq $deffont ? 0 : $base[2] / 3;
   print "# (@utf8box vs @base)\n";
@@ -87,9 +87,9 @@ SKIP:
       "compare box sizes $utf8box[2] vs $base[2] (maxerror $maxdiff)");
 
   # hand-encoded UTF8 drawing
-  ok($fnum->text($backgr, 10, 140, $bgcolor, 32, $text, length($text), 1,1), "draw hand-encoded UTF8");
+  ok($fnum->text($backgr, 10, 140, $bgcolor, 32, $text, 1,1), "draw hand-encoded UTF8");
 
-  ok($fnum->cp($backgr, 80, 140, 1, 32, $text, length($text), 1, 1), 
+  ok($fnum->cp($backgr, 80, 140, 1, 32, $text, 1, 1), 
       "cp hand-encoded UTF8");
 
   # ok, try native perl UTF8 if available
@@ -101,11 +101,11 @@ SKIP:
     # versions
     eval q{$text = "A\xA1\x{2010}A"}; # A, a with ogonek, HYPHEN, A in our test font
     #$text = "A".chr(0xA1).chr(0x2010)."A"; # this one works too
-    ok($fnum->text($backgr, 10, 180, $bgcolor, 32, $text, length($text), 1),
+    ok($fnum->text($backgr, 10, 180, $bgcolor, 32, $text, 1),
         "draw UTF8");
-    ok($fnum->cp($backgr, 80, 180, 1, 32, $text, length($text), 1),
+    ok($fnum->cp($backgr, 80, 180, 1, 32, $text, 1),
         "cp UTF8");
-    @utf8box = $fnum->bbox(50.0, $text, length($text), 0);
+    @utf8box = $fnum->bbox(50.0, $text, 0);
     is(@utf8box, 8, "native utf8 bbox element count");
     ok(abs($utf8box[2] - $base[2]) <= $maxdiff, 
       "compare box sizes native $utf8box[2] vs $base[2] (maxerror $maxdiff)");
@@ -395,6 +395,92 @@ SKIP:
     is($im->errstr, "i_t1_text(): T1_AASetString failed: Invalid Argument in Function Call",
        "check error message");
   }
+
+ SKIP:
+  { # check magic is handled correctly
+    # https://rt.cpan.org/Ticket/Display.html?id=83438
+    skip("no native UTF8 support in this version of perl", 10) 
+      unless $] >= 5.006;
+    my $font = Imager::Font->new(file=>$deffont, type=>'t1');
+    ok($font, "loaded deffont OO")
+      or skip("could not load font:".Imager->errstr, 4);
+    Imager->log("utf8 magic tests\n");
+    my $over = bless {}, "OverUtf8";
+    my $text = chr(0x2010)."A";
+    my $white = Imager::Color->new("#FFF");
+    my $base_draw = Imager->new(xsize => 80, ysize => 20);
+    ok($base_draw->string(font => $font,
+                         text => $text,
+                         x => 2,
+                         y => 18,
+                         size => 15,
+                         color => $white,
+                         aa => 1),
+       "magic: make a base image");
+    my $test_draw = Imager->new(xsize => 80, ysize => 20);
+    ok($test_draw->string(font => $font,
+                         text => $over,
+                         x => 2,
+                         y => 18,
+                         size => 15,
+                         color => $white,
+                         aa => 1),
+       "magic: draw with overload");
+    is_image($base_draw, $test_draw, "check they match");
+    $test_draw->write(file => "testout/utf8tdr.ppm");
+    $base_draw->write(file => "testout/utf8bdr.ppm");
+
+    my $base_cp = Imager->new(xsize => 80, ysize => 20);
+    $base_cp->box(filled => 1, color => "#808080");
+    my $test_cp = $base_cp->copy;
+    ok($base_cp->string(font => $font,
+                       text => $text,
+                       y => 2,
+                       y => 18,
+                       size => 16,
+                       channel => 2,
+                       aa => 1),
+       "magic: make a base image (channel)");
+    Imager->log("magic: draw to channel with overload\n");
+    ok($test_cp->string(font => $font,
+                       text => $over,
+                       y => 2,
+                       y => 18,
+                       size => 16,
+                       channel => 2,
+                       aa => 1),
+       "magic: draw with overload (channel)");
+    is_image($test_cp, $base_cp, "check they match");
+    #$test_cp->write(file => "testout/utf8tcp.ppm");
+    #$base_cp->write(file => "testout/utf8bcp.ppm");
+
+    Imager->log("magic: has_chars");
+    is_deeply([ $font->has_chars(string => $text) ], [ '', 1 ],
+             "magic: has_chars with normal utf8 text");
+    is_deeply([ $font->has_chars(string => $over) ], [ '', 1 ],
+             "magic: has_chars with magic utf8 text");
+
+    Imager->log("magic: bounding_box\n");
+    my @base_bb = $font->bounding_box(string => $text, size => 30);
+    is_deeply([ $font->bounding_box(string => $over, size => 30) ],
+             \@base_bb,
+             "check bounding box magic");
+
+  SKIP:
+    {
+      Imager->log("magic: glyph_names\n");
+      is_deeply([ $font->glyph_names(string => $text, reliable_only => 0) ],
+               [ undef, "A" ],
+               "magic: glyph_names with normal utf8 text");
+      is_deeply([ $font->glyph_names(string => $over, reliable_only => 0) ],
+               [ undef, "A" ],
+               "magic: glyph_names with magic utf8 text");
+    }
+  }
 }
 
+
 #malloc_state();
+
+package OverUtf8;
+use overload '""' => sub { chr(0x2010)."A" };