File Coverage

blib/lib/Guitar/Scale.pm

Criterion	Covered	Total	%
statement	25	31	80.6
branch	4	6	66.6
condition	1	2	50.0
subroutine	3	3	100.0
pod	0	1	0.0
total	33	43	76.7

package Guitar::Scale;

# Copyright (C) 2013 by Mitsuru Yasuda. All rights reserved.
# mail bugs, comments and feedback to [e-mail]

use strict;
use warnings;
our $VERSION = '0.06';

sub pv {
	#
	#
	# use Guitar::Scale;
	# print Guitar::Scale::pv('E', 'Chromatic');
	#
	#
	my ($_key, $_t, $mode)  = @_;
	           $_t ||= 'Minor';
	my %type = (
	  'MitsuruMetal'    => '201011010111',
	  'Aeolian'         => '201101011010',
	  'Altered'         => '210110111010',
	  'Algerian'        => '201101111001',
	  'Blues'           => '200101110010',
	  'Blues++'         => '200111110111',
	  'Chromatic'       => '211111111111',
	  'Diminished'      => '201101101101',
	  'Diminish--'      => '001001001001',
	  'Dorian'          => '201101010110',
	  'Dominant7th'     => '201011010110',
	  'Diatonic'        => '201010010100',
	  'Egyptian'        => '201001010010',
	  'HarmonicMinor'   => '201101011001',
	  'Hawaiian'        => '201101010101',
	  'Hindu'           => '201011011010',
	  'HeavyMetal'      => '201101110110',
	  'Ionian'          => '201011010101',
	  'Japanese'        => '210001100010',
	  'Lydian'          => '201010110101',
	  'Minor'           => '201101011010',
	  'MelodicMinor'    => '201101010101',
	  'Mixolydian'      => '201011010110',
	  'Major'           => '201011010101',
	  'Pentatonic'      => '200101010010',
	  'Phrygian'        => '210101011010',
	  'Roumanian'       => '201100110110',
	  'Ryukyu'          => '200011010001',
	  'Sobaya'          => '210001011000',
	  'Spanish'         => '210011011010',
	  'Ultralocrian'    => '210110101100',
	  'WholeTone'       => '201010101010',

	);
	my @key = (
	  'E','F','F#|Gb','G','G#|Ab','A','A#|Bb','B','C','C#|Db','D','D#|Eb'
	);

	#
	# your homemade @(^-^)@
	#
	if ($_t =~ /^2\d{11}$/) { $type{$_t} = $_t }

	# make scale
	my $st  = 0;
	for my $s ( 0 .. $#key ){
		if ($_key =~ /^$key[$s]$/i) { $st = $s; last }
	}
	my $col = substr(substr($type{$_t}, 12-$st, $st).$type{$_t} ,0 ,12) x 4;

	# print scale
	my
	$str  = substr($col,  0, 25). "\n";
	$str .= substr($col,  7, 25). "\n";
	$str .= substr($col,  3, 25). "\n";
	$str .= substr($col, 10, 25). "\n";
	$str .= substr($col,  5, 25). "\n";
	$str .= substr($col,  0, 25). "\n";
	$mode || do {
	 $str =~ s/0/--+/g;
	  $str =~ s/1/<>+/g;
	   $str =~ s/2/[]+/g;# bass key
	    for my $i ( 0 .. 24 ){ $str .= sprintf("%02d ", $i) }
	};
	return $str;
}

__END__