view release on metacpan or  search on metacpan

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

    my $n_chords=0 ;
    my $n_words=0 ;

    #print("CL:") ; # JJW, uncomment for debugging

    foreach (@words) {
	if (length $_ > 0) {
	    $n_words++ ;


	    my $is_chord = ChordPro::Chords::parse_chord($_) ? 1 : 0  ;
	    if(! $is_chord) {
		if(generic_parse_chord($_)) {
		    print STDERR "$_ detected by generic, not internal parse_chord\n" if $local_debug ;
		    $is_chord=1 ;
		}
	    }

	    $n_chords++ if $is_chord ;
	    print STDERR " ($is_chord:$_)" if $local_debug ;

	    #print(" \'$is_chord:$_\'") ; # JJW, uncomment for debugging
	}
    }
    print STDERR "\n" if $local_debug ;

    return '_' if $n_words == 0 ;	# blank line, redundant logic with sub classify(), but makes this more robust to changes in classify() ;

    my $type = $n_chords/$n_words > 0.4 ? 'c' : 'l' ;

    if($type eq 'l') {
	# is it likely the line had a lot of unknown chords, check
	# the ratio of total chars to nonblank chars , if it is large then

	# it's probably a chord line
	# $type = 'c' if $n_words > 1 && $n_tot_chars/$n_nonblank_chars > 2. ;
    }

    #print(" --- ($n_chords/$n_words) = $type\n") ; # JJW, uncomment for debugging

    return $type ;
}

# reformat an input line classified as a comment for the chordpro format
sub format_comment_line
{
    my $line = $_[0] ;
    # remove [] from original comment
    $line =~ s/\[// ;
    $line =~ s/\]// ;
    return '' if $line eq '' ;
    return "{comment: " . $line . "}" ;
}

# Process the lines via the map.
my $infer_titles;
sub maplines {
    my ( $map, $lines ) = @_;
    my @out;
    $infer_titles = $config->{a2crd}->{'infer-titles'}
      && !$options->{fragment};

    # Preamble.
    # Pass empty lines.

    print STDERR  "====== _C =====\n" if $local_debug ;
    print STDERR "MAP: \'$map\' \n" if $local_debug ;

    while ( $map =~ s/^([_C])// ) {
	print STDERR "$1 == @{$lines}[0]\n" if $local_debug ;
	# simply output blank or comment lines at the start of the file
	# but don't count the line as possible title
	my $pre  = ($1 eq "C" ? "{comment:" : "" ) ;
	my $post = ($1 eq "C" ? "}" : "" ) ;
	push( @out, $pre . shift( @$lines ) . $post );
    }

    print STDERR "====== infer title =====\n" if $local_debug ;
    # Infer title/subtitle.
    if ( $infer_titles && $map =~ s/^l// ) {
	push( @out, "{title: " . shift( @$lines ) . "}");
	if ( $map =~ s/^l// ) {
	    push( @out, "{subtitle: " . shift( @$lines ) . "}");
	}
    }

    print STDERR "====== UNTIL chords or tablature =====\n" if $local_debug ;
    # Pass lines until we have chords or tablature

    while ($map =~ /^(.)(.)(.)/) {
	push @out, "ULC $map" if $local_debug ;
	# some unusual situations to handle, 

	# cl. => exit this loop for normal cl processing
	# .t => exit the loop
	# l.t or c.t => output the l or c as comment, then exit the loop
	# [_f{C].. => output the blank, fingering,directive or comment, and continue the loop

	# we have to stop one line before tablature, in case the line before the tablature needs to be included in the
	# tablature itself
	print STDERR "$1 == @{$lines}[0]\n" if $local_debug ;

	last if($1 eq "c" && $2 eq "l") ;
	last if($2 eq "t" ) ;

	if(($1 eq "c" || $1 eq "l") && $3 eq "t") {
	    push @out, format_comment_line(shift(@$lines)) ;
	    $map =~ s/.// ;
	    last ;
	}

	# in the remaining cases, output the line (properly handled), and continue the loop
	if ( $1 eq "l" or $1 eq "C") {
	    push @out, format_comment_line(shift(@$lines)) ;
	}
	elsif ( $1 eq "f" ) {
	    foreach my $fchart (decode_fingering(shift( @$lines ),1) ) {
		push( @out, $fchart);
	    }
	}
	elsif ( $1 eq "{" ) {