File Coverage

blib/lib/SVGPDF/Text.pm
Criterion Covered Total %
statement 81 120 67.5
branch 29 64 45.3
condition 9 39 23.0
subroutine 5 5 100.0
pod 0 1 0.0
total 124 229 54.1


line stmt bran cond sub pod time code
1             #! perl
2              
3 2     2   1038 use v5.26;
  2         7  
4 2     2   13 use Object::Pad;
  2         3  
  2         12  
5 2     2   232 use utf8;
  2         4  
  2         12  
6 2     2   56 use Carp;
  2         4  
  2         509  
7              
8             class SVGPDF::Text :isa(SVGPDF::Element);
9              
10 24     24 0 44 method process () {
  24         59  
  24         33  
11 24         89 my $atts = $self->atts;
12 24         97 my $xo = $self->xo;
13 24 50       65 return if $atts->{omit}; # for testing/debugging.
14              
15 24         95 my ( $x, $y, $dx, $dy, $tf ) =
16             $self->get_params( $atts, qw( x:s y:s dx:U dy:U transform:s ) );
17 24         88 my $style = $self->style;
18 24         97 $_ = 0+$self->u($_) for $style->{'font-size'};
19 24         42 my $text = "";
20              
21 24         54 my $color = $style->{fill};
22 24 100 66     140 $color = $style->{color} if $color && $color eq "currentColor";
23 24   100     96 my $anchor = $style->{'text-anchor'} || "left";
24 24         79 $self->set_graphics;
25              
26             $self->_dbg( $self->name, " ",
27             defined($atts->{x}) ? ( " x=$x" ) : (),
28             defined($atts->{y}) ? ( " y=$y" ) : (),
29             defined($atts->{dx}) ? ( " dx=$dx" ) : (),
30             defined($atts->{dy}) ? ( " dy=$dy" ) : (),
31             defined($style->{"text-anchor"})
32             ? ( " anchor=\"$anchor\"" ) : (),
33 24 50       72 defined($style->{"transform"}) #???
    50          
    100          
    100          
    100          
    50          
34             ? ( " transform=\"$tf\"" ) : (),
35             );
36              
37             # We assume that if there is an x/y list, there is one single text
38             # argument.
39              
40 24         113 my @c = $self->get_children;
41              
42 24 50       74 if ( $x =~ /,/ ) {
43 0 0 0     0 if ( @c > 1 || ref($c[0]) ne "SVGPDF::TextElement" ) {
44 0         0 die("text: Cannot combine coordinate list with multiple elements\n");
45             }
46 0         0 $x = [ $self->getargs($x) ];
47 0         0 $y = [ $self->getargs($y) ];
48 0         0 $text = [ split( //, $c[0]->content ) ];
49 0 0 0     0 die( "\"", $self->get_cdata, "\" ", 0+@$x, " ", 0+@$y, " ", 0+@$text )
50             unless @$x == @$y && @$y == @$text;
51             }
52             else {
53 24   50     103 $x = [ $self->u($x||0) ];
54 24   50     89 $y = [ $self->u($y||0) ];
55             }
56              
57 24         76 $self->_dbg( "+ xo save" );
58 24         143 $xo->save;
59 24         1242 my $ix = $x->[0];
60 24         44 my $iy = $y->[0];
61 24         44 my ( $ex, $ey );
62              
63 24         33 my $scalex = 1;
64 24         37 my $scaley = 1;
65 24 50       60 if ( $tf ) {
66 0 0       0 ( $dx, $dy ) = $self->getargs($1)
67             if $tf =~ /translate\((.*?)\)/;
68 0 0       0 ( $scalex, $scaley ) = $self->getargs($1)
69             if $tf =~ /scale\((.*?)\)/;
70 0   0     0 $scaley ||= $scalex;
71 0         0 $self->_dbg("TF: $dx, $dy, $scalex, $scaley")
72             }
73             # NOTE: rotate applies to the individual characters, not the text
74             # as a whole.
75              
76 24 50       59 if ( @$x > 1 ) {
77 0         0 for ( @$x ) {
78 0 0       0 if ( $tf ) {
79 0         0 $self->_dbg( "X %.2f = %.2f + %.2f",
80             $dx + $_, $dx, $_ );
81 0         0 $self->_dbg( "Y %.2f = - %.2f - %.2f",
82             $dy + $y->[0], $dy, $y->[0] );
83             }
84 0         0 my $x = $dx + $_;
85 0         0 my $y = $dy + shift(@$y);
86 0 0 0     0 $self->_dbg( "txt* translate( %.2f, %.2f )%s %x",
87             $x, $y,
88             ( $scalex != 1 || $scaley != -1 )
89             ? sprintf(" scale( %.1f, %.1f )", $scalex, -$scaley ) : "",
90             ord($text->[0]));
91             # $xo-> translate( $x, $y );
92 0         0 $xo->save;
93 0 0 0     0 $xo->transform( translate => [ $x, $y ],
94             ($scalex != 1 || $scaley != -1 )
95             ? ( scale => [ $scalex, -$scaley ] ) : (),
96             );
97 0         0 my %o = ();
98 0 0       0 $o{align} = $anchor eq "end"
    0          
99             ? "right"
100             : $anchor eq "middle" ? "center" : "left";
101 0         0 $xo->textstart;
102 0         0 $self->set_font( $xo, $style );
103 0         0 $xo->text( shift(@$text), %o );
104 0         0 $xo->textend;
105 0         0 $xo->restore;
106             }
107             }
108             else {
109 24         46 $_ = $x->[0];
110 24 50       79 if ( $tf ) {
111 0         0 $self->_dbg( "X %.2f = %.2f + %.2f",
112             $dx + $_, $dx, $_ );
113 0         0 $self->_dbg( "Y %.2f = - %.2f - %.2f",
114             - $dy - $y->[0], $dy, $y->[0] );
115             }
116 24         74 my $x = $dx + $_;
117 24         58 my $y = $dy + shift(@$y);
118 24 50 33     373 $self->_dbg( "txt translate( %.2f, %.2f )%s",
119             $x, $y,
120             ($scalex != 1 || $scaley != -1 )
121             ? sprintf(" scale( %.2f %.2f )", $scalex, -$scaley ) : "" );
122 24         97 my %o = ();
123 24 100       111 $o{align} = $anchor eq "end"
    50          
124             ? "right"
125             : $anchor eq "middle" ? "center" : "left";
126 24         84 my $tc = $self->root->tc;
127 24         51 my $fc = $self->root->fc;
128 24         59 for my $c ( @c ) {
129 32 100       118 if ( ref($c) eq 'SVGPDF::TextElement' ) {
    50          
130 28         83 $self->_dbg( "+ xo save" );
131 28         187 $xo->save;
132 28 50 33     1604 $xo->transform( translate => [ $x, $y ],
133             ($scalex != 1 || $scaley != -1 )
134             ? ( scale => [ $scalex, -$scaley ] ) : ()
135             );
136 28         20775 $scalex = $scaley = 1; # no more scaling.
137              
138 28         160 $xo->textstart;
139 28 50       2345 if ( $tc ) {
140 0         0 $x += $tc->( $self, xo => $xo, pdf => $self->root->pdf,
141             style => $style, text => $c->content, %o );
142             }
143             else {
144 28         145 $self->set_font( $xo, $style );
145 28         125 $x += $xo->text( $c->content, %o );
146             }
147 28         12756 $xo->textend;
148 28 50       1252 if ( $style->{'outline-style'} ) {
149             # BEEP BEEP TRICKERY.
150 0         0 my $fn = $xo->{" font"};
151 0         0 my $sz = $xo->{" fontsize"};
152 0   0     0 $xo->line_width( $self->u($style->{'outline-width'} || 1 ));
153 0   0     0 $xo->stroke_color( $style->{'outline-color'} || 'black' );
154 0   0     0 my $d = $self->u($style->{'outline-offset'}) || 1;
155 0         0 $xo->rectangle( -$d,
156             -$d+$sz*$fn->descender/1000,
157             $x-$ix+2*$d,
158             2*$d+$sz*$fn->ascender/1000 );
159 0         0 $xo->stroke;
160             }
161 28         152 $self->_dbg( "- xo restore" );
162 28         145 $xo->restore;
163 28         1332 $ex = $x; $ey = $y;
  28         120  
164             }
165             elsif ( ref($c) eq 'SVGPDF::Tspan' ) {
166 4         18 $self->_dbg( "+ xo save" );
167 4         32 $xo->save;
168 4 50       254 if ( defined($c->atts->{x}) ) {
169 0         0 $x = 0;
170             }
171 4 50       13 if ( defined($c->atts->{'y'}) ) {
172 0         0 $y = 0;
173             }
174 4 50 33     49 $xo->transform( translate => [ $x, $y ],
175             ( $scalex != 1 || $scaley != -1 )
176             ? ( scale => [ $scalex, -$scaley ] ) : (),
177             );
178 4         3515 $scalex = $scaley = 1; # no more scaling.
179 4         21 my ( $x0, $y0 ) = $c->process();
180 4         12 $x += $x0; $y += $y0;
  4         9  
181 4         46 $self->_dbg("tspan moved to $x, $y");
182 4         26 $self->_dbg( "- xo restore" );
183 4         24 $xo->restore;
184 4         226 $ex = $x; $ey = $y;
  4         13  
185             }
186             else {
187 0         0 $self->nfi( $c->name . " in text" );
188             }
189             }
190             }
191              
192 24         78 $self->_dbg( "- xo restore" );
193 24         94 $xo->restore;
194 24         1080 $self->css_pop;
195             }
196              
197             1;