#---------------------------------------------------------------------
package Font_Test;
#
# Copyright 2009 Christopher J. Madsen
#
# Author: Christopher J. Madsen <perl@cjmweb.net>
# Created: 31 Oct 2009
#
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See either the
# GNU General Public License or the Artistic License for more details.
#
# Compare our font metrics against Font::AFM
#---------------------------------------------------------------------

use 5.008;
our $VERSION = '2.00';

use strict;
use warnings;
use Exporter 5.57 'import';
use constant number_of_tests => 275;
use Test::More tests => number_of_tests;

use PostScript::File::Metrics;

our @EXPORT = qw(test_font);

our %attribute = qw(
  FullName           full_name
  FamilyName         family
  Weight             weight
  IsFixedPitch       fixed_pitch
  ItalicAngle        italic_angle
  FontBBox           font_bbox
);

our %dimension_attribute = qw(
  UnderlinePosition  underline_position
  UnderlineThickness underline_thickness
  CapHeight          cap_height
  XHeight            x_height
  Ascender           ascender
  Descender          descender
);
# We don't test this:
#  Version            version

#=====================================================================

sub test_font
{
  my ($font) = @_;

  my $size = 125;
  my $factor = 1000 / $size;

  my $metrics = PostScript::File::Metrics->new($font, $size, 'iso-8859-1');

  isa_ok($metrics, 'PostScript::File::Metrics');

  ok(!$INC{'PostScript/File/Metrics/Loader.pm'},
     'used pre-compiled metrics');

  SKIP: {
    my $testsInBlock = number_of_tests - 2;

    # RECOMMEND PREREQ: Font::AFM
    # Construct the Font::AFM object, or skip the remaining tests:
    eval { require Font::AFM };

    skip "Font::AFM not installed", $testsInBlock if $@;

    my $afm = eval { Font::AFM->new($font) };

    skip "Font::AFM can't find $font.afm", $testsInBlock if $@;

    # Compare the font attributes:
    foreach my $afm_method (sort keys %attribute) {
      my $metrics_method = $attribute{$afm_method};
      my $got = $metrics->$metrics_method;
      if ($afm_method eq 'FontBBox') {
        $_ *= $factor for @$got;
        $got = "@$got" ;
      } # end if FontBBox
      $got = $got ? 'true' : 'false' if $afm_method eq 'IsFixedPitch';
      is($got, $afm->$afm_method, $afm_method);
    }

    # Compare the font dimension attributes:
    foreach my $afm_method (sort keys %dimension_attribute) {
      my $metrics_method = $dimension_attribute{$afm_method};
      my $got = $metrics->$metrics_method;
      is($got * $factor, $afm->$afm_method, $afm_method);
    }

    # Compare the character widths:
    my $wx = $afm->latin1_wx_table;
    $metrics->set_auto_hyphen(0); # Font::AFM doesn't translate hyphen-minus
    $metrics->set_size(undef);    # Switch to default size to match Font::AFM

    for my $char (0 .. 255) {
      my $name = sprintf 'width of char \%03o, \x%02X', $char, $char;
      $name = sprintf '%s (%c)', $name, $char
          if $char >= 0x20 and $char < 0x7F;
      is( $metrics->width(pack 'C', $char), $wx->[$char], $name);
    } # end for $char

    # Test width vs stringwidth:
    $metrics->set_size($size);  # Switch back to old size
    while (<DATA>) {
      chomp $_;
      is( $metrics->width($_), $afm->stringwidth($_, $size), $_);
    }

  } # end SKIP
} # end test_font

#=====================================================================
# Package Return Value:

1;

__DATA__
Now is the time for all good men to come to the aid of their country.
The quick brown fox jumps over the lazy dog.
car­wash
car-wash
-1