aboutsummaryrefslogtreecommitdiff
path: root/chordspeller.pl
diff options
context:
space:
mode:
Diffstat (limited to 'chordspeller.pl')
-rwxr-xr-xchordspeller.pl858
1 files changed, 858 insertions, 0 deletions
diff --git a/chordspeller.pl b/chordspeller.pl
new file mode 100755
index 0000000..66b498d
--- /dev/null
+++ b/chordspeller.pl
@@ -0,0 +1,858 @@
+#!/usr/bin/perl -w
+
+our $self = $0;
+$self =~ s,.*/,,;
+
+our $root = 0;
+our $flat2 = 1;
+our $second = 2;
+our $flat3 = 3;
+our $third = 4;
+our $fourth = 5;
+our $flat5 = 6;
+our $fifth = 7;
+our $flat6 = $sharp5 = 8;
+our $sixth = 9;
+our $flat7 = 10;
+our $seventh = 11;
+our $octave = 12;
+our $ninth = $octave + $second;
+our $tenth = $octave + $third;
+our $eleventh = $octave + $fourth;
+our $thirteenth = $octave + $sixth;
+
+our @majorscale = (0, 2, 4, 5, 7, 9, 11);
+our @minorscale = (0, 2, 3, 5, 7, 8, 10);
+our @major_chord_types = (qw/maj min min maj maj min dim/);
+
+our @intervalnames = (
+ qw/r b2 2 b3 3 4 b5 5 b6 6 b7 7/ );
+
+# TODO: lots more chords
+# also, try to parse the notation instead of having a fixed table.
+# also also, this is the only place in the program where a ninth is
+# really a ninth (14 semitones up) instead of being reduced to a 2nd
+# (2 semitones up).
+
+# btw, "diminished" means "diminished triad", no 7th (older jazz books
+# used "diminished" to mean "diminished triad plus 7th", which we're
+# calling "diminished 7th" here)
+
+our %shapes = (
+ 5 => [ $root, $fifth ],
+ no5 => [ $root, $third ],
+ maj => [ $root, $third, $fifth ],
+ min => [ $root, $flat3, $fifth ],
+ 'min(no5)' => [ $root, $flat3 ],
+ 7 => [ $root, $third, $fifth, $flat7 ],
+ maj7 => [ $root, $third, $fifth, $seventh ],
+ min7 => [ $root, $flat3, $fifth, $flat7 ],
+ sus2 => [ $root, $second, $fifth ],
+ sus4 => [ $root, $fourth, $fifth ],
+ add9 => [ $root, $third, $fifth, $ninth ],
+ 9 => [ $root, $third, $fifth, $seventh, $ninth ],
+ 'min/maj7' => [ $root, $flat3, $fifth, $seventh ],
+ aug => [ $root, $third, $sharp5 ],
+ aug7 => [ $root, $third, $sharp5, $flat7 ],
+ dim => [ $root, $flat3, $flat5 ],
+ dim7 => [ $root, $flat3, $flat5, $sixth ],
+ adim => [ $root, $flat3, $flat5, $flat7 ],
+ 'dim(no7)' => [ $root, $flat3, $flat5 ],
+ 'dim(no3)' => [ $root, $flat5 ],
+ 'dim7(no3)' => [ $root, $flat5, $flat7 ],
+ 6 => [ $root, $third, $fifth, $sixth ],
+ min6 => [ $root, $flat3, $fifth, $sixth ],
+ '6/9' => [ $root, $third, $fifth, $sixth, $ninth ],
+ 'min6/9' => [ $root, $flat3, $fifth, $sixth, $ninth ],
+ 'maj7(no3)' => [ $root, $fifth, $seventh ],
+ 'maj7(no5)' => [ $root, $third, $seventh ],
+ '7(no3)' => [ $root, $fifth, $flat7 ],
+ '7(no5)' => [ $root, $third, $flat7 ],
+ 'm7(no5)' => [ $root, $flat3, $flat7 ],
+ '7#9' => [ $root, $third, $fifth, $flat7, $flat3 ],
+ '7#9(no5)' => [ $root, $third, $flat7, $flat3 ],
+ 'm/add11' => [ $root, $flat3, $fifth, $eleventh ],
+ 'add11' => [ $root, $third, $fifth, $eleventh ],
+ '11' => [ $root, $third, $fifth, $flat7, $eleventh ],
+ 'min11' => [ $root, $flat3, $fifth, $flat7, $eleventh ],
+ 'm/add13' => [ $root, $flat3, $fifth, $thirteenth ],
+ 'add13' => [ $root, $third, $fifth, $thirteenth ],
+ '13' => [ $root, $third, $fifth, $flat7, $eleventh, $thirteenth ],
+ 'min13' => [ $root, $flat3, $fifth, $flat7, $eleventh, $thirteenth ],
+);
+
+our @sharpnames = ( 'c', 'c#', 'd', 'd#', 'e', 'f', 'f#', 'g', 'g#', 'a', 'a#', 'b' );
+our @flatnames = ( 'c', 'db', 'd', 'eb', 'e', 'f', 'gb', 'g', 'ab', 'a', 'bb', 'b' );
+our $notenames = \@sharpnames;
+our @sharpkeys = (0, 7, 2, 9, 4, 11);
+our @keysigs = (
+ 'nat', '5b', '2#', '3b', '4#', '1b', '6b', '1#', '4b', '3#', '2b', '5#');
+
+our $transpose = 0;
+
+our @openstrings;
+our $fretpos = 0;
+our $fretspan = 3;
+our $allowpartial = 0; # set with -p
+our $allowholes = 1; # set with -l
+
+our %notevals = (
+ 'c' => 0,
+ 'c#' => 1,
+ 'db' => 1,
+ 'd' => 2,
+ 'd#' => 3,
+ 'eb' => 3,
+ 'e' => 4,
+ 'f' => 5,
+ 'f#' => 6,
+ 'gb' => 6,
+ 'g' => 7,
+ 'g#' => 8,
+ 'ab' => 8,
+ 'a' => 9,
+ 'a#' => 10,
+ 'bb' => 10,
+ 'b' => 11 );
+
+our @chordints = (qw/I bII II bIII III IV bV V bVI VI bVII VIII/);
+
+our @keynotes = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );
+our @chords = ();
+our $key; # undef = guess
+our $forceroot = 0; # set with -r
+
+sub fix_note {
+ my $note = shift;
+ $note %= 12;
+ return $note;
+}
+
+sub get_note_name {
+ return ucfirst($$notenames[fix_note($_[0])]);
+}
+
+sub name_to_note {
+ my $note = lc($_[0]);
+ return $notevals{$note};
+}
+
+sub add_interval {
+ return fix_note($_[0] + $_[1]);
+}
+
+sub get_interval {
+ return fix_note($_[0] - $_[1]);
+}
+
+sub determine_chord {
+ my $root = shift;
+ my @notes = @_;
+
+ for my $name (sort keys %shapes) {
+ my $shape = $shapes{$name};
+ my $rootname = $$notenames[$root];
+ my @trynotes;
+ for(@$shape) {
+ push @trynotes, add_interval($root, $_);
+ }
+
+ @trynotes = sort { $a <=> $b } @trynotes;
+
+ if(@trynotes != @notes) {
+#warn "$rootname$name: extra notes\n";
+ } elsif(@trynotes < @notes) {
+# warn "$rootname$name: missing notes\n";
+ } else {
+# warn "$rootname$name: same # of notes\n";
+ my $match = 1;
+ for(my $i=0; $i<@notes; $i++) {
+#warn $notes[$i] . ", " . $trynotes[$i];
+ $match = 0 if $notes[$i] != $trynotes[$i];
+ }
+ return $rootname . $name if $match;
+ }
+ }
+
+ return undef;
+}
+
+sub discover_chord {
+ my @frets = split /[^x\d]/i, $_[0];
+
+ my %notes;
+ my $root; # undef = try them all
+ for(my $string = 0; $string < @openstrings; $string++) {
+ next if (not defined $frets[$string]) || ($frets[$string] =~ /x/i);
+ my $note = ($openstrings[$string] + $frets[$string]) % 12;
+ if($forceroot && not defined $root) {
+ $root = $note;
+ }
+ $notes{$note}++;
+ }
+
+ my @notes = sort { $a <=> $b } keys %notes;
+ print "discover_chord(): notes are ";
+ print "$$notenames[$_] " for @notes;
+ print "\n";
+
+#warn "@notes";
+
+ if(defined $root) {
+ return determine_chord($root, @notes);
+ } else {
+ for(@notes) {
+ $ret = determine_chord($_, @notes);
+ return $ret if $ret;
+ }
+ }
+
+ return undef;
+}
+
+sub parse_chord {
+ my $chord = lc(shift);
+ my $fingering;
+ my @frets;
+
+ parse_tuning($tunings{std}) unless @openstrings;
+
+ # tablature input instead of chord symbol?
+ if($chord =~ /^[x\d]/) {
+ @frets = split /[^x\d]/i, $chord;
+ my $gotchord = discover_chord($chord);
+ if(!$gotchord) {
+ warn "$self: can't figure out chord name for fingering $chord\n";
+ return 0;
+ }
+ $chord = $gotchord;
+ }
+
+ # alternate notation
+ $chord =~ s/\+/aug/;
+ $chord =~ s/\-/dim/;
+
+ # rudimentary support for english (e.g. "A minor 7")
+ $chord =~ s/flat/b/gi;
+ $chord =~ s/sharp/#/gi;
+ $chord =~ s/minor/m/gi;
+ $chord =~ s/major/maj/gi;
+ $chord =~ s/\s//g;
+
+ my ($note, $type) = ($chord =~ /^([a-g][#b]?)(.*)?/);
+
+ unless($note) {
+ warn "$self: Invalid chord $chord\n";
+ return 0;
+ }
+
+ $type = "maj" unless $type;
+
+ $type =~ s/^m(#|b|\d|$)/min$1/;
+
+ my $shape = $shapes{$type};
+
+ unless($shape) {
+ warn "$self: Unknown chord type $type\n";
+ return 0;
+ }
+
+ my $val = $notevals{$note};
+
+ unless(defined $val) {
+ warn "$self: Unknown note $note\n";
+ return 0;
+ }
+
+ $val = ($val + $transpose) % 12;
+ $note = $$notenames[$val];
+
+ my @notes;
+ for(@$shape) {
+ my $n = ($val + $_) % 12;
+ $keynotes[$n]++;
+ }
+
+ my $parsed = [ $val, $note, $type ];
+ if(@frets) {
+ for(@frets) {
+ $_ = undef if $_ =~ /x/i;
+ }
+ $fingering = render_fingering($val, \@frets);
+ } else {
+ for(my $startfret = $fretpos; $startfret < $fretpos + 12; $startfret++) {
+ $fingering = find_guitar_chord($startfret, $parsed);
+ last if $fingering;
+ }
+ }
+ push @$parsed, $fingering if $fingering;
+ push @chords, $parsed;
+
+ return 1;
+}
+
+sub dump_chord_shapes {
+ for(sort keys %shapes) {
+ my $shape = $shapes{$_};
+ print "$_: ";
+ for(@$shape) {
+ print $intervalnames[$_ % 12] . " ";
+ }
+ print "\n";
+ }
+}
+
+sub print_chord {
+ my $c = shift;
+ my ($val, $note, $type, $fingering) = @$c;
+ my $shape = $shapes{$type};
+
+ $type =~ s/maj$//; # in output, say A, not Amaj
+
+ my @notes;
+ for(@$shape) {
+ $_ = fix_note($_); # TODO: this turns e.g. 9ths into 2nds
+ my $n = add_interval($val, $_);
+ push @notes, get_note_name($n) . "=" . $intervalnames[$_];
+ }
+
+#my $chordname = ucfirst($note) . $type;
+ my $chordname = get_note_name($val) . $type;
+ if(defined($key)) {
+ my $keyint = $val - $key;
+ $keyint += 12 if $keyint < 0;
+ my $chordint = $chordints[$keyint];
+ if($type =~ /(min|dim)/) { # TODO: this heuristic is lame
+ $chordint = lc($chordint);
+ }
+ $chordname .= " (" . $chordint . ")";
+ }
+
+ print $chordname . ": " . join(" ", @notes) . "\n";
+
+ if($fingering) {
+ print $fingering . "\n";
+ } else {
+ print "(couldn't find fingering at given fret pos)\n";
+ }
+ print "\n";
+}
+
+sub parse_tuning {
+ my $tuning = shift;
+ my $offset = shift || 0;
+
+ $tuning =~ s/\s//g; # allow & ignore spaces
+ $tuning = lc $tuning; # allow uppercase
+
+ die "$self: Invalid tuning '$tuning'\n" unless $tuning =~ /^[a-g#]+$/;
+
+ my @notes = ($tuning =~ /([a-g][#]?)/g);
+ die "$self: Invalid tuning '$tuning'\n" unless @notes;
+
+ @openstrings = ();
+ my @names;
+ for(@notes) {
+ my $note = fix_note(add_interval($notevals{$_}, $offset));
+ push @openstrings, $note;
+ push @names, get_note_name($note);
+ }
+
+ print "Tuning: " . join(" ", @names) . "\n";
+}
+
+# Tuning list isn't really meant to be exhaustive, but should include
+# plenty of variants...
+our @tuning_list = (
+ [ 'std', 'eadgbe', 'Standard Guitar [default]' ],
+ [ 'eb', 'd#g#c#f#a#d#', 'Guitar 1/2 step flat (Eb)' ],
+ [ 'd', 'dgcfad', 'Guitar 1 step flat (D)' ],
+ [ 'c#', 'c#f#beg#c#', 'Guitar 1 1/2 steps flat (C#)' ],
+ [ 'c', 'cfa#d#gc', 'Guitar 2 steps flat (C)' ],
+ [ 'od', 'dadf#ad', 'Open D' ],
+ [ 'og', 'dgdgbd', 'Open G' ],
+ [ 'oe', 'ebeg#be', 'Open E' ],
+ [ 'oeb', 'd#a#d#ga#d#', 'Open Eb' ],
+ [ 'oa', 'eac#eae', 'Open A' ],
+ [ 'dd', 'dadgbe', 'Drop D' ],
+ [ 'dc#', 'c#g#c#f#a#d#', 'Drop C#' ],
+ [ 'dc', 'cgcfad', 'Drop C' ],
+ [ 'nst', 'cgdaeg', 'Fripp\'s New Standard Tuning' ],
+ [ 'b', 'eadg', 'Bass (4-string)' ],
+ [ '5', 'beadg', 'Bass (5-string)' ],
+ [ '6', 'beadgc', 'Bass (6-string)' ],
+ [ '6b', 'beadgb', 'Bass (6-string alt)' ],
+ [ 'r', 'beadf#b', 'Baritone Guitar or alt 6-string bass' ],
+ [ '7', 'beadgbe', '7-string Guitar (low B)' ],
+ [ '7h', 'eadgbea', '7-string Guitar (high A)' ],
+ [ '7d', 'aeadgbe', '7-string Guitar (drop A)' ],
+ [ 't', 'gcfa#de', 'Terz Guitar' ],
+ [ 'm', 'gdae', 'Mandolin' ],
+ [ 'l', 'eadf#be', 'Lute' ],
+ [ 'h', 'adgbe', 'Mexican Vihuela' ],
+ [ 'cv', 'cgda', 'Cello or Viola' ],
+ [ 'v', 'gdae', 'Violin' ],
+ [ 'vs', 'adae', 'Violin (scordatura)' ],
+ [ 'u', 'gcae', 'Ukulele' ],
+ [ 'ub', 'dgbe', 'Baritone Ukulele' ],
+);
+
+our %tunings;
+
+sub tuning_help {
+ for(@tuning_list) {
+ my ($tag, $notes, $name) = @$_;
+ printf("-t%-4s %s (same as -t%s)\n", $tag, $name, $notes);
+ }
+ exit 0;
+}
+
+sub usage {
+ warn <<EOF;
+Usage: $self [globalopts] [chordopts] <chord> [[chordopts] <chord>] ...
+
+Chords can be either standard notation (e.g. A, Bm, C#maj7), or comma-
+separated fret positions, low to high, (e.g. 3,2,0,0,3,3 is a G in
+standard guitar tuning). Use x to indicate strings not played (e.g.
+x,x,0,2,3,2 is a commonly-used D chord).
+
+Global Options:
+ -t<notes> Set tuning, low string to high. Default is eadgbe. Instrument
+ is assumed to have as many strings as there are notes. Do not
+ specify notes as flats (because the letter b is used for both
+ the b note and the flat symbol). Use e.g. d# instead of eb.
+ -t<type> Set one of the built-in tunings. Use -th or -thelp for list.
+ -x<x> Transpose x semitones (x is positive or negative integer)
+ -D Dump all known chord types
+ -k<key> Set the key for all chords (default is to guess key)
+
+Per-Chord Options: Once set, these stay in effect for subsequent chords.
+
+ -b Print flat note names (e.g. Db instead of C#)
+ -s Print sharp note names (e.g. C# instead of Db) [default]
+ -f<x> Place chord at fret position x (x=0 default, means open strings).
+ (Actually, this is the minimum position: if no useful notes
+ are found at x, we try x+1, x+2, ..., x+12)
+ -s<x> Maximum fret span. Default is 3.
+ -v Find variant chord voicing. Doesn't always do anything useful.
+ (for example, this gives 3,2,0,0,3,3 instead of 3,2,0,0,0,3
+ for an open G chord in standard tuning)
+ -n Find normal voicing (default), turns off previous -v option.
+ -r Force lowest bass note to be root of chord.
+ -i Allow inversions (turns off -r). This is the default.
+ -p Allow partial voicings (e.g. only C and E for a C major chord).
+ Use with caution, especially with 7, 9, etc. chords (the
+ matcher will consider a C major triad to match C7 or C9).
+EOF
+ exit 0;
+
+# future options:
+# -l Loose matching. Accepts chord fingerings with "holes" in
+# the middle (e.g. 65X766 for A#).
+# -o Include open strings even in non-open -f positions.
+# -a Chart all chord voicings found for each chord (default is to
+# stop after first one is found). May be combined with -f, e.g.
+# -f5 -a means "all chord voicings from 5th fret up".
+# -c<x> Capo on fret x.
+# -T Tablature notation instead of chord charts, for -t option.
+# -m[file] Generate MIDI file of chords. With [file], output to file.
+# Without [file], play using timidity.
+# -O<type> Output type: text (default), ps, pdf, html, maybe xml someday.
+# -w<x> Set output width for text output. Default: $COLUMNS from
+# environment, or 80 if not set.
+}
+
+sub has_hole {
+ my @voicing = @_;
+ shift @voicing while not defined $voicing[0];
+ pop @voicing while not defined $voicing[-1];
+ return 1 if @voicing == 0; # whoopsie!
+ for(@voicing) {
+ return 1 if not defined $_;
+ }
+ return 0;
+}
+
+# for each string, go thru the note values for frets $fretpos to
+# $fretpos+$fretspan, looking at each note in @vals.
+# TODO: de-shittify this. It was thrown together between 2 and 5AM,
+# and it looks like it.
+sub find_guitar_chord {
+ my $startfret = shift;
+ my $c = shift;
+ my ($val, $note, $type) = @$c;
+ my $shape = $shapes{$type};
+ my @voicing;
+ my $string;
+ my $fret;
+
+ $note = uc $note;
+ $type =~ s/maj$//; # in output, say A, not Amaj
+
+ my @vals;
+ for(@$shape) {
+ my $n = ($val + $_) % 12;
+ push @vals, $n;
+ }
+ @vals = sort @vals; # for e.g. 9 and add9 chords
+
+ my $chordname = ucfirst($note) . $type;
+
+ push @voicing, undef for @openstrings;
+
+ my %foundvals;
+ my $rootfound = 0;
+ for($string=0; $string<@openstrings; $string++) {
+ my ($start, $end, $step);
+ if($findbackwards) {
+ $start = $startfret + $fretspan;
+ $end = $startfret - 1;
+ $step = -1;
+ } else {
+ $start = $startfret;
+ $end = $startfret + $fretspan + 1;
+ $step = 1;
+ }
+FRET:
+ for($fret = $start; $fret != $end; $fret+=$step) {
+ my $fretval = ($openstrings[$string] + $fret) % 12;
+VAL:
+ for(@vals) {
+#warn "\$string==$string \$fret==$fret \$fretval==$fretval \$_==$_\n";
+ if($_ == $fretval) {
+ if($forceroot && !$rootfound && $_ != $val) {
+ next VAL;
+ }
+ $rootfound = 1 if $_ == $val;
+ $voicing[$string] = $fret;
+ $foundvals{$_}++;
+ last FRET;
+ }
+ }
+ }
+ }
+
+ if(scalar keys %foundvals < @vals) {
+ if($allowpartial) {
+#warn "$note$type: didn't find all note values, return partial chord\n";
+ } else {
+#warn "$note$type: didn't find all note values, return nothing\n";
+ return undef;
+ }
+ }
+
+ if(not $allowholes) {
+ if(has_hole(@voicing)) {
+#warn "$note$type: has a hole\n";
+ return undef;
+ }
+ }
+
+ my $r = render_fingering($val, \@voicing);
+ return $r;
+}
+
+sub render_fingering {
+ my $val = $_[0];
+ my @voicing = @{$_[1]};
+ my ($lowfret, $highfret) = (999, -1);
+ for(@voicing) {
+ next unless defined $_;
+ $lowfret = $_ if $_ < $lowfret;
+ $highfret = $_ if $_ > $highfret;
+ }
+
+ my @grid;
+ my ($intervals, $names);
+ for($string=0; $string<@openstrings; $string++) {
+ my $fret = $voicing[$string];
+ if(not defined($fret)) {
+ $intervals .= " ";
+ $names .= " ";
+ } else {
+ my $noteval = ($openstrings[$string] + $fret) % 12;
+ my $interval = $noteval - $val;
+ $interval += 12 if $interval < 0;
+ $interval %= 12;
+ $intervals .= sprintf("%3s", $intervalnames[$interval]);
+ $names .= sprintf("%3s", ucfirst $$notenames[$noteval]);
+ }
+
+ for($lowfret..$highfret) {
+ my $empty = "|";
+ if($_ == $lowfret && $lowfret == 0) {
+ $empty = "+";
+ }
+
+ $grid[$_ - $lowfret][$string] = $empty;
+ }
+
+ if(defined($fret)) {
+ $grid[$fret-$lowfret][$string] = $fret;
+ } else {
+ $grid[0][$string] = 'X';
+ }
+ }
+
+ my @rendered;
+ for(@grid) {
+ $_->[0] =~ s/^/ / if length($_->[0]) == 1;
+ $_->[0] =~ s/^/ /;
+ for($string=1; $string<@openstrings; $string++) {
+ $_->[$string] =~ s/^/-/ if length($_->[$string]) == 1;
+ $_->[$string] =~ s/^/-/;
+ }
+ push @rendered, join("", @$_);
+ }
+ push @rendered, $names;
+ push @rendered, $intervals;
+ return join("\n", @rendered);
+}
+
+# TODO: make this smarter. Currently it completely ignores accidentals
+# and takes the first match it finds. Also it gives up if it can't get
+# an exact match with a major scale (e.g. if given C and G chords only,
+# it gives up, whereas it really should guess either C or G as the key)
+# Probably need some kind of weighting system.
+sub guess_key {
+ my ($k, $n, $ret, @possibles);
+ for $k (0..11) {
+ my $found = 1;
+ for $n (0, 2, 4, 5, 7, 9, 11) {
+ $found = 0 if not $keynotes[($k + $n) % 12];
+ }
+ if($found) {
+ push @possibles, uc($$notenames[$k]);
+ $ret = $k unless defined $ret;
+ }
+ }
+
+ if(@possibles == 0) {
+ warn "$self: Can't guess key, use -k to set\n";
+ } elsif(@possibles > 1) {
+ warn "$self: Possible keys: " . join(" ", @possibles) .
+ ", guessing " . $possibles[0] . ", use -k to set\n";
+ }
+
+ if($ret) {
+ if(grep { $_ == $ret } @sharpkeys) {
+ $notenames = \@sharpnames;
+ } else {
+ $notenames = \@flatnames;
+ }
+ }
+
+ return $ret;
+}
+
+sub parse_opt {
+ my $opt = shift;
+ $opt =~ s/^-+//;
+
+ if($opt eq 'h') {
+ usage();
+ } elsif($opt eq 'b') {
+ $notenames = \@flatnames;
+ } elsif($opt eq 's') {
+ $notenames = \@sharpnames;
+ } elsif($opt =~ /^x([+-]?\d+)/) {
+ $transpose = $1 + 0;
+ } elsif($opt =~ /^k([a-g][#b]?)(m?)/) {
+ my $keyopt = $1;
+ my $minor = $2;
+ $key = $notevals{lc $keyopt};
+ if(defined($key) and $minor) {
+ $key += 3;
+ $key %= 12;
+ }
+ if(defined($key)) {
+ if(grep { $_ == $key } @sharpkeys) {
+ $notenames = \@sharpnames;
+ } else {
+ $notenames = \@flatnames;
+ }
+ } else {
+ warn "$self: Invalid key '$1', ignoring\n";
+ }
+ } elsif($opt =~ /^f(\d+)/) {
+ $fretpos = $1 + 0;
+ } elsif($opt =~ /^s(\d+)/) {
+ $fretspan = $1 + 0;
+ } elsif($opt =~ /^t(.*)/) {
+ my $offset = 0;
+ my $tuning = $1;
+ if($tuning =~ s/([-+]\d+)$//) {
+ $offset = $1;
+ }
+
+ if($tuning =~ /^h(?:elp)?/i) {
+ tuning_help();
+ } elsif($tunings{$tuning}) {
+ parse_tuning($tunings{$tuning}, $offset);
+ } else {
+ parse_tuning($tuning, $offset);
+ }
+ } elsif($opt eq 'r') {
+ $forceroot = 1;
+ } elsif($opt eq 'i') {
+ $forceroot = 0;
+ } elsif($opt eq 'n') {
+ $findbackwards = 0;
+ } elsif($opt eq 'v') {
+ $findbackwards = 1;
+ } elsif($opt eq 'p') {
+ $allowpartial = 1;
+#} elsif($opt eq 'l') {
+#$allowholes = 0;
+ } elsif($opt eq 'd') {
+ dump_chord_shapes();
+ } else {
+ warn "$self: Invalid option '$_', use -h for help\n";
+ }
+}
+
+# main()
+
+for(@tuning_list) {
+ $tunings{$_->[0]} = $_->[1];
+}
+
+
+for(@ARGV) {
+ if(/^-/) {
+ parse_opt($_);
+ } else {
+ parse_chord($_);
+ }
+}
+
+if((defined $key) && !@chords) {
+# got a -k but no chords, show all triad chords in this key.
+ for(my $i = 0; $i < @majorscale; $i++) {
+ my $note = add_interval($majorscale[$i], $key);
+ my $name = $$notenames[$note];
+ my $type = $major_chord_types[$i];
+ parse_chord($name . $type);
+ }
+}
+
+unless(@chords) {
+ warn "$self: Found no valid chords\n";
+ usage();
+ exit 1;
+}
+
+unless(defined($key)) {
+ $key = guess_key();
+}
+
+for(@chords) {
+ print_chord($_);
+}
+
+if(defined $key) {
+ my $keyname = ucfirst($$notenames[$key]);
+ my $minkey = fix_note($key - 3);
+ my $minkeyname = ucfirst($$notenames[$minkey]);
+ print "Key: " . $keyname . " (" . $minkeyname . "m), " . $keysigs[$key] . "\n";
+ print $keyname . " major scale: ";
+ for(@majorscale) {
+ my $note = ($key + $_) % 12;
+ print ucfirst($$notenames[$note]) . " ";
+ }
+ print "\n";
+ print $minkeyname . " minor scale: ";
+ for(@minorscale) {
+ my $note = ($minkey + $_) % 12;
+ print ucfirst($$notenames[$note]) . " ";
+ }
+ print "\n";
+}
+
+# examples:
+
+# I know how to finger some chords, and need to know what they're called,
+# what notes are in them, and what key (if any) those chords imply:
+# chordspeller.pl 3,2,0,0,3,3 x,0,2,2,2,0 x,x,0,2,3,2
+
+# I know the chords in a song, and need to know the key of the song:
+# chordspeller.pl G A D
+
+# I know the chords in a song, and need to transpose it from G to A
+# (up 2 semitones):
+# chordspeller.pl -x2 G C Am D
+
+# Any of the above can be done in any tuning other than standard guitar
+# tuning by way of a -t<tuning> argument (see the help for the list).
+
+__END__
+---=cut-here=-------
+Gmin (ii)
+10-10--|--|--|-10
+ | | | | | |
+ |--|--|--|-11--|
+ | | | | | |
+ |--|-12-12--+--|
+ | | | | | |
+ |--|--|--|--+--|
+ | | | | | |
+ D G D G Bb D
+ 5 r 5 r b3 5
+
+---=cut-here=-------
+
+Each chord is 20x12 with fretspan 3 and 6 strings (actually they're 19x11
+with 3 columns and one row of padding). This allows a printer page that's
+80x66 chars to have a 4x5 grid of them (20 chords), with some room left
+at the top/bottom for things like the key, scales, etc. Also a 80x24
+xterm can display a 4x2 grid (8 chords).
+
+Formula:
+width = strings*3+1 + 3(padding)
+height = (fretspan+1) * 2 + 1(padding) + 1(title) + 1(notes) + 1(intervals)
+
+Compressed form:
+---=cut-here=-------
+Gmin (ii)
+10-10--|--|--|-10
+ |--|--|--|-11--|
+ |--|-12-12--|--|
+ |--|--|--|--|--|
+ D G D G Bb D
+ 5 r 5 r b3 5
+
+---=cut-here=-------
+height = (fretspan+1) + 1(padding) + 1(title) + 1(notes) + 1(intervals)
+
+6string, span3, you get 20x8, or 4x8 on 80x66 page, or 4x3 on 80x25 xterm.
+
+
+Very compressed form:
+---=cut-here=
+Gmin (ii)
+1010-|-|-|10
+ |-|-|-|11-|
+ |-|1212-|-|
+ |-|-|-|-|-|
+ D G D GBb D
+ 5 r 5 rb3 5
+
+---=cut-here=
+width = strings*2 + 1(padding)
+height = (fretspan+1) + 1(padding) + 1(title) + 1(notes) + 1(intervals)
+
+13x8. Gives 6x8 on paper, 6x3 on xterm, but harder to read... not so bad
+if all frets are single-digit though:
+
+---=cut-here=
+G7 (I)
+ +-+-0-0-0-+
+ |-|-|-|-|-1
+ |-2-|-|-|-|
+ 3-|-|-|-|-|
+ G B D G B G
+ 1 3 5 1 3b7
+
+---=cut-here=
+(notice the + instead of |, in the 0 position)
+
generated by cgit v1.2.3 (git 2.26.2) at 2024-06-28 21:33:13 +0000