nsliders.tk

#
# Controls via sliders for csound in tcl/tk
# John ffitch 2000 May 14
#  Modified for stdin/out use May 21
#  2001 January: added text boxes
#

# Create a new slider
proc displayslider num {
    global lastsl
    set sl ".s$num"
    set ex [winfo exists $sl]
    if {$ex == 0} {
        scale $sl -label Control$num -from 0 -to 127 -orient horizontal -length 10c -command "newval $num"
        pack $sl -after $lastsl
        set lastsl $sl
    }
}

proc newval {num val} {
    puts "$num $val"
}

# Output controls

proc setvalue {which val} {
    set sl ".s$which"
    displayslider $which
    $sl set $val
}

proc setmin {which val} {
    set sl ".s$which"
    displayslider $which
    $sl configure -from $val
}

proc setmax {which val} {
    set sl ".s$which"
    displayslider $which
    $sl configure -to $val
}

proc setlab {which val} {
    set sl ".s$which"
    displayslider $which
    $sl configure -label $val
}

# AND NOW THE BUTTONS AND CHECKS

# Create a new button
proc displaybutton num {
    global lastb
    set bt ".b$num"
    set ex [winfo exists $bt]
    if {$ex == 0} {
        button $bt -text Button$num -command "buttonpush $num"
        pack $bt -pady 2m -after $lastb
        set lastb $bt
    }
}

proc buttonpush num {
    puts "0 $num"
}

# Create a new check
proc displaycheck num {
    global xxx
    set ch ".x$num"
    set ex [winfo exists $ch]
    if {$ex == 0} {
        checkbutton $ch -text Check$num -variable xxx -command "checkpush $num"
        pack $ch -pady 2m
    }
}

proc checkpush num {
    global xxx
    puts "-$num $xxx"
}

proc settext {num txt} {
    global lasttxt
    set wl ".flashtxt$num"
    set ex [winfo exists $wl]
    if {$ex == 0} {
        toplevel $wl
        message $wl.msg -text $txt -width 10c -justify left -relief raised -bd 2
        pack $wl.msg
    } else {
        $wl.msg configure -text $txt
    }
}

proc deltext num {
    set wl ".txt$num"
    destroy $wl
}

# ending

message .title -width 10c -justify center -font -*-times-bold-r-normal--*-180-*-*-*-*-*-* -text "Csound Controls"
pack .title
set lastsl .title
message .title1 -width 10c -justify center -font -*-times-bold-r-normal--*-100-*-*-*-*-*-* -text " "
pack .title1
set lastb .title1
#displayslider 1
# # # Experimental
#  displayslider 2
#  displaybutton 1
#  displayslider 3
#  displaybutton 2
#  displaycheck 1
# # # End

puts "Ready"