File Coverage

lib/ChordPro/Output/PDF/Song.pm
Criterion Covered Total %
statement 587 1481 39.6
branch 203 846 24.0
condition 64 468 13.6
subroutine 37 60 61.6
pod 0 28 0.0
total 891 2883 30.9


line stmt bran cond sub pod time code
1             #! perl
2              
3 10     10   150 use v5.26;
  10         41  
4              
5             package main;
6              
7 10     10   60 use utf8;
  10         20  
  10         87  
8             our $config;
9             our $options;
10              
11             package ChordPro::Output::PDF::Song;
12              
13 10     10   855 use Storable qw(dclone);
  10         20  
  10         664  
14 10     10   59 use Ref::Util qw(is_hashref is_arrayref is_coderef);
  10         19  
  10         594  
15 10     10   56 use Carp;
  10         72  
  10         597  
16 10     10   55 use feature 'state';
  10         41  
  10         1432  
17 10     10   67 use ChordPro::Output::Common qw( roman fmt_subst );
  10         21  
  10         557  
18 10     10   56 use feature 'signatures';
  10         337  
  10         525  
19 10     10   52 no warnings qw( experimental::signatures );
  10         36  
  10         592  
20              
21 10     10   59 use ChordPro::Files;
  10         18  
  10         1705  
22 10     10   72 use ChordPro::Paths;
  10         21  
  10         562  
23 10     10   81 use ChordPro::Utils;
  10         37  
  10         1671  
24              
25             #my $ps;
26              
27 10     10   6042 use Text::Layout;
  10         236721  
  10         5543  
28              
29             my $source; # song source
30             my $structured = 0; # structured data
31             my $suppress_empty_chordsline = 0; # suppress chords line when empty
32             my $suppress_empty_lyricsline = 0; # suppress lyrics line when blank
33             my $lyrics_only = 0; # suppress all chord lines
34             my $inlinechords = 0; # chords inline
35             my $inlineannots; # format for inline annots
36             my $chordsunder = 0; # chords under the lyrics
37             my $chordscol = 0; # chords in a separate column
38             my $chordscapo = 0; # capo in a separate column
39             my $propitems_re = propitems_re();
40              
41             # Page classes.
42             my @classes = qw( first title default filler );
43              
44             my $i_tag;
45             sub pr_label_maybe {
46 144     144 0 603 my ( $ps, $x, $y ) = @_;
47 144   50     816 my $tag = $i_tag // "";
48 144         373 $i_tag = undef;
49 144 50       608 prlabel( $ps, $tag, $x, $y ) if $tag ne "";
50             }
51              
52             my $assets;
53             sub assets {
54 0     0 0 0 my ( $id ) = @_;
55 0         0 $assets->{$id};
56             }
57             # Images that go on all pages.
58             my @allpages;
59              
60 10         608180 use constant SIZE_ITEMS => [ qw( chord text chorus tab grid diagram
61 10     10   131 toc title footer label ) ];
  10         41  
62              
63             sub generate_song {
64 40     40 0 154 my ( $s, $opts ) = @_;
65              
66             warn("Generate song \"", $s->{title}, "\", ",
67             "page ", $opts->{page_num}, " (", $opts->{page_idx}, ")\n")
68 40 50       301 if $config->{debug}->{pages} & 0x01;
69              
70 40         179 my $pr = $opts->{pr};
71 40         138 my $pagectrl = $opts->{pagectrl};
72 40 50       489 if ( $pr->{layout}->can("register_element") ) {
73             $pr->{layout}->register_element
74 40         1149 ( TextLayoutImageElement->new( pdf => $pr->{pdf} ), "img" );
75             $pr->{layout}->register_element
76 40         2348 ( TextLayoutSymbolElement->new( pdf => $pr->{pdf} ), "sym" );
77             }
78              
79 40 50       787 unless ( $s->{body} ) { # empty song, or embedded
80 0 0       0 return unless $s->{source}->{embedding};
81 0 0       0 return unless $s->{source}->{embedding} eq "pdf";
82 0         0 my $p = $pr->importfile($s->{source}->{file});
83 0         0 $s->{meta}->{pages} = $p->{pages};
84              
85             # Copy the title of the embedded document, provided there
86             # was no override.
87 0 0 0     0 if ( $s->{meta}->{title}->[0] eq $s->{source}->{file}
88             and $p->{Title} ) {
89 0         0 $s->{meta}->{title} = [ $s->{title} = $p->{Title} ];
90             }
91 0         0 return $s->{meta}->{pages};
92             }
93              
94 40   33     98970 local $config = dclone( $s->{config} // $config );
95 40         250 while ( my($k,$v) = each( %{$config->{markup}->{shortcodes}}) ) {
  40         404  
96 0 0       0 unless ( $pr->{layout}->can("register_shortcode") ) {
97 0         0 warn("Cannot register shortcodes, upgrade Text::Layout module\n");
98 0         0 last;
99             }
100 0         0 $pr->{layout}->register_shortcode( $k, $v );
101             }
102 40         167 $source = $s->{source};
103              
104 40         184 $suppress_empty_chordsline = $::config->{settings}->{'suppress-empty-chords'};
105 40         127 $suppress_empty_lyricsline = $::config->{settings}->{'suppress-empty-lyrics'};
106 40         135 $inlinechords = $::config->{settings}->{'inline-chords'};
107 40         150 $inlineannots = $::config->{settings}->{'inline-annotations'};
108 40         140 $chordsunder = $::config->{settings}->{'chords-under'};
109 40         407 my $ps = $::config->clone->{pdf};
110 40         7831 $ps->{pr} = $pr;
111 40         191 $pr->{ps} = $ps;
112 40         160 $ps->{_s} = $s;
113 40         719 $pr->{_df} = {};
114             # warn("X1: ", $ps->{fonts}->{$_}->{size}, "\n") for "text";
115 40         403 $pr->init_fonts();
116 40         192 my $fonts = $ps->{fonts};
117 40         154 $pr->{_df}->{$_} = { %{$fonts->{$_}} } for qw( text chorus chord grid toc tab );
  240         2001  
118             # warn("X2: ", $pr->{_df}->{$_}->{size}, "\n") for "text";
119              
120 40   50     403 $structured = ( $options->{'backend-option'}->{structure} // '' ) eq 'structured';
121 40 50       154 $s->structurize if $structured;
122 40         173 @allpages = ();
123              
124             # Diagrams drawer.
125 40         124 my $dd;
126             my $dctl;
127 40 50       315 if ( $::config->{instrument}->{type} eq "keyboard" ) {
128 0         0 require ChordPro::Output::PDF::KeyboardDiagram;
129 0         0 $dd = ChordPro::Output::PDF::KeyboardDiagram->new( ps => $ps, pr => $pr );
130 0         0 $dctl = $ps->{kbdiagrams};
131             }
132             else {
133 40         7166 require ChordPro::Output::PDF::StringDiagram;
134 40         961 $dd = ChordPro::Output::PDF::StringDiagram->new( ps => $ps, pr => $pr );
135 40         131 $dctl = $ps->{diagrams};
136             }
137             $dctl->{show} = $s->{settings}->{diagrampos}
138 40 50       261 if defined $s->{settings}->{diagrampos};
139 40         165 $ps->{dd} = $dd;
140 40         124 my $sb = $s->{body};
141              
142             # set_columns needs these, set provisional values.
143 40         227 $ps->{_leftmargin} = $ps->{marginleft};
144 40         176 $ps->{_rightmargin} = $ps->{marginright};
145             set_columns( $ps,
146 40   33     527 $s->{settings}->{columns} || $::config->{settings}->{columns} );
147              
148 40         177 $chordscol = $ps->{chordscolumn};
149 40         155 $lyrics_only = $::config->{settings}->{'lyrics-only'};
150 40         204 $chordscapo = $s->{meta}->{capo};
151              
152 40         100 my $fail;
153 40         128 for my $item ( @{ SIZE_ITEMS() } ) {
  40         169  
154 400         1774 for ( $options->{"$item-font"} ) {
155 400 50       922 next unless $_;
156 0         0 delete( $fonts->{$item}->{file} );
157 0         0 delete( $fonts->{$item}->{name} );
158 0         0 delete( $fonts->{$item}->{description} );
159 0 0       0 if ( m;/; ) {
    0          
160 0         0 $fonts->{$item}->{file} = $_;
161             }
162             elsif ( is_corefont($_) ) {
163 0         0 $fonts->{$item}->{name} = is_corefont($_);
164             }
165             else {
166 0         0 $fonts->{$item}->{description} = $_;
167             }
168 0 0       0 $pr->init_font($item) or $fail++;
169             }
170 400         1246 for ( $options->{"$item-size"} ) {
171 400 50       984 next unless $_;
172 0         0 $fonts->{$item}->{size} = $_;
173             }
174             }
175 40 50       156 die("Unhandled fonts detected -- aborted\n") if $fail;
176              
177 40 50       330 if ( $ps->{labels}->{comment} ) {
    50          
178 0         0 $ps->{_indent} = 0;
179             }
180             elsif ( $ps->{labels}->{width} eq "auto" ) {
181 40 50 33     220 if ( $s->{labels} && @{ $s->{labels} } ) {
  0         0  
182 0         0 my $longest = 0;
183 0   0     0 my $ftext = $fonts->{label} || $fonts->{text};
184 0         0 my $size = $ftext->{size};
185 0         0 my $w = $pr->strwidth(" ", $ftext, $size);
186 0         0 for ( @{ $s->{labels} } ) {
  0         0  
187             # Split on real newlines and \n.
188 0         0 for ( split( /\\n|\n/, $_ ) ) {
189 0         0 my $t = $pr->strwidth( $_, $ftext, $size ) + $w;
190 0 0       0 $longest = $t if $t > $longest;
191             }
192             }
193 0         0 $ps->{_indent} = $longest;
194             }
195             else {
196 40         150 $ps->{_indent} = 0;
197             }
198             }
199             else {
200 0         0 $ps->{_indent} = $ps->{labels}->{width};
201             }
202              
203             my $set_sizes = sub {
204 40     40   258 $ps->{lineheight} = $fonts->{text}->{size} - 1; # chordii
205 40         190 $ps->{chordheight} = $fonts->{chord}->{size};
206 40         421 };
207 40         183 $set_sizes->();
208 40         271 $ps->{'vertical-space'} = $options->{'vertical-space'};
209 40         122 for ( @{ SIZE_ITEMS() } ) {
  40         157  
210 400         1374 $fonts->{$_}->{_size} = $fonts->{$_}->{size};
211             }
212              
213 40         96 my $x;
214 40         209 my $y = $ps->{papersize}->[1] - $ps->{margintop};
215              
216 40   33     404 my $st = $s->{settings}->{titles} || $::config->{settings}->{titles};
217 40 50 33     389 if ( defined($st)
218             && ! $ps->{'titles-directive-ignore'} ) {
219             my $swap = sub {
220 0     0   0 my ( $from, $to ) = @_;
221 0         0 for my $class ( @classes ) {
222 0         0 for ( qw( title subtitle footer ) ) {
223 0 0       0 next unless defined $ps->{formats}->{$class}->{$_};
224 0 0       0 unless ( is_arrayref($ps->{formats}->{$class}->{$_}) ) {
225 0         0 warn("Oops -- pdf.formats.$class.$_ is not an array\n");
226 0         0 next;
227             }
228 0 0       0 unless ( is_arrayref($ps->{formats}->{$class}->{$_}->[0]) ) {
229             $ps->{formats}->{$class}->{$_} =
230 0         0 [ $ps->{formats}->{$class}->{$_} ];
231             }
232 0         0 for my $l ( @{$ps->{formats}->{$class}->{$_}} ) {
  0         0  
233 0         0 ( $l->[$from], $l->[$to] ) =
234             ( $l->[$to], $l->[$from] );
235             }
236             }
237             }
238 40         346 };
239              
240 40 50       190 if ( $st eq "left" ) {
241 0         0 $swap->(0,1);
242             }
243 40 50       819 if ( $st eq "right" ) {
244 0         0 $swap->(2,1);
245             }
246             }
247              
248             my $do_size = sub {
249 0     0   0 my ( $tag, $value ) = @_;
250 0 0       0 if ( $value =~ /^(.+)\%$/ ) {
251             $fonts->{$tag}->{_size} //=
252 0   0     0 $::config->{pdf}->{fonts}->{$tag}->{size};
253             $fonts->{$tag}->{size} =
254 0         0 ( $1 / 100 ) * $fonts->{$tag}->{_size};
255             }
256             else {
257             $fonts->{$tag}->{size} =
258 0         0 $fonts->{$tag}->{_size} = $value;
259             }
260 0         0 $set_sizes->();
261 40         271 };
262              
263 40         141 my $col;
264             my $spreadimage;
265              
266             my $col_adjust = sub {
267 40 50   40   205 if ( $ps->{columns} <= 1 ) {
268             warn( "C=-",
269             pv( ", T=", $ps->{_top} ),
270             pv( ", L=", $ps->{__leftmargin} ),
271             pv( ", I=", $ps->{_indent} ),
272             pv( ", R=", $ps->{__rightmargin} ),
273             pv( ", S=?", $spreadimage ),
274 40 50       216 "\n") if $config->{debug}->{spacing};
275 40         97 return;
276             }
277 0         0 $x = $ps->{_leftmargin} + $ps->{columnoffsets}->[$col];
278 0         0 $ps->{__leftmargin} = $x;
279             $ps->{__rightmargin} =
280             $ps->{_leftmargin}
281 0         0 + $ps->{columnoffsets}->[$col+1];
282             $ps->{__rightmargin} -= $ps->{columnspace}
283 0 0       0 if $col < $ps->{columns}-1;
284 0         0 $y = $ps->{_top};
285             warn( pv( "C=", $col ),
286             pv( ", T=", $ps->{_top} ),
287             pv( ", L=", $ps->{__leftmargin} ),
288             pv( ", I=", $ps->{_indent} ),
289             pv( ", R=", $ps->{__rightmargin} ),
290             pv( ", S=?", $spreadimage ),
291 0 0       0 "\n") if $config->{debug}->{spacing};
292 0         0 $x += $ps->{_indent};
293 0 0 0     0 $y -= $spreadimage if defined($spreadimage) && !ref($spreadimage);
294 40         876 };
295              
296 40         106 my $vsp_ignorefirst;
297 40         143 my $startpage = $opts->{page_num};
298             # These are 1 smaller since they'll be incremented first.
299 40         107 my $page_num = $startpage - 1; # page number
300 40         140 my $page_idx = $opts->{page_idx}-1; # page # in PDF
301              
302             # Physical newpage handler.
303             my $newpage = sub {
304 40     40   94 $page_idx++;
305 40         124 $page_num++;
306             $s->{meta}->{page} =
307             [ $s->{page} = $opts->{roman}
308 40 100       464 ? roman($page_num) : $page_num ];
309              
310             # Add page to the PDF.
311 40 100       456 $pr->newpage( $opts->{prepend} ? $page_idx : () );
312             warn("page: $page_idx(",$s->{page},") added\n")
313 40 50       308 if $config->{debug}->{pages} & 0x01;
314              
315             # Put titles and footer.
316              
317             # If even/odd pages, leftpage signals whether the
318             # header/footer parts must be swapped.
319 40         123 my $rightpage = 1;
320 40 100       271 if ( $pagectrl->{dual_pages} ) {
321 30         189 $rightpage = is_odd($page_num);
322             }
323              
324             # margin* are offsets from the edges of the paper.
325             # _*margin are offsets taking even/odd pages into account.
326             # _margin* are physical coordinates, taking ...
327 40 100       1220 if ( $rightpage ) {
328 36         174 $ps->{_leftmargin} = $ps->{marginleft};
329 36         296 $ps->{_marginleft} = $ps->{marginleft};
330 36         117 $ps->{_rightmargin} = $ps->{marginright};
331 36         206 $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{marginright};
332             }
333             else {
334 4         22 $ps->{_leftmargin} = $ps->{marginright};
335 4         22 $ps->{_marginleft} = $ps->{marginright};
336 4         16 $ps->{_rightmargin} = $ps->{marginleft};
337 4         86 $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{marginleft};
338             }
339 40         217 $ps->{_marginbottom} = $ps->{marginbottom};
340 40         185 $ps->{_margintop} = $ps->{papersize}->[1] - $ps->{margintop};
341 40         153 $ps->{_bottommargin} = $ps->{marginbottom};
342              
343             # Physical coordinates; will be adjusted to columns if needed.
344 40         145 $ps->{__leftmargin} = $ps->{_marginleft};
345 40         156 $ps->{__rightmargin} = $ps->{_marginright};
346 40         149 $ps->{__topmargin} = $ps->{_margintop};
347 40         156 $ps->{__bottommargin} = $ps->{_marginbottom};
348              
349             # Determine page class and background.
350 40         95 my $class = 2; # default
351 40         203 my $bgpdf = $ps->{formats}->{default}->{background};
352 40 100       232 if ( $page_num == 1 ) {
    50          
353 15         41 $class = 0; # very first page
354             $bgpdf = $ps->{formats}->{first}->{background}
355             || $ps->{formats}->{title}->{background}
356 15   33     208 || $bgpdf;
357             }
358             elsif ( $page_num == $startpage ) {
359 25         86 $class = 1; # first of a song
360             $bgpdf = $ps->{formats}->{title}->{background}
361 25   33     240 || $bgpdf;
362             }
363 40 50       209 if ( $bgpdf ) {
364 0         0 my ( $fn, $pg ) = ( $bgpdf, 1 );
365 0 0       0 if ( $bgpdf =~ /^(.+):(\d+)$/ ) {
366 0         0 ( $bgpdf, $pg ) = ( $1, $2 );
367             }
368 0         0 $fn = CP->findres($bgpdf);
369 0 0 0     0 if ( $fn && fs_test( rs => $fn ) ) {
370 0 0 0     0 $pg++ if $pagectrl->{dual_pages} && !$rightpage;
371 0         0 $pr->importpage( $fn, $pg );
372             }
373             else {
374 0         0 warn( "PDF: Missing or empty background document: ",
375             $bgpdf, "\n" );
376             }
377             }
378              
379 40         128 $x = $ps->{__leftmargin};
380 40         100 $y = $ps->{_margintop};
381 40 50 33     209 $y += $ps->{headspace} if $ps->{'head-first-only'} && $class == 2;
382 40         141 $x += $ps->{_indent};
383 40         152 $ps->{_top} = $y;
384 40         114 $col = 0;
385 40         89 $vsp_ignorefirst = 1;
386 40         170 $col_adjust->();
387              
388             # Render the 'allpages' images.
389 40         190 for ( @allpages ) {
390 0         0 my %imageinfo = %$_;
391 0         0 my $img = delete $imageinfo{img};
392 0         0 my $x = delete $imageinfo{x};
393 0         0 my $y = delete $imageinfo{y};
394 0         0 $pr->add_object( $img, $x, $y, %imageinfo );
395             }
396 40         460 };
397              
398             my $checkspace = sub {
399              
400             # Verify that the amount of space if still available.
401             # If not, perform a column break or page break.
402             # Use negative argument to force a break.
403             # Returns true if there was space.
404              
405 144     144   394 my $vsp = $_[0];
406 144 50 33     1304 return 1 if $vsp >= 0 && $y - $vsp >= $ps->{_bottommargin};
407              
408 0 0       0 if ( ++$col >= $ps->{columns}) {
409 0         0 $newpage->();
410 0         0 $vsp_ignorefirst = 0;
411             }
412 0         0 $col_adjust->();
413 0         0 return;
414 40         228 };
415              
416             my $chorddiagrams = sub {
417 40     40   126 my ( $chords, $show, $ldisp ) = @_;
418 40 50 33     172 return if $lyrics_only || !$dctl->{show};
419 40         107 my @chords;
420             $chords = $s->{chords}->{chords}
421 40 50 33     424 if !defined($chords) && $s->{chords};
422 40   33     340 $show //= $dctl->{show};
423 40 50       117 if ( $chords ) {
424 40         147 for ( @$chords ) {
425 48 50       239 if ( my $i = $s->{chordsinfo}->{$_} ) {
426 48 50       289 push( @chords, $i ) if $i->has_diagram;
427             }
428             else {
429 0         0 warn("PDF: Missing chord info for \"$_\"\n");
430             }
431             }
432             }
433 40 100       180 return unless @chords;
434              
435             # Determine page class.
436 24         62 my $class = 2; # default
437 24 100       117 if ( $page_num == 1 ) {
    50          
438 7         22 $class = 0; # very first page
439             }
440             elsif ( $page_num == $startpage ) {
441 17         48 $class = 1; # first of a song
442             }
443             warn( "page: ", $page_num, " ($startpage) cls=$class\n")
444 24 50       133 if $config->{debug}->{pages} & 0x01;
445              
446             # If chord diagrams are to be printed in the right column, put
447             # them on the first page.
448 24 50 33     965 if ( $show eq "right" && $class <= 1 ) {
    50 33        
    0 33        
      33        
449 0         0 my $vsp = $dd->vsp( undef, $ps );
450              
451 0         0 my $v = int( ( $ps->{_margintop} - $ps->{marginbottom} ) / $vsp );
452 0         0 my $c = int( ( @chords - 1) / $v ) + 1;
453             # warn("XXX ", scalar(@chords), ", $c colums of $v max\n");
454             my $column =
455             $ps->{_marginright} - $ps->{_marginleft}
456 0         0 - ($c-1) * $dd->hsp(undef,$ps)
457             - $dd->hsp0(undef,$ps);
458              
459 0         0 my $hsp = $dd->hsp(undef,$ps);
460 0         0 my $x = $x + $column - $ps->{_indent};
461 0         0 $ps->{_rightmargin} = $ps->{papersize}->[0] - $x + $ps->{columnspace};
462 0         0 $ps->{__rightmargin} = $x - $ps->{columnspace};
463             set_columns( $ps,
464 0   0     0 $s->{settings}->{columns} || $::config->{settings}->{columns} );
465 0         0 $col_adjust->();
466 0         0 my $y = $y;
467 0         0 while ( @chords ) {
468              
469 0         0 for ( 0..$c-1 ) {
470 0 0       0 last unless @chords;
471 0         0 $dd->draw( shift(@chords), $x + $_*$hsp, $y, $ps );
472             }
473              
474 0         0 $y -= $vsp;
475             }
476             }
477             elsif ( ( $show eq "top" || $show eq "bottom" )
478             && $class <= 1 && $col == 0) {
479              
480 24         115 my $ww = $ps->{_marginright} - $ps->{_marginleft};
481              
482 24         152 my $dwidth = $dd->hsp0(undef,$ps); # diag
483 24         121 my $dadv = $dd->hsp1(undef,$ps); # adv
484 24         82 my $hsp = $dwidth + $dadv; # diag + adv
485 24         143 my $vsp = $dd->vsp( undef, $ps );
486              
487             # Number of diagrams, based on minimal required interspace.
488             # Add one interspace (cuts off right)
489 24         126 my $h = int( ( $ww + $dadv ) / $hsp );
490 24 50       96 die("ASSERT: $h should be greater than 0") unless $h > 0;
491              
492             # Spread evenly over multiple lines.
493 24 50       109 if ( $dctl->{align} eq "center" ) {
494 0         0 my $lines = int((@chords-1)/$h) + 1;
495 0         0 $h = int((@chords-1)/$lines) + 1;
496             }
497              
498 24         76 my $y = $y;
499 24 50       111 if ( $show eq "bottom" ) {
500 24         167 $y = $ps->{marginbottom} + (int((@chords-1)/$h) + 1) * $vsp;
501 24         79 $ps->{_bottommargin} = $y;
502 24         118 $y -= $dd->vsp1( undef, $ps ); # advance height
503             }
504              
505 24         70 my $h0 = $h;
506 24         91 while ( @chords ) {
507 24         69 my $x = $x - $ps->{_indent};
508 24         114 $checkspace->($vsp);
509 24 50       113 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
510              
511 24 50 33     180 if ( $dctl->{align} eq 'spread' && @chords == $h0 ) {
    50          
512 0         0 my $delta = $ww + $dadv - min( $h0, 0+@chords ) * $hsp;
513 0         0 $dadv = $dd->hsp1(undef,$ps) + $delta / ($h0-1);
514             }
515             elsif ( $dctl->{align} =~ /center|right|spread/ ) {
516 0         0 my $delta = $ww + $dadv - min( $h0, 0+@chords ) * $hsp;
517 0 0       0 $delta /= 2 if $dctl->{align} ne 'right';
518 0         0 $x += $delta;
519             }
520              
521 24         89 for ( 1..$h ) {
522 72 100       340 last unless @chords;
523 48         366 $dd->draw( shift(@chords), $x, $y, $ps );
524 48         223 $x += $dwidth + $dadv;
525             }
526              
527 24         91 $y -= $vsp;
528 24 50       244 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
529             }
530 24 50       129 $ps->{_top} = $y if $show eq "top";
531             }
532             elsif ( $show eq "below" ) {
533             # Note that 'below' chords honour the label margin.
534 0         0 my $ww = $ps->{__rightmargin} - $ps->{__leftmargin} - $ps->{_indent};
535              
536 0         0 my $dwidth = $dd->hsp0(undef,$ps); # diag
537 0         0 my $dadv = $dd->hsp1(undef,$ps); # adv
538 0         0 my $hsp = $dwidth + $dadv; # diag + adv
539 0         0 my $vsp = $dd->vsp( undef, $ps );
540              
541 0         0 my $h = int( ( $ww + $dadv ) / $hsp );
542 0 0       0 die("ASSERT: $h should be greater than 0") unless $h > 0;
543              
544             # Spread evenly over multiple lines.
545 0 0       0 if ( $dctl->{align} eq "center" ) {
546 0         0 my $lines = int((@chords-1)/$h) + 1;
547 0         0 $h = int((@chords-1)/$lines) + 1;
548             }
549              
550 0         0 my $h0 = $h;
551 0         0 while ( @chords ) {
552 0         0 $checkspace->($vsp);
553 0         0 my $x = $x;
554 0 0       0 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
555              
556 0 0 0     0 if ( $dctl->{align} eq 'spread' && @chords == $h0 ) {
    0          
557 0         0 my $delta = $ww + $dadv - min( $h0, 0+@chords ) * $hsp;
558 0         0 $dadv = $dd->hsp1(undef,$ps) + $delta / ($h0-1);
559             }
560             elsif ( $dctl->{align} =~ /center|right|spread/ ) {
561 0         0 my $delta = $ww + $dadv - min( $h0, 0+@chords ) * $hsp;
562 0 0       0 $delta /= 2 if $dctl->{align} ne 'right';
563 0         0 $x += $delta;
564             }
565              
566 0         0 for ( 1..$h ) {
567 0 0       0 last unless @chords;
568 0         0 $dd->draw( shift(@chords), $x, $y, $ps );
569 0         0 $x += $hsp;
570             }
571              
572 0         0 $y -= $vsp;
573 0 0       0 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
574             }
575             }
576 24 50       132 $y = $ps->{_top} if $show eq "top";
577 40         628 };
578              
579 40         119 my @elts;
580             my $dbgop = sub {
581 0     0   0 my ( $elts, $pb ) = @_;
582 0   0     0 $elts //= $elts[-1];
583 0 0       0 $elts = [ $elts ] unless is_arrayref($elts);
584 0         0 for my $elt ( @$elts ) {
585             my $msg = sprintf("OP L:%2d %s (", $elt->{line},
586 0 0       0 $pb ? "pushback($elt->{type})" : $elt->{type} );
587 0 0       0 $msg .= " " . $elt->{subtype} if $elt->{subtype};
588 0 0       0 $msg .= " U:" . $elt->{uri} if $elt->{uri};
589 0 0       0 $msg .= " O:" . $elt->{orig} if $elt->{orig};
590 0 0       0 $msg .= " D:" . $elt->{delegate} if $elt->{delegate};
591 0 0       0 $msg .= " H:" . $elt->{handler} if $elt->{handler};
592 0         0 $msg .= " )";
593 0         0 $msg =~ s/\s+\(\s+\)//;
594 0 0       0 if ( $config->{debug}->{ops} > 1 ) {
595 0         0 require ChordPro::Dumper;
596             local *ChordPro::Chords::Appearance::_data_printer = sub {
597 0         0 my ( $self, $ddp ) = @_;
598 0 0       0 "ChordPro::Chords::Appearance('" . $self->key . "'" .
599             ($self->format ? (", '" . $self->format . "'") : "") .
600             ")";
601 0         0 };
602              
603 0         0 ChordPro::Dumper::ddp( $elt, as => $msg );
604             }
605             else {
606 0         0 warn( $msg, "\n" );
607             }
608             }
609 40         264 };
610              
611             #### CODE STARTS HERE ####
612              
613             # prepare_assets( $s, $pr );
614              
615 40         159 $spreadimage = $s->{spreadimage};
616              
617             # Get going.
618 40         159 $newpage->();
619              
620             # Embed source and config for debugging;
621             $pr->embed($source->{file})
622             if $source->{file}
623             && ( $options->{debug}
624             ||
625             $config->{debug}->{runtimeinfo}
626 40 50 33     737 && $ChordPro::VERSION =~ /_/ );
      33        
627              
628 40         154 my $prev; # previous element
629              
630             my $grid_cellwidth;
631 40         191 my $grid_barwidth = 0.5 * $fonts->{chord}->{size};
632 40         89 my $grid_margin;
633 40         86 my $did = 0;
634 40         136 my $curctx = "";
635              
636 40         106 my $elt; # current element
637 40         204 @elts = @$sb; # song elements
638 40         177 while ( @elts ) {
639 160         471 $elt = shift(@elts);
640              
641 160 50       897 if ( $config->{debug}->{ops} ) {
642 0         0 $dbgop->($elt);
643             }
644              
645 160 50       843 if ( $elt->{type} eq "newpage" ) {
646 0         0 $newpage->();
647 0 0 0     0 showlayout($ps) if $ps->{showlayout} || $config->{debug}->{spacing};
648 0         0 next;
649             }
650              
651 160 50       644 if ( $elt->{type} eq "colb" ) {
652 0         0 $checkspace->(-1);
653 0         0 next;
654             }
655              
656 160 100 66     1222 if ( $elt->{type} ne "set" && !$did++ ) {
657             # Insert top/left/right/bottom chord diagrams.
658 40 50       260 $chorddiagrams->() unless $dctl->{show} eq "below";
659              
660             # Prepare the assets now we know the page width.
661 40         283 prepare_assets( $s, $pr );
662              
663             # Spread image.
664 40 50       148 if ( $spreadimage ) {
665 0 0       0 if (ref($spreadimage) eq 'HASH' ) {
666             # Spread image doesn't indent.
667 0         0 $spreadimage = imagespread( $spreadimage, $x-$ps->{_indent}, $y, $ps );
668             }
669 0         0 $y -= $spreadimage;
670             }
671              
672 40 50 33     304 showlayout($ps) if $ps->{showlayout} || $config->{debug}->{spacing};
673             }
674              
675 160 100       718 if ( $elt->{type} eq "empty" ) {
676 40         116 my $y0 = $y;
677             warn("***SHOULD NOT HAPPEN1***")
678 40 50       285 if $s->{structure} eq "structured";
679 40 100       171 if ( $vsp_ignorefirst ) {
680 24 50 33     327 if ( @elts && $elts[0]->{type} !~ /empty|ignore/ ) {
681 24         60 $vsp_ignorefirst = 0;
682             }
683 24         88 next;
684             }
685 16 50       94 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
686 16         95 my $vsp = empty_vsp( $elt, $ps );
687 16         57 $y -= $vsp;
688 16 50       80 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
689 16         46 next;
690             }
691              
692 120 50       866 unless ( $elt->{type} =~ /^(?:control|set|ignore)$/ ) {
693 120         353 $vsp_ignorefirst = 0;
694             }
695              
696 120 50 66     931 if ( $elt->{type} eq "songline"
      66        
697             or $elt->{type} eq "tabline"
698             or $elt->{type} =~ /^comment(?:_box|_italic)?$/ ) {
699              
700 72 50       321 if ( $elt->{context} ne $curctx ) {
701 0         0 $curctx = $elt->{context};
702             }
703              
704 72         225 my $fonts = $ps->{fonts};
705 72         168 my $type = $elt->{type};
706              
707 72         149 my $ftext;
708 72 50       306 if ( $type eq "songline" ) {
    0          
    0          
709 72 50       361 $ftext = $curctx eq "chorus" ? $fonts->{chorus} : $fonts->{text};
710             }
711             elsif ( $type =~ /^comment/ ) {
712 0   0     0 $ftext = $fonts->{$type} || $fonts->{comment};
713             }
714             elsif ( $type eq "tabline" ) {
715 0         0 $ftext = $fonts->{tab};
716             }
717              
718             # Get vertical space the songline will occupy.
719 72         351 my $vsp = songline_vsp( $elt, $ps );
720 72 50 33     580 if ( $elt->{type} eq "songline" && !$elt->{indent} ) {
721 72         454 my $e = wrap( $pr, $elt, $x );
722 72 50       478 if ( @$e > 1 ) {
723 0         0 $checkspace->($vsp * scalar( @$e ));
724 0         0 $elt = shift( @$e );
725 0         0 unshift( @elts, @$e );
726             }
727             }
728              
729             # Add prespace if fit. Otherwise newpage.
730 72         438 $checkspace->($vsp);
731              
732 72 50       459 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
733              
734 72         205 my $indent = 0;
735              
736             # Handle decorations.
737              
738 72 50       407 if ( $elt->{context} eq "chorus" ) {
739 0         0 my $style = $ps->{chorus};
740 0         0 $indent = $style->{indent};
741 0 0 0     0 if ( $style->{bar}->{offset} && $style->{bar}->{width} ) {
742             my $cx = $ps->{__leftmargin} + $ps->{_indent}
743             - $style->{bar}->{offset}
744 0         0 + $indent;
745             $pr->vline( $cx, $y, $vsp,
746             $style->{bar}->{width},
747 0         0 $style->{bar}->{color} );
748             }
749 0         0 $curctx = "chorus";
750 0 0       0 $i_tag = "" unless $config->{settings}->{choruslabels};
751             }
752              
753             # Substitute metadata in comments.
754 72 50 33     422 if ( $elt->{type} =~ /^comment/ && !$elt->{indent} ) {
755 0         0 $elt = { %$elt };
756             # Flatten chords/phrases.
757 0 0       0 if ( $elt->{chords} ) {
758 0         0 $elt->{text} = "";
759 0         0 for ( 0..$#{ $elt->{chords} } ) {
  0         0  
760 0         0 $elt->{text} .= $elt->{chords}->[$_] . $elt->{phrases}->[$_];
761             }
762             }
763 0         0 $elt->{text} = fmt_subst( $s, $elt->{text} );
764             }
765              
766             # Comment decorations.
767              
768 72         488 $pr->setfont( $ftext );
769              
770             =begin xxx
771              
772             my $text = $elt->{text};
773             my $w = $pr->strwidth( $text );
774              
775             # Draw background.
776             my $bgcol = $ftext->{background};
777             if ( $elt->{type} eq "comment" ) {
778             # Default to grey.
779             $bgcol ||= "#E5E5E5";
780             # Since we default to grey, we need a way to cancel it.
781             undef $bgcol if $bgcol eq "none";
782             }
783             if ( $bgcol ) {
784             $pr->rectxy( $x + $indent - 2, $y + 2,
785             $x + $indent + $w + 2, $y - $vsp, 3, $bgcol );
786             }
787              
788             # Draw box.
789             my $x0 = $x;
790             if ( $elt->{type} eq "comment_box" ) {
791             $x0 += 0.25; # add some offset for the box
792             $pr->rectxy( $x0 + $indent, $y + 1,
793             $x0 + $indent + $w + 1, $y - $vsp + 1,
794             0.5, undef,
795             $ftext->{color} || $ps->{theme}->{foreground} );
796             }
797              
798             =cut
799              
800 72         17903 my $r = songline( $elt, $x, $y, $ps, song => $s, indent => $indent );
801              
802 72         239 $y -= $vsp;
803 72 50       573 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
804              
805 72 50       293 unshift( @elts, $r ) if $r;
806 72         289 next;
807             }
808              
809 48 50       199 if ( $elt->{type} eq "chorus" ) {
810 0         0 warn("NYI: type => chorus\n");
811 0         0 my $cy = $y + vsp($ps,-2); # ####TODO????
812 0         0 foreach my $e ( @{$elt->{body}} ) {
  0         0  
813 0 0       0 if ( $e->{type} eq "songline" ) {
    0          
814 0         0 $y = songline( $e, $x, $y, $ps );
815 0         0 next;
816             }
817             elsif ( $e->{type} eq "empty" ) {
818 0         0 warn("***SHOULD NOT HAPPEN2***");
819 0         0 $y -= vsp($ps);
820 0         0 next;
821             }
822             }
823 0         0 my $style = $ps->{chorus};
824 0         0 my $cx = $ps->{__leftmargin} - $style->{bar}->{offset};
825 0         0 $pr->vline( $cx, $cy, vsp($ps), 1, $style->{bar}->{color} );
826 0         0 $y -= vsp($ps,4); # chordii
827 0         0 next;
828             }
829              
830 48 50       207 if ( $elt->{type} eq "verse" ) {
831 0         0 warn("NYI: type => verse\n");
832 0         0 foreach my $e ( @{$elt->{body}} ) {
  0         0  
833 0 0       0 if ( $e->{type} eq "songline" ) {
    0          
834 0         0 my $h = songline_vsp( $e, $ps );
835 0         0 $checkspace->($h);
836 0         0 songline( $e, $x, $y, $ps );
837 0         0 $y -= $h;
838 0         0 next;
839             }
840             elsif ( $e->{type} eq "empty" ) {
841 0         0 warn("***SHOULD NOT HAPPEN2***");
842 0         0 $y -= vsp($ps);
843 0         0 next;
844             }
845             }
846 0         0 $y -= vsp($ps,4); # chordii
847 0         0 next;
848             }
849              
850 48 50 33     366 if ( $elt->{type} eq "gridline" || $elt->{type} eq "strumline" ) {
851              
852 0 0 0     0 $vsp_ignorefirst = 1, next if $lyrics_only || !$ps->{grids}->{show};
853              
854 0         0 my $vsp = grid_vsp( $elt, $ps );
855 0         0 $checkspace->($vsp);
856 0 0       0 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
857              
858 0         0 my $cells = $grid_margin->[2];
859             $grid_cellwidth = ( $ps->{__rightmargin}
860             - $ps->{_indent}
861             - $ps->{__leftmargin}
862 0         0 - ($cells)*$grid_barwidth
863             ) / $cells;
864             warn("L=", $ps->{__leftmargin},
865             ", I=", $ps->{_indent},
866             ", R=", $ps->{__rightmargin},
867             ", C=$cells, GBW=$grid_barwidth, W=", $grid_cellwidth,
868 0 0       0 "\n") if $config->{debug}->{spacing};
869              
870 0         0 require ChordPro::Output::PDF::Grid;
871             ChordPro::Output::PDF::Grid::gridline
872             ( $elt, $x, $y,
873             $grid_cellwidth,
874             $grid_barwidth,
875             $grid_margin,
876             $ps, song => $s, type => $elt->{type},
877             maybe subtype => $elt->{subtype},
878 0         0 );
879              
880 0         0 $y -= $vsp;
881 0 0       0 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
882              
883 0         0 next;
884             }
885              
886 48 50       196 if ( $elt->{type} eq "tab" ) {
887 0         0 warn("NYI? tab\n");
888 0         0 $pr->setfont( $fonts->{tab} );
889 0         0 my $dy = $fonts->{tab}->{size};
890 0         0 foreach my $e ( @{$elt->{body}} ) {
  0         0  
891 0 0       0 next unless $e->{type} eq "tabline";
892 0         0 $pr->text( $e->{text}, $x, $y );
893 0         0 $y -= $dy;
894             }
895 0         0 next;
896             }
897              
898 48 50       257 if ( $elt->{type} eq "tabline" ) {
899              
900 0         0 my $vsp = tab_vsp( $elt, $ps );
901 0         0 $checkspace->($vsp);
902 0 0       0 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
903              
904 0         0 songline( $elt, $x, $y, $ps );
905              
906 0         0 $y -= $vsp;
907 0 0       0 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
908              
909 0         0 next;
910             }
911              
912 48 50       224 if ( $elt->{type} eq "image" ) {
913 0 0       0 next if defined $elt->{opts}->{spread};
914 0 0       0 next if $elt->{opts}->{omit};
915              
916             # Images are slightly more complex.
917             # Only after establishing the desired height we can issue
918             # the checkspace call, and we must get $y after that.
919              
920             my $gety = sub {
921 0     0   0 my $h = shift;
922 0         0 my $have = $checkspace->($h);
923 0 0       0 $ps->{pr}->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
924 0 0       0 return wantarray ? ($y,$have) : $y;
925 0         0 };
926              
927 0         0 my $vsp = imageline( $elt, $x, $ps, $gety );
928              
929             # Turn error into comment.
930 0 0       0 unless ( $vsp =~ /^\d/ ) {
931 0         0 unshift( @elts, { %$elt,
932             type => "comment_box",
933             text => $vsp,
934             } );
935 0         0 redo;
936             }
937              
938 0         0 $y -= $vsp;
939 0 0       0 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
940              
941 0 0 0     0 if ( $elt->{multi} && !$elt->{msel} ) {
942 0         0 my $i = @{ $elt->{multi} } - 1;
  0         0  
943 0         0 while ( $i > 0 ) {
944 0         0 unshift( @elts, { %$elt, msel => $i } );
945 0         0 $i--;
946             }
947             }
948 0         0 next;
949             }
950              
951 48 50       226 if ( $elt->{type} eq "rechorus" ) {
952 0         0 my $t = $ps->{chorus}->{recall};
953 0 0       0 if ( $t->{type} !~ /^comment(?:_italic|_box)?$/ ) {
954 0         0 die("Config error: Invalid value for pdf.chorus.recall.type\n");
955             }
956              
957 0 0 0     0 if ( $t->{quote} && $elt->{chorus} ) {
    0 0        
    0 0        
      0        
958 0         0 unshift( @elts, @{ $elt->{chorus} } );
  0         0  
959             }
960              
961             elsif ( $elt->{chorus}
962             && $elt->{chorus}->[0]->{type} eq "set"
963             && $elt->{chorus}->[0]->{name} eq "label" ) {
964 0 0       0 if ( $config->{settings}->{choruslabels} ) {
965             # Use as margin label.
966             unshift( @elts, { %$elt,
967             type => $t->{type} // "comment",
968             font => $ps->{fonts}->{$t->{type} // "label"},
969             text => $ps->{chorus}->{recall}->{tag},
970             } )
971 0 0 0     0 if $ps->{chorus}->{recall}->{tag} ne "";
      0        
972             unshift( @elts, { %$elt,
973             type => "set",
974             name => "label",
975             value => $elt->{chorus}->[0]->{value},
976 0         0 } );
977             }
978             else {
979             # Use as tag.
980             unshift( @elts, { %$elt,
981             type => $t->{type} // "comment",
982             font => $ps->{fonts}->{$t->{type} // "label"},
983             text => $elt->{chorus}->[0]->{value},
984             } )
985 0   0     0 }
      0        
986 0 0       0 if ( $ps->{chorus}->{recall}->{choruslike} ) {
987 0         0 $elts[0]->{context} = $elts[1]->{context} = "chorus";
988             }
989             }
990             elsif ( $t->{tag} && $t->{type} =~ /^comment(?:_(?:box|italic))?/ ) {
991             unshift( @elts, { %$elt,
992             type => $t->{type},
993             text => $t->{tag},
994 0         0 } );
995 0 0       0 if ( $ps->{chorus}->{recall}->{choruslike} ) {
996 0         0 $elts[0]->{context} = "chorus";
997             }
998             }
999 0         0 redo;
1000             }
1001              
1002 48 50       200 if ( $elt->{type} eq "tocline" ) {
1003 48         274 my $vsp = toc_vsp( $elt, $ps );
1004 48         257 my $vsp0 = toc_vsp( { title => "" }, $ps );
1005 48         273 $checkspace->($vsp);
1006 48 50       224 $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing};
1007              
1008 48         241 $y -= $vsp0 * tocline( $elt, $x, $y, $ps );
1009 48 50       402 $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing};
1010 48         179 next;
1011             }
1012              
1013 0 0       0 if ( $elt->{type} eq "diagrams" ) {
1014 0         0 $chorddiagrams->( $elt->{chords}, "below", $elt->{line} );
1015 0         0 next;
1016             }
1017              
1018 0 0       0 if ( $elt->{type} eq "control" ) {
1019 0 0       0 if ( $elt->{name} =~ /^($propitems_re)-size$/ ) {
    0          
    0          
1020 0 0       0 if ( defined $elt->{value} ) {
1021 0         0 $do_size->( $1, $elt->{value} );
1022             }
1023             else {
1024             # Restore default.
1025             $ps->{fonts}->{$1}->{size} =
1026 0         0 $pr->{_df}->{$1}->{size};
1027             warn("No size to restore for font $1\n")
1028 0 0       0 unless $ps->{fonts}->{$1}->{size};
1029             }
1030             }
1031             elsif ( $elt->{name} =~ /^($propitems_re)-font$/ ) {
1032 0         0 my $f = $1;
1033 0 0       0 if ( defined $elt->{value} ) {
1034 0         0 my ( $fn, $sz ) = $elt->{value} =~ /^(.*) (\d+(?:\.\d+)?)$/;
1035 0   0     0 $fn //= $elt->{value};
1036 0 0 0     0 if ( $fn =~ m;/;
    0          
1037             ||
1038             $fn =~ m;\.(ttf|otf)$;i ) {
1039 0         0 delete $ps->{fonts}->{$f}->{description};
1040 0         0 delete $ps->{fonts}->{$f}->{name};
1041 0         0 $ps->{fonts}->{$f}->{file} = $elt->{value};
1042             # Discard $sz. There will be an {xxxsize} following.
1043             }
1044             elsif ( is_corefont( $fn ) ) {
1045 0         0 delete $ps->{fonts}->{$f}->{description};
1046 0         0 delete $ps->{fonts}->{$f}->{file};
1047 0         0 $ps->{fonts}->{$f}->{name} = is_corefont($fn);
1048             # Discard $sz. There will be an {xxxsize} following.
1049             }
1050             else {
1051 0         0 delete $ps->{fonts}->{$f}->{file};
1052 0         0 delete $ps->{fonts}->{$f}->{name};
1053 0         0 $ps->{fonts}->{$f}->{description} = $elt->{value};
1054             }
1055             }
1056             else {
1057             # Restore default.
1058 0         0 my $sz = $ps->{fonts}->{$1}->{size};
1059             $ps->{fonts}->{$f} =
1060 0         0 { %{ $pr->{_df}->{$f} } };
  0         0  
1061             # $ps->{fonts}->{$1}->{size} = $sz;
1062             }
1063 0         0 $pr->init_font($f);
1064             }
1065             elsif ( $elt->{name} =~ /^($propitems_re)-color$/ ) {
1066 0 0       0 if ( defined $elt->{value} ) {
1067 0         0 $ps->{fonts}->{$1}->{color} = $elt->{value};
1068             }
1069             else {
1070             # Restore default.
1071             $ps->{fonts}->{$1}->{color} =
1072 0         0 $pr->{_df}->{$1}->{color};
1073             }
1074             }
1075 0         0 next;
1076             }
1077              
1078 0 0       0 if ( $elt->{type} eq "set" ) {
1079 0 0       0 if ( $elt->{name} eq "lyrics-only" ) {
    0          
    0          
    0          
    0          
1080             $lyrics_only = is_true($elt->{value})
1081 0 0       0 unless $lyrics_only > 1;
1082             }
1083             elsif ( $elt->{name} eq "gridparams" ) {
1084 0         0 my @v = @{ $elt->{value} };
  0         0  
1085 0         0 my $cells;
1086 0         0 my $bars = 8;
1087 0         0 $grid_margin = [ 0, 0 ];
1088 0 0       0 if ( $v[1] ) {
1089 0         0 $cells = $v[0] * $v[1];
1090 0         0 $bars = $v[0];
1091             }
1092             else {
1093 0         0 $cells = $v[0];
1094             }
1095 0 0       0 $cells += $grid_margin->[0] = $v[2] if $v[2];
1096 0 0       0 $cells += $grid_margin->[1] = $v[3] if $v[3];
1097 0         0 $grid_margin->[2] = $cells;
1098 0 0 0     0 if ( $ps->{labels}->{comment} && $v[4] ne "" ) {
1099             unshift( @elts, { %$elt,
1100             type => $ps->{labels}->{comment},
1101 0         0 text => $v[4],
1102             } );
1103 0         0 redo;
1104             }
1105 0 0       0 $i_tag = $v[4] unless $lyrics_only;
1106             }
1107             elsif ( $elt->{name} eq "label" ) {
1108 0 0 0     0 next if $elt->{context} eq "grid" && $lyrics_only;
1109 0 0 0     0 if ( $ps->{labels}->{comment} && $elt->{value} ne "" ) {
1110             unshift( @elts, { %$elt,
1111             type => $ps->{labels}->{comment},
1112             text => $elt->{value},
1113 0         0 } );
1114 0         0 redo;
1115             }
1116 0         0 $i_tag = $elt->{value};
1117             }
1118             elsif ( $elt->{name} eq "context" ) {
1119 0         0 $curctx = $elt->{value};
1120             }
1121             # Arbitrary config values.
1122             elsif ( $elt->{name} =~ /^pdf\.(.+)/ ) {
1123 0         0 prpadd2cfg( $ps, $1 => $elt->{value} );
1124             }
1125 0         0 next;
1126             }
1127 0 0       0 if ( $elt->{type} eq "ignore" ) {
1128 0         0 next;
1129             }
1130              
1131 0         0 warn("PDF: Unhandled operator: ", $elt->{type}, " (ignored)\n");
1132             }
1133             continue {
1134 160         893 $prev = $elt;
1135             }
1136              
1137 40 50       283 if ( $dctl->{show} eq "below" ) {
1138 0         0 $chorddiagrams->( undef, "below");
1139             }
1140              
1141 40         144 my $pages = $page_num - $startpage + 1;
1142             $newpage->(), $pages++,
1143             if ( $pagectrl->{align_songs_extend} && $pages % 2
1144             && ( $opts->{songindex} < $opts->{numsongs}
1145 40 0 33     331 || $opts->{forcealign} ) );
      0        
      33        
1146              
1147             # Now for the page headings and footers.
1148 40         155 $page_num = $opts->{page_num} - 1;
1149 40         124 $page_idx = $opts->{page_idx} - 1;
1150 40         295 $s->{meta}->{pages} = [ $pages ];
1151              
1152 40         170 for my $p ( 1 .. $pages ) {
1153 40         105 $page_num++;
1154 40         91 $page_idx++;
1155             warn( "page: $page_num($page_idx), ", $s->{meta}->{title}->[0],
1156             ", ", plural($pages," page"), "\n")
1157 40 50       233 if $config->{debug}->{pages} & 0x01;
1158 40         336 $pr->openpage($page_idx);
1159              
1160             # Put titles and footer.
1161              
1162             # If even/odd pages, leftpage signals whether the
1163             # header/footer parts must be swapped.
1164 40         15536 my $rightpage = 1;
1165 40 100       379 if ( $pagectrl->{dual_pages} ) {
1166 30         215 $rightpage = is_odd($page_num);
1167             }
1168 40 100       266 $s->{meta}->{'page.side'} = $rightpage ? "right" : "left";
1169              
1170             # margin* are offsets from the edges of the paper.
1171             # _*margin are offsets taking even/odd pages into account.
1172 40 100       164 if ( $rightpage ) {
1173 36         198 $ps->{_leftmargin} = $ps->{marginleft};
1174 36         171 $ps->{_rightmargin} = $ps->{marginright};
1175             }
1176             else {
1177 4         21 $ps->{_leftmargin} = $ps->{marginright};
1178 4         18 $ps->{_rightmargin} = $ps->{marginleft};
1179             }
1180              
1181             # _margin* are physical coordinates, taking even/odd pages into account.
1182 40         174 $ps->{_marginleft} = $ps->{_leftmargin};
1183 40         207 $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{_rightmargin};
1184 40         240 $ps->{_marginbottom} = $ps->{marginbottom};
1185 40         167 $ps->{_margintop} = $ps->{papersize}->[1] - $ps->{margintop};
1186              
1187             # Bottom margin, taking bottom chords into account.
1188 40         176 $ps->{_bottommargin} = $ps->{marginbottom};
1189              
1190             # Physical coordinates; will be adjusted to columns if needed.
1191 40         181 $ps->{__leftmargin} = $ps->{_marginleft};
1192 40         160 $ps->{__rightmargin} = $ps->{_marginright};
1193 40         142 $ps->{__topmargin} = $ps->{_margintop};
1194 40         180 $ps->{__bottommargin} = $ps->{_marginbottom};
1195              
1196             $s->{meta}->{page} = [ $s->{page} = $opts->{roman}
1197 40 100       383 ? roman($page_num) : $page_num ];
1198              
1199             # Determine page class.
1200 40         123 my $class = 2; # default
1201 40 100       265 if ( $page_num == 1 ) {
    50          
1202 15         40 $class = 0; # very first page
1203             }
1204             elsif ( $page_num == $startpage ) {
1205 25         68 $class = 1; # first of a song
1206             }
1207 40         214 $s->{meta}->{'page.class'} = $classes[$class];
1208             # Remember first page (see below).
1209 40   33     391 $s->{meta}->{'page.first.side'} //= $s->{meta}->{'page.side'};
1210             warn("page: $page_num($page_idx), side = ", $s->{meta}->{'page.side'},
1211             " class = ", $classes[$class], "\n")
1212 40 50       273 if $::config->{debug}->{pages} & 0x01;
1213              
1214             # Three-part title handlers.
1215 40     120   406 my $tpt = sub { tpt( $ps, $class, $_[0], $rightpage, $x, $y, $s ) };
  120         601  
1216              
1217 40         154 $x = $ps->{__leftmargin};
1218 40 50       190 if ( $ps->{headspace} ) {
1219             warn("Metadata for pageheading: ", ::dump($s->{meta}), "\n")
1220 40 50       186 if $config->{debug}->{meta};
1221 40         160 $y = $ps->{_margintop} + $ps->{headspace};
1222 40         327 $y -= $pr->font_bl($fonts->{title});
1223 40         596 $y = $tpt->("title");
1224 40         167 $y = $tpt->("subtitle");
1225             }
1226              
1227 40 50       208 if ( $ps->{footspace} ) {
1228 40         157 $y = $ps->{marginbottom} - $ps->{footspace};
1229 40         134 $tpt->("footer");
1230             }
1231              
1232             }
1233              
1234             # This is mainly for debugging/development.
1235 40         233 $s->{meta}->{'page.side'} = delete $s->{meta}->{'page.first.side'};
1236              
1237 40         6868 return $pages;
1238             }
1239              
1240             sub prlabel {
1241 0     0 0 0 my ( $ps, $label, $x, $y ) = @_;
1242 0 0 0     0 return if $label eq "" || $ps->{_indent} == 0;
1243 0         0 my $align = $ps->{labels}->{align};
1244 0   0     0 my $font= $ps->{fonts}->{label} || $ps->{fonts}->{text};
1245 0   0     0 $font->{size} ||= $font->{fd}->{size};
1246 0         0 $ps->{pr}->setfont($font); # for strwidth.
1247              
1248             # Now we have quoted strings we can have real newlines.
1249             # Split on real and unescaped (old style) newlines.
1250 0         0 for ( split( /\\n|\n/, $label ) ) {
1251 0         0 my $label = $_;
1252 0 0       0 if ( $align eq "right" ) {
    0          
1253 0         0 my $avg_space_width = $ps->{pr}->strwidth("m");
1254             $ps->{pr}->text( $label,
1255 0         0 $x - $avg_space_width - $ps->{pr}->strwidth($label),
1256             $y, $font );
1257             }
1258             elsif ( $align =~ /^cent(?:er|re)$/ ) {
1259             $ps->{pr}->text( $label,
1260 0         0 $x - $ps->{_indent} + $ps->{pr}->strwidth($label)/2,
1261             $y, $font );
1262             }
1263             else {
1264             $ps->{pr}->text( $label,
1265 0         0 $x - $ps->{_indent}, $y, $font );
1266             }
1267 0         0 $y -= $font->{size} * 1.2;
1268             }
1269             }
1270              
1271             # Propagate markup entries over the fragments so that each fragment
1272             # is properly terminated.
1273             sub defrag {
1274 194     194 0 270353 my ( $frag ) = @_;
1275 194         579 my @stack;
1276             my @res;
1277              
1278 194         660 foreach my $f ( @$frag ) {
1279 388         1418 my @a = split( /(<.*?>)/, $f );
1280 388 100       1093 if ( @stack ) {
1281 2         5 unshift( @a, @stack );
1282 2         3 @stack = ();
1283             }
1284 388         669 my @r;
1285 388         883 foreach my $a ( @a ) {
1286 353 100       1593 if ( $a =~ m;^<\s*/\s*(\w+)(.*)>$; ) {
    100          
1287 3         4 my $k = $1;
1288             #$a =~ s/\b //g;
1289             #$a =~ s/ \b//g;
1290 3 50       6 if ( @stack ) {
1291 3 50       109 if ( $stack[-1] =~ /^<\s*$k\b/ ) {
1292 3         6 pop(@stack);
1293             }
1294             else {
1295 0         0 warn("Markup error: \"@$frag\"\n",
1296             " Closing <$k> but $stack[-1] is open\n");
1297 0         0 next;
1298             }
1299             }
1300             else {
1301 0         0 warn("Markup error: \"@$frag\"\n",
1302             " Closing <$k> but no markup is open\n");
1303 0         0 next;
1304             }
1305             }
1306             elsif ( $a =~ m;^<\s*(\w+)(.*)>$; ) {
1307 6         11 my $k = $1;
1308 6         8 my $v = $2;
1309             # Do not push if self-closed.
1310 6 50       13 push( @stack, "<$k$v>" ) unless $v =~ m;/\s*$;;
1311             }
1312 353         984 push( @r, $a );
1313             }
1314 388 100       968 if ( @stack ) {
1315 2         5 push( @r, map { my $t = $_;
  3         5  
1316 3         15 $t =~ s;^<\s*(\w+).*;;;
1317 3         10 $t; } reverse @stack );
1318             }
1319 388         1463 push( @res, join("", @r ) );
1320             }
1321 194 50       629 if ( @stack ) {
1322 0         0 warn("Markup error: \"@$frag\"\n",
1323 0         0 " Unclosed markup: @{[ reverse @stack ]}\n" );
1324             }
1325             #warn("defrag: ", join('', @res), "\n");
1326 194         869 \@res;
1327             }
1328              
1329             sub songline {
1330 72     72 0 582 my ( $elt, $x, $ytop, $ps, %opts ) = @_;
1331              
1332             # songline draws text in boxes as follows:
1333             #
1334             # +------------------------------
1335             # | C F G
1336             # |
1337             # +------------------------------
1338             # | Lyrics text
1339             # +------------------------------
1340             #
1341             # Variants are:
1342             #
1343             # +------------------------------
1344             # | Lyrics text (lyrics-only, or single-space and no chords)
1345             # +------------------------------
1346             #
1347             # Likewise comments and tabs (which may have different fonts /
1348             # decorations).
1349             #
1350             # And:
1351             #
1352             # +-----------------------+-------
1353             # | Lyrics text | C F G
1354             # +-----------------------+-------
1355             #
1356             # Note that printing text involves baselines, and that chords
1357             # may have a different height than lyrics.
1358             #
1359             # To find the upper/lower extents, the ratio
1360             #
1361             # $font->ascender / $font->descender
1362             #
1363             # can be used. E.g., a font of size 16 with descender -250 and
1364             # ascender 750 must be drawn at 12 points under $ytop.
1365              
1366 72         341 my $pr = $ps->{pr};
1367 72         265 my $fonts = $ps->{fonts};
1368              
1369 72         249 my $type = $elt->{type};
1370              
1371 72         222 my $ftext;
1372             my $ytext;
1373 72         160 my @phrases = @{ defrag( $elt->{phrases} ) };
  72         423  
1374              
1375 72 50       352 if ( $type =~ /^comment/ ) {
1376 0   0     0 $ftext = $elt->{font} || $fonts->{$type} || $fonts->{comment};
1377 0         0 $ytext = $ytop - $pr->font_bl($ftext);
1378 0         0 my $song = $opts{song};
1379 0 0       0 $x += $opts{indent} if $opts{indent};
1380 0 0       0 $x += $elt->{indent} if $elt->{indent};
1381 0         0 pr_label_maybe( $ps, $x, $ytext );
1382 0         0 my $t = $elt->{text};
1383 0 0       0 if ( $elt->{chords} ) {
1384 0         0 $t = "";
1385 0         0 my @ph = @{ $elt->{phrases} };
  0         0  
1386 0         0 for ( @{ $elt->{chords} }) {
  0         0  
1387 0         0 my $chord = $_; # prevent chord clobber in 2pass mode
1388 0 0       0 if ( $chord eq '' ) {
1389             }
1390             else {
1391 0         0 $chord = $chord->chord_display;
1392             }
1393 0         0 $t .= $chord . shift(@ph);
1394             }
1395             }
1396 0         0 my ( $text, $ex ) = wrapsimple( $pr, $t, $x, $ftext );
1397 0         0 $pr->text( $text, $x, $ytext, $ftext );
1398 0   0     0 my $wi = $pr->strwidth( $config->{settings}->{wrapindent}//"x" );
1399 0 0       0 return $ex ne ""
1400             ? { %$elt,
1401             indent => $wi,
1402             text => $ex, chords => undef }
1403             : undef;
1404             }
1405 72 50       336 if ( $type eq "tabline" ) {
1406 0         0 $ftext = $fonts->{tab};
1407 0         0 $ytext = $ytop - $pr->font_bl($ftext);
1408 0 0       0 $x += $opts{indent} if $opts{indent};
1409 0         0 pr_label_maybe( $ps, $x, $ytext );
1410 0         0 $pr->text( $elt->{text}, $x, $ytext, $ftext, undef, "no markup" );
1411 0         0 return;
1412             }
1413              
1414             # assert $type eq "songline";
1415 72 50       377 $ftext = $fonts->{ $elt->{context} eq "chorus" ? "chorus" : "text" };
1416 72         620 $ytext = $ytop - $pr->font_bl($ftext); # unless lyrics AND chords
1417              
1418 72         869 my $fchord = $fonts->{chord};
1419 72         262 my $ychord = $ytop - $pr->font_bl($fchord);
1420              
1421             # Just print the lyrics if no chords.
1422 72 50 33     860 if ( $lyrics_only
      33        
1423             or
1424             $suppress_empty_chordsline && !has_visible_chords($elt)
1425             ) {
1426 0         0 my $x = $x;
1427 0 0       0 $x += $opts{indent} if $opts{indent};
1428 0 0       0 $x += $elt->{indent} if $elt->{indent};
1429 0         0 pr_label_maybe( $ps, $x, $ytext );
1430 0         0 my ( $text, $ex ) = wrapsimple( $pr, join( "", @phrases ),
1431             $x, $ftext );
1432 0         0 $pr->text( $text, $x, $ytext, $ftext );
1433 0   0     0 my $wi = $pr->strwidth( $config->{settings}->{wrapindent}//"x" );
1434 0 0       0 return $ex ne ""
1435             ? { %$elt,
1436             indent => $wi,
1437             phrases => [$ex] }
1438             : undef;
1439             }
1440              
1441 72 50 33     452 if ( $chordscol || $inlinechords ) {
    50          
1442 0 0       0 $ytext = $ychord if $ytext > $ychord;
1443 0         0 $ychord = $ytext;
1444             }
1445             elsif ( $chordsunder ) {
1446 0         0 ( $ytext, $ychord ) = ( $ychord, $ytext );
1447             # Adjust lyrics baseline for the chords.
1448             $ychord -= $ps->{fonts}->{text}->{size}
1449 0         0 * $ps->{spacing}->{lyrics};
1450             }
1451             else {
1452             # Adjust lyrics baseline for the chords.
1453             $ytext -= $ps->{fonts}->{chord}->{size}
1454 72         431 * $ps->{spacing}->{chords};
1455             }
1456              
1457 72   50     286 $elt->{chords} //= [ '' ];
1458 72 50       302 $x += $elt->{indent} if $elt->{indent};
1459              
1460 72         175 my $chordsx = $x;
1461 72 50       274 $chordsx += $ps->{chordscolumn} if $chordscol;
1462 72 50       265 if ( $chordsx < 0 ) { #### EXPERIMENTAL
1463 0         0 ($x, $chordsx) = (-$chordsx, $x);
1464             }
1465 72 50       319 $x += $opts{indent} if $opts{indent};
1466              
1467             # How to embed the chords.
1468 72 50       223 if ( $inlinechords ) {
1469 0 0       0 $inlinechords = '[%s]' unless $inlinechords =~ /%[cs]/;
1470 0         0 $ychord = $ytext;
1471             }
1472              
1473 72         164 my @chords;
1474 72         181 my $n = $#{$elt->{chords}};
  72         250  
1475 72         280 foreach my $i ( 0 .. $n ) {
1476              
1477 144         514 my $chord = $elt->{chords}->[$i];
1478 144         391 my $phrase = $phrases[$i];
1479              
1480 144 50 33     617 if ( $chordscol && $chord ne "" ) {
1481              
1482 0 0       0 if ( $chordscapo ) {
1483             $pr->text(fmt_subst( $opts{song}, $ps->{capoheading} ),
1484             $chordsx,
1485             $ytext + $ftext->{size} *
1486             $ps->{spacing}->{chords},
1487 0         0 $fonts->{chord} );
1488 0         0 undef $chordscapo;
1489             }
1490              
1491             # Underline the first word of the phrase, to indicate
1492             # the actual chord position. Skip leading non-letters.
1493 0 0       0 $phrase = " " if $phrase eq "";
1494              
1495             # This may screw up in some markup situations.
1496 0         0 my ( $pre, $word, $rest ) =
1497             $phrase =~ /^((?:\<[^>]*?\>|\W)+)?(\w+)(.+)?$/;
1498             # This should take case of most cases...
1499 0 0 0     0 unless ( $i == $n || defined($rest) && $rest !~ /^\
      0        
1500 0   0     0 $rest = chop($word) . ($rest//"");
1501             }
1502 0   0     0 $phrase = ($pre//"") . "" . $word . "" . ($rest//"");
      0        
1503              
1504             # Print the text.
1505 0         0 pr_label_maybe( $ps, $x, $ytext );
1506 0         0 $x = $pr->text( $phrase, $x, $ytext, $ftext );
1507              
1508             # Collect chords to be printed in the side column.
1509 0         0 $chord = $chord->chord_display;
1510 0         0 push( @chords, $chord );
1511             }
1512             else {
1513 144         315 my $xt0 = $x;
1514 144         312 my $font = $fchord;
1515 144 50       639 if ( $chord ne '' ) {
1516 144         1374 my $ch = $chord->chord_display;
1517 144         503 my $dp = $ch . " ";
1518 144 50       1020 if ( $chord->info->is_annotation ) {
    50          
1519 0         0 $font = $fonts->{annotation};
1520 0 0       0 ( $dp = $inlineannots ) =~ s/%[cs]/$ch/g
1521             if $inlinechords;
1522             }
1523             elsif ( $inlinechords ) {
1524 0         0 ( $dp = $inlinechords ) =~ s/%[cs]/$ch/g;
1525             }
1526 144         946 $xt0 = $pr->text( $dp, $x, $ychord, $font );
1527             }
1528              
1529             # Do not indent chorus labels (issue #81).
1530 144         1194 pr_label_maybe( $ps, $x-$opts{indent}, $ytext );
1531 144 50       888 if ( $inlinechords ) {
1532 0         0 $x = $pr->text( $phrase, $xt0, $ytext, $ftext );
1533             }
1534             else {
1535 144         310 my $xt1;
1536 144 50       965 if ( $phrase =~ /^\s+$/ ) {
1537 0         0 $xt1 = $xt0 + length($phrase) * $pr->strwidth(" ",$ftext);
1538             # $xt1 = $pr->text( "n" x length($phrase), $xt0, $ytext, $ftext );
1539             }
1540             else {
1541 144         766 $xt1 = $pr->text( $phrase, $x, $ytext, $ftext );
1542             }
1543 144 50       674 if ( $xt0 > $xt1 ) { # chord is wider
1544             # Do we need to insert a split marker?
1545 0 0 0     0 if ( $i < $n
      0        
      0        
1546             && demarkup($phrase) !~ /\s$/
1547             && demarkup($phrases[$i+1]) !~ /^\s/
1548             # And do we have one?
1549             && ( my $marker = $ps->{'split-marker'} ) ) {
1550              
1551             # Marker has 3 parts: start, repeat, and final.
1552             # final is always printed, last.
1553             # start is printed if there is enough room.
1554             # repeat is printed repeatedly to fill the rest.
1555 0 0       0 $marker = [ $marker, "", "" ]
1556             unless is_arrayref($marker);
1557              
1558             # Reserve space for final.
1559 0         0 my $w = 0;
1560 0         0 $pr->setfont($ftext);
1561 0 0       0 $w = $pr->strwidth($marker->[2]) if $marker->[2];
1562 0         0 $xt0 -= $w;
1563             # start or repeat (if no start).
1564 0   0     0 my $m = $marker->[0] || $marker->[1];
1565 0         0 $x = $xt1;
1566 0 0       0 $x = $xt0 unless $m;
1567 0         0 while ( $x < $xt0 ) {
1568 0         0 $x = $pr->text( $m, $x, $ytext, $ftext );
1569             # After the first, use repeat.
1570 0         0 $m = $marker->[1];
1571 0 0       0 $x = $xt0, last unless $m;
1572             }
1573             # Print final.
1574 0 0       0 if ( $w ) {
1575 0         0 $x = $pr->text( $marker->[2], $x, $ytext, $ftext );
1576             }
1577             }
1578             # Adjust the position for the chord and spit marker width.
1579 0 0       0 $x = $xt0 if $xt0 > $x;
1580             }
1581             else {
1582             # Use lyrics width.
1583 144         676 $x = $xt1;
1584             }
1585             }
1586             }
1587             }
1588              
1589             # Print side column with chords, if any.
1590 72 50       354 $pr->text( join(", ", @chords),
1591             $chordsx, $ychord, $fchord )
1592             if @chords;
1593              
1594 72         628 return;
1595             }
1596              
1597       0 0   sub imageline_vsp {
1598             }
1599              
1600             sub imageline {
1601 0     0 0 0 my ( $elt, $x, $ps, $gety ) = @_;
1602              
1603 0         0 my $x0 = $x;
1604 0         0 my $pr = $ps->{pr};
1605 0         0 my $id = $elt->{id};
1606 0         0 my $asset = $assets->{$id};
1607 0 0       0 unless ( $asset ) {
1608 0         0 warn("Line " . $elt->{line} . ", Undefined image id: \"$id\"\n");
1609             }
1610 0   0     0 my $opts = { %{$asset->{opts}//{}}, %{$elt->{opts}//{}} };
  0   0     0  
  0         0  
1611 0         0 my $img = $asset->{data};
1612 0         0 my $label = $opts->{label};
1613 0   0     0 my $anchor = $opts->{anchor} //= "float";
1614 0         0 my $allpages = 0;
1615 0 0       0 if ( $anchor eq "allpages" ) {
1616 0         0 $anchor = "page";
1617 0         0 $allpages = 1;
1618             }
1619 0         0 my $width = $opts->{width};
1620 0         0 my $height = $opts->{height};
1621 0         0 my $avwidth = $asset->{vwidth};
1622 0         0 my $avheight = $asset->{vheight};
1623 0   0     0 my $scalex = $asset->{opts}->{design_scale} || 1;
1624 0         0 my $scaley = $scalex;
1625              
1626 0 0       0 unless ( $img ) {
1627 0         0 return "Unhandled image type: asset=$id";
1628             }
1629 0 0       0 if ( $assets->{$id}->{multi} ) {
1630 0         0 $elt->{multi} = $assets->{$id}->{multi};
1631             }
1632 0 0       0 if ( $elt->{msel} ) {
1633 0         0 for ( $assets->{$id}->{multi}->[$elt->{msel}] ) {
1634 0         0 $img = $_->{xo};
1635             # Take vwidth/vheight from subimage.
1636 0         0 $avwidth = $_->{vwidth};
1637 0         0 $avheight = $_->{vheight};
1638             }
1639 0         0 $width = $height = 0;
1640 0         0 $label = "";
1641             }
1642              
1643             # Available width and height.
1644 0         0 my ( $pw, $ph );
1645 0 0       0 if ( $anchor eq "paper" ) {
1646 0         0 ( $pw, $ph ) = @{$ps->{papersize}};
  0         0  
1647             }
1648             else {
1649 0 0       0 if ( $ps->{columns} > 1 ) {
1650             $pw = $ps->{columnoffsets}->[1]
1651             - $ps->{columnoffsets}->[0]
1652 0         0 - $ps->{columnspace};
1653             }
1654             else {
1655             # $pw = $ps->{__rightmargin} - $ps->{_leftmargin};
1656             # See issue #428.
1657 0         0 $pw = $ps->{_marginright} - $ps->{_leftmargin};
1658             }
1659 0         0 $ph = $ps->{_margintop} - $ps->{_marginbottom};
1660 0 0       0 $pw -= $ps->{_indent} if $anchor eq "float";
1661             }
1662              
1663 0 0 0     0 if ( $width && $width =~ /^(\d+(?:\.\d+)?)\%$/ ) {
1664 0         0 $width = $1/100 * $pw;
1665             }
1666 0 0 0     0 if ( $height && $height =~ /^(\d+(?:\.\d+)?)\%$/ ) {
1667 0         0 $height = $1/100 * $ph;
1668             }
1669              
1670 0   0     0 my ( $w, $h ) = ( $width || $avwidth || $img->width,
      0        
1671             $height || $avheight || $img->height );
1672              
1673             # Scale proportionally if width xor height was explicitly requested.
1674 0 0 0     0 if ( $width && !$height ) {
    0 0        
1675 0   0     0 $h = $width / ($avwidth || $img->width) * ($avheight || $img->height);
      0        
1676             }
1677             elsif ( !$width && $height ) {
1678 0   0     0 $w = $height / ($avheight || $img->height) * ($avwidth || $img->width);
      0        
1679             }
1680              
1681 0 0       0 if ( $w > $pw ) {
1682 0         0 $scalex = $pw / $w;
1683             }
1684 0 0       0 if ( $h*$scalex > $ph ) {
1685 0         0 $scalex = $ph / $h;
1686             }
1687 0         0 $scaley = $scalex;
1688 0 0       0 if ( $opts->{scale} ) {
1689 0         0 my @s;
1690 0 0       0 if ( is_arrayref( $opts->{scale} ) ) {
1691 0         0 @s = @{$opts->{scale}};
  0         0  
1692             }
1693             else {
1694 0         0 for ( split( /,/, $opts->{scale} ) ) {
1695 0 0       0 $_ = $1 / 100 if /^([\d.]+)\%$/;
1696 0         0 push( @s, $_ );
1697             }
1698 0 0       0 push( @s, $s[0] ) unless @s > 1;
1699 0 0       0 carp("Invalid scale attribute: \"$opts->{scale}\" (too many values)\n")
1700             unless @s == 2;
1701             }
1702 0         0 $scalex *= $s[0];
1703 0         0 $scaley *= $s[1];
1704             }
1705              
1706             warn("Image scale: ", pv($scalex), " ", pv($scaley), "\n")
1707 0 0       0 if $config->{debug}->{images};
1708 0         0 $w *= $scalex;
1709 0         0 $h *= $scaley;
1710              
1711 0         0 my $align = $opts->{align};
1712              
1713             # If the image is wider than the page width, and scaled to fit, it may
1714             # not be centered (https://github.com/ChordPro/chordpro/issues/428#issuecomment-2356447522).
1715 0 0       0 if ( $w >= $pw ) {
1716 0         0 $align = "left";
1717             }
1718              
1719 0         0 my $ox = $opts->{x};
1720 0         0 my $oy = $opts->{y};
1721              
1722             # Not sure I like this...
1723 0 0 0     0 if ( defined $oy && $oy =~ /base([-+].*)/ ) {
1724 0         0 $oy = -$1;
1725 0 0       0 $oy += $opts->{base}*$scaley if $opts->{base};
1726 0         0 warn("Y: ", $opts->{y}, " BASE: ", $opts->{base}, " -> $oy\n");
1727             }
1728              
1729 0 0       0 if ( $anchor eq "float" ) {
1730             # Note that with indent, the image is aligned to the indented area.
1731 0 0 0     0 $align //= ( $opts->{center} // 1 ) ? "center" : "left";
      0        
1732             # Note that image is placed aligned on $x.
1733 0 0       0 if ( $align eq "center" ) {
    0          
1734 0         0 $x += $pw / 2;
1735             }
1736             elsif ( $align eq "right" ) {
1737 0         0 $x += $pw;
1738             }
1739 0 0       0 warn("Image $align: $_[1] -> $x\n") if $config->{debug}->{images};
1740             }
1741 0   0     0 $align //= "left";
1742              
1743             # Extra scaling in case the available page width is temporarily
1744             # reduced, e.g. due to a right column for chords.
1745 0         0 my $w_actual = $ps->{__rightmargin}-$ps->{_leftmargin}-$ps->{_indent};
1746             my $xtrascale = $w < $w_actual ? 1
1747 0 0       0 : $w_actual / ( $ps->{_marginright}-$ps->{_leftmargin}-$ps->{_indent} );
1748              
1749 0 0       0 my ( $y, $spaceok ) = $gety->($anchor eq "float" ? $h*$xtrascale : 0);
1750             # y may have been changed by checkspace.
1751 0 0 0     0 if ( !$spaceok && $xtrascale < 1 ) {
1752             # An extra scaled image is flushed to the next page, recalc xtrascale.
1753 0 0       0 $y = $gety->($anchor eq "float" ? $h : 0);
1754             $xtrascale = ( $ps->{__rightmargin}-$ps->{_leftmargin} ) /
1755 0         0 ( $ps->{_marginright}-$ps->{_leftmargin} );
1756 0 0       0 warn("ASSERT: xtrascale = $xtrascale, should be 1\n")
1757             unless abs( $xtrascale - 1 ) < 0.01; # fuzz;
1758             }
1759 0 0 0     0 if ( defined ( my $tag = $i_tag // $label ) ) {
1760 0         0 $i_tag = $tag;
1761 0         0 my $ftext = $ps->{fonts}->{comment};
1762 0         0 my $ytext = $y - $pr->font_bl($ftext);
1763 0         0 pr_label_maybe( $ps, $x0, $ytext );
1764             }
1765              
1766             my $calc = sub {
1767 0     0   0 my ( $l, $r, $t, $b, $mirror ) = @_;
1768 0   0     0 my $_ox = $ox // 0;
1769 0   0     0 my $_oy = $oy // 0;
1770 0         0 $x = $l;
1771 0         0 $y = $t;
1772              
1773 0 0       0 if ( $_ox =~ /^([-+]?[\d.]+)\%$/ ) {
1774 0         0 $ox = $_ox = $1/100 * ($r - $l) - ( $1/100 ) * $w;
1775             }
1776 0 0       0 if ( $_oy =~ /^([-+]?[\d.]+)\%$/ ) {
1777 0         0 $oy = $_oy = $1/100 * ($t - $b) - ( $1/100 ) * $h;
1778             }
1779 0 0       0 if ( $mirror ) {
1780 0 0       0 $x = $r - $w if $_ox =~ /^-/;
1781 0 0       0 $y = $b + $h if $_oy =~ /^-/;
1782             }
1783 0         0 };
1784              
1785 0 0       0 if ( $anchor eq "column" ) {
    0          
    0          
1786             # Relative to the column.
1787 0         0 $calc->( @{$ps}{qw( __leftmargin __rightmargin
  0         0  
1788             __topmargin __bottommargin )}, 0 );
1789             }
1790             elsif ( $anchor eq "page" ) {
1791             # Relative to the page.
1792 0         0 $calc->( @{$ps}{qw( _marginleft _marginright
  0         0  
1793             __topmargin __bottommargin )}, 0 );
1794             }
1795             elsif ( $anchor eq "paper" ) {
1796             # Relative to the paper.
1797 0         0 $calc->( 0, $ps->{papersize}->[0], $ps->{papersize}->[1], 0, 1 );
1798             }
1799             else {
1800             # image is line oriented.
1801             # See issue #428.
1802             # $calc->( $x, $ps->{__rightmargin}, $y, $ps->{__bottommargin}, 0 );
1803 0         0 $calc->( $x, $ps->{_marginright}, $y, $ps->{__bottommargin}, 0 );
1804             warn( pv( "_MR = ", $ps->{_marginright} ),
1805             pv( ", _RM = ", $ps->{_rightmargin} ),
1806 0         0 pv( ", __RM = ", $ps->{__rightmargin} ),
1807             pv( ", XS = ", $xtrascale ),
1808             "\n") if 0;
1809             }
1810              
1811 0 0       0 $x += $ox if defined $ox;
1812 0 0       0 $y -= $oy if defined $oy;
1813             warn( sprintf("add_image x=%.1f y=%.1f w=%.1f h=%.1f scale=%.1f,%.1f,%.1f (%s x%+.1f y%+.1f) %s\n",
1814             $x, $y, $w, $h,
1815             $w/$img->width * $xtrascale,
1816             $h/$img->height * $xtrascale,
1817             $xtrascale,
1818             $anchor,
1819             $ox//0, $oy//0, $align,
1820 0 0 0     0 )) if $config->{debug}->{images};
      0        
1821              
1822             $pr->add_object( $img, $x, $y,
1823             xscale => $w/$img->width * $xtrascale,
1824             yscale => $h/$img->height * $xtrascale,
1825             border => $opts->{border} || 0,
1826             maybe bordertrbl => $opts->{bordertrbl},
1827             valign => $opts->{valign} // "top",
1828             align => $align,
1829             maybe href => $opts->{href},
1830 0   0     0 );
      0        
1831              
1832             # For 'allpages' images, remember the calculated results.
1833 0 0       0 if ( $allpages ) {
1834             push( @allpages,
1835             { img => $img,
1836             x => $x, y => $y,
1837             xscale => $w/$img->width * $xtrascale,
1838             yscale => $h/$img->height * $xtrascale,
1839             border => $opts->{border} || 0,
1840             maybe bordertrbl => $opts->{bordertrbl},
1841             valign => $opts->{valign} // "top",
1842             align => $align,
1843             maybe href => $opts->{href},
1844 0   0     0 } );
      0        
1845             }
1846              
1847 0 0       0 if ( $anchor eq "float" ) {
1848 0   0     0 return ($h + ($oy//0)) * $xtrascale;
1849             }
1850 0         0 return 0; # vertical size
1851             }
1852              
1853             sub imagespread {
1854 0     0 0 0 my ( $si, $x, $y, $ps ) = @_;
1855 0         0 my $pr = $ps->{pr};
1856              
1857 0         0 my $tag = "id=" . $si->{id};
1858             return "Unknown asset: $tag"
1859 0 0       0 unless exists( $assets->{$si->{id}} );
1860 0         0 my $asset = $assets->{$si->{id}};
1861 0         0 my $img = $asset->{data};
1862 0 0       0 return "Unhandled asset: $tag"
1863             unless $img;
1864 0         0 my $opts = {};
1865              
1866             # Available width and height.
1867 0         0 my $pw = $ps->{_marginright} - $ps->{_marginleft};
1868 0         0 my $ph = $ps->{_margintop} - $ps->{_marginbottom};
1869              
1870             my ( $w, $h ) = ( $opts->{width} || $img->width,
1871 0   0     0 $opts->{height} || $img->height );
      0        
1872              
1873             # Design scale.
1874 0   0     0 my $scalex = $asset->{opts}->{scale} || 1;
1875 0         0 my $scaley = $scalex;
1876              
1877 0 0       0 if ( $w > $pw ) {
1878 0         0 $scalex = $pw / $w;
1879             }
1880 0 0       0 if ( $h*$scalex > $ph ) {
1881 0         0 $scalex = $ph / $h;
1882             }
1883 0         0 $scaley = $scalex;
1884              
1885 0 0       0 if ( $opts->{scale} ) {
1886 0         0 my @s;
1887 0 0       0 if ( is_arrayref($opts->{scale}) ) {
1888 0         0 @s = @{$opts->{scale}};
  0         0  
1889             }
1890             else {
1891 0         0 for ( split( /,/, $opts->{scale} ) ) {
1892 0 0       0 $_ = $1 / 100 if /^([\d.]+)\%$/;
1893 0         0 push( @s, $_ );
1894             }
1895 0 0       0 push( @s, $s[0] ) unless @s > 1;
1896 0 0       0 carp("Invalid scale attribute: \"$opts->{scale}\" (too many values)\n")
1897             unless @s == 2;
1898             }
1899 0         0 $scalex *= $s[0];
1900 0         0 $scaley *= $s[1];
1901             }
1902              
1903 0 0       0 warn("Image scale: $scalex $scaley\n") if $config->{debug}->{images};
1904 0         0 $h *= $scalex;
1905 0         0 $w *= $scaley;
1906              
1907 0         0 my $align = $opts->{align};
1908 0 0 0     0 $align //= ( $opts->{center} // 1 ) ? "center" : "left";
      0        
1909             # Note that image is placed aligned on $x.
1910 0 0       0 if ( $align eq "center" ) {
    0          
1911 0         0 $x += $pw / 2;
1912             }
1913             elsif ( $align eq "right" ) {
1914 0         0 $x += $pw;
1915             }
1916 0 0       0 warn("Image $align: $_[1] -> $x\n") if $config->{debug}->{images};
1917              
1918 0 0       0 warn("add_image\n") if $config->{debug}->{images};
1919             # $pr->add_image( $img, $x, $y, $w, $h, $opts->{border} || 0 );
1920             $pr->add_object( $img, $x, $y,
1921             xscale => $w/$img->width,
1922             yscale => $h/$img->height,
1923             border => $opts->{border} || 0,
1924             maybe bordertrbl => $opts->{bordertrbl},
1925 0   0     0 valign => "top",
1926             align => $align,
1927             );
1928              
1929 0         0 return $h + $si->{space}; # vertical size
1930             }
1931              
1932             sub tocline {
1933 48     48 0 186 my ( $elt, $x, $y, $ps ) = @_;
1934              
1935 48         137 my $pr = $ps->{pr};
1936 48         136 my $fonts = $ps->{fonts};
1937 48         108 my $y0 = $y;
1938 48         115 my $ftoc = $fonts->{toc};
1939 48         371 $y -= $pr->font_bl($ftoc);
1940 48         725 $pr->setfont($ftoc);
1941 48         12663 my $tpl = $elt->{title};
1942 48         160 my $lines = 0;
1943 48         118 my $blines = 0; # lines for break
1944 48         95 my $vsp;
1945              
1946 48   50     282 my $p = $elt->{pageno} // "";
1947 48         331 my $pw = $pr->strwidth($p);
1948 48         17816 my $ww = $ps->{__rightmargin} - $x - $pr->strwidth("xxx$p");
1949              
1950             # Formatter sub.
1951             my $f = sub {
1952 48     48   177 my ( $tpl, $p ) = @_;
1953 48         100 my $vsp;
1954 48         325 for my $text ( split( /\\n|\n/, $tpl ) ) {
1955 48         133 $lines++;
1956             # Suppress unclosed markup warnings.
1957             local $SIG{__WARN__} = sub{
1958 0 0       0 CORE::warn(@_) unless "@_" =~ /Unclosed markup/;
1959 48         431 };
1960             # Get the part that fits (hopefully, all) and print.
1961 48         133 ( $text, my $ex ) = @{ defrag( [ $pr->wrap( $text, $ww ) ] ) };
  48         346  
1962 48         373 $pr->text( $text, $x, $y );
1963 48 50       232 unless ($vsp) {
1964 48         393 $ps->{pr}->text( $p, $ps->{__rightmargin} - $pw, $y );
1965 48         284 $vsp = _vsp("toc", $ps);
1966             $x += $pr->strwidth( $config->{settings}->{wrapindent} )
1967 48 50       234 if $ex ne "";
1968             }
1969 48         136 $y -= $vsp;
1970 48 50       569 if ( $ex ne "" ) {
1971 0         0 $text = $ex;
1972 0         0 redo;
1973             }
1974             }
1975 48         200 return $vsp;
1976 48         27006 };
1977              
1978             # First the break, if any. No page number.
1979 48 50       271 if ( $elt->{break} ) {
1980 0         0 $vsp = $f->( $elt->{break}, "" );
1981 0         0 $blines = $lines;
1982 0         0 $lines = 0;
1983             }
1984              
1985             # Then the actual content line, with page number.
1986 48         199 $vsp = $f->( $tpl, $p );
1987              
1988 48 50       272 if ( $elt->{page} ) {
1989 48         365 my $ann = $pr->{pdfpage}->annotation;
1990 48         14043 $ann->link($elt->{page});
1991 48         8245 $ann->rect( $ps->{__leftmargin}, $y0-($blines+$lines)*$vsp, $ps->{__rightmargin}, $y0-$blines*$vsp );
1992             }
1993              
1994 48         4662 return $blines + $lines;
1995             }
1996              
1997             sub has_visible_chords {
1998 144     144 0 402 my ( $elt ) = @_;
1999 144 50       576 if ( $elt->{chords} ) {
2000 144         340 for ( @{ $elt->{chords} } ) {
  144         637  
2001 288 50       770 next if defined;
2002 0         0 warn("Undefined chord in chords: ", ::dump($elt) );
2003             }
2004 144         343 return join( "", @{ $elt->{chords} } ) =~ /\S/;
  144         2121  
2005             }
2006 0         0 return;
2007             }
2008              
2009             sub has_visible_text {
2010 0     0 0 0 my ( $elt ) = @_;
2011 0 0       0 $elt->{phrases} && join( "", @{ $elt->{phrases} } ) =~ /\S/;
  0         0  
2012             }
2013              
2014             sub songline_vsp {
2015 72     72 0 290 my ( $elt, $ps ) = @_;
2016              
2017             # Calculate the vertical span of this songline.
2018 72         229 my $fonts = $ps->{fonts};
2019              
2020 72 50       404 if ( $elt->{type} =~ /^comment/ ) {
2021 0   0     0 my $ftext = $fonts->{$elt->{type}} || $fonts->{comment};
2022 0         0 return $ftext->{size} * $ps->{spacing}->{lyrics};
2023             }
2024 72 50       293 if ( $elt->{type} eq "tabline" ) {
2025 0         0 my $ftext = $fonts->{tab};
2026 0         0 return $ftext->{size} * $ps->{spacing}->{tab};
2027             }
2028              
2029             # Vertical span of the lyrics and chords.
2030             # my $vsp = $fonts->{text}->{size} * $ps->{spacing}->{lyrics};
2031 72         339 my $vsp = text_vsp( $elt, $ps );
2032 72         323 my $csp = $fonts->{chord}->{size} * $ps->{spacing}->{chords};
2033              
2034 72 50 33     495 return $vsp if $lyrics_only || $chordscol;
2035              
2036 72 50 33     280 return $vsp if $suppress_empty_chordsline && ! has_visible_chords($elt);
2037              
2038             # No text printing if no text.
2039 72 50 33     296 $vsp = 0 if $suppress_empty_lyricsline && join( "", @{ $elt->{phrases} } ) !~ /\S/;
  72         561  
2040              
2041 72 50       264 if ( $inlinechords ) {
2042 0 0       0 $vsp = $csp if $csp > $vsp;
2043             }
2044             else {
2045             # We must show chords above lyrics, so add chords span.
2046 72         183 $vsp += $csp;
2047             }
2048 72         289 return $vsp;
2049             }
2050              
2051             sub _vsp {
2052 232     232   810 my ( $eltype, $ps, $sptype ) = @_;
2053 232   66     1228 $sptype ||= $eltype;
2054              
2055             # Calculate the vertical span of this element.
2056              
2057 232         708 my $font = $ps->{fonts}->{$eltype};
2058 232 50       781 confess("Font $eltype has no size!") unless $font->{size};
2059 232         1097 $font->{size} * $ps->{spacing}->{$sptype};
2060             }
2061              
2062 16     16 0 149 sub empty_vsp { _vsp( "empty", $_[1] ) }
2063 0     0 0 0 sub grid_vsp { _vsp( "grid", $_[1] ) }
2064 0     0 0 0 sub tab_vsp { _vsp( "tab", $_[1] ) }
2065              
2066             sub toc_vsp {
2067 96     96 0 320 my $vsp = _vsp( "toc", $_[1] );
2068 96         261 my $tpl = $_[0]->{title};
2069 96 50       335 $tpl = $_[0]->{break} . "\\n" . $tpl if $_[0]->{break};
2070 96         210 my $ret = $vsp;
2071 96         392 while ( $tpl =~ /\\n/g ) {
2072 0         0 $ret += $vsp;
2073             }
2074 96         256 return $ret;
2075             }
2076              
2077             sub text_vsp {
2078 72     72 0 218 my ( $elt, $ps ) = @_;
2079              
2080 72 50       492 my $ftext = $ps->{fonts}->{ $elt->{context} eq "chorus"
2081             ? "chorus" : "text" };
2082 72         624 my $layout = $ps->{pr}->{layout}->copy;
2083 72         6106 $layout->set_font_description( $ftext->{fd} );
2084 72         1698 $layout->set_font_size( $ftext->{size} );
2085             #warn("vsp: ".join( "", @{$elt->{phrases}} )."\n");
2086              
2087 72         654 my $msg = "";
2088             {
2089 72     0   182 local $SIG{__WARN__} = sub { $msg .= "@_" };
  72         917  
  0         0  
2090 72         225 $layout->set_markup( join( "", @{$elt->{phrases}} ) );
  72         597  
2091             }
2092 72 0 33     6861 if ( $msg && $elt->{line} ) {
2093 0         0 $msg =~ s/^(.*)\n\s+//;
2094 0         0 warn("Line ", $elt->{line}, ", $msg\n");
2095             }
2096 72         432 my $vsp = $layout->get_size->{height} * $ps->{spacing}->{lyrics};
2097             #warn("vsp $vsp \"", $layout->get_text, "\"\n");
2098             # Calculate the vertical span of this line.
2099              
2100 72 50       99222 _vsp( $elt->{context} eq "chorus" ? "chorus" : "text", $ps, "lyrics" );
2101             }
2102              
2103             sub set_columns {
2104 40     40 0 150 my ( $ps, $cols ) = @_;
2105 40         97 my @cols;
2106 40 50       188 if ( is_arrayref($cols) ) {
2107 0         0 @cols = @$cols;
2108 0         0 $cols = @$cols;
2109             }
2110 40 50       149 unless ( $cols ) {
2111 0   0     0 $cols = $ps->{columns} ||= 1;
2112             }
2113             else {
2114 40   50     221 $ps->{columns} = $cols ||= 1;
2115             }
2116              
2117             my $w = $ps->{papersize}->[0]
2118 40         292 - $ps->{_leftmargin} - $ps->{_rightmargin};
2119 40         180 $ps->{columnoffsets} = [ 0 ];
2120              
2121 40 50       177 if ( @cols ) { # columns with explicit widths
2122 0         0 my $stars;
2123 0         0 my $wx = $w + $ps->{columnspace}; # available
2124 0         0 for ( @cols ) {
2125 0 0 0     0 if ( !$_ || $_ eq '*' ) {
    0          
2126 0         0 $stars++;
2127             }
2128             elsif ( /^(\d+)%$/ ) {
2129 0         0 $_ = $1 * $w / 100; # patch
2130             }
2131             else {
2132 0         0 $wx -= $_; # subtract from avail width
2133             }
2134             }
2135 0 0       0 my $sw = $wx / $stars if $stars;
2136 0         0 my $l = 0;
2137 0         0 for ( @cols ) {
2138 0 0 0     0 if ( !$_ || $_ eq '*' ) {
2139 0         0 $l += $sw;
2140             }
2141             else {
2142 0         0 $l += $_;
2143             }
2144 0         0 push( @{ $ps->{columnoffsets} }, $l );
  0         0  
2145             }
2146             #warn("COL: @{ $ps->{columnoffsets} }\n");
2147 0         0 return;
2148             }
2149              
2150 40 50       172 push( @{ $ps->{columnoffsets} }, $w ), return unless $cols > 1;
  40         214  
2151              
2152 0         0 my $d = ( $w - ( $cols - 1 ) * $ps->{columnspace} ) / $cols;
2153 0         0 $d += $ps->{columnspace};
2154 0         0 for ( 1 .. $cols-1 ) {
2155 0         0 push( @{ $ps->{columnoffsets} }, $_ * $d );
  0         0  
2156             }
2157 0         0 push( @{ $ps->{columnoffsets} }, $w );
  0         0  
2158             #warn("COL: @{ $ps->{columnoffsets} }\n");
2159             }
2160              
2161             sub showlayout {
2162 0     0 0 0 my ( $ps ) = @_;
2163 0         0 my $pr = $ps->{pr};
2164 0         0 my $col = "red";
2165 0         0 my $lw = 0.5;
2166 0         0 my $font = $ps->{fonts}->{grid};
2167              
2168 0         0 my $mr = $ps->{_rightmargin};
2169 0         0 my $ml = $ps->{_leftmargin};
2170              
2171             my $f = sub {
2172 0     0   0 my $t = sprintf( "%.1f", shift );
2173 0         0 $t =~ s/\.0$//;
2174 0         0 return $t;
2175 0         0 };
2176              
2177             $pr->rectxy( $ml,
2178             $ps->{marginbottom},
2179             $ps->{papersize}->[0]-$mr,
2180             $ps->{papersize}->[1]-$ps->{margintop},
2181 0         0 $lw, undef, $col);
2182              
2183 0         0 my $fsz = 7;
2184 0         0 my $ptop = $ps->{papersize}->[1]-$ps->{margintop}+$fsz-3;
2185 0         0 $pr->setfont($font,$fsz);
2186 0         0 $pr->text( "$ml",
2187             $ml, $ptop, $font, $fsz );
2188 0         0 my $t = $f->($ps->{papersize}->[0]-$mr);
2189             $pr->text( "$t",
2190 0         0 $ps->{papersize}->[0]-$mr-$pr->strwidth("$mr"),
2191             $ptop, $font, $fsz );
2192 0         0 $t = $f->($ps->{papersize}->[1]-$ps->{margintop});
2193             $pr->text( "$t ",
2194             $ml-$pr->strwidth("$t "),
2195 0         0 $ps->{papersize}->[1]-$ps->{margintop}-2,
2196             $font, $fsz );
2197 0         0 $t = $f->($ps->{marginbottom});
2198             $pr->text( "$t ",
2199             $ml-$pr->strwidth("$t "),
2200 0         0 $ps->{marginbottom}-2,
2201             $font, $fsz );
2202             my @a = ( $ml,
2203             $ps->{papersize}->[1]-$ps->{margintop}+$ps->{headspace},
2204 0         0 $ps->{papersize}->[0]-$ml-$mr,
2205             $lw, $col );
2206 0         0 $pr->hline(@a);
2207 0         0 $t = $f->($a[1]);
2208 0         0 $pr->text( "$t ",
2209             $ml-$pr->strwidth("$t "),
2210             $a[1]-2,
2211             $font, $fsz );
2212 0         0 $a[1] = $ps->{marginbottom}-$ps->{footspace};
2213 0         0 $pr->hline(@a);
2214 0         0 $t = $f->($a[1]);
2215 0         0 $pr->text( "$t ",
2216             $ml-$pr->strwidth("$t "),
2217             $a[1]-2,
2218             $font, $fsz );
2219              
2220 0         0 my $spreadimage = $ps->{_spreadimage};
2221 0 0 0     0 if ( defined($spreadimage) && !ref($spreadimage) ) {
2222 0         0 my $mr = $ps->{marginright};
2223 0         0 $a[1] = $ps->{papersize}->[1]-$ps->{margintop} - $spreadimage;
2224 0         0 $a[2] = $ps->{papersize}->[0]-$ml-$mr;
2225 0         0 $pr->hline(@a);
2226 0         0 $t = $f->($a[1]);
2227 0         0 $pr->text( "$t ",
2228             $ml-$pr->strwidth("$t "),
2229             $a[1]-2,
2230             $font, $fsz );
2231 0         0 $a[0] = $ps->{papersize}->[0]-$mr;
2232 0         0 $a[1] = $ps->{papersize}->[1]-$ps->{margintop};
2233 0         0 $a[2] = $a[1] - $ps->{marginbottom};
2234 0         0 $pr->vline(@a);
2235 0         0 $t = $f->($a[0]);
2236 0         0 $pr->text( "$t ",
2237             $a[0]-$pr->strwidth("$t")/2,
2238             $ptop,
2239             $font, $fsz );
2240             }
2241              
2242 0         0 my @off = @{ $ps->{columnoffsets} };
  0         0  
2243 0         0 pop(@off);
2244 0 0       0 @off = ( $ps->{chordscolumn} ) if $chordscol;
2245             @a = ( undef,
2246             $ps->{marginbottom},
2247             $ps->{margintop}-$ps->{papersize}->[1]+$ps->{marginbottom},
2248 0         0 $lw, $col );
2249 0         0 foreach my $i ( 0 .. @off-1 ) {
2250 0 0       0 next unless $off[$i];
2251 0         0 $a[0] = $f->($ml + $off[$i]);
2252 0         0 $pr->text( "$a[0]",
2253             $a[0] - $pr->strwidth($a[0])/2, $ptop, $font, $fsz );
2254 0         0 $pr->vline(@a);
2255 0         0 $a[0] = $f->($ml + $off[$i] - $ps->{columnspace});
2256 0         0 $pr->text( "$a[0]",
2257             $a[0] - $pr->strwidth($a[0])/2, $ptop, $font, $fsz );
2258 0         0 $pr->vline(@a);
2259 0 0       0 if ( $ps->{_indent} ) {
2260 0         0 $a[0] = $ml + $off[$i] + $ps->{_indent};
2261 0         0 $pr->vline(@a);
2262             }
2263             }
2264 0 0       0 if ( $ps->{_indent} ) {
2265 0         0 $a[0] = $ml + $ps->{_indent};
2266 0         0 $pr->vline(@a);
2267             }
2268             }
2269              
2270              
2271             # Get a format string for a given page class and type.
2272             # Page classes have fallbacks.
2273             sub get_format {
2274 120     120 0 444 my ( $ps, $class, $type, $rightpage ) = @_;
2275 120         463 for ( my $i = $class; $i < @classes; $i++ ) {
2276 150         398 $class = $classes[$i];
2277 150 50       445 next if $class eq 'filler';
2278 150         276 my $fmt;
2279 150         332 my $swap = !$rightpage;
2280 150 50 66     972 if ( !$rightpage
    100          
2281             && exists($ps->{formats}->{$class."-even"}->{$type}) ) {
2282 0         0 $fmt = $ps->{formats}->{$class."-even"}->{$type};
2283 0         0 $swap = 0;
2284             }
2285             elsif ( exists($ps->{formats}->{$class}->{$type}) ) {
2286 120         361 $fmt = $ps->{formats}->{$class}->{$type};
2287             }
2288 150 100       460 next unless $fmt;
2289              
2290             # This should be dealt with in Config...
2291 120 50 33     487 $fmt = [ $fmt ] if @$fmt == 3 && !is_arrayref($fmt->[0]);
2292              
2293             # Swap left/right for even pages.
2294 120 100       369 if ( $swap ) {
2295             # make a copy!
2296 12         34 $fmt = [ map { [ reverse @$_ ] } @$fmt ];
  12         73  
2297             }
2298              
2299 120 50       679 if ( $::config->{debug}->{pages} & 0x02 ) {
2300             warn( "format[$class,$type], ",
2301             $rightpage ? "right" : "left",
2302             ", swap = ", $swap ? "yes" : "no",
2303 0 0       0 ", fmt = \"" . join('" "', @{$fmt->[0]}) . "\"\n");
  0 0       0  
2304             }
2305 120 50       583 return $fmt if $fmt;
2306             }
2307 0         0 return;
2308             }
2309              
2310             # Three-part titles.
2311             # Note: baseline printing.
2312             sub tpt {
2313 120     120 0 504 my ( $ps, $class, $type, $rightpage, $x, $y, $s ) = @_;
2314 120         487 my $fmt = get_format( $ps, $class, $type, $rightpage );
2315 120 50       350 return unless $fmt;
2316             warn("page: ", $s->{meta}->{page}->[0],
2317             ", fmt[", $s->{meta}->{"page.class"}, ",$type] = \"",
2318 0         0 join('" "',@{$fmt->[0]}), "\"\n" )
2319 120 50       416 if $::config->{debug}->{pages} & 0x01;
2320              
2321 120         312 my $pr = $ps->{pr};
2322 120         337 my $font = $ps->{fonts}->{$type};
2323              
2324 120         220 my $havefont;
2325 120         422 my $rm = $ps->{papersize}->[0] - $ps->{_rightmargin};
2326              
2327 120         415 for my $fmt ( @$fmt ) {
2328 120 50       392 if ( @$fmt % 3 ) {
2329 0         0 die("ASSERT: " . scalar(@$fmt)," part format $class $type");
2330             }
2331              
2332             # Left part. Easiest.
2333 120 100       382 if ( $fmt->[0] ) {
2334 4         19 my $t = fmt_subst( $s, $fmt->[0] );
2335 4 50       1074 if ( $t ne "" ) {
2336 4 50       43 $pr->setfont($font) unless $havefont++;
2337 4         1081 $pr->text( $t, $x, $y );
2338             }
2339             }
2340              
2341             # Center part.
2342 120 100       392 if ( $fmt->[1] ) {
2343 80         584 my $t = fmt_subst( $s, $fmt->[1] );
2344 80 100       23359 if ( $t ne "" ) {
2345 40 50       463 $pr->setfont($font) unless $havefont++;
2346 40         9722 $pr->text( $t, ($rm+$x-$pr->strwidth($t))/2, $y );
2347             }
2348             }
2349              
2350             # Right part.
2351 120 100       522 if ( $fmt->[2] ) {
2352 21         116 my $t = fmt_subst( $s, $fmt->[2] );
2353 21 50       5242 if ( $t ne "" ) {
2354 21 50       230 $pr->setfont($font) unless $havefont++;
2355 21         5572 $pr->text( $t, $rm-$pr->strwidth($t), $y );
2356             }
2357             }
2358              
2359 120   100     1117 $y -= $font->{size} * ($ps->{spacing}->{$type} || 1);
2360             }
2361              
2362             # Return updated baseline.
2363 120         840 return $y;
2364             }
2365              
2366             sub wrap {
2367 72     72 0 294 my ( $pr, $elt, $x ) = @_;
2368 72         220 my $res = [];
2369 72   50     153 my @chords = @{ $elt->{chords} // [] };
  72         1053  
2370 72   50     170 my @phrases = @{ defrag( $elt->{phrases} // [] ) };
  72         505  
2371 72         259 my @rchords;
2372             my @rphrases;
2373 72         329 my $m = $pr->{ps}->{__rightmargin};
2374             my $wi = $pr->strwidth( $config->{settings}->{wrapindent}//"x",
2375 72   50     961 $pr->{ps}->{fonts}->{text} );
2376             #warn("WRAP x=$x rm=$m w=", $m - $x, "\n");
2377              
2378 72         26524 while ( @chords ) {
2379 144         403 my $chord = shift(@chords);
2380 144   50     557 my $phrase = shift(@phrases) // "";
2381 144         358 my $ex = "";
2382             #warn("wrap x=$x rm=$m w=", $m - $x, " ch=$chord, ph=$phrase\n");
2383              
2384 144 100 66     738 if ( @rchords && $chord ) {
2385             # Does the chord fit?
2386 72         1040 my $c = $chord->chord_display;
2387 72         246 my $w;
2388 72 50       347 if ( $c =~ /^\*(.+)/ ) {
2389 0         0 $pr->setfont( $pr->{ps}->{fonts}->{annotation} );
2390 0         0 $c = $1;
2391             }
2392             else {
2393 72         593 $pr->setfont( $pr->{ps}->{fonts}->{chord} );
2394             }
2395 72         17971 $w = $pr->strwidth($c);
2396 72 50       29683 if ( $w > $m - $x ) {
2397             # Nope. Move to overflow.
2398 0         0 $ex = $phrase;
2399             }
2400             }
2401              
2402 144 50       527 if ( $ex eq "" ) {
2403             # Do lyrics fit?
2404 144         683 my $font = $pr->{ps}->{fonts}->{text};
2405 144         806 $pr->setfont($font);
2406 144         33719 my $ph;
2407 144         979 ( $ph, $ex ) = $pr->wrap( $phrase, $m - $x );
2408             # If it doesn not fit, it is usually a case a bad luck.
2409             # However, we may be able to move to overflow.
2410 144         735 my $w = $pr->strwidth($ph);
2411 144 50 33     109774 if ( $w > $m - $x && @rchords > 1 ) {
2412 0         0 $ex = $phrase;
2413             }
2414             else {
2415 144         507 push( @rchords, $chord );
2416 144         400 push( @rphrases, $ph );
2417 144         347 $chord = '';
2418             }
2419 144         379 $x += $w;
2420             }
2421              
2422 144 50       729 if ( $ex ne "" ) { # overflow
2423 0 0 0     0 if ( $rphrases[-1] =~ /[[:alpha:]]$/
      0        
2424             && $ex =~ /^[[:alpha:]]/
2425             && $chord ne '' ) {
2426 0         0 $rphrases[-1] .= "-";
2427             }
2428 0         0 unshift( @chords, $chord );
2429 0         0 unshift( @phrases, $ex );
2430 0         0 push( @$res,
2431             { %$elt, chords => [@rchords], phrases => [@rphrases] } );
2432 0         0 $x = $_[2] + $wi;;
2433 0 0       0 $res->[-1]->{indent} = $wi if @$res > 1;
2434 0         0 @rchords = ();
2435 0         0 @rphrases = ();
2436             }
2437             }
2438 72         857 push( @$res, { %$elt, chords => \@rchords, phrases => \@rphrases } );
2439 72 50       389 $res->[-1]->{indent} = $wi if @$res > 1;
2440 72         292 return $res;
2441             }
2442              
2443             sub wrapsimple {
2444 0     0 0 0 my ( $pr, $text, $x, $font ) = @_;
2445 0 0       0 return ( "", "" ) unless length($text);
2446              
2447 0   0     0 $font ||= $pr->{font};
2448 0         0 $pr->setfont($font);
2449 0         0 $pr->wrap( $text, $pr->{ps}->{__rightmargin} - $x );
2450             }
2451              
2452             sub prepare_assets {
2453 40     40 0 138 my ( $s, $pr ) = @_;
2454              
2455 40   50     97 my %sa = %{$s->{assets}//{}} ; # song assets
  40         388  
2456              
2457             warn("PDF: Preparing ", plural(scalar(keys %sa), " image"), "\n")
2458 40 50 33     390 if $config->{debug}->{images} || $config->{debug}->{assets};
2459              
2460 40         194 for my $id ( sort keys %sa ) {
2461 0         0 prepare_asset( $id, $s, $pr );
2462             }
2463              
2464             warn("PDF: Preparing ", plural(scalar(keys %sa), " image"), ", done\n")
2465 40 50 33     384 if $config->{debug}->{images} || $config->{debug}->{assets};
2466 40   50     265 $assets = $s->{assets} || {};
2467             ::dump( $assets, as => "Assets, Pass 2" )
2468 40 50       262 if $config->{debug}->{assets} & 0x02;
2469              
2470             }
2471              
2472             sub prepare_asset {
2473 0     0 0   my ( $id, $s, $pr ) = @_;
2474              
2475 0           my $ps = $s->{_ps} = $pr->{ps}; # for handlers TODO
2476              
2477             # All elements generate zero or one display items, except for SVG images
2478             # than can result in a series of display items.
2479             # So we first scan the list for SVG and delegate items and turn these
2480             # into simple display items.
2481              
2482             # warn("_MR = ", $ps->{_marginright}, ", _RM = ", $ps->{_rightmargin},
2483             # ", __RM = ", $ps->{__rightmargin}, "\n");
2484             # my $pw = $ps->{__rightmargin} - $ps->{_marginleft};
2485 0           my $pw = $ps->{_marginright} - $ps->{_marginleft};
2486             my $cw = ( $pw - ( $ps->{columns} - 1 ) * $ps->{columnspace} ) /$ps->{columns}
2487 0           - $ps->{_indent};
2488              
2489 0           for my $elt ( $s->{assets}->{$id} ) {
2490             # Already prepared, e.g. multi-pass songbook.
2491 0 0         next if UNIVERSAL::can($elt->{data}, "width");
2492              
2493 0 0 0       $elt->{subtype} //= "image" if $elt->{uri};
2494              
2495 0 0 0       if ( $elt->{type} eq "image" && $elt->{subtype} eq "delegate" ) {
2496 0           my $delegate = $elt->{delegate};
2497             warn("PDF: Preparing delegate $delegate, handler ",
2498             $elt->{handler},
2499 0   0       ( map { " $_=" . $elt->{opts}->{$_} } keys(%{$elt->{opts}//{}})),
  0            
2500 0 0         "\n") if $config->{debug}->{images};
2501              
2502 0           my $pkg = __PACKAGE__;
2503 0           $pkg =~ s/::Output::[:\w]+$/::Delegate::$delegate/;
2504 0 0         eval "require $pkg" || die($@);
2505 0   0       my $hd = $pkg->can($elt->{handler}) //
2506             die("PDF: Missing delegate handler ${pkg}::$elt->{handler}\n");
2507 0 0         unless ( $elt->{data} ) {
2508 0           $elt->{data} = fs_load( $elt->{uri}, { fail => 'hard' } );
2509             }
2510              
2511             # Determine actual width.
2512 0 0         my $w = defined($elt->{opts}->{spread}) ? $pw : $cw;
2513             $w = $elt->{opts}->{width}
2514 0 0 0       if $elt->{opts}->{width} && $elt->{opts}->{width} < $w;
2515              
2516 0           my $res = $hd->( $s, elt => $elt, pagewidth => $w );
2517 0 0         if ( $res ) {
2518 0   0       $res->{opts} = { %{ $res->{opts} // {} },
2519 0   0       %{ $elt->{opts} // {} } };
  0            
2520             warn( "PDF: Preparing delegate $delegate, handler ",
2521             $elt->{handler}, " => ",
2522             $res->{type}, "/", $res->{subtype},
2523 0   0       ( map { " $_=" . $res->{opts}->{$_} } keys(%{$res->{opts}//{}})),
  0            
2524             " w=$w",
2525             "\n" )
2526 0 0         if $config->{debug}->{images};
2527 0           $s->{assets}->{$id} = $res;
2528             }
2529             else {
2530             # Substitute alert image.
2531             $s->{assets}->{$id} = $res =
2532             { type => "image",
2533             line => $elt->{line},
2534             subtype => "xform",
2535             data => TextLayoutImageElement::alert(60),
2536 0   0       opts => { %{$elt->{opts}//{}} } };
  0            
2537             }
2538              
2539             # If the delegate produced an image, continue processing.
2540 0 0 0       if ( $res && $res->{type} eq "image" ) {
2541 0           $elt = $res;
2542             }
2543             else {
2544             # Proceed to next asset.
2545 0           next;
2546             }
2547             }
2548              
2549 0 0 0       if ( $elt->{type} eq "image" && $elt->{subtype} eq "svg" ) {
2550 0 0         warn("PDF: Preparing SVG image\n") if $config->{debug}->{images};
2551 0           require SVGPDF;
2552 0           SVGPDF->VERSION(0.080);
2553              
2554             # One or more?
2555             my $combine = ( !($elt->{opts}->{split}//1)
2556             || $elt->{opts}->{id}
2557 0 0 0       || defined($elt->{opts}->{spread}) )
2558             ? "stacked" : "none";
2559 0   0       my $sep = $elt->{opts}->{staffsep} || 0;
2560              
2561             # Note we need special font and text handlers.
2562             my $p = SVGPDF->new
2563             ( pdf => $ps->{pr}->{pdf},
2564 0     0     fc => sub { svg_fonthandler( $ps, @_ ) },
2565 0     0     tc => sub { svg_texthandler( $ps, @_ ) },
2566             atts => { debug => $config->{debug}->{svg} > 1,
2567 0   0       verbose => $config->{debug}->{svg} // 0,
2568             } );
2569 0           my $data = $elt->{data};
2570             my $o = $p->process( $data ? \join( "\n", @$data ) : $elt->{uri},
2571 0 0         combine => $combine,
2572             sep => $sep,
2573             );
2574             warn( "PDF: Preparing SVG image => ",
2575             plural(0+@$o, " element"), ", combine=$combine\n")
2576 0 0         if $config->{debug}->{images};
2577 0 0         if ( ! @$o ) {
2578 0           warn("Error in SVG embedding (no SVG objects found)\n");
2579 0           next;
2580             }
2581              
2582             my $res =
2583             $s->{assets}->{$id} = {
2584             type => "image",
2585             subtype => "xform",
2586             width => $o->[0]->{width},
2587             height => $o->[0]->{height},
2588             vwidth => $o->[0]->{vwidth},
2589             vheight => $o->[0]->{vheight},
2590             data => $o->[0]->{xo},
2591 0   0       opts => { %{ $o->[0]->{opts} // {} },
2592 0   0       %{ $s->{assets}->{$id}->{opts} // {} },
  0            
2593             },
2594             sep => $sep,
2595             };
2596 0 0         if ( @$o > 1 ) {
2597 0           $res->{multi} = $o;
2598             }
2599             warn("Created asset $id (xform, ",
2600             $o->[0]->{vwidth}, "x", $o->[0]->{vheight}, ")",
2601             " scale=", $res->{opts}->{scale} || 1,
2602             " align=", $res->{opts}->{align}//"default",
2603             " sep=", $sep,
2604             " base=", $res->{opts}->{base}//"",
2605             "\n")
2606 0 0 0       if $config->{debug}->{images};
      0        
      0        
2607 0           next;
2608             }
2609              
2610 0 0 0       if ( $elt->{type} eq "image" && $elt->{subtype} eq "xform" ) {
2611             # Ready to go.
2612 0           next;
2613             }
2614              
2615 0 0         if ( $elt->{type} eq "image" ) {
2616 0 0         warn("PDF: Preparing $elt->{subtype} image\n") if $config->{debug}->{images};
2617 0 0 0       if ( ($elt->{uri}//"") =~ /^chord:(.+)/ ) {
2618 0           my $chord = $1;
2619             # Look it up.
2620 0   0       my $info = $s->{chordsinfo}->{$chord}
2621             // ChordPro::Chords::known_chord($chord);
2622             # If it is defined locally, merge.
2623 0   0       for my $def ( @{ $s->{define} // [] } ) {
  0            
2624 0 0         next unless $def->{name} eq $chord;
2625 0           $info->{$_} = $def->{$_} for keys(%$def);
2626             }
2627 0           my $xo;
2628 0 0         unless ( $info ) {
2629 0           warn("Unknown chord in asset: $1\n");
2630 0           $xo = TextLayoutImageElement::alert(20);
2631             }
2632             else {
2633 0   0       my $type = $elt->{opts}->{type} || $config->{instrument}->{type};
2634 0           my $p = ChordPro::Output::PDF::diagrammer($type);
2635 0           $xo = $p->diagram_xo($info);
2636             }
2637             my $res =
2638             $s->{assets}->{$id} = {
2639             type => "image",
2640             subtype => "xform",
2641             width => $xo->width,
2642             height => $xo->height,
2643             data => $xo,
2644             maybe opts => $s->{assets}->{$id}->{opts},
2645 0           };
2646             warn("Created asset $id ($elt->{subtype}, ",
2647             $res->{width}, "x", $res->{height}, ")",
2648 0   0       map { " $_=" . $res->{opts}->{$_} } keys( %{$res->{opts}//{}} ),
  0            
2649             "\n")
2650 0 0         if $config->{debug}->{images};
2651             }
2652             else {
2653 0 0 0       if ( $elt->{uri} && !$elt->{data} ) {
2654 0           $elt->{data} = fs_blob( $elt->{uri}, { fail => 'hard' } );
2655             }
2656 0 0         my $data = $elt->{data} ? IO::String->new($elt->{data}) : $elt->{uri};
2657 0           my $img = $pr->{pdf}->image($data);
2658 0           my $subtype = lc(ref($img) =~ s/^.*://r);
2659 0 0         $subtype = "jpg" if $subtype eq "jpeg";
2660             my $res =
2661             $s->{assets}->{$id} = {
2662             type => "image",
2663             subtype => $subtype,
2664             width => $img->width,
2665             height => $img->height,
2666             data => $img,
2667             maybe opts => $s->{assets}->{$id}->{opts},
2668 0           };
2669             warn("Created asset $id ($elt->{subtype}, ",
2670             $res->{width}, "x", $res->{height}, ")",
2671 0           ( map { " $_=" . $res->{opts}->{$_} }
2672 0   0       keys( %{$res->{opts}//{}} ) ),
2673             "\n")
2674 0 0         if $config->{debug}->{images};
2675             }
2676             }
2677              
2678 0           next;
2679              
2680 0 0 0       if ( $elt->{type} eq "image" && $elt->{opts}->{spread} ) {
2681 0 0         if ( $s->{spreadimage} ) {
2682 0           warn("Ignoring superfluous spread image\n");
2683             }
2684             else {
2685 0           $s->{spreadimage} = $elt;
2686             warn("PDF: Preparing images, got spread image\n")
2687 0 0         if $config->{debug}->{images};
2688 0           next; # do not copy back
2689             }
2690             }
2691              
2692             }
2693             }
2694              
2695             # Font handler for SVG embedding.
2696             sub svg_fonthandler {
2697 0     0 0   my ( $ps, $svg, %args ) = @_;
2698 0           my ( $pdf, $style ) = @args{qw(pdf style)};
2699              
2700 0           my $family = lc( $style->{'font-family'} );
2701 0   0       my $stl = lc( $style->{'font-style'} // "normal" );
2702 0   0       my $weight = lc( $style->{'font-weight'} // "normal" );
2703 0   0       my $size = $style->{'font-size'} || 12;
2704              
2705             # Font cache.
2706 0           state $fc = {};
2707 0           my $key = join( "|", $family, $stl, $weight );
2708              
2709             # Clear cache when the PDF changes.
2710 0           state $cf = "";
2711 0 0         if ( $cf ne $ps->{pr}->{pdf} ) {
2712 0           $cf = $ps->{pr}->{pdf};
2713 0           $fc = {};
2714             }
2715              
2716             # As a special case we handle fonts with 'names' like
2717             # pdf.font.foo and map these to the corresponding font
2718             # in the pdf.fonts structure.
2719 0 0         if ( $family =~ /^pdf\.fonts\.(.*)/ ) {
2720 0           my $try = $ps->{fonts}->{$1};
2721 0 0         if ( $try ) {
2722             warn("SVG: Font $family found in config: ",
2723             $try->{_ff}, "\n")
2724 0 0         if $config->{debug}->{svg};
2725             # The font may change during the run, so we do not
2726             # cache it.
2727 0           return $try->{fd}->{font};
2728             }
2729             }
2730              
2731 0     0     local *Text::Layout::FontConfig::_fallback = sub { 0 };
  0            
2732              
2733 0   0       my $font = $fc->{$key} //= do {
2734              
2735 0           my $t;
2736             my $try =
2737 0           eval {
2738 0           $t = Text::Layout::FontConfig->find_font( $family, $stl, $weight );
2739 0           $t->get_font($ps->{pr}->{layout}->copy);
2740             };
2741 0 0         if ( $try ) {
2742             warn("SVG: Font $key found in font config: ",
2743             $t->{loader_data},
2744             "\n")
2745 0 0         if $config->{debug}->{svg};
2746 0           $try;
2747             }
2748             else {
2749 0           return;
2750             }
2751             };
2752              
2753 0           return $font;
2754             }
2755              
2756             # Text handler for SVG embedding.
2757             sub svg_texthandler {
2758 0     0 0   my ( $ps, $svg, %args ) = @_;
2759 0           my $xo = delete($args{xo});
2760 0           my $pdf = delete($args{pdf});
2761 0           my $style = delete($args{style});
2762 0           my $text = delete($args{text});
2763 0           my %opts = %args;
2764              
2765 0           my @t = split( /([♯♭])/, $text );
2766 0 0         if ( @t == 1 ) {
2767             # Nothing special.
2768 0           $svg->set_font( $xo, $style );
2769 0           return $xo->text( $text, %opts );
2770             }
2771              
2772 0           my ( $font, $sz ) = $svg->root->fontmanager->find_font($style);
2773 0           my $has_sharp = $font->glyphByUni(ord("♯")) ne ".notdef";
2774 0           my $has_flat = $font->glyphByUni(ord("♭")) ne ".notdef";
2775             # For convenience we assume that either both are available, or missing.
2776              
2777 0 0 0       if ( $has_sharp && $has_flat ) {
2778             # Nothing special.
2779 0           $xo->font( $font, $sz );
2780 0           return $xo->text( $text, %opts );
2781             }
2782              
2783             # Replace the sharp and flat glyphs by glyps from the chordfingers font.
2784 0           my $d = 0;
2785 0           my $this = 0;
2786 0           while ( @t ) {
2787 0           my $text = shift(@t);
2788 0           my $fs = shift(@t);
2789 0 0         $xo->font( $font, $sz ) unless $this eq $font;
2790 0           $d += $xo->text($text);
2791 0           $this = $font;
2792 0 0         next unless $fs;
2793 0           $xo->font( $ps->{fonts}->{chordprosymbols}->{fd}->{font}, $sz );
2794 0           $this = 0;
2795 0 0         $d += $xo->text( $fs eq '♭' ? '!' : '#' );
2796             }
2797 0           return $d;
2798             }
2799              
2800             1;