view release on metacpan or  search on metacpan

lib/Music/Abc/DT.pm  view on Meta::CPAN

  }

  return $proc;
}

# -- get the actuators that have a decoration --
sub _get_deco_actuators {
  my ( $abch, $sym, $proc ) = @_;
  my %abch = %{$abch};
  my $type = $sym->{type};
  my $bar  = $type == ABC_T_BAR;

  if ( $sym->{info}->{dc}->{n} ) {    # n is the whole number of decorations
    $proc = $abch{'deco'} || $proc;

    # note::deco is more specific than deco alone
    $proc = $abch{"$sym_name{$type}::deco"} || $proc;

    # the actual bar is more specific
    if ($bar) {
      $proc = $abch{ _bar_dump( q{}, $sym, q{} ) . '::deco' } || $proc;
    }

    my $dc = _deco_dump( $sym->{info}->{dc}, q{} );
#FIXME é possivel existir mais que uma deco por sym, logo a pesquisa no abch nao pode estar tal como está
    # the actual decoration is more specific
    $proc = $abch{$dc} || $proc;

    # note::!f! is more specific than !f! alone
    $proc = $abch{"$sym_name{$type}::$dc"} || $proc;

    # the actual bar with that actual deco is more specific
    if ($bar) {
      $proc = $abch{ _bar_dump( q{}, $sym, q{} ) . "::$dc" } || $proc;
    }
  }

  return $proc;
}

# -- searches for a note/rest/bar's gchord/accompaniment chord actuators
sub _get_gchord_actuator {
  my ( $abch, $sym, $proc ) = @_;
  my %abch = %{$abch};
  my $type = $sym->{type};
  my $element = $type == ABC_T_NOTE ? 'note'
              : $type == ABC_T_REST ? 'rest'
              :                       'bar';

  # it has at least one accompaniment chord (or guitar chord)
  if ($sym->{text}) {
    $proc = $abch{'gchord'} || $proc;

    # bar::gchord
    $proc = $abch{ $element . 'gchord' } || $proc;

    my $gchord = $sym->{text};
    # Multiple chords per element can be notated writing two or more consecutive
    # chords before the same element, or using the separating characters ; or \n
    $gchord =~ tr/;/\n/;
    my @gchords = split m/\n/xms, $gchord;

    # stops the search after the first match; the first gchords have priority
    # eg: 'gchord::F'
    foreach my $gc (@gchords) {
      $proc = $abch{ "gchord::$gc" } || $proc;
      last if $abch{ "gchord::$gc" };
    }

    # stops the search after the first match; the first gchords have priority
    # eg: 'bar::gchord::F'
    foreach my $gc (@gchords) {
      $proc = $abch{ $element . "::gchord::$gc" } || $proc;
      last if $abch{ $element . "::gchord::$gc" };
    }
  }

  return $proc;
}

sub _get_info {
  my $sym = shift;

  given ( substr $sym->{text}, 0, 1 ) {
    when ('V') { # Voice
      _get_voice($sym);
    }
    when ('K') { # Key (K)
      _get_key($sym);
    }
    when ('Q') { # Tempo (Q)
      # $voice_struct{$c_voice}{tempo} = substr _tempo_header_dump( q{}, $sym ), 2;
    }
    when ('M') { # Meter (M)
      _get_meter($sym);
    }
    when ('L') { # Length (L)
      _get_length($sym);
    }
  }

  return;
}

# -- updates the current voice's key info
sub _get_key {
  my $sym = shift;
  my $c_key;

  if ( $sym->{info}->{empty} ) {
    if ( $sym->{info}->{empty} == 2 ) { $c_key = NONE }
  } else {
    # extracts only the Key's note and mode, ignores explicit accidentals
    $c_key = _key_calc($sym);
  }

  _update_key($c_key);

  return;
}