view release on metacpan or  search on metacpan

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

		  ", swap = ", $swap ? "yes" : "no",
		  ", fmt = \"" . join('" "', @{$fmt->[0]}) . "\"\n");
	}
	return $fmt if $fmt;
    }
    return;
}

# Three-part titles.
# Note: baseline printing.
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;
	}