| 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; |