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 aug dim 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 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 maj