A guitar scale thingy
#!/usr/local/bin/perl -w
use strict;
use CGI;
my @notes = ('a','a#','b','c','c#','d','d#','e','f','f#','g','g#');
my %scales = ( major => '0,2,4,5,7,9,11', minor => '0,2,3,5,7,9,11',);
my %f = ( key=>'a', scale=>'major', 1=>'e', 2=>'a', 3=>'d', 4=>'g', 5=
+>'b', 6=>'e' );
my $cgi = CGI->new();
$f{$_} = $cgi->param($_) for $cgi->param;
sub findstr{my $i=0;++$i while $notes[$i] ne $f{$_[0]};$i}
sub selbox($$@) { qq:<select name="$_[0]">:.join('',map{my $a=/^$_[1]$
+/?'selected':'';"<option $a>$_</option>"}@_[2..$#_]).'</select>'}
sub row{'<tr>'.join('',map{qq{<td align="center" valign="center">$_</t
+d>}}@_).'</tr>'}
my $offset = findstr('key');
%scales = map{ $_ =>{ map{my $a=$notes[($_+$offset)%12];$a=>$_}split/,
+/,$scales{$_} } } keys %scales;
print $cgi->header();
print '<html><head><title>Guitar Fretboard</title></head><body><table
+align="center" bgcolor="#FFFFFF" cellspacing="0" cellpadding="0" bord
+er="1">';
print '<form name="foo" method="post"><tr><td colspan="1">' . selbox('
+key',$f{'key'},@notes) . '</td><td colspan="5">';
print selbox('scale',$f{'scale'},keys %scales) . '</td></tr><tr><td co
+lspan="6"><input type="submit" value="update"/> Notes:<input val
+ue="';
print join(',', sort keys %{ $scales{ $f{scale} } } ) . '"/></td></tr>
+' . row( reverse map{ selbox( $_, $f{$_}, @notes )}1..6 );
my @strings = map{ findstr($_) }reverse(1..6);
for ( 1 ..24 ) {
print row(
map{
$_=@notes[($strings[$_]++)%12];
my $c = $_;
if ( exists( $scales{$f{scale}}->{$_} ) ) {
$_ = ( $_ eq $f{key} ) ? 'root' : 'not
+e';
}
else {
$_ = 'blank';
}
qq{<img src="http://www.thesite.org/~frank/$_.
+gif" alt="$c">};
}(0..$#strings)
);
print '<tr><td colspan="6" bgcolor="black"><img src="http://ww
+w.thesite.org/~frank/spacer.gif" height="2"></td></tr>';
}
print '</form></table></body></html>';
The plan is to link it to a mysql database that holds lots of loverly scales like the Gai-Gaku-Ritu Sen Poi Scale and the like.
|
