mirror of
https://github.com/thestk/stk
synced 2026-04-26 00:58:37 +00:00
Version 2.01
This commit is contained in:
committed by
Stephen Sinclair
parent
6485746ee9
commit
ea749b71d2
BIN
TCLSpecs/.swp
Normal file
BIN
TCLSpecs/.swp
Normal file
Binary file not shown.
2
TCLSpecs/GUIDrums
Executable file
2
TCLSpecs/GUIDrums
Executable file
@@ -0,0 +1,2 @@
|
||||
cd ..
|
||||
wish < TCLSpecs/TCLDrums.tcl | syntmono DrumSynt -r -i
|
||||
@@ -1,2 +1,2 @@
|
||||
cd ..
|
||||
wish < TCLSpecs/TCLPhys.tcl | testTextIn Clarinet
|
||||
wish < TCLSpecs/TCLPhys.tcl | syntmono Clarinet -r -i
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
cd ..
|
||||
wish < TCLSpecs/TCLStruk.tcl | testTextIn Mandolin
|
||||
wish < TCLSpecs/TCLStruk.tcl | syntmono Mandolin -r -i
|
||||
|
||||
2
TCLSpecs/GUIShakers
Executable file
2
TCLSpecs/GUIShakers
Executable file
@@ -0,0 +1,2 @@
|
||||
cd ..
|
||||
wish < TCLSpecs/TCLShakers.tcl | syntmono Maraca -r -i
|
||||
@@ -1,2 +1,2 @@
|
||||
cd ..
|
||||
wish < TCLSpecs/TCLVoice.tcl | testTextIn FMVoices
|
||||
wish < TCLSpecs/TCLVoice.tcl | syntmono FMVoices -r -i
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
cd ..
|
||||
testMIDI | testTextIn Clarinet
|
||||
MD2SKINI | syntmono Clarinet -r -i
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
cd ..
|
||||
testMIDI | testTextIn Mandolin
|
||||
MD2SKINI | syntmono Mandolin -r -i
|
||||
|
||||
@@ -1,2 +1,2 @@
|
||||
cd ..
|
||||
testMIDI | testTextIn FMVoices
|
||||
MD2SKINI | syntmono FMVoices -r -i
|
||||
|
||||
152
TCLSpecs/TCLDrums.tcl
Normal file
152
TCLSpecs/TCLDrums.tcl
Normal 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
|
||||
}
|
||||
}
|
||||
@@ -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
195
TCLSpecs/TCLShakers.tcl
Normal 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
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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
|
||||
}
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user