#!/command/tclsh

package require Tcl
package require Tk

frame .f -borderwidth 5

canvas .c -highlightthickness 0
label  .l

set notes {c c# d d# e f f# g g# a a# b}
set posns {0 0.6 1 1.8 2 3 3.6 4 4.7 5 5.8 6}

set w [expr {1 * 30}]
set h [expr {5 * 30}]

for {set octave 3; set x 0} {$octave < 6} {incr octave; incr x 7} {
    foreach note $notes pos $posns {
        switch -- [string length $note] {
        1 {
            # White key.
            set kw 1
            set kh 1
            set type white_key
        } 2 {
            # Black key.
            set kw 0.6
            set kh [expr {2 / 3.}]
            set type black_key
        }}

        .c create rectangle [expr {($x + $pos) * $w}] 0\
                [expr {($x + $pos + $kw) * $w}] [expr {$h * $kh}]\
                -tags $type
    }
}

.c itemconfigure white_key -fill white
.c itemconfigure black_key -fill black
.c raise black_key white_key

.c configure -width [expr {$w * 14 + 1}] -height [expr {$h + 1}]

pack .c -in .f -side top
pack .l -in .f -side bottom -fill x -expand 1
pack .f

wm resizable . 0 0

# vim: set ts=4 sts=4 sw=4 tw=80 et: