view release on metacpan or  search on metacpan

bin/atonal-util  view on Meta::CPAN

    for my $i ( 0 .. $Atu->scale_degrees - 1 ) {
        my $set = ( $Atu->normal_form( $Atu->transpose( $i, $pset ) ) )[0];
        if ( !$seen{"@$set"}++ ) {
            push @transpose, $set;
            my $iset =
              ( $Atu->normal_form( $Atu->transpose_invert( $i, 0, $pset ) ) )[0];
            push @transpose_invert, $iset if !$seen{"@$iset"}++;
        }
    }

    emit_pitch_set( \@transpose )        if @transpose;
    emit_pitch_set( \@transpose_invert ) if @transpose_invert;
}

sub findall {
    my (@args) = @_;
    GetOptionsFromArray(
        \@args, @Std_Opts,
        'exclude=s' => \my $excludes,
        'fn=s'      => \my $desired_forte_nums,
        'root=s'    => \my $root_pitch
    );
    $Lyu->chrome('flats') if $Flag_Flat;

    my $desired = args2pitchset(@args);
    my %excludes;
    @excludes{ $Lyu->notes2pitches( split /[, ]+/, $excludes ) } = ()
      if defined $excludes;
    $root_pitch = $Lyu->notes2pitches($root_pitch) if defined $root_pitch;
    my $fn_re;
    if ( defined $desired_forte_nums ) {
        $fn_re = '^[' . join( '', parse_range($desired_forte_nums) ) . ']$';
    }

    my $fnums = $Atu->fnums;
    for my $fnum ( sort keys %$fnums ) {
        if ( defined $desired_forte_nums ) {
            ( my $prefix = $fnum ) =~ s/[-].+//;
            next if $prefix !~ m/$fn_re/;
        }
        _findps( $fnums->{$fnum}, $desired, $root_pitch, \%excludes, $fnum );
    }
}

sub findin {
    my (@args) = @_;
    GetOptionsFromArray(
        \@args, @Std_Opts,
        'exclude=s'    => \my $excludes,
        'pitchset|P=s' => \my @base_input,
        'root=s'       => \my $root_pitch
    ) or print_help();

    die "error: atonal-util findin needs --pitchset=... option\n"
      unless @base_input;

    $Lyu->chrome('flats') if $Flag_Flat;

    for my $bi (@base_input) {
        say "PS $bi" if @base_input > 1;

        my $ps_base;
        if ( $bi =~ m/^\d-/ ) {
            $ps_base = $Atu->forte2pcs($bi);
            die "unknown Forte Number '$bi'\n" if !defined $ps_base;
        } else {
            $ps_base = args2pitchset( split /[ ,]/, $bi );
        }
        my $desired = args2pitchset(@args);
        my %excludes;
        @excludes{ $Lyu->notes2pitches( split /[, ]+/, $excludes ) } = ()
          if defined $excludes;
        $root_pitch = $Lyu->notes2pitches($root_pitch) if defined $root_pitch;

        if ( @$desired > @$ps_base ) {
            die "cannot desire more than is present\n";
        }

        _findps( $ps_base, $desired, $root_pitch, \%excludes );
    }
}

sub _findps {
    my ( $ps_base, $desired, $root_pitch, $excludes, $fnum ) = @_;
    $fnum     //= '-';
    $excludes //= {};

    _init_tension() if $Flag_Tension;

    my $ps_width = 24 - ( $Flag_Lyout ? 0 : 6 );

  TRANS: for my $i ( 0 .. $Atu->scale_degrees - 1 ) {
        my %tps;
        @tps{ @{ $Atu->transpose( $i, $ps_base ) } } = ();
        if ( all { exists $tps{$_} } @$desired ) {
            my @pitches = @{ $Atu->transpose( $i, $ps_base ) };
            next if defined $root_pitch and $pitches[0] != $root_pitch;
            if (%$excludes) {
                for my $p (@pitches) {
                    next TRANS if exists $excludes->{$p};
                }
            }

            my $tstr = '';
            if ($Flag_Tension) {
                $tstr = sprintf "\t%.03f  %.03f  %.03f", $Tension->vertical( \@pitches );
            }

            @pitches = $Lyu->p2ly(@pitches) if $Flag_Lyout;

            my $s = sprintf "%s\tT(%d)\t%-${ps_width}s%s", $fnum, $i,
              join( ',', @pitches ), $tstr;
            $s =~ s/\s+$//;
            say $s;
        }
    }

  TRANSINV: for my $i ( 0 .. $Atu->scale_degrees - 1 ) {
        my %ips;
        @ips{ @{ $Atu->transpose_invert( $i, 0, $ps_base ) } } = ();
        if ( all { exists $ips{$_} } @$desired ) {
            my @pitches = @{ $Atu->transpose_invert( $i, 0, $ps_base ) };
            next if defined $root_pitch and $pitches[0] != $root_pitch;
            if (%$excludes) {
                for my $p (@pitches) {
                    next TRANSINV if exists $excludes->{$p};
                }
            }

            my $tstr = '';
            if ($Flag_Tension) {
                $tstr = sprintf "\t%.03f  %.03f  %.03f", $Tension->vertical( \@pitches );
            }

            @pitches = $Lyu->p2ly(@pitches) if $Flag_Lyout;

            my $s = sprintf "%s\tTi(%d)\t%-${ps_width}s%s", $fnum, $i,
              join( ',', @pitches ), $tstr;
            $s =~ s/\s+$//;
            say $s;
        }
    }
}

sub fnums {
    my (@args) = @_;
    GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
    _init_tension('cope') if $Flag_Tension;

    my $fns = $Atu->fnums;
    for my $fn ( sort keys %$fns ) {
        my $pset = $fns->{$fn};
        my $icc  = $Atu->interval_class_content($pset);

        my $tstr = '';
        if ($Flag_Tension) {
            $tstr = sprintf "\t%.03f  %.03f  %.03f", $Tension->vertical($pset);
        }

        my $s = sprintf "%s\t%-16s\t%-8s%s", $fn, join( ',', @$pset ),
          join( '', @$icc ), $tstr;
        $s =~ s/\s+$//;
        say $s;
    }
}

sub forte2pcs {
    my (@args) = @_;
    GetOptionsFromArray( \@args, @Std_Opts ) or print_help();

    emit_pitch_set( $Atu->forte2pcs( $args[0] ), rs => $Flag_Record_Sep );
}

sub freq2pitch {
    my (@args) = @_;
    my $mode = 'absolute';
    GetOptionsFromArray(
        \@args,
        @Std_Opts,
        'concertfreq|cf=s'  => \my $concert_freq,
        'concertpitch|cp=s' => \my $concert_pitch,
        'relative=s'        => \my $relative,
        'scala=s'           => \my $scala_file,
    ) or print_help();

    my ( $scala, $p2f ) = _init_scala( $concert_freq, $concert_pitch, $scala_file );

    if ( !@args or ( @args == 1 and $args[0] eq '-' ) ) {
        chomp( @args = readline *STDIN );
    }

    # Not the default, so if things persist or chain due to some rewrite,
    # would need to save the old or create a new object or whatever
    $Lyu->keep_state(1);
    $Lyu->mode('absolute');

    for my $freq ( grep looks_like_number $_, map { split ' ', $_ } @args ) {
        die "frequency '$freq' out of range" if $freq < 8 or $freq > 4200;

        my $p = $scala->freq2pitch($freq);

        # how off is the frequency from the given scale and concertfreq?
        my $pitch_freq = $scala->pitch2freq($p);
        my $error      = $freq - $pitch_freq;

        $p = $Lyu->p2ly($p) if $Flag_Lyout;

        my $percent = abs($error) / $pitch_freq * 100;

        printf "%.2f\t%s\t%+.2f\t%.2f%%\n", $freq, $p, $error, $percent;
    }
}

sub gen_melody {
    my (@args) = @_;
    $Flag_Record_Sep = ' ';    # for easier feeding to ly-fu
    GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
    $Lyu->chrome('flats') if $Flag_Flat;
    emit_pitch_set( $Atu->gen_melody, rs => $Flag_Record_Sep );
}

sub half_prime_form {
    my (@args) = @_;