view release on metacpan or  search on metacpan

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

	$self->add( type  => "control",
		    name  => $name,
		    value => $value );
	$self->add( @toadd ) if @toadd;
	return 1;
    }

    if ( $prop eq "size" ) {
	unless ( $value =~ /^\d+(?:\.\d+)?\%?$/ ) {
	    do_warn("Illegal value \"$value\" for $item$prop\n");
	    return 1;
	}
    }
    if ( $prop eq "color" ) {
	my $v;
	unless ( $v = get_color($value) ) {
	    do_warn("Illegal value \"$value\" for $item$prop\n");
	    return 1;
	}
	$value = $v;
    }
    $value = $prop eq "font" ? $value : lc($value);
    $self->add( type  => "control",
		name  => $name,
		value => $value );
    push( @{ $propstack{$name} }, $value );

    # A trailing number after a font directive is an implicit size
    # directive.
    if ( $prop eq 'font' && $value =~ /\s(\d+(?:\.\d+)?)$/ ) {
	$self->add( type  => "control",
		    name  => "$item-size",
		    value => $1 );
	push( @{ $propstack{"$item-size"} }, $1 );
    }
}

sub add_chord {
    my ( $self, $info, $new_id ) = @_;

    if ( $new_id ) {
	if ( $new_id eq "1" ) {
	    state $id = "ch0000";
	    $new_id = " $id";
	    $id++;
	}
    }
    else {
	$new_id = $info->name;
    }
    $self->{chordsinfo}->{$new_id} = $info->new($info);

    return $new_id;
}

sub define_chord {
    my ( $self, $dir, $args ) = @_;

    # Split the arguments and keep a copy for error messages.
    # Note that quotewords returns an empty result if it gets confused,
    # so fall back to the ancient split method if so.
    $args =~ s/^\s+//;
    $args =~ s/\s+$//;
    my @a = quotewords( '[: ]+', 0, $args );
    @a = split( /[: ]+/, $args ) unless @a;

    my @orig = @a;
    my $show = $dir eq "chord";
    my $fail = 0;
    my $name = shift(@a);
    my $strings = $config->diagram_strings;

    # Process the options.
    my %kv = ( name => $name );
    while ( @a ) {
	my $a = shift(@a);

	# Copy existing definition.
	if ( $a eq "copy" || $a eq "copyall" ) {
	    if ( my $i = ChordPro::Chords::known_chord($a[0]) ) {
		$kv{$a} = $a[0];
		$kv{orig} = $i;
		shift(@a);
	    }
	    else {
		do_warn("Unknown chord to copy: $a[0]\n");
		$fail++;
		last;
	    }
	}

	# display
	elsif ( $a eq "display" && @a ) {
	    $kv{display} = demarkup($a[0]);
	    do_warn( "\"display\" should not contain markup, use \"format\"" )
	      unless $kv{display} eq shift(@a);
	    $kv{display} = $self->parse_chord($kv{display},1);
	    delete $kv{display} unless defined $kv{display};
	}

	# format
	elsif ( $a eq "format" && @a ) {
	    $kv{format} = shift(@a);
	}

	# base-fret N
	elsif ( $a eq "base-fret" ) {
	    if ( $a[0] =~ /^\d+$/ ) {
		$kv{base} = shift(@a);
	    }
	    else {
		do_warn("Invalid base-fret value: $a[0]\n");
		$fail++;
		last;
	    }
	}
	# frets N N ... N
	elsif ( $a eq "frets" ) {
	    my @f;
	    while ( @a && $a[0] =~ /^(?:-?[0-9]+|[-xXN])$/ && @f < $strings ) {
		push( @f, shift(@a) );