view release on metacpan or  search on metacpan

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

    if ( $self->{pdf}->can("info_metadata") ) {
	for ( keys(%info) ) {
	    $self->{pdf}->info_metadata( $_, demarkup($info{$_}) );
	}
	if ( $config->{debug}->{runtimeinfo} ) {
	    $self->{pdf}->info_metadata( "RuntimeInfo",
					 "Runtime Info:\n" . ::runtimeinfo() );
	}
    }
    else {
	$self->{pdf}->info(%info);
    }
}

# Return a PDF compliant date/time string.
sub pdf_date {
    my ( $t ) = @_;
    $t ||= $regtest ? $faketime : time;

    my @tm = gmtime($t);

    return sprintf(
        "%04d%02d%02d%02d%02d%02d+00'00'",
        1900 + $tm[5],
        $tm[4] + 1,
        $tm[3],
        $tm[2],
        $tm[1],
        $tm[0],
    );
}

sub wrap {
    my ( $self, $text, $m ) = @_;

    my $ex = "";
    my $sp = "";
    #warn("TEXT: |$text| ($m)\n");
    while ( $self->strwidth($text) > $m ) {
	my ( $l, $s, $r ) = $text =~ /^(.+)([-_,.:;\s])(.+)$/;
	return ( $text, $ex ) unless defined $s;
	#warn("WRAP: |$text| -> |$l|$s|$r$sp$ex|\n");
	if ( $s =~ /\S/ ) {
	    $l .= $s;
	    $s = "";
	}
	$text = $l;
	$ex = $r . $sp . $ex;
	$sp = $s;
    }

    return ( $text, $ex );
}

sub _fgcolor {
    my ( $self, $col ) = @_;
    if ( !defined($col) || $col =~ /^foreground(?:-medium|-light)?$/ ) {
	$col = $self->{ps}->{theme}->{$col//"foreground"};
    }
    elsif ( $col eq "background" ) {
	$col = $self->{ps}->{theme}->{background};
    }
    elsif ( !$col ) {
	Carp::confess("Undefined fgcolor: $col");
    }
    $col;
}

sub _bgcolor {
    my ( $self, $col ) = @_;
    if ( !defined($col) || $col eq "background" ) {
	$col = $self->{ps}->{theme}->{background};
    }
    elsif ( $col =~ /^foreground(?:-medium|-light)?$/ ) {
	$col = $self->{ps}->{theme}->{$col};
    }
    elsif ( !$col ) {
	Carp::confess("Undefined bgcolor: $col");
    }
    $col;
}

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};
}

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

	    $gfx->stroke;
	}
    }

    if ( $options{href} ) {
	my $a = $gfx->{' apipage'}->annotation;
	$a->url( $options{href}, -rect => [ $x, $y, $x+$w, $y+$h ] );
    }

    $gfx->restore;
}

# For convenience.
sub crosshairs {
    my ( $self, $x, $y, %options ) = @_;
    my $gfx = $self->{pdfgfx};
    my $col = $options{colour} || $options{color} || "black";
    my $lw  = $options{linewidth} || 0.1;
    my $w  = ( $options{width} || 40 ) / 2;
    my $h  = ( $options{width} || $options{height} || 40 ) / 2;
    for ( $gfx  ) {
	$_->save;
	$_->line_width($lw);
	$_->stroke_color($col);
	$_->move($x-$w,$y);
	$_->hline($x+$w);
	$_->move($x,$y+$h);
	$_->vline($y-$h);
	$_->stroke;
	$_->restore;
    }
}

sub add_image {
    my ( $self, $img, $x, $y, $w, $h,
	 $border, $trbl ) = @_;
    $self->add_object( $img, $x, $y,
		       xscale => $w/$img->width,
		       yscale => $h/$img->height,
		       valign => "bottom",
		       maybe border     => $border,
		       maybe bordertrbl => $trbl );
}

sub newpage {
    my ( $self, $page ) = @_;
    my $ps = $self->{ps};
    #$self->{pdftext}->textend if $self->{pdftext};
    $page ||= 0;

    # PDF::API2 says $page must refer to an existing page.
    # Set to 0 to append.
    $page = 0 if $page == $self->{pdf}->pages + 1;

    $self->{pdfpage} = $self->{pdf}->page($page);
    $self->{pdfpage}->mediabox( $ps->{papersize}->[0],
				$ps->{papersize}->[1] );

    $self->{pdfgfx}  = $self->{pdfpage}->gfx;
    $self->{pdftext} = $self->{pdfpage}->text;
    unless ($ps->{theme}->{background} =~ /^white|none|#ffffff$/i ) {
	for ( $self->{pdfgfx} ) {
	    $_->save;
	    $_->fillcolor( $ps->{theme}->{background} );
	    $_->linewidth(0);
	    $_->rectxy( 0, 0, $ps->{papersize}->[0],
			$ps->{papersize}->[1] );
	    $_->fill;
	    $_->restore;
	}
    }
}

# Align.
# Ordinal page numbers start with 1.
# Assuming the next page to be written is $page, do we need
# to insert alignment pages?
# If so, insert them, and return the number of pages inserted (zero or one).
# Alignment is to an odd page, except for the back matter, whose
# final page must be even.

sub page_align {
    my ( $self, $pagectrl, $part, $page, $even ) = @_;
    my $ret = $self->_page_align( $pagectrl, $part, $page, $even );
    warn( "ALIGN( $part, page $page, ",
	  defined($even) ? "even $even, " : "",
	  ChordPro::Output::PDF::pagectrl_msg($pagectrl),
	  " ) -> $ret\n")
      if exists($::config->{debug}->{pagealign})
      && $::config->{debug}->{pagealign};
    return $ret;
}

sub _page_align {
    my ( $self, $pagectrl, $part, $page, $even ) = @_;
    $even ||= 0;

    # Only align to odd pages.
    return 0 if $even xor is_odd($page);	# already odd/even
    return 0 unless $pagectrl->{dual_pages};	# no alignment
    return 0 unless $pagectrl->{align_songs};	# no alignment

    use List::Util 'shuffle';
    my $ps = $self->{ps};
    my $bg;
    my $ffile;
    my $filler;
    if ( ($bg = $ps->{formats}->{filler}->{background})
	 &&
	 ( $ffile = expand_tilde($bg) )
	 &&
	 ( $filler = $self->{pdfapi}->open($ffile) )
       ) {
	state $file = "";
	state @pages;
	if ( $file ne $ffile || !@pages ) {
	    $file = $ffile;
	    # Try to make it reproducible.
	    local $ENV{PERL_HASH_SEED} = 0x12a02ab;
	    srand();
	    @pages = shuffle( 1..$filler->pages );
	}
	# Pick a random page.
	$self->{pdf}->import_page( $filler, shift(@pages), $page );
    }
    else {
	$self->newpage($page);
    }
    return 1;		# number of pages added
}

sub openpage {
    my ( $self, $page ) = @_;
    $self->{pdfpage} = $self->{pdf}->openpage($page);
    confess("Fatal: Page $page not found.") unless $self->{pdfpage};
    $self->{pdfgfx}  = $self->{pdfpage}->gfx;
    $self->{pdftext} = $self->{pdfpage}->text;
}

sub importpage {
    my ( $self, $fn, $pg ) = @_;
    my $bg = $self->{pdfapi}->open($fn);
    return unless $bg;		# should have been checked
    $pg = $bg->pages if $pg > $bg->pages;
    $self->{pdf}->import_page( $bg, $pg, $self->{pdfpage} );
    # Make sure the contents get on top of it.
    $self->{pdfgfx}  = $self->{pdfpage}->gfx;
    $self->{pdftext} = $self->{pdfpage}->text;
}

sub importfile {
    my ( $self, $filename ) = @_;
    my $pdf = $self->{pdfapi}->open($filename);
    return unless $pdf;		# should have been checked
    for ( my $page = 1; $page <= $pdf->pages; $page++ ) {
	$self->{pdf}->import_page( $pdf, $page );
    }
    return { pages => $pdf->pages, $pdf->info_metadata };
}

sub pagelabel {
    my ( $self, $page, $style, $prefix, $start ) = @_;
    $style //= 'arabic';
    $start //= 1;

    # PDF::API2 2.042 has some incompatible changes...
    my $c = $self->{pdf}->can("page_labels");
    if ( $c ) {			# 2.042+