package Text::PDF::SFont;

# use strict;
use vars qw(@ISA %widths @encodings);
@ISA = qw(Text::PDF::Dict);

use Text::PDF::Utils;
use Compress::Zlib;

=head1 NAME

Text::PDF::SFont - PDF Standard inbuilt font resource object. Inherits from
L<Text::PDF::Dict>

=head1 METHODS

=head2 Text::PDF::SFont->new($parent, $name, $pdfname)

Creates a new font object with given parent and name. The name must be from
one of the core 14 base fonts included with PDF. These are:

    Courier,     Courier-Bold,   Courier-Oblique,   Courier-BoldOblique
    Times-Roman, Times-Bold,     Times-Italic,      Times-BoldItalic
    Helvetica,   Helvetica-Bold, Helvetica-Oblique, Helvetica-BoldOblique
    Symbol,      ZapfDingbats

The $pdfname is the name that this particular font object will be referenced
by throughout the PDF file. If you want to play silly games with naming, then
you can write the code to do it!

All fonts in this system are full PDF objects.

=head1 BUGS

Currently no width support for Symbol or ZapfDingbats, I haven't
got my head around the AFMs yet.

MacExpertEncoding not supported yet (I don't have the width info for any
of the fonts)

=cut

BEGIN
{
    @encodings = ('WinAnsiEncoding', 'MacRomanEncoding');
    %enc_map = (
        'WinAnsiEncoding' => [0 .. 126, 128, 160, 128, 145,134, 140,
        131, 129, 130, 26, 139, 151, 136, 150, 128, 153, 128, 128, 143,
        144, 141, 142, 128, 133, 132, 31, 146, 157, 137, 156, 128, 158,
        152, 32, 161 .. 255],
        'MacRomanEncoding' => [0 .. 127, 196, 197, 199, 201, 209, 214,
        220, 225, 224, 226, 228, 227, 229, 231, 233, 232, 234, 235, 237,
        236, 238, 239, 241, 243, 242, 244, 246, 245, 250, 249, 251, 252,
        129, 176, 162, 163, 128, 182, 223, 174, 169, 146, 180, 168, 0,
        198, 216, 0, 177, 0, 0, 165, 181, 0, 0, 0, 0, 0, 186, 169, 0,
        230, 248, 192, 161, 172, 0, 134, 0, 0, 171, 187, 131, 32, 192,
        195, 213, 150, 156, 133, 132, 141 .. 144, 247, 0, 255, 152, 135,
        164, 136, 137, 147, 148, 130, 183, 145, 140, 139, 194, 202, 200,
        205, 206, 207, 204, 211, 212, 0, 210, 218, 219, 217, 154, 26,
        31, 175, 24, 27, 30, 184, 28, 29, 25],
                );
}

sub new
{
    my ($class, $parent, $name, $pdfname, $encoding) = @_;
    my ($self) = $class->SUPER::new;

    $self->{'Type'} = PDFName("Font");
    $self->{'Subtype'} = PDFName("Type1");
    $self->{'BaseFont'} = PDFName($name);
    $self->{'Name'} = PDFName($pdfname);
    $self->{'Encoding'} = PDFName($encodings[$encoding-1]) if ($encoding);
    $parent->new_obj($self);
    $self;
}

=head2 $f->width($text)

Returns the width of the text in em.

=cut

sub getBase
{
    my ($self) = @_;

    unless (defined $widths{$self->{'BaseFont'}->val})
    { @{$widths{$self->{'BaseFont'}->val}} = unpack("n*",
                uncompress(unpack("u", $width_data{$self->{'BaseFont'}->val}))); }
    $self;
}

sub width
{
    my ($self, $text) = @_;
    my ($width);
    my ($str) = $self->{'BaseFont'}->val;
    my ($enc);
    $enc = $self->{'Encoding'}->val if defined $self->{'Encoding'};
    
    $self->getBase;
    foreach (unpack("C*", $text))
    { $width += $widths{$str}[$enc ne "" ? $enc_map{$enc}[$_] : $_]; }
    $width / 1000;
}

=head2 $f->trim($text, $len)

Trims the given text to the given length (in per mille em) returning the trimmed
text

=cut

sub trim
{
    my ($self, $text, $len) = @_;
    my ($width, $i);
    my ($str) = $self->{'BaseFont'}->val;
    my ($enc);
    $enc = $self->{'Encoding'}->val if defined $self->{'Encoding'};
    
    $self->getBase;
    $len *= 1000;
    
    foreach (unpack("C*", $text))
    {
        $width += $widths{$str}[$enc ne "" ? $nec_map{$enc}[$_] : $_];
        last if ($width > $len);
        $i++;
    }
    return substr($text, 0, $i);
}

BEGIN
{
%width_data = (
'Courier' => <<'EOT',
8>)QC8"`-,$4,)TB9?_"%Q]`(*0`U#D_/
EOT

'Courier-Bold' => <<'EOT',
8>)QC8"`-,$4,)TB9?_"%Q]`(*0`U#D_/
EOT

'Courier-BoldOblique' => <<'EOT',
8>)QC8"`-,$4,)TB9?_"%Q]`(*0`U#D_/
EOT

'Courier-Oblique' => <<'EOT',
8>)QC8"`-,$4,)TB9?_"%Q]`(*0`U#D_/
EOT

'Helvetica' => <<'EOT',
M>)R54#$.PC`,C.U.?4`E_I!/P)2E?0)+9Q:V/H"=/0]@[0_X0R362FQ]0"16
MSFY+4<5"3HJ<LWV.S[G_#M4;5$#+GKUT'-W=N`L'L);3S!;&!X.7%T<@`9%;
M*3DAFQ%[V7/".RJG.;VEM^K6IE;T8.\&4\R3KMYN<`-E-Z!_F5=3UARJ$B)%
M0P4U'+#/T?X^RFB]-_T_!QFG[50+<59]5,RSP?7*37Y\IA0ZB9]TQ@O*B&JZ
MP@E3`K<S3VHZ0>N@P$YQ!?33$L_[5>J+E`OPK]*<2G-E^^VJ=),+B\,_W`]K
)A]92?@,9KULP
EOT

'Helvetica-Bold' => <<'EOT',
M>)R54"L6PC`0S&Y<#Y#70^02H&IZ!4PT!L<!ZO$]`+8WX;U('*X*Q0&8G=!0
MZNB\-)O]S>PZ]]\G_08!YZY1HS]K=D_Z!NWH#Q(LLH7E:$<D?]/\P8A7HYDU
M&?9.,]ZC^2QF?S_!@EUX41^9G<J!)R%&5@G0DPJ@I\0B>AG_2P9I327F.5#[
M[&>[W;5H\S-R#.B%"+O@+MSFFZQ+V4>=JB7+0TYXH3.L7B[8!/=$?8'V$7Q[
G`V>J0/],!L`X.(?YFP70U:RV-7+N"LS[W?!2GW[0K6QN[`T)B%=1
EOT

'Helvetica-BoldOblique' => <<'EOT',
M>)R54"L6PC`0S&Y<#Y#70^02H&IZ!4PT!L<!ZO$]`+8WX;U('*X*Q0&8G=!0
MZNB\-)O]S>PZ]]\G_08!YZY1HS]K=D_Z!NWH#Q(LLH7E:$<D?]/\P8A7HYDU
M&?9.,]ZC^2QF?S_!@EUX41^9G<J!)R%&5@G0DPJ@I\0B>AG_2P9I327F.5#[
M[&>[W;5H\S-R#.B%"+O@+MSFFZQ+V4>=JB7+0TYXH3.L7B[8!/=$?8'V$7Q[
G`V>J0/],!L`X.(?YFP70U:RV-7+N"LS[W?!2GW[0K6QN[`T)B%=1
EOT

'Helvetica-Oblique' => <<'EOT',
M>)R54#$.PC`,C.U.?4`E_I!/P)2E?0)+9Q:V/H"=/0]@[0_X0R362FQ]0"16
MSFY+4<5"3HJ<LWV.S[G_#M4;5$#+GKUT'-W=N`L'L);3S!;&!X.7%T<@`9%;
M*3DAFQ%[V7/".RJG.;VEM^K6IE;T8.\&4\R3KMYN<`-E-Z!_F5=3UARJ$B)%
M0P4U'+#/T?X^RFB]-_T_!QFG[50+<59]5,RSP?7*37Y\IA0ZB9]TQ@O*B&JZ
MP@E3`K<S3VHZ0>N@P$YQ!?33$L_[5>J+E`OPK]*<2G-E^^VJ=),+B\,_W`]K
)A]92?@,9KULP
EOT

'Times-Bold' => <<'EOT',
M>)R54#$.PC`,C)T%Y0&9^`%Y0;<.+$C]`DO?DJ43>S<65AZ05W3F`960F#(Q
M<78"+6(BI]B.[=@^&_/?H>X;YDD=[RA3MK-MR:LW<R-^7"^1'R"'&P%^G7GB
M$5=D;YUU%.%U/-HK3]#P(19*CIU+)BJ@$^^U5N9`26ZU)0)I6TB\-1+5EWG2
M_HD&<Z.!-^!SK+//HLVES%9>95+T#-)?M?3VY%$G4JK[J*Q0$?E\IZ#\#:R.
M3N`8`'3GK>P$]@'QAT#F6:#<Q@)45ZC?O8&YW.I'+XP68*;T@:_(ZQS9MW()
(93.47Q0]@OL`
EOT

'Times-BoldItalic' => <<'EOT',
M>)R54+L1@S`,E>2.`;Q$F,`5&8`-.!I/P0#NTS-`V@S`%-09@+O<I7*5*D]R
MXH1+%=Z!]?/3XQ']]W"_!STXR8$S9W=T#7NK9@FH:\]KYP>8D:#`K4YFPUJ^
MX$BX/TMT$VJK1.NTY40-'8E@\,IA7,JXV*N;6W1TJW<-XK(O`1[9(K/-)1[H
MR@-4$H^F?7.;GG0V;6/)BE*W83OVNXNIB,HOJW*:'^G]5V#$O-RX@8J1"%'/
M)VAL@5XZ3,`3R[+<%?:?%>"OL2D&S($/PE>L2G:N0M-2X5_(U0.=")H7%,>>
$ZZB'L0``
EOT

'Times-Italic' => <<'EOT',
M>)R54#L.PC`,C9T-1E`W;N"9O0?H%5AZBAX@>T<DQB!8.4!/42'.P,24`3'Q
M[*;0BHD^)?ZES_9S[K^/JCG<"_>1$B5?^H6[639QU#Q.H94?X`U'!?[:<PT<
MN#?;<X]JAUA\F;,X8!2UR-7PA`*8`YV,2QD[.T.W`H`/IK%?L/=)>5'I$+6T
MHI8WV&=GLS>^4>O.PVS^KEW0!Y&_:@7S7&P*47[P@-/T")\N*YV&G[2V_1V\
M"CTB"8EILC2MA+;P'PK8^@O?8-_LC^IB9]5@1)SXHJI,D7<;4&3,7\1)9(J]
%`8H]BK$`
EOT

'Times-Roman' => <<'EOT',
M>)R542L2PC`0S6Y<-1/'#2(S>`[0*V!Z"@Z`1\+D`%@$,I89=`=\916J@D'Q
M=IMV6E#T3;9]N]NWGQCSWT/E'.8->Z"..KNVA;FHM^,@?APGD1\X<AP$E.R1
M:XY`S15[V!K_[X39K3#U1=A*F#VKKT*.PWE`JZ0$VY]R4!=KB[$>%/M.H-YI
M9F-NU/`2\VRT]]:V\C8GZ9\#6%*`V3NJ>^W':VWIOH9BROO(5:"(2ORBA<YO
M\%72'C-Z0+*NNBM/*\2?`DHZ30;T(Z94#-N=QH$P8UXG&<%QPES&;._HY>LF
%/HNICN<`
EOT
);
}

1;

