Hex Artifact Content
Not logged in

Artifact 5e178cdc6d4b25834775a0f57a0126db8ecffd92:


0000: 23 20 62 61 73 65 64 20 6f 6e 20 68 74 74 70 3a  # based on http:
0010: 2f 2f 77 69 6b 69 2e 74 63 6c 2e 74 6b 2f 33 39  //wiki.tcl.tk/39
0020: 37 37 0a 0a 6e 61 6d 65 73 70 61 63 65 20 65 76  77..namespace ev
0030: 61 6c 20 6d 75 73 69 63 20 7b 0a 20 20 20 20 76  al music {.    v
0040: 61 72 69 61 62 6c 65 20 76 65 72 73 69 6f 6e 20  ariable version 
0050: 30 2e 31 20 20 20 20 20 20 3b 23 20 77 65 6c 6c  0.1      ;# well
0060: 20 79 65 73 2c 20 77 69 74 68 20 73 6f 6d 65 20   yes, with some 
0070: 69 74 65 72 61 74 69 6f 6e 73 20 3b 2d 29 0a 20  iterations ;-). 
0080: 20 20 20 76 61 72 69 61 62 6c 65 20 41 20 34 34     variable A 44
0090: 30 20 20 20 20 20 20 20 20 20 20 20 20 3b 23 20  0            ;# 
00a0: 73 74 61 6e 64 61 72 64 20 70 69 74 63 68 0a 20  standard pitch. 
00b0: 20 20 20 76 61 72 69 61 62 6c 65 20 62 61 73 69     variable basi
00c0: 63 4e 61 6d 65 73 20 7b 63 20 63 23 20 64 20 64  cNames {c c# d d
00d0: 23 20 65 20 66 20 66 23 20 67 20 67 23 20 61 20  # e f f# g g# a 
00e0: 62 62 20 62 7d 0a 20 20 20 20 76 61 72 69 61 62  bb b}.    variab
00f0: 6c 65 20 62 70 6d 20 37 32 0a 20 20 20 20 76 61  le bpm 72.    va
0100: 72 69 61 62 6c 65 20 66 72 65 71 4d 61 70 20 20  riable freqMap  
0110: 20 20 20 20 20 20 20 20 3b 23 20 61 72 72 61 79          ;# array
0120: 20 28 6e 6f 74 65 6e 61 6d 65 29 20 2d 3e 20 66   (notename) -> f
0130: 72 65 71 75 65 6e 63 79 0a 20 20 20 20 76 61 72  requency.    var
0140: 69 61 62 6c 65 20 73 68 6f 77 4e 6f 74 65 73 20  iable showNotes 
0150: 20 30 20 20 20 20 20 3b 23 20 64 65 66 61 75 6c   0     ;# defaul
0160: 74 20 66 6f 72 20 54 63 6c 0a 20 20 20 20 76 61  t for Tcl.    va
0170: 72 69 61 62 6c 65 20 6c 61 73 74 20 30 0a 7d 0a  riable last 0.}.
0180: 0a 70 72 6f 63 20 6d 75 73 69 63 3a 3a 67 65 74  .proc music::get
0190: 44 75 72 61 74 69 6f 6e 20 7b 6e 6f 74 65 7d 20  Duration {note} 
01a0: 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 62  {.    variable b
01b0: 70 6d 0a 20 20 20 20 73 65 74 20 72 65 73 20 5b  pm.    set res [
01c0: 65 78 70 72 20 7b 36 30 30 30 30 2f 24 62 70 6d  expr {60000/$bpm
01d0: 7d 5d 0a 20 20 20 20 77 68 69 6c 65 20 7b 5b 72  }].    while {[r
01e0: 65 67 65 78 70 20 7b 28 2e 2b 29 5b 2b 5d 24 7d  egexp {(.+)[+]$}
01f0: 20 24 6e 6f 74 65 20 2d 3e 20 6e 6f 74 65 5d 7d   $note -> note]}
0200: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 72   {.        set r
0210: 65 73 20 5b 65 78 70 72 20 7b 24 72 65 73 2a 32  es [expr {$res*2
0220: 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 77 68 69  }].    }.    whi
0230: 6c 65 20 7b 5b 72 65 67 65 78 70 20 7b 28 2e 2b  le {[regexp {(.+
0240: 29 5b 2d 5d 24 7d 20 24 6e 6f 74 65 20 2d 3e 20  )[-]$} $note -> 
0250: 6e 6f 74 65 5d 7d 20 7b 0a 20 20 20 20 20 20 20  note]} {.       
0260: 20 73 65 74 20 72 65 73 20 5b 65 78 70 72 20 7b   set res [expr {
0270: 24 72 65 73 2f 32 7d 5d 0a 20 20 20 20 7d 0a 20  $res/2}].    }. 
0280: 20 20 20 69 66 20 7b 5b 72 65 67 65 78 70 20 7b     if {[regexp {
0290: 28 2e 2b 29 5b 2e 5d 24 7d 20 24 6e 6f 74 65 20  (.+)[.]$} $note 
02a0: 2d 3e 20 6e 6f 74 65 5d 7d 20 7b 0a 20 20 20 20  -> note]} {.    
02b0: 20 20 20 20 73 65 74 20 72 65 73 20 5b 65 78 70      set res [exp
02c0: 72 20 7b 72 6f 75 6e 64 28 24 72 65 73 2a 31 2e  r {round($res*1.
02d0: 35 29 7d 5d 0a 20 20 20 20 7d 0a 20 20 20 20 73  5)}].    }.    s
02e0: 65 74 20 72 65 73 0a 7d 0a 0a 70 72 6f 63 20 6d  et res.}..proc m
02f0: 75 73 69 63 3a 3a 67 65 74 46 72 65 71 75 65 6e  usic::getFrequen
0300: 63 79 20 7b 6e 6f 74 65 7d 20 7b 0a 20 20 20 20  cy {note} {.    
0310: 76 61 72 69 61 62 6c 65 20 66 72 65 71 4d 61 70  variable freqMap
0320: 0a 20 20 20 20 73 65 74 20 70 75 72 65 4e 61 6d  .    set pureNam
0330: 65 20 5b 73 74 72 69 6e 67 20 74 72 69 6d 72 69  e [string trimri
0340: 67 68 74 20 24 6e 6f 74 65 20 7b 2b 2d 2e 7d 5d  ght $note {+-.}]
0350: 0a 20 20 20 20 69 66 20 7b 5b 69 6e 66 6f 20 65  .    if {[info e
0360: 78 69 73 74 73 20 66 72 65 71 4d 61 70 28 24 70  xists freqMap($p
0370: 75 72 65 4e 61 6d 65 29 5d 7d 20 7b 0a 20 20 20  ureName)]} {.   
0380: 20 20 20 20 20 72 65 74 75 72 6e 20 24 66 72 65       return $fre
0390: 71 4d 61 70 28 24 70 75 72 65 4e 61 6d 65 29 0a  qMap($pureName).
03a0: 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 72 6e      }.    return
03b0: 20 22 22 0a 7d 0a 0a 70 72 6f 63 20 6d 75 73 69   "".}..proc musi
03c0: 63 3a 3a 5f 6d 61 6b 65 46 72 65 71 4d 61 70 20  c::_makeFreqMap 
03d0: 7b 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c  {} {.    variabl
03e0: 65 20 41 0a 20 20 20 20 76 61 72 69 61 62 6c 65  e A.    variable
03f0: 20 62 61 73 69 63 4e 61 6d 65 73 0a 20 20 20 20   basicNames.    
0400: 76 61 72 69 61 62 6c 65 20 66 72 65 71 4d 61 70  variable freqMap
0410: 0a 20 20 20 20 73 65 74 20 6c 64 61 20 5b 65 78  .    set lda [ex
0420: 70 72 20 7b 6c 6f 67 28 24 41 29 2f 6c 6f 67 28  pr {log($A)/log(
0430: 32 29 7d 5d 0a 20 20 20 20 73 65 74 20 69 20 33  2)}].    set i 3
0440: 20 3b 23 20 43 20 69 73 20 33 20 68 61 6c 66 2d   ;# C is 3 half-
0450: 74 6f 6e 65 73 20 61 62 6f 76 65 20 41 0a 20 20  tones above A.  
0460: 20 20 73 65 74 20 66 72 65 71 4d 61 70 28 78 29    set freqMap(x)
0470: 20 30 20 3b 23 20 70 61 75 73 65 0a 20 20 20 20   0 ;# pause.    
0480: 66 6f 72 65 61 63 68 20 6e 61 6d 65 20 24 62 61  foreach name $ba
0490: 73 69 63 4e 61 6d 65 73 20 7b 0a 20 20 20 20 20  sicNames {.     
04a0: 20 20 20 73 65 74 20 66 20 5b 65 78 70 72 20 7b     set f [expr {
04b0: 70 6f 77 28 32 2c 20 24 6c 64 61 20 2b 20 24 69  pow(2, $lda + $i
04c0: 2f 31 32 2e 29 7d 5d 0a 20 20 20 20 20 20 20 20  /12.)}].        
04d0: 73 65 74 20 66 72 65 71 4d 61 70 28 24 6e 61 6d  set freqMap($nam
04e0: 65 29 20 20 20 24 66 0a 20 20 20 20 20 20 20 20  e)   $f.        
04f0: 73 65 74 20 66 72 65 71 4d 61 70 28 24 6e 61 6d  set freqMap($nam
0500: 65 27 29 20 20 5b 65 78 70 72 20 7b 24 66 2a 32  e')  [expr {$f*2
0510: 7d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 66  }].        set f
0520: 72 65 71 4d 61 70 28 24 6e 61 6d 65 27 27 29 20  reqMap($name'') 
0530: 5b 65 78 70 72 20 7b 24 66 2a 34 7d 5d 0a 20 20  [expr {$f*4}].  
0540: 20 20 20 20 20 20 73 65 74 20 75 6e 61 6d 65 20        set uname 
0550: 5b 73 74 72 69 6e 67 20 74 6f 75 70 70 65 72 20  [string toupper 
0560: 24 6e 61 6d 65 5d 0a 20 20 20 20 20 20 20 20 73  $name].        s
0570: 65 74 20 66 72 65 71 4d 61 70 28 24 75 6e 61 6d  et freqMap($unam
0580: 65 29 20 20 20 20 5b 65 78 70 72 20 7b 24 66 2f  e)    [expr {$f/
0590: 32 2e 7d 5d 0a 20 20 20 20 20 20 20 20 73 65 74  2.}].        set
05a0: 20 66 72 65 71 4d 61 70 28 24 7b 75 6e 61 6d 65   freqMap(${uname
05b0: 7d 31 29 20 5b 65 78 70 72 20 7b 24 66 2f 34 2e  }1) [expr {$f/4.
05c0: 7d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 66  }].        set f
05d0: 72 65 71 4d 61 70 28 24 7b 75 6e 61 6d 65 7d 32  reqMap(${uname}2
05e0: 29 20 5b 65 78 70 72 20 7b 24 66 2f 38 2e 7d 5d  ) [expr {$f/8.}]
05f0: 0a 20 20 20 20 20 20 20 20 69 6e 63 72 20 69 0a  .        incr i.
0600: 20 20 20 20 7d 0a 7d 0a 0a 6d 75 73 69 63 3a 3a      }.}..music::
0610: 5f 6d 61 6b 65 46 72 65 71 4d 61 70 20 3b 23 20  _makeFreqMap ;# 
0620: 70 72 6f 63 27 65 64 20 6f 6e 6c 79 20 74 6f 20  proc'ed only to 
0630: 68 69 64 65 20 6c 6f 63 61 6c 20 76 61 72 69 61  hide local varia
0640: 62 6c 65 73 0a 0a 70 72 6f 63 20 6d 75 73 69 63  bles..proc music
0650: 3a 3a 66 72 65 71 54 6f 4e 6f 74 65 20 7b 66 72  ::freqToNote {fr
0660: 65 71 7d 20 7b 0a 20 20 20 20 23 20 43 6f 6e 76  eq} {.    # Conv
0670: 65 72 74 73 20 74 68 65 20 67 69 76 65 6e 20 66  erts the given f
0680: 72 65 71 75 65 6e 63 79 20 74 6f 20 61 20 6d 69  requency to a mi
0690: 64 69 20 6e 6f 74 65 0a 20 20 20 20 23 20 4d 69  di note.    # Mi
06a0: 64 69 20 6e 6f 74 65 73 20 72 61 6e 67 65 20 66  di notes range f
06b0: 72 6f 6d 20 30 20 74 6f 20 31 32 37 20 77 69 74  rom 0 to 127 wit
06c0: 68 20 74 68 65 20 6c 6f 77 65 73 74 20 6e 6f 74  h the lowest not
06d0: 65 0a 20 20 20 20 23 20 61 74 20 61 20 66 72 65  e.    # at a fre
06e0: 71 75 65 6e 63 79 20 6f 66 20 38 2e 31 37 35 20  quency of 8.175 
06f0: 48 7a 20 61 6e 64 20 74 68 65 20 68 69 67 68 65  Hz and the highe
0700: 73 74 20 6e 6f 74 65 20 61 74 20 31 32 35 35 37  st note at 12557
0710: 20 48 7a 0a 20 20 20 20 23 20 45 61 63 68 20 6f   Hz.    # Each o
0720: 63 74 61 76 65 20 63 6f 6e 73 69 73 74 73 20 6f  ctave consists o
0730: 66 20 31 32 20 6e 6f 74 65 73 20 61 6e 64 20 66  f 12 notes and f
0740: 72 6f 6d 20 6f 6e 65 20 6f 63 74 61 76 65 20 74  rom one octave t
0750: 6f 20 74 68 65 0a 20 20 20 20 23 20 6e 65 78 74  o the.    # next
0760: 2c 20 74 68 65 20 66 72 65 71 75 65 6e 63 79 20  , the frequency 
0770: 64 6f 75 62 6c 65 73 0a 20 20 20 20 69 66 20 7b  doubles.    if {
0780: 24 66 72 65 71 20 3d 3d 20 30 7d 20 7b 72 65 74  $freq == 0} {ret
0790: 75 72 6e 20 30 7d 0a 20 20 20 20 72 65 74 75 72  urn 0}.    retur
07a0: 6e 20 5b 65 78 70 72 20 72 6f 75 6e 64 28 28 6c  n [expr round((l
07b0: 6f 67 28 24 66 72 65 71 2f 38 2e 31 37 35 29 2f  og($freq/8.175)/
07c0: 6c 6f 67 28 32 29 29 20 2a 20 31 32 29 5d 0a 7d  log(2)) * 12)].}
07d0: 0a 0a 70 72 6f 63 20 6d 75 73 69 63 3a 3a 70 6c  ..proc music::pl
07e0: 61 79 20 7b 73 63 6f 72 65 20 7b 54 6b 20 30 7d  ay {score {Tk 0}
07f0: 7d 20 7b 0a 20 20 20 20 73 65 74 20 74 20 30 0a  } {.    set t 0.
0800: 20 20 20 20 66 6f 72 65 61 63 68 20 69 74 65 6d      foreach item
0810: 20 24 73 63 6f 72 65 20 7b 0a 20 20 20 20 20 20   $score {.      
0820: 20 20 73 77 69 74 63 68 20 2d 2d 20 24 69 74 65    switch -- $ite
0830: 6d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20  m {.            
0840: 2f 20 7b 7d 0a 20 20 20 20 20 20 20 20 20 20 20  / {}.           
0850: 20 3c 20 7b 7d 0a 20 20 20 20 20 20 20 20 20 20   < {}.          
0860: 20 20 3e 20 7b 7d 0a 20 20 20 20 20 20 20 20 20    > {}.         
0870: 20 20 20 64 65 66 61 75 6c 74 20 7b 0a 20 20 20     default {.   
0880: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 65 74               set
0890: 20 64 74 20 5b 67 65 74 44 75 72 61 74 69 6f 6e   dt [getDuration
08a0: 20 24 69 74 65 6d 5d 0a 20 20 20 20 20 20 20 20   $item].        
08b0: 20 20 20 20 20 20 20 20 61 66 74 65 72 20 24 74          after $t
08c0: 20 6d 75 73 69 63 3a 3a 70 6c 61 79 4e 6f 74 65   music::playNote
08d0: 20 24 69 74 65 6d 20 24 64 74 20 24 54 6b 0a 20   $item $dt $Tk. 
08e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69                 i
08f0: 6e 63 72 20 74 20 24 64 74 0a 20 20 20 20 20 20  ncr t $dt.      
0900: 20 20 20 20 20 20 7d 0a 09 7d 0a 20 20 20 20 7d        }..}.    }
0910: 0a 7d 0a 0a 70 72 6f 63 20 6d 75 73 69 63 3a 3a  .}..proc music::
0920: 70 6c 61 79 4e 6f 74 65 20 7b 6e 6f 74 65 20 7b  playNote {note {
0930: 64 75 72 61 74 69 6f 6e 20 22 22 7d 20 7b 54 6b  duration ""} {Tk
0940: 20 30 7d 7d 20 7b 0a 20 20 20 20 76 61 72 69 61   0}} {.    varia
0950: 62 6c 65 20 63 75 72 72 65 6e 74 20 24 6e 6f 74  ble current $not
0960: 65 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 73  e.    variable s
0970: 68 6f 77 4e 6f 74 65 73 0a 20 20 20 20 73 65 74  howNotes.    set
0980: 20 66 20 5b 67 65 74 46 72 65 71 75 65 6e 63 79   f [getFrequency
0990: 20 24 6e 6f 74 65 5d 0a 20 20 20 20 69 66 20 7b   $note].    if {
09a0: 24 66 3d 3d 22 22 7d 20 7b 0a 09 69 66 20 7b 24  $f==""} {..if {$
09b0: 54 6b 7d 20 7b 0a 09 20 20 20 20 73 65 74 20 3a  Tk} {..    set :
09c0: 3a 6d 75 73 69 63 3a 3a 69 6e 66 6f 20 22 75 6e  :music::info "un
09d0: 6b 6e 6f 77 6e 20 6e 6f 74 65 20 24 6e 6f 74 65  known note $note
09e0: 22 0a 09 20 20 20 20 72 65 74 75 72 6e 0a 09 7d  "..    return..}
09f0: 20 65 6c 73 65 20 7b 0a 09 20 20 20 20 65 72 72   else {..    err
0a00: 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 6e 6f 74 65  or "unknown note
0a10: 20 24 6e 6f 74 65 22 0a 09 7d 0a 20 20 20 20 7d   $note"..}.    }
0a20: 0a 20 20 20 20 69 66 20 7b 24 64 75 72 61 74 69  .    if {$durati
0a30: 6f 6e 3d 3d 22 22 7d 20 7b 73 65 74 20 64 75 72  on==""} {set dur
0a40: 61 74 69 6f 6e 20 5b 67 65 74 44 75 72 61 74 69  ation [getDurati
0a50: 6f 6e 20 24 6e 6f 74 65 5d 7d 0a 20 20 20 20 69  on $note]}.    i
0a60: 66 20 7b 24 64 75 72 61 74 69 6f 6e 7d 20 20 20  f {$duration}   
0a70: 20 20 7b 73 65 74 20 3a 3a 6d 75 73 69 63 3a 3a    {set ::music::
0a80: 6c 61 73 74 20 5b 70 6c 61 79 42 65 67 69 6e 20  last [playBegin 
0a90: 24 66 5d 7d 0a 20 20 20 20 69 66 20 7b 24 64 75  $f]}.    if {$du
0aa0: 72 61 74 69 6f 6e 3e 3d 30 7d 20 20 7b 0a 20 20  ration>=0}  {.  
0ab0: 20 20 20 20 20 20 73 65 74 20 63 6d 64 20 22 6d        set cmd "m
0ac0: 75 73 69 63 3a 3a 70 6c 61 79 45 6e 64 20 24 3a  usic::playEnd $:
0ad0: 3a 6d 75 73 69 63 3a 3a 6c 61 73 74 22 0a 20 20  :music::last".  
0ae0: 20 20 20 20 20 20 69 66 20 7b 24 54 6b 7d 20 7b        if {$Tk} {
0af0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 6b 65 79  .            key
0b00: 62 6f 61 72 64 48 69 6c 69 74 65 20 24 6e 6f 74  boardHilite $not
0b10: 65 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 20  e 1.            
0b20: 61 70 70 65 6e 64 20 63 6d 64 20 22 3b 20 6d 75  append cmd "; mu
0b30: 73 69 63 3a 3a 6b 65 79 62 6f 61 72 64 48 69 6c  sic::keyboardHil
0b40: 69 74 65 20 24 6e 6f 74 65 20 30 22 0a 20 20 20  ite $note 0".   
0b50: 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 61       }.        a
0b60: 66 74 65 72 20 5b 65 78 70 72 20 7b 24 64 75 72  fter [expr {$dur
0b70: 61 74 69 6f 6e 2f 32 7d 5d 20 24 63 6d 64 0a 20  ation/2}] $cmd. 
0b80: 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 24 73 68     }.    if {$sh
0b90: 6f 77 4e 6f 74 65 73 20 26 26 20 24 64 75 72 61  owNotes && $dura
0ba0: 74 69 6f 6e 20 3e 3d 20 30 7d 20 7b 64 72 61 77  tion >= 0} {draw
0bb0: 4e 6f 74 65 20 24 6e 6f 74 65 7d 0a 7d 0a 0a 70  Note $note}.}..p
0bc0: 72 6f 63 20 6d 75 73 69 63 3a 3a 70 6c 61 79 42  roc music::playB
0bd0: 65 67 69 6e 20 7b 66 72 65 71 7d 20 7b 0a 20 20  egin {freq} {.  
0be0: 20 20 69 66 20 7b 24 66 72 65 71 20 3d 3d 20 30    if {$freq == 0
0bf0: 7d 20 7b 72 65 74 75 72 6e 20 30 7d 0a 20 20 20  } {return 0}.   
0c00: 20 73 65 74 20 6e 6f 74 65 20 5b 66 72 65 71 54   set note [freqT
0c10: 6f 4e 6f 74 65 20 24 66 72 65 71 5d 0a 20 20 20  oNote $freq].   
0c20: 20 63 61 74 63 68 20 7b 6d 75 7a 69 63 3a 3a 70   catch {muzic::p
0c30: 6c 61 79 6e 6f 74 65 20 30 20 24 6e 6f 74 65 20  laynote 0 $note 
0c40: 36 30 20 2d 31 7d 0a 20 20 20 20 72 65 74 75 72  60 -1}.    retur
0c50: 6e 20 24 6e 6f 74 65 0a 7d 0a 0a 70 72 6f 63 20  n $note.}..proc 
0c60: 6d 75 73 69 63 3a 3a 70 6c 61 79 45 6e 64 20 7b  music::playEnd {
0c70: 7b 76 61 72 4e 61 6d 65 20 22 22 7d 7d 20 7b 0a  {varName ""}} {.
0c80: 20 20 20 20 69 66 20 7b 24 76 61 72 4e 61 6d 65      if {$varName
0c90: 3d 3d 22 22 7d 20 7b 73 65 74 20 76 61 72 4e 61  ==""} {set varNa
0ca0: 6d 65 20 24 3a 3a 6d 75 73 69 63 3a 3a 6c 61 73  me $::music::las
0cb0: 74 7d 0a 20 20 20 20 69 66 20 7b 24 76 61 72 4e  t}.    if {$varN
0cc0: 61 6d 65 7d 20 7b 63 61 74 63 68 20 7b 6d 75 7a  ame} {catch {muz
0cd0: 69 63 3a 3a 70 6c 61 79 6e 6f 74 65 20 30 20 24  ic::playnote 0 $
0ce0: 76 61 72 4e 61 6d 65 20 30 20 30 7d 7d 0a 7d 0a  varName 0 0}}.}.
0cf0: 0a 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  .#--------------
0d00: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0d10: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
0d20: 2d 54 6b 20 73 74 75 66 66 3a 20 70 69 61 6e 6f  -Tk stuff: piano
0d30: 20 6b 65 79 62 6f 61 72 64 0a 0a 70 72 6f 63 20   keyboard..proc 
0d40: 6d 75 73 69 63 3a 3a 64 72 61 77 4b 65 79 62 6f  music::drawKeybo
0d50: 61 72 64 20 7b 63 20 78 30 20 79 30 20 64 78 20  ard {c x0 y0 dx 
0d60: 64 79 20 6e 6b 65 79 73 7d 20 7b 0a 20 20 20 20  dy nkeys} {.    
0d70: 76 61 72 69 61 62 6c 65 20 63 75 72 72 65 6e 74  variable current
0d80: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 6b 62  .    variable kb
0d90: 64 43 61 6e 76 61 73 20 24 63 0a 20 20 20 20 73  dCanvas $c.    s
0da0: 65 74 20 79 31 20 20 5b 65 78 70 72 20 7b 24 79  et y1  [expr {$y
0db0: 30 2b 24 64 79 7d 5d 0a 20 20 20 20 73 65 74 20  0+$dy}].    set 
0dc0: 79 30 35 20 5b 65 78 70 72 20 24 79 31 2a 2e 36  y05 [expr $y1*.6
0dd0: 37 5d 20 20 3b 23 20 6c 65 6e 67 74 68 20 6f 66  7]  ;# length of
0de0: 20 62 6c 61 63 6b 20 6b 65 79 73 0a 20 20 20 20   black keys.    
0df0: 73 65 74 20 64 78 32 20 5b 65 78 70 72 20 7b 24  set dx2 [expr {$
0e00: 64 78 2f 32 7d 5d 20 20 3b 23 20 6f 66 66 73 65  dx/2}]  ;# offse
0e10: 74 20 6f 66 20 62 6c 61 63 6b 20 6b 65 79 73 0a  t of black keys.
0e20: 20 20 20 20 73 65 74 20 6e 6b 65 79 20 30 0a 20      set nkey 0. 
0e30: 20 20 20 66 6f 72 65 61 63 68 20 6e 6f 74 65 20     foreach note 
0e40: 5b 6e 6f 74 65 53 65 71 75 65 6e 63 65 5d 20 7b  [noteSequence] {
0e50: 0a 20 20 20 20 20 20 20 20 69 66 20 7b 5b 69 6e  .        if {[in
0e60: 63 72 20 6e 6b 65 79 5d 3e 24 6e 6b 65 79 73 7d  cr nkey]>$nkeys}
0e70: 20 62 72 65 61 6b 0a 20 20 20 20 20 20 20 20 73   break.        s
0e80: 65 74 20 6b 65 79 63 6f 6c 6f 72 20 5b 6b 65 79  et keycolor [key
0e90: 43 6f 6c 6f 72 20 24 6e 6f 74 65 5d 0a 20 20 20  Color $note].   
0ea0: 20 20 20 20 20 69 66 20 7b 24 6b 65 79 63 6f 6c       if {$keycol
0eb0: 6f 72 3d 3d 22 62 6c 61 63 6b 22 7d 20 7b 0a 20  or=="black"} {. 
0ec0: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 78             set x
0ed0: 20 5b 65 78 70 72 20 7b 24 78 30 20 2d 20 24 64   [expr {$x0 - $d
0ee0: 78 2a 2e 33 35 7d 5d 0a 20 20 20 20 20 20 20 20  x*.35}].        
0ef0: 20 20 20 20 73 65 74 20 69 64 20 5b 24 63 20 63      set id [$c c
0f00: 72 65 61 74 65 20 72 65 63 74 20 24 78 20 24 79  reate rect $x $y
0f10: 30 20 5b 65 78 70 72 20 7b 24 78 2b 24 64 78 2a  0 [expr {$x+$dx*
0f20: 30 2e 36 7d 5d 20 24 79 30 35 20 5c 0a 20 20 20  0.6}] $y05 \.   
0f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 66 69               -fi
0f40: 6c 6c 20 24 6b 65 79 63 6f 6c 6f 72 20 2d 74 61  ll $keycolor -ta
0f50: 67 20 5b 6c 69 73 74 20 24 6e 6f 74 65 20 62 6c  g [list $note bl
0f60: 61 63 6b 5d 5d 0a 20 20 20 20 20 20 20 20 7d 20  ack]].        } 
0f70: 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 20 20  else {.         
0f80: 20 20 20 73 65 74 20 69 64 20 5b 24 63 20 63 72     set id [$c cr
0f90: 65 61 74 65 20 72 65 63 74 20 24 78 30 20 24 79  eate rect $x0 $y
0fa0: 30 20 5b 65 78 70 72 20 24 78 30 2b 24 64 78 5d  0 [expr $x0+$dx]
0fb0: 20 24 79 31 20 5c 0a 20 20 20 20 20 20 20 20 20   $y1 \.         
0fc0: 20 20 20 20 20 20 20 2d 66 69 6c 6c 20 24 6b 65         -fill $ke
0fd0: 79 63 6f 6c 6f 72 20 2d 74 61 67 20 24 6e 6f 74  ycolor -tag $not
0fe0: 65 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 69  e].            i
0ff0: 6e 63 72 20 78 30 20 24 64 78 3b 20 69 6e 63 72  ncr x0 $dx; incr
1000: 20 78 30 20 31 0a 20 20 20 20 20 20 20 20 7d 0a   x0 1.        }.
1010: 20 20 20 20 20 20 20 20 24 63 20 62 69 6e 64 20          $c bind 
1020: 24 69 64 20 3c 31 3e 20 20 20 20 20 20 20 20 20  $id <1>         
1030: 20 20 20 20 20 20 22 6d 75 73 69 63 3a 3a 54 6b        "music::Tk
1040: 4f 6e 20 24 63 20 24 69 64 20 24 6e 6f 74 65 22  On $c $id $note"
1050: 20 3b 23 20 73 6f 75 6e 64 20 6f 6e 0a 20 20 20   ;# sound on.   
1060: 20 20 20 20 20 24 63 20 62 69 6e 64 20 24 69 64       $c bind $id
1070: 20 3c 42 75 74 74 6f 6e 52 65 6c 65 61 73 65 2d   <ButtonRelease-
1080: 31 3e 20 22 6d 75 73 69 63 3a 3a 54 6b 4f 66 66  1> "music::TkOff
1090: 20 24 63 20 24 69 64 20 24 6e 6f 74 65 22 3b 23   $c $id $note";#
10a0: 20 73 6f 75 6e 64 20 6f 66 66 0a 20 20 20 20 20   sound off.     
10b0: 20 20 20 24 63 20 62 69 6e 64 20 24 69 64 20 3c     $c bind $id <
10c0: 33 3e 20 5c 0a 20 20 20 20 20 20 20 20 20 20 22  3> \.          "
10d0: 73 65 74 20 6d 75 73 69 63 3a 3a 63 75 72 72 65  set music::curre
10e0: 6e 74 20 7b 24 6e 6f 74 65 3a 20 5b 66 6f 72 6d  nt {$note: [form
10f0: 61 74 20 25 2e 31 66 20 5b 67 65 74 46 72 65 71  at %.1f [getFreq
1100: 75 65 6e 63 79 20 24 6e 6f 74 65 5d 5d 20 48 7a  uency $note]] Hz
1110: 7d 22 0a 20 20 20 20 20 20 20 20 24 63 20 62 69  }".        $c bi
1120: 6e 64 20 24 69 64 20 3c 45 6e 74 65 72 3e 20 22  nd $id <Enter> "
1130: 73 65 74 20 6d 75 73 69 63 3a 3a 63 75 72 72 65  set music::curre
1140: 6e 74 20 24 6e 6f 74 65 22 0a 20 20 20 20 20 20  nt $note".      
1150: 20 20 24 63 20 62 69 6e 64 20 24 69 64 20 3c 4c    $c bind $id <L
1160: 65 61 76 65 3e 20 22 73 65 74 20 6d 75 73 69 63  eave> "set music
1170: 3a 3a 63 75 72 72 65 6e 74 20 7b 7d 22 0a 20 20  ::current {}".  
1180: 20 20 7d 0a 20 20 20 20 24 63 20 72 61 69 73 65    }.    $c raise
1190: 20 62 6c 61 63 6b 0a 20 20 20 20 73 65 74 20 6d   black.    set m
11a0: 61 78 78 20 5b 6c 69 6e 64 65 78 20 5b 24 63 20  axx [lindex [$c 
11b0: 62 62 6f 78 20 61 6c 6c 5d 20 32 5d 0a 20 20 20  bbox all] 2].   
11c0: 20 69 66 20 7b 5b 24 63 20 63 67 65 74 20 2d 77   if {[$c cget -w
11d0: 69 64 74 68 5d 3c 24 6d 61 78 78 7d 20 7b 24 63  idth]<$maxx} {$c
11e0: 20 63 6f 6e 66 69 67 20 2d 77 69 64 74 68 20 5b   config -width [
11f0: 65 78 70 72 20 7b 24 6d 61 78 78 7d 5d 7d 0a 20  expr {$maxx}]}. 
1200: 20 20 20 73 65 74 20 6d 61 78 79 20 5b 6c 69 6e     set maxy [lin
1210: 64 65 78 20 5b 24 63 20 62 62 6f 78 20 61 6c 6c  dex [$c bbox all
1220: 5d 20 33 5d 0a 20 20 20 20 69 66 20 7b 5b 24 63  ] 3].    if {[$c
1230: 20 63 67 65 74 20 2d 68 65 69 67 68 74 5d 3c 24   cget -height]<$
1240: 6d 61 78 79 7d 20 7b 24 63 20 63 6f 6e 66 69 67  maxy} {$c config
1250: 20 2d 68 65 69 67 68 74 20 5b 65 78 70 72 20 7b   -height [expr {
1260: 24 6d 61 78 79 7d 5d 7d 0a 7d 0a 0a 70 72 6f 63  $maxy}]}.}..proc
1270: 20 6d 75 73 69 63 3a 3a 54 6b 4f 6e 20 7b 63 61   music::TkOn {ca
1280: 6e 76 61 73 20 69 64 20 6e 6f 74 65 7d 20 7b 0a  nvas id note} {.
1290: 20 20 20 20 76 61 72 69 61 62 6c 65 20 73 74 61      variable sta
12a0: 72 74 54 69 6d 65 20 5b 63 6c 6f 63 6b 20 63 6c  rtTime [clock cl
12b0: 69 63 6b 73 20 2d 6d 69 6c 6c 69 73 65 63 5d 0a  icks -millisec].
12c0: 20 20 20 20 70 6c 61 79 4e 6f 74 65 20 24 6e 6f      playNote $no
12d0: 74 65 20 2d 31 0a 20 20 20 20 24 63 61 6e 76 61  te -1.    $canva
12e0: 73 20 6d 6f 76 65 20 24 69 64 20 2d 31 20 2d 33  s move $id -1 -3
12f0: 20 3b 23 20 61 6e 69 6d 61 74 65 20 74 68 65 20   ;# animate the 
1300: 6b 65 79 20 74 6f 20 6c 6f 6f 6b 20 64 65 70 72  key to look depr
1310: 65 73 73 65 64 0a 7d 0a 0a 70 72 6f 63 20 6d 75  essed.}..proc mu
1320: 73 69 63 3a 3a 54 6b 4f 66 66 20 7b 63 61 6e 76  sic::TkOff {canv
1330: 61 73 20 69 64 20 6e 6f 74 65 7d 20 7b 0a 20 20  as id note} {.  
1340: 20 20 76 61 72 69 61 62 6c 65 20 72 65 63 6f 72    variable recor
1350: 64 3b 20 76 61 72 69 61 62 6c 65 20 72 65 63 6f  d; variable reco
1360: 72 64 65 64 0a 20 20 20 20 76 61 72 69 61 62 6c  rded.    variabl
1370: 65 20 73 74 61 72 74 54 69 6d 65 0a 20 20 20 20  e startTime.    
1380: 73 65 74 20 64 74 20 5b 65 78 70 72 20 7b 5b 63  set dt [expr {[c
1390: 6c 6f 63 6b 20 63 6c 69 63 6b 73 20 2d 6d 69 6c  lock clicks -mil
13a0: 6c 69 73 65 63 5d 20 2d 20 24 73 74 61 72 74 54  lisec] - $startT
13b0: 69 6d 65 7d 5d 0a 20 20 20 20 69 66 20 7b 24 64  ime}].    if {$d
13c0: 74 3c 31 33 30 7d 20 7b 0a 09 61 70 70 65 6e 64  t<130} {..append
13d0: 20 6e 6f 74 65 20 2d 0a 20 20 20 20 7d 20 65 6c   note -.    } el
13e0: 73 65 69 66 20 7b 24 64 74 3e 36 30 30 7d 20 7b  seif {$dt>600} {
13f0: 0a 09 61 70 70 65 6e 64 20 6e 6f 74 65 20 2b 2b  ..append note ++
1400: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24  .    } elseif {$
1410: 64 74 3e 33 30 30 7d 20 7b 0a 09 61 70 70 65 6e  dt>300} {..appen
1420: 64 20 6e 6f 74 65 20 2b 0a 20 20 20 20 7d 0a 20  d note +.    }. 
1430: 20 20 20 70 6c 61 79 4e 6f 74 65 20 24 6e 6f 74     playNote $not
1440: 65 20 30 0a 20 20 20 20 69 66 20 7b 24 72 65 63  e 0.    if {$rec
1450: 6f 72 64 7d 20 7b 6c 61 70 70 65 6e 64 20 72 65  ord} {lappend re
1460: 63 6f 72 64 65 64 20 24 6e 6f 74 65 7d 0a 20 20  corded $note}.  
1470: 20 20 24 63 61 6e 76 61 73 20 6d 6f 76 65 20 24    $canvas move $
1480: 69 64 20 31 20 33 0a 7d 0a 0a 70 72 6f 63 20 6d  id 1 3.}..proc m
1490: 75 73 69 63 3a 3a 6b 65 79 62 6f 61 72 64 48 69  usic::keyboardHi
14a0: 6c 69 74 65 20 7b 6e 6f 74 65 20 6d 6f 64 65 7d  lite {note mode}
14b0: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20   {.    variable 
14c0: 6b 62 64 43 61 6e 76 61 73 0a 20 20 20 20 73 65  kbdCanvas.    se
14d0: 74 20 6e 6f 74 65 20 5b 73 74 72 69 6e 67 20 74  t note [string t
14e0: 72 69 6d 72 69 67 68 74 20 24 6e 6f 74 65 20 7b  rimright $note {
14f0: 2b 2d 2e 7d 5d 0a 20 20 20 20 73 65 74 20 69 64  +-.}].    set id
1500: 20 20 20 5b 24 6b 62 64 43 61 6e 76 61 73 20 66     [$kbdCanvas f
1510: 69 6e 64 20 77 69 74 68 74 61 67 20 24 6e 6f 74  ind withtag $not
1520: 65 5d 0a 20 20 20 20 73 65 74 20 66 69 6c 6c 20  e].    set fill 
1530: 5b 65 78 70 72 20 7b 24 6d 6f 64 65 3f 20 22 67  [expr {$mode? "g
1540: 72 65 65 6e 22 3a 20 5b 6b 65 79 43 6f 6c 6f 72  reen": [keyColor
1550: 20 24 6e 6f 74 65 5d 7d 5d 0a 20 20 20 20 24 6b   $note]}].    $k
1560: 62 64 43 61 6e 76 61 73 20 69 74 65 6d 63 6f 6e  bdCanvas itemcon
1570: 66 69 67 20 24 69 64 20 2d 66 69 6c 6c 20 24 66  fig $id -fill $f
1580: 69 6c 6c 0a 20 7d 0a 0a 70 72 6f 63 20 6d 75 73  ill. }..proc mus
1590: 69 63 3a 3a 6b 65 79 43 6f 6c 6f 72 20 7b 6e 6f  ic::keyColor {no
15a0: 74 65 7d 20 7b 0a 20 20 20 20 65 78 70 72 20 7b  te} {.    expr {
15b0: 5b 72 65 67 65 78 70 20 2d 6e 6f 63 61 73 65 20  [regexp -nocase 
15c0: 22 23 7c 62 62 22 20 24 6e 6f 74 65 5d 3f 20 22  "#|bb" $note]? "
15d0: 62 6c 61 63 6b 22 20 3a 20 22 77 68 69 74 65 22  black" : "white"
15e0: 7d 0a 7d 0a 0a 70 72 6f 63 20 6d 75 73 69 63 3a  }.}..proc music:
15f0: 3a 6e 6f 74 65 53 65 71 75 65 6e 63 65 20 7b 7d  :noteSequence {}
1600: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20   {.    variable 
1610: 62 61 73 69 63 4e 61 6d 65 73 0a 20 20 20 20 73  basicNames.    s
1620: 65 74 20 75 62 61 73 69 63 20 5b 73 74 72 69 6e  et ubasic [strin
1630: 67 20 74 6f 75 70 70 65 72 20 24 62 61 73 69 63  g toupper $basic
1640: 4e 61 6d 65 73 5d 0a 20 20 20 20 66 6f 72 65 61  Names].    forea
1650: 63 68 20 69 20 24 75 62 61 73 69 63 20 20 20 20  ch i $ubasic    
1660: 20 7b 6c 61 70 70 65 6e 64 20 6e 6f 74 65 53 65   {lappend noteSe
1670: 71 75 65 6e 63 65 20 24 7b 69 7d 32 7d 0a 20 20  quence ${i}2}.  
1680: 20 20 66 6f 72 65 61 63 68 20 69 20 24 75 62 61    foreach i $uba
1690: 73 69 63 20 20 20 20 20 7b 6c 61 70 70 65 6e 64  sic     {lappend
16a0: 20 6e 6f 74 65 53 65 71 75 65 6e 63 65 20 24 7b   noteSequence ${
16b0: 69 7d 31 7d 0a 20 20 20 20 66 6f 72 65 61 63 68  i}1}.    foreach
16c0: 20 69 20 24 75 62 61 73 69 63 20 20 20 20 20 7b   i $ubasic     {
16d0: 6c 61 70 70 65 6e 64 20 6e 6f 74 65 53 65 71 75  lappend noteSequ
16e0: 65 6e 63 65 20 24 7b 69 7d 7d 0a 20 20 20 20 66  ence ${i}}.    f
16f0: 6f 72 65 61 63 68 20 69 20 24 62 61 73 69 63 4e  oreach i $basicN
1700: 61 6d 65 73 20 7b 6c 61 70 70 65 6e 64 20 6e 6f  ames {lappend no
1710: 74 65 53 65 71 75 65 6e 63 65 20 24 69 7d 0a 20  teSequence $i}. 
1720: 20 20 20 66 6f 72 65 61 63 68 20 69 20 24 62 61     foreach i $ba
1730: 73 69 63 4e 61 6d 65 73 20 7b 6c 61 70 70 65 6e  sicNames {lappen
1740: 64 20 6e 6f 74 65 53 65 71 75 65 6e 63 65 20 24  d noteSequence $
1750: 69 27 7d 0a 20 20 20 20 66 6f 72 65 61 63 68 20  i'}.    foreach 
1760: 69 20 24 62 61 73 69 63 4e 61 6d 65 73 20 7b 6c  i $basicNames {l
1770: 61 70 70 65 6e 64 20 6e 6f 74 65 53 65 71 75 65  append noteSeque
1780: 6e 63 65 20 24 69 27 27 7d 0a 20 20 20 20 73 65  nce $i''}.    se
1790: 74 20 6e 6f 74 65 53 65 71 75 65 6e 63 65 20 3b  t noteSequence ;
17a0: 23 20 66 6f 72 20 63 6f 6e 76 65 6e 69 65 6e 74  # for convenient
17b0: 6c 79 20 63 72 65 61 74 69 6e 67 20 74 68 65 20  ly creating the 
17c0: 6b 65 79 62 6f 61 72 64 0a 7d 0a 0a 23 2d 2d 2d  keyboard.}..#---
17d0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
17e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
17f0: 2d 2d 2d 2d 2d 2d 2d 2d 20 54 6b 20 73 74 75 66  -------- Tk stuf
1800: 66 3a 20 4e 6f 74 65 20 72 65 6e 64 65 72 69 6e  f: Note renderin
1810: 67 0a 0a 70 72 6f 63 20 6d 75 73 69 63 3a 3a 64  g..proc music::d
1820: 72 61 77 4c 69 6e 65 73 20 7b 63 61 6e 76 61 73  rawLines {canvas
1830: 20 78 30 20 79 30 20 78 31 20 64 79 7d 20 7b 0a   x0 y0 x1 dy} {.
1840: 20 20 20 20 76 61 72 69 61 62 6c 65 20 6e 6f 74      variable not
1850: 65 4d 61 70 0a 20 20 20 20 76 61 72 69 61 62 6c  eMap.    variabl
1860: 65 20 73 63 6f 72 65 43 61 6e 76 61 73 20 24 63  e scoreCanvas $c
1870: 61 6e 76 61 73 0a 20 20 20 20 76 61 72 69 61 62  anvas.    variab
1880: 6c 65 20 73 68 6f 77 4e 6f 74 65 73 20 31 0a 20  le showNotes 1. 
1890: 20 20 20 73 65 74 20 6e 6f 74 65 4d 61 70 28 74     set noteMap(t
18a0: 6f 70 59 29 20 24 79 30 0a 20 20 20 20 66 6f 72  opY) $y0.    for
18b0: 65 61 63 68 20 69 20 7b 31 20 32 20 33 20 34 20  each i {1 2 3 4 
18c0: 35 7d 20 7b 0a 20 20 20 20 20 20 20 20 24 63 61  5} {.        $ca
18d0: 6e 76 61 73 20 63 72 65 61 74 65 20 6c 69 6e 65  nvas create line
18e0: 20 24 78 30 20 24 79 30 20 24 78 31 20 24 79 30   $x0 $y0 $x1 $y0
18f0: 0a 20 20 20 20 20 20 20 20 69 6e 63 72 20 79 30  .        incr y0
1900: 20 24 64 79 0a 20 20 20 20 7d 0a 20 20 20 20 73   $dy.    }.    s
1910: 65 74 20 6e 6f 74 65 4d 61 70 28 62 74 6d 59 29  et noteMap(btmY)
1920: 20 5b 65 78 70 72 20 7b 24 79 30 2d 24 64 79 7d   [expr {$y0-$dy}
1930: 5d 0a 20 20 20 20 23 20 70 6f 73 69 74 69 6f 6e  ].    # position
1940: 20 77 68 65 72 65 20 6e 65 77 20 6e 6f 74 65 73   where new notes
1950: 20 61 72 65 20 69 6e 73 65 72 74 65 64 0a 20 20   are inserted.  
1960: 20 20 73 65 74 20 6e 6f 74 65 4d 61 70 28 6e 65    set noteMap(ne
1970: 77 58 29 20 5b 65 78 70 72 20 7b 24 78 31 20 2d  wX) [expr {$x1 -
1980: 20 32 30 30 7d 5d 0a 20 20 20 20 61 72 72 61 79   200}].    array
1990: 20 73 65 74 20 6e 6f 74 65 4d 61 70 20 5b 6d 61   set noteMap [ma
19a0: 6b 65 4e 6f 74 65 54 61 62 6c 65 20 5b 65 78 70  keNoteTable [exp
19b0: 72 20 24 79 30 2d 24 64 79 2f 32 5d 20 5b 65 78  r $y0-$dy/2] [ex
19c0: 70 72 20 7b 24 64 79 2f 32 7d 5d 5d 0a 7d 0a 0a  pr {$dy/2}]].}..
19d0: 70 72 6f 63 20 6d 75 73 69 63 3a 3a 64 72 61 77  proc music::draw
19e0: 4e 6f 74 65 20 7b 6e 61 6d 65 7d 20 7b 0a 20 20  Note {name} {.  
19f0: 20 20 76 61 72 69 61 62 6c 65 20 6e 6f 74 65 4d    variable noteM
1a00: 61 70 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20  ap.    variable 
1a10: 73 63 6f 72 65 43 61 6e 76 61 73 0a 20 20 20 20  scoreCanvas.    
1a20: 73 65 74 20 63 20 24 73 63 6f 72 65 43 61 6e 76  set c $scoreCanv
1a30: 61 73 0a 20 20 20 20 72 65 67 65 78 70 20 7b 28  as.    regexp {(
1a40: 5b 41 2d 47 61 2d 67 78 5d 29 28 5b 42 62 23 5d  [A-Ga-gx])([Bb#]
1a50: 29 3f 5b 31 32 27 5d 2a 28 5b 2d 2b 2e 5d 2a 29  )?[12']*([-+.]*)
1a60: 7d 20 24 6e 61 6d 65 20 2d 3e 20 6e 6f 74 65 20  } $name -> note 
1a70: 73 69 67 6e 20 6c 65 6e 67 74 68 0a 20 20 20 20  sign length.    
1a80: 69 66 20 7b 24 6e 6f 74 65 3d 3d 22 78 22 7d 20  if {$note=="x"} 
1a90: 72 65 74 75 72 6e 20 3b 23 20 70 61 75 73 65 20  return ;# pause 
1aa0: 73 69 67 6e 73 20 77 69 6c 6c 20 63 6f 6d 65 20  signs will come 
1ab0: 6c 61 74 65 72 0a 0a 20 20 20 20 24 63 20 6d 6f  later..    $c mo
1ac0: 76 65 20 6e 6f 74 65 20 2d 33 30 20 30 0a 20 20  ve note -30 0.  
1ad0: 20 20 73 65 74 20 79 20 24 6e 6f 74 65 4d 61 70    set y $noteMap
1ae0: 28 24 6e 6f 74 65 29 0a 20 20 20 20 69 66 20 7b  ($note).    if {
1af0: 5b 73 74 72 69 6e 67 20 66 69 72 73 74 20 31 20  [string first 1 
1b00: 24 6e 61 6d 65 5d 3e 30 7d 20 7b 69 6e 63 72 20  $name]>0} {incr 
1b10: 79 20 34 32 7d 20 20 20 20 20 20 20 20 20 3b 23  y 42}         ;#
1b20: 20 6c 6f 77 20 6e 6f 74 65 0a 20 20 20 20 69 66   low note.    if
1b30: 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73 74 20   {[string first 
1b40: 32 20 24 6e 61 6d 65 5d 3e 30 7d 20 7b 69 6e 63  2 $name]>0} {inc
1b50: 72 20 79 20 38 34 7d 20 20 20 20 20 20 20 20 20  r y 84}         
1b60: 3b 23 20 76 65 72 79 20 6c 6f 77 20 6e 6f 74 65  ;# very low note
1b70: 0a 20 20 20 20 77 68 69 6c 65 20 7b 5b 72 65 67  .    while {[reg
1b80: 65 78 70 20 28 2e 2b 29 27 20 24 6e 61 6d 65 20  exp (.+)' $name 
1b90: 2d 3e 20 6e 61 6d 65 5d 7d 20 7b 69 6e 63 72 20  -> name]} {incr 
1ba0: 79 20 2d 34 32 7d 20 3b 23 20 68 69 67 68 20 6e  y -42} ;# high n
1bb0: 6f 74 65 0a 20 20 20 20 73 65 74 20 6e 65 77 58  ote.    set newX
1bc0: 20 24 6e 6f 74 65 4d 61 70 28 6e 65 77 58 29 0a   $noteMap(newX).
1bd0: 20 20 20 20 73 65 74 20 73 78 20 5b 65 78 70 72      set sx [expr
1be0: 20 7b 24 6e 65 77 58 2b 34 7d 5d 0a 20 20 20 20   {$newX+4}].    
1bf0: 73 77 69 74 63 68 20 2d 2d 20 24 73 69 67 6e 20  switch -- $sign 
1c00: 7b 0a 20 20 20 20 20 20 20 20 23 20 20 20 20 20  {.        #     
1c10: 7b 24 63 20 63 72 65 61 74 65 20 74 65 78 74 20  {$c create text 
1c20: 24 73 78 20 24 79 20 2d 74 65 78 74 20 23 20 2d  $sx $y -text # -
1c30: 74 61 67 20 6e 6f 74 65 3b 24 63 20 6d 6f 76 65  tag note;$c move
1c40: 20 6e 6f 74 65 20 2d 31 34 20 30 7d 0a 20 20 20   note -14 0}.   
1c50: 20 20 20 20 20 42 20 2d 20 62 20 7b 24 63 20 63       B - b {$c c
1c60: 72 65 61 74 65 20 74 65 78 74 20 24 73 78 20 24  reate text $sx $
1c70: 79 20 2d 74 65 78 74 20 62 20 2d 74 61 67 20 6e  y -text b -tag n
1c80: 6f 74 65 3b 24 63 20 6d 6f 76 65 20 6e 6f 74 65  ote;$c move note
1c90: 20 2d 31 34 20 30 7d 0a 20 20 20 20 7d 0a 20 20   -14 0}.    }.  
1ca0: 20 20 73 65 74 20 79 32 20 5b 65 78 70 72 20 7b    set y2 [expr {
1cb0: 28 28 24 79 2b 36 29 2f 31 32 29 2a 31 32 2b 35  (($y+6)/12)*12+5
1cc0: 7d 5d 0a 20 20 20 20 73 65 74 20 61 78 30 20 5b  }].    set ax0 [
1cd0: 65 78 70 72 20 7b 24 6e 65 77 58 2d 34 7d 5d 20  expr {$newX-4}] 
1ce0: 3b 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 20 61 75 78 69  ;#--------- auxi
1cf0: 6c 69 61 72 79 20 6c 69 6e 65 73 2c 20 61 62 6f  liary lines, abo
1d00: 76 65 20 6f 72 20 62 65 6c 6f 77 0a 20 20 20 20  ve or below.    
1d10: 73 65 74 20 61 78 31 20 5b 65 78 70 72 20 7b 24  set ax1 [expr {$
1d20: 6e 65 77 58 2b 32 32 7d 5d 0a 20 20 20 20 77 68  newX+22}].    wh
1d30: 69 6c 65 20 7b 24 79 32 20 3c 20 24 6e 6f 74 65  ile {$y2 < $note
1d40: 4d 61 70 28 74 6f 70 59 29 2d 31 7d 20 7b 0a 20  Map(topY)-1} {. 
1d50: 20 20 20 20 20 20 20 69 66 20 7b 24 79 3c 24 79         if {$y<$y
1d60: 32 7d 20 7b 24 63 20 63 72 65 61 74 65 20 6c 69  2} {$c create li
1d70: 6e 65 20 24 61 78 30 20 24 79 32 20 24 61 78 31  ne $ax0 $y2 $ax1
1d80: 20 24 79 32 20 2d 74 61 67 20 6e 6f 74 65 7d 0a   $y2 -tag note}.
1d90: 20 20 20 20 20 20 20 20 69 6e 63 72 20 79 32 20          incr y2 
1da0: 31 32 0a 20 20 20 20 7d 0a 20 20 20 20 77 68 69  12.    }.    whi
1db0: 6c 65 20 7b 24 79 32 20 3e 20 24 6e 6f 74 65 4d  le {$y2 > $noteM
1dc0: 61 70 28 62 74 6d 59 29 7d 20 7b 0a 20 20 20 20  ap(btmY)} {.    
1dd0: 20 20 20 20 24 63 20 63 72 65 61 74 65 20 6c 69      $c create li
1de0: 6e 65 20 24 61 78 30 20 24 79 32 20 24 61 78 31  ne $ax0 $y2 $ax1
1df0: 20 24 79 32 20 2d 74 61 67 20 6e 6f 74 65 0a 20   $y2 -tag note. 
1e00: 20 20 20 20 20 20 20 69 6e 63 72 20 79 32 20 2d         incr y2 -
1e10: 31 32 0a 20 20 20 20 7d 0a 20 20 20 20 73 65 74  12.    }.    set
1e20: 20 6e 65 77 58 31 20 5b 65 78 70 72 20 7b 24 6e   newX1 [expr {$n
1e30: 65 77 58 2b 31 34 7d 5d 0a 20 20 20 20 73 65 74  ewX+14}].    set
1e40: 20 66 69 6c 6c 20 62 6c 61 63 6b 0a 20 20 20 20   fill black.    
1e50: 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73  if {[string firs
1e60: 74 20 2b 20 24 6c 65 6e 67 74 68 5d 3e 3d 30 7d  t + $length]>=0}
1e70: 20 7b 73 65 74 20 66 69 6c 6c 20 7b 7d 7d 0a 20   {set fill {}}. 
1e80: 20 20 20 24 63 20 63 72 65 61 74 65 20 6f 76 61     $c create ova
1e90: 6c 20 24 6e 65 77 58 20 24 79 20 24 6e 65 77 58  l $newX $y $newX
1ea0: 31 20 5b 65 78 70 72 20 7b 24 79 2b 31 30 7d 5d  1 [expr {$y+10}]
1eb0: 20 2d 74 61 67 20 6e 6f 74 65 20 5c 0a 20 20 20   -tag note \.   
1ec0: 20 20 20 20 20 2d 66 69 6c 6c 20 24 66 69 6c 6c       -fill $fill
1ed0: 0a 20 20 20 20 69 66 20 7b 5b 73 74 72 69 6e 67  .    if {[string
1ee0: 20 66 69 72 73 74 20 2e 20 24 6c 65 6e 67 74 68   first . $length
1ef0: 5d 3e 3d 30 7d 20 7b 0a 20 20 20 20 20 20 20 20  ]>=0} {.        
1f00: 24 63 20 63 72 65 61 74 65 20 74 65 78 74 20 24  $c create text $
1f10: 6e 65 77 58 31 20 24 79 20 2d 61 6e 63 68 6f 72  newX1 $y -anchor
1f20: 20 77 20 2d 74 65 78 74 20 22 20 2c 22 20 2d 74   w -text " ," -t
1f30: 61 67 20 6e 6f 74 65 0a 20 20 20 20 7d 0a 20 20  ag note.    }.  
1f40: 20 20 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69    if {[string fi
1f50: 72 73 74 20 2b 2b 20 24 6c 65 6e 67 74 68 5d 3c  rst ++ $length]<
1f60: 30 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74  0} {.        set
1f70: 20 79 30 20 5b 65 78 70 72 20 7b 24 79 3e 31 30   y0 [expr {$y>10
1f80: 32 3f 20 24 79 2d 34 30 3a 20 24 79 2b 35 30 7d  2? $y-40: $y+50}
1f90: 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 78 30  ].        set x0
1fa0: 20 5b 65 78 70 72 20 7b 24 79 3e 31 30 32 3f 20   [expr {$y>102? 
1fb0: 24 6e 65 77 58 31 3a 20 24 6e 65 77 58 7d 5d 0a  $newX1: $newX}].
1fc0: 20 20 20 20 20 20 20 20 24 63 20 63 72 65 61 74          $c creat
1fd0: 65 20 6c 69 6e 65 20 24 78 30 20 24 79 30 20 24  e line $x0 $y0 $
1fe0: 78 30 20 5b 69 6e 63 72 20 79 20 36 5d 20 2d 74  x0 [incr y 6] -t
1ff0: 61 67 20 6e 6f 74 65 0a 20 20 20 20 20 20 20 20  ag note.        
2000: 69 66 20 7b 5b 73 74 72 69 6e 67 20 66 69 72 73  if {[string firs
2010: 74 20 2d 20 24 6c 65 6e 67 74 68 5d 3e 3d 30 7d  t - $length]>=0}
2020: 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20 73   {.            s
2030: 65 74 20 79 31 20 5b 65 78 70 72 20 7b 28 24 79  et y1 [expr {($y
2040: 30 2b 24 79 29 2f 32 7d 5d 0a 20 20 20 20 20 20  0+$y)/2}].      
2050: 20 20 20 20 20 20 24 63 20 63 72 65 61 74 65 20        $c create 
2060: 6c 69 6e 65 20 24 78 30 20 24 79 30 20 5b 65 78  line $x0 $y0 [ex
2070: 70 72 20 7b 24 78 30 2b 31 30 7d 5d 20 24 79 31  pr {$x0+10}] $y1
2080: 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20   \.             
2090: 20 20 20 2d 77 69 64 74 68 20 31 20 2d 74 61 67     -width 1 -tag
20a0: 20 6e 6f 74 65 0a 20 20 20 20 20 20 20 20 7d 0a   note.        }.
20b0: 20 20 20 20 7d 0a 7d 0a 0a 70 72 6f 63 20 6d 75      }.}..proc mu
20c0: 73 69 63 3a 3a 6d 61 6b 65 4e 6f 74 65 54 61 62  sic::makeNoteTab
20d0: 6c 65 20 7b 79 30 20 64 79 7d 20 7b 0a 20 20 20  le {y0 dy} {.   
20e0: 20 73 65 74 20 62 61 73 69 63 73 20 7b 43 20 44   set basics {C D
20f0: 20 45 20 46 20 47 20 41 20 42 7d 0a 20 20 20 20   E F G A B}.    
2100: 66 6f 72 65 61 63 68 20 69 20 22 24 62 61 73 69  foreach i "$basi
2110: 63 73 20 5b 73 74 72 69 6e 67 20 74 6f 6c 6f 77  cs [string tolow
2120: 65 72 20 24 62 61 73 69 63 73 5d 22 20 7b 0a 20  er $basics]" {. 
2130: 20 20 20 20 20 20 20 6c 61 70 70 65 6e 64 20 6e         lappend n
2140: 6f 74 65 54 61 62 6c 65 20 24 69 20 24 79 30 0a  oteTable $i $y0.
2150: 20 20 20 20 20 20 20 20 69 6e 63 72 20 79 30 20          incr y0 
2160: 2d 24 64 79 0a 20 20 20 20 7d 0a 20 20 20 20 73  -$dy.    }.    s
2170: 65 74 20 6e 6f 74 65 54 61 62 6c 65 0a 7d 0a 0a  et noteTable.}..
2180: 23 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  #---------------
2190: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
21a0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 20 45 6e  ------------- En
21b0: 64 20 6f 66 20 70 61 63 6b 61 67 65 20 63 6f 6e  d of package con
21c0: 74 65 6e 74 73 0a 70 61 63 6b 61 67 65 20 70 72  tents.package pr
21d0: 6f 76 69 64 65 20 6d 75 73 69 63 20 24 6d 75 73  ovide music $mus
21e0: 69 63 3a 3a 76 65 72 73 69 6f 6e 0a 0a 23 2d 2d  ic::version..#--
21f0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
2200: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d  ----------------
2210: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 20 54 6b  ------------- Tk
2220: 20 61 6e 64 20 70 75 72 65 2d 54 63 6c 20 64 65   and pure-Tcl de
2230: 6d 6f 73 0a 0a 70 72 6f 63 20 6d 75 73 69 63 3a  mos..proc music:
2240: 3a 6d 61 6b 65 47 55 49 20 7b 74 6f 70 7d 20 7b  :makeGUI {top} {
2250: 0a 0a 20 20 20 20 77 6d 20 74 69 74 6c 65 20 24  ..    wm title $
2260: 74 6f 70 20 22 54 63 6c 6d 75 73 69 63 20 24 6d  top "Tclmusic $m
2270: 75 73 69 63 3a 3a 76 65 72 73 69 6f 6e 20 64 65  usic::version de
2280: 6d 6f 22 0a 0a 20 20 20 20 69 66 20 7b 24 74 6f  mo"..    if {$to
2290: 70 20 65 71 20 22 2e 22 7d 20 7b 0a 09 73 65 74  p eq "."} {..set
22a0: 20 77 20 22 22 0a 20 20 20 20 7d 20 65 6c 73 65   w "".    } else
22b0: 20 7b 0a 09 73 65 74 20 77 20 24 74 6f 70 0a 20   {..set w $top. 
22c0: 20 20 20 7d 0a 0a 20 20 20 20 73 65 74 20 61 6e     }..    set an
22d0: 64 72 6f 69 64 20 30 0a 20 20 20 20 63 61 74 63  droid 0.    catc
22e0: 68 20 7b 73 65 74 20 61 6e 64 72 6f 69 64 20 5b  h {set android [
22f0: 73 64 6c 74 6b 20 61 6e 64 72 6f 69 64 5d 7d 0a  sdltk android]}.
2300: 20 20 20 20 69 66 20 7b 24 61 6e 64 72 6f 69 64      if {$android
2310: 7d 20 7b 0a 09 62 69 6e 64 20 24 74 6f 70 20 3c  } {..bind $top <
2320: 43 6f 6e 66 69 67 75 72 65 3e 20 7b 7d 0a 20 20  Configure> {}.  
2330: 20 20 7d 0a 0a 20 20 20 20 63 61 6e 76 61 73 20    }..    canvas 
2340: 24 77 2e 73 20 2d 62 67 20 77 68 69 74 65 20 2d  $w.s -bg white -
2350: 68 65 69 67 68 74 20 32 35 30 0a 20 20 20 20 69  height 250.    i
2360: 66 20 7b 24 61 6e 64 72 6f 69 64 7d 20 7b 0a 09  f {$android} {..
2370: 73 65 74 20 77 69 64 74 68 20 5b 77 69 6e 66 6f  set width [winfo
2380: 20 73 63 72 65 65 6e 77 69 64 74 68 20 2e 5d 0a   screenwidth .].
2390: 09 6d 75 73 69 63 3a 3a 64 72 61 77 4c 69 6e 65  .music::drawLine
23a0: 73 20 24 77 2e 73 20 30 20 39 30 20 24 77 69 64  s $w.s 0 90 $wid
23b0: 74 68 20 31 32 0a 20 20 20 20 7d 20 65 6c 73 65  th 12.    } else
23c0: 20 7b 0a 09 6d 75 73 69 63 3a 3a 64 72 61 77 4c   {..music::drawL
23d0: 69 6e 65 73 20 24 77 2e 73 20 30 20 39 30 20 31  ines $w.s 0 90 1
23e0: 32 30 30 20 31 32 0a 20 20 20 20 7d 0a 0a 20 20  200 12.    }..  
23f0: 20 20 66 72 61 6d 65 20 24 77 2e 66 0a 20 20 20    frame $w.f.   
2400: 20 62 75 74 74 6f 6e 20 24 77 2e 66 2e 70 6c 61   button $w.f.pla
2410: 79 20 2d 74 65 78 74 20 50 6c 61 79 20 2d 63 6f  y -text Play -co
2420: 6d 6d 61 6e 64 20 7b 6d 75 73 69 63 3a 3a 70 6c  mmand {music::pl
2430: 61 79 20 24 3a 3a 6d 75 73 69 63 3a 3a 74 75 6e  ay $::music::tun
2440: 65 20 31 7d 0a 20 20 20 20 62 75 74 74 6f 6e 20  e 1}.    button 
2450: 24 77 2e 66 2e 78 20 2d 74 65 78 74 20 58 20 2d  $w.f.x -text X -
2460: 63 6f 6d 6d 61 6e 64 20 7b 73 65 74 20 3a 3a 6d  command {set ::m
2470: 75 73 69 63 3a 3a 74 75 6e 65 20 22 22 7d 0a 20  usic::tune ""}. 
2480: 20 20 20 63 68 65 63 6b 62 75 74 74 6f 6e 20 24     checkbutton $
2490: 77 2e 66 2e 72 65 63 6f 72 64 20 2d 74 65 78 74  w.f.record -text
24a0: 20 52 65 63 6f 72 64 20 2d 76 61 72 69 61 62 6c   Record -variabl
24b0: 65 20 6d 75 73 69 63 3a 3a 72 65 63 6f 72 64 0a  e music::record.
24c0: 20 20 20 20 63 68 65 63 6b 62 75 74 74 6f 6e 20      checkbutton 
24d0: 24 77 2e 66 2e 6e 6f 74 65 73 20 2d 74 65 78 74  $w.f.notes -text
24e0: 20 4e 6f 74 65 73 20 2d 76 61 72 69 61 62 6c 65   Notes -variable
24f0: 20 6d 75 73 69 63 3a 3a 73 68 6f 77 4e 6f 74 65   music::showNote
2500: 73 0a 20 20 20 20 65 76 61 6c 20 70 61 63 6b 20  s.    eval pack 
2510: 5b 77 69 6e 66 6f 20 63 68 69 6c 64 72 65 6e 20  [winfo children 
2520: 24 77 2e 66 5d 20 2d 73 69 64 65 20 6c 65 66 74  $w.f] -side left
2530: 20 2d 70 61 64 79 20 30 20 2d 66 69 6c 6c 20 79   -pady 0 -fill y
2540: 0a 0a 20 20 20 20 65 6e 74 72 79 20 24 77 2e 65  ..    entry $w.e
2550: 20 2d 74 65 78 74 76 61 72 20 3a 3a 6d 75 73 69   -textvar ::musi
2560: 63 3a 3a 74 75 6e 65 0a 20 20 20 20 62 69 6e 64  c::tune.    bind
2570: 20 24 77 2e 65 20 3c 52 65 74 75 72 6e 3e 20 7b   $w.e <Return> {
2580: 2e 66 2e 70 6c 61 79 20 69 6e 76 6f 6b 65 7d 0a  .f.play invoke}.
2590: 20 20 20 20 62 69 6e 64 20 24 77 2e 65 20 3c 33      bind $w.e <3
25a0: 3e 20 7b 63 61 74 63 68 20 7b 6d 75 73 69 63 3a  > {catch {music:
25b0: 3a 70 6c 61 79 20 5b 25 57 20 73 65 6c 65 63 74  :play [%W select
25c0: 69 6f 6e 20 67 65 74 5d 20 31 7d 7d 0a 20 20 20  ion get] 1}}.   
25d0: 20 74 72 61 63 65 20 76 61 72 69 61 62 6c 65 20   trace variable 
25e0: 3a 3a 6d 75 73 69 63 3a 3a 72 65 63 6f 72 64 65  ::music::recorde
25f0: 64 20 77 20 7b 73 65 74 20 3a 3a 6d 75 73 69 63  d w {set ::music
2600: 3a 3a 74 75 6e 65 20 24 3a 3a 6d 75 73 69 63 3a  ::tune $::music:
2610: 3a 72 65 63 6f 72 64 65 64 20 3b 23 7d 0a 0a 20  :recorded ;#}.. 
2620: 20 20 20 63 61 6e 76 61 73 20 24 77 2e 63 20 2d     canvas $w.c -
2630: 68 65 69 67 68 74 20 31 30 20 3b 23 20 64 75 6d  height 10 ;# dum
2640: 6d 79 20 73 6d 61 6c 6c 20 74 6f 20 6d 61 6b 65  my small to make
2650: 20 69 74 20 73 68 72 69 6e 6b 77 72 61 70 70 65   it shrinkwrappe
2660: 64 0a 20 20 20 20 69 66 20 7b 24 61 6e 64 72 6f  d.    if {$andro
2670: 69 64 7d 20 7b 0a 09 73 65 74 20 77 69 64 74 68  id} {..set width
2680: 20 5b 77 69 6e 66 6f 20 73 63 72 65 65 6e 77 69   [winfo screenwi
2690: 64 74 68 20 2e 5d 0a 09 69 6e 63 72 20 77 69 64  dth .]..incr wid
26a0: 74 68 20 2d 34 30 0a 09 73 65 74 20 77 69 64 74  th -40..set widt
26b0: 68 20 5b 65 78 70 72 20 72 6f 75 6e 64 28 24 77  h [expr round($w
26c0: 69 64 74 68 20 2f 20 33 36 2e 30 29 5d 0a 09 73  idth / 36.0)]..s
26d0: 65 74 20 68 65 69 67 68 74 20 5b 65 78 70 72 20  et height [expr 
26e0: 72 6f 75 6e 64 28 24 77 69 64 74 68 20 2a 20 36  round($width * 6
26f0: 2e 32 35 29 5d 0a 09 6d 75 73 69 63 3a 3a 64 72  .25)]..music::dr
2700: 61 77 4b 65 79 62 6f 61 72 64 20 24 77 2e 63 20  awKeyboard $w.c 
2710: 31 30 20 35 20 24 77 69 64 74 68 20 24 68 65 69  10 5 $width $hei
2720: 67 68 74 20 36 31 0a 20 20 20 20 7d 20 65 6c 73  ght 61.    } els
2730: 65 20 7b 0a 09 6d 75 73 69 63 3a 3a 64 72 61 77  e {..music::draw
2740: 4b 65 79 62 6f 61 72 64 20 24 77 2e 63 20 35 20  Keyboard $w.c 5 
2750: 35 20 33 32 20 32 30 30 20 36 31 0a 20 20 20 20  5 32 200 61.    
2760: 7d 0a 0a 20 20 20 20 6c 61 62 65 6c 20 24 77 2e  }..    label $w.
2770: 69 6e 66 6f 20 2d 74 65 78 74 76 61 72 20 3a 3a  info -textvar ::
2780: 6d 75 73 69 63 3a 3a 69 6e 66 6f 20 2d 77 69 64  music::info -wid
2790: 74 68 20 38 30 20 2d 61 6e 63 68 6f 72 20 77 20  th 80 -anchor w 
27a0: 2d 72 65 6c 69 65 66 20 73 75 6e 6b 65 6e 20 5c  -relief sunken \
27b0: 0a 20 20 20 20 20 20 20 20 2d 62 6f 72 64 65 72  .        -border
27c0: 77 69 64 74 68 20 31 0a 20 20 20 20 73 65 74 20  width 1.    set 
27d0: 3a 3a 6d 75 73 69 63 3a 3a 69 6e 66 6f 20 22 57  ::music::info "W
27e0: 65 6c 63 6f 6d 65 20 74 6f 20 54 63 6c 4d 75 73  elcome to TclMus
27f0: 69 63 20 2d 20 65 6e 6a 6f 79 20 74 68 65 20 70  ic - enjoy the p
2800: 6f 77 65 72 20 6f 66 20 54 63 6c 2f 54 6b 21 22  ower of Tcl/Tk!"
2810: 0a 20 20 20 20 74 72 61 63 65 20 76 61 72 69 61  .    trace varia
2820: 62 6c 65 20 3a 3a 6d 75 73 69 63 3a 3a 63 75 72  ble ::music::cur
2830: 72 65 6e 74 20 77 20 7b 73 65 74 20 3a 3a 6d 75  rent w {set ::mu
2840: 73 69 63 3a 3a 69 6e 66 6f 20 24 3a 3a 6d 75 73  sic::info $::mus
2850: 69 63 3a 3a 63 75 72 72 65 6e 74 20 3b 23 7d 0a  ic::current ;#}.
2860: 0a 20 20 20 20 65 76 61 6c 20 70 61 63 6b 20 5b  .    eval pack [
2870: 77 69 6e 66 6f 20 63 68 69 6c 64 72 65 6e 20 24  winfo children $
2880: 74 6f 70 5d 20 2d 66 69 6c 6c 20 78 0a 20 20 20  top] -fill x.   
2890: 20 69 66 20 7b 24 61 6e 64 72 6f 69 64 7d 20 7b   if {$android} {
28a0: 0a 09 70 61 63 6b 20 63 6f 6e 66 69 67 75 72 65  ..pack configure
28b0: 20 24 77 2e 63 20 2d 73 69 64 65 20 62 6f 74 74   $w.c -side bott
28c0: 6f 6d 0a 09 70 61 63 6b 20 63 6f 6e 66 69 67 75  om..pack configu
28d0: 72 65 20 24 77 2e 69 6e 66 6f 20 2d 73 69 64 65  re $w.info -side
28e0: 20 62 6f 74 74 6f 6d 20 2d 62 65 66 6f 72 65 20   bottom -before 
28f0: 2e 63 20 2d 70 61 64 78 20 31 30 20 2d 70 61 64  .c -padx 10 -pad
2900: 79 20 35 0a 09 65 76 61 6c 20 70 61 63 6b 20 63  y 5..eval pack c
2910: 6f 6e 66 69 67 75 72 65 20 5b 77 69 6e 66 6f 20  onfigure [winfo 
2920: 63 68 69 6c 64 72 65 6e 20 24 77 2e 66 5d 20 2d  children $w.f] -
2930: 70 61 64 79 20 31 30 20 2d 70 61 64 78 20 31 30  pady 10 -padx 10
2940: 0a 09 70 61 63 6b 20 63 6f 6e 66 69 67 75 72 65  ..pack configure
2950: 20 24 77 2e 65 20 2d 70 61 64 78 20 31 30 0a 09   $w.e -padx 10..
2960: 62 69 6e 64 20 24 74 6f 70 20 3c 4b 65 79 2d 42  bind $top <Key-B
2970: 72 65 61 6b 3e 20 65 78 69 74 0a 20 20 20 20 7d  reak> exit.    }
2980: 20 65 6c 73 65 20 7b 0a 09 77 6d 20 72 65 73 69   else {..wm resi
2990: 7a 61 62 6c 65 20 24 74 6f 70 20 30 20 30 0a 09  zable $top 0 0..
29a0: 62 69 6e 64 20 24 74 6f 70 20 3c 45 73 63 61 70  bind $top <Escap
29b0: 65 3e 20 65 78 69 74 0a 09 62 69 6e 64 20 24 74  e> exit..bind $t
29c0: 6f 70 20 3f 20 7b 63 6f 6e 73 6f 6c 65 20 73 68  op ? {console sh
29d0: 6f 77 7d 0a 20 20 20 20 7d 0a 7d 0a 0a 69 66 20  ow}.    }.}..if 
29e0: 7b 5b 66 69 6c 65 20 74 61 69 6c 20 5b 69 6e 66  {[file tail [inf
29f0: 6f 20 73 63 72 69 70 74 5d 5d 3d 3d 5b 66 69 6c  o script]]==[fil
2a00: 65 20 74 61 69 6c 20 24 61 72 67 76 30 5d 7d 20  e tail $argv0]} 
2a10: 7b 0a 20 20 20 20 73 65 74 20 3a 3a 6d 75 73 69  {.    set ::musi
2a20: 63 3a 3a 74 75 6e 65 20 7b 0a 20 20 20 20 20 20  c::tune {.      
2a30: 20 20 65 2e 20 64 20 63 20 63 2e 20 41 2d 20 41    e. d c c. A- A
2a40: 2e 20 47 2b 20 63 20 65 20 64 2b 20 65 2e 20 64  . G+ c e d+ e. d
2a50: 20 63 20 63 2e 20 41 2d 20 41 2e 20 47 20 63 20   c c. A- A. G c 
2a60: 42 20 64 20 63 2b 20 78 0a 20 20 20 20 20 20 20  B d c+ x.       
2a70: 20 67 2e 20 61 20 67 20 67 2e 20 65 2d 20 67 2e   g. a g g. e- g.
2a80: 20 67 2b 20 61 20 67 20 64 2b 20 65 2e 20 64 20   g+ a g d+ e. d 
2a90: 63 20 63 2e 20 41 2d 20 41 2e 20 47 20 63 20 42  c c. A- A. G c B
2aa0: 20 64 20 63 2b 2b 0a 20 20 20 20 7d 0a 0a 20 20   d c++.    }..  
2ab0: 20 20 63 61 74 63 68 20 7b 6d 75 7a 69 63 3a 3a    catch {muzic::
2ac0: 69 6e 69 74 7d 0a 0a 20 20 20 20 69 66 20 7b 5b  init}..    if {[
2ad0: 70 61 63 6b 61 67 65 20 70 72 6f 76 69 64 65 20  package provide 
2ae0: 54 6b 5d 21 3d 22 22 7d 20 7b 0a 20 20 20 20 20  Tk]!=""} {.     
2af0: 20 20 20 6f 70 74 69 6f 6e 20 61 64 64 20 2a 42     option add *B
2b00: 75 74 74 6f 6e 2e 70 61 64 59 20 30 0a 0a 09 73  utton.padY 0...s
2b10: 65 74 20 61 6e 64 72 6f 69 64 20 30 0a 09 63 61  et android 0..ca
2b20: 74 63 68 20 7b 73 65 74 20 61 6e 64 72 6f 69 64  tch {set android
2b30: 20 5b 73 64 6c 74 6b 20 61 6e 64 72 6f 69 64 5d   [sdltk android]
2b40: 7d 0a 09 69 66 20 7b 24 61 6e 64 72 6f 69 64 7d  }..if {$android}
2b50: 20 7b 0a 09 20 20 20 20 77 6d 20 61 74 74 72 69   {..    wm attri
2b60: 62 75 74 65 73 20 2e 20 2d 66 75 6c 6c 73 63 72  butes . -fullscr
2b70: 65 65 6e 20 31 0a 09 20 20 20 20 62 6f 72 67 20  een 1..    borg 
2b80: 73 63 72 65 65 6e 6f 72 69 65 6e 74 61 74 69 6f  screenorientatio
2b90: 6e 20 6c 61 6e 64 73 63 61 70 65 0a 09 20 20 20  n landscape..   
2ba0: 20 73 64 6c 74 6b 20 74 6f 75 63 68 74 72 61 6e   sdltk touchtran
2bb0: 73 6c 61 74 65 20 30 0a 09 20 20 20 20 23 20 67  slate 0..    # g
2bc0: 72 6f 73 73 20 68 61 63 6b 20 66 6f 72 20 70 6f  ross hack for po
2bd0: 74 65 6e 74 69 61 6c 20 6f 72 69 65 6e 74 61 74  tential orientat
2be0: 69 6f 6e 20 63 68 61 6e 67 65 0a 09 20 20 20 20  ion change..    
2bf0: 23 20 6f 74 68 65 72 77 69 73 65 20 73 63 72 65  # otherwise scre
2c00: 65 6e 20 77 69 64 74 68 2f 68 65 69 67 68 74 20  en width/height 
2c10: 63 61 6e 20 62 65 20 77 72 6f 6e 67 0a 09 20 20  can be wrong..  
2c20: 20 20 23 20 66 6f 72 20 67 65 6f 6d 65 74 72 79    # for geometry
2c30: 20 63 6f 6d 70 75 74 61 74 69 6f 6e 0a 09 20 20   computation..  
2c40: 20 20 62 69 6e 64 20 2e 20 3c 43 6f 6e 66 69 67    bind . <Config
2c50: 75 72 65 3e 20 7b 0a 09 09 62 69 6e 64 20 2e 20  ure> {...bind . 
2c60: 3c 43 6f 6e 66 69 67 75 72 65 3e 20 7b 7d 0a 09  <Configure> {}..
2c70: 09 61 66 74 65 72 20 35 30 30 20 7b 6d 75 73 69  .after 500 {musi
2c80: 63 3a 3a 6d 61 6b 65 47 55 49 20 2e 7d 0a 09 20  c::makeGUI .}.. 
2c90: 20 20 20 7d 0a 09 7d 20 65 6c 73 65 20 7b 0a 09     }..} else {..
2ca0: 20 20 20 20 6d 75 73 69 63 3a 3a 6d 61 6b 65 47      music::makeG
2cb0: 55 49 20 2e 0a 09 7d 0a 20 20 20 20 7d 20 65 6c  UI ...}.    } el
2cc0: 73 65 20 7b 0a 09 70 75 74 73 20 22 50 75 72 65  se {..puts "Pure
2cd0: 2d 54 63 6c 20 6d 75 73 69 63 20 70 61 63 6b 61  -Tcl music packa
2ce0: 67 65 20 64 65 6d 6f 20 2d 20 77 69 6c 6c 20 6c  ge demo - will l
2cf0: 61 73 74 20 35 30 20 73 65 63 6f 6e 64 73 22 0a  ast 50 seconds".
2d00: 09 61 66 74 65 72 20 35 30 30 30 30 20 73 65 74  .after 50000 set
2d10: 20 61 77 68 69 6c 65 20 31 0a 20 20 20 20 20 20   awhile 1.      
2d20: 20 20 74 72 61 63 65 20 76 61 72 69 61 62 6c 65    trace variable
2d30: 20 6d 75 73 69 63 3a 3a 63 75 72 72 65 6e 74 20   music::current 
2d40: 77 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 20  w {.            
2d50: 70 75 74 73 20 2d 6e 6f 6e 65 77 6c 69 6e 65 20  puts -nonewline 
2d60: 73 74 64 65 72 72 20 22 24 3a 3a 6d 75 73 69 63  stderr "$::music
2d70: 3a 3a 63 75 72 72 65 6e 74 20 22 20 3b 23 7d 0a  ::current " ;#}.
2d80: 20 20 20 20 20 20 20 20 6d 75 73 69 63 3a 3a 70          music::p
2d90: 6c 61 79 20 24 3a 3a 6d 75 73 69 63 3a 3a 74 75  lay $::music::tu
2da0: 6e 65 0a 09 76 77 61 69 74 20 61 77 68 69 6c 65  ne..vwait awhile
2db0: 0a 20 20 20 20 7d 0a 7d 0a                       .    }.}.