if 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. in the entry widget updates the canvas. [http://www.purl.org/NET/akupries/noway/note.gif] 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" 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 .s -textvar score entry .t -textvar lyrics bind .s {display} bind .t {display} pack .t .s -side bottom -fill x pack .c -side bottom -fill both -expand 1 update display focus .s ---- [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 example is from 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 3s, options to set the symbols for the key, and to connect notes with a bar or slur... ---- Amazing! Absolutely Amazing for such a small piece of code. Nicely Done! ---- [Arts and crafts of Tcl-Tk programming] | [Category Package] | [Category Multimedia]