view release on metacpan or  search on metacpan

lib/Music/AtonalUtil.pm  view on Meta::CPAN

    # XXX packing not implemented beyond "right" method (via www.mta.ca docs)
    $self->{_packing} = 'right';    # $param{PACKING} // 'right';

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

sub normal_form {
    my $self = shift;
    my $pset = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];

    croak 'pitch set must contain something' if !@$pset;

    my %origmap;
    for my $p (@$pset) {
        push @{ $origmap{ $p % $self->{_DEG_IN_SCALE} } }, $p;
    }
    if ( keys %origmap == 1 ) {
        return wantarray ? ( [ keys %origmap ], \%origmap ) : [ keys %origmap ];
    }
    my @nset = sort { $a <=> $b } keys %origmap;

    my $equivs = $self->circular_permute( \@nset );
    my @order  = 1 .. $#nset;
    # NOTE this only performs 'right' packing, see commits
    # 9f0c33f8260af9584d38c92af4e7a6a39f7e2769 and prior for long since
    # unimplemented notes on this topic
    @order = reverse @order;

    my @normal;
    for my $i (@order) {
        my $min_span = $self->{_DEG_IN_SCALE};
        my @min_span_idx;

        for my $eidx ( 0 .. $#$equivs ) {
            my $span =
              ( $equivs->[$eidx][$i] - $equivs->[$eidx][0] ) % $self->{_DEG_IN_SCALE};
            if ( $span < $min_span ) {
                $min_span     = $span;
                @min_span_idx = $eidx;
            } elsif ( $span == $min_span ) {
                push @min_span_idx, $eidx;
            }
        }

        if ( @min_span_idx == 1 ) {
            @normal = @{ $equivs->[ $min_span_idx[0] ] };
            last;
        } else {
            @$equivs = @{$equivs}[@min_span_idx];
        }
    }

    if ( !@normal ) {
        # nothing unique, pick lowest starting pitch, which is first index
        # by virtue of the numeric sort performed above.
        @normal = @{ $equivs->[0] };
    }

    $_ += 0 for @normal;    # KLUGE avoid Test::Differences seeing '4' vs. 4

    return wantarray ? ( \@normal, \%origmap ) : \@normal;
}

# Utility, converts a pitch set into a scale_degrees-bit number:
#                7   3  0
# [0,3,7] -> 000010001001 -> 137
sub pcs2bits {
    my $self = shift;
    my $pset = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];

    croak 'pitch set must contain something' if !@$pset;

    my $bs = 0;
    for my $p ( map $_ % $self->{_DEG_IN_SCALE}, @$pset ) {
        $bs |= 1 << $p;
    }
    return $bs;
}

sub pcs2forte {
    my $self = shift;
    my $pset = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];

    croak 'pitch set must contain something' if !@$pset;

    return $PCS2FORTE{ join ',', @{ $self->prime_form($pset) } };
}

sub pcs2intervals {
    my $self = shift;
    my $pset = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];

    croak 'pitch set must contain at least two elements' if @$pset < 2;

    my @intervals;
    for my $i ( 1 .. $#{$pset} ) {
        push @intervals, $pset->[$i] - $pset->[ $i - 1 ];
    }

    return \@intervals;
}

sub pcs2str {
    my $self = shift;
    croak 'must supply a pitch set' if !defined $_[0];

    my $str;
    if ( ref $_[0] eq 'ARRAY' ) {
        $str = '[' . join( ',', @{ $_[0] } ) . ']';
    } elsif ( $_[0] =~ m/,/ ) {
        $str = '[' . $_[0] . ']';
    } else {
        $str = '[' . join( ',', @_ ) . ']';
    }
    return $str;
}

sub pitch2intervalclass {
    my ( $self, $pitch ) = @_;