Revision: 10716 http://pure-data.svn.sourceforge.net/pure-data/?rev=10716&view=rev Author: eighthave Date: 2009-02-02 16:35:29 +0000 (Mon, 02 Feb 2009)

Log Message: ----------- - copied over gatom code from u_main.tk and got it running. It still needs some serious cleanup.

- cleaned up the importing of pd_connect::pdsend. It is now imported into the global namespace in pd.tk since pdsend is used in every package

- cleaned up some variable names and formatting, added comments

Modified Paths: -------------- branches/pd-devel/0.41.4/src/pd.tk branches/pd-devel/0.41.4/src/pd_bindings.tcl branches/pd-devel/0.41.4/src/pd_menucommands.tcl branches/pd-devel/0.41.4/src/pdtk_array.tcl branches/pd-devel/0.41.4/src/pdtk_canvas.tcl branches/pd-devel/0.41.4/src/pkgIndex.tcl

Added Paths: ----------- branches/pd-devel/0.41.4/src/gatom.tcl

Added: branches/pd-devel/0.41.4/src/gatom.tcl =================================================================== --- branches/pd-devel/0.41.4/src/gatom.tcl (rev 0) +++ branches/pd-devel/0.41.4/src/gatom.tcl 2009-02-02 16:35:29 UTC (rev 10716) @@ -0,0 +1,229 @@ + +package provide gatom 0.1 + +package require wheredoesthisgo + +namespace eval ::gatom:: { + namespace export pdtk_gatom_dialog +} + +############ 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 ::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 ::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 + ::gatom::apply $mytoplevel +} + +proc ::gatom::apply {mytoplevel} { + set vid [string trimleft $mytoplevel .] + + # TODO replace this $$/global stuff by setting the values that were given + # to use by Pd directly to the entry boxes, then when calling the apply + # proc, use [$myentry get] + set var_gatomwidth [concat gatomwidth_$vid] + global $var_gatomwidth + set var_gatomlo [concat gatomlo_$vid] + global $var_gatomlo + set var_gatomhi [concat gatomhi_$vid] + global $var_gatomhi + set var_gatomwherelabel [concat gatomwherelabel_$vid] + global $var_gatomwherelabel + set var_gatomlabel [concat gatomlabel_$vid] + global $var_gatomlabel + set var_gatomsymfrom [concat gatomsymfrom_$vid] + global $var_gatomsymfrom + set var_gatomsymto [concat gatomsymto_$vid] + global $var_gatomsymto + + # set cmd [concat $id param $gatomwidth $gatomlo $gatomhi ;] + + set cmd [concat $mytoplevel param \ + [eval concat $$var_gatomwidth] \ + [eval concat $$var_gatomlo] \ + [eval concat $$var_gatomhi] \ + [eval ::gatom::escape $$var_gatomlabel] \ + [eval concat $$var_gatomwherelabel] \ + [eval ::gatom::escape $$var_gatomsymfrom] \ + [eval ::gatom::escape $$var_gatomsymto] \ + ;] + + # puts stderr $cmd + pdsend $cmd +} + + +proc gatom_cancel {mytoplevel} { + # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings + # is sorted out + ::gatom::cancel $mytoplevel +} +proc ::gatom::cancel {mytoplevel} { + pdsend "$mytoplevel cancel" +} + + +proc gatom_ok {mytoplevel} { + # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings + # is sorted out + ::gatom::ok $mytoplevel +} +proc ::gatom::ok {mytoplevel} { + ::gatom::apply $mytoplevel + ::gatom::cancel $mytoplevel +} + +proc ::gatom::pdtk_gatom_dialog {mytoplevel initwidth initlo inithi \ + wherelabel label symfrom symto} { + + set vid [string trimleft $mytoplevel .] + + # TODO replace this $$/global stuff by setting the values that were given + # to use by Pd directly to the entry boxes, then when calling the apply + # proc, use [$myentry get] + set var_gatomwidth [concat gatomwidth_$vid] + global $var_gatomwidth + set var_gatomlo [concat gatomlo_$vid] + global $var_gatomlo + set var_gatomhi [concat gatomhi_$vid] + global $var_gatomhi + set var_gatomwherelabel [concat gatomwherelabel_$vid] + global $var_gatomwherelabel + set var_gatomlabel [concat gatomlabel_$vid] + global $var_gatomlabel + set var_gatomsymfrom [concat gatomsymfrom_$vid] + global $var_gatomsymfrom + set var_gatomsymto [concat gatomsymto_$vid] + global $var_gatomsymto + + set $var_gatomwidth $initwidth + set $var_gatomlo $initlo + set $var_gatomhi $inithi + set $var_gatomwherelabel $wherelabel + set $var_gatomlabel [::gatom::unescape $label] + set $var_gatomsymfrom [::gatom::unescape $symfrom] + set $var_gatomsymto [::gatom::unescape $symto] + + toplevel $mytoplevel + wm title $mytoplevel "atom box properties" + wm resizable $mytoplevel 0 0 + wm protocol $mytoplevel WM_DELETE_WINDOW "::gatom::cancel $mytoplevel" + + ::pd_bindings::panel_bindings $mytoplevel "gatom" + + frame $mytoplevel.params -height 7 + pack $mytoplevel.params -side top + label $mytoplevel.params.entryname -text "width" + entry $mytoplevel.params.entry -textvariable $var_gatomwidth -width 4 + pack $mytoplevel.params.entryname $mytoplevel.params.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.entryname -text "lower" + entry $mytoplevel.limits.lower.entry -textvariable $var_gatomlo -width 8 + pack $mytoplevel.limits.lower.entryname $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.entryname -text "upper" + entry $mytoplevel.limits.upper.entry -textvariable $var_gatomhi -width 8 + pack $mytoplevel.limits.upper.spacer $mytoplevel.limits.upper.entryname \ + $mytoplevel.limits.upper.entry -side left + + frame $mytoplevel.spacer1 -height 7 + pack $mytoplevel.spacer1 -side top + + labelframe $mytoplevel.label -text "label" -padx 5 -pady 4 -borderwidth 1 \ + -font highlight_font + pack $mytoplevel.label -side top -fill x + frame $mytoplevel.label.name + pack $mytoplevel.label.name -side top + entry $mytoplevel.label.name.entry -textvariable $var_gatomlabel -width 33 + pack $mytoplevel.label.name.entry -side left + frame $mytoplevel.label.radio + pack $mytoplevel.label.radio -side top + radiobutton $mytoplevel.label.radio.left -value 0 \ + -variable $var_gatomwherelabel \ + -text "left " -justify left + radiobutton $mytoplevel.label.radio.right -value 1 \ + -variable $var_gatomwherelabel \ + -text "right" -justify left + radiobutton $mytoplevel.label.radio.top -value 2 \ + -variable $var_gatomwherelabel \ + -text "top" -justify left + radiobutton $mytoplevel.label.radio.bottom -value 3 \ + -variable $var_gatomwherelabel \ + -text "bottom" -justify left + pack $mytoplevel.label.radio.left -side left -anchor w + pack $mytoplevel.label.radio.right -side right -anchor w + pack $mytoplevel.label.radio.top -side top -anchor w + pack $mytoplevel.label.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.paramsymto + pack $mytoplevel.s_r.paramsymto -side top -anchor e + label $mytoplevel.s_r.paramsymto.entryname -text "send symbol" + entry $mytoplevel.s_r.paramsymto.entry -textvariable $var_gatomsymto -width 21 + pack $mytoplevel.s_r.paramsymto.entry $mytoplevel.s_r.paramsymto.entryname -side right + + frame $mytoplevel.s_r.paramsymfrom + pack $mytoplevel.s_r.paramsymfrom -side top -anchor e + label $mytoplevel.s_r.paramsymfrom.entryname -text "receive symbol" + entry $mytoplevel.s_r.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 21 + pack $mytoplevel.s_r.paramsymfrom.entry $mytoplevel.s_r.paramsymfrom.entryname -side right + + frame $mytoplevel.buttonframe -pady 5 + pack $mytoplevel.buttonframe -side top -fill x -pady 2m + button $mytoplevel.buttonframe.cancel -text {Cancel}\ + -command "::gatom::cancel $mytoplevel" + pack $mytoplevel.buttonframe.cancel -side left -expand 1 + button $mytoplevel.buttonframe.apply -text {Apply}\ + -command "::gatom::apply $mytoplevel" + pack $mytoplevel.buttonframe.apply -side left -expand 1 + button $mytoplevel.buttonframe.ok -text {OK}\ + -command "::gatom::ok $mytoplevel" + pack $mytoplevel.buttonframe.ok -side left -expand 1 + + $mytoplevel.params.entry select from 0 + $mytoplevel.params.entry select adjust end + focus $mytoplevel.params.entry +}

Modified: branches/pd-devel/0.41.4/src/pd.tk =================================================================== --- branches/pd-devel/0.41.4/src/pd.tk 2009-02-02 14:14:28 UTC (rev 10715) +++ branches/pd-devel/0.41.4/src/pd.tk 2009-02-02 16:35:29 UTC (rev 10716) @@ -60,6 +60,7 @@ package require pd_menus package require pd_bindings package require pd_post +package require gatom package require pd_iemgui package require pdtk_array package require pdtk_canvas @@ -68,9 +69,10 @@ package require wheredoesthisgo

# import into the global namespace for backwards compatibility +namespace import ::pd_connect::pdsend namespace import ::pd_post::pdtk_post -namespace import ::pd_connect::pdsend namespace import ::pd_iemgui::pdtk_iemgui_dialog +namespace import ::gatom::pdtk_gatom_dialog

#------------------------------------------------------------------------------# # coding style

Modified: branches/pd-devel/0.41.4/src/pd_bindings.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-02-02 14:14:28 UTC (rev 10715) +++ branches/pd-devel/0.41.4/src/pd_bindings.tcl 2009-02-02 16:35:29 UTC (rev 10716) @@ -68,6 +68,9 @@ bind $mytoplevel <FocusIn> "window_focusin %W" }

+# this is for the panels: find, font, sendmessage, gatom properties, array +# properties, iemgui properties, canvas properties, data structures +# properties, Audio setup, and MIDI setup proc ::pd_bindings::panel_bindings {mytoplevel panelname} { variable modifier

Modified: branches/pd-devel/0.41.4/src/pd_menucommands.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-02-02 14:14:28 UTC (rev 10715) +++ branches/pd-devel/0.41.4/src/pd_menucommands.tcl 2009-02-02 16:35:29 UTC (rev 10716) @@ -7,7 +7,6 @@ variable untitled_number "1"

namespace export menu_* - }

# ------------------------------------------------------------------------------ @@ -91,7 +90,8 @@ wm deiconify .find raise .find } else { - # TODO insert real find panel here + # TODO figure out findagain + # TODO make targetlabel into a popup menu toplevel .find wm title .find [_ "Find"] wm geometry .find =475x125+150+150

Modified: branches/pd-devel/0.41.4/src/pdtk_array.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pdtk_array.tcl 2009-02-02 14:14:28 UTC (rev 10715) +++ branches/pd-devel/0.41.4/src/pdtk_array.tcl 2009-02-02 16:35:29 UTC (rev 10716) @@ -1,7 +1,5 @@ package provide pdtk_array 0.1

-package require pd_connect - #### jsarlo ##### proc pdtk_array_listview_setpage {arrayName page} { global pd_array_listview_page

Modified: branches/pd-devel/0.41.4/src/pdtk_canvas.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-02-02 14:14:28 UTC (rev 10715) +++ branches/pd-devel/0.41.4/src/pdtk_canvas.tcl 2009-02-02 16:35:29 UTC (rev 10716) @@ -102,11 +102,19 @@ pdtk_pastetext }

+ #------------------------------------------------------------------------------# +# canvas font + +proc pdtk_canvas_dofont {mytoplevel initsize} { + # TODO this should just bring up the Font panel +} + +#------------------------------------------------------------------------------# # canvas popup menu

-proc popup_action {name action} { - pdsend "$name done-popup $action $::popup_xpix $::popup_ypix" +proc popup_action {mytoplevel action} { + pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix" }

proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {

Modified: branches/pd-devel/0.41.4/src/pkgIndex.tcl =================================================================== --- branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-02-02 14:14:28 UTC (rev 10715) +++ branches/pd-devel/0.41.4/src/pkgIndex.tcl 2009-02-02 16:35:29 UTC (rev 10716) @@ -11,6 +11,7 @@ package ifneeded apple_events 0.1 [list source [file join $dir apple_events.tcl]] package ifneeded pd_bindings 0.1 [list source [file join $dir pd_bindings.tcl]] package ifneeded pd_connect 0.1 [list source [file join $dir pd_connect.tcl]] +package ifneeded gatom 0.1 [list source [file join $dir gatom.tcl]] package ifneeded pd_iemgui 0.1 [list source [file join $dir pd_iemgui.tcl]] package ifneeded pd_menucommands 0.1 [list source [file join $dir pd_menucommands.tcl]] package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.