view release on metacpan or  search on metacpan

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

our $config;

package ChordPro::Output::ChordPro;

use v5.26;
use utf8;
use Carp;
use feature qw( signatures );
no warnings "experimental::signatures";

use ChordPro::Output::Common;
use ChordPro::Utils qw( fq qquote demarkup is_true is_ttrue );
use Ref::Util qw( is_arrayref );

my $re_meta;

sub generate_songbook ( $self, $sb ) {

    # Skip empty songbooks.
    return [] unless eval { $sb->{songs}->[0]->{body} };

    # Build regex for the known metadata items.
    $re_meta = join( '|',
		     map { quotemeta }
		     "title", "subtitle",
		     "artist", "composer", "lyricist", "arranger",
		     "album", "copyright", "year",
		     "key", "time", "tempo", "capo", "duration" );
    $re_meta = qr/^($re_meta)$/;

    my @book;

    foreach my $song ( @{$sb->{songs}} ) {
	if ( @book ) {
	    push(@book, "") if $options->{'backend-option'}->{tidy};
	    push(@book, "{new_song}");
	}
	push(@book, @{generate_song($song)});
    }

    push( @book, "");
    \@book;
}

my $lyrics_only = 0;
my $variant = 'cho';
my $rechorus;

sub upd_config () {
    $rechorus = $::config->{chordpro}->{chorus}->{recall};
    $lyrics_only = 2 * $::config->{settings}->{'lyrics-only'};
}

sub generate_song ( $s ) {

    my $tidy = $options->{'backend-option'}->{tidy};
    my $structured = ( $options->{'backend-option'}->{structure} // '' ) eq 'structured';
    # $s->structurize if ++$structured;
    $variant = $options->{'backend-option'}->{variant} || 'cho';
    my $seq  = $options->{'backend-option'}->{seq};
    my $expand = $options->{'backend-option'}->{expand};
    my $msp  = $variant eq "msp";
    my $movable = ChordPro::Chords::Parser->get_parser($s->{system})->movable;
    upd_config();

    my @s;
    my %imgs;

    if ( $s->{preamble} ) {
	@s = @{ $s->{preamble} };
    }

    push(@s, "{title: " . fq($s->{meta}->{title}->[0]) . "}")
      if defined $s->{meta}->{title};
    if ( defined $s->{subtitle} ) {
	push(@s, map { +"{subtitle: ".fq($_)."}" } @{$s->{subtitle}});
    }

    if ( $s->{meta} ) {
	if ( $msp ) {
	    $s->{meta}->{source} //= [ "Lead Sheet" ];
	    $s->{meta}->{custom2} //= [ $seq ] if defined $seq;
	}
	# Known ones 'as is'.
	my %used;
	foreach my $k ( sort keys %{ $s->{meta} } ) {
	    next if $k =~ /^(?:title|subtitle|key)$/;
	    if ( $k =~ $re_meta ) {
		$used{$k}++;
		push( @s, map { +"{$k: ".fq($_)."}" } @{ $s->{meta}->{$k} } );
	    }
	}
	# Unknowns with meta prefix.
	foreach my $k ( sort keys %{ $s->{meta} } ) {
	    next if $used{$k};
	    next if $k =~ /^(?:title|subtitle|songindex|key.*|chords|numchords)$/;
	    next if $k =~ /^_/;
	    next if $k =~ /\./;
	    next if $k =~ /^bookmark/;
	    push( @s, map { +"{meta: $k ".fq($_)."}" } @{ $s->{meta}->{$k} } );
	}
    }

    if ( $s->{settings} ) {
	foreach ( sort keys %{ $s->{settings} } ) {
	    if ( $_ eq "diagrams" ) {
		next if $s->{settings}->{diagrampos};
		my $v = $s->{settings}->{$_};
		if ( is_ttrue($v) ) {
		    $v = "on";
		}
		elsif ( is_true($v) ) {
		}
		else {
		    $v = "off";
		}
		push(@s, "{diagrams: $v}");
	    }
	    elsif ( $_ eq "diagrampos" ) {
		my $v = $s->{settings}->{$_};
		push(@s, "{diagrams: $v}");

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

	    push(@s, "") if $tidy;
	    foreach my $e ( @{$elt->{body}} ) {
		if ( $e->{type} eq "empty" ) {
		    push(@s, "***SHOULD NOT HAPPEN***"), next
		      if $structured;
		}
		if ( $e->{type} eq "song" ) {
		    push(@s, songline( $s, $e ));
		    next;
		}
	    }
	    push(@s, "") if $tidy;
	    next;
	}

	if ( $elt->{type} eq "chorus" ) {
	    push(@s, "") if $tidy;
	    push(@s, "{start_of_chorus*}");
	    foreach my $e ( @{$elt->{body}} ) {
		if ( $e->{type} eq "empty" ) {
		    push(@s, "");
		    next;
		}
		if ( $e->{type} eq "songline" ) {
		    push(@s, songline( $s, $e ));
		    next;
		}
	    }
	    push(@s, "{end_of_chorus*}");
	    push(@s, "") if $tidy;
	    next;
	}

	if ( $elt->{type} eq "rechorus" ) {
	    if ( $msp ) {
		push( @s, "{chorus}" );
	    }
	    elsif ( $rechorus->{quote} ) {
		unshift( @elts, @{ $elt->{chorus} } );
	    }
	    elsif ( $rechorus->{type} &&  $rechorus->{tag} ) {
		push( @s, "{".$rechorus->{type}.": ".$rechorus->{tag}."}" );
	    }
	    else {
		push( @s, "{chorus}" );
	    }
	    next;
	}

	if ( $elt->{type} eq "tab" ) {
	    push(@s, "") if $tidy;
	    push(@s, "{start_of_tab}");
	    push(@s, @{$elt->{body}});
	    push(@s, "{end_of_tab}");
	    push(@s, "") if $tidy;
	    next;
	}

	if ( $elt->{type} =~ /^comment(?:_italic|_box)?$/ ) {
	    my $type = $elt->{type};
	    my $text = $expand ? $elt->{text} : $elt->{orig};
	    if ( $msp ) {
		$type = $type eq 'comment'
		  ? 'highlight'
		    : $type eq 'comment_italic'
		      ? 'comment'
		      : $type;
	    }
	    # Flatten chords/phrases.
	    if ( $elt->{chords} ) {
		$text = "";
		for ( 0..$#{ $elt->{chords} } ) {
		    $text .= "[" . fq(chord( $s, $elt->{chords}->[$_])) . "]"
		      if $elt->{chords}->[$_] ne "";
		    $text .= $elt->{phrases}->[$_];
		}
	    }
	    $text = fmt_subst( $s, $text ) if $msp;
	    push(@s, "") if $tidy;
	    push(@s, "{$type: ".fq($text)."}");
	    push(@s, "") if $tidy;
	    next;
	}

	if ( $elt->{type} eq "image" && !$msp ) {
	    my $uri = $s->{assets}->{$elt->{id}}->{uri};
	    if ( $msp && $uri !~ /^id=/ ) {
		$imgs{$uri} //= keys(%imgs);
		$uri = sprintf("id=img%02d", $imgs{$uri});
	    }
	    my @args = ( "image:", qquote($uri) );
	    while ( my($k,$v) = each( %{ $elt->{opts} } ) ) {
		$v = join( ",",@$v ) if is_arrayref($v);
		push( @args, "$k=$v" );
	    }
	    foreach ( @args ) {
		next unless /\s/;
		$_ = '"' . $_ . '"';
	    }
	    push( @s, "{@args}" );
	    next;
	}

	if ( $elt->{type} eq "diagrams" ) {
	    for ( @{$elt->{chords}} ) {
		push( @s, define( $s->{chordsinfo}->{$_}, 1 ) );
	    }
	}

	if ( $elt->{type} eq "set" ) {
	    if ( $elt->{name} eq "lyrics-only" ) {
		$lyrics_only = $elt->{value}
		  unless $lyrics_only > 1;
	    }
	    elsif ( $elt->{name} eq "transpose" ) {
	    }
	    # Arbitrary config values.
	    elsif ( $elt->{name} =~ /^(chordpro\..+)/ ) {
		my @k = split( /[.]/, $1 );
		my $cc = {};
		my $c = \$cc;