[Jos Decoster] Tchords is a script to find scales and chords on a guitar or bass. It looks like this:

[tchords screenshot]

The script can be found below.

If you play piano or keyboard, try [KeyboardChords].

----
[AMG]: This is brilliant, thanks!!
----
======
## (This license blatantly stolen from Tktable and Tcl/Tk license and adapted -
## thus assume it falls under similar license terms).
##
## This software is copyrighted by Jos Decoster <jos _dot_ decoster _at_ gmail 
## _dot_ com>.  The  following terms apply to all files associated with the 
## software unless explicitly disclaimed in individual files.
##
## The authors hereby grant permission to use, copy, modify, distribute, and
## license this software and its documentation for any purpose, provided that
## existing copyright notices are retained in all copies and that this notice
## is included verbatim in any distributions.  No written agreement, license,
## or royalty fee is required for any of the authorized uses.
##
## IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
## DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
## OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF,
## EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
##
## THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
## INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
## FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE IS
## PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO
## OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
## MODIFICATIONS.
##
## RESTRICTED RIGHTS: Use, duplication or disclosure by the U.S. government
## is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
## of the Rights in Technical Data and Computer Software Clause as DFARS
## 252.227-7013 and FAR 52.227-19.

namespace eval ::Chords {

    variable all_notes
    variable scales
    variable chords
    variable chords_abbrev
    variable tunings
    variable mididev 

    variable fret_dist 30
    variable string_dist 30
    variable note_rad 10
    variable note_font {arial 12 bold}

    #                          0   1    2   3   4    5   6    7   8   9   10   11  
    set all_notes_sharp [list "A" "A#" "B" "C" "C#" "D" "D#" "E" "F" "F#" "G" "G#"]
    set all_notes_flat  [list "A" "Bb" "B" "C" "Db" "D" "Eb" "E" "F" "Gb" "G" "Ab"]
    set all_notes       $all_notes_sharp
    set note_colors [list "red" "magenta" "green" "blue" "plum1" "purple" "goldenrod" "orange" "beige" "gray70" "cyan" "white"]

    # Scales based on 'First Scales Dictionary' by gottardelli@cesi.it (STEFANO GOTTARDELLI) as found on www.olga.net and
    # 'more exotic scales and modes' by talamasc@athenet.net (Andy Perades) also found on www.olga.net

    set scales(all,chromatic)              [list 0 1 2 3 4 5 6 7 8 9 10 11]
    set scales(key)                        [list 0]
    set scales(major)                      [list 0 2 4 5 7 9 11]
    set scales(ionian,major)               [list 0 2 4 5 7 9 11]
    set scales(dorian)                     [list 0 2 3 5 7 9 10]
    set scales(phrygian,kurd,arabic)       [list 0 1 3 5 7 8 10]
    set scales(lydian)                     [list 0 2 4 6 7 9 11]
    set scales(mixolydian)                 [list 0 2 4 5 7 9 10]
    set scales(aeolian,natural_minor,ancient_minor) [list 0 2 3 5 7 8 10]
    set scales(locrian)                    [list 0 1 3 5 6 8 10]
    set scales(melodic_minor,jazz_minor)   [list 0 2 3 5 7 9 11]
    set scales(javanese)                   [list 0 1 3 5 7 9 10]
    set scales(lydian_augmented)           [list 0 2 4 6 8 9 10]
    set scales(lydian_dominant,overtone)   [list 0 2 4 6 7 9 10]
    set scales(hindu)                      [list 0 2 4 5 7 8 10]
    set scales(locrian_natural)            [list 0 2 3 5 6 8 10]
    set scales(super_locrian,ravel)        [list 0 1 3 4 6 8 10]
    set scales(harmonic_minor,mohammedan)  [list 0 2 3 5 7 8 11]
    set scales(harmonic_major)             [list 0 2 4 5 8 9 11]
    set scales(romanian)                   [list 0 2 3 6 7 9 10]
    set scales(phrygian_dominant,phrygian_major,balkan,jewish,spanish_gypsy) [list 0 1 4 5 7 8 10]
    set scales(lydian_sharp)               [list 0 3 4 6 7 9 11]
    set scales(ultra_locrian)              [list 0 1 3 4 6 8 9]
    set scales(double_harmonic_minor,byzantine,gypsy,east_indian_raga) [list 0 1 4 5 7 8 11]
    set scales(hungarian_minor,algerian)   [list 0 2 3 6 7 8 11]
    set scales(oriental)                   [list 0 1 4 5 6 9 10]
    set scales(pentatonic_minor)           [list 0 3 5 7 10]
    set scales(pentatonic_major,mongolian) [list 0 2 4 7 9]
    set scales(pentatonic_egyptian)        [list 0 2 5 7 10]
    set scales(pentatonic_ritusen)         [list 0 2 5 7 9]
    set scales(pentatonic_japanese)        [list 0 1 5 7 8]
    set scales(pentatonic_chinese)         [list 0 2 4 5 11]
    set scales(pentatonic_indian)          [list 0 4 5 7 10]
    set scales(prometheus)                 [list 0 2 4 6 9 10]
    set scales(prometheus_neapolitam)      [list 0 1 4 6 7 10]
    set scales(whole_tone)                 [list 0 2 4 6 8 10]
    set scales(diminished)                 [list 0 2 3 5 6 8 9 11]
    set scales(diminished_inverted)        [list 0 1 3 4 6 7 9 10]
    set scales(augmented)                  [list 0 3 4 7 8 11]
    set scales(blues_major)                [list 0 2 3 4 7 9]
    set scales(blues_minor)                [list 0 3 5 6 7 10]
    set scales(blues_altered)              [list 0 2 3 4 5 6 7 9 10]

    # Chords based on long_chord_dbase.txt from voith@soccer.sps.mot.com (Ray
    # Voith) found on www.olga.net.

    set chords(major)                       [list 0 4 7]
    set chords(minor)                       [list 0 3 7]
    set chords(seventh)                     [list 0 4 7 10]
    set chords(minor_seventh)               [list 0 3 7 10]
    set chords(major_seventh)               [list 0 4 7 11]
    set chords(sixth)                       [list 0 4 7 9]
    set chords(minor_sixth)                 [list 0 3 7 9]
    set chords(augmented)                   [list 0 4 8]
    set chords(augmented_seventh)           [list 0 4 8 10]
    set chords(diminished)                  [list 0 3 6]
    set chords(diminished_seventh)          [list 0 3 6 9]
    set chords(seventh_flatted_fifth)       [list 0 4 6 10]
    set chords(minor_seventh_flatted_fifth) [list 0 3 6 10]
    set chords(ninth)                       [list 0 4 7 10 2]
    set chords(minor_ninth)                 [list 0 3 7 10 2]
    set chords(major_ninth)                 [list 0 4 7 11 2]
    set chords(eleventh)                    [list 0 4 7 10 2 5]
    set chords(diminished_ninth)            [list 0 4 7 10 1]
    set chords(added_ninth)                 [list 0 4 7 2]
    set chords(added_fourth)                [list 0 4 7 5]
    set chords(suspended)                   [list 0 5 7]
    set chords(suspended_ninth)             [list 0 2 7]
    set chords(seventh_suspended_fourth)    [list 0 5 7 10]
    set chords(seventh_suspended_ninth)     [list 0 2 7 10]
    set chords(fifth)                       [list 0 7]

    set chords_abbrev(major)                        [list ""]
    set chords_abbrev(minor)                        "m"
    set chords_abbrev(seventh)                      "7"
    set chords_abbrev(minor_seventh)                "m7"
    set chords_abbrev(major_seventh)                [list "maj7" "M7"]
    set chords_abbrev(sixth)                        "6"
    set chords_abbrev(minor_sixth)                  "m6"
    set chords_abbrev(augmented)                    "+"
    set chords_abbrev(augmented_seventh)            "7+"
    set chords_abbrev(diminished)                   "dim"
    set chords_abbrev(diminished_seventh)           [list "dim7" "o"]
    set chords_abbrev(seventh_flatted_fifth)        "7(5b)"
    set chords_abbrev(minor_seventh_flatted_fifth)  "m7(5b)"
    set chords_abbrev(ninth)                        "9"          
    set chords_abbrev(minor_ninth)                  "m9"          
    set chords_abbrev(major_ninth)                  [list "maj9" "M9"]
    set chords_abbrev(eleventh)                     "11" 
    set chords_abbrev(diminished_ninth)             "dim9"
    set chords_abbrev(added_ninth)                  [list "(9)" "(2)"]
    set chords_abbrev(added_fourth)                 [list "(4)" "(11)"]
    set chords_abbrev(suspended)                    [list "sus" "sus4"]
    set chords_abbrev(suspended_ninth)              [list "sus9" "sus2"]
    set chords_abbrev(seventh_suspended_fourth)     [list "7sus" "7sus4"]
    set chords_abbrev(seventh_suspended_ninth)      [list "7sus2" "7sus9"]
    set chords_abbrev(fifth)                        [list "5" "(no 3rd)"]  

    set tunings(standard)              [list E A D G B  E]
    set tunings(standard_bass)         [list E A D G]
    set tunings(standard_5string_bass) [list B E A D G]
    set tunings(open_G)                [list D G D G B D]
    set tunings(open_E)                [list E B E G# B E]
    set tunings(open_D)                [list D A D F# A D]
    set tunings(open_C)                [list C G C G C E]
    set tunings(broken_D)              [list D A D G B E]
    
}

proc ::Chords::get_notes { start positions } {

    variable all_notes

    set notes {}
    foreach lpos $positions {
        set pos [expr {($start + $lpos) % 12}]
        lappend notes [lindex $all_notes $pos]
    }

    return $notes
}

proc ::Chords::scale { key type } {

    variable all_notes
    variable scales

    set start [lsearch $all_notes $key]

    if { $start < 0 } {
        return -code error "Chords ERROR: unknown key '$key'"
    }

    if { ![info exists scales($type)] } {
        return -code error "Chords ERROR: unknown scale-type '$type'"
    }

    return [::Chords::get_notes $start $scales($type)]
}

proc ::Chords::chord { key type } {

    variable all_notes
    variable chords

    set start [lsearch $all_notes $key]

    if { $start < 0 } {
        return -code error "Chords ERROR: unknown key '$key'"
    }

    if { ![info exists chords($type)] } {
        return -code error "Chords ERROR: unknown scale-type '$type'"
    }

    return [::Chords::get_notes $start $chords($type)]
}

proc ::Chords::notes_to_string { base notes {frets 20} } {

    variable all_notes

    set pos [lsearch $all_notes $base]

    if { $pos < 0 } {
        return -code error "Chords ERROR: unknown base '$base'"
    }

    set string {}

    for { set i 0 } { $i <= $frets } { incr i } { 
        set note [lindex $all_notes $pos]
        if { [lsearch $notes $note] >= 0 } {
            lappend string $note
        } else {
            lappend string {}
        }

        set pos [expr {($pos + 1) % 12}] 
    }

    return $string
}

proc ::Chords::draw_guitar { cvs strings frets x y hstart vstart } {

    variable fret_dist
    variable string_dist 
    variable note_font

    set nw [expr {$frets*$fret_dist + $fret_dist}]
    set nh [expr {[llength $strings]*$string_dist}]
    set ny0 $y
    set ny1 [expr {$ny0 + $nh}]

    switch -exact -- $hstart {
        l {
            set nx0 $x
            set nx1 [expr {$x + $nw}]
            set fret_incr $fret_dist
        }
        r {
            set nx0 [expr {$x + $nw}]
            set nx1 $x
            set fret_incr -$fret_dist
        }
        default {
            return -code error "Chords ERROR: unknown hstart '$hstart'"
        }
    }

    # Neck
    $cvs create rect $nx0 $ny0 $nx1 $ny1 -fill black -outline black -tags guitar

    # Frets
    set fx0 [expr {$nx0 + $fret_incr}]
    $cvs create line $fx0 $ny0 $fx0 $ny1 -width 8 -fill gray90 -tags guitar
    incr fx0 $fret_incr

    for { set i 0 } { $i < $frets } { incr i } {
        $cvs create line $fx0 $ny0 $fx0 $ny1 -width 2 -fill gray80 -tags guitar
        incr fx0 $fret_incr
    }

    # Fret numbers
    set tx0 [expr {$nx0 + $fret_incr}]
    set ty0 [expr {$ny1 + $string_dist / 2}]
    for { set i 0 } { $i <= $frets } { incr i } {
        $cvs create text $tx0 $ty0 -text $i -tags guitar -font $note_font
        incr tx0 $fret_incr
    }

    return
}

proc ::Chords::draw_string { cvs nr string strings frets hstart vstart x y } {

    variable fret_dist
    variable string_dist 
    variable note_rad
    variable note_font
    variable all_notes
    variable note_colors

    set nh  [expr {[llength $strings]*$string_dist}]
    set nw [expr {$frets*$fret_dist + $fret_dist}]

    switch -exact -- $vstart {
        t {
            set ny0 $y
            set ny1 [expr {$y + $nh}]
            set sy0 [expr {$ny0 + $string_dist / 2 + ([llength $strings] - $nr) * $string_dist}]
            
        }
        b {
            set ny0 $y
            set ny1 [expr {$y + $nh}]
            set sy0 [expr {$ny1 - $string_dist / 2 - ([llength $strings] - $nr) * $string_dist}]
        }
        default {
            return -code error "Chords ERROR: unknown vstart '$vstart'"
        }
    }

    switch -exact -- $hstart {
        l {
            set nx0 $x
            set nx1 [expr {$x + $nw}]
            set fret_incr $fret_dist
        }
        r {
            set nx0 [expr {$x + $nw}]
            set nx1 $x
            set fret_incr -$fret_dist
        }
        default {
            return -code error "Chords ERROR: unknown hstart '$hstart'"
        }
    }

    $cvs create line $nx0 $sy0 $nx1 $sy0 -width $nr -fill gray90 -tags guitar

    switch -exact -- $hstart {
        l {
            set nx0 [expr {$x + $fret_dist / 2 - $note_rad}]
            set nx1 [expr {$x + $fret_dist / 2 + $note_rad}]
            set tx0 [expr {$x + $fret_dist / 2}]
        }
        r {
            set nx0 [expr {$x + $nw - $fret_dist / 2 + $note_rad}]
            set nx1 [expr {$x + $nw - $fret_dist / 2 - $note_rad}]
            set tx0 [expr {$x + $nw - $fret_dist / 2}]
        }
        default {
            return -code error "Chords ERROR: unknown hstart '$hstart'"
        }
    }

    set ny0 [expr {$sy0 - $note_rad}]
    set ny1 [expr {$sy0 + $note_rad}]

    foreach note $string {

        if { [string length $note] } {
            set clr [lindex $note_colors [lsearch $all_notes $note]]
            $cvs create oval $nx0 $ny0 $nx1 $ny1 -fill $clr -tags guitar
            $cvs create text $tx0 $sy0 -text $note -anchor c -tags guitar -font $note_font
        }        

        incr nx0 $fret_incr
        incr nx1 $fret_incr
        incr tx0 $fret_incr
    }

    return
}

proc ::Chords::draw_on_guitar { cvs notes {strings {E A D G B E}} {frets 20} {hstart l} {vstart t} {x 0} {y 0} } {

    ::Chords::draw_guitar $cvs $strings $frets $x $y $hstart $vstart

    set i [llength $strings]
    foreach string $strings {
        set nl [::Chords::notes_to_string $string $notes $frets]
        ::Chords::draw_string $cvs $i $nl $strings $frets $hstart $vstart $x $y
        incr i -1
    }

    return
}

proc ::Chords::refresh_guitar_chord_selector { path {n1 ""} {n2 ""} {op ""} } {

    variable fret_dist
    variable string_dist
    variable all_notes
    variable all_notes_sharp
    variable all_notes_flat
    variable note_colors
    variable tunings

    variable chords_abbrev

    variable selected_canvas
    variable selected_key
    variable selected_cl
    variable selected_type
    variable selected_strings
    variable selected_frets
    variable ldisplayed_cl
    variable displayed_cl
    variable selected_nlf
    variable selected_tb
    variable selected_lr
    variable selected_shfl
    variable keypathlist

    # Delete old guitar drawing

    $selected_canvas($path) delete guitar

    $selected_canvas($path) configure -width [expr {$selected_frets($path) * $fret_dist + $fret_dist + 2*$string_dist}] -height [expr {[llength $tunings($selected_strings($path))] * $string_dist + 2*$string_dist }]

    # Set sharp / flat and adjust selected key

    set kidx [lsearch $all_notes $selected_key($path)]

    switch -exact -- $selected_shfl($path) {
        flat    { set all_notes $all_notes_flat  }
        sharp -
        default { set all_notes $all_notes_sharp }
    }

    set selected_key($path) [lindex $all_notes $kidx]

    foreach p $keypathlist($path) l $all_notes {
        $p configure -text $l -value $l
    }

    # Set chord / scale

    switch -exact -- $selected_cl($path) {
        chord { 
            set stp [string first "," $selected_type($path)]
            if { $stp >= 0 } {
                set st [string range $selected_type($path) 0 [expr {$stp - 1}]]
            } else {
                set st $selected_type($path)
            }
            set notes [::Chords::chord $selected_key($path) $st] 
            set ldisplayed_cl($path) "Displayed chord"
            set dc "$selected_key($path) $st"
            foreach abb $chords_abbrev($st) {
                append dc ", $selected_key($path)$abb"
            }
            set displayed_cl($path) $dc
        }
        scale { 
            set notes [::Chords::scale $selected_key($path) $selected_type($path)] 
            set ldisplayed_cl($path) "Displayed scale"
            set displayed_cl($path) [format "%s %s" $selected_key($path) $selected_type($path)]
        }
        default { set notes {} }
    }

    # Set bass string position

    switch -exact -- $selected_tb($path) {
        top     { set tb t }
        bottom  { set tb b }
        default { set tb t }
    }

    # Set head position

    switch -exact -- $selected_lr($path) {
        left    { set lr l }
        right   { set lr r }
        default { set lr l }
    }

    # Show notes below guitar drawing

    set nlf $selected_nlf($path)

    set sl [grid slaves $nlf]
    foreach s $sl {
        ::destroy $s
    }

    set i 0
    foreach note $notes {
        if { [string length $note] } {
            set clr [lindex $note_colors [lsearch $all_notes $note]]
            label $nlf.nl$i -text $note -bg $clr -width 3
            grid $nlf.nl$i -row 0 -column $i
            incr i
        }
    }

    # Draw guitar

    ::Chords::draw_on_guitar $selected_canvas($path) $notes $tunings($selected_strings($path)) $selected_frets($path) $lr $tb $string_dist $string_dist

    return
}

proc ::Chords::refresh_guitar_chord_scale_selector { path {n1 ""} {n2 ""} {op ""} } {

    variable scales
    variable chords
    variable chords_abbrev

    variable selected_btf
    variable selected_cl
    variable previous_cl
    variable selected_type
    variable typelistbox

    if { [string compare $previous_cl($path) $selected_cl($path)] } {

        switch -exact -- $selected_cl($path) { 
            chord   { 
                set itypes [lsort [array names chords]] 
                set types {}
                foreach type $itypes {
                    set dc $type
                    foreach abb $chords_abbrev($type) {
                        if { [string length $abb] } {
                            append dc ", $abb"
                        }
                    }
                    lappend types $dc
                }
            }
            scale  { set types [lsort [array names scales]] } 
            default { set types None }
        }

        set previous_cl($path) $selected_cl($path)
    
        set lb $typelistbox($path)
        $lb delete 0 end
        eval $lb insert end $types

        $lb selection set [lsearch $types major]
        set selected_type($path) major
    }
    
    ::Chords::refresh_guitar_chord_selector $path

    return 
}

proc ::Chords::start_guitar_chord_selector { path {strings standard} {frets 20} {key C} {type major} {cl scale} {bass top} {head left} {shfl sharp} } {

    variable all_notes
    variable scales
    variable chords
    variable tunings
    
    variable fret_dist
    variable string_dist 

    variable selected_canvas
    variable selected_btf
    variable selected_nlf
    variable selected_key
    variable selected_type
    variable selected_strings
    variable selected_frets
    variable selected_cl
    variable selected_tb
    variable selected_lr
    variable selected_shfl
    variable previous_cl
    variable ldisplayed_cl
    variable displayed_cl
    variable typelistbox
    variable keypathlist

    set selected_key($path) $key
    set selected_type($path) $type
    set selected_cl($path) $cl
    set previous_cl($path) None
    set selected_strings($path) $strings
    set selected_frets($path) $frets
    set selected_tb($path) $bass
    set selected_lr($path) $head
    set selected_shfl($path) $shfl
    
    set bf [frame $path -bd 0 -relief flat]
    
    # Canvas
    set cf [frame $bf.cf -bd 5 -relief flat]
    pack $cf -fill both -expand true

    set cvs [canvas $cf.cvs -bd 0 -bg gray95 -width [expr {$frets * $fret_dist + $fret_dist}] -height [expr {[llength $strings] * $string_dist}]]
    pack $cvs -fill both -expand true

    set selected_canvas($path) $cvs

    # Notes list and scale or chord name
    set nlnf [frame $bf.nlnf -bd 5 -relief flat]
    pack $nlnf -fill x

    set nlf [frame $nlnf.nlf -bd 5 -relief flat]
    pack $nlf -fill x

    set selected_nlf($path) $nlf

    label $nlnf.disp -textvariable ::Chords::displayed_cl($path) -width 50
    pack $nlnf.disp

#    entry $nlnf.mdisp -state disabled -textvariable ::Chords::midinotes($path) -width 50
#    pack $nlnf.mdisp

    # Select buttons
    set btf [frame $bf.btf -bd 5 -relief flat]
    pack $btf -fill x

    set selected_btf($path) $btf

    # chord or scale and sharp or flat
    set scsff [frame $btf.scsff -bd 0]
    grid $scsff -row 0 -column 1 -sticky ewns

    ## chord or scale
    set scf [frame $scsff.scf -bd 2 -relief ridge]
    pack $scf -side top -fill both -expand true

    set whlbl [label $scf.whlbl -text "What" -relief raised]
    pack $whlbl -side top -fill x

    set cbs [radiobutton $scf.cbs -text Scales -variable ::Chords::selected_cl($path) -value scale -anchor w]
    set cbc [radiobutton $scf.cbc -text Chords -variable ::Chords::selected_cl($path) -value chord -anchor w]
    pack $cbs -side top -fill x
    pack $cbc -side top -fill x

    ## sharp or flat
    set sff [frame $scsff.sff -bd 2 -relief ridge]
    pack $sff -side top -fill both -expand true

    set sflbl [label $sff.sflbl -text "How" -relief raised]
    pack $sflbl -side top -fill x

    set cbsh [radiobutton $sff.cbsh -text Sharp -variable ::Chords::selected_shfl($path) -value sharp -anchor w]
    set cbfl [radiobutton $sff.cbfl -text Flat  -variable ::Chords::selected_shfl($path) -value flat  -anchor w]
    pack $cbsh -side top -fill x
    pack $cbfl -side top -fill x

    # key
    set kyf [frame $btf.keyf -bd 2 -relief ridge]
    grid $kyf -row 0 -column 2 -sticky ewns

    set kyf1 [frame $kyf.keyf1 -bd 0]
    pack $kyf1 -side top -fill x

    set kylbl [label $kyf1.kylbl -text "Key" -relief raised]
    pack $kylbl -side top -fill x

    set kyf2 [frame $kyf.keyf2 -bd 0]
    pack $kyf2 -fill both -expand true -side top

    set ka  [radiobutton $kyf2.ka  -text A   -variable ::Chords::selected_key($path) -value A   -anchor w]
    set kak [radiobutton $kyf2.kak -text A\# -variable ::Chords::selected_key($path) -value A\# -anchor w]
    set kb  [radiobutton $kyf2.kb  -text B   -variable ::Chords::selected_key($path) -value B   -anchor w]
    set kc  [radiobutton $kyf2.kc  -text C   -variable ::Chords::selected_key($path) -value C   -anchor w]
    set kck [radiobutton $kyf2.kck -text C\# -variable ::Chords::selected_key($path) -value C\# -anchor w]
    set kd  [radiobutton $kyf2.kd  -text D   -variable ::Chords::selected_key($path) -value D   -anchor w]
    set kdk [radiobutton $kyf2.kdk -text D\# -variable ::Chords::selected_key($path) -value D\# -anchor w]
    set ke  [radiobutton $kyf2.ke  -text E   -variable ::Chords::selected_key($path) -value E   -anchor w]
    set kf  [radiobutton $kyf2.kf  -text F   -variable ::Chords::selected_key($path) -value F   -anchor w]
    set kfk [radiobutton $kyf2.kfk -text F\# -variable ::Chords::selected_key($path) -value F\# -anchor w]
    set kg  [radiobutton $kyf2.kg  -text G   -variable ::Chords::selected_key($path) -value G   -anchor w]
    set kgk [radiobutton $kyf2.kgk -text G\# -variable ::Chords::selected_key($path) -value G\# -anchor w]
    set kl  [label       $kyf2.l]

    grid $ka  -row  0 -column 0 -rowspan 2 -sticky w
    grid $kak -row  1 -column 1 -rowspan 2 -sticky w
    grid $kb  -row  2 -column 0 -rowspan 2 -sticky w
    grid $kc  -row  4 -column 0 -rowspan 2 -sticky w 
    grid $kck -row  5 -column 1 -rowspan 2 -sticky w
    grid $kd  -row  6 -column 0 -rowspan 2 -sticky w
    grid $kdk -row  7 -column 1 -rowspan 2 -sticky w
    grid $ke  -row  8 -column 0 -rowspan 2 -sticky w
    grid $kf  -row 10 -column 0 -rowspan 2 -sticky w
    grid $kfk -row 11 -column 1 -rowspan 2 -sticky w
    grid $kg  -row 12 -column 0 -rowspan 2 -sticky w
    grid $kgk -row 13 -column 1 -rowspan 2 -sticky w
    grid $kl  -row 14 -column 0 

    set keypathlist($path) [list $ka $kak $kb $kc $kck $kd $kdk $ke $kf $kfk $kg $kgk]

    # which chord or scale to display
    set typebf [frame $btf.typebf -bd 2 -relief ridge]
    grid $typebf -row 0 -column 3 -sticky ewns

    set typebfl [label $typebf.lbl -text "Type" -bd 2 -relief raised]
    pack $typebfl -side top -fill x

    set typef [frame $typebf.typef -bd 0]
    pack $typef -fill both -expand true

    set typelistbox($path) [listbox $typef.lb -xscrollcommand "$typef.scx set" -yscrollcommand "$typef.scy set" -selectmode single -width 35]
    scrollbar $typef.scx -command "$typef.lb xview" -width 11 -orient horizontal
    scrollbar $typef.scy -command "$typef.lb yview" -width 11

    grid $typef.lb  -row 0 -column 0 -sticky ewns
    grid $typef.scx -row 1 -column 0 -sticky ew
    grid $typef.scy -row 0 -column 1 -sticky ns
    grid rowconfigure $typef 0 -weight 1
    grid rowconfigure $typef 1 -weight 0
    grid columnconfigure $typef 0 -weight 1
    grid columnconfigure $typef 1 -weight 0

    bind $typef.lb <ButtonRelease-1> "::Chords::set_selected_type $path"

    # Tunings
    set strgf [frame $btf.strgf -bd 2 -relief ridge]
    grid $strgf -row 0 -column 4 -sticky ewns

    set strglbl [label $strgf.strglbl -text "Tuning" -relief raised]
    pack $strglbl -side top -fill x

    set cnt 1
    foreach strgc [lsort -dictionary [array names tunings]] {
        set rb [radiobutton $strgf.strg$strgc -text $strgc -variable ::Chords::selected_strings($path) -value $strgc -anchor w]
        pack $rb -side top -fill x
        incr cnt
    }

    # number of frets
    set nff [frame $btf.nff -bd 2 -relief ridge]
    grid $nff -row 0 -column 6 -sticky ewns

    set nflbl [label $nff.nflbl -text "Frets" -relief raised]
    pack $nflbl -side top -fill x

    set cnt 0
    foreach nfc {12 16 20 24 28} {
        set rb [radiobutton $nff.nf$nfc -text $nfc -variable ::Chords::selected_frets($path) -value $nfc -anchor w]
        pack $rb -side top -fill x
        incr cnt
    }

    # position of bass string and head
    set tblrf [frame $btf.tblrf -bd 0]
    grid $tblrf -row 0 -column 7 -sticky ewns

    ## position of bass string
    set tbf [frame $tblrf.tbf -bd 2 -relief ridge]
    pack $tbf -side top -expand true -fill both

    set tblbl [label $tbf.tblbl -text "Bass string" -relief raised]
    pack $tblbl -side top -fill x

    set cnt 1
    foreach tbc {top bottom} {
        set rb [radiobutton $tbf.tb$tbc -text $tbc -variable ::Chords::selected_tb($path) -value $tbc -anchor w]
        pack $rb -side top -fill x
        incr cnt
    }

    ## position of head
    set lrf [frame $tblrf.lrf -bd 2 -relief ridge]
    pack $lrf -side top -expand true -fill both

    set lrlbl [label $lrf.lrlbl -text "Head" -relief raised]
    pack $lrlbl -side top -fill x

    set cnt 1
    foreach lrc {left right} {
        set rb [radiobutton $lrf.lr$lrc -text $lrc -variable ::Chords::selected_lr($path) -value $lrc -anchor w]
        pack $rb -side top -fill x
        incr cnt
    }

    ::Chords::refresh_guitar_chord_scale_selector $path

    trace add variable ::Chords::selected_key($path)     write [list ::Chords::refresh_guitar_chord_selector $path]
    trace add variable ::Chords::selected_cl($path)      write [list ::Chords::refresh_guitar_chord_scale_selector $path]
    trace add variable ::Chords::selected_type($path)    write [list ::Chords::refresh_guitar_chord_selector $path]
    trace add variable ::Chords::selected_strings($path) write [list ::Chords::refresh_guitar_chord_selector $path]
    trace add variable ::Chords::selected_frets($path)   write [list ::Chords::refresh_guitar_chord_selector $path]
    trace add variable ::Chords::selected_tb($path)      write [list ::Chords::refresh_guitar_chord_selector $path]
    trace add variable ::Chords::selected_lr($path)      write [list ::Chords::refresh_guitar_chord_selector $path]
    trace add variable ::Chords::selected_shfl($path)    write [list ::Chords::refresh_guitar_chord_selector $path]

    return $bf
}

proc ::Chords::set_selected_type { path } {

    variable typelistbox
    variable selected_type

    set lb $typelistbox($path)

    set sl [$lb curselection]

    if { [llength $sl] == 0 } { 
        return
    }

    set s [lindex $sl 0]

    set selected_type($path) [$lb get $s]

    puts "selected_type($path) = $selected_type($path)"
}

proc ::Chords::close_guitar_chord_selector { path } {

    variable selected_canvas
    variable selected_btf
    variable selected_nlf
    variable selected_key
    variable selected_type
    variable selected_strings
    variable selected_frets
    variable selected_cl
    variable selected_tb
    variable selected_lr
    variable selected_shfl
    variable previous_cl
    variable ldisplayed_cl
    variable displayed_cl
    variable typelistbox
    variable keypathlist

    unset selected_canvas($path)
    unset selected_btf($path)
    unset selected_nlf($path)
    unset selected_key($path)
    unset selected_type($path)
    unset selected_strings($path)
    unset selected_frets($path)
    unset selected_cl($path)
    unset selected_tb($path)
    unset selected_lr($path)
    unset selected_shfl($path)
    unset previous_cl($path)
    unset ldisplayed_cl($path)
    unset displayed_cl($path)
    unset typelistbox($path)
    unset keypathlist($path)
    
    destroy $path

    return
} 

::Chords::start_guitar_chord_selector .s
pack .s -fill both -expand true
======

----
!!!!!!
%|[Category Application]|[Category Music]|%
!!!!!!