Mountain Dulcimer Tab

#!/usr/bin/perl require '/home/rickheit/public_html/dtrad/common.pl'; %arg = &cgi_handle; # we need to figure the key from the tune file $buf = `$gettune $arg{'tt'}`; # look for a key signature if ($buf =~ /\nK-\s*([A-G][b#s]?)/) { $key = $1; $songkey = "This song appears to be in $key."; ($kn = $key) =~ tr/b#/ts/; } print <Mountain Dulcimer Tab

Experimental Mountain Dulcimer Tab

I've been experimenting with some code to produce simple mountain dulcimer tab for songs. This program doesn't do a great deal; it simply arranges the notes in the song across the strings. When it can't place the note on the strings anywhere, it produces an 'X' across all three strings. This program assumes you have a 6 1/2 fret, and notes it as '6*'.

$songkey This program isn't smart enough to determine what mode it's in. Here are some popular modal tunings that should encompass that key (listed melody, middle, bass):

Ionian	Ionian	Ionian	Ionian
Dorian	Dorian	Dorian	Dorian
Phrygian	Phrygian	Phrygian	Phrygian
Lydian	Lydian	Lydian	Lydian
Myxolydian	Myxolydian	Myxolydian	Myxolydian
Aeolian	Aeolian	Aeolian	Aeolian
Locrian	Locrian	Locrian	Locrian

Or just enter your own tuning: This program currently won't transpose the song for you, but you can get a similar effect by telling it your strings are tuned differently.

Contents: ? A B C D E F G H I J K L M N O P Q R S T U V W X Y Z Main Page EOF sub cgi_handle { local(@a); if ($ENV{'REQUEST_METHOD'} eq 'POST') { ($stuff = <>) =~ s/^\s*|\s*$//g; } else { $stuff = $ENV{'QUERY_STRING'}; } @a = split(/[\&\=]/, $stuff); for (@a) { s/\+/ /g; s/%(..)/sprintf("%c", hex($1))/eg; } return @a; } # Turns HTML-illegal characters into their cute little ol' coding. sub fixch { $_[0] =~ s/\W/'%'.sprintf('%02X', ord($&))/eg; } # Given a starting note (in the form [A-Ga-g][ts]*, t = flat s = sharp) # and an interval ( \d+[Mm+-]? ), returns the new note sub interval { local($start, $interval) = @_; # turn note into number ($snum, $slet) = ¬enum($start); # turn interval into letters, steps $ilet = $interval; $ilet -= 1; $ilet += 7 while $ilet < 0; $ilet %= 7; # don't trust negative modulo # the major or perfect intervals $inum = (0, 2, 4, 5, 7, 9, 11)[$ilet]; # minor: one step lower $inum-- if $interval =~ /[^iI]m/; # augmented: one step higher $inum++ if $interval =~ /\+|aug/i; # diminished: perfect intervals drop one; others 2 if ($interval =~ /\-|dim/i) { $inum-- unless $ilet == 0 || $ilet == 3 || $ilet == 4; $inum--; } $inum += 12 while $inum < 0; $inum %= 12; # don't trust negative modulo # figure new letter $nlet = ($slet+$ilet)%7; # safe to modulo, never negative $nnum = ($snum+$inum)%12; # add sharps or flats to letter as needed $nlet = chr($nlet + ord('A')); return $nlet if $nnum == ¬enum($nlet); return $nlet.'s' if $nnum == ¬enum($nlet.'s'); return $nlet.'t' if $nnum == ¬enum($nlet.'t'); return $nlet.'ss' if $nnum == ¬enum($nlet.'ss'); return $nlet.'tt' if $nnum == ¬enum($nlet.'tt'); return $nlet.'sss' if $nnum == ¬enum($nlet.'sss'); return $nlet.'ttt' if $nnum == ¬enum($nlet.'ttt'); } sub notenum { local($note) = @_; # turn note into number $note = lc($note); $slet = ord($note) - ord('a'); $slet += 7 while $slet < 0; $slet %= 7; # don't trust negative modulo $snum = (0, 2, 3, 5, 7, 8, 10)[$slet]; # add sharps and flats $snum -= ($note =~ tr/t//); $snum += ($note =~ tr/s//); $snum += 12 while $snum < 0; $snum %= 12; # don't trust negative modulo return wantarray? ($snum, $slet): $snum; }

Melody:	Middle:	Bass: