diff options
Diffstat (limited to 'pd/tcl/dialog_gatom.tcl')
| -rw-r--r-- | pd/tcl/dialog_gatom.tcl | 211 |
1 files changed, 211 insertions, 0 deletions
diff --git a/pd/tcl/dialog_gatom.tcl b/pd/tcl/dialog_gatom.tcl new file mode 100644 index 00000000..e377657f --- /dev/null +++ b/pd/tcl/dialog_gatom.tcl @@ -0,0 +1,211 @@ + +package provide dialog_gatom 0.1 + +package require wheredoesthisgo + +namespace eval ::dialog_gatom:: { + namespace export pdtk_gatom_dialog +} + +# hashtable for communicating the position of the radiobuttons (Tk's +# radiobutton widget requires this to be global) +global gatomlabel_position + +############ pdtk_gatom_dialog -- run a gatom dialog ######### + +# dialogs like this one can come up in many copies; but in TK the easiest +# way to get data from an "entry", etc., is to set an associated variable +# name. This is especially true for grouped "radio buttons". So we have +# to synthesize variable names for each instance of the dialog. The dialog +# gets a TK pathname $id, from which it strips the leading "." to make a +# variable suffix $vid. Then you can get the actual value out by asking for +# [eval concat $$variablename]. There should be an easier way but I don't see +# it yet. + +proc ::dialog_gatom::escape {sym} { + if {[string length $sym] == 0} { + set ret "-" + } else { + if {[string equal -length 1 $sym "-"]} { + set ret [string replace $sym 0 0 "--"] + } else { + set ret [string map {"$" "#"} $sym] + } + } + return [unspace_text $ret] +} + +proc ::dialog_gatom::unescape {sym} { + if {[string equal -length 1 $sym "-"]} { + set ret [string replace $sym 0 0 ""] + } else { + set ret [string map {"#" "$"} $sym] + } + return $ret +} + +proc gatom_apply {mytoplevel} { + # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings + # is sorted out + ::dialog_gatom::apply $mytoplevel +} + +proc ::dialog_gatom::apply {mytoplevel} { + global gatomlabel_position + + pdsend "$mytoplevel param \ + [$mytoplevel.width.entry get] \ + [$mytoplevel.limits.lower.entry get] \ + [$mytoplevel.limits.upper.entry get] \ + [::dialog_gatom::escape [$mytoplevel.gatomlabel.name.entry get]] \ + $gatomlabel_position($mytoplevel) \ + [::dialog_gatom::escape [$mytoplevel.s_r.send.entry get]] \ + [::dialog_gatom::escape [$mytoplevel.s_r.receive.entry get]]" +} + + +proc gatom_cancel {mytoplevel} { + # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings + # is sorted out + ::dialog_gatom::cancel $mytoplevel +} + +proc ::dialog_gatom::cancel {mytoplevel} { + pdsend "$mytoplevel cancel" +} + + +proc gatom_ok {mytoplevel} { + # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings + # is sorted out + ::dialog_gatom::ok $mytoplevel +} +proc ::dialog_gatom::ok {mytoplevel} { + ::dialog_gatom::apply $mytoplevel + ::dialog_gatom::cancel $mytoplevel +} + +# set up the panel with the info from pd +proc ::dialog_gatom::pdtk_gatom_dialog {mytoplevel initwidth initlower \ + initupper initgatomlabel_position initgatomlabel initsend initreceive} { + global gatomlabel_position + set gatomlabel_position($mytoplevel) $initgatomlabel_position + + if {[winfo exists $mytoplevel]} { + wm deiconify $mytoplevel + raise $mytoplevel + } else { + create_panel $mytoplevel + } + + $mytoplevel.width.entry insert 0 $initwidth + $mytoplevel.limits.lower.entry insert 0 $initlower + $mytoplevel.limits.upper.entry insert 0 $initupper + if {$initgatomlabel ne "-"} { + $mytoplevel.gatomlabel.name.entry insert 0 $initgatomlabel + } + set gatomlabel_position($mytoplevel) $initgatomlabel_position + if {$initsend ne "-"} { + $mytoplevel.s_r.send.entry insert 0 $initsend + } + if {$initreceive ne "-"} { + $mytoplevel.s_r.receive.entry insert 0 $initreceive + } +} + +proc ::dialog_gatom::create_panel {mytoplevel} { + global gatomlabel_position + + toplevel $mytoplevel + wm title $mytoplevel "atom box properties" + wm resizable $mytoplevel 0 0 + catch { # not all platforms/Tcls versions have these options + wm attributes $mytoplevel -topmost 1 + #wm attributes $mytoplevel -transparent 1 + #$mytoplevel configure -highlightthickness 1 + } + wm protocol $mytoplevel WM_DELETE_WINDOW "::dialog_gatom::cancel $mytoplevel" + + ::pd_bindings::panel_bindings $mytoplevel "gatom" + + frame $mytoplevel.width -height 7 + pack $mytoplevel.width -side top + label $mytoplevel.width.label -text "width" + entry $mytoplevel.width.entry -width 4 + pack $mytoplevel.width.label $mytoplevel.width.entry -side left + + labelframe $mytoplevel.limits -text "limits" -padx 15 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $mytoplevel.limits -side top -fill x + frame $mytoplevel.limits.lower + pack $mytoplevel.limits.lower -side left + label $mytoplevel.limits.lower.label -text "lower" + entry $mytoplevel.limits.lower.entry -width 8 + pack $mytoplevel.limits.lower.label $mytoplevel.limits.lower.entry -side left + frame $mytoplevel.limits.upper + pack $mytoplevel.limits.upper -side left + frame $mytoplevel.limits.upper.spacer -width 20 + label $mytoplevel.limits.upper.label -text "upper" + entry $mytoplevel.limits.upper.entry -width 8 + pack $mytoplevel.limits.upper.spacer $mytoplevel.limits.upper.label \ + $mytoplevel.limits.upper.entry -side left + + frame $mytoplevel.spacer1 -height 7 + pack $mytoplevel.spacer1 -side top + + labelframe $mytoplevel.gatomlabel -text "label" -padx 5 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $mytoplevel.gatomlabel -side top -fill x + frame $mytoplevel.gatomlabel.name + pack $mytoplevel.gatomlabel.name -side top + entry $mytoplevel.gatomlabel.name.entry -width 33 + pack $mytoplevel.gatomlabel.name.entry -side left + frame $mytoplevel.gatomlabel.radio + pack $mytoplevel.gatomlabel.radio -side top + radiobutton $mytoplevel.gatomlabel.radio.left -value 0 -text "left " \ + -variable gatomlabel_position($mytoplevel) -justify left -takefocus 0 + radiobutton $mytoplevel.gatomlabel.radio.right -value 1 -text "right" \ + -variable gatomlabel_position($mytoplevel) -justify left -takefocus 0 + radiobutton $mytoplevel.gatomlabel.radio.top -value 2 -text "top" \ + -variable gatomlabel_position($mytoplevel) -justify left -takefocus 0 + radiobutton $mytoplevel.gatomlabel.radio.bottom -value 3 -text "bottom" \ + -variable gatomlabel_position($mytoplevel) -justify left -takefocus 0 + pack $mytoplevel.gatomlabel.radio.left -side left -anchor w + pack $mytoplevel.gatomlabel.radio.right -side right -anchor w + pack $mytoplevel.gatomlabel.radio.top -side top -anchor w + pack $mytoplevel.gatomlabel.radio.bottom -side bottom -anchor w + + frame $mytoplevel.spacer2 -height 7 + pack $mytoplevel.spacer2 -side top + + labelframe $mytoplevel.s_r -text "messages" -padx 5 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $mytoplevel.s_r -side top -fill x + frame $mytoplevel.s_r.send + pack $mytoplevel.s_r.send -side top -anchor e + label $mytoplevel.s_r.send.label -text "send symbol" + entry $mytoplevel.s_r.send.entry -width 21 + pack $mytoplevel.s_r.send.entry $mytoplevel.s_r.send.label -side right + + frame $mytoplevel.s_r.receive + pack $mytoplevel.s_r.receive -side top -anchor e + label $mytoplevel.s_r.receive.label -text "receive symbol" + entry $mytoplevel.s_r.receive.entry -width 21 + pack $mytoplevel.s_r.receive.entry $mytoplevel.s_r.receive.label -side right + + frame $mytoplevel.buttonframe -pady 5 + pack $mytoplevel.buttonframe -side top -fill x -pady 2m + button $mytoplevel.buttonframe.cancel -text {Cancel} \ + -command "::dialog_gatom::cancel $mytoplevel" + pack $mytoplevel.buttonframe.cancel -side left -expand 1 + button $mytoplevel.buttonframe.apply -text {Apply} \ + -command "::dialog_gatom::apply $mytoplevel" + pack $mytoplevel.buttonframe.apply -side left -expand 1 + button $mytoplevel.buttonframe.ok -text {OK} \ + -command "::dialog_gatom::ok $mytoplevel" + pack $mytoplevel.buttonframe.ok -side left -expand 1 + + $mytoplevel.width.entry select from 0 + $mytoplevel.width.entry select adjust end + focus $mytoplevel.width.entry +} |