view release on metacpan or  search on metacpan

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

    $gfx->stroke if $strokecolor && !$fillcolor;
    $gfx->restore;
}

sub circle {
    my ( $self, $x, $y, $r, $lw, $fillcolor, $strokecolor ) = @_;
    my $gfx = $self->{pdfgfx};
    $gfx->save;
    $gfx->strokecolor($self->_fgcolor($strokecolor)) if $strokecolor;
    $gfx->fillcolor($self->_fgcolor($fillcolor)) if $fillcolor;
    $gfx->linewidth($lw||1);
    $gfx->circle( $x, $y, $r );
    $gfx->fill if $fillcolor && !$strokecolor;
    $gfx->fillstroke if $fillcolor && $strokecolor;
    $gfx->stroke if $strokecolor && !$fillcolor;
    $gfx->restore;
}

sub cross {
    my ( $self, $x, $y, $r, $lw, $strokecolor ) = @_;
    my $gfx = $self->{pdfgfx};
    $gfx->save;
    $gfx->strokecolor($self->_fgcolor($strokecolor)) if $strokecolor;
    $gfx->linewidth($lw||1);
    $r = 0.9 * $r;
    $gfx->move( $x-$r, $y-$r );
    $gfx->line( $x+$r, $y+$r );
    $gfx->stroke if $strokecolor;
    $gfx->move( $x-$r, $y+$r );
    $gfx->line( $x+$r, $y-$r );
    $gfx->stroke if $strokecolor;
    $gfx->restore;
}

# Fetch an image or xform object.
# Source is $elt->{uri} (for files), $elt->{chord} (for chords).
# Result is delivered, and stored in $elt->{data};
sub get_image {
    my ( $self, $elt ) = @_;

    my $img;
    my $subtype = $elt->{subtype};
    my $data;

    if ( $subtype eq "delegate" ) {
	croak("delegated image in get_image()");
    }

    if ( $elt->{data} ) {	# have data
	$data = $elt->{data};
	warn("get_image($elt->{subtype}): data ", length($data), " bytes\n")
	  if $config->{debug}->{images};
	return $data;
    }

    my $uri = $elt->{uri};
    if ( !$subtype && $uri =~ /\.(\w+)$/ ) {
	$subtype //= $1;
    }

    if ( $subtype =~ /^(jpg|png|gif)$/ ) {
	$img = $self->{pdf}->image($uri);
	warn("get_image($subtype, $uri): img ", length($img), " bytes\n")
	  if $config->{debug}->{images};
    }
    elsif ( $subtype =~ /^(xform)$/ ) {
	$img = $data;
	warn("get_image($subtype): xobject (",
#	     join(" ", $img->bbox),
	     join(" ", @{$data->{bbox}}),
	     ")\n")
	  if $config->{debug}->{images};
    }
    else {
	croak("Unhandled image type: $subtype\n");
    }
    return $img;
}

sub _xo_width {
    my ( $self ) = @_;
    my @bb = $self->bbox;
    return abs($bb[2]-$bb[0]);
}
sub _xo_height {
    my ( $self ) = @_;
    my @bb = $self->bbox;
    return abs($bb[3]-$bb[1]);
}

sub add_object {
    my ( $self, $o, $x, $y, %options ) = @_;

    my $scale_x = $options{"xscale"} || $options{"scale"} || 1;
    my $scale_y = $options{"yscale"} || $options{"scale"} || $scale_x;

    my $va = $options{valign} // "bottom";
    my $ha = $options{align}  // "left";

    my $gfx = $self->{pdfgfx};
    my $w = $o->width  * $scale_x;
    my $h = $o->height * $scale_y;

    if ( $config->{debug}->{images} ) {
	my $s;
	if ( abs( $scale_x - $scale_y ) < 0.01 ) {
	    $s = sprintf( "%.2f", $scale_x );
	}
	else {
	    $s = sprintf( "%.2f,%.2f", $scale_x, $scale_y );
	}
	warn( sprintf( "add_object x=%.1f y=%.1f w=%.1f h=%.1f scale=%s %s\n",
		       $x, $y, $w, $h, $s, $ha, ) );
    }

    $self->crosshairs( $x, $y, color => "lime" ) if $config->{debug}->{images};
    if ( $va eq "top" ) {
	$y -= $h;
    }
    elsif ( $va eq "middle" ) {
	$y -= $h/2;