| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | #!/usr/bin/perl | 
| 2 |  |  |  |  |  |  |  | 
| 3 |  |  |  |  |  |  | package main; | 
| 4 |  |  |  |  |  |  |  | 
| 5 | 10 |  |  | 10 |  | 3374 | use utf8; | 
|  | 10 |  |  |  |  | 32 |  | 
|  | 10 |  |  |  |  | 87 |  | 
| 6 |  |  |  |  |  |  | our $config; | 
| 7 |  |  |  |  |  |  | our $options; | 
| 8 |  |  |  |  |  |  |  | 
| 9 |  |  |  |  |  |  | package ChordPro::Output::PDF; | 
| 10 |  |  |  |  |  |  |  | 
| 11 | 10 |  |  | 10 |  | 738 | use strict; | 
|  | 10 |  |  |  |  | 22 |  | 
|  | 10 |  |  |  |  | 432 |  | 
| 12 | 10 |  |  | 10 |  | 79 | use warnings; | 
|  | 10 |  |  |  |  | 22 |  | 
|  | 10 |  |  |  |  | 434 |  | 
| 13 | 10 |  |  | 10 |  | 80 | use Encode qw( encode_utf8 ); | 
|  | 10 |  |  |  |  | 29 |  | 
|  | 10 |  |  |  |  | 710 |  | 
| 14 | 10 |  |  | 10 |  | 94 | use App::Packager; | 
|  | 10 |  |  |  |  | 24 |  | 
|  | 10 |  |  |  |  | 128 |  | 
| 15 | 10 |  |  | 10 |  | 9978 | use File::Temp (); | 
|  | 10 |  |  |  |  | 196894 |  | 
|  | 10 |  |  |  |  | 340 |  | 
| 16 | 10 |  |  | 10 |  | 97 | use Storable qw(dclone); | 
|  | 10 |  |  |  |  | 23 |  | 
|  | 10 |  |  |  |  | 615 |  | 
| 17 | 10 |  |  | 10 |  | 71 | use List::Util qw(any); | 
|  | 10 |  |  |  |  | 22 |  | 
|  | 10 |  |  |  |  | 624 |  | 
| 18 | 10 |  |  | 10 |  | 68 | use Carp; | 
|  | 10 |  |  |  |  | 27 |  | 
|  | 10 |  |  |  |  | 550 |  | 
| 19 | 10 |  |  | 10 |  | 70 | use feature 'state'; | 
|  | 10 |  |  |  |  | 25 |  | 
|  | 10 |  |  |  |  | 981 |  | 
| 20 |  |  |  |  |  |  |  | 
| 21 |  |  |  |  |  |  | use ChordPro::Output::Common | 
| 22 | 10 |  |  | 10 |  | 86 | qw( roman prep_outlines fmt_subst ); | 
|  | 10 |  |  |  |  | 23 |  | 
|  | 10 |  |  |  |  | 794 |  | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 10 |  |  | 10 |  | 4421 | use ChordPro::Output::PDF::Writer; | 
|  | 10 |  |  |  |  | 35 |  | 
|  | 10 |  |  |  |  | 492 |  | 
| 25 | 10 |  |  | 10 |  | 80 | use ChordPro::Utils; | 
|  | 10 |  |  |  |  | 24 |  | 
|  | 10 |  |  |  |  | 1237 |  | 
| 26 |  |  |  |  |  |  |  | 
| 27 |  |  |  |  |  |  | my $pdfapi; | 
| 28 |  |  |  |  |  |  |  | 
| 29 | 10 |  |  | 10 |  | 88 | use Text::Layout; | 
|  | 10 |  |  |  |  | 25 |  | 
|  | 10 |  |  |  |  | 255 |  | 
| 30 | 10 |  |  | 10 |  | 73 | use String::Interpolate::Named; | 
|  | 10 |  |  |  |  | 28 |  | 
|  | 10 |  |  |  |  | 29636 |  | 
| 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 | 45 | my ( $self, $sb ) = @_; | 
| 41 |  |  |  |  |  |  |  | 
| 42 | 8 | 50 |  |  |  | 50 | return [] unless $sb->{songs}->[0]->{body}; # no songs | 
| 43 | 8 |  | 33 |  |  | 63 | $verbose ||= $options->{verbose}; | 
| 44 |  |  |  |  |  |  |  | 
| 45 | 8 |  |  |  |  | 27 | my $ps = $config->{pdf}; | 
| 46 |  |  |  |  |  |  |  | 
| 47 | 8 |  |  |  |  | 143 | my $pr = (__PACKAGE__."::Writer")->new( $ps, $pdfapi ); | 
| 48 | 8 | 50 | 0 |  |  | 69 | warn("Generating PDF ", $options->{output} || "__new__.pdf", "...\n") if $options->{verbose}; | 
| 49 |  |  |  |  |  |  |  | 
| 50 | 8 |  |  |  |  | 65 | my $name = ::runtimeinfo("short"); | 
| 51 | 8 | 50 |  |  |  | 39 | $name =~ s/version.*/regression testing/ if $regtest; | 
| 52 | 8 |  |  |  |  | 109 | my %info = ( Title => $sb->{songs}->[0]->{meta}->{title}->[0], | 
| 53 |  |  |  |  |  |  | Creator => $name ); | 
| 54 | 8 |  |  |  |  | 30 | while ( my ( $k, $v ) = each %{ $ps->{info} } ) { | 
|  | 40 |  |  |  |  | 2162 |  | 
| 55 | 32 | 100 | 66 |  |  | 171 | next unless defined($v) && $v ne ""; | 
| 56 | 8 |  |  |  |  | 80 | $info{ucfirst($k)} = fmt_subst( $sb->{songs}->[0], $v ); | 
| 57 |  |  |  |  |  |  | } | 
| 58 | 8 |  |  |  |  | 99 | $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 |  |  |  |  | 305 | my ( %start_of, %pages_of ); | 
| 66 | 8 |  |  |  |  | 42 | for ( qw( front toc songbook back ) ) { | 
| 67 | 32 |  |  |  |  | 76 | $start_of{$_} = 1; | 
| 68 | 32 |  |  |  |  | 62 | $pages_of{$_} = 0; | 
| 69 |  |  |  |  |  |  | } | 
| 70 |  |  |  |  |  |  |  | 
| 71 |  |  |  |  |  |  | # The songbook... | 
| 72 | 8 |  |  |  |  | 19 | my @book; | 
| 73 | 8 |  | 50 |  |  | 75 | my $page = $options->{"start-page-number"} ||= 1; | 
| 74 |  |  |  |  |  |  |  | 
| 75 | 8 | 50 | 66 |  |  | 132 | 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 |  |  |  |  | 67 | my $first_song_aligned; | 
| 80 |  |  |  |  |  |  | my $songindex; | 
| 81 | 8 |  |  |  |  | 31 | foreach my $song ( @{$sb->{songs}} ) { | 
|  | 8 |  |  |  |  | 47 |  | 
| 82 | 24 |  |  |  |  | 66 | $songindex++; | 
| 83 |  |  |  |  |  |  |  | 
| 84 |  |  |  |  |  |  | # Align. | 
| 85 | 24 | 100 | 100 |  |  | 234 | if ( $ps->{'pagealign-songs'} && !($page % 2) ) { | 
| 86 | 10 |  |  |  |  | 81 | $pr->newpage($ps, $page); | 
| 87 | 10 |  |  |  |  | 30 | $page++; | 
| 88 | 10 |  | 50 |  |  | 42 | $first_song_aligned //= 1; | 
| 89 |  |  |  |  |  |  | } | 
| 90 | 24 |  | 100 |  |  | 128 | $first_song_aligned //= 0; | 
| 91 |  |  |  |  |  |  |  | 
| 92 | 24 |  |  |  |  | 100 | $song->{meta}->{tocpage} = $page; | 
| 93 | 24 |  |  |  |  | 130 | 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 |  |  |  |  | 141 | numsongs  => scalar(@{$sb->{songs}}), | 
|  | 24 |  |  |  |  | 185 |  | 
| 100 |  |  |  |  |  |  | } ); | 
| 101 |  |  |  |  |  |  | # Easy access to toc page. | 
| 102 | 24 |  |  |  |  | 239 | $song->{meta}->{page} = $song->{meta}->{tocpage}; | 
| 103 |  |  |  |  |  |  | } | 
| 104 | 8 |  |  |  |  | 58 | $pages_of{songbook} = $page - 1; | 
| 105 | 8 |  |  |  |  | 34 | $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 |  |  | 57 | line => $::config->{toc}->{line} } ]; | 
| 113 |  |  |  |  |  |  |  | 
| 114 | 8 |  |  |  |  | 27 | foreach my $ctl ( reverse( @{ $::config->{contents} } ) ) { | 
|  | 8 |  |  |  |  | 42 |  | 
| 115 | 24 | 50 | 33 |  |  | 242 | next unless $options->{toc} // @book > 1; | 
| 116 |  |  |  |  |  |  |  | 
| 117 | 24 |  |  |  |  | 71 | for ( qw( fields label line pageno ) ) { | 
| 118 | 96 | 50 |  |  |  | 276 | next if exists $ctl->{$_}; | 
| 119 | 0 |  |  |  |  | 0 | die("Config error: \"contents\" is missing \"$_\"\n"); | 
| 120 |  |  |  |  |  |  | } | 
| 121 | 24 | 100 |  |  |  | 146 | next if $ctl->{omit}; | 
| 122 |  |  |  |  |  |  |  | 
| 123 | 16 |  |  |  |  | 178 | my $book = prep_outlines( [ map { $_->[1] } @book ], $ctl ); | 
|  | 48 |  |  |  |  | 180 |  | 
| 124 |  |  |  |  |  |  |  | 
| 125 |  |  |  |  |  |  | # Create a pseudo-song for the table of contents. | 
| 126 | 16 |  |  |  |  | 68 | my $t = $ctl->{label}; | 
| 127 | 16 |  |  |  |  | 60 | my $l = $ctl->{line}; | 
| 128 | 16 |  |  |  |  | 60 | my $start = $start_of{songbook} - $options->{"start-page-number"}; | 
| 129 | 16 |  |  |  |  | 37 | my $pgtpl = $ctl->{pageno}; | 
| 130 |  |  |  |  |  |  | my $song = | 
| 131 |  |  |  |  |  |  | { title     => $t, | 
| 132 |  |  |  |  |  |  | meta => { title => [ $t ] }, | 
| 133 |  |  |  |  |  |  | structure => "linear", | 
| 134 |  |  |  |  |  |  | body      => [ | 
| 135 | 16 |  |  |  |  | 75 | map { +{ type    => "tocline", | 
| 136 |  |  |  |  |  |  | context => "toc", | 
| 137 |  |  |  |  |  |  | title   => fmt_subst( $_->[-1], $l ), | 
| 138 | 48 |  |  |  |  | 6238 | 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 |  |  |  |  | 3369 | $page = generate_song( $song, | 
| 146 |  |  |  |  |  |  | { pr => $pr, prepend => 1, roman => 1, | 
| 147 |  |  |  |  |  |  | startpage => 1, | 
| 148 |  |  |  |  |  |  | songindex => 1, numsongs => 1, | 
| 149 |  |  |  |  |  |  | } ); | 
| 150 | 16 |  |  |  |  | 95 | $pages_of{toc} += $page; | 
| 151 |  |  |  |  |  |  | #### TODO: This is not correct if there are more TOCs. | 
| 152 | 16 | 50 |  |  |  | 71 | $pages_of{toc}++ if $first_song_aligned; | 
| 153 |  |  |  |  |  |  |  | 
| 154 |  |  |  |  |  |  | # Align. | 
| 155 | 16 | 50 | 66 |  |  | 151 | if ( $ps->{'even-odd-pages'} && $page % 2 && !$first_song_aligned ) { | 
|  |  |  | 66 |  |  |  |  | 
| 156 | 12 |  |  |  |  | 78 | $pr->newpage($ps, $page+1); | 
| 157 | 12 |  |  |  |  | 43 | $page++; | 
| 158 |  |  |  |  |  |  | } | 
| 159 | 16 |  |  |  |  | 53 | $start_of{songbook} += $page; | 
| 160 | 16 |  |  |  |  | 203 | $start_of{back}     += $page; | 
| 161 |  |  |  |  |  |  | } | 
| 162 |  |  |  |  |  |  |  | 
| 163 | 8 | 100 |  |  |  | 81 | if ( $ps->{'front-matter'} ) { | 
| 164 | 3 |  |  |  |  | 17 | $page = 1; | 
| 165 | 3 |  |  |  |  | 24 | my $matter = $pdfapi->open( expand_tilde($ps->{'front-matter'}) ); | 
| 166 | 3 | 50 |  |  |  | 26561 | die("Missing front matter: ", $ps->{'front-matter'}, "\n") unless $matter; | 
| 167 | 3 |  |  |  |  | 22 | for ( 1 .. $matter->pages ) { | 
| 168 | 3 |  |  |  |  | 54 | $pr->{pdf}->import_page( $matter, $_, $_ ); | 
| 169 | 3 |  |  |  |  | 26016 | $page++; | 
| 170 |  |  |  |  |  |  | } | 
| 171 | 3 |  |  |  |  | 19 | $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 |  |  | 60 | if $ps->{'even-odd-pages'} && !($page % 2); | 
| 177 |  |  |  |  |  |  |  | 
| 178 | 3 |  |  |  |  | 25 | $start_of{toc}      += $page - 1; | 
| 179 | 3 |  |  |  |  | 12 | $start_of{songbook} += $page - 1; | 
| 180 | 3 |  |  |  |  | 261 | $start_of{back}     += $page - 1; | 
| 181 |  |  |  |  |  |  | } | 
| 182 |  |  |  |  |  |  |  | 
| 183 | 8 | 100 |  |  |  | 79 | if ( $ps->{'back-matter'} ) { | 
| 184 | 3 |  |  |  |  | 27 | my $matter = $pdfapi->open( expand_tilde($ps->{'back-matter'}) ); | 
| 185 | 3 | 50 |  |  |  | 21522 | die("Missing back matter: ", $ps->{'back-matter'}, "\n") unless $matter; | 
| 186 | 3 |  |  |  |  | 15 | $page = $start_of{back}; | 
| 187 |  |  |  |  |  |  | $pr->newpage($ps), $page++, $start_of{back}++ | 
| 188 | 3 | 50 | 33 |  |  | 68 | if $ps->{'even-odd-pages'} && ($page % 2); | 
| 189 | 3 |  |  |  |  | 18 | for ( 1 .. $matter->pages ) { | 
| 190 | 3 |  |  |  |  | 52 | $pr->{pdf}->import_page( $matter, $_, $page ); | 
| 191 | 3 |  |  |  |  | 21796 | $page++; | 
| 192 |  |  |  |  |  |  | } | 
| 193 | 3 |  |  |  |  | 15 | $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 |  |  |  | 290 | if $pages_of{front}; | 
| 201 |  |  |  |  |  |  | $pr->pagelabel( $start_of{toc}-1,      'roman'            ) | 
| 202 | 8 | 50 |  |  |  | 607 | if $pages_of{toc}; | 
| 203 |  |  |  |  |  |  | $pr->pagelabel( $start_of{songbook}-1, 'arabic'           ) | 
| 204 | 8 | 50 |  |  |  | 1172 | if $pages_of{songbook}; | 
| 205 |  |  |  |  |  |  | $pr->pagelabel( $start_of{back}-1,     'arabic', 'back-'  ) | 
| 206 | 8 | 100 |  |  |  | 836 | if $pages_of{back}; | 
| 207 |  |  |  |  |  |  |  | 
| 208 |  |  |  |  |  |  | # Add the outlines. | 
| 209 | 8 |  |  |  |  | 368 | $pr->make_outlines( [ map { $_->[1] } @book ], $start_of{songbook} ); | 
|  | 24 |  |  |  |  | 123 |  | 
| 210 |  |  |  |  |  |  |  | 
| 211 | 8 |  | 50 |  |  | 1030 | $pr->finish( $options->{output} || "__new__.pdf" ); | 
| 212 | 8 | 50 |  |  |  | 697390 | warn("Generated PDF...\n") if $options->{verbose}; | 
| 213 |  |  |  |  |  |  |  | 
| 214 |  |  |  |  |  |  | generate_csv( \@book, $page, \%pages_of, \%start_of ) | 
| 215 | 8 | 50 |  |  |  | 104 | if $options->{csv}; | 
| 216 |  |  |  |  |  |  |  | 
| 217 | 8 | 50 |  |  |  | 59 | _dump($ps) if $verbose; | 
| 218 |  |  |  |  |  |  |  | 
| 219 | 8 |  |  |  |  | 133 | [] | 
| 220 |  |  |  |  |  |  | } | 
| 221 |  |  |  |  |  |  |  | 
| 222 |  |  |  |  |  |  | sub generate_csv { | 
| 223 | 8 |  |  | 8 | 0 | 44 | my ( $book, $page, $pages_of, $start_of ) = @_; | 
| 224 |  |  |  |  |  |  |  | 
| 225 |  |  |  |  |  |  | # Create an MSPro compatible CSV for this PDF. | 
| 226 | 8 |  |  |  |  | 57 | push( @$book, [ "CSV", { meta => { tocpage => $page } } ] ); | 
| 227 | 8 |  |  |  |  | 105 | ( my $csv = $options->{output} ) =~ s/\.pdf$/.csv/i; | 
| 228 | 8 | 50 |  |  |  | 115 | 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 |  |  | 1268 | if  $config->{debug}->{csv} || $options->{verbose}; | 
| 233 |  |  |  |  |  |  |  | 
| 234 | 8 |  |  |  |  | 40 | my $ps = $config->{pdf}; | 
| 235 | 8 |  |  |  |  | 39 | my $ctl = $ps->{csv}; | 
| 236 | 8 |  | 50 |  |  | 132 | my $sep = $ctl->{separator} // ";"; | 
| 237 | 8 |  | 50 |  |  | 56 | my $vsep = $ctl->{vseparator} // "|"; | 
| 238 |  |  |  |  |  |  |  | 
| 239 |  |  |  |  |  |  | my $rfc4180 = sub { | 
| 240 | 328 |  |  | 328 |  | 46987 | my ( $v ) = @_; | 
| 241 | 328 | 50 |  |  |  | 1085 | $v = [$v] unless ref($v) eq 'ARRAY'; | 
| 242 | 328 | 50 | 33 |  |  | 1428 | return "" unless defined($v) && defined($v->[0]); | 
| 243 | 328 |  |  |  |  | 822 | $v = join( $sep, @$v ); | 
| 244 | 328 | 50 |  |  |  | 4624 | return $v unless $v =~ m/[$sep"\n\r]/s; | 
| 245 | 0 |  |  |  |  | 0 | $v =~ s/"/""/g; | 
| 246 | 0 |  |  |  |  | 0 | return '"' . $v . '"'; | 
| 247 | 8 |  |  |  |  | 73 | }; | 
| 248 |  |  |  |  |  |  |  | 
| 249 |  |  |  |  |  |  | my $pagerange = sub { | 
| 250 | 33 |  |  | 33 |  | 90 | my ( $pages, $page ) = @_; | 
| 251 | 33 | 100 |  |  |  | 108 | if ( @_ == 1 ) { | 
| 252 | 9 |  |  |  |  | 24 | $pages = $pages_of->{$_[0]}; | 
| 253 | 9 |  |  |  |  | 23 | $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 |  |  |  |  | 69 | my @cols = (); | 
| 263 | 33 |  |  |  |  | 58 | for ( @{ $ctl->{fields} } ) { | 
|  | 33 |  |  |  |  | 99 |  | 
| 264 | 297 | 100 |  |  |  | 931 | next if $_->{omit}; | 
| 265 | 264 |  | 33 |  |  | 1124 | my $v = $_->{value} // '%{'.$_->{meta}.'}'; | 
| 266 | 264 |  |  |  |  | 819 | local( $config->{metadata}->{separator} ) = $vsep; | 
| 267 | 264 |  |  |  |  | 1033 | push( @cols, $rfc4180->( fmt_subst( { meta => $m }, $v ) ) ); | 
| 268 |  |  |  |  |  |  | } | 
| 269 | 33 |  |  |  |  | 511 | print $fd ( join( $sep, @cols ), "\n" ); | 
| 270 | 33 |  |  |  |  | 234 | scalar(@cols); | 
| 271 | 8 |  |  |  |  | 50 | }; | 
| 272 |  |  |  |  |  |  |  | 
| 273 | 8 |  |  |  |  | 29 | my @cols; | 
| 274 |  |  |  |  |  |  | my $ncols; | 
| 275 | 8 |  |  |  |  | 24 | for ( @{ $ctl->{fields} } ) { | 
|  | 8 |  |  |  |  | 49 |  | 
| 276 | 72 | 100 |  |  |  | 271 | next if $_->{omit}; | 
| 277 | 64 |  |  |  |  | 150 | push( @cols, $rfc4180->($_->{name}) ); | 
| 278 |  |  |  |  |  |  | } | 
| 279 | 8 |  |  |  |  | 120 | $ncols = @cols; | 
| 280 |  |  |  |  |  |  | #warn( "CSV: $ncols fields\n" ); | 
| 281 | 8 |  |  |  |  | 386 | print $fd ( join( $sep, @cols ), "\n" ); | 
| 282 |  |  |  |  |  |  |  | 
| 283 | 8 | 100 |  |  |  | 48 | unless ( $ctl->{songsonly} ) { | 
| 284 |  |  |  |  |  |  | $csvline->( { title     => '__front_matter__', | 
| 285 |  |  |  |  |  |  | pagerange => $pagerange->("front"), | 
| 286 |  |  |  |  |  |  | sorttitle => 'Front Matter', | 
| 287 |  |  |  |  |  |  | artist    => 'ChordPro' } ) | 
| 288 | 3 | 50 |  |  |  | 23 | 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 |  |  |  | 30 | if $pages_of->{toc}; | 
| 294 |  |  |  |  |  |  | } | 
| 295 |  |  |  |  |  |  |  | 
| 296 |  |  |  |  |  |  | warn( "CSV: ", scalar(@$book), " songs in book\n") | 
| 297 | 8 | 50 |  |  |  | 131 | if $config->{debug}->{csv}; | 
| 298 | 8 |  |  |  |  | 58 | for ( my $p = 0; $p < @$book-1; $p++ ) { | 
| 299 | 24 |  |  |  |  | 53 | my ( $title, $song ) = @{$book->[$p]}; | 
|  | 24 |  |  |  |  | 87 |  | 
| 300 |  |  |  |  |  |  | my $page = $start_of->{songbook} + $song->{meta}->{tocpage} | 
| 301 | 24 |  | 50 |  |  | 147 | - ($options->{"start-page-number"} || 1); | 
| 302 | 24 |  |  |  |  | 68 | my $pp = $song->{meta}->{pages}; | 
| 303 | 24 |  |  |  |  | 49 | my $m = { %{$song->{meta}}, | 
|  | 24 |  |  |  |  | 162 |  | 
| 304 |  |  |  |  |  |  | pagerange => [ $pagerange->($pp, $page) ] }; | 
| 305 | 24 |  |  |  |  | 91 | $csvline->($m); | 
| 306 |  |  |  |  |  |  | } | 
| 307 |  |  |  |  |  |  |  | 
| 308 | 8 | 100 |  |  |  | 60 | unless ( $ctl->{songsonly} ) { | 
| 309 |  |  |  |  |  |  | $csvline->( { title     => '__back_matter__', | 
| 310 |  |  |  |  |  |  | pagerange => $pagerange->("back"), | 
| 311 |  |  |  |  |  |  | sorttitle => 'Back Matter', | 
| 312 |  |  |  |  |  |  | artist    => 'ChordPro'} ) | 
| 313 | 3 | 50 |  |  |  | 25 | if $pages_of->{back}; | 
| 314 |  |  |  |  |  |  | } | 
| 315 | 8 |  |  |  |  | 480 | close($fd); | 
| 316 |  |  |  |  |  |  | warn("Generated CSV...\n") | 
| 317 | 8 | 50 | 33 |  |  | 330 | 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 |  | 114 | use constant SIZE_ITEMS => [ qw (chord text tab grid diagram toc title footer) ]; | 
|  | 10 |  |  |  |  | 35 |  | 
|  | 10 |  |  |  |  | 166603 |  | 
| 334 |  |  |  |  |  |  |  | 
| 335 |  |  |  |  |  |  | sub generate_song { | 
| 336 | 40 |  |  | 40 | 0 | 134 | my ( $s, $opts ) = @_; | 
| 337 |  |  |  |  |  |  |  | 
| 338 | 40 |  |  |  |  | 108 | my $pr = $opts->{pr}; | 
| 339 |  |  |  |  |  |  |  | 
| 340 | 40 | 50 |  |  |  | 166 | 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 |  |  | 66271 | local $config = dclone( $s->{config} // $config ); | 
| 356 |  |  |  |  |  |  |  | 
| 357 | 40 |  |  |  |  | 256 | $source = $s->{source}; | 
| 358 | 40 |  | 50 |  |  | 336 | $assets = $s->{assets} || {}; | 
| 359 |  |  |  |  |  |  |  | 
| 360 | 40 |  |  |  |  | 125 | $suppress_empty_chordsline = $::config->{settings}->{'suppress-empty-chords'}; | 
| 361 | 40 |  |  |  |  | 189 | $suppress_empty_lyricsline = $::config->{settings}->{'suppress-empty-lyrics'}; | 
| 362 | 40 |  |  |  |  | 113 | $inlinechords = $::config->{settings}->{'inline-chords'}; | 
| 363 | 40 |  |  |  |  | 133 | $inlineannots = $::config->{settings}->{'inline-annotations'}; | 
| 364 | 40 |  |  |  |  | 98 | $chordsunder  = $::config->{settings}->{'chords-under'}; | 
| 365 | 40 |  |  |  |  | 270 | my $ps = $::config->clone->{pdf}; | 
| 366 | 40 |  |  |  |  | 5024 | $ps->{pr} = $pr; | 
| 367 | 40 |  |  |  |  | 180 | $pr->{ps} = $ps; | 
| 368 | 40 |  |  |  |  | 130 | $ps->{_s} = $s; | 
| 369 | 40 |  |  |  |  | 412 | $pr->{_df} = {}; | 
| 370 |  |  |  |  |  |  | #    warn("X1: ", $ps->{fonts}->{$_}->{size}, "\n") for "text"; | 
| 371 | 40 |  |  |  |  | 296 | $pr->init_fonts(); | 
| 372 | 40 |  |  |  |  | 119 | my $fonts = $ps->{fonts}; | 
| 373 | 40 |  |  |  |  | 157 | $pr->{_df}->{$_} = { %{$fonts->{$_}} } for qw( text chord grid toc tab ); | 
|  | 200 |  |  |  |  | 1072 |  | 
| 374 |  |  |  |  |  |  | #    warn("X2: ", $pr->{_df}->{$_}->{size}, "\n") for "text"; | 
| 375 |  |  |  |  |  |  |  | 
| 376 | 40 |  | 50 |  |  | 414 | $structured = ( $options->{'backend-option'}->{structure} // '' ) eq 'structured'; | 
| 377 | 40 | 50 |  |  |  | 129 | $s->structurize if $structured; | 
| 378 |  |  |  |  |  |  |  | 
| 379 |  |  |  |  |  |  | # Diagrams drawer. | 
| 380 | 40 |  |  |  |  | 114 | my $dd; | 
| 381 |  |  |  |  |  |  | my $dctl; | 
| 382 | 40 | 50 |  |  |  | 172 | 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 |  |  |  |  | 4987 | require ChordPro::Output::PDF::StringDiagrams; | 
| 389 | 40 |  |  |  |  | 310 | $dd = ChordPro::Output::PDF::StringDiagrams->new($ps); | 
| 390 | 40 |  |  |  |  | 141 | $dctl = $ps->{diagrams}; | 
| 391 |  |  |  |  |  |  | } | 
| 392 |  |  |  |  |  |  | $dctl->{show} = $s->{settings}->{diagrampos} | 
| 393 | 40 | 50 |  |  |  | 222 | if defined $s->{settings}->{diagrampos}; | 
| 394 | 40 |  |  |  |  | 125 | $ps->{dd} = $dd; | 
| 395 | 40 |  |  |  |  | 103 | my $sb = $s->{body}; | 
| 396 |  |  |  |  |  |  |  | 
| 397 |  |  |  |  |  |  | # set_columns needs these, set provisional values. | 
| 398 | 40 |  |  |  |  | 130 | $ps->{_leftmargin}  = $ps->{marginleft}; | 
| 399 | 40 |  |  |  |  | 101 | $ps->{_rightmargin} = $ps->{marginright}; | 
| 400 |  |  |  |  |  |  | set_columns( $ps, | 
| 401 | 40 |  | 33 |  |  | 364 | $s->{settings}->{columns} || $::config->{settings}->{columns} ); | 
| 402 |  |  |  |  |  |  |  | 
| 403 | 40 |  |  |  |  | 94 | $chordscol    = $ps->{chordscolumn}; | 
| 404 | 40 |  |  |  |  | 191 | $lyrics_only  = $::config->{settings}->{'lyrics-only'}; | 
| 405 | 40 |  |  |  |  | 116 | $chordscapo   = $s->{meta}->{capo}; | 
| 406 |  |  |  |  |  |  |  | 
| 407 | 40 |  |  |  |  | 87 | my $fail; | 
| 408 | 40 |  |  |  |  | 90 | for my $item ( @{ SIZE_ITEMS() } ) { | 
|  | 40 |  |  |  |  | 139 |  | 
| 409 | 320 |  |  |  |  | 838 | for ( $options->{"$item-font"} ) { | 
| 410 | 320 | 50 |  |  |  | 640 | 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 |  |  |  |  | 706 | for ( $options->{"$item-size"} ) { | 
| 426 | 320 | 50 |  |  |  | 654 | next unless $_; | 
| 427 | 0 |  |  |  |  | 0 | $fonts->{$item}->{size} = $_; | 
| 428 |  |  |  |  |  |  | } | 
| 429 |  |  |  |  |  |  | } | 
| 430 | 40 | 50 |  |  |  | 202 | die("Unhandled fonts detected -- aborted\n") if $fail; | 
| 431 |  |  |  |  |  |  |  | 
| 432 | 40 | 50 |  |  |  | 237 | if ( $ps->{labels}->{comment} ) { | 
|  |  | 50 |  |  |  |  |  | 
| 433 | 0 |  |  |  |  | 0 | $ps->{_indent} = 0; | 
| 434 |  |  |  |  |  |  | } | 
| 435 |  |  |  |  |  |  | elsif ( $ps->{labels}->{width} eq "auto" ) { | 
| 436 | 40 | 50 | 33 |  |  | 181 | 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 |  |  |  |  | 121 | $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 |  | 152 | $ps->{lineheight} = $fonts->{text}->{size} - 1; # chordii | 
| 458 | 40 |  |  |  |  | 118 | $ps->{chordheight} = $fonts->{chord}->{size}; | 
| 459 | 40 |  |  |  |  | 225 | }; | 
| 460 | 40 |  |  |  |  | 138 | $set_sizes->(); | 
| 461 | 40 |  |  |  |  | 123 | $ps->{'vertical-space'} = $options->{'vertical-space'}; | 
| 462 | 40 |  |  |  |  | 87 | for ( @{ SIZE_ITEMS() } ) { | 
|  | 40 |  |  |  |  | 126 |  | 
| 463 | 320 |  |  |  |  | 656 | $fonts->{$_}->{_size} = $fonts->{$_}->{size}; | 
| 464 |  |  |  |  |  |  | } | 
| 465 |  |  |  |  |  |  |  | 
| 466 | 40 |  |  |  |  | 138 | my $x; | 
| 467 | 40 |  |  |  |  | 166 | my $y = $ps->{papersize}->[1] - $ps->{margintop}; | 
| 468 |  |  |  |  |  |  |  | 
| 469 | 40 | 50 |  |  |  | 181 | $ps->{'even-odd-pages'} =  1 if $options->{'even-pages-number-left'}; | 
| 470 | 40 | 50 |  |  |  | 147 | $ps->{'even-odd-pages'} = -1 if $options->{'odd-pages-number-left'}; | 
| 471 |  |  |  |  |  |  |  | 
| 472 | 40 |  | 33 |  |  | 261 | my $st = $s->{settings}->{titles} || $::config->{settings}->{titles}; | 
| 473 | 40 | 50 | 33 |  |  | 350 | 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 |  |  |  |  | 544 | }; | 
| 495 |  |  |  |  |  |  |  | 
| 496 | 40 | 50 |  |  |  | 161 | if ( $st eq "left" ) { | 
| 497 | 0 |  |  |  |  | 0 | $swap->(0,1); | 
| 498 |  |  |  |  |  |  | } | 
| 499 | 40 | 50 |  |  |  | 634 | 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 |  |  |  |  | 186 | }; | 
| 518 |  |  |  |  |  |  |  | 
| 519 | 40 |  |  |  |  | 83 | my $col; | 
| 520 |  |  |  |  |  |  |  | 
| 521 |  |  |  |  |  |  | my $col_adjust = sub { | 
| 522 | 42 | 50 |  | 42 |  | 144 | if ( $ps->{columns} <= 1 ) { | 
| 523 |  |  |  |  |  |  | warn("L=", $ps->{__leftmargin}, | 
| 524 |  |  |  |  |  |  | ", R=", $ps->{__rightmargin}, | 
| 525 | 42 | 50 |  |  |  | 169 | "\n") if $config->{debug}->{spacing}; | 
| 526 | 42 |  |  |  |  | 100 | 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 |  |  |  |  | 223 | }; | 
| 541 |  |  |  |  |  |  |  | 
| 542 | 40 |  |  |  |  | 95 | my $vsp_ignorefirst; | 
| 543 | 40 |  | 50 |  |  | 195 | my $startpage = $opts->{startpage} || 1; | 
| 544 | 40 |  |  |  |  | 100 | my $thispage = $startpage - 1; | 
| 545 | 40 |  |  |  |  | 73 | my $spreadimage; | 
| 546 |  |  |  |  |  |  |  | 
| 547 |  |  |  |  |  |  | # Physical newpage handler. | 
| 548 |  |  |  |  |  |  | my $newpage = sub { | 
| 549 |  |  |  |  |  |  |  | 
| 550 |  |  |  |  |  |  | # Add page to the PDF. | 
| 551 | 42 | 100 |  | 42 |  | 342 | $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 |  |  |  |  | 108 | my $rightpage = 1; | 
| 558 | 42 | 100 |  |  |  | 203 | if ( $ps->{"even-odd-pages"} ) { | 
| 559 |  |  |  |  |  |  | # Even/odd printing... | 
| 560 | 32 |  |  |  |  | 107 | $rightpage = $thispage % 2 == 0; | 
| 561 |  |  |  |  |  |  | # Odd/even printing... | 
| 562 | 32 | 100 |  |  |  | 137 | $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 |  |  |  | 125 | if ( $rightpage ) { | 
| 569 | 34 |  |  |  |  | 83 | $ps->{_leftmargin}  = $ps->{marginleft}; | 
| 570 | 34 |  |  |  |  | 91 | $ps->{_marginleft}  = $ps->{marginleft}; | 
| 571 | 34 |  |  |  |  | 95 | $ps->{_rightmargin} = $ps->{marginright}; | 
| 572 | 34 |  |  |  |  | 124 | $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{marginright}; | 
| 573 |  |  |  |  |  |  | } | 
| 574 |  |  |  |  |  |  | else { | 
| 575 | 8 |  |  |  |  | 22 | $ps->{_leftmargin}  = $ps->{marginright}; | 
| 576 | 8 |  |  |  |  | 19 | $ps->{_marginleft}  = $ps->{marginright}; | 
| 577 | 8 |  |  |  |  | 18 | $ps->{_rightmargin} = $ps->{marginleft}; | 
| 578 | 8 |  |  |  |  | 24 | $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{marginleft}; | 
| 579 |  |  |  |  |  |  | } | 
| 580 | 42 |  |  |  |  | 130 | $ps->{_marginbottom}  = $ps->{marginbottom}; | 
| 581 | 42 |  |  |  |  | 118 | $ps->{_margintop}     = $ps->{papersize}->[1] - $ps->{margintop}; | 
| 582 | 42 |  |  |  |  | 109 | $ps->{_bottommargin}  = $ps->{marginbottom}; | 
| 583 |  |  |  |  |  |  |  | 
| 584 |  |  |  |  |  |  | # Physical coordinates; will be adjusted to columns if needed. | 
| 585 | 42 |  |  |  |  | 109 | $ps->{__leftmargin}   = $ps->{_marginleft}; | 
| 586 | 42 |  |  |  |  | 115 | $ps->{__rightmargin}  = $ps->{_marginright}; | 
| 587 | 42 |  |  |  |  | 96 | $ps->{__topmargin}    = $ps->{_margintop}; | 
| 588 | 42 |  |  |  |  | 93 | $ps->{__bottommargin} = $ps->{_marginbottom}; | 
| 589 |  |  |  |  |  |  |  | 
| 590 | 42 |  |  |  |  | 84 | $thispage++; | 
| 591 |  |  |  |  |  |  | $s->{meta}->{page} = [ $s->{page} = $opts->{roman} | 
| 592 | 42 | 100 |  |  |  | 259 | ? roman($thispage) : $thispage ]; | 
| 593 |  |  |  |  |  |  |  | 
| 594 |  |  |  |  |  |  | # Determine page class and background. | 
| 595 | 42 |  |  |  |  | 88 | my $class = 2;		# default | 
| 596 | 42 |  |  |  |  | 131 | my $bgpdf = $ps->{formats}->{default}->{background}; | 
| 597 | 42 | 100 |  |  |  | 159 | if ( $thispage == 1 ) { | 
|  |  | 100 |  |  |  |  |  | 
| 598 | 24 |  |  |  |  | 50 | $class = 0;		# very first page | 
| 599 |  |  |  |  |  |  | $bgpdf = $ps->{formats}->{first}->{background} | 
| 600 |  |  |  |  |  |  | || $ps->{formats}->{title}->{background} | 
| 601 | 24 |  | 33 |  |  | 233 | || $bgpdf; | 
| 602 |  |  |  |  |  |  | } | 
| 603 |  |  |  |  |  |  | elsif ( $thispage == $startpage ) { | 
| 604 | 16 |  |  |  |  | 33 | $class = 1;		# first of a song | 
| 605 |  |  |  |  |  |  | $bgpdf = $ps->{formats}->{title}->{background} | 
| 606 | 16 |  | 33 |  |  | 102 | || $bgpdf; | 
| 607 |  |  |  |  |  |  | } | 
| 608 | 42 | 50 |  |  |  | 150 | 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 |  |  |  |  | 91 | $x += $ps->{_indent}; | 
| 626 | 42 |  |  |  |  | 84 | $y = $ps->{_margintop}; | 
| 627 | 42 | 50 | 33 |  |  | 202 | $y += $ps->{headspace} if $ps->{'head-first-only'} && $class == 2; | 
| 628 |  |  |  |  |  |  |  | 
| 629 | 42 | 50 |  |  |  | 555 | if ( $spreadimage ) { | 
| 630 | 0 |  |  |  |  | 0 | $y -= imagespread( $spreadimage, $x, $y, $ps ); | 
| 631 | 0 |  |  |  |  | 0 | undef $spreadimage; | 
| 632 |  |  |  |  |  |  | } | 
| 633 | 42 |  |  |  |  | 105 | $ps->{_top} = $y; | 
| 634 | 42 |  |  |  |  | 80 | $col = 0; | 
| 635 | 42 |  |  |  |  | 79 | $vsp_ignorefirst = 1; | 
| 636 | 42 |  |  |  |  | 108 | $col_adjust->(); | 
| 637 | 40 |  |  |  |  | 195 | }; | 
| 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 |  | 269 | 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 |  |  |  |  | 148 | }; | 
| 656 |  |  |  |  |  |  |  | 
| 657 |  |  |  |  |  |  | my $chorddiagrams = sub { | 
| 658 | 40 |  |  | 40 |  | 110 | my ( $chords, $show, $ldisp ) = @_; | 
| 659 | 40 | 50 | 33 |  |  | 156 | return if $lyrics_only || !$dctl->{show}; | 
| 660 | 40 |  |  |  |  | 495 | my @chords; | 
| 661 |  |  |  |  |  |  | $chords = $s->{chords}->{chords} | 
| 662 | 40 | 100 | 66 |  |  | 305 | if !defined($chords) && $s->{chords}; | 
| 663 | 40 |  | 33 |  |  | 222 | $show //= $dctl->{show}; | 
| 664 | 40 | 100 |  |  |  | 592 | if ( $chords ) { | 
| 665 | 24 |  |  |  |  | 94 | for ( @$chords ) { | 
| 666 | 48 | 50 |  |  |  | 545 | if ( my $i = $s->{chordsinfo}->{$_} ) { | 
| 667 | 48 | 50 |  |  |  | 253 | 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 |  |  |  | 468 | return unless @chords; | 
| 675 |  |  |  |  |  |  |  | 
| 676 |  |  |  |  |  |  | # Determine page class. | 
| 677 | 24 |  |  |  |  | 64 | my $class = 2;		# default | 
| 678 | 24 | 100 |  |  |  | 104 | if ( $thispage == 1 ) { | 
|  |  | 50 |  |  |  |  |  | 
| 679 | 8 |  |  |  |  | 24 | $class = 0;		# very first page | 
| 680 |  |  |  |  |  |  | } | 
| 681 |  |  |  |  |  |  | elsif ( $thispage == $startpage ) { | 
| 682 | 16 |  |  |  |  | 53 | $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 |  |  | 343 | 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 |  |  |  |  | 73 | my $ww = ( $ps->{_marginright} - $ps->{_marginleft} ); | 
| 744 |  |  |  |  |  |  |  | 
| 745 |  |  |  |  |  |  | # Number of diagrams, based on minimal required interspace. | 
| 746 | 24 |  |  |  |  | 114 | my $h = int( ( $ww | 
| 747 |  |  |  |  |  |  | # Add one interspace (cuts off right) | 
| 748 |  |  |  |  |  |  | + $dd->hsp1(undef,$ps) ) | 
| 749 |  |  |  |  |  |  | / $dd->hsp(undef,$ps) ); | 
| 750 | 24 | 50 |  |  |  | 118 | die("ASSERT: $h should be greater than 0") unless $h > 0; | 
| 751 |  |  |  |  |  |  |  | 
| 752 | 24 |  |  |  |  | 98 | my $vsp = $dd->vsp( undef, $ps ); | 
| 753 | 24 |  |  |  |  | 78 | my $hsp = $dd->hsp( undef, $ps ); | 
| 754 |  |  |  |  |  |  |  | 
| 755 | 24 |  |  |  |  | 144 | my $y = $ps->{marginbottom} + (int((@chords-1)/$h) + 1) * $vsp; | 
| 756 | 24 |  |  |  |  | 59 | $ps->{_bottommargin} = $y; | 
| 757 |  |  |  |  |  |  |  | 
| 758 | 24 |  |  |  |  | 85 | $y -= $dd->vsp1( undef, $ps ); # advance height | 
| 759 |  |  |  |  |  |  |  | 
| 760 | 24 |  |  |  |  | 79 | while ( @chords ) { | 
| 761 | 24 |  |  |  |  | 65 | my $x = $x - $ps->{_indent}; | 
| 762 | 24 |  |  |  |  | 80 | $checkspace->($vsp); | 
| 763 | 24 | 50 |  |  |  | 88 | $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing}; | 
| 764 |  |  |  |  |  |  |  | 
| 765 | 24 |  |  |  |  | 74 | for ( 1..$h ) { | 
| 766 | 72 | 100 |  |  |  | 237 | last unless @chords; | 
| 767 | 48 |  |  |  |  | 214 | $dd->draw( shift(@chords), $x, $y, $ps ); | 
| 768 | 48 |  |  |  |  | 151 | $x += $hsp; | 
| 769 |  |  |  |  |  |  | } | 
| 770 |  |  |  |  |  |  |  | 
| 771 | 24 |  |  |  |  | 96 | $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 |  |  |  |  | 1388 | }; | 
| 798 |  |  |  |  |  |  |  | 
| 799 | 40 |  |  |  |  | 141 | my @elts; | 
| 800 |  |  |  |  |  |  | my $elt;			# current element | 
| 801 | 40 |  |  |  |  | 102 | my @sb = @{$sb}; | 
|  | 40 |  |  |  |  | 1026 |  | 
| 802 | 40 |  |  |  |  | 110 | my $redo = []; | 
| 803 | 40 |  |  |  |  | 1148 | while ( @sb ) { | 
| 804 | 160 | 50 |  |  |  | 368 | $elt = @$redo ? shift(@$redo) : shift(@sb); | 
| 805 | 160 | 50 | 33 |  |  | 844 | 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 |  |  |  |  | 385 | push( @elts, $elt ); | 
| 840 |  |  |  |  |  |  | } | 
| 841 |  |  |  |  |  |  |  | 
| 842 |  |  |  |  |  |  | # Get going. | 
| 843 | 40 |  |  |  |  | 163 | $newpage->(); | 
| 844 |  |  |  |  |  |  |  | 
| 845 |  |  |  |  |  |  | # Embed source and config for debugging; | 
| 846 | 40 | 50 | 66 |  |  | 245 | $pr->embed($source->{file}) if $source->{file} && $options->{debug}; | 
| 847 |  |  |  |  |  |  |  | 
| 848 | 40 |  |  |  |  | 123 | my $prev;			# previous element | 
| 849 |  |  |  |  |  |  |  | 
| 850 |  |  |  |  |  |  | my $grid_cellwidth; | 
| 851 | 40 |  |  |  |  | 162 | my $grid_barwidth = 0.5 * $fonts->{chord}->{size}; | 
| 852 | 40 |  |  |  |  | 100 | my $grid_margin; | 
| 853 | 40 |  |  |  |  | 91 | my $did = 0; | 
| 854 | 40 |  |  |  |  | 89 | my $curctx = ""; | 
| 855 |  |  |  |  |  |  |  | 
| 856 | 40 |  |  |  |  | 129 | while ( @elts ) { | 
| 857 | 160 |  |  |  |  | 325 | $elt = shift(@elts); | 
| 858 |  |  |  |  |  |  |  | 
| 859 | 160 | 50 |  |  |  | 576 | if ( $elt->{type} eq "newpage" ) { | 
| 860 | 0 |  |  |  |  | 0 | $newpage->(); | 
| 861 | 0 |  |  |  |  | 0 | next; | 
| 862 |  |  |  |  |  |  | } | 
| 863 |  |  |  |  |  |  |  | 
| 864 | 160 | 50 |  |  |  | 421 | if ( $elt->{type} eq "colb" ) { | 
| 865 | 0 |  |  |  |  | 0 | $checkspace->(-1); | 
| 866 | 0 |  |  |  |  | 0 | next; | 
| 867 |  |  |  |  |  |  | } | 
| 868 |  |  |  |  |  |  |  | 
| 869 | 160 | 100 | 66 |  |  | 698 | if ( $elt->{type} ne "set" && !$did++ ) { | 
| 870 |  |  |  |  |  |  | # Insert top/left/right/bottom chord diagrams. | 
| 871 | 40 | 50 |  |  |  | 226 | $chorddiagrams->() unless $dctl->{show} eq "below"; | 
| 872 | 40 | 50 | 33 |  |  | 201 | showlayout($ps) if $ps->{showlayout} || $config->{debug}->{spacing}; | 
| 873 |  |  |  |  |  |  | } | 
| 874 |  |  |  |  |  |  |  | 
| 875 | 160 | 100 |  |  |  | 911 | if ( $elt->{type} eq "empty" ) { | 
| 876 | 40 |  |  |  |  | 114 | my $y0 = $y; | 
| 877 |  |  |  |  |  |  | warn("***SHOULD NOT HAPPEN1***") | 
| 878 | 40 | 50 |  |  |  | 160 | if $s->{structure} eq "structured"; | 
| 879 | 40 | 100 |  |  |  | 170 | $vsp_ignorefirst = 0, next if $vsp_ignorefirst; | 
| 880 | 16 | 50 |  |  |  | 161 | $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing}; | 
| 881 | 16 |  |  |  |  | 105 | my $vsp = empty_vsp( $elt, $ps ); | 
| 882 | 16 |  |  |  |  | 55 | $y -= $vsp; | 
| 883 | 16 | 50 |  |  |  | 81 | $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing}; | 
| 884 | 16 |  |  |  |  | 35 | next; | 
| 885 |  |  |  |  |  |  | } | 
| 886 |  |  |  |  |  |  |  | 
| 887 | 120 | 50 |  |  |  | 584 | unless ( $elt->{type} =~ /^(?:control|set|ignore)$/ ) { | 
| 888 | 120 |  |  |  |  | 220 | $vsp_ignorefirst = 0; | 
| 889 |  |  |  |  |  |  | } | 
| 890 |  |  |  |  |  |  |  | 
| 891 | 120 | 50 | 66 |  |  | 589 | if ( $elt->{type} eq "songline" | 
|  |  |  | 66 |  |  |  |  | 
| 892 |  |  |  |  |  |  | or $elt->{type} eq "tabline" | 
| 893 |  |  |  |  |  |  | or $elt->{type} =~ /^comment(?:_box|_italic)?$/ ) { | 
| 894 |  |  |  |  |  |  |  | 
| 895 | 72 | 50 |  |  |  | 595 | if ( $elt->{context} ne $curctx ) { | 
| 896 | 0 |  |  |  |  | 0 | $curctx = $elt->{context}; | 
| 897 |  |  |  |  |  |  | } | 
| 898 |  |  |  |  |  |  |  | 
| 899 | 72 |  |  |  |  | 159 | my $fonts = $ps->{fonts}; | 
| 900 | 72 |  |  |  |  | 135 | my $type   = $elt->{type}; | 
| 901 |  |  |  |  |  |  |  | 
| 902 | 72 |  |  |  |  | 124 | my $ftext; | 
| 903 | 72 | 50 |  |  |  | 218 | if ( $type eq "songline" ) { | 
|  |  | 0 |  |  |  |  |  | 
|  |  | 0 |  |  |  |  |  | 
| 904 | 72 |  |  |  |  | 149 | $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 |  |  |  |  | 223 | my $vsp = songline_vsp( $elt, $ps ); | 
| 915 | 72 | 50 | 33 |  |  | 450 | if ( $elt->{type} eq "songline" && !$elt->{indent} ) { | 
| 916 | 72 |  |  |  |  | 267 | my $e = wrap( $pr, $elt, $x ); | 
| 917 | 72 | 50 |  |  |  | 330 | 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 |  |  |  |  | 250 | $checkspace->($vsp); | 
| 926 |  |  |  |  |  |  |  | 
| 927 | 72 | 50 |  |  |  | 256 | $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing}; | 
| 928 |  |  |  |  |  |  |  | 
| 929 | 72 |  |  |  |  | 138 | my $indent = 0; | 
| 930 |  |  |  |  |  |  |  | 
| 931 |  |  |  |  |  |  | # Handle decorations. | 
| 932 |  |  |  |  |  |  |  | 
| 933 | 72 | 50 |  |  |  | 219 | 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 |  |  | 309 | 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 |  |  |  |  | 331 | $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 |  |  |  |  | 13772 | my $r = songline( $elt, $x, $y, $ps, song => $s, indent => $indent ); | 
| 996 |  |  |  |  |  |  |  | 
| 997 | 72 |  |  |  |  | 163 | $y -= $vsp; | 
| 998 | 72 | 50 |  |  |  | 247 | $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing}; | 
| 999 |  |  |  |  |  |  |  | 
| 1000 | 72 | 50 |  |  |  | 197 | unshift( @elts, $r ) if $r; | 
| 1001 | 72 |  |  |  |  | 165 | next; | 
| 1002 |  |  |  |  |  |  | } | 
| 1003 |  |  |  |  |  |  |  | 
| 1004 | 48 | 50 |  |  |  | 150 | 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 |  |  |  | 128 | 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 |  |  |  | 122 | 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 |  |  |  | 123 | 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 |  |  |  | 132 | 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 |  |  |  | 118 | 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 |  |  |  | 126 | 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 |  |  |  | 117 | if ( $elt->{type} eq "svg" ) { | 
| 1158 |  |  |  |  |  |  | # We turn SVG into one (or more) XForm objects. | 
| 1159 |  |  |  |  |  |  |  | 
| 1160 | 0 |  |  |  |  | 0 | require PDF::SVG; | 
| 1161 |  |  |  |  |  |  | my $p = PDF::SVG->new | 
| 1162 | 0 |  |  |  |  | 0 | ( pdf => $ps->{pr}->{pdf}, atts => { debug => $config->{debug}->{images} > 1 } ); | 
| 1163 | 0 |  |  |  |  | 0 | my $o = $p->process( $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 |  |  |  | 120 | 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 |  |  |  | 119 | 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 |  |  |  | 144 | if ( $elt->{type} eq "tocline" ) { | 
| 1266 | 48 |  |  |  |  | 143 | my $vsp = toc_vsp( $elt, $ps ); | 
| 1267 | 48 |  |  |  |  | 162 | $checkspace->($vsp); | 
| 1268 | 48 | 50 |  |  |  | 141 | $pr->show_vpos( $y, 0 ) if $config->{debug}->{spacing}; | 
| 1269 |  |  |  |  |  |  |  | 
| 1270 | 48 |  |  |  |  | 171 | tocline( $elt, $x, $y, $ps ); | 
| 1271 |  |  |  |  |  |  |  | 
| 1272 | 48 |  |  |  |  | 3159 | $y -= $vsp; | 
| 1273 | 48 | 50 |  |  |  | 211 | $pr->show_vpos( $y, 1 ) if $config->{debug}->{spacing}; | 
| 1274 | 48 |  |  |  |  | 103 | 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 |  |  |  |  | 518 | $prev = $elt; | 
| 1401 |  |  |  |  |  |  | } | 
| 1402 |  |  |  |  |  |  |  | 
| 1403 | 40 | 50 |  |  |  | 191 | if ( $dctl->{show} eq "below" ) { | 
| 1404 | 0 |  |  |  |  | 0 | $chorddiagrams->( undef, "below"); | 
| 1405 |  |  |  |  |  |  | } | 
| 1406 |  |  |  |  |  |  |  | 
| 1407 | 40 |  |  |  |  | 129 | my $pages = $thispage - $startpage + 1; | 
| 1408 |  |  |  |  |  |  | $newpage->(), $pages++, | 
| 1409 |  |  |  |  |  |  | if $ps->{'pagealign-songs'} > 1 && $pages % 2 | 
| 1410 | 40 | 100 | 66 |  |  | 238 | && $opts->{songindex} < $opts->{numsongs}; | 
|  |  |  | 100 |  |  |  |  | 
| 1411 |  |  |  |  |  |  |  | 
| 1412 |  |  |  |  |  |  | # Now for the page headings and footers. | 
| 1413 | 40 |  |  |  |  | 102 | $thispage = $startpage - 1; | 
| 1414 | 40 |  |  |  |  | 201 | $s->{meta}->{pages} = [ $pages ]; | 
| 1415 |  |  |  |  |  |  |  | 
| 1416 | 40 |  |  |  |  | 146 | for my $p ( 1 .. $pages ) { | 
| 1417 |  |  |  |  |  |  |  | 
| 1418 | 42 |  |  |  |  | 241 | $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 |  |  |  |  | 13039 | my $rightpage = 1; | 
| 1425 | 42 | 100 |  |  |  | 231 | if ( $ps->{"even-odd-pages"} ) { | 
| 1426 |  |  |  |  |  |  | # Even/odd printing... | 
| 1427 | 32 |  |  |  |  | 120 | $rightpage = $thispage % 2 == 0; | 
| 1428 |  |  |  |  |  |  | # Odd/even printing... | 
| 1429 | 32 | 100 |  |  |  | 135 | $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 |  |  |  | 127 | if ( $rightpage ) { | 
| 1436 | 34 |  |  |  |  | 106 | $ps->{_leftmargin}  = $ps->{marginleft}; | 
| 1437 | 34 |  |  |  |  | 76 | $ps->{_marginleft}  = $ps->{marginleft}; | 
| 1438 | 34 |  |  |  |  | 88 | $ps->{_rightmargin} = $ps->{marginright}; | 
| 1439 | 34 |  |  |  |  | 128 | $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{marginright}; | 
| 1440 |  |  |  |  |  |  | } | 
| 1441 |  |  |  |  |  |  | else { | 
| 1442 | 8 |  |  |  |  | 33 | $ps->{_leftmargin}  = $ps->{marginright}; | 
| 1443 | 8 |  |  |  |  | 21 | $ps->{_marginleft}  = $ps->{marginright}; | 
| 1444 | 8 |  |  |  |  | 24 | $ps->{_rightmargin} = $ps->{marginleft}; | 
| 1445 | 8 |  |  |  |  | 26 | $ps->{_marginright} = $ps->{papersize}->[0] - $ps->{marginleft}; | 
| 1446 |  |  |  |  |  |  | } | 
| 1447 | 42 |  |  |  |  | 99 | $ps->{_marginbottom}  = $ps->{marginbottom}; | 
| 1448 | 42 |  |  |  |  | 113 | $ps->{_margintop}     = $ps->{papersize}->[1] - $ps->{margintop}; | 
| 1449 | 42 |  |  |  |  | 84 | $ps->{_bottommargin}  = $ps->{marginbottom}; | 
| 1450 |  |  |  |  |  |  |  | 
| 1451 |  |  |  |  |  |  | # Physical coordinates; will be adjusted to columns if needed. | 
| 1452 | 42 |  |  |  |  | 90 | $ps->{__leftmargin}   = $ps->{_marginleft}; | 
| 1453 | 42 |  |  |  |  | 78 | $ps->{__rightmargin}  = $ps->{_marginright}; | 
| 1454 | 42 |  |  |  |  | 89 | $ps->{__topmargin}    = $ps->{_margintop}; | 
| 1455 | 42 |  |  |  |  | 107 | $ps->{__bottommargin} = $ps->{_marginbottom}; | 
| 1456 |  |  |  |  |  |  |  | 
| 1457 | 42 |  |  |  |  | 95 | $thispage++; | 
| 1458 |  |  |  |  |  |  | $s->{meta}->{page} = [ $s->{page} = $opts->{roman} | 
| 1459 | 42 | 100 |  |  |  | 260 | ? roman($thispage) : $thispage ]; | 
| 1460 |  |  |  |  |  |  |  | 
| 1461 |  |  |  |  |  |  | # Determine page class. | 
| 1462 | 42 |  |  |  |  | 106 | my $class = 2;		# default | 
| 1463 | 42 | 100 |  |  |  | 174 | if ( $thispage == 1 ) { | 
|  |  | 100 |  |  |  |  |  | 
| 1464 | 24 |  |  |  |  | 51 | $class = 0;		# very first page | 
| 1465 |  |  |  |  |  |  | } | 
| 1466 |  |  |  |  |  |  | elsif ( $thispage == $startpage ) { | 
| 1467 | 16 |  |  |  |  | 42 | $class = 1;		# first of a song | 
| 1468 |  |  |  |  |  |  | } | 
| 1469 |  |  |  |  |  |  |  | 
| 1470 |  |  |  |  |  |  | # Three-part title handlers. | 
| 1471 | 42 |  |  | 126 |  | 269 | my $tpt = sub { tpt( $ps, $class, $_[0], $rightpage, $x, $y, $s ) }; | 
|  | 126 |  |  |  |  | 496 |  | 
| 1472 |  |  |  |  |  |  |  | 
| 1473 | 42 |  |  |  |  | 106 | $x = $ps->{__leftmargin}; | 
| 1474 | 42 | 50 |  |  |  | 132 | if ( $ps->{headspace} ) { | 
| 1475 |  |  |  |  |  |  | warn("Metadata for pageheading: ", ::dump($s->{meta}), "\n") | 
| 1476 | 42 | 50 |  |  |  | 179 | if $config->{debug}->{meta}; | 
| 1477 | 42 |  |  |  |  | 94 | $y = $ps->{_margintop} + $ps->{headspace}; | 
| 1478 | 42 |  |  |  |  | 169 | $y -= font_bl($fonts->{title}); | 
| 1479 | 42 |  |  |  |  | 531 | $y = $tpt->("title"); | 
| 1480 | 42 |  |  |  |  | 490 | $y = $tpt->("subtitle"); | 
| 1481 |  |  |  |  |  |  | } | 
| 1482 |  |  |  |  |  |  |  | 
| 1483 | 42 | 50 |  |  |  | 185 | if ( $ps->{footspace} ) { | 
| 1484 | 42 |  |  |  |  | 128 | $y = $ps->{marginbottom} - $ps->{footspace}; | 
| 1485 | 42 |  |  |  |  | 170 | $tpt->("footer"); | 
| 1486 |  |  |  |  |  |  | } | 
| 1487 |  |  |  |  |  |  |  | 
| 1488 |  |  |  |  |  |  | } | 
| 1489 |  |  |  |  |  |  |  | 
| 1490 | 40 |  |  |  |  | 14436 | return $pages; | 
| 1491 |  |  |  |  |  |  | } | 
| 1492 |  |  |  |  |  |  |  | 
| 1493 |  |  |  |  |  |  | sub font_bl { | 
| 1494 | 282 |  |  | 282 | 0 | 551 | my ( $font ) = @_; | 
| 1495 |  |  |  |  |  |  | #    $font->{size} / ( 1 - $font->{fd}->{font}->descender / $font->{fd}->{font}->ascender ); | 
| 1496 | 282 |  |  |  |  | 1136 | $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 | 404 | my ( $ps, $label, $x, $y, $font) = @_; | 
| 1506 | 144 | 50 | 33 |  |  | 461 | 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 | 3187 | my ( $frag ) = @_; | 
| 1536 | 146 |  |  |  |  | 264 | my @stack; | 
| 1537 |  |  |  |  |  |  | my @res; | 
| 1538 |  |  |  |  |  |  |  | 
| 1539 | 146 |  |  |  |  | 366 | foreach my $f ( @$frag ) { | 
| 1540 | 292 |  |  |  |  | 935 | my @a = split( /(<.*?>)/, $f ); | 
| 1541 | 292 | 100 |  |  |  | 644 | if ( @stack ) { | 
| 1542 | 2 |  |  |  |  | 6 | unshift( @a, @stack ); | 
| 1543 | 2 |  |  |  |  | 7 | @stack = (); | 
| 1544 |  |  |  |  |  |  | } | 
| 1545 | 292 |  |  |  |  | 443 | my @r; | 
| 1546 | 292 |  |  |  |  | 482 | foreach my $a ( @a ) { | 
| 1547 | 305 | 100 |  |  |  | 981 | 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 |  |  |  | 6 | if ( @stack ) { | 
| 1552 | 3 | 50 |  |  |  | 52 | if ( $stack[-1] =~ /^<\s*$k\b/ ) { | 
| 1553 | 3 |  |  |  |  | 9 | 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 |  |  |  |  | 15 | my $k = $1; | 
| 1569 | 6 |  |  |  |  | 21 | push( @stack, "<$k$2>" ); | 
| 1570 |  |  |  |  |  |  | } | 
| 1571 | 305 |  |  |  |  | 785 | push( @r, $a ); | 
| 1572 |  |  |  |  |  |  | } | 
| 1573 | 292 | 100 |  |  |  | 577 | if ( @stack ) { | 
| 1574 | 2 |  |  |  |  | 6 | push( @r, map { my $t = $_; | 
|  | 3 |  |  |  |  | 5 |  | 
| 1575 | 3 |  |  |  |  | 21 | $t =~ s;^<\s*(\w+).*;$1>;; | 
| 1576 | 3 |  |  |  |  | 12 | $t; } reverse @stack ); | 
| 1577 |  |  |  |  |  |  | } | 
| 1578 | 292 |  |  |  |  | 912 | push( @res, join("", @r ) ); | 
| 1579 |  |  |  |  |  |  | } | 
| 1580 | 146 | 50 |  |  |  | 400 | 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 |  |  |  |  | 574 | \@res; | 
| 1586 |  |  |  |  |  |  | } | 
| 1587 |  |  |  |  |  |  |  | 
| 1588 |  |  |  |  |  |  | sub songline { | 
| 1589 | 72 |  |  | 72 | 0 | 368 | 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 |  |  |  |  | 182 | my $pr    = $ps->{pr}; | 
| 1626 | 72 |  |  |  |  | 157 | my $fonts = $ps->{fonts}; | 
| 1627 |  |  |  |  |  |  |  | 
| 1628 | 72 |  |  |  |  | 161 | my $type   = $elt->{type}; | 
| 1629 |  |  |  |  |  |  |  | 
| 1630 | 72 |  |  |  |  | 127 | my $ftext; | 
| 1631 |  |  |  |  |  |  | my $ytext; | 
| 1632 | 72 |  | 50 |  |  | 297 | my $tag = $i_tag // ""; | 
| 1633 | 72 |  |  |  |  | 131 | $i_tag = undef; | 
| 1634 |  |  |  |  |  |  |  | 
| 1635 | 72 |  |  |  |  | 118 | my @phrases = @{ defrag( $elt->{phrases} ) }; | 
|  | 72 |  |  |  |  | 173 |  | 
| 1636 |  |  |  |  |  |  |  | 
| 1637 | 72 | 50 |  |  |  | 318 | 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 |  |  |  | 217 | 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 |  |  |  |  | 195 | $ytext  = $ytop - font_bl($ftext); # unless lyrics AND chords | 
| 1675 |  |  |  |  |  |  |  | 
| 1676 | 72 |  |  |  |  | 704 | my $fchord = $fonts->{chord}; | 
| 1677 | 72 |  |  |  |  | 155 | my $ychord = $ytop - font_bl($fchord); | 
| 1678 |  |  |  |  |  |  |  | 
| 1679 |  |  |  |  |  |  | # Just print the lyrics if no chords. | 
| 1680 | 72 | 50 | 33 |  |  | 671 | 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 |  |  | 418 | 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 |  |  |  |  | 1447 | * $ps->{spacing}->{chords}; | 
| 1708 |  |  |  |  |  |  | } | 
| 1709 |  |  |  |  |  |  |  | 
| 1710 | 72 |  | 50 |  |  | 207 | $elt->{chords} //= [ '' ]; | 
| 1711 | 72 | 50 |  |  |  | 228 | $x += $elt->{indent} if $elt->{indent}; | 
| 1712 |  |  |  |  |  |  |  | 
| 1713 | 72 |  |  |  |  | 136 | my $chordsx = $x; | 
| 1714 | 72 | 50 |  |  |  | 170 | $chordsx += $ps->{chordscolumn} if $chordscol; | 
| 1715 | 72 | 50 |  |  |  | 206 | if ( $chordsx < 0 ) {	#### EXPERIMENTAL | 
| 1716 | 0 |  |  |  |  | 0 | ($x, $chordsx) = (-$chordsx, $x); | 
| 1717 |  |  |  |  |  |  | } | 
| 1718 | 72 | 50 |  |  |  | 193 | $x += $opts{indent} if $opts{indent}; | 
| 1719 |  |  |  |  |  |  |  | 
| 1720 |  |  |  |  |  |  | # How to embed the chords. | 
| 1721 | 72 | 50 |  |  |  | 178 | if ( $inlinechords ) { | 
| 1722 | 0 | 0 |  |  |  | 0 | $inlinechords = '[%s]' unless $inlinechords =~ /%[cs]/; | 
| 1723 | 0 |  |  |  |  | 0 | $ychord = $ytext; | 
| 1724 |  |  |  |  |  |  | } | 
| 1725 |  |  |  |  |  |  |  | 
| 1726 | 72 |  |  |  |  | 615 | my @chords; | 
| 1727 | 72 |  |  |  |  | 133 | my $n = $#{$elt->{chords}}; | 
|  | 72 |  |  |  |  | 200 |  | 
| 1728 | 72 |  |  |  |  | 214 | foreach my $i ( 0 .. $n ) { | 
| 1729 |  |  |  |  |  |  |  | 
| 1730 | 144 |  |  |  |  | 325 | my $chord = $elt->{chords}->[$i]; | 
| 1731 | 144 |  |  |  |  | 293 | my $phrase = $phrases[$i]; | 
| 1732 |  |  |  |  |  |  |  | 
| 1733 | 144 | 50 | 33 |  |  | 423 | 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 |  |  |  |  | 245 | my $xt0 = $x; | 
| 1768 | 144 |  |  |  |  | 224 | my $font = $fchord; | 
| 1769 | 144 | 50 |  |  |  | 452 | if ( $chord ne '' ) { | 
| 1770 | 144 |  |  |  |  | 576 | my $ch = $chord->chord_display; | 
| 1771 | 144 |  |  |  |  | 2267 | my $dp = $ch . " "; | 
| 1772 | 144 | 50 |  |  |  | 585 | 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 |  |  |  |  | 1502 | $xt0 = $pr->text( $dp, $x, $ychord, $font ); | 
| 1781 |  |  |  |  |  |  | } | 
| 1782 |  |  |  |  |  |  |  | 
| 1783 |  |  |  |  |  |  | # Do not indent chorus labels (issue #81). | 
| 1784 | 144 |  |  |  |  | 796 | prlabel( $ps, $tag, $x-$opts{indent}, $ytext ); | 
| 1785 | 144 |  |  |  |  | 288 | $tag = ""; | 
| 1786 | 144 | 50 |  |  |  | 656 | if ( $inlinechords ) { | 
| 1787 | 0 |  |  |  |  | 0 | $x = $pr->text( $phrase, $xt0, $ytext, $ftext ); | 
| 1788 |  |  |  |  |  |  | } | 
| 1789 |  |  |  |  |  |  | else { | 
| 1790 | 144 |  |  |  |  | 1247 | my $xt1; | 
| 1791 | 144 | 50 |  |  |  | 637 | 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 |  |  |  |  | 441 | $xt1 = $pr->text( $phrase, $x, $ytext, $ftext ); | 
| 1797 |  |  |  |  |  |  | } | 
| 1798 | 144 | 50 |  |  |  | 517 | 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 |  |  |  |  | 471 | $x = $xt1; | 
| 1839 |  |  |  |  |  |  | } | 
| 1840 |  |  |  |  |  |  | } | 
| 1841 |  |  |  |  |  |  | } | 
| 1842 |  |  |  |  |  |  | } | 
| 1843 |  |  |  |  |  |  |  | 
| 1844 |  |  |  |  |  |  | # Print side column with chords, if any. | 
| 1845 | 72 | 50 |  |  |  | 283 | $pr->text( join(",  ", @chords), | 
| 1846 |  |  |  |  |  |  | $chordsx, $ychord, $fchord ) | 
| 1847 |  |  |  |  |  |  | if @chords; | 
| 1848 |  |  |  |  |  |  |  | 
| 1849 | 72 |  |  |  |  | 308 | 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 |  | 117 | use Image::Info; | 
|  | 10 |  |  |  |  | 69 |  | 
|  | 10 |  |  |  |  | 82949 |  | 
| 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 | 112 | my ( $elt, $x, $y, $ps ) = @_; | 
| 2404 |  |  |  |  |  |  |  | 
| 2405 | 48 |  |  |  |  | 93 | my $pr = $ps->{pr}; | 
| 2406 | 48 |  |  |  |  | 84 | my $fonts = $ps->{fonts}; | 
| 2407 | 48 |  |  |  |  | 82 | my $y0 = $y; | 
| 2408 | 48 |  |  |  |  | 78 | my $ftoc = $fonts->{toc}; | 
| 2409 | 48 |  |  |  |  | 145 | $y -= font_bl($ftoc); | 
| 2410 | 48 |  |  |  |  | 527 | $pr->setfont($ftoc); | 
| 2411 | 48 |  |  |  |  | 9585 | my $tpl = $elt->{title}; | 
| 2412 | 48 |  |  |  |  | 122 | my $vsp; | 
| 2413 | 48 |  |  |  |  | 316 | for ( split( /\\n/, $tpl ) ) { | 
| 2414 | 48 |  |  |  |  | 274 | $ps->{pr}->text( $_, $x, $y ); | 
| 2415 | 48 | 50 |  |  |  | 151 | unless ($vsp) { | 
| 2416 | 48 |  |  |  |  | 161 | my $p = $elt->{pageno}; | 
| 2417 | 48 |  |  |  |  | 201 | $ps->{pr}->text( $p, $ps->{__rightmargin} - $pr->strwidth($p), $y ); | 
| 2418 | 48 |  |  |  |  | 253 | $vsp = _vsp("toc", $ps); | 
| 2419 |  |  |  |  |  |  | } | 
| 2420 | 48 |  |  |  |  | 137 | $y -= $vsp; | 
| 2421 |  |  |  |  |  |  | } | 
| 2422 | 48 |  |  |  |  | 223 | my $ann = $pr->{pdfpage}->annotation; | 
| 2423 | 48 |  |  |  |  | 35123 | $ann->link($elt->{page}); | 
| 2424 |  |  |  |  |  |  | $ann->rect( $ps->{__leftmargin}, $y0 - $ftoc->{size} * $ps->{spacing}->{toc}, | 
| 2425 | 48 |  |  |  |  | 5606 | $ps->{__rightmargin}, $y0 ); | 
| 2426 |  |  |  |  |  |  | } | 
| 2427 |  |  |  |  |  |  |  | 
| 2428 |  |  |  |  |  |  | sub has_visible_chords { | 
| 2429 | 144 |  |  | 144 | 0 | 2046 | my ( $elt ) = @_; | 
| 2430 | 144 | 50 |  |  |  | 443 | if ( $elt->{chords} ) { | 
| 2431 | 144 |  |  |  |  | 226 | for ( @{ $elt->{chords} } ) { | 
|  | 144 |  |  |  |  | 411 |  | 
| 2432 | 288 | 50 |  |  |  | 668 | next if defined; | 
| 2433 | 0 |  |  |  |  | 0 | warn("Undefined chord in chords: ", ::dump($elt) ); | 
| 2434 |  |  |  |  |  |  | } | 
| 2435 | 144 |  |  |  |  | 256 | return join( "", @{ $elt->{chords} } ) =~ /\S/; | 
|  | 144 |  |  |  |  | 1699 |  | 
| 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 | 172 | my ( $elt, $ps ) = @_; | 
| 2447 |  |  |  |  |  |  |  | 
| 2448 |  |  |  |  |  |  | # Calculate the vertical span of this songline. | 
| 2449 | 72 |  |  |  |  | 140 | my $fonts = $ps->{fonts}; | 
| 2450 |  |  |  |  |  |  |  | 
| 2451 | 72 | 50 |  |  |  | 244 | 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 |  |  |  | 185 | 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 |  |  |  |  | 197 | my $vsp = text_vsp( $elt, $ps ); | 
| 2463 | 72 |  |  |  |  | 210 | my $csp = $fonts->{chord}->{size} * $ps->{spacing}->{chords}; | 
| 2464 |  |  |  |  |  |  |  | 
| 2465 | 72 | 50 | 33 |  |  | 321 | return $vsp if $lyrics_only || $chordscol; | 
| 2466 |  |  |  |  |  |  |  | 
| 2467 | 72 | 50 | 33 |  |  | 898 | return $vsp if $suppress_empty_chordsline && ! has_visible_chords($elt); | 
| 2468 |  |  |  |  |  |  |  | 
| 2469 |  |  |  |  |  |  | # No text printing if no text. | 
| 2470 | 72 | 50 | 33 |  |  | 256 | $vsp = 0 if $suppress_empty_lyricsline && join( "", @{ $elt->{phrases} } ) !~ /\S/; | 
|  | 72 |  |  |  |  | 1047 |  | 
| 2471 |  |  |  |  |  |  |  | 
| 2472 | 72 | 50 |  |  |  | 217 | 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 |  |  |  |  | 584 | $vsp += $csp; | 
| 2478 |  |  |  |  |  |  | } | 
| 2479 | 72 |  |  |  |  | 245 | return $vsp; | 
| 2480 |  |  |  |  |  |  | } | 
| 2481 |  |  |  |  |  |  |  | 
| 2482 |  |  |  |  |  |  | sub _vsp { | 
| 2483 | 184 |  |  | 184 |  | 492 | my ( $eltype, $ps, $sptype ) = @_; | 
| 2484 | 184 |  | 66 |  |  | 654 | $sptype ||= $eltype; | 
| 2485 |  |  |  |  |  |  |  | 
| 2486 |  |  |  |  |  |  | # Calculate the vertical span of this element. | 
| 2487 |  |  |  |  |  |  |  | 
| 2488 | 184 |  |  |  |  | 422 | my $font = $ps->{fonts}->{$eltype}; | 
| 2489 | 184 |  |  |  |  | 611 | $font->{size} * $ps->{spacing}->{$sptype}; | 
| 2490 |  |  |  |  |  |  | } | 
| 2491 |  |  |  |  |  |  |  | 
| 2492 | 16 |  |  | 16 | 0 | 77 | 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 | 137 | my $vsp = _vsp( "toc",   $_[1] ); | 
| 2498 | 48 |  |  |  |  | 118 | my $tpl = $_[0]->{title}; | 
| 2499 | 48 |  |  |  |  | 80 | my $ret = $vsp; | 
| 2500 | 48 |  |  |  |  | 190 | while ( $tpl =~ /\\n/g ) { | 
| 2501 | 0 |  |  |  |  | 0 | $ret += $vsp; | 
| 2502 |  |  |  |  |  |  | } | 
| 2503 | 48 |  |  |  |  | 107 | return $ret; | 
| 2504 |  |  |  |  |  |  | } | 
| 2505 |  |  |  |  |  |  |  | 
| 2506 |  |  |  |  |  |  | sub text_vsp { | 
| 2507 | 72 |  |  | 72 | 0 | 149 | my ( $elt, $ps ) = @_; | 
| 2508 |  |  |  |  |  |  |  | 
| 2509 | 72 |  |  |  |  | 355 | my $layout = Text::Layout->new( $ps->{pr}->{pdf} ); | 
| 2510 | 72 |  |  |  |  | 3694 | $layout->set_font_description( $ps->{fonts}->{text}->{fd} ); | 
| 2511 | 72 |  |  |  |  | 1237 | $layout->set_font_size( $ps->{fonts}->{text}->{size} ); | 
| 2512 |  |  |  |  |  |  | #warn("vsp: ".join( "", @{$elt->{phrases}} )."\n"); | 
| 2513 | 72 |  |  |  |  | 498 | $layout->set_markup( join( "", @{$elt->{phrases}} ) ); | 
|  | 72 |  |  |  |  | 620 |  | 
| 2514 | 72 |  |  |  |  | 3749 | 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 |  |  |  |  | 31531 | _vsp( "text", $ps, "lyrics" ); | 
| 2519 |  |  |  |  |  |  | } | 
| 2520 |  |  |  |  |  |  |  | 
| 2521 |  |  |  |  |  |  | sub set_columns { | 
| 2522 | 40 |  |  | 40 | 0 | 129 | my ( $ps, $cols ) = @_; | 
| 2523 | 40 |  |  |  |  | 84 | my @cols; | 
| 2524 | 40 | 50 |  |  |  | 174 | if ( ref($cols) eq 'ARRAY' ) { | 
| 2525 | 0 |  |  |  |  | 0 | @cols = @$cols; | 
| 2526 | 0 |  |  |  |  | 0 | $cols = @$cols; | 
| 2527 |  |  |  |  |  |  | } | 
| 2528 | 40 | 50 |  |  |  | 129 | unless ( $cols ) { | 
| 2529 | 0 |  | 0 |  |  | 0 | $cols = $ps->{columns} ||= 1; | 
| 2530 |  |  |  |  |  |  | } | 
| 2531 |  |  |  |  |  |  | else { | 
| 2532 | 40 |  | 50 |  |  | 181 | $ps->{columns} = $cols ||= 1; | 
| 2533 |  |  |  |  |  |  | } | 
| 2534 |  |  |  |  |  |  |  | 
| 2535 |  |  |  |  |  |  | my $w = $ps->{papersize}->[0] | 
| 2536 | 40 |  |  |  |  | 205 | - $ps->{_leftmargin} - $ps->{_rightmargin}; | 
| 2537 | 40 |  |  |  |  | 146 | $ps->{columnoffsets} = [ 0 ]; | 
| 2538 |  |  |  |  |  |  |  | 
| 2539 | 40 | 50 |  |  |  | 148 | 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 |  |  |  | 189 | push( @{ $ps->{columnoffsets} }, $w ), return unless $cols > 1; | 
|  | 40 |  |  |  |  | 178 |  | 
| 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 | 4218 | my ( $lib, $verbose ) = @_; | 
| 2662 | 11 |  |  |  |  | 30 | my $pdfapi; | 
| 2663 |  |  |  |  |  |  |  | 
| 2664 | 11 |  |  |  |  | 30 | my $t = "config"; | 
| 2665 |  |  |  |  |  |  | # Get PDF library. | 
| 2666 | 11 | 50 |  |  |  | 64 | if ( $ENV{CHORDPRO_PDF_API} ) { | 
| 2667 | 0 |  |  |  |  | 0 | $t = "CHORDPRO_PDF_API"; | 
| 2668 | 0 |  |  |  |  | 0 | $lib = $ENV{CHORDPRO_PDF_API}; | 
| 2669 |  |  |  |  |  |  | } | 
| 2670 | 11 | 50 |  |  |  | 58 | 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 |  |  |  |  | 68 | for ( qw( PDF::API2 PDF::Builder ) ) { | 
| 2679 | 11 | 50 |  |  |  | 1748 | eval "require $_" or next; | 
| 2680 | 11 |  |  |  |  | 1753834 | $pdfapi = $_; | 
| 2681 | 11 | 50 |  |  |  | 65 | warn("Using PDF library $_ (detected)\n") if $verbose; | 
| 2682 | 11 |  |  |  |  | 43 | last; | 
| 2683 |  |  |  |  |  |  | } | 
| 2684 |  |  |  |  |  |  | } | 
| 2685 | 11 | 50 |  |  |  | 44 | die("Missing PDF library\n") unless $pdfapi; | 
| 2686 | 11 |  |  |  |  | 80 | return $pdfapi; | 
| 2687 |  |  |  |  |  |  | } | 
| 2688 |  |  |  |  |  |  |  | 
| 2689 |  |  |  |  |  |  | sub configurator { | 
| 2690 | 8 |  |  | 8 | 0 | 55 | my ( $cfg ) = @_; | 
| 2691 |  |  |  |  |  |  |  | 
| 2692 |  |  |  |  |  |  | # From here, we're mainly dealing with the PDF settings. | 
| 2693 | 8 |  |  |  |  | 99 | my $pdf   = $cfg->{pdf}; | 
| 2694 |  |  |  |  |  |  |  | 
| 2695 |  |  |  |  |  |  | # Get PDF library. | 
| 2696 | 8 |  | 33 |  |  | 92 | $pdfapi //= config_pdfapi( $pdf->{library} ); | 
| 2697 |  |  |  |  |  |  |  | 
| 2698 | 8 |  |  |  |  | 39 | my $fonts = $pdf->{fonts}; | 
| 2699 |  |  |  |  |  |  |  | 
| 2700 |  |  |  |  |  |  | # Apply Chordii command line compatibility. | 
| 2701 |  |  |  |  |  |  |  | 
| 2702 |  |  |  |  |  |  | # Command line only takes text and chord fonts. | 
| 2703 | 8 |  |  |  |  | 34 | for my $type ( qw( text chord ) ) { | 
| 2704 | 16 |  |  |  |  | 87 | for ( $options->{"$type-font"} ) { | 
| 2705 | 16 | 50 |  |  |  | 61 | 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 |  |  |  |  | 86 | for ( $options->{"$type-size"} ) { | 
| 2716 | 16 | 50 |  |  |  | 60 | $fonts->{$type}->{size} = $_ if $_; | 
| 2717 |  |  |  |  |  |  | } | 
| 2718 |  |  |  |  |  |  | } | 
| 2719 |  |  |  |  |  |  |  | 
| 2720 | 8 |  |  |  |  | 50 | for ( $options->{"page-size"} ) { | 
| 2721 | 8 | 50 |  |  |  | 40 | $pdf->{papersize} = $_ if $_; | 
| 2722 |  |  |  |  |  |  | } | 
| 2723 | 8 |  |  |  |  | 41 | for ( $options->{"vertical-space"} ) { | 
| 2724 | 8 | 50 |  |  |  | 37 | next unless $_; | 
| 2725 |  |  |  |  |  |  | $pdf->{spacing}->{lyrics} += | 
| 2726 | 0 |  |  |  |  | 0 | $_ / $fonts->{text}->{size}; | 
| 2727 |  |  |  |  |  |  | } | 
| 2728 | 8 |  |  |  |  | 57 | for ( $options->{"lyrics-only"} ) { | 
| 2729 | 8 | 50 |  |  |  | 37 | 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 |  |  |  |  | 34 | for ( $options->{"single-space"} ) { | 
| 2735 | 8 | 50 |  |  |  | 30 | next unless defined $_; | 
| 2736 | 0 |  |  |  |  | 0 | $pdf->{"suppress-empty-chords"} = $_; | 
| 2737 |  |  |  |  |  |  | } | 
| 2738 | 8 |  |  |  |  | 36 | for ( $options->{"even-pages-number-left"} ) { | 
| 2739 | 8 | 50 |  |  |  | 26 | next unless defined $_; | 
| 2740 | 0 |  |  |  |  | 0 | $pdf->{"even-pages-number-left"} = $_; | 
| 2741 |  |  |  |  |  |  | } | 
| 2742 |  |  |  |  |  |  |  | 
| 2743 |  |  |  |  |  |  | # Chord grid width. | 
| 2744 | 8 | 50 |  |  |  | 53 | 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 |  |  |  | 47 | unless ( eval { $pdf->{papersize}->[0] } ) { | 
|  | 8 |  |  |  |  | 170 |  | 
| 2754 | 8 |  |  |  |  | 862 | eval "require ${pdfapi}::Resource::PaperSizes"; | 
| 2755 | 8 |  |  |  |  | 129 | my %ps = "${pdfapi}::Resource::PaperSizes"->get_paper_sizes; | 
| 2756 |  |  |  |  |  |  | die("Unhandled paper size: ", $pdf->{papersize}, "\n") | 
| 2757 | 8 | 50 |  |  |  | 473 | unless exists $ps{lc $pdf->{papersize}}; | 
| 2758 |  |  |  |  |  |  | $pdf->{papersize} = $ps{lc $pdf->{papersize}} | 
| 2759 | 8 |  |  |  |  | 74 | } | 
| 2760 |  |  |  |  |  |  |  | 
| 2761 |  |  |  |  |  |  | # Merge properties for derived fonts. | 
| 2762 |  |  |  |  |  |  | my $fm = sub { | 
| 2763 | 96 |  |  | 96 |  | 207 | my ( $font, $def ) = @_; | 
| 2764 | 96 |  |  |  |  | 129 | for ( keys %{ $fonts->{$def} } ) { | 
|  | 96 |  |  |  |  | 292 |  | 
| 2765 | 376 | 100 |  |  |  | 854 | next if /^(?:background|frame)$/; | 
| 2766 | 288 |  | 66 |  |  | 993 | $fonts->{$font}->{$_} //= $fonts->{$def}->{$_}; | 
| 2767 |  |  |  |  |  |  | } | 
| 2768 | 8 |  |  |  |  | 83 | }; | 
| 2769 | 8 |  |  |  |  | 46 | $fm->( qw( subtitle       text     ) ); | 
| 2770 | 8 |  |  |  |  | 50 | $fm->( qw( comment_italic text     ) ); | 
| 2771 | 8 |  |  |  |  | 45 | $fm->( qw( comment_box    text     ) ); | 
| 2772 | 8 |  |  |  |  | 69 | $fm->( qw( comment        text     ) ); | 
| 2773 | 8 |  |  |  |  | 63 | $fm->( qw( annotation     chord    ) ); | 
| 2774 | 8 |  |  |  |  | 63 | $fm->( qw( toc            text     ) ); | 
| 2775 | 8 |  |  |  |  | 77 | $fm->( qw( empty          text     ) ); | 
| 2776 | 8 |  |  |  |  | 64 | $fm->( qw( grid           chord    ) ); | 
| 2777 | 8 |  |  |  |  | 64 | $fm->( qw( grid_margin    comment  ) ); | 
| 2778 | 8 |  |  |  |  | 86 | $fm->( qw( diagram        comment  ) ); | 
| 2779 | 8 |  |  |  |  | 61 | $fm->( qw( diagram_base   comment  ) ); | 
| 2780 |  |  |  |  |  |  |  | 
| 2781 |  |  |  |  |  |  | # Default footer is small subtitle. | 
| 2782 | 8 |  | 33 |  |  | 136 | $fonts->{footer}->{size} //= 0.6 * $fonts->{subtitle}->{size}; | 
| 2783 | 8 |  |  |  |  | 30 | $fm->( qw( footer         subtitle ) ); | 
| 2784 |  |  |  |  |  |  |  | 
| 2785 |  |  |  |  |  |  | # This one is fixed. | 
| 2786 | 8 |  |  |  |  | 140 | $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 | 290 | my ( $ps, $class, $type ) = @_; | 
| 2793 | 126 |  |  |  |  | 354 | my @classes = qw( first title default ); | 
| 2794 | 126 |  |  |  |  | 418 | for ( my $i = $class; $i < @classes; $i++ ) { | 
| 2795 | 174 | 100 |  |  |  | 658 | next unless exists($ps->{formats}->{$classes[$i]}->{$type}); | 
| 2796 | 126 |  |  |  |  | 414 | 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 | 404 | my ( $ps, $class, $type, $rightpage, $x, $y, $s ) = @_; | 
| 2805 | 126 |  |  |  |  | 322 | my $fmt = get_format( $ps, $class, $type ); | 
| 2806 | 126 | 50 |  |  |  | 320 | return unless $fmt; | 
| 2807 | 126 | 50 | 33 |  |  | 646 | if ( @$fmt == 3 && ref($fmt->[0]) ne 'ARRAY' ) { | 
| 2808 | 126 |  |  |  |  | 306 | $fmt = [ $fmt ]; | 
| 2809 |  |  |  |  |  |  | } | 
| 2810 |  |  |  |  |  |  | # @fmt = ( left-fmt, center-fmt, right-fmt ) | 
| 2811 | 126 |  |  |  |  | 232 | my $pr = $ps->{pr}; | 
| 2812 | 126 |  |  |  |  | 287 | my $font = $ps->{fonts}->{$type}; | 
| 2813 |  |  |  |  |  |  |  | 
| 2814 | 126 |  |  |  |  | 210 | my $havefont; | 
| 2815 | 126 |  |  |  |  | 299 | my $rm = $ps->{papersize}->[0] - $ps->{_rightmargin}; | 
| 2816 |  |  |  |  |  |  |  | 
| 2817 | 126 |  |  |  |  | 294 | for my $fmt ( @$fmt ) { | 
| 2818 | 126 | 50 |  |  |  | 341 | if ( @$fmt % 3 ) { | 
| 2819 | 0 |  |  |  |  | 0 | die("ASSERT: " . scalar(@$fmt)," part format $class $type"); | 
| 2820 |  |  |  |  |  |  | } | 
| 2821 |  |  |  |  |  |  |  | 
| 2822 | 126 |  |  |  |  | 411 | my @fmt = @$fmt; | 
| 2823 | 126 | 100 |  |  |  | 339 | @fmt = @fmt[2,1,0] unless $rightpage; # swap | 
| 2824 |  |  |  |  |  |  |  | 
| 2825 |  |  |  |  |  |  | # Left part. Easiest. | 
| 2826 | 126 | 100 |  |  |  | 306 | if ( $fmt[0] ) { | 
| 2827 | 5 |  |  |  |  | 30 | my $t = fmt_subst( $s, $fmt[0] ); | 
| 2828 | 5 | 50 |  |  |  | 960 | if ( $t ne "" ) { | 
| 2829 | 5 | 50 |  |  |  | 45 | $pr->setfont($font) unless $havefont++; | 
| 2830 | 5 |  |  |  |  | 1088 | $pr->text( $t, $x, $y ); | 
| 2831 |  |  |  |  |  |  | } | 
| 2832 |  |  |  |  |  |  | } | 
| 2833 |  |  |  |  |  |  |  | 
| 2834 |  |  |  |  |  |  | # Center part. | 
| 2835 | 126 | 100 |  |  |  | 283 | if ( $fmt[1] ) { | 
| 2836 | 80 |  |  |  |  | 393 | my $t = fmt_subst( $s, $fmt[1] ); | 
| 2837 | 80 | 100 |  |  |  | 16413 | if ( $t ne "" ) { | 
| 2838 | 40 | 50 |  |  |  | 313 | $pr->setfont($font) unless $havefont++; | 
| 2839 | 40 |  |  |  |  | 8028 | $pr->text( $t, ($rm+$x-$pr->strwidth($t))/2, $y ); | 
| 2840 |  |  |  |  |  |  | } | 
| 2841 |  |  |  |  |  |  | } | 
| 2842 |  |  |  |  |  |  |  | 
| 2843 |  |  |  |  |  |  | # Right part. | 
| 2844 | 126 | 100 |  |  |  | 529 | if ( $fmt[2] ) { | 
| 2845 | 15 |  |  |  |  | 91 | my $t = fmt_subst( $s, $fmt[2] ); | 
| 2846 | 15 | 50 |  |  |  | 3101 | if ( $t ne "" ) { | 
| 2847 | 15 | 100 |  |  |  | 129 | $pr->setfont($font) unless $havefont++; | 
| 2848 | 15 |  |  |  |  | 2732 | $pr->text( $t, $rm-$pr->strwidth($t), $y ); | 
| 2849 |  |  |  |  |  |  | } | 
| 2850 |  |  |  |  |  |  | } | 
| 2851 |  |  |  |  |  |  |  | 
| 2852 | 126 |  | 100 |  |  | 893 | $y -= $font->{size} * ($ps->{spacing}->{$type} || 1); | 
| 2853 |  |  |  |  |  |  | } | 
| 2854 |  |  |  |  |  |  |  | 
| 2855 |  |  |  |  |  |  | # Return updated baseline. | 
| 2856 | 126 |  |  |  |  | 643 | return $y; | 
| 2857 |  |  |  |  |  |  | } | 
| 2858 |  |  |  |  |  |  |  | 
| 2859 |  |  |  |  |  |  | sub wrap { | 
| 2860 | 72 |  |  | 72 | 0 | 210 | my ( $pr, $elt, $x ) = @_; | 
| 2861 | 72 |  |  |  |  | 144 | my $res = []; | 
| 2862 | 72 |  | 50 |  |  | 131 | my @chords  = @{ $elt->{chords} // [] }; | 
|  | 72 |  |  |  |  | 295 |  | 
| 2863 | 72 |  | 50 |  |  | 134 | my @phrases = @{ defrag( $elt->{phrases} // [] ) }; | 
|  | 72 |  |  |  |  | 286 |  | 
| 2864 | 72 |  |  |  |  | 256 | my @rchords; | 
| 2865 |  |  |  |  |  |  | my @rphrases; | 
| 2866 | 72 |  |  |  |  | 221 | my $m = $pr->{ps}->{__rightmargin}; | 
| 2867 |  |  |  |  |  |  | #warn("WRAP x=$x rm=$m w=", $m - $x, "\n"); | 
| 2868 |  |  |  |  |  |  |  | 
| 2869 | 72 |  |  |  |  | 175 | while ( @chords ) { | 
| 2870 | 144 |  |  |  |  | 295 | my $chord  = shift(@chords); | 
| 2871 | 144 |  | 50 |  |  | 353 | my $phrase = shift(@phrases) // ""; | 
| 2872 | 144 |  |  |  |  | 240 | my $ex = ""; | 
| 2873 |  |  |  |  |  |  | #warn("wrap x=$x rm=$m w=", $m - $x, " ch=$chord, ph=$phrase\n"); | 
| 2874 |  |  |  |  |  |  |  | 
| 2875 | 144 | 100 |  |  |  | 341 | if ( @rchords ) { | 
| 2876 |  |  |  |  |  |  | # Does the chord fit? | 
| 2877 | 72 |  |  |  |  | 404 | my $c = $chord->chord_display; | 
| 2878 | 72 |  |  |  |  | 1067 | my $w; | 
| 2879 | 72 | 50 |  |  |  | 271 | if ( $c =~ /^\*(.+)/ ) { | 
| 2880 | 0 |  |  |  |  | 0 | $pr->setfont( $pr->{ps}->{fonts}->{annotation} ); | 
| 2881 | 0 |  |  |  |  | 0 | $c = $1; | 
| 2882 |  |  |  |  |  |  | } | 
| 2883 |  |  |  |  |  |  | else { | 
| 2884 | 72 |  |  |  |  | 353 | $pr->setfont( $pr->{ps}->{fonts}->{chord} ); | 
| 2885 |  |  |  |  |  |  | } | 
| 2886 | 72 |  |  |  |  | 14448 | $w = $pr->strwidth($c); | 
| 2887 | 72 | 50 |  |  |  | 13872 | if ( $w > $m - $x ) { | 
| 2888 |  |  |  |  |  |  | # Nope. Move to overflow. | 
| 2889 | 0 |  |  |  |  | 0 | $ex = $phrase; | 
| 2890 |  |  |  |  |  |  | } | 
| 2891 |  |  |  |  |  |  | } | 
| 2892 |  |  |  |  |  |  |  | 
| 2893 | 144 | 50 |  |  |  | 399 | if ( $ex eq "" ) { | 
| 2894 |  |  |  |  |  |  | # Do lyrics fit? | 
| 2895 | 144 |  |  |  |  | 365 | my $font = $pr->{ps}->{fonts}->{text}; | 
| 2896 | 144 |  |  |  |  | 560 | $pr->setfont($font); | 
| 2897 | 144 |  |  |  |  | 27466 | my $ph; | 
| 2898 | 144 |  |  |  |  | 704 | ( $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 |  |  |  |  | 476 | my $w = $pr->strwidth($ph); | 
| 2902 | 144 | 50 | 33 |  |  | 39533 | if ( $w > $m - $x && @rchords > 1 ) { | 
| 2903 | 0 |  |  |  |  | 0 | $ex = $phrase; | 
| 2904 |  |  |  |  |  |  | } | 
| 2905 |  |  |  |  |  |  | else { | 
| 2906 | 144 |  |  |  |  | 386 | push( @rchords, $chord ); | 
| 2907 | 144 |  |  |  |  | 327 | push( @rphrases, $ph ); | 
| 2908 | 144 |  |  |  |  | 308 | $chord = ''; | 
| 2909 |  |  |  |  |  |  | } | 
| 2910 | 144 |  |  |  |  | 290 | $x += $w; | 
| 2911 |  |  |  |  |  |  | } | 
| 2912 |  |  |  |  |  |  |  | 
| 2913 | 144 | 50 |  |  |  | 590 | 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 |  |  |  |  | 719 | push( @$res, { %$elt, chords => \@rchords, phrases => \@rphrases } ); | 
| 2930 | 72 | 50 |  |  |  | 305 | $res->[-1]->{indent} = $pr->strwidth("x") if @$res > 1; | 
| 2931 | 72 |  |  |  |  | 206 | 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 | 2214 | $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 |  |  |  |  |  |  |  |