view release on metacpan or  search on metacpan

bin/atonal-util  view on Meta::CPAN

    _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) = @_;
    GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
    $Lyu->chrome('flats') if $Flag_Flat;
    emit_pitch_set( scalar $Atu->half_prime_form( args2pitchset(@args) ),
        rs => $Flag_Record_Sep );
}

sub interval_class_content {
    my (@args) = @_;
    GetOptionsFromArray( \@args, @Std_Opts, 'scaledegrees|sd=i' => \my $sd );
    $Atu->scale_degrees($sd) if $sd;
    emit_pitch_set(
        scalar $Atu->interval_class_content( args2pitchset(@args) ),
        lyflag => 0,
        rs     => '',
    );
}

sub intervals2pcs {
    my (@args) = @_;
    GetOptionsFromArray( \@args, @Std_Opts, 'pitch|n=s' => \my $start_pitch )
      or print_help();
    $start_pitch = $Lyu->notes2pitches( $start_pitch // 0 );

    $Lyu->ignore_register(0);

    emit_pitch_set( $Atu->intervals2pcs( $start_pitch, args2pitchset(@args) ),
        rs => $Flag_Record_Sep );
}

sub invariance_matrix {
    my (@args) = @_;
    GetOptionsFromArray( \@args, @Std_Opts );
    emit_pitch_set(
        $Atu->invariance_matrix( args2pitchset(@args) ),
        lyflag => 0,
        rs     => $Flag_Record_Sep
    );
}

sub invariants {
    my (@args) = @_;
    GetOptionsFromArray( \@args, @Std_Opts ) or print_help();
    $Lyu->chrome('flats') if $Flag_Flat;
    my $ps = args2pitchset(@args);

    my %seen;
    @seen{@$ps} = ();