File Coverage

blib/lib/PDF/Make/Builder/Font.pm

Criterion	Covered	Total	%
statement	75	78	96.1
branch	22	28	78.5
condition	9	15	60.0
subroutine	16	16	100.0
pod	8	8	100.0
total	130	145	89.6

package PDF::Make::Builder::Font;
use strict;
use warnings;
use Object::Proto;
use PDF::Make::Page qw(:fonts);
use PDF::Make::Font ();

BEGIN {
    Object::Proto::define('PDF::Make::Builder::Font',
        'colour:Str:default(#000)',
        'size:Num:default(9)',
        'family:Str:default(Helvetica)',
        'bold:Bool:default(0)',
        'italic:Bool:default(0)',
        'line_height:Num',
        'loaded:HashRef:default({})',
    );
    Object::Proto::import_accessors('PDF::Make::Builder::Font');
}

# Standard 14 font family mapping: family => { variant => page constant }
my %STD14 = (
    Times => {
        normal      => TIMES_ROMAN,
        bold        => TIMES_BOLD,
        italic      => TIMES_ITALIC,
        bolditalic  => TIMES_BOLDITALIC,
    },
    Helvetica => {
        normal      => HELVETICA,
        bold        => HELVETICA_BOLD,
        italic      => HELVETICA_OBLIQUE,
        bolditalic  => HELVETICA_BOLDOBLIQUE,
    },
    Courier => {
        normal      => COURIER,
        bold        => COURIER_BOLD,
        italic      => COURIER_OBLIQUE,
        bolditalic  => COURIER_BOLDOBLIQUE,
    },
    Symbol      => { normal => SYMBOL },
    ZapfDingbats => { normal => ZAPFDINGBATS },
);

# Map family+variant to PDF BaseFont name for XS Font
my %BASEFONT = (
    'Times_normal'           => 'Times-Roman',
    'Times_bold'             => 'Times-Bold',
    'Times_italic'           => 'Times-Italic',
    'Times_bolditalic'       => 'Times-BoldItalic',
    'Helvetica_normal'       => 'Helvetica',
    'Helvetica_bold'         => 'Helvetica-Bold',
    'Helvetica_italic'       => 'Helvetica-Oblique',
    'Helvetica_bolditalic'   => 'Helvetica-BoldOblique',
    'Courier_normal'         => 'Courier',
    'Courier_bold'           => 'Courier-Bold',
    'Courier_italic'         => 'Courier-Oblique',
    'Courier_bolditalic'     => 'Courier-BoldOblique',
    'Symbol_normal'          => 'Symbol',
    'ZapfDingbats_normal'    => 'ZapfDingbats',
);

# Cache for PDF::Make::Font XS objects (exact per-glyph metrics)
my %_xs_font_cache;

sub _xs_font {
    my ($self, $variant) = @_;
    $variant //= $self->_default_variant;
    my $fam = family $self;
    my $key = "${fam}_${variant}";
    return $_xs_font_cache{$key} if $_xs_font_cache{$key};
    my $basefont = $BASEFONT{$key};
    return undef unless $basefont;
    $_xs_font_cache{$key} = PDF::Make::Font->standard14($basefont);
    return $_xs_font_cache{$key};
}

sub _default_variant {
    my ($self) = @_;
    return 'bolditalic' if bold($self) && italic($self);
    return 'bold'       if bold($self);
    return 'italic'     if italic($self);
    return 'normal';
}

sub effective_line_height {
    my ($self) = @_;
    my $lh = line_height $self;
    return defined $lh && $lh > 0 ? $lh : size $self;
}

sub measure_text {
    my ($self, $text) = @_;
    my $xs = $self->_xs_font;
    return $xs->string_width($text, size $self) if $xs;
    # Fallback for unknown fonts
    return length($text) * 0.52 * (size $self);
}

sub measure_word {
    my ($self, $word) = @_;
    my $xs = $self->_xs_font;
    return $xs->string_width($word, size $self) if $xs;
    return length($word) * 0.52 * (size $self);
}

sub space_width {
    my ($self) = @_;
    my $xs = $self->_xs_font;
    return $xs->string_width(' ', size $self) if $xs;
    return 0.28 * (size $self);
}

sub hex_to_rgb {
    my ($self, $hex) = @_;
    $hex =~ s/^#//;
    my ($r, $g, $b);
    if (length($hex) == 3) {
        ($r, $g, $b) = map { hex($_.$_) / 255.0 } split //, $hex;
    } elsif (length($hex) == 6) {
        $r = hex(substr($hex, 0, 2)) / 255.0;
        $g = hex(substr($hex, 2, 2)) / 255.0;
        $b = hex(substr($hex, 4, 2)) / 255.0;
    } else {
        return (0, 0, 0);
    }
    return ($r, $g, $b);
}

sub resource_name {
    my ($self, $variant) = @_;
    $variant //= $self->_default_variant;
    my $fam = family $self;
    return "F_${fam}_${variant}";
}

sub ensure_loaded {
    my ($self, $xs_page, $variant) = @_;
    $variant //= $self->_default_variant;
    my $fam = family $self;
    my $key = "${fam}_${variant}";
    my $res_name = "F_${key}";

    # Cache is per-page (keyed by page pointer address) to handle overflow
    my $page_id = "$xs_page";  # stringified ref = unique per page
    my $ld = loaded $self;
    return $res_name if $ld->{"${key}_${page_id}"};

    my $family_map = $STD14{$fam};
    die "PDF::Make::Builder::Font: unknown font family '$fam'" unless $family_map;
    my $font_id = $family_map->{$variant};
    die "PDF::Make::Builder::Font: unknown variant '$variant' for '$fam'" unless defined $font_id;

    $xs_page->add_std14_font($res_name, $font_id);
    $ld->{"${key}_${page_id}"} = 1;
    loaded $self, $ld;
    return $res_name;
}

sub families { return keys %STD14 }

1;

__END__