File Coverage

blib/lib/Lutherie/FretCalc.pm

Criterion	Covered	Total	%
statement	6	159	3.7
branch	0	96	0.0
condition	0	24	0.0
subroutine	2	15	13.3
pod	13	13	100.0
total	21	307	6.8

# Copyright (c) 2001 Douglas Sparling. All rights reserved. This program is free
# software; you can redistribute it and/or modify it under the same terms
# as Perl itself.

package Lutherie::FretCalc;

use strict;
use vars qw($VERSION);

$VERSION = '0.33';

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;
    my $self = {};

    if (defined $_[0]) {
        $self->{scale} = $_[0];
    } else {
        $self->{scale} = 25;
    }
    if (defined $_[1]) {
        $self->{num_frets} = $_[1];
    } else {
        $self->{num_frets} = 24;
    }
    #$self->{num_frets}  = 24;
    $self->{fret_num}    = 12;
    $self->{in_units}    = 'in';
    $self->{out_units}   = 'in';
    $self->{calc_method} = 't';
    $self->{tet}         = 12;
    $self->{precision}   = 4; # Precision for 'in'
    #$self->{half_fret}   = ();

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

sub scale {
    my($self) = shift;
    if(@_) { $self->{scale} = shift }
    return $self->{scale};
}

sub num_frets {
    my($self) = shift;
    if(@_) { $self->{num_frets} = shift }
    return $self->{num_frets};
}

sub fret_num {
    my($self) = shift;
    if(@_) { $self->{fret_num} = shift }
    return $self->{fret_num};
}

sub in_units {
    my($self) = shift;
    if(@_) { $self->{in_units} = shift }
    return $self->{in_units};
}

sub out_units {
    my($self) = shift;
    if(@_) {
        my $out_units = shift;
        # Set precision defaults
        if( $out_units eq 'in' ) {
            $self->{precision} = 4;
        } else {
            $self->{precision} = 1;
        }
        $self->{out_units} = $out_units;
    }
    return $self->{out_units};
}

sub calc_method {
    my($self) = shift;
    if(@_) { $self->{calc_method} = shift }
    return $self->{calc_method};
}

sub tet {
    my($self) = shift;
    if(@_) { $self->{tet} = shift }
    return $self->{tet};
}

sub precision {
    my($self) = shift;
    if(@_) {
        my $prec = shift;
        $prec = 4 if $prec < 0 or $prec > 6;
        $self->{precision} = $prec;
    }
    return $self->{precision};
}

sub half_fret {
    my($self) = shift;
    #if(@_) { $self->{half_fret} = shift }
    if(@_) {
        if($self->{half_fret}) {
            $self->{half_fret} = join(',', $self->{half_fret},shift);
        } else {
            $self->{half_fret} = shift;
        }
    }
    return $self->{half_fret};
}


sub fretcalc {

    my($self) = shift;

    if(@_) { $self->{num_frets} = shift }

    my $distance_from_nut = 0;
    my $distance_from_nut_formatted;

    my @chart = ();
    # Set precision
    my $prec;
    $prec = '%8.0f' if $self->{precision} == 0;
    $prec = '%8.1f' if $self->{precision} == 1;
    $prec = '%8.2f' if $self->{precision} == 2;
    $prec = '%8.3f' if $self->{precision} == 3;
    $prec = '%8.4f' if $self->{precision} == 4;
    $prec = '%8.5f' if $self->{precision} == 5;
    $prec = '%8.6f' if $self->{precision} == 6;
    $chart[0] = sprintf("$prec",0);

    for my $i (1..$self->{num_frets}) {
        if ($self->{calc_method} eq 't') {
            $distance_from_nut = ($self->{scale} - $self->{scale}/2 ** ($i/$self->{tet}));
        } elsif ($self->{calc_method} eq 'ec') {
            my $x = ($self->{scale} - $distance_from_nut) / 17.817;
            $distance_from_nut += $x;
        } elsif ($self->{calc_method} eq 'es') {
            my $x = ($self->{scale} - $distance_from_nut) / 17.835;
            $distance_from_nut += $x;
        } elsif ($self->{calc_method} eq 'ep') {
            my $x = ($self->{scale} - $distance_from_nut) / 18;
            $distance_from_nut += $x;
        } else {
            $distance_from_nut = ($self->{scale} - $self->{scale}/2 ** ($i/12));
        }

        ### input scale: in, output scale: in
        if( ($self->{in_units} eq 'in') && ($self->{out_units} eq 'in') ) {
            $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
        ### input scale: in, output scale: mm
        } elsif( ($self->{in_units} eq 'in') && ($self->{out_units} eq 'mm') ) {
            $distance_from_nut *= 25.4;
            $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
        ### input scale: mm, output scale: in
        } elsif( ($self->{in_units} eq 'mm') && ($self->{out_units} eq 'in') ) {
            $distance_from_nut /=  25.4;
            $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
        #### input scale: mm, out_units: mm
        } else {
            $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
        }
        push @chart, $distance_from_nut_formatted;
    }

    return @chart;

}

sub fret {

    my $self = shift;

    # Check if fret_num was passed
    if(@_) { $self->{fret_num} = shift }

    # Set precision
    my $prec;
    $prec = '%8.0f' if $self->{precision} == 0;
    $prec = '%8.1f' if $self->{precision} == 1;
    $prec = '%8.2f' if $self->{precision} == 2;
    $prec = '%8.3f' if $self->{precision} == 3;
    $prec = '%8.4f' if $self->{precision} == 4;
    $prec = '%8.5f' if $self->{precision} == 5;
    $prec = '%8.6f' if $self->{precision} == 6;

    my $distance_from_nut = 0;
    my $distance_from_nut_formatted;
    if ($self->{calc_method} eq 't') {
        $distance_from_nut = ($self->{scale} - $self->{scale}/2 ** ($self->{fret_num}/$self->{tet}));
    } elsif ($self->{calc_method} eq 'ec') {
        for my $i (1..$self->{fret_num}) {
            my $x = ($self->{scale} - $distance_from_nut) / 17.817;
            $distance_from_nut += $x;
        }
    } elsif ($self->{calc_method} eq 'es') {
        for my $i (1..$self->{fret_num}) {
            my $x = ($self->{scale} - $distance_from_nut) / 17.835;
            $distance_from_nut += $x;
        }
    } elsif ($self->{calc_method} eq 'ep') {
        for my $i (1..$self->{fret_num}) {
            my $x = ($self->{scale} - $distance_from_nut) / 18;
            $distance_from_nut += $x;
        }
    } else {
        $distance_from_nut = ($self->{scale} - $self->{scale}/2 ** ($self->{fret_num}/$self->{tet}));
    }

    ### in_units: in, out_units: in
    if( ($self->{in_units} eq 'in') && ($self->{out_units} eq 'in') ) {
        $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
    ### in_units: in, out_units: mm
    } elsif( ($self->{in_units} eq 'in') && ($self->{out_units} eq 'mm') ) {
        $distance_from_nut *= 25.4;
        $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
    ### in_units: mm, out_units: in
    } elsif( ($self->{in_units} eq 'mm') && ($self->{out_units} eq 'in') ) {
        $distance_from_nut /= 25.4;
        $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
    ### in_units: mm, out_units: mm
    } else {
        $distance_from_nut_formatted = sprintf("$prec",$distance_from_nut);
    }
    return $distance_from_nut_formatted;

}

sub dulc_calc {
    my($self) = shift;
    my %dulc;
    my @frets = $self->fretcalc(24); # Use 24 frets for dulcimer

    # Set standard frets
    $dulc{1} = $frets[2];
    $dulc{2} = $frets[4];
    $dulc{3} = $frets[5];
    $dulc{4} = $frets[7];
    $dulc{5} = $frets[9];
    $dulc{6} = $frets[10];
    $dulc{7} = $frets[12];

    $dulc{8} = $frets[14];
    $dulc{9} = $frets[16];
    $dulc{10} = $frets[17];
    $dulc{11} = $frets[19];
    $dulc{12} = $frets[21];
    $dulc{13} = $frets[22];
    $dulc{14} = $frets[24];

    # Add the half frets (valid = 1,6,8,13)
    my @half_frets = split(/,/,$self->{half_fret});
    foreach my $half( @half_frets ) {
        if( $half == 1 ) {
            $dulc{1.5} = $frets[3];
        } elsif( $half == 6 ) {
            $dulc{6.5} = $frets[11];
        } elsif( $half == 8 ) {
            $dulc{8.5} = $frets[15];
        } elsif( $half == 13 ) {
            $dulc{13.5} = $frets[23];
        }
    }

    return %dulc;

}


1;

__END__