File Coverage

blib/lib/Music/Voss.pm

Criterion	Covered	Total	%
statement	50	79	63.2
branch	12	46	26.0
condition	5	36	13.8
subroutine	11	14	78.5
pod	3	3	100.0
total	81	178	45.5

# -*- Perl -*-
#
# Functions for fractal noise generation functions.
#
# Run perldoc(1) on this file for additional documentation.

package Music::Voss;

use 5.010000;
use strict;
use warnings;
use Carp qw(croak);
use Exporter 'import';
use List::Util ();
use Scalar::Util qw(looks_like_number);

our $VERSION = '0.05';

our @EXPORT_OK = qw(bitchange powers powers_stateless);

# This method derived from the "White and brown music, fractal curves
# and one-over-f fluctuations" article. Should also be possible with
# physical dice and a binary chart to show how the bits change between
# tries and thus which dice need be re-rolled for a particular try.
sub bitchange {
  my (%params) = @_;
  if ( !exists $params{rollers} ) {
    $params{rollers} = 3;
  } elsif ( !defined $params{rollers} or !looks_like_number $params{rollers} ) {
    croak "rollers must be a number";
  } else {
    $params{rollers} = int $params{rollers};
  }
  if ( !exists $params{roll} ) {
    $params{roll} = sub { int rand 6 };
  } elsif ( !defined $params{roll} or ref $params{roll} ne 'CODE' ) {
    croak "roll must be code reference";
  }
  if ( !exists $params{summer} ) {
    $params{summer} = \&List::Util::sum0;
  } elsif ( !defined $params{summer} or ref $params{summer} ne 'CODE' ) {
    croak "summer must be code reference";
  }
  my @nums = map { $params{roll}->( undef, $_ ) } 0 .. $params{rollers} - 1;
  my $prev;
  return sub {
    my ($n) = @_;
    croak "input must be number" if !defined $n or !looks_like_number $n;
    if ( defined $prev ) {
      for my $rnum ( 0 .. $params{rollers} - 1 ) {
        if ( ( $n >> $rnum & 1 ) != ( $prev >> $rnum & 1 ) ) {
          $nums[$rnum] = $params{roll}->( $n, $rnum );
        }
      }
    }
    $prev = $n;
    return $params{summer}->(@nums);
  };
}

# "Musimathics, Vol 1" p.358 based function generator based on powers of
# (by default) 2, the supplied number, and a list of subroutines to
# (perhaps) run. (Was called "voss", orginally.)
sub powers {
  my (%params) = @_;
  croak "must be given list of calls"
    if !$params{calls}
    or ref $params{calls} ne 'ARRAY';
  if ( !exists $params{summer} ) {
    $params{summer} = \&List::Util::sum0;
  } elsif ( !defined $params{summer} or ref $params{summer} ne 'CODE' ) {
    croak "summer must be code reference";
  }
  if ( !exists $params{e} ) {
    $params{e} = 2;
  } elsif ( !defined $params{e} or !looks_like_number $params{e} ) {
    croak "e must be a number";
  }
  my @nums = (0) x @{ $params{calls} };
  return sub {
    my ($n) = @_;
    croak "input must be number" if !defined $n or !looks_like_number $n;
    for my $k ( 0 .. $#{ $params{calls} } ) {
      if ( $n % $params{e}**$k == 0 ) {
        $nums[$k] = $params{calls}->[$k]->( $n, $k );
      }
    }
    return $params{summer}->(@nums);
  };
}

sub powers_stateless {
  my (%params) = @_;
  croak "must be given list of calls"
    if !$params{calls}
    or ref $params{calls} ne 'ARRAY';
  if ( !exists $params{summer} ) {
    $params{summer} = \&List::Util::sum0;
  } elsif ( !defined $params{summer} or ref $params{summer} ne 'CODE' ) {
    croak "summer must be code reference";
  }
  if ( !exists $params{e} ) {
    $params{e} = 2;
  } elsif ( !defined $params{e} or !looks_like_number $params{e} ) {
    croak "e must be a number";
  }
  return sub {
    my ($n) = @_;
    croak "input must be number" if !defined $n or !looks_like_number $n;
    my @nums;
    for my $k ( 0 .. $#{ $params{calls} } ) {
      if ( $n % $params{e}**$k == 0 ) {
        push @nums, $params{calls}->[$k]->( $n, $k );
      }
    }
    return $params{summer}->(@nums);
  };
}

1;
__END__