Updated 2014-01-28 02:37:52 by uniquename

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 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
        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} {
            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} {
            } 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

  focus .n

Amazing! 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 2014jan27

Here 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.

The lyrics are a bit cramped --- probably from trying to write each syllable directly below the corresponding note. By changing the note spacing, this cramping might be eliminated in most cases.

Suchenwirth's high-quality rendering of the notes is quite remarkable. These images remind me of the quality he put into A little slide-rule.