Version 2.01

This commit is contained in:
Gary Scavone
2013-09-25 11:17:56 +02:00
committed by Stephen Sinclair
parent 6485746ee9
commit ea749b71d2
223 changed files with 12125 additions and 4552 deletions

BIN
TCLSpecs/.swp Normal file

Binary file not shown.

2
TCLSpecs/GUIDrums Executable file
View File

@@ -0,0 +1,2 @@
cd ..
wish < TCLSpecs/TCLDrums.tcl | syntmono DrumSynt -r -i

View File

@@ -1,2 +1,2 @@
cd ..
wish < TCLSpecs/TCLPhys.tcl | testTextIn Clarinet
wish < TCLSpecs/TCLPhys.tcl | syntmono Clarinet -r -i

View File

@@ -1,2 +1,2 @@
cd ..
wish < TCLSpecs/TCLStruk.tcl | testTextIn Mandolin
wish < TCLSpecs/TCLStruk.tcl | syntmono Mandolin -r -i

2
TCLSpecs/GUIShakers Executable file
View File

@@ -0,0 +1,2 @@
cd ..
wish < TCLSpecs/TCLShakers.tcl | syntmono Maraca -r -i

View File

@@ -1,2 +1,2 @@
cd ..
wish < TCLSpecs/TCLVoice.tcl | testTextIn FMVoices
wish < TCLSpecs/TCLVoice.tcl | syntmono FMVoices -r -i

View File

@@ -1,2 +1,2 @@
cd ..
testMIDI | testTextIn Clarinet
MD2SKINI | syntmono Clarinet -r -i

View File

@@ -1,2 +1,2 @@
cd ..
testMIDI | testTextIn Mandolin
MD2SKINI | syntmono Mandolin -r -i

View File

@@ -1,2 +1,2 @@
cd ..
testMIDI | testTextIn FMVoices
MD2SKINI | syntmono FMVoices -r -i

152
TCLSpecs/TCLDrums.tcl Normal file
View File

@@ -0,0 +1,152 @@
set press 127
set outID "stdout"
set commtype "stdout"
# Configure main window
wm title . "STK Drum Controller"
wm iconname . "drum"
. config -bg black
# Configure "communications" menu
menu .menu -tearoff 0
menu .menu.communication -tearoff 0
.menu add cascade -label "Communication" -menu .menu.communication \
-underline 0
.menu.communication add radio -label "Console" -variable commtype \
-value "stdout" -command { setComm }
.menu.communication add radio -label "Socket" -variable commtype \
-value "socket" -command { setComm }
. configure -menu .menu
# Configure slider
scale .bPressure -from 0 -to 128 -length 100 \
-command {changePress } -variable press\
-orient horizontal -label "Velocity" \
-tickinterval 64 -showvalue true -bg grey66
pack .bPressure -pady 5 -padx 5
# Configure buttons
frame .buttons -bg black
frame .buttons.left -bg black
frame .buttons.right -bg black
button .buttons.left.bass -text Bass -bg grey66 \
-command { playDrum 36 } -width 7
button .buttons.left.snare -text Snare -bg grey66 \
-command { playDrum 38 } -width 7
button .buttons.left.tomlo -text LoTom -bg grey66 \
-command { playDrum 41 } -width 7
button .buttons.left.tommid -text MidTom -bg grey66 \
-command { playDrum 45 } -width 7
button .buttons.left.tomhi -text HiTom -bg grey66 \
-command { playDrum 50 } -width 7
button .buttons.left.homer -text Homer -bg grey66 \
-command { playDrum 90 } -width 7
button .buttons.right.hat -text Hat -bg grey66 \
-command { playDrum 42 } -width 7
button .buttons.right.ride -text Ride -bg grey66 \
-command { playDrum 46 } -width 7
button .buttons.right.crash -text Crash -bg grey66 \
-command { playDrum 49 } -width 7
button .buttons.right.cowbel -text CowBel -bg grey66 \
-command { playDrum 56 } -width 7
button .buttons.right.tamb -text Tamb -bg grey66 \
-command { playDrum 54 } -width 7
button .buttons.right.homer -text Homer -bg grey66 \
-command { playDrum 90 } -width 7
pack .buttons.left.bass -pady 5
pack .buttons.left.snare -pady 5
pack .buttons.left.tomlo -pady 5
pack .buttons.left.tommid -pady 5
pack .buttons.left.tomhi -pady 5
pack .buttons.left.homer -pady 5
pack .buttons.right.hat -pady 5
pack .buttons.right.ride -pady 5
pack .buttons.right.crash -pady 5
pack .buttons.right.cowbel -pady 5
pack .buttons.right.tamb -pady 5
pack .buttons.right.homer -pady 5
pack .buttons.left -side left -pady 5 -padx 5
pack .buttons.right -side right -pady 5 -padx 5
pack .buttons -pady 5 -padx 5
# Configure exit button
button .exit -text "Exit Program" -bg grey66 -command myExit
pack .exit -side bottom -pady 20
proc myExit {} {
global outID
puts $outID [format "ExitProgram"]
flush $outID
close $outID
exit
}
proc playDrum {value} {
global press
global outID
puts $outID [format "NoteOn 0.0 1 %i %f" $value $press]
flush $outID
}
proc changePress {value} {
global press
set press $value
}
# Socket connection procedure
set d .socketdialog
proc setComm {} {
global outID
global commtype
global d
if {$commtype == "stdout"} {
if { [string compare "stdout" $outID] } {
set i [tk_dialog .dialog "Break Socket Connection?" {You are about to break an existing socket connection ... is this what you want to do?} "" 0 Cancel OK]
switch $i {
0 {set commtype "socket"}
1 {close $outID
set outID "stdout"}
}
}
} elseif { ![string compare "stdout" $outID] } {
set sockport 2001
toplevel $d
wm title $d "STK Client Socket Connection"
wm resizable $d 0 0
grab $d
label $d.message -text "Specify a socket port number below (if different than the STK default of 2001) and then click the \"Connect\" button to invoke a socket-client connection attempt to the STK socket server." \
-background white -font {Helvetica 10 bold} \
-wraplength 3i -justify left
frame $d.sockport
entry $d.sockport.entry -width 6
label $d.sockport.text -text "Socket Port Number:" \
-font {Helvetica 10 bold}
pack $d.message -side top -padx 5 -pady 10
pack $d.sockport.text -side left -padx 1 -pady 10
pack $d.sockport.entry -side right -padx 5 -pady 10
pack $d.sockport -side top -padx 5 -pady 10
$d.sockport.entry insert 0 $sockport
frame $d.buttons
button $d.buttons.cancel -text "Cancel" -bg grey66 \
-command { set commtype "stdout"
set outID "stdout"
destroy $d }
button $d.buttons.connect -text "Connect" -bg grey66 \
-command {
set sockport [$d.sockport.entry get]
set err [catch {socket localhost $sockport} outID]
if {$err == 0} {
destroy $d
} else {
tk_dialog $d.error "Socket Error" {Error: Unable to make socket connection. Make sure the STK socket server is first running and that the port number is correct.} "" 0 OK
} }
pack $d.buttons.cancel -side left -padx 5 -pady 10
pack $d.buttons.connect -side right -padx 5 -pady 10
pack $d.buttons -side bottom -padx 5 -pady 10
}
}

View File

@@ -1,128 +1,60 @@
set pitch 64.0
set press 64.0
set cont1 0.0
set cont2 20.0
set cont4 64.0
set cont11 64.0
set outID "stdout"
set commtype "stdout"
set patchnum 0
button .pretty -bitmap @TCLSpecs/bitmaps/prcFunny.xbm \
-background white -foreground black
.pretty config -bitmap @TCLSpecs/bitmaps/prc.xbm
# Configure main window
wm title . "STK Physical Model Controller"
wm iconname . "physical"
. config -bg black
proc myExit {} {
puts stdout [format "ExitProgram"]
flush stdout
exit
}
proc noteOn {pitchVal pressVal} {
puts stdout [format "NoteOn 0.0 1 %f %f" $pitchVal $pressVal]
flush stdout
}
proc noteOff {pitchVal pressVal} {
puts stdout [format "NoteOff 0.0 1 %f %f" $pitchVal $pressVal]
flush stdout
}
proc patchChange {value} {
global .pretty
puts stdout [format "ProgramChange 0.0 1 %i" $value]
if {$value==0} {
.pretty config -bitmap @TCLSpecs/bitmaps/Klar.xbm
}
if {$value==1} {
.pretty config -bitmap @TCLSpecs/bitmaps/KFloot.xbm
}
if {$value==2} {
.pretty config -bitmap @TCLSpecs/bitmaps/KHose.xbm
}
if {$value==3} {
.pretty config -bitmap @TCLSpecs/bitmaps/KFiddl.xbm
}
flush stdout
}
proc printWhatz {tag value1 value2 } {
puts stdout [format "%s %i %f" $tag $value1 $value2]
flush stdout
}
proc changePress {value} {
global press
set press $value
puts stdout [format "AfterTouch 0.0 1 %f" $press]
flush stdout
}
proc changePitch {value} {
global pitch
set pitch $value
puts stdout [format "PitchBend 0.0 1 %f" $pitch]
flush stdout
}
scale .bPressure -from 0 -to 128 -length 200 \
-command {changePress } \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Breath Pressure" \
-tickinterval 32 -showvalue true -bg grey66
scale .pitch -from 0 -to 128 -length 200 \
-command {changePitch } \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "MIDI Note Number" \
-tickinterval 32 -showvalue true -bg grey66
scale .cont1 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 2} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Reed, Emb., Lip., Bow Pres." \
-tickinterval 32 -showvalue true -bg grey66
scale .cont2 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Noise Amt., Slide Length,Bow Pos." \
-tickinterval 32 -showvalue true -bg grey66
scale .cont3 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vibrato Rate" \
-tickinterval 32 -showvalue true -bg grey66
scale .vibrato -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vibrato Amount" \
-tickinterval 32 -showvalue true -bg grey66
. config -bg grey20
# Configure "communications" menu
menu .menu -tearoff 0
menu .menu.communication -tearoff 0
.menu add cascade -label "Communication" -menu .menu.communication \
-underline 0
.menu.communication add radio -label "Console" -variable commtype \
-value "stdout" -command { setComm }
.menu.communication add radio -label "Socket" -variable commtype \
-value "socket" -command { setComm }
. configure -menu .menu
# Configure patch change buttons
frame .instChoice -bg black
radiobutton .instChoice.clar -text Clarinet -bg grey66 \
-command { patchChange 0 }
radiobutton .instChoice.flut -text Flute -bg grey66 \
-command { patchChange 1 }
radiobutton .instChoice.bras -text Brass -bg grey66 \
-command { patchChange 2 }
radiobutton .instChoice.bowd -text Bowed -bg grey66 \
-command { patchChange 3 }
radiobutton .instChoice.clar -text "Clarinet" -bg grey66 \
-variable patchnum -value 0 -command { patchChange $patchnum }
radiobutton .instChoice.flut -text "Flute" -bg grey66 \
-variable patchnum -value 1 -command { patchChange $patchnum }
radiobutton .instChoice.bras -text "Brass" -bg grey66 \
-variable patchnum -value 2 -command { patchChange $patchnum }
radiobutton .instChoice.bowd -text "Bowed" -bg grey66 \
-variable patchnum -value 3 -command { patchChange $patchnum }
pack .instChoice.clar -side left -padx 5
pack .instChoice.flut -side left -padx 5
pack .instChoice.bras -side left -padx 5
pack .instChoice.bowd -side left -padx 5 -pady 10
pack .instChoice
pack .instChoice -side top
# Configure bitmap display
if {$tcl_platform(platform) == "windows"} {
set bitmappath bitmaps
} else {
set bitmappath TCLSpecs/bitmaps
}
button .pretty -bitmap @$bitmappath/prcFunny.xbm \
-background white -foreground black
.pretty config -bitmap @$bitmappath/prc.xbm
pack .pretty -padx 5 -pady 10
pack .bPressure -padx 10 -pady 10
pack .pitch -padx 10 -pady 10
pack .vibrato -padx 10 -pady 10
pack .cont1 -padx 10 -pady 10
pack .cont2 -padx 10 -pady 10
pack .cont3 -padx 10 -pady 10
# Configure "note-on" buttons
frame .noteOn -bg black
button .noteOn.on -text NoteOn -bg grey66 -command { noteOn $pitch $press }
@@ -134,3 +66,172 @@ pack .noteOn.exit -side left -padx 5 -pady 10
pack .noteOn
# Configure sliders
frame .left -bg black
frame .right -bg black
scale .left.bPressure -from 0 -to 128 -length 200 \
-command {changePress } -variable press \
-orient horizontal -label "Breath Pressure" \
-tickinterval 32 -showvalue true -bg grey66
scale .left.pitch -from 0 -to 128 -length 200 \
-command {changePitch } -variable pitch \
-orient horizontal -label "MIDI Note Number" \
-tickinterval 32 -showvalue true -bg grey66
scale .left.cont1 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 2} \
-orient horizontal -label "Reed, Emb., Lip., Bow Pres." \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont2
scale .right.cont2 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-orient horizontal -label "Noise, Slide Len.,Bow Pos." \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont4
scale .right.cont3 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-orient horizontal -label "Vibrato Rate" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont11
scale .right.vibrato -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-orient horizontal -label "Vibrato Amount" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont1
pack .left.bPressure -padx 10 -pady 10
pack .left.pitch -padx 10 -pady 10
pack .left.cont1 -padx 10 -pady 10
pack .right.cont2 -padx 10 -pady 10
pack .right.cont3 -padx 10 -pady 10
pack .right.vibrato -padx 10 -pady 10
pack .left -side left
pack .right -side right
proc myExit {} {
global pitch
global outID
puts $outID [format "NoteOff 0.0 1 %f 127" $pitch ]
flush $outID
puts $outID [format "ExitProgram"]
flush $outID
close $outID
exit
}
proc noteOn {pitchVal pressVal} {
global outID
puts $outID [format "NoteOn 0.0 1 %f %f" $pitchVal $pressVal]
flush $outID
}
proc noteOff {pitchVal pressVal} {
global outID
puts $outID [format "NoteOff 0.0 1 %f %f" $pitchVal $pressVal]
flush $outID
}
proc patchChange {value} {
global outID
global bitmappath
global cont1
global cont2
global cont4
global cont11
puts $outID [format "ProgramChange 0.0 1 %i" $value]
if {$value==0} {
.pretty config -bitmap @$bitmappath/Klar.xbm
}
if {$value==1} {
.pretty config -bitmap @$bitmappath/KFloot.xbm
}
if {$value==2} {
.pretty config -bitmap @$bitmappath/KHose.xbm
}
if {$value==3} {
.pretty config -bitmap @$bitmappath/KFiddl.xbm
}
flush $outID
set cont1 0.0
set cont2 20.0
set cont4 64.0
set cont11 64.0
}
proc printWhatz {tag value1 value2 } {
global outID
puts $outID [format "%s %i %f" $tag $value1 $value2]
flush $outID
}
proc changePress {value} {
global outID
puts $outID [format "AfterTouch 0.0 1 %f" $value]
flush $outID
}
proc changePitch {value} {
global outID
puts $outID [format "PitchBend 0.0 1 %.3f" $value]
flush $outID
}
# Socket connection procedure
set d .socketdialog
proc setComm {} {
global outID
global commtype
global d
if {$commtype == "stdout"} {
if { [string compare "stdout" $outID] } {
set i [tk_dialog .dialog "Break Socket Connection?" {You are about to break an existing socket connection ... is this what you want to do?} "" 0 Cancel OK]
switch $i {
0 {set commtype "socket"}
1 {close $outID
set outID "stdout"}
}
}
} elseif { ![string compare "stdout" $outID] } {
set sockport 2001
toplevel $d
wm title $d "STK Client Socket Connection"
wm resizable $d 0 0
grab $d
label $d.message -text "Specify a socket port number below (if different than the STK default of 2001) and then click the \"Connect\" button to invoke a socket-client connection attempt to the STK socket server." \
-background white -font {Helvetica 10 bold} \
-wraplength 3i -justify left
frame $d.sockport
entry $d.sockport.entry -width 6
label $d.sockport.text -text "Socket Port Number:" \
-font {Helvetica 10 bold}
pack $d.message -side top -padx 5 -pady 10
pack $d.sockport.text -side left -padx 1 -pady 10
pack $d.sockport.entry -side right -padx 5 -pady 10
pack $d.sockport -side top -padx 5 -pady 10
$d.sockport.entry insert 0 $sockport
frame $d.buttons
button $d.buttons.cancel -text "Cancel" -bg grey66 \
-command { set commtype "stdout"
set outID "stdout"
destroy $d }
button $d.buttons.connect -text "Connect" -bg grey66 \
-command {
set sockport [$d.sockport.entry get]
set err [catch {socket localhost $sockport} outID]
if {$err == 0} {
destroy $d
} else {
tk_dialog $d.error "Socket Error" {Error: Unable to make socket connection. Make sure the STK socket server is first running and that the port number is correct.} "" 0 OK
} }
pack $d.buttons.cancel -side left -padx 5 -pady 10
pack $d.buttons.connect -side right -padx 5 -pady 10
pack $d.buttons -side bottom -padx 5 -pady 10
}
}

195
TCLSpecs/TCLShakers.tcl Normal file
View File

@@ -0,0 +1,195 @@
set press 64.0
set cont1 64.0
set cont4 64.0
set cont11 64.0
set outID "stdout"
set commtype "stdout"
set patchnum 19
# Configure main window
wm title . "STK Shakers Controller"
wm iconname . "shakers"
. config -bg black
# Configure "communications" menu
menu .menu -tearoff 0
menu .menu.communication -tearoff 0
.menu add cascade -label "Communication" -menu .menu.communication \
-underline 0
.menu.communication add radio -label "Console" -variable commtype \
-value "stdout" -command { setComm }
.menu.communication add radio -label "Socket" -variable commtype \
-value "socket" -command { setComm }
. configure -menu .menu
# Configure sliders
frame .right -bg black
scale .right.bPressure -from 0 -to 128 -length 300 \
-command {changePress } -variable press\
-orient horizontal -label "Shake Energy" \
-tickinterval 32 -showvalue true -bg grey66
scale .right.cont2 -from 0 -to 128 -length 300 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-orient horizontal -label "(<--High) System Damping (Low-->)" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont4
scale .right.cont3 -from 0 -to 128 -length 300 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-orient horizontal -label "Number of Objects" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont11
scale .right.vibrato -from 0 -to 128 -length 300 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-orient horizontal -label "Resonance Center Freq." \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont1
pack .right.bPressure -padx 10 -pady 10
pack .right.vibrato -padx 10 -pady 10
pack .right.cont2 -padx 10 -pady 10
pack .right.cont3 -padx 10 -pady 10
pack .right -side right -padx 5 -pady 5
# Configure radio buttons
frame .left -bg black
radiobutton .left.maraca -text Maraca -bg grey66 \
-command { patchChange 19 } -variable patchnum -width 8 \
-justify left -value 19
radiobutton .left.sekere -text Sekere -bg grey66 \
-command { patchChange 20 } -variable patchnum -width 8 \
-justify left -value 20
radiobutton .left.cabasa -text Cabasa -bg grey66 \
-command { patchChange 21 } -variable patchnum -width 8 \
-justify left -value 21
radiobutton .left.bamboo -text Bamboo -bg grey66 \
-command { patchChange 22 } -variable patchnum -width 8 \
-justify left -value 22
radiobutton .left.waterdrp -text Waterdrp -bg grey66 \
-command { patchChange 23 } -variable patchnum -width 8 \
-justify left -value 23
radiobutton .left.tambourn -text Tambourn -bg grey66 \
-command { patchChange 24 } -variable patchnum -width 8 \
-justify left -value 24
radiobutton .left.sleighbl -text Sleighbl -bg grey66 \
-command { patchChange 25 } -variable patchnum -width 8 \
-justify left -value 25
radiobutton .left.guiro -text Guiro -bg grey66 \
-command { patchChange 26 } -variable patchnum -width 8 \
-justify left -value 26
pack .left.maraca -pady 5
pack .left.sekere -pady 5
pack .left.cabasa -pady 5
pack .left.bamboo -pady 5
pack .left.waterdrp -pady 5
pack .left.tambourn -pady 5
pack .left.sleighbl -pady 5
pack .left.guiro -pady 5
pack .left -side left -padx 10
# Configure exit button
button .left.exit -text "Exit Program" -bg grey66 -command myExit
pack .left.exit -pady 10
proc myExit {} {
global outID
puts $outID [format "ExitProgram"]
flush $outID
close $outID
exit
}
proc patchChange {value} {
global outID
global press
global cont1
global cont4
global cont11
puts $outID [format "ProgramChange 0.0 1 %i" $value]
flush $outID
set cont1 64.0
set cont4 64.0
set cont11 64.0
}
proc printWhatz {tag value1 value2 } {
global outID
global press
puts $outID [format "%s %i %f" $tag $value1 $value2]
puts $outID [format "AfterTouch 0.0 1 %f" $press]
flush $outID
}
proc changePress {value} {
global outID
puts $outID [format "AfterTouch 0.0 1 %f" $value]
flush $outID
}
proc changePitch {value} {
global outID
puts $outID [format "PitchBend 0.0 1 %.3f" $value]
flush $outID
}
# Socket connection procedure
set d .socketdialog
proc setComm {} {
global outID
global commtype
global d
if {$commtype == "stdout"} {
if { [string compare "stdout" $outID] } {
set i [tk_dialog .dialog "Break Socket Connection?" {You are about to break an existing socket connection ... is this what you want to do?} "" 0 Cancel OK]
switch $i {
0 {set commtype "socket"}
1 {close $outID
set outID "stdout"}
}
}
} elseif { ![string compare "stdout" $outID] } {
set sockport 2001
toplevel $d
wm title $d "STK Client Socket Connection"
wm resizable $d 0 0
grab $d
label $d.message -text "Specify a socket port number below (if different than the STK default of 2001) and then click the \"Connect\" button to invoke a socket-client connection attempt to the STK socket server." \
-background white -font {Helvetica 10 bold} \
-wraplength 3i -justify left
frame $d.sockport
entry $d.sockport.entry -width 6
label $d.sockport.text -text "Socket Port Number:" \
-font {Helvetica 10 bold}
pack $d.message -side top -padx 5 -pady 10
pack $d.sockport.text -side left -padx 1 -pady 10
pack $d.sockport.entry -side right -padx 5 -pady 10
pack $d.sockport -side top -padx 5 -pady 10
$d.sockport.entry insert 0 $sockport
frame $d.buttons
button $d.buttons.cancel -text "Cancel" -bg grey66 \
-command { set commtype "stdout"
set outID "stdout"
destroy $d }
button $d.buttons.connect -text "Connect" -bg grey66 \
-command {
set sockport [$d.sockport.entry get]
set err [catch {socket localhost $sockport} outID]
if {$err == 0} {
destroy $d
} else {
tk_dialog $d.error "Socket Error" {Error: Unable to make socket connection. Make sure the STK socket server is first running and that the port number is correct.} "" 0 OK
} }
pack $d.buttons.cancel -side left -padx 5 -pady 10
pack $d.buttons.connect -side right -padx 5 -pady 10
pack $d.buttons -side bottom -padx 5 -pady 10
}
}

View File

@@ -1,129 +1,54 @@
set pitch 64.0
set press 64.0
set cont1 0.0
set cont2 64.0
set cont4 64.0
set cont11 127.0
set outID "stdout"
set commtype "stdout"
set patchnum 5
button .pretty -bitmap @TCLSpecs/bitmaps/prcFunny.xbm \
-background white -foreground black
.pretty config -bitmap @TCLSpecs/bitmaps/prc.xbm
# Configure main window
wm title . "STK Struck-Pluck Model Controller"
wm iconname . "struck"
. config -bg black
proc myExit {} {
puts stdout [format "ExitProgram"]
flush stdout
exit
}
proc noteOn {pitchVal pressVal} {
puts stdout [format "NoteOn 0.0 1 %f %f" $pitchVal $pressVal]
flush stdout
}
proc noteOff {pitchVal pressVal} {
puts stdout [format "NoteOff 0.0 1 %f %f" $pitchVal $pressVal]
flush stdout
}
proc patchChange {value} {
global .pretty
puts stdout [format "ProgramChange 0.0 1 %i" $value]
if {$value==4} {
.pretty config -bitmap @TCLSpecs/bitmaps/KPluk.xbm
}
if {$value==5} {
.pretty config -bitmap @TCLSpecs/bitmaps/KModal.xbm
}
if {$value==6} {
.pretty config -bitmap @TCLSpecs/bitmaps/KModal.xbm
}
if {$value==7} {
.pretty config -bitmap @TCLSpecs/bitmaps/KModal.xbm
}
if {$value==8} {
.pretty config -bitmap @TCLSpecs/bitmaps/KFMod.xbm
}
if {$value==9} {
.pretty config -bitmap @TCLSpecs/bitmaps/KFMod.xbm
}
if {$value==10} {
.pretty config -bitmap @TCLSpecs/bitmaps/KFMod.xbm
}
flush stdout
}
proc printWhatz {tag value1 value2 } {
puts stdout [format "%s %i %f" $tag $value1 $value2]
flush stdout
}
proc changePress {value} {
global press
set press $value
puts stdout [format "AfterTouch 0.0 1 %f" $press]
flush stdout
}
proc changePitch {value} {
global pitch
set pitch $value
puts stdout [format "PitchBend 0.0 1 %f" $pitch]
flush stdout
}
scale .bPressure -from 0 -to 128 -length 200 \
-command {changePress } \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Breath Pressure" \
-tickinterval 32 -showvalue true -bg grey66
scale .pitch -from 0 -to 128 -length 200 \
-command {changePitch } \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "MIDI Note Number" \
-tickinterval 32 -showvalue true -bg grey66
scale .cont1 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 2} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Stick/Pick Hardness" \
-tickinterval 32 -showvalue true -bg grey66
scale .cont2 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Strike/Pick Position" \
-tickinterval 32 -showvalue true -bg grey66
scale .cont3 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vibrato Rate" \
-tickinterval 32 -showvalue true -bg grey66
scale .vibrato -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vibrato Amount" \
-tickinterval 32 -showvalue true -bg grey66
. config -bg grey20
# Configure "communications" menu
menu .menu -tearoff 0
menu .menu.communication -tearoff 0
.menu add cascade -label "Communication" -menu .menu.communication \
-underline 0
.menu.communication add radio -label "Console" -variable commtype \
-value "stdout" -command { setComm }
.menu.communication add radio -label "Socket" -variable commtype \
-value "socket" -command { setComm }
. configure -menu .menu
# Configure patch change buttons
frame .plucked -bg black
frame .modal -bg black
frame .fm -bg black
radiobutton .mand -text Mandolin -bg grey66 \
-command { patchChange 4 }
radiobutton .plucked.pluk1 -text Plucked -bg grey66 \
-command { patchChange 4 } -variable patchnum -value 4
radiobutton .plucked.mand -text Mandolin -bg grey66 \
-command { patchChange 5 } -variable patchnum -value 5
radiobutton .modal.mari -text Marimba -bg grey66 \
-command { patchChange 5 }
-command { patchChange 6 } -variable patchnum -value 6
radiobutton .modal.vibr -text Vibraphn -bg grey66 \
-command { patchChange 6 }
-command { patchChange 7 } -variable patchnum -value 7
radiobutton .modal.agog -text AgogoBel -bg grey66 \
-command { patchChange 7 }
-command { patchChange 8 } -variable patchnum -value 8
radiobutton .fm.rhod -text Rhodey -bg grey66 \
-command { patchChange 8 }
-command { patchChange 9 } -variable patchnum -value 9
radiobutton .fm.wurl -text Wurley -bg grey66 \
-command { patchChange 9 }
-command { patchChange 10 } -variable patchnum -value 10
radiobutton .fm.tube -text TubeBell -bg grey66 \
-command { patchChange 10 }
-command { patchChange 11 } -variable patchnum -value 11
pack .mand -padx 5 -pady 10
pack .plucked.pluk1 -side left -padx 5
pack .plucked.mand -side left -padx 5 -pady 10
pack .plucked
pack .modal.mari -side left -padx 5
pack .modal.vibr -side left -padx 5
pack .modal.agog -side left -padx 5 -pady 10
@@ -133,15 +58,18 @@ pack .fm.wurl -side left -padx 5
pack .fm.tube -side left -padx 5 -pady 10
pack .fm
# Configure bitmap display
if {$tcl_platform(platform) == "windows"} {
set bitmappath bitmaps
} else {
set bitmappath TCLSpecs/bitmaps
}
button .pretty -bitmap @$bitmappath/prcFunny.xbm \
-background white -foreground black
.pretty config -bitmap @$bitmappath/prc.xbm
pack .pretty -padx 5 -pady 10
pack .bPressure -padx 10 -pady 10
pack .pitch -padx 10 -pady 10
pack .vibrato -padx 10 -pady 10
pack .cont1 -padx 10 -pady 10
pack .cont2 -padx 10 -pady 10
pack .cont3 -padx 10 -pady 10
# Configure "note-on" buttons
frame .noteOn -bg black
button .noteOn.on -text NoteOn -bg grey66 -command { noteOn $pitch $press }
@@ -151,9 +79,190 @@ pack .noteOn.on -side left -padx 5
pack .noteOn.off -side left -padx 5 -pady 10
pack .noteOn.exit -side left -padx 5 -pady 10
pack .noteOn
# Configure sliders
frame .left -bg black
frame .right -bg black
scale .left.bPressure -from 0 -to 128 -length 250 \
-command {changePress } -variable press \
-orient horizontal -label "Breath Pressure" \
-tickinterval 32 -showvalue true -bg grey66
scale .left.pitch -from 0 -to 128 -length 250 \
-command {changePitch } -variable pitch \
-orient horizontal -label "MIDI Note Number" \
-tickinterval 32 -showvalue true -bg grey66
scale .left.cont1 -from 0 -to 128 -length 250 \
-command {printWhatz "ControlChange 0.0 1 " 2} \
-orient horizontal -label "Stick/Pick Hardness (Mand Body Size)" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont2
scale .right.cont2 -from 0 -to 128 -length 250 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-orient horizontal -label "Strike/Pick Position" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont4
scale .right.cont3 -from 0 -to 128 -length 250 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-orient horizontal -label "Vibrato Rate (String Sustain)" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont11
scale .right.vibrato -from 0 -to 128 -length 250 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-orient horizontal -label "Vibrato Amount (Mand Detune) " \
-tickinterval 32 -showvalue true -bg grey66\
-variable cont1
pack .left.bPressure -padx 10 -pady 10
pack .left.pitch -padx 10 -pady 10
pack .left.cont1 -padx 10 -pady 10
pack .right.cont2 -padx 10 -pady 10
pack .right.cont3 -padx 10 -pady 10
pack .right.vibrato -padx 10 -pady 10
pack .left -side left
pack .right -side right
bind all <KeyPress> {
noteOn $pitch $press
}
pack .noteOn
proc myExit {} {
global pitch
global outID
puts $outID [format "NoteOff 0.0 1 %f 127" $pitch ]
flush $outID
puts $outID [format "ExitProgram"]
flush $outID
close $outID
exit
}
proc noteOn {pitchVal pressVal} {
global outID
puts $outID [format "NoteOn 0.0 1 %f %f" $pitchVal $pressVal]
flush $outID
}
proc noteOff {pitchVal pressVal} {
global outID
puts $outID [format "NoteOff 0.0 1 %f %f" $pitchVal $pressVal]
flush $outID
}
proc patchChange {value} {
global outID
global bitmappath
global cont1
global cont2
global cont4
global cont11
puts $outID [format "ProgramChange 0.0 1 %i" $value]
if {$value==4} {
.pretty config -bitmap @$bitmappath/KPluk.xbm
}
if {$value==5} {
.pretty config -bitmap @$bitmappath/KPluk.xbm
}
if {$value==6} {
.pretty config -bitmap @$bitmappath/KModal.xbm
}
if {$value==7} {
.pretty config -bitmap @$bitmappath/KModal.xbm
}
if {$value==8} {
.pretty config -bitmap @$bitmappath/KModal.xbm
}
if {$value==9} {
.pretty config -bitmap @$bitmappath/KFMod.xbm
}
if {$value==10} {
.pretty config -bitmap @$bitmappath/KFMod.xbm
}
if {$value==11} {
.pretty config -bitmap @$bitmappath/KFMod.xbm
}
flush $outID
set cont1 0.0
set cont2 20.0
set cont4 64.0
set cont11 64.0
}
proc printWhatz {tag value1 value2 } {
global outID
puts $outID [format "%s %i %f" $tag $value1 $value2]
flush $outID
}
proc changePress {value} {
global outID
puts $outID [format "AfterTouch 0.0 1 %f" $value]
flush $outID
}
proc changePitch {value} {
global outID
puts $outID [format "PitchBend 0.0 1 %.3f" $value]
flush $outID
}
# Socket connection procedure
set d .socketdialog
proc setComm {} {
global outID
global commtype
global d
if {$commtype == "stdout"} {
if { [string compare "stdout" $outID] } {
set i [tk_dialog .dialog "Break Socket Connection?" {You are about to break an existing socket connection ... is this what you want to do?} "" 0 Cancel OK]
switch $i {
0 {set commtype "socket"}
1 {close $outID
set outID "stdout"}
}
}
} elseif { ![string compare "stdout" $outID] } {
set sockport 2001
toplevel $d
wm title $d "STK Client Socket Connection"
wm resizable $d 0 0
grab $d
label $d.message -text "Specify a socket port number below (if different than the STK default of 2001) and then click the \"Connect\" button to invoke a socket-client connection attempt to the STK socket server." \
-background white -font {Helvetica 10 bold} \
-wraplength 3i -justify left
frame $d.sockport
entry $d.sockport.entry -width 6
label $d.sockport.text -text "Socket Port Number:" \
-font {Helvetica 10 bold}
pack $d.message -side top -padx 5 -pady 10
pack $d.sockport.text -side left -padx 1 -pady 10
pack $d.sockport.entry -side right -padx 5 -pady 10
pack $d.sockport -side top -padx 5 -pady 10
$d.sockport.entry insert 0 $sockport
frame $d.buttons
button $d.buttons.cancel -text "Cancel" -bg grey66 \
-command { set commtype "stdout"
set outID "stdout"
destroy $d }
button $d.buttons.connect -text "Connect" -bg grey66 \
-command {
set sockport [$d.sockport.entry get]
set err [catch {socket localhost $sockport} outID]
if {$err == 0} {
destroy $d
} else {
tk_dialog $d.error "Socket Error" {Error: Unable to make socket connection. Make sure the STK socket server is first running and that the port number is correct.} "" 0 OK
} }
pack $d.buttons.cancel -side left -padx 5 -pady 10
pack $d.buttons.connect -side right -padx 5 -pady 10
pack $d.buttons -side bottom -padx 5 -pady 10
}
}

View File

@@ -1,116 +1,54 @@
set pitch 64.0
set press 64.0
set cont1 20.0
set cont2 64.0
set cont4 64.0
set cont11 64.0
set outID "stdout"
set commtype "stdout"
set patchnum 16
button .pretty -bitmap @TCLSpecs/bitmaps/prcFunny.xbm \
-background white -foreground black
.pretty config -bitmap @TCLSpecs/bitmaps/prc.xbm
# Configure main window
wm title . "STK Voice Model Controller"
wm iconname . "voice"
. config -bg black
proc myExit {} {
puts stdout [format "ExitProgram"]
flush stdout
exit
}
proc noteOn {pitchVal pressVal} {
puts stdout [format "NoteOn 0.0 1 %f %f" $pitchVal $pressVal]
flush stdout
}
proc noteOff {pitchVal pressVal} {
puts stdout [format "NoteOff 0.0 1 %f %f" $pitchVal $pressVal]
flush stdout
}
proc patchChange {value} {
global .pretty
puts stdout [format "ProgramChange 0.0 1 %i" $value]
if {$value==11} {
.pretty config -bitmap @TCLSpecs/bitmaps/KVoiceFM.xbm
}
if {$value==12} {
.pretty config -bitmap @TCLSpecs/bitmaps/KVoicForm.xbm
}
flush stdout
}
proc printWhatz {tag value1 value2 } {
puts stdout [format "%s %i %f" $tag $value1 $value2]
flush stdout
}
proc changePress {value} {
global press
set press $value
puts stdout [format "AfterTouch 0.0 1 %f" $press]
flush stdout
}
proc changePitch {value} {
global pitch
set pitch $value
puts stdout [format "PitchBend 0.0 1 %f" $pitch]
flush stdout
}
scale .bPressure -from 0 -to 128 -length 200 \
-command {changePress } \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Loudness (Spectral Tilt)" \
-tickinterval 32 -showvalue true -bg grey66
scale .pitch -from 0 -to 128 -length 200 \
-command {changePitch } \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "MIDI Note Number" \
-tickinterval 32 -showvalue true -bg grey66
scale .cont1 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 2} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Formant Q / Voiced/Un." \
-tickinterval 32 -showvalue true -bg grey66
scale .cont2 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vowel (Bass, Tenor, Alto, Sop.)" \
-tickinterval 32 -showvalue true -bg grey66
scale .cont3 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vibrato Rate" \
-tickinterval 32 -showvalue true -bg grey66
scale .vibrato -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-activeforeground white -sliderforeground grey80\
-orient horizontal -label "Vibrato Amount" \
-tickinterval 32 -showvalue true -bg grey66
. config -bg grey20
# Configure "communications" menu
menu .menu -tearoff 0
menu .menu.communication -tearoff 0
.menu add cascade -label "Communication" -menu .menu.communication \
-underline 0
.menu.communication add radio -label "Console" -variable commtype \
-value "stdout" -command { setComm }
.menu.communication add radio -label "Socket" -variable commtype \
-value "socket" -command { setComm }
. configure -menu .menu
# Configure patch change buttons
frame .instChoice -bg black
radiobutton .instChoice.fm -text FMVoice -bg grey66 \
-command { patchChange 11 }
radiobutton .instChoice.form -text Formant -bg grey66 \
-command { patchChange 12 }
radiobutton .instChoice.fm -text "FMVoice" -bg grey66 \
-command { patchChange 16 } -value 16 -variable patchnum
radiobutton .instChoice.form -text "Formant" -bg grey66 \
-command { patchChange 17 } -value 17 -variable patchnum
pack .instChoice.fm -side left -padx 5
pack .instChoice.form -side left -padx 5 -pady 10
pack .instChoice
pack .instChoice -side top
# Configure bitmap display
if {$tcl_platform(platform) == "windows"} {
set bitmappath bitmaps
} else {
set bitmappath TCLSpecs/bitmaps
}
button .pretty -bitmap @$bitmappath/prcFunny.xbm \
-background white -foreground black
.pretty config -bitmap @$bitmappath/prc.xbm
pack .pretty -padx 5 -pady 10
pack .bPressure -padx 10 -pady 10
pack .pitch -padx 10 -pady 10
pack .vibrato -padx 10 -pady 10
pack .cont1 -padx 10 -pady 10
pack .cont2 -padx 10 -pady 10
pack .cont3 -padx 10 -pady 10
# Configure "note-on" buttons
frame .noteOn -bg black
button .noteOn.on -text NoteOn -bg grey66 -command { noteOn $pitch $press }
@@ -122,3 +60,166 @@ pack .noteOn.exit -side left -padx 5 -pady 10
pack .noteOn
# Configure sliders
frame .left -bg black
frame .right -bg black
scale .left.bPressure -from 0 -to 128 -length 200 \
-command {changePress } -variable press \
-orient horizontal -label "Loudness (Spectral Tilt)" \
-tickinterval 32 -showvalue true -bg grey66
scale .left.pitch -from 0 -to 128 -length 200 \
-command {changePitch } -variable pitch \
-orient horizontal -label "MIDI Note Number" \
-tickinterval 32 -showvalue true -bg grey66
scale .left.cont1 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 2} \
-orient horizontal -label "Formant Q / Voiced/Un." \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont2
scale .right.cont2 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 4} \
-orient horizontal -label "Vowel (Bass, Tenor, Alto, Sop.)" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont4
scale .right.cont3 -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 11} \
-orient horizontal -label "Vibrato Rate" \
-tickinterval 32 -showvalue true -bg grey66 \
-variable cont11
scale .right.vibrato -from 0 -to 128 -length 200 \
-command {printWhatz "ControlChange 0.0 1 " 1} \
-orient horizontal -label "Vibrato Amount" \
-tickinterval 32 -showvalue true -bg grey66\
-variable cont1
pack .left.bPressure -padx 10 -pady 10
pack .left.pitch -padx 10 -pady 10
pack .left.cont1 -padx 10 -pady 10
pack .right.cont2 -padx 10 -pady 10
pack .right.cont3 -padx 10 -pady 10
pack .right.vibrato -padx 10 -pady 10
pack .left -side left
pack .right -side right
proc myExit {} {
global pitch
global outID
puts $outID [format "NoteOff 0.0 1 %f 127" $pitch ]
flush $outID
puts $outID [format "ExitProgram"]
flush $outID
close $outID
exit
}
proc noteOn {pitchVal pressVal} {
global outID
puts $outID [format "NoteOn 0.0 1 %f %f" $pitchVal $pressVal]
flush $outID
}
proc noteOff {pitchVal pressVal} {
global outID
puts $outID [format "NoteOff 0.0 1 %f %f" $pitchVal $pressVal]
flush $outID
}
proc patchChange {value} {
global outID
global bitmappath
global cont1
global cont2
global cont4
global cont11
puts $outID [format "ProgramChange 0.0 1 %i" $value]
if {$value==16} {
.pretty config -bitmap @$bitmappath/KVoiceFM.xbm
}
if {$value==17} {
.pretty config -bitmap @$bitmappath/KVoicForm.xbm
}
flush $outID
set cont1 0.0
set cont2 20.0
set cont4 64.0
set cont11 64.0
}
proc printWhatz {tag value1 value2 } {
global outID
puts $outID [format "%s %i %f" $tag $value1 $value2]
flush $outID
}
proc changePress {value} {
global outID
puts $outID [format "AfterTouch 0.0 1 %f" $value]
flush $outID
}
proc changePitch {value} {
global outID
puts $outID [format "PitchBend 0.0 1 %.3f" $value]
flush $outID
}
# Socket connection procedure
set d .socketdialog
proc setComm {} {
global outID
global commtype
global d
if {$commtype == "stdout"} {
if { [string compare "stdout" $outID] } {
set i [tk_dialog .dialog "Break Socket Connection?" {You are about to break an existing socket connection ... is this what you want to do?} "" 0 Cancel OK]
switch $i {
0 {set commtype "socket"}
1 {close $outID
set outID "stdout"}
}
}
} elseif { ![string compare "stdout" $outID] } {
set sockport 2001
toplevel $d
wm title $d "STK Client Socket Connection"
wm resizable $d 0 0
grab $d
label $d.message -text "Specify a socket port number below (if different than the STK default of 2001) and then click the \"Connect\" button to invoke a socket-client connection attempt to the STK socket server." \
-background white -font {Helvetica 10 bold} \
-wraplength 3i -justify left
frame $d.sockport
entry $d.sockport.entry -width 6
label $d.sockport.text -text "Socket Port Number:" \
-font {Helvetica 10 bold}
pack $d.message -side top -padx 5 -pady 10
pack $d.sockport.text -side left -padx 1 -pady 10
pack $d.sockport.entry -side right -padx 5 -pady 10
pack $d.sockport -side top -padx 5 -pady 10
$d.sockport.entry insert 0 $sockport
frame $d.buttons
button $d.buttons.cancel -text "Cancel" -bg grey66 \
-command { set commtype "stdout"
set outID "stdout"
destroy $d }
button $d.buttons.connect -text "Connect" -bg grey66 \
-command {
set sockport [$d.sockport.entry get]
set err [catch {socket localhost $sockport} outID]
if {$err == 0} {
destroy $d
} else {
tk_dialog $d.error "Socket Error" {Error: Unable to make socket connection. Make sure the STK socket server is first running and that the port number is correct.} "" 0 OK
} }
pack $d.buttons.cancel -side left -padx 5 -pady 10
pack $d.buttons.connect -side right -padx 5 -pady 10
pack $d.buttons -side bottom -padx 5 -pady 10
}
}