File Coverage

blib/lib/Music/Tension.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	16	16	100.0
condition	27	27	100.0
subroutine	8	8	100.0
pod	4	4	100.0
total	97	97	100.0

# -*- Perl -*-
#
# Parent class for music tension analysis modules

package Music::Tension;

our $VERSION = '1.03';

use strict;
use warnings;
use Carp qw/croak/;
use Scalar::Util qw/looks_like_number/;

########################################################################
#
# METHODS

sub new {
    my ( $class, %param ) = @_;
    my $self = {};

    # just MIDI support here, see Music::Scala for scala scale file support
    if ( exists $param{reference_frequency} ) {
        croak "reference_frequency must be a number"
          if !defined $param{reference_frequency}
          or !looks_like_number $param{reference_frequency};
        $self->{_reference_frequency} = $param{reference_frequency};
    } else {
        $self->{_reference_frequency} = 440;
    }

    bless $self, $class;
    return $self;
}

sub freq2pitch {
    my ( $self, $freq ) = @_;
    croak "frequency must be a positive number"
      if !defined $freq
      or !looks_like_number $freq
      or $freq <= 0;

    return sprintf "%.0f",
      69 + 12 * ( log( $freq / $self->{_reference_frequency} ) / log(2) );
}

# accumulate tension values for two phrases at each possible offset
sub offset_tensions {
    my ( $self, $phrase1, $phrase2 ) = @_;

    die "pitches method is unimplemented" unless $self->can('pitches');

    croak "phrase1 is too short"
      unless defined $phrase1
      and ref $phrase1 eq 'ARRAY'
      and $#{$phrase1} > 1;
    croak "phrase2 is too short"
      unless defined $phrase2
      and ref $phrase2 eq 'ARRAY'
      and @$phrase2;

    my $max = $#{$phrase1};

    my @tensions;
    for my $offset ( 0 .. $max ) {
        for my $i ( 0 .. $#{$phrase2} ) {
            my $delta = $i + $offset;
            last if $delta > $max;
            push @{ $tensions[$offset] },
              $self->pitches( $phrase1->[$delta], $phrase2->[$i] );
        }
    }
    return @tensions;
}

sub pitch2freq {
    my ( $self, $pitch ) = @_;
    croak "pitch must be MIDI number"
      if !defined $pitch
      or !looks_like_number $pitch
      or $pitch < 0;

    return $self->{_reference_frequency} * ( 2**( ( $pitch - 69 ) / 12 ) );
}

1;
__END__