[PD-cvs] SF.net SVN: pure-data:[10716] branches/pd-devel/0.41.4/src
eighthave at users.sourceforge.net
eighthave at users.sourceforge.net
Mon Feb 2 17:35:29 CET 2009
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.
More information about the Pd-cvs
mailing list