package Text::PDF::SFont;

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

use Text::PDF::Utils;
use Compress::Zlib;
# no warnings qw(uninitialized);

=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],
        'PDFDocEncoding' => [0 .. 255],
        'AdobeStandardEncoding' => [
		0 .. 38, 144, 40 .. 95, 143, 97 .. 126, 0, 0, 0, 0, 0, 0, 0, 
		0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
		0, 0, 0, 0, 0, 0, 0,  161, 162, 163, 135, 165, 134, 167, 164, 
		39, 141, 171, 136, 137, 147, 148, 0, 133, 129, 130, 183, 0, 
		182, 128, 145, 140, 142, 187, 131, 139, 0, 191, 0, 96, 180, 
		26, 31,175, 24, 27, 168, 0, 30, 231, 0, 28, , 25, 29, 132, 
		0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 198, 0, 170,
		0, 0, 0, 0, 149, 216, 150, 186, 0, 0, 0, 0, 0, 230, 0, 0, 0, 
		154, 0, 0, 155, 248, 156, 223, 0, 0, 0, 0],        
                );
}

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

    return undef unless exists $width_data{$name};
    $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}[(defined $enc and $enc ne "") ? $enc_map{$enc}[$_] : $_]; }
    $width / 1000;
}

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

Trims the given text to the given length (in 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);
}

=head2 $f->out_text($text)

Acknowledges the text to be output for subsetting purposes, etc.

=cut

sub out_text
{
    my ($self, $text) = @_;

    return PDFStr($text)->as_pdf;
}

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

'Symbol' => <<'EOT',
M>)RED*%/PV`0Q;_W#C-D1<WT''YVR(HF\Y]`#(DGH#!X,ML_8*X"4\,?L":H
MVID9DAF^A&0)R3"\:TT3</M^N6LN[_)Z=R&<^4XHV>+(F5W;)1J40E4X>2#'
M\1]RY)PY>%/N6"ENN>(/(SOYW:NN[4&YL\`/7G$I]16-JF>;<H72;M2W=C=U
MNU-"PPDJ1A1R<?<%)_W7<Y2Z8,L:GXJ$?=ABKPG/?DR\"]]RVO17^!JXR&S'
MZ($7S5;U<[3Z[_NPMZYUD'[@VN;:=&H["V+N65..\-IR\:A.OVJK[>+(/Z'H
3]4S^3R/20`@HD+%V_NJ_?N9DIP``
EOT

'ZapfDingbats' => <<'EOT',
M>)RMD#M+`T$4A>>>TZ3TD4V,51K!3CO!!R$B@LTV%M:2*BFUL1!+"19:F2)9
MB"AIM)`$B6D$14%,D11:^@,DJ(46NT8$#_X"0>?CFP<S<^?.=>YOS1+L\$H^
MH$N/"2;1X"5/,,85[K$FZ^S@G3[Z^,`,:OA$A!!O]HIQI)#%&8<8%PFF.,I)
M3BG.DOJLYAE6\(1[O&AW!.>,T6D,<8T;'.."TYS0:4_K4[105Z1AW#')09G7
M>WT1(N2FB'/`FF['/*M:T8H($"C_;3$GXN)+E*WL>JYGOOF_JP`>D4::NZCH
M7Q%C6$83:S\_^D^VN,C(VGAF($NL\D#,,\]9!F*?ASRR+M>Y('+,J1XM%IQC
405DU2*[*#=[*C&Y5V6;I&TT<5J(`
EOT
);
}

1;