view release on metacpan or  search on metacpan

lib/CAM/PDFTaxforms.pm  view on Meta::CPAN

            # Try to pull out the font size, if any.  If more than
            # one, pick the last one.  Font commands look like:
            # "/<fontname> <size> Tf"
            #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($da =~ m{ \s*/(\w+)\s+(\d+)\s+Tf.*? \z }xms)
            if ($da =~ m{ \s*/([\w-]+)\s+([.\d]+)\s+Tf.*? \z }xmso)
            {
               $fontname = $1;
               $fontsize = $2;
               if ($fontname)
               {
                  if ($propdict->{DR})
                  {
                     my $dr = $self->getValue($propdict->{DR});
                     $fontmetrics = $self->getFontMetrics($dr, $fontname);
                  }
                  #print STDERR "Didn't get font\n" if (!$fontmetrics);
               }
            }
         }

         my %flags = (
            Justify => 'left',
         );
         if ($propdict->{Ff})
         {
            # Just decode the ones we actually care about
            # PDF ref, 3rd ed pp 532,543
            my $ff = $self->getValue($propdict->{Ff});
            my @flags = split m//xms, unpack 'b*', pack 'V', $ff;
            $flags{ReadOnly}        = $flags[0];
            $flags{Required}        = $flags[1];
            $flags{NoExport}        = $flags[2];
            $flags{Multiline}       = $flags[12];
            $flags{Password}        = $flags[13];
            $flags{FileSelect}      = $flags[20];
            $flags{DoNotSpellCheck} = $flags[22];
            $flags{DoNotScroll}     = $flags[23];
         }
         if ($propdict->{Q})
         {
            my $q = $self->getValue($propdict->{Q}) || 0;
            $flags{Justify} = $q==2 ? 'right' : ($q==1 ? 'center' : 'left');
         }

         # The order of the following sections is important!
         $text =~ s/ [^\n] /*/gxms  if ($flags{Password});  # Asterisks for password characters

         if ($fontmetrics && ! $fontsize)
         {
            # Fix autoscale fonts
            $stringwidth = 0;
            my $lines = 0;
            for my $line (split /\n/xmso, $text)  # trailing null strings omitted
            {
               $lines++;
               my $w = $self->getStringWidth($fontmetrics, $line);
               $stringwidth = $w  if ($w && $w > $stringwidth);
            }
            $lines ||= 1;
            # Initial guess
            $fontsize = ($dy - 2 * $border) / ($lines * 1.5);
            my $fontwidth = $fontsize * $stringwidth;
            my $maxwidth = $dx - 2 * $border;
            $fontsize *= $maxwidth / $fontwidth  if ($fontwidth > $maxwidth);
            $da =~ s/ \/$fontname\s+0\s+Tf\b /\/$fontname $fontsize Tf/gxms;
         }
         if ($fontsize)
         {
            # This formula is TOTALLY empirical.  It's probably wrong.
#           #JWT:CHGD. TO NEXT:  $ty = $border + 2 + (9 - $fontsize) * 0.4;
            $ty = $border + 2 + (5 - $fontsize) * 0.4;
         }


         # escape characters
         $text = $self->writeString($text);

         if ($flags{Multiline})
         {
            # TODO: wrap the field with wrapString()??
            # Shawn Dawson of Silent Solutions pointed out that this does not auto-wrap the input text

            my $linebreaks = $text =~ s/ \\n /\) Tj T* \(/gxms;

            # Total guess work:
            # line height is either 150% of fontsize or thrice
            # the corner offset
            $tl = $fontsize ? $fontsize * 1.5 : $ty * 3;

            # Bottom aligned
            #$ty += $linebreaks * $tl;
            # Top aligned
            $ty = $dy - $border - $tl;
            warn 'Justified text not supported for multiline fields'  if ($flags{Justify} ne 'left');
            $tl .= ' TL';
         }
         else
         {
            #JWT: CHGD. TO NEXT (BUG#58144 PATCH): if ($flags{Justify} ne 'left' && $fontmetrics)
            if ($flags{Justify} ne 'left')
            {
               #JWT: CHGD. TO NEXT 8: my $width = $stringwidth || $self->getStringWidth($fontmetrics, $text);
               my $width;
               if ($stringwidth || $fontmetrics) {
                  #JWT:CHGD TO NEXT PER BUG#122890: $width = $self->getStringWidth($fontmetrics, $text);
                  $width = $self->getStringWidth($fontmetrics, (substr $text, 1, (length $text)-2));
               } else {  #JWT: NO FONT METRICS, SO HAVE TO GUESS WIDTH:
               	  $width = (length($text)-1) * 0.57;  #JWT:FIXME (HACK) FOR RIGHT-JUSTIFYING STANDARD SIZE 8 NUMERIC FONT.
                  my $commas = $text;
                  $width -= 0.29  while ($commas =~ s/\,//o);  #JWT:FIXME (HACK) FUDGE FOR WIDTH OF COMMAS (SMALLER THAN DIGITS)
               }
               my $diff = $dx - $width * $fontsize;
               $diff = 0  if ($diff < 0);  #JWT:ADDED.

               if ($flags{Justify} eq 'center')
               {
                  $text = ($diff/2)." 0 Td $text";
               }
               elsif ($flags{Justify} eq 'right')
               {
                  $text = "$diff 0 Td $text";
               }
            }
         }

         # Move text from lower left corner of form field
         my $tm = "1 0 0 1 $tx $ty Tm ";

         # if not 'none', draw a background as a filled rectangle of solid color
         my $background_color
               = $opts{background_color} eq 'none' ? q{}
               : ref $opts{background_color}       ? "@{$opts{background_color}} rgb"
                     : "$opts{background_color} g";
         my $background = $background_color ? "$background_color 0 0 $dx $dy re f" : q{};

         $text =  "$tl $da $tm $text Tj";
         $text = "$background /Tx BMC q 1 1 ".($dx-$border).q{ }.($dy-$border)." re W n BT $text ET Q EMC";
         unless ($fieldType eq 'Btn')  #JWT:ADDED CONDITION:
         {
            $formdict->{Length} = CAM::PDF::Node->new('number', length($text), $formonum, $formgnum);
            # JWT:NEXT 3 ADDED PER BUG#125299 PATCH:
            $formdict->{StreamData} = CAM::PDF::Node->new('stream', $text, $formonum, $formgnum);
            delete $formdict->{ Filter };
            $self-> encodeObject( $formonum, 'FlateDecode' );
         }