File Coverage

blib/lib/ChordPro/Output/PDF.pm
Criterion Covered Total %
statement 743 1646 45.1
branch 256 850 30.1
condition 92 411 22.3
subroutine 48 78 61.5
pod 0 41 0.0
total 1139 3026 37.6


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