view release on metacpan or  search on metacpan

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

  use 5.01400;
  use strict;
  use warnings FATAL => 'all';

BEGIN {

  use Data::Dumper;
  use Readonly;
  use feature 'state'; #state variables are enabled
  use Exporter 'import'; # gives you Exporter's import() method directly
  use POSIX ();
  use File::Temp ();
  use List::MoreUtils qw{any};

  our $VERSION = '0.01';

  our %EXPORT_TAGS = (
    'all' => [
      qw( _broken_rhythm _head_par _length_header_dump _meter_calc _pscom_to_abc _slur_dump
        _vover_to_abc _tuplet_to_abc _get_transformation _get_note_rest_bar_actuators
        _get_null_info_clef_actuators _bar_dump _deco_dump _step_dump _get_chord_notes
        _diatonic_interval _get_alter _get_chromatic_info _get_generic_info _get_ps
        _get_specifier_from_generic_chromatic _interval_from_generic_and_chromatic _notes_to_chromatic
        _notes_to_generic _notes_to_interval _convert_staff_distance_to_interval $brhythm @blen
        $deco_tb %state_name )
    ]
  );

  our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

  # If you are only exporting function names it is recommended to omit the ampersand, as the
  # implementation is faster this way.
  our @EXPORT =
    qw( &dt &dt_string &toabc &get_meter &get_length &get_wmeasure &get_gchords &get_key &get_time
    &get_time_ql &is_major_triad &is_minor_triad &is_dominant_seventh &get_chord_step &get_fifth
    &get_third &get_seventh &root &find_consecutive_notes_in_measure &get_pitch_class
    &get_pitch_name $c_voice $sym %voice_struct);

  use vars
    qw( $deco_tb $in_grace $brhythm $gbr @blen $micro_tb $c_voice %voice_struct $c_tune $c_sym_ix
    $c_abc $sym $c_bar %sym_name %state_name %info_name %STEPREF @key_shift @key_tonic $ly_st @clef_type
    $toabc_called_outside $toabc_called_inside $GLOBAL $IMPLICIT_VOICE $QUARTER_LENGTH $FIRST_MEASURE);

  Readonly our $GLOBAL         => 'global';   # identifies data that is applied to the entire score (voice independent)
  Readonly our $IMPLICIT_VOICE => 0;          # default voice
  Readonly our $QUARTER_LENGTH => 384;        # default value for quarter length (abcm2ps)
  Readonly our $FIRST_MEASURE  => 1;          # default value for the first measure

  use constant {    # info type
    ABC_T_NULL   => 0,
    ABC_T_INFO   => 1,   #  (first character of text gives the info type)
    ABC_T_PSCOM  => 2,
    ABC_T_CLEF   => 3,
    ABC_T_NOTE   => 4,
    ABC_T_REST   => 5,
    ABC_T_BAR    => 6,
    ABC_T_EOLN   => 7,
    ABC_T_MREST  => 8,   #  multi-measure rest
    ABC_T_MREP   => 9,   #  measure repeat
    ABC_T_V_OVER => 10,  #  voice overlay
    ABC_T_TUPLET => 11,
  };

  use constant { # symbol state in file/tune
    ABC_S_GLOBAL  => 0,      # global
    ABC_S_HEAD    => 1,      # in header (after X:)
    ABC_S_TUNE    => 2,       # in tune (after K:)
    ABC_S_EMBED   => 3     # embedded header (between [..])
  };


  use constant { # info flags
    ABC_F_ERROR       => 0x0001,  #  error around this symbol
    ABC_F_INVIS       => 0x0002,  #  invisible symbol
    ABC_F_SPACE       => 0x0004,  #  space before a note
    ABC_F_STEMLESS    => 0x0008,  #  note with no stem
    ABC_F_LYRIC_START => 0x0010,  #  may start a lyric here
    ABC_F_GRACE       => 0x0020,  #  grace note
    ABC_F_GR_END      => 0x0040,  #  end of grace note sequence
    ABC_F_SAPPO       => 0x0080   #  short appoggiatura
  };

  use constant { # key mode
    MAJOR   =>  7,
    MINOR   =>  8,
    BAGPIPE =>  9  #  bagpipe when >= 8
  };

  use constant { # clef type
    TREBLE =>  0,
    ALTO   =>  1,
    BASS   =>  2,
    PERC   =>  3
  };

  use constant { # voice overlay
    V_OVER_V  => 0,  #  &
    V_OVER_S  => 1,  #  (&
    V_OVER_E  => 2   #  &)
  };

  # key signatures
  use constant KEY_NAMES => qw(ionian dorian phrygian lydian mixolydian aeolian locrian major minor HP Hp);

  use constant { NONE     => 'none' };
  use constant { MAXVOICE => 32 }; # max number of voices
  use constant { BASE_LEN => 1536 }; # basic note length (semibreve or whole note - same as MIDI)
  use constant { DEFAULT_METER  => '4/4' };
  use constant { DEFAULT_LENGTH => '1/8' };

  use constant { # accidentals
    A_NULL  =>  0,  #  none
    A_SH    =>  1,  #  sharp
    A_NT    =>  2,  #  natural
    A_FT    =>  3,  #  flat
    A_DS    =>  4,  #  double sharp
    A_DF    =>  5   #  double flat
  };


  use constant { # bar types
    B_BAR   => 1,  #  |
    B_OBRA  => 2,  #  [
    B_CBRA  => 3,  #  ]
    B_COL   => 4   #  :
  };

  use constant { # slur/tie types (3 bits)
    SL_ABOVE  =>  0x01,
    SL_BELOW  =>  0x02,
    SL_AUTO   =>  0x03,
    SL_DOTTED =>  0x04  #  (modifier bit)
  };

  our ( $in_grace, $brhythm, $gbr, $ly_st, $c_voice, %voice_struct );
  our ( @blen, $micro_tb, $deco_tb );
  our ( $c_tune, $c_sym_ix, $c_abc, $toabc_called_outside, $toabc_called_inside );

  our %sym_name = (
    # the extra () around the constants are there to fool the auto quoting
    (ABC_T_NULL)    => 'null',
    (ABC_T_INFO)    => 'info',
    (ABC_T_PSCOM)   => 'pscom',
    (ABC_T_CLEF)    => 'clef',
    (ABC_T_NOTE)    => 'note',
    (ABC_T_REST)    => 'rest',
    (ABC_T_BAR)     => 'bar',
    (ABC_T_EOLN)    => 'eoln',
    (ABC_T_MREST)   => 'mrest',
    (ABC_T_MREP)    => 'mrep',
    (ABC_T_V_OVER)  => 'vover',
    (ABC_T_TUPLET)  => 'tuplet',
  );
  our %info_name = (
    'K'             => 'key',
    'L'             => 'length',

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

# Updates the time offset for voice $c_voice
sub _update_time_offset {
  if ( $sym->{type} ~~ [ ABC_T_NOTE, ABC_T_REST ] ) {
    if ( !( $sym->{flags} & ABC_F_GRACE ) ) {
      $voice_struct{$c_voice}{time} += $sym->{info}->{dur};
    }
    # FIXME atencao ao v_over, nao pode contar da mesma maneira
  }
  if ( $sym->{type} == ABC_T_MREST ) {
    #abcm2ps-7.3.4/parse.c:2953
    $voice_struct{$c_voice}{time} += $sym->{info}->{dur};
  }

  return;
}

# -- dump voice
sub _voice_header_dump {
  my ( $abc, $sym ) = @_;

# FIXME PARSER quando no abc a voz de uma melodia está no formato "V: id\nABCD|z4" (note-se o espaço
# entre "V:" e id), a voz nao é identificada logo o id e a voice nao sao definidos
  $abc .= sprintf 'V:%s', $sym->{info}->{id};
  if ( $sym->{info}->{fname} ne q{} ) {
    $abc .= sprintf ' name="%s"', $sym->{info}->{fname};
  }
  if ( $sym->{info}->{nname} ne q{} ) {
    $abc .= sprintf ' sname="%s"', $sym->{info}->{nname};
  }
  if ( $sym->{info}->{merge} ) { $abc .= ' merge' }
  if ( $sym->{info}->{stem} ) {
    $abc .= sprintf ' stem=%s', _head_par( $sym->{info}->{stem} );
  }
  if ( $sym->{info}->{gstem} ) {
    $abc .= sprintf ' gstem=%s', _head_par( $sym->{info}->{gstem} );
  }
  if ( $sym->{info}->{dyn} ) {
    $abc .= sprintf ' dyn=%s', _head_par( $sym->{info}->{dyn} );
  }
  if ( $sym->{info}->{lyrics} ) {
    $abc .= sprintf ' lyrics=%s', _head_par( $sym->{info}->{lyrics} );
  }
  if ( $sym->{info}->{gchord} ) {
    $abc .= sprintf ' gchord=%s', _head_par( $sym->{info}->{gchord} );
  }
  if ( $sym->{info}->{scale} ) {
    $abc .= sprintf ' scale=%.2f', $sym->{info}->{scale};
  }

  #  print next symbol if it is a clef
  if ( ref( $c_tune->{symbols}->[ $c_sym_ix + 1 ] )
       && $c_tune->{symbols}->[ $c_sym_ix + 1 ]->{type} == ABC_T_CLEF )
  {
    $abc = _clef_dump( $abc, $c_tune->{symbols}->[ $c_sym_ix + 1 ] );
  }

  return $abc;
}

# -- return abc of voice overlay
sub _vover_to_abc {
  my ( $new_abc, $sym ) = @_;

  given ( $sym->{info}->{type} ) {
    when (V_OVER_V) { $new_abc .= q{&}; }
    when (V_OVER_S) { $new_abc .= '(&'; }
    when (V_OVER_E) { $new_abc .= '&)'; }
  }

  return $new_abc;
}


################################### Chord.pm ################################

# -- Returns the (first) pitch at the provided scaleDegree (chordStep)
#    Returns undef if none can be found.
sub get_chord_step {
  my ( $sym, $chord_step, $test_root ) = @_;

  if ( !$test_root ) {
    $test_root = root($sym);
    if ( !$test_root ) {
      die "Cannot run get_chord_step without a root\n";
    }
  }

  for my $note_ref ( _get_chord_notes($sym) ) {
    my ( $d_int, $c_int ) = _notes_to_interval( $test_root, $note_ref );
    my $g_int_info = _get_generic_info( $d_int->{generic} );
    if ( $g_int_info->{mod7} == $chord_step ) {
      return $note_ref;
    }
  }

  return;
}

# -- Shortcut for getChordStep(5)
sub get_fifth {
  my $sym = shift;

  return get_chord_step($sym, 5);
}

# -- Shortcut for getChordStep(7)
sub get_seventh {
  my $sym = shift;

  return get_chord_step($sym, 7);
}

# -- Shortcut for getChordStep(3)
sub get_third {
  my $sym = shift;

  return get_chord_step($sym, 3);
}