App-Music-ChordPro

 view release on metacpan or  search on metacpan

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

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

			# Move to assets.
			$self->{assets}->{$id} = $a;
			if ( $def ) {
			    my $label = delete $a->{label};
			    do_warn("Label \"$label\" ignored on non-displaying $in_context section\n")
			      if $label;
			}
			else {
			    my $label = delete $opts->{label};
			    $self->add( type => "set",
					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.

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

		# Do we have a name? Chords? Both?
		# name:C D E
		# :C D E
		# :
		if ( $chords =~ /^(\w*):(.*)/ ) {
		    # Name, possibly empty.
		    $cctag = $1 if length($1);
		    # Chords, possibly empty.
		    $chords = $2;
		}
		# C D E
		elsif ( $chords =~ /\s/ ) {
		    # Whitespace separated chords.
		}
		# name
		elsif ( $chords =~ /^\w+$/ ) {
		    $cctag = $chords;
		    $chords = "";
		}
		# ???
		else {
		    warn("Unrecognized cc value: \"$chords\"\n")
		      if $chords;
		    $chords = "";
		}
		if ( $chords ne "" ) {
		    $memchords = [ split( ' ', $chords ) ];
		    $memchords{$cctag} = $memchords;
		    $memcrdinx = 0;
		    $memorizing = 0;
		    if ( $config->{debug}->{chords} ) {
			my $i = 0;
			warn("Chord memorized for $cctag\[$i]: ",
			     $_, "\n"), $i++
			       for @$memchords;
		    }
		    return 1;
		}
	    }
	}

	# Enabling this always would allow [^] to recall anyway.
	# Feature?
	if ( 1 || $config->{settings}->{memorize} ) {
	    $memchords = ($memchords{$cctag//$in_context} //= []);
	    $memcrdinx = 0;
	    $memorizing = 0;
	}
	return 1;
    }

    if ( $dir =~ /^end_of_(\w+)$/ ) {
	do_warn("Not in " . ucfirst($1) . " context\n")
	  unless $in_context eq $1;
	$grid_type = 0;
	if ( $in_context eq "grille" && @grille > 1 ) {
	    my $opts = shift(@grille);
	    my $id = $opts->{id};
	    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};
		    }
		}

		# Move to assets.
		$self->{assets}->{$id} =
		  { type      => "image",
		    subtype   => "delegate",
		    delegate  => "Grille",
		    handler   => "grille2xo",
		    opts      => $opts,
		    line      => $grille[0]{line},
		    data      => \@grille,
		    context   => $in_context,
		  };
		if ( $def ) {
		    my $label = delete $a->{label};
		    do_warn("Label \"$label\" ignored on non-displaying $in_context section\n")
		      if $label;
		}
		else {
		    my $label = delete $opts->{label};
		    $self->add( type => "set",
				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};
		    }
		}
	    }
	}
	else {
	    $self->add( type => "set",
			name => "context",
			value => $def_context );
	}
	$in_context = $def_context;
	undef $memchords;
	return 1;

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

		&& $v =~ /^(?:base[+-])?([-+]?\d+(?:\.\d+)?\%?)$/ ) {
	    $opts{lc($k)} = $v;
	}
	elsif ( $k =~ /^(scale)$/
		&& $v =~ /^(\d+(?:\.\d+)?)(%)?(?:,(\d+(?:\.\d+)?)(%)?)?$/ ) {
	    $opts{lc($k)} = [ $2 ? $1/100 : $1 ];
	    $opts{lc($k)}->[1] = $3 ? $4 ? $3/100 : $3 : $opts{lc($k)}->[0];
	}
	elsif ( $k =~ /^(center|border|spread|persist|omit)$/i ) {
	    if ( $k eq "center" ) {
		$opts{align} = $k;
	    }
	    else {
		$opts{lc($k)} = $v;
	    }
	}
	elsif ( $k =~ /^(src|uri)$/i && $v ne "" ) {
	    $uri = $v;
	}
	elsif ( $k =~ /^(id)$/i && $v ne "" ) {
	    $id = $v;
	}
	elsif ( $k =~ /^(chord)$/i && $v ne "" ) {
	    $chord = $v;
	}
	elsif ( $k =~ /^(type)$/i && $v ne "" ) {
	    $opts{type} = $v;
	}
	elsif ( $k =~ /^(label|href)$/i && $v ne "" ) {
	    $opts{lc($k)} = $v;
	}
	elsif ( $k =~ /^(anchor)$/i
		&& $v =~ /^(paper|page|allpages|column|float|line)$/ ) {
	    $opts{lc($k)} = lc($v);
	}
	elsif ( $k =~ /^(align)$/i
		&& $v =~ /^(center|left|right)$/ ) {
	    $opts{lc($k)} = lc($v);
	}
	elsif ( $k =~ /^(bordertrbl)$/i
		&& $v =~ /^[trbl]*$/ ) {
	    $opts{lc($k)} = lc($v);
	}
	elsif ( $uri ) {
	    do_warn( "Unknown image attribute: $k\n" );
	    next;
	}
	# Assume just an image file uri.
	else {
	    $uri = $k;
	}
    }

    return if is_true($opts{omit});

    unless ( $uri || $id || $chord ) {
	do_warn( "Missing image source\n" );
	return;
    }
    if ( $opts{align} && $opts{x} && $opts{x} =~ /\%$/ ) {
	do_warn( "Useless combination of x percentage with align (align ignored)" );
	delete $opts{align};
    }

    # If the image uri does not have a directory, look it up
    # next to the song, and then in the images folder of the
    # resources.
    if ( $uri ) {
	if ( CP->is_here($uri) ) {
	    my $found = CP->siblingres( $diag->{file}, $uri, class => "images" )
	      || CP->siblingres( $diag->{file}, $uri, class => "icons" );
	    if ( $found ) {
		$uri = $found;
	    }
	    else {
		do_warn("Missing image for \"$uri\"");
		return;
	    }
	}
	# Do not affect URIs and base64 data strings.
	elsif ( $uri !~ /^(data:|\w+:\/\/)/ ) {
	    $uri = expand_tilde($uri);
	}
    }

    if ( $chord ) {
	if ( $chord =~ /^\[(.*)\]$/ ) { # transposable
	    my $info = $self->parse_chord($1);
	    $chord = $info->{name} if $info;
	}
	$uri = "chord:$chord";
    }

    my $aid = $id || "_Image".$assetid++;

    if ( defined $opts{spread} ) {
	if ( exists $self->{spreadimage} ) {
	    do_warn("Skipping superfluous spread image");
	}
	else {
	    $self->{spreadimage} =
	      { id => $aid, space => $opts{spread} };
	    warn("Got spread image $aid with $opts{spread} space\n")
	      if $config->{debug}->{images};
	}
    }

    # Store as asset.
    if ( $uri ) {
	my $opts;
	for ( qw( type persist href ) ) {
	    $opts->{$_} = $opts{$_} if defined $opts{$_};
	    delete $opts{$_};
	}
	for ( qw( spread ) ) {
	    $opts->{$_} = $opts{$_} if defined $opts{$_};
	}

	if ( $id && %opts ) {
	    do_warn("Asset definition \"$id\" does not take attributes",
		   " (" . join(" ",sort keys %opts) . ")");



( run in 0.914 second using v1.01-cache-2.11-cpan-fe3c2283af0 )