App-Music-ChordPro
view release on metacpan or search on metacpan
lib/ChordPro/Output/PDF/Song.pm view on Meta::CPAN
" class = ", $classes[$class], "\n")
if $::config->{debug}->{pages} & 0x01;
# Three-part title handlers.
my $tpt = sub { tpt( $ps, $class, $_[0], $rightpage, $x, $y, $s ) };
$x = $ps->{__leftmargin};
if ( $ps->{headspace} ) {
warn("Metadata for pageheading: ", ::dump($s->{meta}), "\n")
if $config->{debug}->{meta};
$y = $ps->{_margintop} + $ps->{headspace};
$y -= $pr->font_bl($fonts->{title});
$y = $tpt->("title");
$y = $tpt->("subtitle");
}
if ( $ps->{footspace} ) {
$y = $ps->{marginbottom} - $ps->{footspace};
$tpt->("footer");
}
}
# This is mainly for debugging/development.
$s->{meta}->{'page.side'} = delete $s->{meta}->{'page.first.side'};
return $pages;
}
sub prlabel {
my ( $ps, $label, $x, $y ) = @_;
return if $label eq "" || $ps->{_indent} == 0;
my $align = $ps->{labels}->{align};
my $font= $ps->{fonts}->{label} || $ps->{fonts}->{text};
$font->{size} ||= $font->{fd}->{size};
$ps->{pr}->setfont($font); # for strwidth.
# Now we have quoted strings we can have real newlines.
# Split on real and unescaped (old style) newlines.
for ( split( /\\n|\n/, $label ) ) {
my $label = $_;
if ( $align eq "right" ) {
my $avg_space_width = $ps->{pr}->strwidth("m");
$ps->{pr}->text( $label,
$x - $avg_space_width - $ps->{pr}->strwidth($label),
$y, $font );
}
elsif ( $align =~ /^cent(?:er|re)$/ ) {
$ps->{pr}->text( $label,
$x - $ps->{_indent} + $ps->{pr}->strwidth($label)/2,
$y, $font );
}
else {
$ps->{pr}->text( $label,
$x - $ps->{_indent}, $y, $font );
}
$y -= $font->{size} * 1.2;
}
}
# Propagate markup entries over the fragments so that each fragment
# is properly terminated.
sub defrag {
my ( $frag ) = @_;
my @stack;
my @res;
foreach my $f ( @$frag ) {
my @a = split( /(<.*?>)/, $f );
if ( @stack ) {
unshift( @a, @stack );
@stack = ();
}
my @r;
foreach my $a ( @a ) {
if ( $a =~ m;^<\s*/\s*(\w+)(.*)>$; ) {
my $k = $1;
#$a =~ s/\b //g;
#$a =~ s/ \b//g;
if ( @stack ) {
if ( $stack[-1] =~ /^<\s*$k\b/ ) {
pop(@stack);
}
else {
warn("Markup error: \"@$frag\"\n",
" Closing <$k> but $stack[-1] is open\n");
next;
}
}
else {
warn("Markup error: \"@$frag\"\n",
" Closing <$k> but no markup is open\n");
next;
}
}
elsif ( $a =~ m;^<\s*(\w+)(.*)>$; ) {
my $k = $1;
my $v = $2;
# Do not push if self-closed.
push( @stack, "<$k$v>" ) unless $v =~ m;/\s*$;;
}
push( @r, $a );
}
if ( @stack ) {
push( @r, map { my $t = $_;
$t =~ s;^<\s*(\w+).*;</$1>;;
$t; } reverse @stack );
}
push( @res, join("", @r ) );
}
if ( @stack ) {
warn("Markup error: \"@$frag\"\n",
" Unclosed markup: @{[ reverse @stack ]}\n" );
}
#warn("defrag: ", join('', @res), "\n");
\@res;
}
sub songline {
my ( $elt, $x, $ytop, $ps, %opts ) = @_;
# songline draws text in boxes as follows:
#
# +------------------------------
# | C F G
# |
# +------------------------------
# | Lyrics text
# +------------------------------
#
# Variants are:
#
# +------------------------------
# | Lyrics text (lyrics-only, or single-space and no chords)
# +------------------------------
#
# Likewise comments and tabs (which may have different fonts /
# decorations).
#
# And:
#
# +-----------------------+-------
# | Lyrics text | C F G
# +-----------------------+-------
#
# Note that printing text involves baselines, and that chords
# may have a different height than lyrics.
#
# To find the upper/lower extents, the ratio
#
# $font->ascender / $font->descender
#
# can be used. E.g., a font of size 16 with descender -250 and
# ascender 750 must be drawn at 12 points under $ytop.
my $pr = $ps->{pr};
my $fonts = $ps->{fonts};
my $type = $elt->{type};
my $ftext;
my $ytext;
my @phrases = @{ defrag( $elt->{phrases} ) };
if ( $type =~ /^comment/ ) {
$ftext = $elt->{font} || $fonts->{$type} || $fonts->{comment};
$ytext = $ytop - $pr->font_bl($ftext);
my $song = $opts{song};
$x += $opts{indent} if $opts{indent};
$x += $elt->{indent} if $elt->{indent};
pr_label_maybe( $ps, $x, $ytext );
my $t = $elt->{text};
if ( $elt->{chords} ) {
$t = "";
my @ph = @{ $elt->{phrases} };
for ( @{ $elt->{chords} }) {
my $chord = $_; # prevent chord clobber in 2pass mode
if ( $chord eq '' ) {
}
else {
$chord = $chord->chord_display;
}
$t .= $chord . shift(@ph);
}
}
my ( $text, $ex ) = wrapsimple( $pr, $t, $x, $ftext );
$pr->text( $text, $x, $ytext, $ftext );
my $wi = $pr->strwidth( $config->{settings}->{wrapindent} );
return $ex ne ""
? { %$elt,
indent => $wi,
text => $ex, chords => undef }
: undef;
}
if ( $type eq "tabline" ) {
$ftext = $fonts->{tab};
$ytext = $ytop - $pr->font_bl($ftext);
$x += $opts{indent} if $opts{indent};
pr_label_maybe( $ps, $x, $ytext );
$pr->text( $elt->{text}, $x, $ytext, $ftext, undef, "no markup" );
return;
}
# assert $type eq "songline";
$ftext = $fonts->{ $elt->{context} eq "chorus" ? "chorus" : "text" };
$ytext = $ytop - $pr->font_bl($ftext); # unless lyrics AND chords
my $fchord = $fonts->{chord};
my $ychord = $ytop - $pr->font_bl($fchord);
# Just print the lyrics if no chords.
if ( $lyrics_only
or
$suppress_empty_chordsline && !has_visible_chords($elt)
) {
my $x = $x;
$x += $opts{indent} if $opts{indent};
$x += $elt->{indent} if $elt->{indent};
pr_label_maybe( $ps, $x, $ytext );
my ( $text, $ex ) = wrapsimple( $pr, join( "", @phrases ),
$x, $ftext );
$pr->text( $text, $x, $ytext, $ftext );
my $wi = $pr->strwidth( $config->{settings}->{wrapindent} );
lib/ChordPro/Output/PDF/Song.pm view on Meta::CPAN
}
warn("Image scale: $scalex $scaley\n") if $config->{debug}->{images};
$h *= $scalex;
$w *= $scaley;
my $align = $opts->{align};
$align //= ( $opts->{center} // 1 ) ? "center" : "left";
# Note that image is placed aligned on $x.
if ( $align eq "center" ) {
$x += $pw / 2;
}
elsif ( $align eq "right" ) {
$x += $pw;
}
warn("Image $align: $_[1] -> $x\n") if $config->{debug}->{images};
warn("add_image\n") if $config->{debug}->{images};
# $pr->add_image( $img, $x, $y, $w, $h, $opts->{border} || 0 );
$pr->add_object( $img, $x, $y,
xscale => $w/$img->width,
yscale => $h/$img->height,
border => $opts->{border} || 0,
maybe bordertrbl => $opts->{bordertrbl},
valign => "top",
align => $align,
);
return $h + $si->{space}; # vertical size
}
sub tocline {
my ( $elt, $x, $y, $ps ) = @_;
my $pr = $ps->{pr};
my $fonts = $ps->{fonts};
my $y0 = $y;
my $ftoc = $fonts->{toc};
$y -= $pr->font_bl($ftoc);
$pr->setfont($ftoc);
my $tpl = $elt->{title};
my $lines = 0;
my $blines = 0; # lines for break
my $vsp;
my $p = $elt->{pageno} // "";
my $pw = $pr->strwidth($p);
my $ww = $ps->{__rightmargin} - $x - $pr->strwidth("xxx$p");
# Formatter sub.
my $f = sub {
my ( $tpl, $p ) = @_;
my $vsp;
for my $text ( split( /\\n|\n/, $tpl ) ) {
$lines++;
# Suppress unclosed markup warnings.
local $SIG{__WARN__} = sub{
CORE::warn(@_) unless "@_" =~ /Unclosed markup/;
};
# Get the part that fits (hopefully, all) and print.
( $text, my $ex ) = @{ defrag( [ $pr->wrap( $text, $ww ) ] ) };
$pr->text( $text, $x, $y );
unless ($vsp) {
$ps->{pr}->text( $p, $ps->{__rightmargin} - $pw, $y );
$vsp = _vsp("toc", $ps);
$x += $pr->strwidth( $config->{settings}->{wrapindent} )
if $ex ne "";
}
$y -= $vsp;
if ( $ex ne "" ) {
$text = $ex;
redo;
}
}
return $vsp;
};
# First the break, if any. No page number.
if ( $elt->{break} ) {
$vsp = $f->( $elt->{break}, "" );
$blines = $lines;
$lines = 0;
}
# Then the actual content line, with page number.
$vsp = $f->( $tpl, $p );
if ( $elt->{page} ) {
my $ann = $pr->{pdfpage}->annotation;
$ann->link($elt->{page});
$ann->rect( $ps->{__leftmargin}, $y0-($blines+$lines)*$vsp, $ps->{__rightmargin}, $y0-$blines*$vsp );
}
return $blines + $lines;
}
sub has_visible_chords {
my ( $elt ) = @_;
if ( $elt->{chords} ) {
for ( @{ $elt->{chords} } ) {
next if defined;
warn("Undefined chord in chords: ", ::dump($elt) );
}
return join( "", @{ $elt->{chords} } ) =~ /\S/;
}
return;
}
sub has_visible_text {
my ( $elt ) = @_;
$elt->{phrases} && join( "", @{ $elt->{phrases} } ) =~ /\S/;
}
sub songline_vsp {
my ( $elt, $ps ) = @_;
# Calculate the vertical span of this songline.
my $fonts = $ps->{fonts};
if ( $elt->{type} =~ /^comment/ ) {
my $ftext = $fonts->{$elt->{type}} || $fonts->{comment};
lib/ChordPro/Output/PDF/Song.pm view on Meta::CPAN
sub tpt {
my ( $ps, $class, $type, $rightpage, $x, $y, $s ) = @_;
my $fmt = get_format( $ps, $class, $type, $rightpage );
return unless $fmt;
warn("page: ", $s->{meta}->{page}->[0],
", fmt[", $s->{meta}->{"page.class"}, ",$type] = \"",
join('" "',@{$fmt->[0]}), "\"\n" )
if $::config->{debug}->{pages} & 0x01;
my $pr = $ps->{pr};
my $font = $ps->{fonts}->{$type};
my $havefont;
my $rm = $ps->{papersize}->[0] - $ps->{_rightmargin};
for my $fmt ( @$fmt ) {
if ( @$fmt % 3 ) {
die("ASSERT: " . scalar(@$fmt)," part format $class $type");
}
# Left part. Easiest.
if ( $fmt->[0] ) {
my $t = fmt_subst( $s, $fmt->[0] );
if ( $t ne "" ) {
$pr->setfont($font) unless $havefont++;
$pr->text( $t, $x, $y );
}
}
# Center part.
if ( $fmt->[1] ) {
my $t = fmt_subst( $s, $fmt->[1] );
if ( $t ne "" ) {
$pr->setfont($font) unless $havefont++;
$pr->text( $t, ($rm+$x-$pr->strwidth($t))/2, $y );
}
}
# Right part.
if ( $fmt->[2] ) {
my $t = fmt_subst( $s, $fmt->[2] );
if ( $t ne "" ) {
$pr->setfont($font) unless $havefont++;
$pr->text( $t, $rm-$pr->strwidth($t), $y );
}
}
$y -= $font->{size} * ($ps->{spacing}->{$type} || 1);
}
# Return updated baseline.
return $y;
}
sub wrap {
my ( $pr, $elt, $x ) = @_;
return [ $elt ] unless $::config->{settings}->{wraplines};
my $res = [];
my @chords = @{ $elt->{chords} // [] };
my @phrases = @{ defrag( $elt->{phrases} // [] ) };
my @rchords;
my @rphrases;
my $m = $pr->{ps}->{__rightmargin};
my $wi = $pr->strwidth( $config->{settings}->{wrapindent},
$pr->{ps}->{fonts}->{text} );
#warn("WRAP x=$x rm=$m w=", $m - $x, "\n");
while ( @chords ) {
my $chord = shift(@chords);
my $phrase = shift(@phrases) // "";
my $ex = "";
#warn("wrap x=$x rm=$m w=", $m - $x, " ch=$chord, ph=$phrase\n");
if ( @rchords && $chord ) {
# Does the chord fit?
my $c = $chord->chord_display;
my $w;
if ( $c =~ /^\*(.+)/ ) {
$pr->setfont( $pr->{ps}->{fonts}->{annotation} );
$c = $1;
}
else {
$pr->setfont( $pr->{ps}->{fonts}->{chord} );
}
$w = $pr->strwidth($c);
if ( $w > $m - $x ) {
# Nope. Move to overflow.
$ex = $phrase;
}
}
if ( $ex eq "" ) {
# Do lyrics fit?
my $font = $pr->{ps}->{fonts}->{text};
$pr->setfont($font);
my $ph;
( $ph, $ex ) = $pr->wrap( $phrase, $m - $x );
# If it doesn not fit, it is usually a case a bad luck.
# However, we may be able to move to overflow.
my $w = $pr->strwidth($ph);
if ( $w > $m - $x && @rchords > 1 ) {
$ex = $phrase;
}
else {
push( @rchords, $chord );
push( @rphrases, $ph );
$chord = '';
}
$x += $w;
}
if ( $ex ne "" ) { # overflow
if ( $rphrases[-1] =~ /[[:alpha:]]$/
&& $ex =~ /^[[:alpha:]]/
&& $chord ne '' ) {
$rphrases[-1] .= "-";
}
unshift( @chords, $chord );
unshift( @phrases, $ex );
push( @$res,
( run in 1.322 second using v1.01-cache-2.11-cpan-b16cb0d3907 )