App-Music-ChordPro
view release on metacpan or search on metacpan
lib/ChordPro/Song.pm view on Meta::CPAN
next unless defined $options->{$_};
$config->{settings}->{$_} = $options->{$_};
}
# Catch common error.
unless ( UNIVERSAL::isa( $config->{instrument}, 'HASH' ) ) {
$config->{instrument} //= "guitar";
$config->{instrument} =
{ type => $config->{instrument},
description => ucfirst $config->{instrument} };
do_warn( "Missing or invalid instrument - set to ",
$config->{instrument}->{type}, "\n" );
}
# Remove inactive delegates.
while ( my ($k,$v) = each %{ $config->{delegates} } ) {
delete( $config->{delegates}->{$k} )
if !$v || (beo( $v, 'type')//'none') eq 'none';
}
# Handle transpose (needs parsing unless cli).
if ( ref($config->{settings}->{transpose}) ) {
# From CLI; already parsed.
}
else {
my $t = parse_transpose( $config->{settings}->{transpose} );
die("Config error: invalid transpose value \"" .
$config->{settings}->{transpose} . "\"\n" ) unless defined $t;
$config->{settings}->{transpose} = $t;
}
# Enforce key transpose semantics unless otherwise specified.
if ( $config->{settings}->{'transpose-sf-key'} ) {
for ( $config->{settings}->{transpose} ) {
if ( $_ ) {
$_ = parse_transpose( $_ . "k" ) unless $_->forced;
}
else {
$_ = parse_transpose("0k");
}
}
}
# And lock the config.
$config->lock;
for ( keys %{ $config->{meta} } ) {
$meta->{$_} //= [];
my $v = $config->{meta}->{$_};
$v = [ $v ] unless is_arrayref($v);
if ( is_arrayref($meta->{$_}) ) {
push( @{ $meta->{$_} }, @$v );
}
else {
$meta->{$_} = $v;
}
}
$xpose = parse_transpose(0);
$no_transpose = $options->{'no-transpose'};
$no_substitute = $options->{'no-substitute'};
my $fragment = $options->{fragment};
my $target = $config->{settings}->{transcode};
if ( $target ) {
unless ( ChordPro::Chords::Parser->have_parser($target) ) {
if ( my $file = CP->findres("config/notes/$target.json") ) {
for ( ChordPro::Config::get_config($file) ) {
my $new = $config->hmerge($_);
local $config = $new;
ChordPro::Chords::Parser->new($new);
}
}
}
unless ( ChordPro::Chords::Parser->have_parser($target) ) {
die("No transcoder for ", $target, "\n");
}
warn("Got transcoder for $target\n") if $::options->{verbose};
ChordPro::Chords::set_parser($target);
my $p = ChordPro::Chords::get_parser;
$xcmov = $p->movable;
if ( $target ne $p->{system} ) {
::dump(ChordPro::Chords::Parser->parsers);
warn("OOPS parser mixup, $target <> ",
ChordPro::Chords::get_parser->{system})
}
ChordPro::Chords::set_parser($self->{system});
}
else {
$target = $self->{system};
}
upd_config();
$self->{source} = { file => $diag->{file}, line => 1 + $$linecnt };
$self->{system} = $target // $config->{notes}->{system};
$self->{config} = $config;
$self->{meta} = $meta if $meta;
$self->{chordsinfo} = {};
$target //= $self->{system};
# Preprocessor.
my $prep = make_preprocessor( $config->{parser}->{preprocess} );
# Pre-fill meta data, if any. TODO? ALREADY DONE?
if ( $options->{meta} ) {
while ( my ($k, $v ) = each( %{ $options->{meta} } ) ) {
$self->{meta}->{$k} = [ $v ];
}
}
$self->{meta}->{"chordpro.songsource"} = $diag->{file}
unless $::running_under_test;
# Build regexp to split out chords.
if ( $config->{settings}->{memorize} ) {
$re_chords = qr/(\[.*?\]|\^)/;
}
else {
$re_chords = qr/(\[.*?\])/;
}
my $skipcnt = 0;
while ( @$lines ) {
if ( $skipcnt ) {
lib/ChordPro/Song.pm view on Meta::CPAN
# Read the data.
my @data;
while ( @$lines && $lines->[0] =~ /^# (.+)/ ) {
push( @data, $1 );
shift(@$lines);
}
# Store in assets.
$self->{assets} //= {};
$self->{assets}->{$id} =
{ data => \@data,
type => "image",
subtype => $type,
module => beo( $config->{delegates}->{$type}, 'module' ),
handler => beo( $config->{delegates}->{$type}, 'handler' ),
opts => $kv,
};
if ( $config->{debug}->{images} ) {
warn("asset[$id] type=image/$type ",
scalar(@data), " lines",
$kv->{persist} ? ", persist" : "",
"\n");
}
next;
}
if ( $kw eq "include" ) {
if ( $kv->{end} ) {
$diag = pop( @diag );
$$linecnt = $diag->{line};
}
else {
my $uri = $kv->{src};
if ( $uri && CP->is_here($uri) ) {
my $found = CP->siblingres( $diag->{file}, $uri, class => "include" );
if ( $found ) {
$uri = $found;
}
else {
do_warn("Missing include for \"$uri\"");
$uri = undef;
}
}
if ( $uri ) {
unshift( @$lines, @{fs_load($uri)}, "##include: end=1" );
push( @diag, { %$diag } );
$diag->{file} = $uri;
$diag->{line} = $$linecnt = 0;
$diag->{orig} = "(including $uri)";
}
}
next;
}
# Currently the ChordPro backend is the only one that
# cares about comment lines.
# Collect pre-title stuff separately.
next unless exists($config->{$backend})
&& beo( $config->{$backend}, 'comments') eq "retain";
if ( exists $self->{title} || $fragment ) {
$self->add( type => "ignore", text => $_ );
}
else {
push( @{ $self->{preamble} }, $_ );
}
next;
}
# Tab content goes literally.
if ( $in_context eq "tab" ) {
unless ( /^\s*\{(?:end_of_tab|eot)\}\s*$/ ) {
$self->add( type => "tabline", text => $_ );
next;
}
}
if ( exists $config->{delegates}->{$in_context} ) {
# 'open' indicates open.
if ( /^\s*\{(?:end_of_\Q$in_context\E)\}\s*$/ ) {
delete $self->{body}->[-1]->{open};
$grid_type = 0;
# A subsequent {start_of_XXX} will open a new item
my $d = $config->{delegates}->{$in_context};
if ( beo( $d, 'type' ) eq "image" ) {
local $_;
my $a = pop( @{ $self->{body} } );
my $id = $a->{id};
my $opts = {};
unless ( $id ) {
my $pkg = 'ChordPro::Delegate::' . $a->{delegate};
eval "require $pkg" || warn($@);
if ( my $c = $pkg->can("options") ) {
$opts = $c->($a->{data});
$id = $opts->{id};
}
}
$opts = $a->{opts} = { %$opts, %{$a->{opts}} };
unless ( is_true($opts->{omit}) ) {
if ( $opts->{align} && $opts->{x} && $opts->{x} =~ /\%$/ ) {
do_warn( "Useless combination of x percentage with align (align ignored)" );
delete $opts->{align};
}
my $def = !!$id;
$id //= "_Image".$assetid++;
if ( defined $opts->{spread} ) {
$def++;
if ( exists $self->{spreadimage} ) {
do_warn("Skipping superfluous spread image");
}
else {
$self->{spreadimage} =
{ id => $id, space => $opts->{spread} };
warn("Got spread image $id with space=$opts->{spread}\n")
if $config->{debug}->{images};
}
}
lib/ChordPro/Song.pm view on Meta::CPAN
name => "label",
value => $label )
if $label && $label ne "";
$self->add( type => "image",
opts => $opts,
id => $id );
if ( $opts->{label} ) {
push( @labels, $opts->{label} )
unless $in_context eq "chorus"
&& !$config->{settings}->{choruslabels};
}
}
}
}
elsif ( beo( $d, 'type' ) eq "filter" ) {
local $_;
my $a = pop( @{ $self->{body} } );
my $pkg = 'ChordPro::Delegate::' . $a->{delegate};
eval "require $pkg" || warn($@);
my $c = $pkg->can( $a->{handler} );
my $res = $c->( $c, elt => $a );
my @lines = @{$res->{data}};
$skipcnt += @lines;
unshift( @$lines, @lines );
$in_context = $def_context;
# Prevent context set.
next;
}
}
else {
# Add to an open item.
if ( $self->{body} && @{ $self->{body} }
&& $self->{body}->[-1]->{context} eq $in_context
&& $self->{body}->[-1]->{open} ) {
push( @{$self->{body}->[-1]->{data}},
fmt_subst( $self, $_ ) );
}
# Else start new item.
else {
croak("Reopening delegate");
}
next;
}
}
# For now, directives should go on their own lines.
if ( /^\s*\{(.*)\}\s*$/ ) {
my $dir = $1;
if ( $prep->{directive} ) {
$config->{debug}->{pp} && warn("PRE: ", $_, "\n");
$prep->{directive}->($dir);
$config->{debug}->{pp} && warn("POST: {", $dir, "}\n");
}
$self->add( type => "ignore",
text => $_ )
unless $self->directive($dir);
next;
}
if ( /\S/ && !$fragment && !exists $self->{title} ) {
do_warn("Missing {title} -- prepare for surprising results");
unshift( @$lines, "{title:$_}");
$skipcnt++;
next;
}
if ( $in_context eq "tab" ) {
$self->add( type => "tabline", text => $_ );
warn("OOPS");
next;
}
if ( $in_context eq "grid" ) {
$self->add( type => "gridline", $self->decompose_grid($_) );
next;
}
if ( $in_context eq "grille" && @grille ) {
push( @grille, { line => $diag->{line},
$self->decompose_grid($_) } );
next;
}
if ( /\S/ ) {
if ( $prep->{songline} ) {
$config->{debug}->{pp} && warn("PRE: ", $_, "\n");
$prep->{songline}->($_);
$config->{debug}->{pp} && warn("POST: ", $_, "\n");
}
if ( $config->{settings}->{flowtext}
&& @{ $self->{body}//[] } ) {
my $prev = $self->{body}->[-1];
my $this = { $self->decompose($_) };
if ( $prev->{type} eq "songline"
&& !$prev->{chords}
&& !$this->{chords} ) {
$prev->{phrases}->[0] .= " " . $this->{phrases}->[0];
}
else {
$self->add( type => "songline", %$this );
}
}
else {
$self->add( type => "songline", $self->decompose($_) );
}
}
elsif ( exists $self->{title} || $fragment ) {
$self->add( type => "empty" );
}
else {
# Collect pre-title stuff separately.
push( @{ $self->{preamble} }, $_ );
}
}
do_warn("Unterminated context in song: $in_context")
if $in_context;
warn("Processed song...\n") if $options->{verbose};
$diag->{format} = "\"%f\": %m";
::dump($self->{assets}, as => "Assets, Pass 1")
if $config->{debug}->{assets} & 1;
$self->dump(0) if $config->{debug}->{song} > 1;
::dump($self->{body}) if $config->{debug}->{ops};
if ( @labels ) {
$self->{labels} = [ @labels ];
}
# Suppress chords that the user considers 'easy'.
my %suppress;
my $xc = $config->{settings}->{transcode};
for ( @{ $config->{diagrams}->{suppress} } ) {
my $info = ChordPro::Chords::known_chord($_);
warn("Unknown chord \"$_\" in suppress list\n"), next
unless $info;
# Note we do transcode, but we do not transpose.
if ( $xc ) {
$info = $info->transcode($xc);
}
$suppress{$info->name} = $info->{origin} ne "song";
}
# Suppress chords that the user don't want.
while ( my ($k,$v) = each %{ $self->{chordsinfo} } ) {
$suppress{$k} = 1 if !is_true($v->{diagram}//1);
}
@used_chords = map { $suppress{$_} ? () : $_ } @used_chords;
my $diagrams;
if ( exists($self->{settings}->{diagrams} ) ) {
$diagrams = $self->{settings}->{diagrams};
$diagrams &&= $config->{diagrams}->{show} || "all";
}
else {
$diagrams = $config->{diagrams}->{show};
}
if ( $diagrams =~ /^(user|all)$/
&& !ChordPro::Chords::Parser->get_parser($target,1)->has_diagrams ) {
do_warn( "Chord diagrams suppressed for " .
ucfirst($target) . " chords" ) unless $options->{silent};
$diagrams = "none";
}
if ( $diagrams eq "user" ) {
if ( $self->{define} && @{$self->{define}} ) {
( run in 0.552 second using v1.01-cache-2.11-cpan-b16cb0d3907 )