notes::show .c {C D E F G+ G+ a a a a G++}An appended plus sign doubles, a minus sign halves the duration. This still leaves lots to do, but it's a fun beginning... The demo program (see screenshot above) has both a canvas for the notes and an entry widget for the input. <Return> in the entry widget updates the canvas.
See TclMusic for an updated (but not yet feature-complete) version of this. namespace eval notes {
variable size 6 ;# distance between lines = height of a note
variable aspect 1.33 ;# width/height of a note
variable x0 20
variable y0 40 ;# 30
variable measure 16 ;# 16ths to the bar
variable count 0
variable names {A B C D E F G a b c d e f g}
proc show {c notes lyrics} {
variable x0; variable y0
variable x $x0 y $y0
variable canvas $c
variable xmax [expr [winfo width $c]-20]
variable todo ""
$c delete all
key
set p [ string first ":" $lyrics ]; incr p -1
set txt [ string range $lyrics 0 $p ]; incr p 2
set lyrics [ string range $lyrics $p end]
$canvas create text 40 16 -text $txt -font {Helvetica 14} -anchor w
regsub -all "#" $notes "# " notes
regsub -all -- "-" $lyrics "- " lyrics
regsub -all "=" $lyrics "-" lyrics
set nr 0
foreach i $notes {
#set txt $i
set txt [lindex $lyrics $nr]
switch -regexp -- $i {
{[0-9]/[0-9]} {showtime $i}
{\(:} {dots begin}
{:\)} {dots end}
{#} {set todo #}
{^[A-Ga-g]} {
regexp (.)(.+)? $i -> note length
note $note $length $txt
incr nr
}
}
}
showbar 2
if {$x!=$x0} {showlines 0}
}
proc showtime time {
variable x; variable y; variable canvas
variable size; variable aspect
variable measure
regexp {([0-9])/([0-9])} $time -> num div
$canvas create text $x [expr $y+$size] -text $num ;# ?? bold
$canvas create text $x [expr $y+3*$size] -text $div
set x [expr $x+$size*$aspect]
set measure [expr $num*16/$div]
}
proc dots where {
variable canvas; variable x; variable y
variable size; variable aspect
switch $where {
begin {set xt [expr $x-$size*$aspect]}
end {set xt [expr $x-2.5*$size*$aspect]}
}
$canvas create oval $xt [expr $y+$size*1.5-1] \
[expr $xt+2] [expr $y+$size*1.5+1] -fill black
$canvas create oval $xt [expr $y+$size*2.5-1] \
[expr $xt+2] [expr $y+$size*2.5+1] -fill black
if {$where=="end"} {showbar 2; set x [expr $x+$size]}
}
proc do {what y1 y2} {
variable canvas; variable x; variable size; variable todo
set s2 [expr $size/2.]
switch $what {
# {
$canvas create line $x [expr $y1-$size+1] $x [expr $y2+$size]
set x [expr $x+$s2]
$canvas create line $x [expr $y1-$size] $x [expr $y2+$size-1]
set x [expr $x+$s2]
$canvas create line [expr $x-1.5*$size] [expr $y1+1]\
$x [expr $y1-2]
$canvas create line [expr $x-1.5*$size] [expr $y2+1]\
$x [expr $y2-2]
set x [expr $x+$s2]
}
}
set todo ""
}
proc note {note length txt} {
variable x; variable x0; variable xmax; variable y
variable size; variable aspect
variable names; variable canvas
variable todo
set index [lsearch $names $note]
set y1 [expr $y+(11-$index)*$size/2.+1]
set y2 [expr $y1+$size-1]
if {$todo=="#"} {do # $y1 $y2}
set x2 [expr $x+$size*$aspect]
set cmd [list $canvas create oval $x $y1 $x2 $y2]
if ![regexp {\+} $length] {lappend cmd -fill black}
eval $cmd
set y1 [expr ($y1+$size/2.)]
if {$index<3} {
$canvas create line [expr $x-2] $y1 [expr $x2+3] $y1
}
if {$length!="++"} {
if [regexp {[b-g]} $note] {
set xs $x; set ys [expr $y1+3.5*$size]; set dir -1
} else {
set xs $x2; set ys [expr $y1-3.5*$size]; set dir 1
}
$canvas create line $xs $y1 $xs $ys
if {$length=="-"} {
$canvas create line [expr $xs+1] $ys \
[expr $xs+$size*$aspect] [expr $ys+$dir*$size] -width 2
}
} else {set x [expr $x+$size*$aspect]}
if [regexp {\.} $length] {
$canvas create oval [expr $x2+$size/2] [expr $y1-3] \
[expr $x2+$size/2+2] [expr $y1-1] -fill black
}
if {$txt ne "_"} { $canvas create text $x [expr $y+7*$size] -text $txt }
set x [expr $x+$size*$aspect*3] ;# ?? adjust for textlen
countup $length
if {$x>$xmax} {showlines}
}
proc key {} {
variable canvas; variable x; variable x0; variable y
variable size; variable aspect
foreach i {
8 38 10 44 17 39 7 5 14 0 15 10 2 24 10 35 20 30 17 18 7 23 10 28
} {
lappend coords [expr {$i/6.*$size}]
}
set id [eval $canvas create line $coords -smooth 1 -width 2]
$canvas move $id $x0 [expr $y-$size]
set x [expr $x+3.5*$size*$aspect]
}
proc countup {length} {
variable count; variable measure
switch -- $length {
-- {incr count 1}
- {incr count 2}
-. {incr count 3}
"" {incr count 4}
. {incr count 6}
+ {incr count 8}
++ {incr count 16}
}
if {$count>=$measure} {
showbar
set count 0
}
}
proc showbar {{n 1}} {
variable canvas; variable size; variable aspect
variable x; variable xmax; variable y
if {$n>1} {
set x [expr $x-$size*$aspect]
$canvas create line $x $y $x [expr $y+4*$size] -width 2
} else {
$canvas create line $x $y $x [expr $y+4*$size]
if {$x>$xmax-10*$size*$aspect} {
showlines
} else {
set x [expr $x+2*$size]
}
}
}
proc showlines {{key 1}} {
variable canvas; variable size
variable x0; variable x
variable y
for {set i 0} {$i<5} {incr i} {
$canvas create line $x0 $y $x $y
set y [expr $y+$size]
}
set x $x0
set y [expr $y+$size*5]
if $key key
}
}
proc display {} {notes::show .c $::score $::lyrics}
set example1n [list \
4/4 C. D- E F G+ G+ (: a. a- b. c- G++ :) \
F. F- a F E+ E+ G. F- E #D C. E- C+ \
]
set example1t "Test: la la la _ la-la la=la"
set example2n [list \
# 6/8 G- G- G- D- D- D- G- G- G- G. a- a- a- E- E- E- \
a. a G- F- F- F- D- D- D- \
F- F- F- F- F- E- D- D- D- D- E- F- G- G- G- G. ]
set example2t [list Programmer's Drinking Song:\
Nine-ty nine litt-le bugs in the code, _\
Nine-ty nine bugs in the code,\
Fix one bug, com-pile it a-gain,\
One-hund-red litt-le bugs in the code.\
(go-to start if bugs > 0) ]
set score $example2n
set lyrics $example2t
canvas .c -background white -width 500
entry .n -textvar score
entry .t -textvar lyrics
bind .n <Return> {display}
bind .t <Return> {display}
pack .t .n -side bottom -fill x
pack .c -side bottom -fill both -expand 1
update
display
focus .nAmazing! Absolutely Amazing for such a small piece of code. Nicely Done!
HJG I added an input-line for a songtitle and lyrics. ":" separates the songtitle from the lyrics, "-" separates syllables, "=" writes a "-", and "_" writes a blank under a note.The example2 is a variation of 99 bottles of beer, found at http://sniff.numachi.com/~rickheit/dtrad/pages/tiPROGBUGS;ttBOT99.html
(It took longer to find/choose and enter this demo, than the actual programming :-) Now, it would be nice to have a few extras, e.g. make these entry-fields height 2 or 3, as well as options to set the symbols for the key, and to connect notes with a bar or slur...uniquename 2014jan27Here is an image of the window with HJG's input-line for songtitle and lyrics --- and with the "Programmer's Drinking Song" as sample input, for notes and lyrics.

