Music-Abc-DT
view release on metacpan or search on metacpan
lib/Music/Abc/DT.pm view on Meta::CPAN
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',
'M' => 'meter',
'Q' => 'tempo',
'V' => 'voice',
'w' => 'lyrics',
'W' => 'lyrics',
);
our %state_name = (
(ABC_S_GLOBAL) => 'in_global',
(ABC_S_HEAD) => 'in_header',
(ABC_S_TUNE) => 'in_tune',
(ABC_S_EMBED) => 'in_line',
);
our @key_tonic = qw(F C G D A E B);
our @key_shift = (1, 3, 5, 0, 2, 4, 6, 1, 4); # [7 + 2]
our @clef_type = qw(treble alto bass perc);
}
# Processes abc tunes;
# Receives the filename of an abc tune
# Receives a set of expressions (functions) defining the processing and associated values for each element
sub dt {
my ( $abcfile, %abch ) = @_;
my $abc_struct = eval `aux-abc2perl $abcfile`;
my $return = _dt_processing( $abc_struct, %abch );
return $return;
}
# Works in a similar way of dt but takes input from a string instead of a file name
sub dt_string {
my ( $string, %abch ) = @_;
my $tmp_abcfile = File::Temp->new( SUFFIX => '.abc' );
print {$tmp_abcfile} $string;
my $abc_struct = eval `aux-abc2perl $tmp_abcfile`;
my $return = _dt_processing( $abc_struct, %abch );
return $return;
}
# Returns a list of consecutive note structures belonging to the same measure
#
# A single undef is placed in the list at any point there is a discontinuity (such as if there is a
# rest between two pitches), unless the `no_undef` parameter is True.
#
# How to determine consecutive pitches is a little tricky and there are many options: The
# `$args->{skip_unisons}` parameter uses the midi-note value (ps) to determine unisons, so enharmonic
# transitions (F# -> Gb) are also skipped if `$args->{skip_unisons}` is true. Music21 believes that
# this is the most common usage. However, because of this, you cannot completely be sure that the
# find_consecutive_notes_in_measure() - find_consecutive_notes_in_measure({$args->{skip_unisons} =>
# 1}) will give you the number of P1s (Perfect First) in the piece, because there could be d2's
# (Diminished Second) in there as well.
sub find_consecutive_notes_in_measure {
my $args = shift;
my $return_list = [];
my $n_symbols = scalar( @{ $c_tune->{symbols} } ) - 1;
my $last_start = 0;
my $last_end = -1;
my $last_was_undef = 0;
my $c_sym_offset = 0;
my $last_note;
if ( $args->{skip_octaves} ) { $args->{skip_unisons} = 1; } # implied
for my $ix ( $c_sym_ix .. $n_symbols ) {
lib/Music/Abc/DT.pm view on Meta::CPAN
$proc = $abch{"MIDI::$1"} || $proc;
}
#TODO add PageFormats (see last pages from abcplus)
} else {
$proc = $abch{'FORMAT'} || $proc;
if ( $text =~ /^(staves|score)/xms ) {
$proc = $abch{$1} || $proc;
}
}
return $proc;
}
# -- gets the transformation to be applied according to an abc symbol/element
# -- searches for an actuator that matches the abc symbol passed in as argument
# -- the most specific actuator is the one chosen
sub _get_transformation {
my ( $abch, $sym ) = @_;
my %abch = %{$abch};
my $type = $sym->{type};
my $state = $sym->{state};
my $proc = q{};
# the second most general actuator is the state, ex: in_header
$proc = $abch{ $state_name{$state} } || $proc;
# searches for actuators
if ( $type == ABC_T_PSCOM ) {
# searches for pscom actuators
$proc = _get_pscom_actuators( $abch, $sym, $proc );
} elsif ( $type == ABC_T_NOTE
|| $type == ABC_T_REST
|| $type == ABC_T_BAR )
{
# searches for note, rest or bar actuators
$proc = _get_note_rest_bar_actuators( $abch, $sym, $proc );
} elsif ( $type == ABC_T_NULL
|| $type == ABC_T_INFO
|| $type == ABC_T_CLEF )
{
# searches for nul, info or clef actuators
$proc = _get_null_info_clef_actuators( $abch, $sym, $proc );
} else {
# searches for the remaining actuators ( eoln, mrest, mrep, v_over, tuplet )
$proc = $abch{ $sym_name{$type} } || $proc;
}
# if no actuator was found, it tries to apply the -default function
# and if it doesn't exist either, it applies the identity function - toabc()
$proc ||= $abch{'-default'} || \&toabc;
return $proc;
}
# -- Updates the current voice and some info related to it --
sub _get_voice {
my $sym = shift;
if ( $sym->{state} == ABC_S_TUNE || $sym->{state} == ABC_S_EMBED ) {
$c_voice = $sym->{info}->{voice};
#set voice stuff if not already set
#TODO check abcm2ps-7.3.4/parse.c:2817 (do_tune)
$voice_struct{$c_voice}{id} ||= $sym->{info}->{id};
$voice_struct{$c_voice}{name} ||= $sym->{info}->{fname} || q{};
$voice_struct{$c_voice}{time} ||= 0;
$voice_struct{$c_voice}{meter}{text} ||= $voice_struct{$GLOBAL}{meter}{text} || 'M:' . DEFAULT_METER;
$voice_struct{$c_voice}{meter}{wmeasure} ||= $voice_struct{$GLOBAL}{meter}{wmeasure} || BASE_LEN;
$voice_struct{$c_voice}{length} ||= $voice_struct{$GLOBAL}{length} || 'L:' . DEFAULT_LENGTH;
$voice_struct{$c_voice}{key}{text} ||= $voice_struct{$GLOBAL}{key}{text};
$voice_struct{$c_voice}{key}{sf} ||= $voice_struct{$GLOBAL}{key}{sf};
$voice_struct{$c_voice}{key}{exp} ||= $voice_struct{$GLOBAL}{key}{exp};
$voice_struct{$c_voice}{key}{nacc} ||= $voice_struct{$GLOBAL}{key}{nacc};
$voice_struct{$c_voice}{key}{pits} ||= $voice_struct{$GLOBAL}{key}{pits};
$voice_struct{$c_voice}{key}{accs} ||= $voice_struct{$GLOBAL}{key}{accs};
}
return;
}
# -- dump a header --
sub _header_dump {
my ( $abc, $sym ) = @_;
given (substr $sym->{text}, 0, 1) { # info type (first character)
when ('K' ) { $abc = _key_header_dump($abc, $sym) } # Key
when ('L' ) { $abc = _length_header_dump($abc, $sym) } # Length
when ('M' ) { $abc = _meter_header_dump($abc, $sym) } # Meter
when ('Q' ) { $abc = _tempo_header_dump($abc, $sym) } # Tempo
when ('V' ) { $abc = _voice_header_dump($abc, $sym) } # Voice
when (['d','s']) { $abc .= q{%}; continue } # 's': decoration line # tclabc.c => "FIXME: already in notes"
default { $abc .= $sym->{text}; }
}
return $abc;
}
# -- return a 'up' / 'down' / auto' parameter value --
sub _head_par {
my $v = shift;
return 'down' if ($v < 0);
return 'auto' if ($v == 2);
return 'up';
}
# -- returns the abc for the info field and the new line flag
sub _info_to_abc {
my ($new_abc, $sym, $c, $nl_new) = @_;
if ($sym->{state} == ABC_S_EMBED) { $new_abc .= '[' }
elsif ($c ne "\n") { $new_abc .= "\\\n";
# _lyrics_dump($new_abc, $sym);
}
$new_abc = _header_dump($new_abc, $sym);
if ($sym->{state} == ABC_S_EMBED) { $new_abc .= ']' }
else { $nl_new = 1; }
return ($new_abc, $nl_new);
}
# Initializes voice variables
sub _initialize {
$voice_struct{$c_voice}{id} = q{};
$voice_struct{$c_voice}{name} = q{};
$voice_struct{$c_voice}{meter}{text} = 'M:' . DEFAULT_METER;
$voice_struct{$c_voice}{meter}{wmeasure} = BASE_LEN;
$voice_struct{$c_voice}{length} = 'L:' . DEFAULT_LENGTH;
$voice_struct{$c_voice}{time} = 0;
$voice_struct{$c_voice}{key}{text} = q{};
return;
}
# -- calculates key note and mode
sub _key_calc {
my $sym = shift;
my $abc = q{};
# calculates Key
if ( $sym->{info}->{mode} < BAGPIPE ) {
# ion dor phr lyd mix aeo loc
# 7 C# D# E# F# G# A# B#
# 6 F# G# A# B C# D# E#
# 5 B C# D# E F# G# A#
# 4 E F# G# A B C# D#
# 3 A B C# D E F# G#
# 2 D E F# G A B C#
# 1 G A B C D E F#
# 0 C D E F G A B
# -1 F G A Bb C D E
# -2 Bb C D Eb F G A
# -3 Eb F G Ab Bb C D
# -4 Ab Bb C Db Eb F G
# -5 Db Eb F Gb Ab Bb C
# -6 Gb Ab Bb Cb Db Eb F
# -7 Cb Db Eb Fb Gb Ab Bb
my $i = $sym->{info}->{sf} + $key_shift[ $sym->{info}->{mode} ];
$abc .= $key_tonic[ ( $i + 7 ) % 7 ];
if ( $i < 0 ) { $abc .= 'b' }
elsif ( $i >= 7 ) { $abc .= q{#} }
}
# if it is a mode other than major it appends the first 3 characters of its name (mixolydian => mix)
if ( $sym->{info}->{mode} != MAJOR ) {
$abc .= substr( (KEY_NAMES)[ $sym->{info}->{mode} ], 0, 3 );
}
return $abc;
}
# -- dump the header key
sub _key_header_dump {
my($abc, $sym) = @_;
lib/Music/Abc/DT.pm view on Meta::CPAN
$new_abc .= '{';
if ( $sym->{flags} & ABC_F_SAPPO ) { $new_abc .= q{/} } #short appoggiatura
}
}
return $new_abc;
}
# -- returns the abc for the info field and the new line flag
sub _pscom_to_abc {
my ( $new_abc, $sym, $c ) = @_;
my $nl_new = 1;
if ( $sym->{text} ne q{} ) {
if ( $c ne "\n" ) { $new_abc .= "\\\n" }
# _lyrics_dump($new_abc, $sym) if ($new_abc ne "");
$new_abc .= $sym->{text};
}
return ( $new_abc, $nl_new );
}
# -- dumps rests and additional spacings to abc
sub _rest_to_abc {
my ( $sym, $new_abc ) = @_;
if ( $sym->{info}->{lens}->[0] ) {
# rests
$new_abc .= $sym->{flags} & ABC_F_INVIS ? 'x' : 'z';
$new_abc =
_length_dump( $new_abc, _broken_rhythm( $sym->{info}->{lens}->[0] ) );
} else {
# additional spacing
$new_abc .= 'y';
if ( $sym->{info}->{lens}->[1] >= 0 ) {
$new_abc .= $sym->{info}->{lens}->[1];
}
}
return $new_abc;
}
# -- set the duration of all notes/rests/mrests
sub _set_durations {
my ( $tunes_ref, $tune ) = @_;
my $n_symbols = scalar( @{ ${$tunes_ref}->{$tune}->{symbols} } ) - 1;
my %v_i = (); # current voice's info
my $c = $IMPLICIT_VOICE; # current voice
#FIXME ver se consigo deixar de usar o ${$s} e passar a usar so $s
# sets the duration of all notes/rests without regard for tuplets - this is needed for tuplets
for my $ix ( 0 .. $n_symbols ) {
my $s = \${$tunes_ref}->{$tune}->{symbols}->[$ix];
given ( ${$s}->{type} ) {
when (ABC_T_INFO) {
given ( substr ${$s}->{text}, 0, 1 ) {
when ('V') { # Voice
if ( ${$s}->{state} ~~ [ABC_S_TUNE, ABC_S_EMBED] ) {
$c = ${$s}->{info}->{voice};
$v_i{$c}{meter}{wmeasure} ||= BASE_LEN;
}
}
when ('M') { # Meter
if ( ${$s}->{state} ~~ [ ABC_S_HEAD, ABC_S_TUNE ] ) {
$v_i{$c}{meter}{wmeasure} = ${$s}->{info}->{wmeasure};
}
}
}
}
when ( [ ABC_T_NOTE, ABC_T_REST ] ) {
${$s}->{info}->{dur} = ${$s}->{info}->{lens}->[0]
}
when (ABC_T_MREST) {
my $dur = $v_i{$c}{meter}{wmeasure} * ${$s}->{info}->{len};
${$s}->{info}->{dur} = $dur;
}
}
}
return;
}
# sets the real duration for notes and rests inside a tuplet
# updates the time offset
# sets bar numbers on notes, rests, mrests and bars
sub _set_tuplet_time_and_bars {
my ( $tunes_ref, $tune ) = @_;
my $n_symbols = scalar( @{ ${$tunes_ref}->{$tune}->{symbols} } ) - 1;
my $c = $IMPLICIT_VOICE; # current voice
my %v_i = (); # current voice's info
$v_i{$c}{meter}{wmeasure} ||= BASE_LEN;
$v_i{$c}{bar}{num} ||= int $FIRST_MEASURE;
$v_i{$c}{bar}{time} ||= 0;
$v_i{$c}{time} ||= 0;
for my $ix ( 0 .. $n_symbols ) {
my $s = ${$tunes_ref}->{$tune}->{symbols}->[$ix];
given ( $s->{type} ) {
when (ABC_T_INFO) {
given ( substr $s->{text}, 0, 1 ) {
when ('V') { # Voice
if ( $s->{state} ~~ [ABC_S_TUNE, ABC_S_EMBED] ) {
$c = $s->{info}->{voice};
$v_i{$c}{meter}{wmeasure} ||= BASE_LEN;
$v_i{$c}{bar}{num} ||= int $FIRST_MEASURE;
$v_i{$c}{bar}{time} ||= 0;
$v_i{$c}{time} ||= 0;
}
}
when ('M') { # Meter
if ( $s->{state} ~~ [ ABC_S_HEAD, ABC_S_TUNE ] ) {
$v_i{$c}{meter}{wmeasure} = $s->{info}->{wmeasure};
}
}
}
}
when (ABC_T_TUPLET) {
_set_tuplet( $tunes_ref, $tune, $ix, $s );
}
}
# sets the time offset on notes/rest/mrests/bars
_set_time_offset(\$s, \$v_i{$c}{bar}{time});
given ( $s->{type} ) {
when (ABC_T_BAR) {
# for incomplete measures
$v_i{$c}{bar}{time} ||= $v_i{$c}{meter}{wmeasure};
# increments bar number only if it isn't an incomplete measure
if ( $s->{info}->{type} != B_OBRA and $s->{info}->{time} >= $v_i{$c}{bar}{time} ) { $v_i{$c}{bar}{num}++ }
$s->{info}->{bar_num} = $v_i{$c}{bar}{num};
# updates the new measure's bar time
$v_i{$c}{bar}{time} = $s->{info}->{time} + $v_i{$c}{meter}{wmeasure};
}
when ( [ ABC_T_NOTE, ABC_T_REST ] ) {
$s->{info}->{bar_num} = $v_i{$c}{bar}{num};
}
when (ABC_T_MREST) {
$s->{info}->{bar_num} = $v_i{$c}{bar}{num};
$v_i{$c}{bar}{num} += ($s->{info}->{len} - 1);
}
}
}
return;
}
# -- set the duration of notes/rests in a tuplet
# FIXME: KO if voice change
# FIXME: KO if in a grace sequence
# TODO : finish nested tuples (there's a detail in the C version that i don't understand)
sub _set_tuplet {
my ( $tunes_ref, $tune, $sym_ix, $sym ) = @_;
my $as;
my $s;
my $lplet;
my $r = $sym->{info}->{r_plet};
my $grace = $sym->{flags} & ABC_F_GRACE;
my $c_tune_local = ${$tunes_ref}->{$tune};
( run in 2.662 seconds using v1.01-cache-2.11-cpan-0b58ddf2af1 )