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 variable ::Chords::selected_key($path) w [list ::Chords::refresh_guitar_chord_selector $path]
trace variable ::Chords::selected_cl($path) w [list ::Chords::refresh_guitar_chord_scale_selector $path]
trace variable ::Chords::selected_type($path) w [list ::Chords::refresh_guitar_chord_selector $path]
trace variable ::Chords::selected_strings($path) w [list ::Chords::refresh_guitar_chord_selector $path]
trace variable ::Chords::selected_frets($path) w [list ::Chords::refresh_guitar_chord_selector $path]
trace variable ::Chords::selected_tb($path) w [list ::Chords::refresh_guitar_chord_selector $path]
trace variable ::Chords::selected_lr($path) w [list ::Chords::refresh_guitar_chord_selector $path]
trace variable ::Chords::selected_shfl($path) w [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