Version 3 of Notes on a canvas
Updated 2003-07-25 13:52:34if 0 {Richard Suchenwirth 2002-09-02 - This weekend fun project starts investigations on how to render musical notes on a canvas widget. Input is of course a string, e.g.
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 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} {
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
regsub -all # $notes "# " notes
foreach i $notes {
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
}
}
}
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
$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} {
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
}
set x [expr $x+$size*$aspect*3]
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
}
}
set example [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+ \
]
canvas .c -background white -width 500
entry .e -textvar example
bind .e <Return> {notes::show .c $example}
pack .e -side bottom -fill x
pack .c -side bottom -fill both -expand 1
update
notes::show .c $example
focus .eAmazing! Absolutely Amazing for such a small piece of code. Nicely Done!