2007-09-04 - [FF] - A simple application the will show you keyboard chords, in every key, every chord!! -- yeah, you'll add those missing! ;) (by editing '''proc makechord''')

Notes:
   * Uses [spinbox menubutton]

[http://www.freemove.it/images/KeyboardChords.png]

----
 package require Tk 8.4

 source spin_mb.tcl

 catch {toplevel .}
 canvas .c -width 500 -height 80
 spin_mb .root -cycle -variable ::root -values {C C# D D# E F F# G G# A A# B}
 spin_mb .mode -cycle -variable ::mode -values {maj min 7 maj7 dim aug sus4}

 grid .c -row 0 -column 0 -columnspan 13
 grid .root -row 1 -column 0
 grid .mode -row 1 -column 1
 grid columnconfigure . 12 -weight 1

 proc create7keys {cnv x y xsize ysize oct action} {
	set x1 $x ; set y2 [expr $y+$ysize] ; set sz [expr $xsize/7] ; set x2 [expr $x+$sz]
	set n [expr $oct*12]
	foreach K {C D E F G A B} {
		$cnv create rectangle $x1 $y $x2 $y2 -tags [list k wk ${K}-${oct} n$n]
		$cnv bind ${K}-${oct} <ButtonPress-1> [list $action $cnv ${K}-${oct}]
		set x1 [expr $x1+$sz] ; set x2 [expr $x2+$sz]
		if {$K == "E"} {incr n 1} {incr n 2}
	}
	set y2 [expr $y+$ysize*0.6] ; set sz [expr $xsize/12] ; set x1 [expr $x] ; set x2 [expr $x1+$sz]
	set n [expr $oct*12+1]
	foreach K {C# D# nul F# G# A#} {
		set x1 [expr $x1+$sz] ; set x2 [expr $x2+$sz]
		if {$K == "nul"} {incr n 1; continue}
		$cnv create rectangle $x1 $y $x2 $y2 -tags [list k bk ${K}-${oct} n$n]
		$cnv bind ${K}-${oct} <ButtonPress-1> [list $action $cnv ${K}-${oct}]
		set x1 [expr $x1+$sz] ; set x2 [expr $x2+$sz]
		incr n 2
	}
 }

 proc togglekey {cnv tag} {
	if {[lsearch -exact [$cnv gettags $tag] act] != -1} 	  \
	{	$cnv dtag $tag act				} \
	{	$cnv addtag act withtag $tag			}
	upd $cnv
 }

 proc setkey {cnv tag {st 1}} {
	if {[lsearch -exact [$cnv gettags $tag] act] != -1} 	  \
	{	$cnv dtag $tag act				} \
	{	$cnv addtag act withtag $tag			}
	upd $cnv
 }

 proc setkeyN {cnv n {st 1}} {
	set tag n$n
	if {[lsearch -exact [$cnv gettags $tag] act] != -1} 	  \
	{	$cnv dtag $tag act				} \
	{	$cnv addtag act withtag $tag			}
 }

 proc setroot {cnv notetag} {
	set ::root [lindex [split $notetag -] 0]
	set ::nroot [string map {C# 1 D# 3 F# 6 G# 8 A# 10 C 0 D 2 E 4 F 5 G 7 A 9 B 11} $::root]
	makechord $::nroot $::mode
 }

 proc lcheck {l i} {if {[lsearch -exact $l $i] != -1} {return 1} {return 0}}
 proc onsetmode {args} {makechord $::nroot $::mode}
 proc onsetroot {args} {setroot .c $::root-1}
 proc upd {cnv} {foreach {t a v} {k outline black wk fill white bk fill black act fill red} {$cnv itemconfigure $t -$a $v}}

 proc makechord {root mode} {
	if {[lcheck $mode maj]}    { set intervals {0 7 12 16 19}  }
	if {![lcheck $mode minor]} { set intervals {0 7 12 16 19}  }
	if {[lcheck $mode min]}    { set intervals {0 7 12 15 19}  }
	if {[lcheck $mode 7]}      { set intervals {0 10 16 19 22} }
	if {[lcheck $mode maj7]}   { set intervals {0 11 16 19 23} }
	if {[lcheck $mode aug]}    { set intervals {0 8 12 16 20}  }
	if {[lcheck $mode dim]}    { set intervals {0 6 12 15 18}  }
	if {[lcheck $mode sus]}    { set intervals {0 7 12 17 19}  }
	if {[lcheck $mode sus4]}   { set intervals {0 7 12 17 19}  }
	.c dtag act act
	foreach i $intervals {setkeyN .c [expr $root+$i]}
	upd .c
 }

 set ::keycount 0
 set x 0
 for {set i 0} {$i < 3} {incr i} {create7keys .c $x 0 168 75 $i setroot ; incr x 168 ; incr ::keycount 12}
 upd .c
 trace add variable ::root write onsetroot
 trace add variable ::mode write onsetmode
 set ::root C
 set ::mode major
----
[[ [Category GUI] ]]