]> git.imager.perl.org - imager.git/blobdiff - t/t30t1font.t
bounding_box() for the t1 driver wasn't converting from UTF8 to ascii
[imager.git] / t / t30t1font.t
index b36f5d4fdf1c3c27e13e9de7f96360629068de2b..2a3370f27544210a1ddcf6e7bb1882c2c468e4d2 100644 (file)
@@ -7,7 +7,8 @@
 # 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 => 50;
+use lib 't';
+use Test::More tests => 77;
 BEGIN { use_ok(Imager => ':all') }
 
 #$Imager::DEBUG=1;
@@ -22,19 +23,27 @@ my $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
 SKIP:
 {
   if (!(i_has_format("t1")) ) {
-    skip("t1lib unavailable or disabled", 49);
+    skip("t1lib unavailable or disabled", 76);
   }
   elsif (! -f $fontname_pfb) {
-    skip("cannot find fontfile for type 1 test $fontname_pfb", 49);
+    skip("cannot find fontfile for type 1 test $fontname_pfb", 76);
   }
   elsif (! -f $fontname_afm) {
-    skip("cannot find fontfile for type 1 test $fontname_afm", 49);
+    skip("cannot find fontfile for type 1 test $fontname_afm", 76);
   }
 
   print "# has t1\n";
 
   i_t1_set_aa(1);
 
+  unlink "t1lib.log"; # lose it if it exists
+  init(t1log=>0);
+  ok(!-e("t1lib.log"), "disable t1log");
+  init(t1log=>1);
+  ok(-e("t1lib.log"), "enable t1log");
+  init(t1log=>0);
+  unlink "t1lib.log";
+
   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", 48);
@@ -123,14 +132,6 @@ SKIP:
   print "# debug: ",join(" x ",i_t1_bbox(0,50,"eses",4) ),"\n";
   print "# debug: ",join(" x ",i_t1_bbox(0,50,"llll",4) ),"\n";
 
-  unlink "t1lib.log"; # lose it if it exists
-  init(t1log=>0);
-  ok(!-e("t1lib.log"), "disable t1log");
-  init(t1log=>1);
-  ok(-e("t1lib.log"), "enable t1log");
-  init(t1log=>0);
-  unlink "t1lib.log";
-
   # character existance tests - uses the special ExistenceTest font
   my $exists_font = 'fontfiles/ExistenceTest.pfb';
   my $exists_afm = 'fontfiles/ExistenceText.afm';
@@ -225,6 +226,88 @@ SKIP:
     cmp_ok($bbox->display_width, '<', $bbox->advance_width,
            "display smaller than advance");
   }
+
+ SKIP:
+  { print "# alignment tests\n";
+    my $font = Imager::Font->new(file=>$deffont, type=>'t1');
+    ok($font, "loaded deffont OO")
+      or skip("could not load font:".Imager->errstr, 4);
+    my $im = Imager->new(xsize=>140, ysize=>150);
+    my %common = 
+      (
+       font=>$font, 
+       size=>40, 
+       aa=>1,
+      );
+    $im->line(x1=>0, y1=>40, x2=>139, y2=>40, color=>'blue');
+    $im->line(x1=>0, y1=>90, x2=>139, y2=>90, color=>'blue');
+    $im->line(x1=>0, y1=>110, x2=>139, y2=>110, color=>'blue');
+    for my $args ([ x=>5,   text=>"A", color=>"white" ],
+                  [ x=>40,  text=>"y", color=>"white" ],
+                  [ x=>75,  text=>"A", channel=>1 ],
+                  [ x=>110, text=>"y", channel=>1 ]) {
+      ok($im->string(%common, @$args, 'y'=>40), "A no alignment");
+      ok($im->string(%common, @$args, 'y'=>90, align=>1), "A align=1");
+      ok($im->string(%common, @$args, 'y'=>110, align=>0), "A align=0");
+    }
+    ok($im->write(file=>'testout/t30align.ppm'), "save align image");
+  }
+
+ SKIP:
+  {
+    # see http://rt.cpan.org/Ticket/Display.html?id=20555
+    print "# bounding box around spaces\n";
+    # SpaceTest contains 3 characters, space, ! and .undef
+    # only characters that define character zero seem to illustrate
+    # the problem we had with spaces
+    my $space_fontfile = "fontfiles/SpaceTest.pfb";
+    my $font = Imager::Font->new(file => $space_fontfile, type => 't1');
+    ok($font, "loaded $deffont")
+      or skip("failed to load $deffont" . Imager->errstr, 13);
+    my $bbox = $font->bounding_box(string => "", size => 36);
+    print "# empty string bbox: @$bbox\n";
+    is($bbox->start_offset, 0, "empty string start_offset");
+    is($bbox->end_offset, 0, "empty string end_offset");
+    is($bbox->advance_width, 0, "empty string advance_width");
+    is($bbox->ascent, 0, "empty string ascent");
+    is($bbox->descent, 0, "empty string descent");
+
+    # a single space
+    my $bbox_space = $font->bounding_box(string => " ", size => 36);
+    print "# space bbox: @$bbox_space\n";
+    is($bbox_space->start_offset, 0, "single space start_offset");
+    is($bbox_space->end_offset, $bbox_space->advance_width, 
+       "single space end_offset");
+    cmp_ok($bbox_space->ascent, '>=', $bbox_space->descent,
+          "single space ascent/descent");
+
+    my $bbox_bang = $font->bounding_box(string => "!", size => 36);
+    print "# '!' bbox: @$bbox_bang\n";
+
+    # space ! space
+    my $bbox_spbangsp = $font->bounding_box(string => " ! ", size => 36);
+    print "# ' ! ' bbox: @$bbox_spbangsp\n";
+    my $exp_advance = $bbox_bang->advance_width + 2 * $bbox_space->advance_width;
+    is($bbox_spbangsp->advance_width, $exp_advance, "sp ! sp advance_width");
+    is($bbox_spbangsp->start_offset, 0, "sp ! sp start_offset");
+    is($bbox_spbangsp->end_offset, $exp_advance, "sp ! sp end_offset");
+  }
+
+ SKIP:
+  { # http://rt.cpan.org/Ticket/Display.html?id=20554
+    # this is "A\xA1\x{2010}A"
+    # the t1 driver is meant to ignore any UTF8 characters over 0xff
+    print "# issue 20554\n";
+    my $text = pack("C*", 0x41, 0xC2, 0xA1, 0xE2, 0x80, 0x90, 0x41);
+    my $tran_text = "A\xA1A";
+    my $font = Imager::Font->new(file => 'fontfiles/dcr10.pfb', type => 't1');
+    $font
+      or skip("cannot load font fontfiles/fcr10.pfb:".Imager->errstr, 1);
+    my $bbox_utf8 = $font->bounding_box(string => $text, utf8 => 1, size => 36);
+    my $bbox_tran = $font->bounding_box(string => $tran_text, size => 36);
+    is($bbox_utf8->advance_width, $bbox_tran->advance_width,
+       "advance widths should match");
+  }
 }
 
 #malloc_state();