view release on metacpan or  search on metacpan

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

sub fix_musicsyms {
    my ( $text, $font ) = @_;

    for ( $text ) {
	if ( /♯/ ) {
	    unless ( $font->{has_sharp} //=
		     $font->{fd}->{font}->glyphByUni(ord("♯")) ne ".notdef" ) {
		s;♯;<sym sharp/>;g;
	    }
	}
	if ( /â™­/ ) {
	    unless ( $font->{has_flat} //=
		     $font->{fd}->{font}->glyphByUni(ord("â™­")) ne ".notdef" ) {
		s;â™­;<sym flat/>;g;
	    }
	}
	if ( /Δ/ ) {
	    unless ( $font->{has_delta} //=
		     $font->{fd}->{font}->glyphByUni(ord("Δ")) ne ".notdef" ) {
		s;Δ;<sym delta/>;g;
	    }
	}
    }
    return $text;
}

sub text {
    my ( $self, $text, $x, $y, $font, $size, $nomarkup ) = @_;
#    print STDERR ("T: @_\n");
    $font ||= $self->{font};
    $text = fix_musicsyms( $text, $font );
    $size ||= $font->{size};

    $self->{layout}->set_font_description($font->{fd});
    $self->{layout}->set_font_size($size);
    # We don't have set_color in the API.
    $self->{layout}->{_currentcolor} = $self->_fgcolor($font->{color});
    # Watch out for regression... May have to do this in the nomarkup case only.
    if ( $nomarkup ) {
	$text =~ s/'/\x{2019}/g;		# friendly quote
	$self->{layout}->set_text($text);
    }
    else {
	$self->{layout}->set_markup($text);
	for ( @{ $self->{layout}->{_content} } ) {
	    next unless $_->{type} eq "text";
	    $_->{text} =~ s/\'/\x{2019}/g;	# friendly quote
	}
    }
    $y -= $self->{layout}->get_baseline;
    $self->{layout}->show( $x, $y, $self->{pdftext} );

    my $e = $self->{layout}->get_pixel_extents;
    $e->{y} += $e->{height};

    # Handle decorations (background, box).
    my $bgcol = $self->_bgcolor($font->{background});
    undef $bgcol if $bgcol && $bgcol =~ /^no(?:ne)?$/i;
    my $debug = $ENV{CHORDPRO_DEBUG_TEXT} ? "magenta" : undef;
    my $frame = $font->{frame} || $debug;
    undef $frame if $frame && $frame =~ /^no(?:ne)?$/i;
    if ( $bgcol || $frame ) {
	printf("BB: %.2f %.2f %.2f %.2f\n", @{$e}{qw( x y width height ) } )
	  if $debug;
	# Draw background and.or frame.
	my $d = $debug ? 0 : 1;
	$frame = $debug || $font->{color} || $self->{ps}->{theme}->{foreground} if $frame;
	$self->rectxy( $x + $e->{x} - $d,
		       $y + $e->{y} + $d,
		       $x + $e->{x} + $e->{width} + $d,
		       $y + $e->{y} - $e->{height} - $d,
		       0.5, $bgcol, $frame);
    }

    $x += $e->{width};
#    print STDERR ("TX: $x\n");
    return $x;
}

sub setfont {
    my ( $self, $font, $size ) = @_;
    $self->{font} = $font;
    warn("PDF: Font ", $font->{_ff}, " should have a size!\n")
      unless $size ||= $font->{size};
    $self->{fontsize} = $size ||= $font->{size} || $font->{fd}->{size};
    $self->{pdftext}->font( $font->{fd}->{font}, $size );
}

sub font_bl {
    my ( $self, $font ) = @_;
#    $font->{size} / ( 1 - $font->{fd}->{font}->descender / $font->{fd}->{font}->ascender );
    $font->{size} * $font->{fd}->{font}->ascender / 1000;
}

sub font_ul {
    my ( $self, $font ) = @_;
    $font->{fd}->{font}->underlineposition / 1024 * $font->{size};
}

sub strwidth {
    my ( $self, $text, $font, $size ) = @_;
    $font ||= $self->{font};
    $text = fix_musicsyms( $text, $font );
    $size ||= $self->{fontsize} || $font->{size};
    $self->{tmplayout} //= $self->{layout}->copy;
    $self->{tmplayout}->set_font_description($font->{fd});
    $self->{tmplayout}->set_font_size($size);
    $self->{tmplayout}->set_markup($text);
    wantarray ? $self->{tmplayout}->get_pixel_size
      : $self->{tmplayout}->get_pixel_size->{width};
}

sub strheight {
    my ( $self, $text, $font, $size ) = @_;
    $font ||= $self->{font};
    $text = fix_musicsyms( $text, $font );
    $size ||= $self->{fontsize} || $font->{size};
    $self->{tmplayout} //= $self->{layout}->copy;
    $self->{tmplayout}->set_font_description($font->{fd});
    $self->{tmplayout}->set_font_size($size);
    $self->{tmplayout}->set_markup($text);
    wantarray ? $self->{tmplayout}->get_pixel_size
      : $self->{tmplayout}->get_pixel_size->{height};
}

sub line {
    my ( $self, $x0, $y0, $x1, $y1, $lw, $color ) = @_;
    my $gfx = $self->{pdfgfx};
    $gfx->save;
    $gfx->strokecolor( $self->_fgcolor($color) );
    $gfx->linecap(1);
    $gfx->linewidth($lw||1);