view release on metacpan or  search on metacpan

lib/ChordPro/Output/PDF/Song.pm  view on Meta::CPAN

	# Physical coordinates; will be adjusted to columns if needed.
	$ps->{__leftmargin}   = $ps->{_marginleft};
	$ps->{__rightmargin}  = $ps->{_marginright};
	$ps->{__topmargin}    = $ps->{_margintop};
	$ps->{__bottommargin} = $ps->{_marginbottom};

	$s->{meta}->{page} = [ $s->{page} = $opts->{roman}
			       ? roman($page_num) : $page_num ];

	# Determine page class.
	my $class = 2;		# default
	if ( $page_num == 1 ) {
	    $class = 0;		# very first page
	}
	elsif ( $page_num == $startpage ) {
	    $class = 1;		# first of a song
	}
	$s->{meta}->{'page.class'} = $classes[$class];
	# Remember first page (see below).
	$s->{meta}->{'page.first.side'} //= $s->{meta}->{'page.side'};
	warn("page: $page_num($page_idx), side = ", $s->{meta}->{'page.side'},
	     " 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.