view release on metacpan or  search on metacpan

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

my $dcache;			# cache core grids
my $pdf = "";			# for cache flush

class ChordPro::Output::PDF::KeyboardDiagram;

field $pr       :param;

field $config;
field $ps;

field $kw;
field $kh;
field $lw;
field $fg;
field $keys;
field $base;
field $base_k;
field $show;
field $pressed;

ADJUST {
    $config	  = $::config;
    $ps		  = $pr->{ps};
    my $ctl	  = $ps->{kbdiagrams};
    $kw		  = $ctl->{width} || 6;
    $kh		  = $ctl->{height} || 6;
    $lw		  = ($ctl->{linewidth} || 0.10) * $kw;
    $keys	  = $ctl->{keys};
    $base	  = $ctl->{base};
    $show	  = $ctl->{show};
    $pressed	  = $ctl->{pressed};
    $dcache = {} if $pr->{pdf} ne $pdf;
    $pdf          = $pr->{pdf};

    unless ( $keys =~ /^(?:7|10|14|17|21)$/ ) {
	die("pdf.kbdiagrams.keys is $keys, must be one of 7, 10, 14, 17, or 21\n");
    }

    unless ( $base =~ /^(?:C|F)$/i ) {
	die("pdf.kbdiagrams.base is \"$base\", must be \"C\" or \"F\"\n");
    }
    if ( uc($base) eq 'C' ) {
	$base = $base_k = 0;
    }
    else {			# must be 'F'
	$base_k = 3;
	$base = 5;
    }

    unless ( $show =~ /^(?:top|bottom|right|below)$/i ) {
	die("pdf.kbdiagrams.show is \"$show\", must be one of ".
	    "\"top\", \"bottom\", \"right\", or \"below\"\n");
    }
}

use constant DIAG_DEBUG => 0;

# The vertical space the diagram requires.
method vsp0 ( $elt, $dummy = 0 ) {
    $ps->{fonts}->{diagram}->{size} * 1.2 + $kh + $lw;
}

# The advance height.
method vsp1 ( $elt, $dummy = 0 ) {
    $ps->{kbdiagrams}->{vspace} * $kh;
}

# The vertical space the diagram requires, including advance height.
method vsp ( $elt, $dummy = 0 ) {
    $self->vsp0($elt) + $self->vsp1($elt);
}

# The horizontal space the diagram requires.
method hsp0 ( $elt, $dummy = 0 ) {
    $lw + $keys * $kw;
}

# The advance width.
method hsp1 ( $elt, $dummy = 0 ) {
    $ps->{kbdiagrams}->{hspace} * $kw;
}

# The horizontal space the diagram requires, including advance width.
method hsp ( $elt, $dummy = 0 ) {
    $self->hsp0($elt) + $self->hsp1($ps);
}

my %keytypes =
  (  0 => [0,"L"],		# Left
     1 => [0,"B"],		# Black
     2 => [1,"M"],		# Middle
     3 => [1,"B"],
     4 => [2,"R"],		# Right
     5 => [3,"L"],
     6 => [3,"B"],
     7 => [4,"M"],
     8 => [4,"B"],
     9 => [5,"M"],
    10 => [5,"B"],
    11 => [6,"R"] );


# The actual draw method.
method draw ( $info, $x, $y, $dummy = 0 ) {
    return unless $info;
    my $w = $lw + $kw * $keys;
    $fg = $info->{diagram} // $ps->{theme}->{foreground};

    # Get (or infer) keys.
    my @keys = @{ChordPro::Chords::get_keys($info)};
    unless ( @keys ) {
	warn("PDF: No diagram for chord \"", $info->name, "\"\n");
    }

    my $font = $ps->{fonts}->{diagram};

    my $xo = $self->diagram_xo($info);
    my @bb = $xo->bbox;
    warn("BB [ @bb ] $x $y\n") if DIAG_DEBUG;
    $pr->{pdfgfx}->object( $xo, $x,
			   $y - ($font->{size} * 1.2 + $lw) );

    # Draw font name.
    $pr->setfont($font);
    my $name = $info->chord_display;
    $name .= "?" unless @keys;
    $name = "<span color='$fg'>$name</span>"
      if $info->{diagram};
    $pr->text( $name, $x + ($w - $pr->strwidth($name))/2, $y - $pr->font_bl($font) );
}

# Returns the complete diagram as an xo. This includes the core grid
# and pressed keys.
# Bounding box origin is top left of the grid.
# Note that the chord name is not part of the diagram.

method diagram_xo ($info) {
    return unless $info;

    my $col = $pressed // "red";
    $fg = $info->{diagram} // $fg // $ps->{theme}->{foreground};
    my $w = $lw + $kw * $keys;
    my $v = $kh;

    # Get (or infer) keys.
    my @keys = @{ChordPro::Chords::get_keys($info)};
    unless ( @keys ) {
	warn("PDF: No diagram for chord \"", $info->name, "\"\n");
    }

    my $xo = $pdf->xo_form;

    # Draw the core grid.
    $xo->line_width($lw);
    my $xg = $self->grid_xo;
    $xo->bbox( $xg->bbox );
    $xo->object( $xg, 0, 0, 1 );

    my $kk = ( $keys % 7 == 0 )
      ? 12 * int( $keys / 7 )
      : $keys == 10 ? 17 : 29;

    # Vertical offsets in the key image.
    my $t  = 0;
    my $m  = $t - $kh / 2;
    my $b  = $t - $kh;

    # Horizontal offsets in the key image.
    my $l  = 0;
    my $ml = $l + 1 * $kw / 3;
    my $mr = $l + 2 * $kw / 3;
    my $r  = $l + $kw; # 3 * $kw / 3;
    my $xr = $l + 4 * $kw / 3;

    # Don't use theme colour, use black & white.
    $xo->stroke_color($fg);
    $xo->fill_color($col);

    # Shift down if would start in 2nd octave.
    my $kd = -int(($keys[0] + $info->{root_ord}) / 12) * 12;
    # Adjust for diagram start.
    $kd+=12 if ($keys[0] + $info->{root_ord}) < $base;

    for my $key ( @keys ) {
	$key += $kd + $info->{root_ord};
	$key += 12 if $key < 0;
	$key -= 12 while $key >= $kk;
	# Get octave and reduce.
	my $o = int( $key / 12 ); # octave