File Coverage

lib/ChordPro/lib/SVGPDF/Text.pm
Criterion Covered Total %
statement 11 121 9.0
branch 0 66 0.0
condition 0 39 0.0
subroutine 4 5 80.0
pod 0 1 0.0
total 15 232 6.4


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