#!/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:'} sub row{''.join('',map{qq{$_}}@_).''} my $offset = findstr('key'); %scales = map{ $_ =>{ map{my $a=$notes[($_+$offset)%12];$a=>$_}split/,/,$scales{$_} } } keys %scales; print $cgi->header(); print 'Guitar Fretboard'; print '' . 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' : 'note'; } else { $_ = 'blank'; } qq{$c}; }(0..$#strings) ); print ''; } print '
' . selbox('key',$f{'key'},@notes) . ''; print selbox('scale',$f{'scale'},keys %scales) . '
 Notes:
';