From: Tony Cook <tony@develop=help.com>
Date: Tue, 26 Apr 2005 08:55:35 +0000 (+0000)
Subject: - Imager::Font::BBox objects now have right_bearing() and display_width()
X-Git-Tag: Imager-0.48^2~172
X-Git-Url: http://git.imager.perl.org/imager.git/commitdiff_plain/7fdbfba8aac6f6770cb85bb65e0243ec1f17cf08

- Imager::Font::BBox objects now have right_bearing() and display_width()
  methods.  Hopefully this and the advance_width() method fills out
  the Imager bounding box interface to a useful state.
  Implemented for FT2, FT1.x, T1Lib so far.
---

diff --git a/Changes b/Changes
index 09a55698..9591b7f7 100644
--- a/Changes
+++ b/Changes
@@ -1069,7 +1069,7 @@ Revision history for Perl extension Imager.
 - Imager::Font::BBox objects now have right_bearing() and display_width()
   methods.  Hopefully this and the advance_width() method fills out
   the Imager bounding box interface to a useful state.
-  Implemented for FT2 so far.
+  Implemented for FT2, FT1.x, T1Lib so far.
 
 =================================================================
 
diff --git a/dynfilt/Makefile.PL b/dynfilt/Makefile.PL
index 2141dd90..11793e3a 100644
--- a/dynfilt/Makefile.PL
+++ b/dynfilt/Makefile.PL
@@ -92,6 +92,8 @@ pure_all ::
 }
 
 # EU::MM crashes without this when we define it in the base Makefile.PL
+# but then warns about redefinition, so delete the GLOB entry
+BEGIN { delete $MY::{metafile} }
 sub MY::metafile {
   '';
 }
diff --git a/font.c b/font.c
index 5099ee2e..a979e7ad 100644
--- a/font.c
+++ b/font.c
@@ -328,8 +328,10 @@ i_t1_bbox(int fontnum,float points,char *str,int len,int cords[6], int utf8,char
   cords[BBOX_ASCENT]=((float)bbox.ury*points)/1000;
 
   cords[BBOX_ADVANCE_WIDTH] = ((float)advance * points)/1000;
+  cords[BBOX_RIGHT_BEARING] = 
+    cords[BBOX_ADVANCE_WIDTH] - cords[BBOX_POS_WIDTH];
 
-  return BBOX_ADVANCE_WIDTH+1;
+  return BBOX_RIGHT_BEARING+1;
 }
 
 
@@ -1726,8 +1728,6 @@ i_tt_bbox_inst( TT_Fonthandle *handle, int inst ,const char *txt, int len, int c
 	  - (gm->bbox.xMax - gm->bbox.xMin);
 	/* fprintf(stderr, "font info last: %d %d %d %d\n", 
 	   gm->bbox.xMax, gm->bbox.xMin, gm->advance, rightb); */
-	if (rightb > 0)
-	  rightb = 0;
       }
 
       ascent  = (ascent  >  casc ?  ascent : casc );
@@ -1737,13 +1737,16 @@ i_tt_bbox_inst( TT_Fonthandle *handle, int inst ,const char *txt, int len, int c
   
   cords[BBOX_NEG_WIDTH]=start;
   cords[BBOX_GLOBAL_DESCENT]=gdescent;
-  cords[BBOX_POS_WIDTH]=width - rightb / 64;
+  cords[BBOX_POS_WIDTH]=width;
+  if (rightb < 0)
+    cords[BBOX_POS_WIDTH] -= rightb / 64;
   cords[BBOX_GLOBAL_ASCENT]=gascent;
   cords[BBOX_DESCENT]=descent;
   cords[BBOX_ASCENT]=ascent;
   cords[BBOX_ADVANCE_WIDTH] = width;
+  cords[BBOX_RIGHT_BEARING] = rightb / 64;
 
-  return BBOX_ADVANCE_WIDTH + 1;
+  return BBOX_RIGHT_BEARING + 1;
 }
 
 
diff --git a/lib/Imager/Font.pm b/lib/Imager/Font.pm
index 6fb624df..dfc2bbc3 100644
--- a/lib/Imager/Font.pm
+++ b/lib/Imager/Font.pm
@@ -873,6 +873,15 @@ list.
 
 You need to modify this class to add new font types.
 
+The $pos_width member returned by the bounding_box() method has
+historically returned different values from different drivers.  The
+Freetype 1.x and 2.x, and the Win32 drivers return the max of the
+advance width and the right edge of the right-most glyph.  The Type 1
+driver always returns the right edge of the right-most glyph.
+
+The newer advance_width and right_bearing values allow access to any
+of the above.
+
 =head1 SEE ALSO
 
 Imager(3), Imager::Font::FreeType2(3), Imager::Font::Type1(3),
diff --git a/t/t30t1font.t b/t/t30t1font.t
index a83ab1d6..b36f5d4f 100644
--- a/t/t30t1font.t
+++ b/t/t30t1font.t
@@ -7,7 +7,7 @@
 # Change 1..1 below to 1..last_test_to_print .
 # (It may become useful if the test is moved to ./t subdirectory.)
 use strict;
-use Test::More tests => 41;
+use Test::More tests => 50;
 BEGIN { use_ok(Imager => ':all') }
 
 #$Imager::DEBUG=1;
@@ -22,13 +22,13 @@ my $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
 SKIP:
 {
   if (!(i_has_format("t1")) ) {
-    skip(40, "t1lib unavailable or disabled", 40);
+    skip("t1lib unavailable or disabled", 49);
   }
   elsif (! -f $fontname_pfb) {
-    skip("cannot find fontfile for type 1 test $fontname_pfb", 40);
+    skip("cannot find fontfile for type 1 test $fontname_pfb", 49);
   }
   elsif (! -f $fontname_afm) {
-    skip("cannot find fontfile for type 1 test $fontname_afm", 40);
+    skip("cannot find fontfile for type 1 test $fontname_afm", 49);
   }
 
   print "# has t1\n";
@@ -37,7 +37,7 @@ SKIP:
 
   my $fnum=Imager::i_t1_new($fontname_pfb,$fontname_afm); # this will load the pfb font
   unless (ok($fnum >= 0, "load font $fontname_pfb")) {
-    skip("without the font I can't do a thing", 39);
+    skip("without the font I can't do a thing", 48);
   }
 
   my $bgcolor=Imager::Color->new(255,0,0,0);
@@ -48,7 +48,7 @@ SKIP:
   i_line($overlay,0,50,100,50,$bgcolor,1);
 
   my @bbox=i_t1_bbox(0,50.0,'XMCLH',5);
-  ok(@bbox == 7, "i_t1_bbox");
+  is(@bbox, 8, "i_t1_bbox");
   print "# bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
 
   open(FH,">testout/t30t1font.ppm") || die "cannot open testout/t35t1font.ppm\n";
@@ -73,9 +73,9 @@ SKIP:
   my $alttext = "A\xA1A";
   
   my @utf8box = i_t1_bbox($fnum, 50.0, $text, length($text), 1);
-  is(@utf8box, 7, "utf8 bbox element count");
+  is(@utf8box, 8, "utf8 bbox element count");
   my @base = i_t1_bbox($fnum, 50.0, $alttext, length($alttext), 0);
-  is(@base, 7, "alt bbox element count");
+  is(@base, 8, "alt bbox element count");
   my $maxdiff = $fontname_pfb eq $deffont ? 0 : $base[2] / 3;
   print "# (@utf8box vs @base)\n";
   ok(abs($utf8box[2] - $base[2]) <= $maxdiff, 
@@ -101,7 +101,7 @@ SKIP:
     ok(i_t1_cp($backgr, 80, 180, 1, $fnum, 32, $text, length($text), 1),
         "cp UTF8");
     @utf8box = i_t1_bbox($fnum, 50.0, $text, length($text), 0);
-    is(@utf8box, 7, "native utf8 bbox element count");
+    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)");
     eval q{$text = "A\xA1\xA2\x01\x1F\x{0100}A"};
@@ -158,7 +158,7 @@ SKIP:
   SKIP:
   {
     ok($font, "loaded OO font")
-      or skip("Could not load test font", 15);
+      or skip("Could not load test font", 24);
     my @exists = $font->has_chars(string=>"!A");
     is(@exists, 2, "return count from has_chars");
     ok($exists[0], "we have an exclamation mark");
@@ -199,6 +199,31 @@ SKIP:
     };
     is($@, "", "correct error handling");
     cmp_ok(Imager->errstr, '=~', qr/no string parameter/, "error message");
+
+    # test extended bounding box results
+    # the test font is known to have a shorter advance width for that char
+    @bbox = $font->bounding_box(string=>"/", size=>100);
+    is(@bbox, 8, "should be 8 entries");
+    isnt($bbox[6], $bbox[2], "different advance width");
+    my $bbox = $font->bounding_box(string=>"/", size=>100);
+    cmp_ok($bbox->pos_width, '>', $bbox->advance_width, "OO check");
+
+    cmp_ok($bbox->right_bearing, '<', 0, "check right bearing");
+
+    cmp_ok($bbox->display_width, '>', $bbox->advance_width,
+           "check display width (roughly)");
+
+    # check with a char that fits inside the box
+    $bbox = $font->bounding_box(string=>"!", size=>100);
+    print "# pos width ", $bbox->pos_width, "\n";
+
+    # they aren't the same historically for the type 1 driver
+    isnt($bbox->pos_width, $bbox->advance_width, 
+       "check backwards compatibility");
+    cmp_ok($bbox->left_bearing, '>', 0, "left bearing positive");
+    cmp_ok($bbox->right_bearing, '>', 0, "right bearing positive");
+    cmp_ok($bbox->display_width, '<', $bbox->advance_width,
+           "display smaller than advance");
   }
 }
 
diff --git a/t/t35ttfont.t b/t/t35ttfont.t
index 133d0302..258ee8e5 100644
--- a/t/t35ttfont.t
+++ b/t/t35ttfont.t
@@ -1,7 +1,7 @@
 #!perl -w
 use strict;
 use lib 't';
-use Test::More tests => 43;
+use Test::More tests => 49;
 
 BEGIN { use_ok(Imager => ':all') }
 require "t/testtools.pl";
@@ -32,7 +32,7 @@ SKIP:
   ok($ttraw, "create font");
 
   my @bbox = i_tt_bbox($ttraw,50.0,'XMCLH',5,0);
-  is(@bbox, 7, "bounding box");
+  is(@bbox, 8, "bounding box");
   print "#bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
 
   ok(i_tt_cp($ttraw,$overlay,5,50,1,50.0,'XMCLH',5,1,0), "cp output");
@@ -71,9 +71,9 @@ SKIP:
   my $alttext = "A-A";
   
   my @utf8box = i_tt_bbox($ttraw, 50.0, $text, length($text), 1);
-  is(@utf8box, 7, "utf8 bbox element count");
+  is(@utf8box, 8, "utf8 bbox element count");
   my @base = i_tt_bbox($ttraw, 50.0, $alttext, length($alttext), 0);
-  is(@base, 7, "alt bbox element count");
+  is(@base, 8, "alt bbox element count");
   my $maxdiff = $fontname eq $deffont ? 0 : $base[2] / 3;
   print "# (@utf8box vs @base)\n";
   ok(abs($utf8box[2] - $base[2]) <= $maxdiff, 
@@ -100,7 +100,7 @@ SKIP:
     ok(i_tt_cp($ttraw, $backgr, 350, 80, 0, 14, $text, 0, 1, 0),
        "cp UTF8");
     @utf8box = i_tt_bbox($ttraw, 50.0, $text, length($text), 0);
-    is(@utf8box, 7, "native utf8 bbox element count");
+    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)");
     eval q{$text = "A\x{0905}\x{0906}\x{0103}A"}; # Devanagari
@@ -119,7 +119,7 @@ SKIP:
  SKIP:
   {
     ok($hcfont, "loading existence test font")
-      or skip("could not load test font", 14);
+      or skip("could not load test font", 20);
 
     # list interface
     my @exists = $hcfont->has_chars(string=>'!A');
@@ -150,11 +150,27 @@ SKIP:
 
     # the test font is known to have a shorter advance width for that char
     my @bbox = $hcfont->bounding_box(string=>"/", size=>100);
-    is(@bbox, 7, "should be 7 entries");
+    is(@bbox, 8, "should be 8 entries");
     isnt($bbox[6], $bbox[2], "different advance width from pos width");
     print "# @bbox\n";
     my $bbox = $hcfont->bounding_box(string=>"/", size=>100);
     isnt($bbox->pos_width, $bbox->advance_width, "OO check");
+
+    cmp_ok($bbox->right_bearing, '<', 0, "check right bearing");
+
+    cmp_ok($bbox->display_width, '>', $bbox->advance_width,
+           "check display width (roughly)");
+
+    # check with a char that fits inside the box
+    $bbox = $hcfont->bounding_box(string=>"!", size=>100);
+    print "# @$bbox\n";
+    print "# pos width ", $bbox->pos_width, "\n";
+    is($bbox->pos_width, $bbox->advance_width, 
+       "check backwards compatibility");
+    cmp_ok($bbox->left_bearing, '>', 0, "left bearing positive");
+    cmp_ok($bbox->right_bearing, '>', 0, "right bearing positive");
+    cmp_ok($bbox->display_width, '<', $bbox->advance_width,
+           "display smaller than advance");
   }
   undef $hcfont;
   
diff --git a/t/t36oofont.t b/t/t36oofont.t
index cab30fe7..6d374c93 100644
--- a/t/t36oofont.t
+++ b/t/t36oofont.t
@@ -15,7 +15,7 @@ my $loaded;
 BEGIN { $| = 1; print "1..20\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Imager;
-require "t/testtools.pl";
+BEGIN { require "t/testtools.pl"; }
 $loaded=1;
 okx(1, "loaded");
 
@@ -46,7 +46,7 @@ if (i_has_format("t1") and -f $fontname_pfb) {
   my $text="LLySja";
   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
 
-  okx(@bbox == 7, "bounding box list length");
+  isx(@bbox, 8, "bounding box list length");
 
   $img->box(box=>\@bbox, color=>$green);
 
@@ -97,7 +97,7 @@ if (i_has_format("tt") and -f $fontname_tt) {
   my $text="LLySja";
   my @bbox=$font->bounding_box(string=>$text, 'x'=>0, 'y'=>50);
 
-  okx(@bbox == 7, "bbox list size");
+  isx(@bbox, 8, "bbox list size");
 
   $img->box(box=>\@bbox, color=>$green);