aboutsummaryrefslogtreecommitdiff
path: root/pd/tcl
diff options
context:
space:
mode:
authorMiller Puckette <millerpuckette@users.sourceforge.net>2009-08-17 23:31:36 +0000
committerMiller Puckette <millerpuckette@users.sourceforge.net>2009-08-17 23:31:36 +0000
commit282671282b20fa17ab9dbbaba9d1cf2246b5029d (patch)
treef7af53ee269efd2564ca872a4da187e1ae687f3b /pd/tcl
parent76d1c8472e025126a4b3e1571f817198b2fec9f9 (diff)
merge in new tcl implementation by Steiner & Chun
svn path=/trunk/; revision=11934
Diffstat (limited to 'pd/tcl')
-rw-r--r--pd/tcl/AppMain.tcl27
-rw-r--r--pd/tcl/apple_events.tcl53
-rw-r--r--pd/tcl/dialog_find.tcl94
-rw-r--r--pd/tcl/dialog_font.tcl107
-rw-r--r--pd/tcl/dialog_gatom.tcl211
-rw-r--r--pd/tcl/dialog_iemgui.tcl780
-rw-r--r--pd/tcl/pd.tcl315
-rw-r--r--pd/tcl/pd_bindings.tcl201
-rw-r--r--pd/tcl/pd_connect.tcl90
-rw-r--r--pd/tcl/pd_menucommands.tcl167
-rw-r--r--pd/tcl/pd_menus.tcl355
-rw-r--r--pd/tcl/pdtk_array.tcl346
-rw-r--r--pd/tcl/pdtk_canvas.tcl152
-rw-r--r--pd/tcl/pdtk_text.tcl20
-rw-r--r--pd/tcl/pkgIndex.tcl23
-rwxr-xr-xpd/tcl/pkg_mkIndex.tcl9
-rw-r--r--pd/tcl/wheredoesthisgo.tcl1054
17 files changed, 4004 insertions, 0 deletions
diff --git a/pd/tcl/AppMain.tcl b/pd/tcl/AppMain.tcl
new file mode 100644
index 00000000..26adc832
--- /dev/null
+++ b/pd/tcl/AppMain.tcl
@@ -0,0 +1,27 @@
+# This file is for the Wish.app on Mac OS X. It is only used when a Wish.app
+# is loading embedded pd code on Mac OS X. It is completely unused on any
+# other configuration, like when 'pd' launches Wish.app or when 'pd' is using
+# an X11 wish on Mac OS X. GNU/Linux and Windows will never use this file.
+
+
+puts --------------------------AppMain.tcl-----------------------------------
+catch {console show}
+
+# FIXME apple_events must require a newer tcl than 8.4?
+# package require apple_events
+
+puts "AppMain.tcl"
+puts "argv0: $argv0"
+puts "executable: [info nameofexecutable]"
+puts "argc: $argc argv: $argv"
+
+# TODO is there anything useful to do with the psn (Process Serial Number)?
+if {[string first "-psn" [lindex $argv 0]] == 0} {
+ set argv [lrange $argv 1 end]
+ set argc [expr $argc - 1]
+}
+
+# launch pd.tk here
+if [catch {source [file join [file dirname [info script]] ../tcl/pd.tcl]}] {
+ puts stderr $errorInfo
+}
diff --git a/pd/tcl/apple_events.tcl b/pd/tcl/apple_events.tcl
new file mode 100644
index 00000000..b52dcdba
--- /dev/null
+++ b/pd/tcl/apple_events.tcl
@@ -0,0 +1,53 @@
+
+package provide apple_events 0.1
+
+package require wheredoesthisgo
+
+# from http://wiki.tcl.tk/12987
+
+set ::tk::mac::CGAntialiasLimit 0 ;# min line thickness to anti-alias (default: 3)
+set ::tk::mac::antialiasedtext 1 ;# enable/disable anti-aliased text
+
+# kAEOpenDocuments
+proc ::tk::mac::OpenDocument {args} {
+ foreach filename $args {
+ puts "open_file $filename"
+ open_file $filename
+ }
+ set ::pd_menucommands::menu_open_dir [file dirname $filename]
+}
+
+# kEventAppHidden
+proc ::tk::mac::OnHide {} {
+ # TODO
+}
+
+# kEventAppShown
+proc ::tk::mac::OnShow {} {
+ # TODO
+}
+
+# kAEShowPreferences
+proc ::tk::mac::ShowPreferences {} {
+ menu_preferences_panel
+}
+
+# kAEQuitApplication
+#proc ::tk::mac::Quit {} {
+# # TODO sort this out... how to quit pd-gui after sending the message
+# puts stderr "Custom exit proc"
+# pdsend "pd verifyquit"
+#}
+
+# these I gleaned by reading the source (tkMacOSXHLEvents.c)
+proc ::tk::mac::PrintDocument {args} {
+ # TODO what's $mytoplevel here?. I am guessing args would be the same as
+ # ::tk::mac::OpenDocument
+ #menu_print $mytoplevel
+}
+
+proc ::tk::mac::OpenApplication {} {
+}
+
+proc ::tk::mac::ReopenApplication {} {
+}
diff --git a/pd/tcl/dialog_find.tcl b/pd/tcl/dialog_find.tcl
new file mode 100644
index 00000000..92d58347
--- /dev/null
+++ b/pd/tcl/dialog_find.tcl
@@ -0,0 +1,94 @@
+
+package provide dialog_find 0.1
+
+package require pd_bindings
+
+namespace eval ::dialog_find:: {
+ namespace export menu_dialog_find
+}
+
+# TODO figure out findagain
+# TODO make targetlabel into a popup menu
+# TODO make panel go away after a find
+
+proc find_ok {mytoplevel} {::dialog_find::ok $mytoplevel} ;# TODO temp kludge
+proc ::dialog_find::ok {mytoplevel} {
+ # find will be on top, so use the previous window that was on top
+ set search_window [lindex [wm stackorder .] end-1]
+ if {$search_window eq "."} {
+ puts "search pd window not implemented yet"
+ } else {
+ puts "search_window $search_window"
+ set find_string [.find.entry get]
+ if {$find_string ne ""} {
+ pdsend "$search_window find $find_string"
+ }
+ }
+}
+
+proc find_cancel {mytoplevel} {::dialog_find::cancel $mytoplevel} ;# TODO temp kludge
+proc ::dialog_find::cancel {mytoplevel} {
+ wm withdraw .find
+}
+
+proc ::dialog_find::set_canvas_to_search {mytoplevel} {
+ if {[winfo exists .find.frame.targetlabel]} {
+ set focusedtoplevel [winfo toplevel [lindex [wm stackorder .] end]]
+ if {$focusedtoplevel eq ".find"} {
+ set focusedtoplevel [winfo toplevel [lindex [wm stackorder .] end-1]]
+ }
+ # TODO this text should be based on $::menu_windowlist
+ if {$focusedtoplevel eq "."} {
+ .find.frame.targetlabel configure -text [wm title .]
+ } else {
+ foreach window $::menu_windowlist {
+ if {[lindex $window 1] eq $focusedtoplevel} {
+ .find.frame.targetlabel configure -text [lindex $window 0]
+ }
+ }
+ }
+ }
+}
+
+# the find panel is opened from the menu and key bindings
+proc ::dialog_find::menu_dialog_find {mytoplevel} {
+ if {[winfo exists .find]} {
+ wm deiconify .find
+ raise .find
+ } else {
+ create_panel $mytoplevel
+ }
+}
+
+proc ::dialog_find::create_panel {mytoplevel} {
+ toplevel .find
+ wm title .find [_ "Find"]
+ wm geometry .find =475x125+150+150
+ wm resizable .find 0 0
+ if {[catch {wm attributes .find -topmost}]} {puts stderr ".find -topmost failed"}
+ .find configure
+ ::pd_bindings::panel_bindings .find "find"
+
+ frame .find.frame
+ pack .find.frame -side top -fill x -pady 7
+ label .find.frame.searchin -text [_ "Search in"]
+ label .find.frame.targetlabel -font "TkTextFont 14"
+ label .find.frame.for -text [_ "for:"]
+ pack .find.frame.searchin .find.frame.targetlabel .find.frame.for -side left
+ entry .find.entry -width 54 -font 18 -relief sunken \
+ -highlightthickness 3 -highlightcolor blue
+ focus .find.entry
+ pack .find.entry -side top -padx 10
+
+ frame .find.buttonframe -background yellow
+ button .find.button -text [_ "Find"] -default active -width 9 \
+ -command "::dialog_find::ok $mytoplevel"
+ if {$::windowingsystem eq "x11"} {
+ button .find.close -text [_ "Close"] -default normal -width 9 \
+ -command "::dialog_find::cancel $mytoplevel"
+ pack .find.buttonframe .find.button .find.close -side right -padx 10 -pady 15
+ } else {
+ pack .find.buttonframe .find.button -side right -padx 10 -pady 15
+ }
+ ::dialog_find::set_canvas_to_search $mytoplevel
+}
diff --git a/pd/tcl/dialog_font.tcl b/pd/tcl/dialog_font.tcl
new file mode 100644
index 00000000..cebfcb08
--- /dev/null
+++ b/pd/tcl/dialog_font.tcl
@@ -0,0 +1,107 @@
+
+package provide dialog_font 0.1
+
+namespace eval ::dialog_font:: {
+ variable fontsize 0
+ variable dofont_fontsize 0
+ variable stretchval 0
+ variable whichstretch 0
+
+ namespace export pdtk_canvas_dofont
+}
+
+proc ::dialog_font::apply {mytoplevel myfontsize} {
+ pdsend "$mytoplevel font $myfontsize $stretchval $whichstretch"
+}
+
+proc ::dialog_font::close {mytoplevel} {
+ pdsend "$mytoplevel cancel"
+}
+
+proc ::dialog_font::cancel {mytoplevel} {
+ ::dialog_font::apply $mytoplevel $fontsize ;# reinstate previous font size
+ pdsend "$mytoplevel cancel"
+}
+
+proc ::dialog_font::ok {mytoplevel} {
+ set fontsize $::dialog_font::fontsize
+ ::dialog_font::apply $mytoplevel $fontsize
+ ::dialog_font::close $mytoplevel
+}
+
+# this should be called pdtk_font_dialog like the rest of the panels, but it
+# is called from the C side, so we'll leave it be
+proc ::dialog_font::pdtk_canvas_dofont {mytoplevel initsize} {
+ create_panel $mytoplevel $initsize
+}
+
+proc ::dialog_font::create_panel {mytoplevel initsize} {
+ set fontsize $initsize
+ set dofont_fontsize $initsize
+ set stretchval 100
+ set whichstretch 1
+
+ toplevel $mytoplevel
+ wm title $mytoplevel {Patch Font}
+ wm protocol $mytoplevel WM_DELETE_WINDOW "::dialog_font::cancel $mytoplevel"
+
+ pdtk_panelkeybindings $mytoplevel font
+
+ frame $mytoplevel.buttonframe
+ pack $mytoplevel.buttonframe -side bottom -fill x -pady 2m
+ button $mytoplevel.buttonframe.cancel -text "Cancel" \
+ -command "::dialog_font::cancel $mytoplevel"
+ button $mytoplevel.buttonframe.ok -text "OK" \
+ -command "::dialog_font::ok $mytoplevel"
+ pack $mytoplevel.buttonframe.cancel -side left -expand 1
+ pack $mytoplevel.buttonframe.ok -side left -expand 1
+
+ frame $mytoplevel.radiof
+ pack $mytoplevel.radiof -side left
+
+ label $mytoplevel.radiof.label -text {Font Size:}
+ pack $mytoplevel.radiof.label -side top
+
+ radiobutton $mytoplevel.radiof.radio8 -value 8 -variable ::dialog_font::fontsize -text "8" \
+ -command "::dialog_font::apply $mytoplevel 8"
+ radiobutton $mytoplevel.radiof.radio10 -value 10 -variable ::dialog_font::fontsize -text "10" \
+ -command "::dialog_font::apply $mytoplevel 10"
+ radiobutton $mytoplevel.radiof.radio12 -value 12 -variable ::dialog_font::fontsize -text "12" \
+ -command "::dialog_font::apply $mytoplevel 12"
+ radiobutton $mytoplevel.radiof.radio16 -value 16 -variable ::dialog_font::fontsize -text "16" \
+ -command "::dialog_font::apply $mytoplevel 16"
+ radiobutton $mytoplevel.radiof.radio24 -value 24 -variable ::dialog_font::fontsize -text "24" \
+ -command "::dialog_font::apply $mytoplevel 24"
+ radiobutton $mytoplevel.radiof.radio36 -value 36 -variable ::dialog_font::fontsize -text "36" \
+ -command "::dialog_font::apply $mytoplevel 36"
+ pack $mytoplevel.radiof.radio8 -side top -anchor w
+ pack $mytoplevel.radiof.radio10 -side top -anchor w
+ pack $mytoplevel.radiof.radio12 -side top -anchor w
+ pack $mytoplevel.radiof.radio16 -side top -anchor w
+ pack $mytoplevel.radiof.radio24 -side top -anchor w
+ pack $mytoplevel.radiof.radio36 -side top -anchor w
+
+ set current_radiobutton [format "$mytoplevel.radiof.radio%d" $initsize]
+ $current_radiobutton select
+
+ frame $mytoplevel.stretchf
+ pack $mytoplevel.stretchf -side left
+
+ label $mytoplevel.stretchf.label -text "Stretch:"
+ pack $mytoplevel.stretchf.label -side top
+
+ entry $mytoplevel.stretchf.entry -textvariable stretchval -width 5
+ pack $mytoplevel.stretchf.entry -side left
+
+ radiobutton $mytoplevel.stretchf.radio1 \
+ -value 1 -variable whichstretch -text "X and Y"
+ radiobutton $mytoplevel.stretchf.radio2 \
+ -value 2 -variable whichstretch -text "X only"
+ radiobutton $mytoplevel.stretchf.radio3 \
+ -value 3 -variable whichstretch -text "Y only"
+
+ pack $mytoplevel.stretchf.radio1 -side top -anchor w
+ pack $mytoplevel.stretchf.radio2 -side top -anchor w
+ pack $mytoplevel.stretchf.radio3 -side top -anchor w
+
+}
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
+}
diff --git a/pd/tcl/dialog_iemgui.tcl b/pd/tcl/dialog_iemgui.tcl
new file mode 100644
index 00000000..5aabf4c2
--- /dev/null
+++ b/pd/tcl/dialog_iemgui.tcl
@@ -0,0 +1,780 @@
+# For information on usage and redistribution, and for a DISCLAIMER OF ALL
+# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
+# Copyright (c) 1997-2009 Miller Puckette.
+
+package provide dialog_iemgui 0.1
+
+namespace eval ::dialog_iemgui:: {
+ variable define_min_flashhold 50
+ variable define_min_flashbreak 10
+ variable define_min_fontsize 4
+
+ namespace export pdtk_iemgui_dialog
+}
+
+# TODO rename $mytoplevel to $mytoplevel
+
+proc ::dialog_iemgui::clip_dim {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_wdt [concat iemgui_wdt_$vid]
+ global $var_iemgui_wdt
+ set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
+ global $var_iemgui_min_wdt
+ set var_iemgui_hgt [concat iemgui_hgt_$vid]
+ global $var_iemgui_hgt
+ set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
+ global $var_iemgui_min_hgt
+
+ if {[eval concat $$var_iemgui_wdt] < [eval concat $$var_iemgui_min_wdt]} {
+ set $var_iemgui_wdt [eval concat $$var_iemgui_min_wdt]
+ $mytoplevel.dim.w_ent configure -textvariable $var_iemgui_wdt
+ }
+ if {[eval concat $$var_iemgui_hgt] < [eval concat $$var_iemgui_min_hgt]} {
+ set $var_iemgui_hgt [eval concat $$var_iemgui_min_hgt]
+ $mytoplevel.dim.h_ent configure -textvariable $var_iemgui_hgt
+ }
+}
+
+proc ::dialog_iemgui::clip_num {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_num [concat iemgui_num_$vid]
+ global $var_iemgui_num
+
+ if {[eval concat $$var_iemgui_num] > 2000} {
+ set $var_iemgui_num 2000
+ $mytoplevel.para.num_ent configure -textvariable $var_iemgui_num
+ }
+ if {[eval concat $$var_iemgui_num] < 1} {
+ set $var_iemgui_num 1
+ $mytoplevel.para.num_ent configure -textvariable $var_iemgui_num
+ }
+}
+
+proc ::dialog_iemgui::sched_rng {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
+ global $var_iemgui_min_rng
+ set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
+ global $var_iemgui_max_rng
+ set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
+ global $var_iemgui_rng_sch
+
+ variable define_min_flashhold
+ variable define_min_flashbreak
+
+ if {[eval concat $$var_iemgui_rng_sch] == 2} {
+ if {[eval concat $$var_iemgui_max_rng] < [eval concat $$var_iemgui_min_rng]} {
+ set hhh [eval concat $$var_iemgui_min_rng]
+ set $var_iemgui_min_rng [eval concat $$var_iemgui_max_rng]
+ set $var_iemgui_max_rng $hhh
+ $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
+ $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng }
+ if {[eval concat $$var_iemgui_max_rng] < $define_min_flashhold} {
+ set $var_iemgui_max_rng $iemgui_define_min_flashhold
+ $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
+ }
+ if {[eval concat $$var_iemgui_min_rng] < $define_min_flashbreak} {
+ set $var_iemgui_min_rng $define_min_flashbreak
+ $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
+ }
+ }
+ if {[eval concat $$var_iemgui_rng_sch] == 1} {
+ if {[eval concat $$var_iemgui_min_rng] == 0.0} {
+ set $var_iemgui_min_rng 1.0
+ $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
+ }
+ }
+}
+
+proc ::dialog_iemgui::verify_rng {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
+ global $var_iemgui_min_rng
+ set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
+ global $var_iemgui_max_rng
+ set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
+ global $var_iemgui_lin0_log1
+
+ if {[eval concat $$var_iemgui_lin0_log1] == 1} {
+ if {[eval concat $$var_iemgui_max_rng] == 0.0 && [eval concat $$var_iemgui_min_rng] == 0.0} {
+ set $var_iemgui_max_rng 1.0
+ $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
+ }
+ if {[eval concat $$var_iemgui_max_rng] > 0} {
+ if {[eval concat $$var_iemgui_min_rng] <= 0} {
+ set $var_iemgui_min_rng [expr [eval concat $$var_iemgui_max_rng] * 0.01]
+ $mytoplevel.rng.min_ent configure -textvariable $var_iemgui_min_rng
+ }
+ } else {
+ if {[eval concat $$var_iemgui_min_rng] > 0} {
+ set $var_iemgui_max_rng [expr [eval concat $$var_iemgui_min_rng] * 0.01]
+ $mytoplevel.rng.max_ent configure -textvariable $var_iemgui_max_rng
+ }
+ }
+ }
+}
+
+proc ::dialog_iemgui::clip_fontsize {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
+ global $var_iemgui_gn_fs
+
+ variable define_min_fontsize
+
+ if {[eval concat $$var_iemgui_gn_fs] < $define_min_fontsize} {
+ set $var_iemgui_gn_fs $define_min_fontsize
+ $mytoplevel.label.fs_ent configure -textvariable $var_iemgui_gn_fs
+ }
+}
+
+proc ::dialog_iemgui::set_col_example {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_bcol [concat iemgui_bcol_$vid]
+ global $var_iemgui_bcol
+ set var_iemgui_fcol [concat iemgui_fcol_$vid]
+ global $var_iemgui_fcol
+ set var_iemgui_lcol [concat iemgui_lcol_$vid]
+ global $var_iemgui_lcol
+
+ $mytoplevel.colors.sections.lb_bk configure \
+ -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]]
+
+ if { [eval concat $$var_iemgui_fcol] >= 0 } {
+ $mytoplevel.colors.sections.fr_bk configure \
+ -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]]
+ } else {
+ $mytoplevel.colors.sections.fr_bk configure \
+ -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]]}
+}
+
+proc ::dialog_iemgui::preset_col {mytoplevel presetcol} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
+ global $var_iemgui_l2_f1_b0
+ set var_iemgui_bcol [concat iemgui_bcol_$vid]
+ global $var_iemgui_bcol
+ set var_iemgui_fcol [concat iemgui_fcol_$vid]
+ global $var_iemgui_fcol
+ set var_iemgui_lcol [concat iemgui_lcol_$vid]
+ global $var_iemgui_lcol
+
+ if { [eval concat $$var_iemgui_l2_f1_b0] == 0 } { set $var_iemgui_bcol $presetcol }
+ if { [eval concat $$var_iemgui_l2_f1_b0] == 1 } { set $var_iemgui_fcol $presetcol }
+ if { [eval concat $$var_iemgui_l2_f1_b0] == 2 } { set $var_iemgui_lcol $presetcol }
+ ::dialog_iemgui::set_col_example $mytoplevel
+}
+
+proc ::dialog_iemgui::choose_col_bkfrlb {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
+ global $var_iemgui_l2_f1_b0
+ set var_iemgui_bcol [concat iemgui_bcol_$vid]
+ global $var_iemgui_bcol
+ set var_iemgui_fcol [concat iemgui_fcol_$vid]
+ global $var_iemgui_fcol
+ set var_iemgui_lcol [concat iemgui_lcol_$vid]
+ global $var_iemgui_lcol
+
+ if {[eval concat $$var_iemgui_l2_f1_b0] == 0} {
+ set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC]
+ set helpstring [tk_chooseColor -title [_ "Background color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_bcol]]]
+ if { $helpstring != "" } {
+ set $var_iemgui_bcol [string replace $helpstring 0 0 "0x"]
+ set $var_iemgui_bcol [expr [eval concat $$var_iemgui_bcol] & 0xFCFCFC] }
+ }
+ if {[eval concat $$var_iemgui_l2_f1_b0] == 1} {
+ set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC]
+ set helpstring [tk_chooseColor -title [_ "Foreground color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_fcol]]]
+ if { $helpstring != "" } {
+ set $var_iemgui_fcol [string replace $helpstring 0 0 "0x"]
+ set $var_iemgui_fcol [expr [eval concat $$var_iemgui_fcol] & 0xFCFCFC] }
+ }
+ if {[eval concat $$var_iemgui_l2_f1_b0] == 2} {
+ set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC]
+ set helpstring [tk_chooseColor -title [_ "Label color"] -initialcolor [format "#%6.6x" [eval concat $$var_iemgui_lcol]]]
+ if { $helpstring != "" } {
+ set $var_iemgui_lcol [string replace $helpstring 0 0 "0x"]
+ set $var_iemgui_lcol [expr [eval concat $$var_iemgui_lcol] & 0xFCFCFC] }
+ }
+ ::dialog_iemgui::set_col_example $mytoplevel
+}
+
+proc ::dialog_iemgui::lilo {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
+ global $var_iemgui_lin0_log1
+ set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
+ global $var_iemgui_lilo0
+ set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
+ global $var_iemgui_lilo1
+
+ ::dialog_iemgui::sched_rng $mytoplevel
+
+ if {[eval concat $$var_iemgui_lin0_log1] == 0} {
+ set $var_iemgui_lin0_log1 1
+ $mytoplevel.para.lilo configure -text [eval concat $$var_iemgui_lilo1]
+ ::dialog_iemgui::verify_rng $mytoplevel
+ ::dialog_iemgui::sched_rng $mytoplevel
+ } else {
+ set $var_iemgui_lin0_log1 0
+ $mytoplevel.para.lilo configure -text [eval concat $$var_iemgui_lilo0]
+ }
+}
+
+proc ::dialog_iemgui::toggle_font {mytoplevel gn_f} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
+ global $var_iemgui_gn_f
+
+ set $var_iemgui_gn_f $gn_f
+
+ switch -- $gn_f {
+ 0 { set current_font $::font_family}
+ 1 { set current_font "Helvetica" }
+ 2 { set current_font "Times" }
+ }
+ set current_font_spec "{$current_font} 12 $::font_weight"
+
+ $mytoplevel.label.fontpopup_label configure -text $current_font \
+ -font $current_font_spec
+ $mytoplevel.label.name_entry configure -font $current_font_spec
+ $mytoplevel.colors.sections.fr_bk configure -font $current_font_spec
+ $mytoplevel.colors.sections.lb_bk configure -font $current_font_spec
+}
+
+proc ::dialog_iemgui::lb {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
+ global $var_iemgui_loadbang
+
+ if {[eval concat $$var_iemgui_loadbang] == 0} {
+ set $var_iemgui_loadbang 1
+ $mytoplevel.para.lb configure -text "init"
+ } else {
+ set $var_iemgui_loadbang 0
+ $mytoplevel.para.lb configure -text "no init"
+ }
+}
+
+proc ::dialog_iemgui::stdy_jmp {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_steady [concat iemgui_steady_$vid]
+ global $var_iemgui_steady
+
+ if {[eval concat $$var_iemgui_steady]} {
+ set $var_iemgui_steady 0
+ $mytoplevel.para.stdy_jmp configure -text "jump on click"
+ } else {
+ set $var_iemgui_steady 1
+ $mytoplevel.para.stdy_jmp configure -text "steady on click"
+ }
+}
+
+proc ::dialog_iemgui::apply {mytoplevel} {
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_wdt [concat iemgui_wdt_$vid]
+ global $var_iemgui_wdt
+ set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
+ global $var_iemgui_min_wdt
+ set var_iemgui_hgt [concat iemgui_hgt_$vid]
+ global $var_iemgui_hgt
+ set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
+ global $var_iemgui_min_hgt
+ set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
+ global $var_iemgui_min_rng
+ set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
+ global $var_iemgui_max_rng
+ set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
+ global $var_iemgui_lin0_log1
+ set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
+ global $var_iemgui_lilo0
+ set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
+ global $var_iemgui_lilo1
+ set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
+ global $var_iemgui_loadbang
+ set var_iemgui_num [concat iemgui_num_$vid]
+ global $var_iemgui_num
+ set var_iemgui_steady [concat iemgui_steady_$vid]
+ global $var_iemgui_steady
+ set var_iemgui_snd [concat iemgui_snd_$vid]
+ global $var_iemgui_snd
+ set var_iemgui_rcv [concat iemgui_rcv_$vid]
+ global $var_iemgui_rcv
+ set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
+ global $var_iemgui_gui_nam
+ set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
+ global $var_iemgui_gn_dx
+ set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
+ global $var_iemgui_gn_dy
+ set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
+ global $var_iemgui_gn_f
+ set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
+ global $var_iemgui_gn_fs
+ set var_iemgui_bcol [concat iemgui_bcol_$vid]
+ global $var_iemgui_bcol
+ set var_iemgui_fcol [concat iemgui_fcol_$vid]
+ global $var_iemgui_fcol
+ set var_iemgui_lcol [concat iemgui_lcol_$vid]
+ global $var_iemgui_lcol
+
+ ::dialog_iemgui::clip_dim $mytoplevel
+ ::dialog_iemgui::clip_num $mytoplevel
+ ::dialog_iemgui::sched_rng $mytoplevel
+ ::dialog_iemgui::verify_rng $mytoplevel
+ ::dialog_iemgui::sched_rng $mytoplevel
+ ::dialog_iemgui::clip_fontsize $mytoplevel
+
+ if {[eval concat $$var_iemgui_snd] == ""} {set hhhsnd "empty"} else {set hhhsnd [eval concat $$var_iemgui_snd]}
+ if {[eval concat $$var_iemgui_rcv] == ""} {set hhhrcv "empty"} else {set hhhrcv [eval concat $$var_iemgui_rcv]}
+ if {[eval concat $$var_iemgui_gui_nam] == ""} {set hhhgui_nam "empty"
+ } else {
+ set hhhgui_nam [eval concat $$var_iemgui_gui_nam]}
+
+ if {[string index $hhhsnd 0] == "$"} {
+ set hhhsnd [string replace $hhhsnd 0 0 #] }
+ if {[string index $hhhrcv 0] == "$"} {
+ set hhhrcv [string replace $hhhrcv 0 0 #] }
+ if {[string index $hhhgui_nam 0] == "$"} {
+ set hhhgui_nam [string replace $hhhgui_nam 0 0 #] }
+
+ set hhhsnd [unspace_text $hhhsnd]
+ set hhhrcv [unspace_text $hhhrcv]
+ set hhhgui_nam [unspace_text $hhhgui_nam]
+
+ pdsend [concat $mytoplevel dialog \
+ [eval concat $$var_iemgui_wdt] \
+ [eval concat $$var_iemgui_hgt] \
+ [eval concat $$var_iemgui_min_rng] \
+ [eval concat $$var_iemgui_max_rng] \
+ [eval concat $$var_iemgui_lin0_log1] \
+ [eval concat $$var_iemgui_loadbang] \
+ [eval concat $$var_iemgui_num] \
+ $hhhsnd \
+ $hhhrcv \
+ $hhhgui_nam \
+ [eval concat $$var_iemgui_gn_dx] \
+ [eval concat $$var_iemgui_gn_dy] \
+ [eval concat $$var_iemgui_gn_f] \
+ [eval concat $$var_iemgui_gn_fs] \
+ [eval concat $$var_iemgui_bcol] \
+ [eval concat $$var_iemgui_fcol] \
+ [eval concat $$var_iemgui_lcol] \
+ [eval concat $$var_iemgui_steady]]
+}
+
+
+proc iemgui_cancel {mytoplevel} {
+ # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings
+ # is sorted out
+ ::dialog_iemgui::cancel $mytoplevel
+}
+proc ::dialog_iemgui::cancel {mytoplevel} {
+ pdsend "$mytoplevel cancel"
+}
+
+proc iemgui_ok {mytoplevel} {
+ # TODO kludge!! until a common approach to ::pd_bindings::panel_bindings
+ # is sorted out
+ ::dialog_iemgui::ok $mytoplevel
+}
+proc ::dialog_iemgui::ok {mytoplevel} {
+ ::dialog_iemgui::apply $mytoplevel
+ ::dialog_iemgui::cancel $mytoplevel
+}
+
+proc ::dialog_iemgui::pdtk_iemgui_dialog {mytoplevel mainheader dim_header \
+ wdt min_wdt wdt_label \
+ hgt min_hgt hgt_label \
+ rng_header min_rng min_rng_label max_rng \
+ max_rng_label rng_sched \
+ lin0_log1 lilo0_label lilo1_label \
+ loadbang steady num_label num \
+ snd rcv \
+ gui_name \
+ gn_dx gn_dy gn_f gn_fs \
+ bcol fcol lcol} {
+
+ set vid [string trimleft $mytoplevel .]
+
+ set var_iemgui_wdt [concat iemgui_wdt_$vid]
+ global $var_iemgui_wdt
+ set var_iemgui_min_wdt [concat iemgui_min_wdt_$vid]
+ global $var_iemgui_min_wdt
+ set var_iemgui_hgt [concat iemgui_hgt_$vid]
+ global $var_iemgui_hgt
+ set var_iemgui_min_hgt [concat iemgui_min_hgt_$vid]
+ global $var_iemgui_min_hgt
+ set var_iemgui_min_rng [concat iemgui_min_rng_$vid]
+ global $var_iemgui_min_rng
+ set var_iemgui_max_rng [concat iemgui_max_rng_$vid]
+ global $var_iemgui_max_rng
+ set var_iemgui_rng_sch [concat iemgui_rng_sch_$vid]
+ global $var_iemgui_rng_sch
+ set var_iemgui_lin0_log1 [concat iemgui_lin0_log1_$vid]
+ global $var_iemgui_lin0_log1
+ set var_iemgui_lilo0 [concat iemgui_lilo0_$vid]
+ global $var_iemgui_lilo0
+ set var_iemgui_lilo1 [concat iemgui_lilo1_$vid]
+ global $var_iemgui_lilo1
+ set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
+ global $var_iemgui_loadbang
+ set var_iemgui_num [concat iemgui_num_$vid]
+ global $var_iemgui_num
+ set var_iemgui_steady [concat iemgui_steady_$vid]
+ global $var_iemgui_steady
+ set var_iemgui_snd [concat iemgui_snd_$vid]
+ global $var_iemgui_snd
+ set var_iemgui_rcv [concat iemgui_rcv_$vid]
+ global $var_iemgui_rcv
+ set var_iemgui_gui_nam [concat iemgui_gui_nam_$vid]
+ global $var_iemgui_gui_nam
+ set var_iemgui_gn_dx [concat iemgui_gn_dx_$vid]
+ global $var_iemgui_gn_dx
+ set var_iemgui_gn_dy [concat iemgui_gn_dy_$vid]
+ global $var_iemgui_gn_dy
+ set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
+ global $var_iemgui_gn_f
+ set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
+ global $var_iemgui_gn_fs
+ set var_iemgui_l2_f1_b0 [concat iemgui_l2_f1_b0_$vid]
+ global $var_iemgui_l2_f1_b0
+ set var_iemgui_bcol [concat iemgui_bcol_$vid]
+ global $var_iemgui_bcol
+ set var_iemgui_fcol [concat iemgui_fcol_$vid]
+ global $var_iemgui_fcol
+ set var_iemgui_lcol [concat iemgui_lcol_$vid]
+ global $var_iemgui_lcol
+
+ set $var_iemgui_wdt $wdt
+ set $var_iemgui_min_wdt $min_wdt
+ set $var_iemgui_hgt $hgt
+ set $var_iemgui_min_hgt $min_hgt
+ set $var_iemgui_min_rng $min_rng
+ set $var_iemgui_max_rng $max_rng
+ set $var_iemgui_rng_sch $rng_sched
+ set $var_iemgui_lin0_log1 $lin0_log1
+ set $var_iemgui_lilo0 $lilo0_label
+ set $var_iemgui_lilo1 $lilo1_label
+ set $var_iemgui_loadbang $loadbang
+ set $var_iemgui_num $num
+ set $var_iemgui_steady $steady
+ if {$snd == "empty"} {set $var_iemgui_snd [format ""]
+ } else {set $var_iemgui_snd [format "%s" $snd]}
+ if {$rcv == "empty"} {set $var_iemgui_rcv [format ""]
+ } else {set $var_iemgui_rcv [format "%s" $rcv]}
+ if {$gui_name == "empty"} {set $var_iemgui_gui_nam [format ""]
+ } else {set $var_iemgui_gui_nam [format "%s" $gui_name]}
+
+ if {[string index [eval concat $$var_iemgui_snd] 0] == "#"} {
+ set $var_iemgui_snd [string replace [eval concat $$var_iemgui_snd] 0 0 $] }
+ if {[string index [eval concat $$var_iemgui_rcv] 0] == "#"} {
+ set $var_iemgui_rcv [string replace [eval concat $$var_iemgui_rcv] 0 0 $] }
+ if {[string index [eval concat $$var_iemgui_gui_nam] 0] == "#"} {
+ set $var_iemgui_gui_nam [string replace [eval concat $$var_iemgui_gui_nam] 0 0 $] }
+ set $var_iemgui_gn_dx $gn_dx
+ set $var_iemgui_gn_dy $gn_dy
+ set $var_iemgui_gn_f $gn_f
+ set $var_iemgui_gn_fs $gn_fs
+
+ set $var_iemgui_bcol $bcol
+ set $var_iemgui_fcol $fcol
+ set $var_iemgui_lcol $lcol
+
+ set $var_iemgui_l2_f1_b0 0
+
+ toplevel $mytoplevel
+ wm title $mytoplevel [format [_ "%s Properties"] $mainheader]
+ wm resizable $mytoplevel 0 0
+ wm protocol $mytoplevel WM_DELETE_WINDOW [concat ::dialog_iemgui::cancel $mytoplevel]
+
+ ::pd_bindings::panel_bindings $mytoplevel "iemgui"
+
+ frame $mytoplevel.dim
+ pack $mytoplevel.dim -side top
+ label $mytoplevel.dim.head -text $dim_header
+ label $mytoplevel.dim.w_lab -text [_ $wdt_label] -width 6
+ entry $mytoplevel.dim.w_ent -textvariable $var_iemgui_wdt -width 5
+ label $mytoplevel.dim.dummy1 -text " " -width 10
+ label $mytoplevel.dim.h_lab -text [_ $hgt_label] -width 6
+ entry $mytoplevel.dim.h_ent -textvariable $var_iemgui_hgt -width 5
+ pack $mytoplevel.dim.head -side top
+ pack $mytoplevel.dim.w_lab $mytoplevel.dim.w_ent $mytoplevel.dim.dummy1 -side left
+ if { $hgt_label != "empty" } {
+ pack $mytoplevel.dim.h_lab $mytoplevel.dim.h_ent -side left}
+
+ frame $mytoplevel.rng
+ pack $mytoplevel.rng -side top
+ label $mytoplevel.rng.head -text $rng_header
+ label $mytoplevel.rng.min_lab -text [_ $min_rng_label] -width 6
+ entry $mytoplevel.rng.min_ent -textvariable $var_iemgui_min_rng -width 9
+ label $mytoplevel.rng.dummy1 -text " " -width 1
+ label $mytoplevel.rng.max_lab -text [_ $max_rng_label] -width 8
+ entry $mytoplevel.rng.max_ent -textvariable $var_iemgui_max_rng -width 9
+ if { $rng_header != "empty" } {
+ pack $mytoplevel.rng.head -side top
+ if { $min_rng_label != "empty" } {
+ pack $mytoplevel.rng.min_lab $mytoplevel.rng.min_ent -side left}
+ if { $max_rng_label != "empty" } {
+ pack $mytoplevel.rng.dummy1 \
+ $mytoplevel.rng.max_lab $mytoplevel.rng.max_ent -side left} }
+
+ if { [eval concat $$var_iemgui_lin0_log1] >= 0 || [eval concat $$var_iemgui_loadbang] >= 0 || [eval concat $$var_iemgui_num] > 0 || [eval concat $$var_iemgui_steady] >= 0 } {
+ label $mytoplevel.space1 -text ""
+ pack $mytoplevel.space1 -side top }
+
+ frame $mytoplevel.para
+ pack $mytoplevel.para -side top
+ label $mytoplevel.para.dummy2 -text "" -width 1
+ label $mytoplevel.para.dummy3 -text "" -width 1
+ if {[eval concat $$var_iemgui_lin0_log1] == 0} {
+ button $mytoplevel.para.lilo -text [_ [eval concat $$var_iemgui_lilo0]] -width 5 \
+ -command "::dialog_iemgui::lilo $mytoplevel" }
+ if {[eval concat $$var_iemgui_lin0_log1] == 1} {
+ button $mytoplevel.para.lilo -text [_ [eval concat $$var_iemgui_lilo1]] -width 5 \
+ -command "::dialog_iemgui::lilo $mytoplevel" }
+ if {[eval concat $$var_iemgui_loadbang] == 0} {
+ button $mytoplevel.para.lb -text [_ "no init"] \
+ -width [::msgcat::mcmax "no init"] \
+ -command "::dialog_iemgui::lb $mytoplevel" }
+ if {[eval concat $$var_iemgui_loadbang] == 1} {
+ button $mytoplevel.para.lb -text [_ "Save"] \
+ -width [::msgcat::mcmax "Save"] \
+ -command "::dialog_iemgui::lb $mytoplevel" }
+ label $mytoplevel.para.num_lab -text [_ $num_label] -width 9
+ entry $mytoplevel.para.num_ent -textvariable $var_iemgui_num -width 4
+
+ if {[eval concat $$var_iemgui_steady] == 0} {
+ button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
+ -text [_ "jump on click"] -width 12 }
+ if {[eval concat $$var_iemgui_steady] == 1} {
+ button $mytoplevel.para.stdy_jmp -command "::dialog_iemgui::stdy_jmp $mytoplevel" \
+ -text [_ "steady on click"] -width 12 }
+ if {[eval concat $$var_iemgui_lin0_log1] >= 0} {
+ pack $mytoplevel.para.lilo -side left -expand 1}
+ if {[eval concat $$var_iemgui_loadbang] >= 0} {
+ pack $mytoplevel.para.dummy2 $mytoplevel.para.lb -side left -expand 1}
+ if {[eval concat $$var_iemgui_num] > 0} {
+ pack $mytoplevel.para.dummy3 $mytoplevel.para.num_lab $mytoplevel.para.num_ent -side left -expand 1}
+ if {[eval concat $$var_iemgui_steady] >= 0} {
+ pack $mytoplevel.para.dummy3 $mytoplevel.para.stdy_jmp -side left -expand 1}
+
+ frame $mytoplevel.spacer0 -height 4
+ pack $mytoplevel.spacer0 -side top
+
+ labelframe $mytoplevel.s_r -borderwidth 1 -pady 4 -text [_ "Messages"] \
+ -font highlight_font
+ pack $mytoplevel.s_r -side top -fill x -ipadx 5
+ frame $mytoplevel.s_r.send
+ pack $mytoplevel.s_r.send -side top
+ label $mytoplevel.s_r.send.lab -text [_ "Send symbol"] -width 12 -justify right
+ entry $mytoplevel.s_r.send.ent -textvariable $var_iemgui_snd -width 22
+ if { $snd != "nosndno" } {
+ pack $mytoplevel.s_r.send.lab $mytoplevel.s_r.send.ent -side left}
+
+ frame $mytoplevel.s_r.receive
+ pack $mytoplevel.s_r.receive -side top
+ label $mytoplevel.s_r.receive.lab -text [_ "Receive symbol"] -width 12 -justify right
+ entry $mytoplevel.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22
+ if { $rcv != "norcvno" } {
+ pack $mytoplevel.s_r.receive.lab $mytoplevel.s_r.receive.ent -side left}
+
+ # get the current font name from the int given from C-space (gn_f)
+ set current_font $::font_family
+ if {[eval concat $$var_iemgui_gn_f] == 1} \
+ { set current_font "Helvetica" }
+ if {[eval concat $$var_iemgui_gn_f] == 2} \
+ { set current_font "Times" }
+
+ frame $mytoplevel.spacer1 -height 7
+ pack $mytoplevel.spacer1 -side top
+
+ labelframe $mytoplevel.label -borderwidth 1 -text [_ "Label"] -pady 4 \
+ -font highlight_font
+ pack $mytoplevel.label -side top -fill x
+ entry $mytoplevel.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \
+ -font [list $current_font 12 $::font_weight]
+ pack $mytoplevel.label.name_entry -side top -expand yes -fill both -padx 5
+
+ frame $mytoplevel.label.xy -padx 27 -pady 1
+ pack $mytoplevel.label.xy -side top
+ label $mytoplevel.label.xy.x_lab -text [_ "X offset"] -width 6
+ entry $mytoplevel.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5
+ label $mytoplevel.label.xy.dummy1 -text " " -width 2
+ label $mytoplevel.label.xy.y_lab -text [_ "Y offset"] -width 6
+ entry $mytoplevel.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5
+ pack $mytoplevel.label.xy.x_lab $mytoplevel.label.xy.x_entry $mytoplevel.label.xy.dummy1 \
+ $mytoplevel.label.xy.y_lab $mytoplevel.label.xy.y_entry -side left -anchor e
+
+ label $mytoplevel.label.fontpopup_label -text $current_font \
+ -relief groove -font [list $current_font 12 $::font_weight] -padx 5
+ pack $mytoplevel.label.fontpopup_label -side left -anchor w -expand yes -fill x
+ label $mytoplevel.label.fontsize_label -text [_ "size:"] -width 4
+ entry $mytoplevel.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5
+ pack $mytoplevel.label.fontsize_entry $mytoplevel.label.fontsize_label \
+ -side right -anchor e -padx 5 -pady 5
+ menu $mytoplevel.popup
+ $mytoplevel.popup add command \
+ -label $::font_family \
+ -font [format {{%s} 12 %s} $::font_family $::font_weight] \
+ -command "::dialog_iemgui::toggle_font $mytoplevel 0"
+ $mytoplevel.popup add command \
+ -label "Helvetica" \
+ -font [format {Helvetica 12 %s} $::font_weight] \
+ -command "::dialog_iemgui::toggle_font $mytoplevel 1"
+ $mytoplevel.popup add command \
+ -label "Times" \
+ -font [format {Times 12 %s} $::font_weight] \
+ -command "::dialog_iemgui::toggle_font $mytoplevel 2"
+ bind $mytoplevel.label.fontpopup_label <Button> \
+ [list tk_popup $mytoplevel.popup %X %Y]
+
+ frame $mytoplevel.spacer2 -height 7
+ pack $mytoplevel.spacer2 -side top
+
+ labelframe $mytoplevel.colors -borderwidth 1 -text [_ "Colors"] -font highlight_font
+ pack $mytoplevel.colors -fill x -ipadx 5 -ipady 4
+
+ frame $mytoplevel.colors.select
+ pack $mytoplevel.colors.select -side top
+ radiobutton $mytoplevel.colors.select.radio0 -value 0 -variable \
+ $var_iemgui_l2_f1_b0 -text [_ "Background"] -width 10 -justify left
+ radiobutton $mytoplevel.colors.select.radio1 -value 1 -variable \
+ $var_iemgui_l2_f1_b0 -text [_ "Front"] -width 5 -justify left
+ radiobutton $mytoplevel.colors.select.radio2 -value 2 -variable \
+ $var_iemgui_l2_f1_b0 -text [_ "Label"] -width 5 -justify left
+ if { [eval concat $$var_iemgui_fcol] >= 0 } {
+ pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio1 \
+ $mytoplevel.colors.select.radio2 -side left
+ } else {
+ pack $mytoplevel.colors.select.radio0 $mytoplevel.colors.select.radio2 -side left
+ }
+
+ frame $mytoplevel.colors.sections
+ pack $mytoplevel.colors.sections -side top
+ button $mytoplevel.colors.sections.but -text [_ "Compose color"] \
+ -width [::msgcat::mcmax "Compose color"] \
+ -command "::dialog_iemgui::choose_col_bkfrlb $mytoplevel"
+ pack $mytoplevel.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
+ -expand yes -fill x
+ if { [eval concat $$var_iemgui_fcol] >= 0 } {
+ label $mytoplevel.colors.sections.fr_bk -text "o=||=o" -width 6 \
+ -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -foreground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
+ -font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
+ } else {
+ label $mytoplevel.colors.sections.fr_bk -text "o=||=o" -width 6 \
+ -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -foreground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
+ }
+ label $mytoplevel.colors.sections.lb_bk -text [_ "Test label"] \
+ -width [::msgcat::mcmax "Test label"] \
+ -background [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -activebackground [format "#%6.6x" [eval concat $$var_iemgui_bcol]] \
+ -foreground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_lcol]] \
+ -font [list $current_font 12 $::font_weight] -padx 2 -pady 2 -relief ridge
+ pack $mytoplevel.colors.sections.lb_bk $mytoplevel.colors.sections.fr_bk \
+ -side right -anchor e -expand yes -fill both -pady 7
+
+ # color scheme by Mary Ann Benedetto http://piR2.org
+ frame $mytoplevel.colors.r1
+ pack $mytoplevel.colors.r1 -side top
+ foreach i { 0 1 2 3 4 5 6 7 8 9} \
+ hexcol { 0xFFFFFF 0xDFDFDF 0xBBBBBB 0xFFC7C6 0xFFE3C6 \
+ 0xFEFFC6 0xC6FFC7 0xc6FEFF 0xC7C6FF 0xE3C6FF } \
+ {
+ label $mytoplevel.colors.r1.c$i -background [format "#%6.6x" $hexcol] \
+ -activebackground [format "#%6.6x" $hexcol] -relief ridge \
+ -padx 7 -pady 0
+ bind $mytoplevel.colors.r1.c$i <Button> [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
+ }
+ pack $mytoplevel.colors.r1.c0 $mytoplevel.colors.r1.c1 $mytoplevel.colors.r1.c2 $mytoplevel.colors.r1.c3 \
+ $mytoplevel.colors.r1.c4 $mytoplevel.colors.r1.c5 $mytoplevel.colors.r1.c6 $mytoplevel.colors.r1.c7 \
+ $mytoplevel.colors.r1.c8 $mytoplevel.colors.r1.c9 -side left
+
+ frame $mytoplevel.colors.r2
+ pack $mytoplevel.colors.r2 -side top
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } \
+ hexcol { 0x9F9F9F 0x7C7C7C 0x606060 0xFF0400 0xFF8300 \
+ 0xFAFF00 0x00FF04 0x00FAFF 0x0400FF 0x9C00FF } \
+ {
+ label $mytoplevel.colors.r2.c$i -background [format "#%6.6x" $hexcol] \
+ -activebackground [format "#%6.6x" $hexcol] -relief ridge \
+ -padx 7 -pady 0
+ bind $mytoplevel.colors.r2.c$i <Button> \
+ [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
+ }
+ pack $mytoplevel.colors.r2.c0 $mytoplevel.colors.r2.c1 $mytoplevel.colors.r2.c2 $mytoplevel.colors.r2.c3 \
+ $mytoplevel.colors.r2.c4 $mytoplevel.colors.r2.c5 $mytoplevel.colors.r2.c6 $mytoplevel.colors.r2.c7 \
+ $mytoplevel.colors.r2.c8 $mytoplevel.colors.r2.c9 -side left
+
+ frame $mytoplevel.colors.r3
+ pack $mytoplevel.colors.r3 -side top
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } \
+ hexcol { 0x404040 0x202020 0x000000 0x551312 0x553512 \
+ 0x535512 0x0F4710 0x0E4345 0x131255 0x2F004D } \
+ {
+ label $mytoplevel.colors.r3.c$i -background [format "#%6.6x" $hexcol] \
+ -activebackground [format "#%6.6x" $hexcol] -relief ridge \
+ -padx 7 -pady 0
+ bind $mytoplevel.colors.r3.c$i <Button> \
+ [format "::dialog_iemgui::preset_col %s %d" $mytoplevel $hexcol]
+ }
+ pack $mytoplevel.colors.r3.c0 $mytoplevel.colors.r3.c1 $mytoplevel.colors.r3.c2 $mytoplevel.colors.r3.c3 \
+ $mytoplevel.colors.r3.c4 $mytoplevel.colors.r3.c5 $mytoplevel.colors.r3.c6 $mytoplevel.colors.r3.c7 \
+ $mytoplevel.colors.r3.c8 $mytoplevel.colors.r3.c9 -side left
+
+ frame $mytoplevel.cao -pady 10
+ pack $mytoplevel.cao -side top
+ button $mytoplevel.cao.cancel -text [_ "Cancel"] -width 6 \
+ -command "::dialog_iemgui::cancel $mytoplevel"
+ label $mytoplevel.cao.dummy1 -text "" -width 3
+ button $mytoplevel.cao.apply -text [_ "Apply"] -width 6 \
+ -command "::dialog_iemgui::apply $mytoplevel"
+ label $mytoplevel.cao.dummy2 -text "" -width 3
+ button $mytoplevel.cao.ok -text [_ "OK"] -width 6 \
+ -command "::dialog_iemgui::ok $mytoplevel"
+ pack $mytoplevel.cao.cancel $mytoplevel.cao.dummy1 -side left
+ pack $mytoplevel.cao.apply $mytoplevel.cao.dummy2 -side left
+ pack $mytoplevel.cao.ok -side left
+
+ if {[info tclversion] < 8.4} {
+ bind $mytoplevel <Key-Tab> {tkTabToWindow [tk_focusNext %W]}
+ bind $mytoplevel <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
+ } else {
+ bind $mytoplevel <Key-Tab> {tk::TabToWindow [tk_focusNext %W]}
+ bind $mytoplevel <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
+ }
+
+ $mytoplevel.dim.w_ent select from 0
+ $mytoplevel.dim.w_ent select adjust end
+ focus $mytoplevel.dim.w_ent
+}
+
diff --git a/pd/tcl/pd.tcl b/pd/tcl/pd.tcl
new file mode 100644
index 00000000..0418dcd8
--- /dev/null
+++ b/pd/tcl/pd.tcl
@@ -0,0 +1,315 @@
+#!/bin/sh
+# This line continues for Tcl, but is a single line for 'sh' \
+ exec wish "$0" -- ${1+"$@"}
+# For information on usage and redistribution, and for a DISCLAIMER OF ALL
+# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
+# Copyright (c) 1997-2009 Miller Puckette.
+
+# puts -------------------------------pd.tcl-----------------------------------
+
+package require Tcl 8.3
+package require Tk
+if {[tk windowingsystem] ne "win32"} {package require msgcat}
+
+# Pd's packages are stored in the same directory as the main script (pd.tcl)
+set auto_path [linsert $auto_path 0 [file dirname [info script]]]
+package require pd_connect
+package require pd_menus
+package require pd_bindings
+package require dialog_font
+package require dialog_gatom
+package require dialog_iemgui
+package require pdtk_array
+package require pdtk_canvas
+package require pdtk_text
+# TODO eliminate this kludge:
+package require wheredoesthisgo
+
+# import into the global namespace for backwards compatibility
+namespace import ::pd_connect::pdsend
+namespace import ::dialog_font::pdtk_canvas_dofont
+namespace import ::dialog_gatom::pdtk_gatom_dialog
+namespace import ::dialog_iemgui::pdtk_iemgui_dialog
+
+#------------------------------------------------------------------------------#
+# global variables
+
+# for testing which platform we are running on ("aqua", "win32", or "x11")
+set windowingsystem ""
+
+# canvas font, received from pd in pdtk_pd_startup, set in s_main.c
+set font_family "Courier"
+set font_weight "bold"
+# sizes of chars for each of the Pd fixed font sizes:
+# fontsize width(pixels) height(pixels)
+set font_fixed_metrics {
+ 8 5 10
+ 9 6 11
+ 10 6 13
+ 12 7 15
+ 14 8 17
+ 16 10 20
+ 18 11 22
+ 24 14 30
+ 30 18 37
+ 36 22 45
+}
+
+# store list of parent windows for Window menu
+set menu_windowlist {}
+
+#------------------------------------------------------------------------------#
+# coding style
+#
+# these are preliminary ideas, we'll change them as we work things out:
+# - when possible use "" doublequotes to delimit messages
+# - use '$::myvar' instead of 'global myvar'
+# - for the sake of clarity, there should not be any inline code, everything
+# should be in a proc that is ultimately triggered from main()
+# - if a menu_* proc opens a panel, that proc is called menu_*_panel
+# - use "eq/ne" for string comparison, NOT "==/!="
+#
+## Names for Common Variables
+#----------------------------
+#
+# variables named after the Tk widgets they represent
+# $mytoplevel = 'toplevel'
+# $mymenubar = the 'menu' attached to the 'toplevel'
+# $mymenu = 'menu' attached to the menubar 'menu'
+# $menuitem = 'menu' item
+# $mycanvas = 'canvas'
+# $canvasitem = 'canvas' item
+#
+#
+## Prefix Names for procs
+#----------------------------
+# pdtk pd -> pd-gui API (i.e. called from 'pd')
+# pdsend pd-gui -> pd API (sends a message to 'pd' using pdsend)
+# canvas manipulates a canvas
+# text manipulates a Tk 'text' widget
+
+# ------------------------------------------------------------------------------
+# init functions
+
+proc init {} {
+ # we are not using Tk scaling, so fix it to 1 on all platforms. This
+ # guarantees that patches will be pixel-exact on every platform
+ tk scaling 1
+
+ # TODO Tcl/Tk 8.3 doesn't have [tk windowingsystem]
+ set ::windowingsystem [tk windowingsystem]
+ # get the versions for later testing
+ regexp {([0-9])\.([0-9])\.([0-9]+)} [info patchlevel] \
+ wholematch ::tcl_major ::tcl_minor ::tcl_patch
+ switch -- $::windowingsystem {
+ "x11" {
+ # add control to show/hide hidden files in the open panel (load
+ # the tk_getOpenFile dialog once, otherwise it will not work)
+ catch {tk_getOpenFile -with-invalid-argument}
+ set ::tk::dialog::file::showHiddenBtn 1
+ set ::tk::dialog::file::showHiddenVar 0
+ # set file types that open/save recognize
+ set ::filetypes {
+ {{pd files} {.pd} }
+ {{max patch files} {.pat} }
+ {{max text files} {.mxt} }
+ }
+ }
+ "aqua" {
+ # set file types that open/save recognize
+ set ::filetypes {
+ {{Pd Files} {.pd} }
+ {{Max Patch Files (.pat)} {.pat} }
+ {{Max Text Files (.mxt)} {.mxt} }
+ }
+ }
+ "win32" {
+ font create menufont -family Tahoma -size -11
+ # set file types that open/save recognize
+ set ::filetypes {
+ {{Pd Files} {.pd} }
+ {{Max Patch Files} {.pat} }
+ {{Max Text Files} {.mxt} }
+ }
+ }
+ }
+}
+
+# official GNU gettext msgcat shortcut
+if {[tk windowingsystem] ne "win32"} {
+ proc _ {s} {return [::msgcat::mc $s]}
+} else {
+ proc _ {s} {return $s}
+}
+
+proc load_locale {} {
+ ::msgcat::mcload [file join [file dirname [info script]] locale]
+
+ # for Windows
+ #set locale "en" ;# Use whatever is right for your app
+ #if {[catch {package require registry}]} {
+ # tk_messageBox -icon error -message "Could not get locale from registry"
+ #} else {
+ # set locale [string tolower \
+ # [string range \
+ # [registry get {HKEY_CURRENT_USER\Control Panel\International} sLanguage] 0 1] ]
+ #}
+
+ ##--moo: force default system and stdio encoding to UTF-8
+ encoding system utf-8
+ fconfigure stderr -encoding utf-8
+ fconfigure stdout -encoding utf-8
+ ##--/moo
+}
+
+# ------------------------------------------------------------------------------
+# font handling
+
+# this proc gets the internal font name associated with each size
+proc get_font_for_size {size} {
+ return "pd_font_${size}"
+}
+
+proc set_base_font {family weight} {
+ if {[lsearch -exact [font families] $family] > -1} {
+ set ::font_family $family
+ } else {
+ puts stderr "Error: Font family \"$family\" not found, using default: $::font_family"
+ }
+ if {[lsearch -exact {bold normal} $weight] > -1} {
+ set ::font_weight $weight
+ set using_defaults 0
+ } else {
+ puts stderr "Error: Font weight \"$weight\" not found, using default: $::font_weight"
+ }
+ puts stderr "Using FONT $::font_family $::font_weight"
+}
+
+# creates all the base fonts (i.e. pd_font_8 thru pd_font_36) so that they fit
+# into the metrics given by $::font_fixed_metrics for any given font/weight
+proc fit_font_into_metrics {} {
+# TODO the fonts picked seem too small, probably on fixed width
+ foreach {size width height} $::font_fixed_metrics {
+ set myfont [get_font_for_size $size]
+ font create $myfont -family $::font_family -weight $::font_weight \
+ -size [expr {-$height}]
+ set height2 $height
+ set giveup 0
+ while {[font measure $myfont M] > $width} {
+ incr height2 -1
+ font configure $myfont -size [expr {-$height2}]
+ if {$height2 * 2 <= $height} {
+ set giveup 1
+ puts "error: [lindex [info level 0] 0] failed to find a font of size $size fitting into a $width x $height cell! this system sucks"
+ break
+ }
+ }
+ if {$giveup} {continue}
+ }
+}
+
+
+# ------------------------------------------------------------------------------
+# procs called directly by pd
+
+proc pdtk_pd_startup {version {args ""}} {
+ # pdtk_post "pdtk_pd_startup $version $args"
+ # pdtk_post "\tversion: $version"
+ # pdtk_post "\targs: $args"
+ set oldtclversion 0
+ pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_fixed_metrics"
+ set_base_font [lindex $args 2] [lindex $args 3]
+ fit_font_into_metrics
+ # TODO what else is needed from the original?
+}
+
+##### routine to ask user if OK and, if so, send a message on to Pd ######
+proc pdtk_check {ignoredarg message reply_to_pd default} {
+ # TODO this should use -parent and -title, but the hard part is figuring
+ # out how to get the values for those without changing g_editor.c
+ set answer [tk_messageBox -type yesno -icon question \
+ -default $default -message $message]
+ if {$answer eq "yes"} {
+ pdsend $reply_to_pd
+ }
+}
+
+proc pdtk_fixwindowmenu {} {
+ #TODO figure out how to do this cleanly
+ puts stderr "Running pdtk_fixwindowmenu"
+}
+
+# ------------------------------------------------------------------------------
+# procs called directly by pd
+
+proc check_for_running_instances {} {
+## http://tcl.tk/man/tcl8.4/TkCmd/send.htm
+## This script fragment can be used to make an application that only
+## runs once on a particular display.
+#
+#if {[tk appname FoobarApp] ne "FoobarApp"} {
+# send -async FoobarApp RemoteStart $argv
+# exit
+#}
+## The command that will be called remotely, which raises
+## the application main window and opens the requested files
+#proc RemoteStart args {
+# raise .
+# foreach filename $args {
+# OpenFile $filename
+# }
+#}
+}
+
+proc load_startup {} {
+ global errorInfo
+ set pd_guidir "[pwd]/../startup"
+ # puts stderr "load_startup $pd_guidir"
+ if { ! [file isdirectory $pd_guidir]} { return }
+ foreach filename [glob -directory $pd_guidir -nocomplain -types {f} -- *.tcl] {
+ puts "Loading $filename"
+ set tclfile [open $filename]
+ set tclcode [read $tclfile]
+ close $tclfile
+ if {[catch {uplevel #0 $tclcode} errorname]} {
+ puts stderr "------------------------------------------------------"
+ puts stderr "UNHANDLED ERROR: $errorInfo"
+ puts stderr "FAILED TO LOAD $filename"
+ puts stderr "------------------------------------------------------"
+ }
+ }
+}
+
+# ------------------------------------------------------------------------------
+# main
+proc main {argc argv} {
+ catch {console show} ;# Not all platforms have the console command
+ post_tclinfo
+ pdtk_post "Starting pd.tcl with main($argc $argv)"
+ check_for_running_instances
+ if {[tk windowingsystem] ne "win32"} {load_locale}
+ init
+
+ # TODO check args for -stderr and set pdtk_post accordingly
+ if { $argc == 1 && [string is int [lindex $argv 0]]} {
+ # 'pd' started first and launched us, so get the port to connect to
+ ::pd_connect::to_pd [lindex $argv 0]
+ } else {
+ # the GUI is starting first, so create socket and exec 'pd'
+ set portnumber [::pd_connect::create_socket]
+ set pd_exec [file join [file dirname [info script]] ../bin/pd]
+ exec -- $pd_exec -guiport $portnumber &
+ #TODO add vwait so that pd-gui will exit if pd never shows up
+ }
+ ::pd_bindings::class_bindings
+ create_pdwindow
+ load_startup
+}
+
+main $::argc $::argv
+
+
+
+
+
+
diff --git a/pd/tcl/pd_bindings.tcl b/pd/tcl/pd_bindings.tcl
new file mode 100644
index 00000000..6ea91187
--- /dev/null
+++ b/pd/tcl/pd_bindings.tcl
@@ -0,0 +1,201 @@
+package provide pd_bindings 0.1
+
+package require pd_menucommands
+package require dialog_find
+
+namespace eval ::pd_bindings:: {
+ variable modifier
+
+ namespace export window_bindings
+ namespace export panel_bindings
+ namespace export canvas_bindings
+}
+
+proc ::pd_bindings::class_bindings {} {
+ # binding by class is not recursive, so its useful for certain things
+ bind CanvasWindow <Map> "::pd_bindings::map %W"
+ bind CanvasWindow <Unmap> "::pd_bindings::unmap %W"
+ bind CanvasWindow <Configure> "::pd_bindings::window_configure %W"
+ bind CanvasWindow <FocusIn> "::pd_bindings::window_focusin %W"
+ bind CanvasWindow <Activate> "::pd_bindings::window_focusin %W"
+}
+
+proc ::pd_bindings::window_bindings {mytoplevel} {
+ variable modifier
+
+ # for key bindings
+ # puts "::windowingsystem $::windowingsystem"
+ if {$::windowingsystem eq "aqua"} {
+ set modifier "Mod1"
+ } else {
+ set modifier "Control"
+ }
+
+ # File menu
+ bind $mytoplevel <$modifier-Key-b> "menu_helpbrowser"
+ bind $mytoplevel <$modifier-Key-f> "::dialog_find::menu_dialog_find $mytoplevel"
+ bind $mytoplevel <$modifier-Key-n> "menu_new"
+ bind $mytoplevel <$modifier-Key-o> "menu_open"
+ bind $mytoplevel <$modifier-Key-p> "menu_print $mytoplevel"
+ bind $mytoplevel <$modifier-Key-q> "pdsend \"pd verifyquit\""
+ bind $mytoplevel <$modifier-Key-r> "menu_raise_pdwindow"
+ bind $mytoplevel <$modifier-Shift-Key-L> "menu_clear_console"
+ bind $mytoplevel <$modifier-Shift-Key-Q> "pdsend \"pd quit\""
+ bind $mytoplevel <$modifier-Shift-Key-R> "menu_toggle_console"
+
+ # DSP control
+ bind $mytoplevel <$modifier-Key-slash> "pdsend \"pd dsp 1\""
+ bind $mytoplevel <$modifier-Key-period> "pdsend \"pd dsp 0\""
+}
+
+proc ::pd_bindings::pdwindow_bindings {mytoplevel} {
+ variable modifier
+
+ window_bindings $mytoplevel
+
+ # TODO update this to work with the console, if it is used
+ bind $mytoplevel <$modifier-Key-a> ".printout.text tag add sel 1.0 end"
+ bind $mytoplevel <$modifier-Key-x> "tk_textCut .printout.text"
+ bind $mytoplevel <$modifier-Key-c> "tk_textCopy .printout.text"
+ bind $mytoplevel <$modifier-Key-v> "tk_textPaste .printout.text"
+ bind $mytoplevel <$modifier-Key-w> { }
+
+ # Tcl event bindings
+ wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"pd verifyquit\""
+
+ # do window maintenance when entering the Pd window (Window menu, scrollbars, etc)
+ # bind $mytoplevel <FocusIn> "::pd_bindings::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
+
+ window_bindings $mytoplevel
+
+ bind $mytoplevel <KeyPress-Escape> [format "%s_cancel %s" $panelname $mytoplevel]
+ bind $mytoplevel <KeyPress-Return> [format "%s_ok %s" $panelname $mytoplevel]
+ bind $mytoplevel <$modifier-Key-w> [format "%s_cancel %s" $panelname $mytoplevel]
+
+ wm protocol $mytoplevel WM_DELETE_WINDOW "${panelname}_cancel $mytoplevel"
+
+ bind $mytoplevel <FocusIn> "::pd_bindings::panel_focusin %W"
+}
+
+proc ::pd_bindings::canvas_bindings {mytoplevel} {
+ variable modifier
+ set mycanvas $mytoplevel.c
+
+ window_bindings $mytoplevel
+
+ # key bindings -------------------------------------------------------------
+ bind $mytoplevel <$modifier-Key-1> "pdsend \"$mytoplevel obj\""
+ bind $mytoplevel <$modifier-Key-2> "pdsend \"$mytoplevel msg\""
+ bind $mytoplevel <$modifier-Key-3> "pdsend \"$mytoplevel floatatom\""
+ bind $mytoplevel <$modifier-Key-4> "pdsend \"$mytoplevel symbolatom\""
+ bind $mytoplevel <$modifier-Key-5> "pdsend \"$mytoplevel text\""
+ bind $mytoplevel <$modifier-Key-a> "pdsend \"$mytoplevel selectall\""
+ bind $mytoplevel <$modifier-Key-c> "pdsend \"$mytoplevel copy\""
+ bind $mytoplevel <$modifier-Key-d> "pdsend \"$mytoplevel duplicate\""
+ bind $mytoplevel <$modifier-Key-e> "pdsend \"$mytoplevel editmode 0\""
+ bind $mytoplevel <$modifier-Key-g> "pdsend \"$mytoplevel findagain\""
+ bind $mytoplevel <$modifier-Key-s> "pdsend \"$mytoplevel menusave\""
+ bind $mytoplevel <$modifier-Key-v> "pdsend \"$mytoplevel paste\""
+ bind $mytoplevel <$modifier-Key-w> "pdsend \"$mytoplevel menuclose 0\""
+ bind $mytoplevel <$modifier-Key-x> "pdsend \"$mytoplevel cut\""
+ bind $mytoplevel <$modifier-Key-z> "menu_undo $mytoplevel"
+ bind $mytoplevel <$modifier-Key-slash> "pdsend \"pd dsp 1\""
+ bind $mytoplevel <$modifier-Key-period> "pdsend \"pd dsp 0\""
+
+ # annoying, but Tk's bind needs uppercase letter to get the Shift
+ bind $mytoplevel <$modifier-Shift-Key-B> "pdsend \"$mytoplevel bng 1\""
+ bind $mytoplevel <$modifier-Shift-Key-C> "pdsend \"$mytoplevel mycnv 1\""
+ bind $mytoplevel <$modifier-Shift-Key-D> "pdsend \"$mytoplevel vradio 1\""
+ bind $mytoplevel <$modifier-Shift-Key-H> "pdsend \"$mytoplevel hslider 1\""
+ bind $mytoplevel <$modifier-Shift-Key-I> "pdsend \"$mytoplevel hradio 1\""
+ bind $mytoplevel <$modifier-Shift-Key-N> "pdsend \"$mytoplevel numbox 1\""
+ bind $mytoplevel <$modifier-Shift-Key-S> "pdsend \"$mytoplevel menusaveas\""
+ bind $mytoplevel <$modifier-Shift-Key-T> "pdsend \"$mytoplevel toggle 1\""
+ bind $mytoplevel <$modifier-Shift-Key-U> "pdsend \"$mytoplevel vumeter 1\""
+ bind $mytoplevel <$modifier-Shift-Key-V> "pdsend \"$mytoplevel vslider 1\""
+ bind $mytoplevel <$modifier-Shift-Key-W> "pdsend \"$mytoplevel menuclose 1\""
+ bind $mytoplevel <$modifier-Shift-Key-Z> "menu_redo $mytoplevel"
+
+ if {$::windowingsystem eq "aqua"} {
+ bind $mytoplevel <$modifier-Key-m> "menu_minimize $mytoplevel"
+ bind $mytoplevel <$modifier-Key-t> "menu_dialog_font $mytoplevel"
+ bind $mytoplevel <$modifier-quoteleft> "menu_raisenextwindow"
+ } else {
+ bind $mytoplevel <$modifier-Key-m> "menu_message_panel"
+ bind $mytoplevel <$modifier-Key-t> "menu_texteditor"
+ }
+
+ bind $mycanvas <Key> "pdsend_key %W 1 %K %A 0"
+ bind $mycanvas <Shift-Key> "pdsend_key %W 1 %K %A 1"
+ bind $mycanvas <KeyRelease> "pdsend_key %W 0 %K %A 0"
+
+ # mouse bindings -----------------------------------------------------------
+ # these need to be bound to $mytoplevel.c because %W will return $mytoplevel for
+ # events over the window frame and $mytoplevel.c for events over the canvas
+ bind $mycanvas <Motion> "pdtk_canvas_motion %W %x %y 0"
+ bind $mycanvas <Button-1> "pdtk_canvas_mouse %W %x %y %b 0"
+ bind $mycanvas <ButtonRelease-1> "pdtk_canvas_mouseup %W %x %y %b"
+ bind $mycanvas <$modifier-Button-1> "pdtk_canvas_mouse %W %x %y %b 2"
+ # TODO look into "virtual events' for a means for getting Shift-Button, etc.
+ switch -- $::windowingsystem {
+ "aqua" {
+ bind $mycanvas <Button-2> "pdtk_canvas_rightclick %W %x %y %b"
+ # on Mac OS X, make a rightclick with Ctrl-click for 1 button mice
+ bind $mycanvas <Control-Button-1> "pdtk_canvas_rightclick %W %x %y %b"
+ # TODO try replacing the above with this
+ #bind all <Control-Button-1> {event generate %W <Button-2> \
+ # -x %x -y %y -rootx %X -rooty %Y \
+ # -button 2 -time %t}
+ } "x11" {
+ bind $mycanvas <Button-3> "pdtk_canvas_rightclick %W %x %y %b"
+ # on X11, button 2 "pastes" from the X windows clipboard
+ bind $mycanvas <Button-2> "pdtk_canvas_clickpaste %W %x %y %b"
+ } "win32" {
+ bind $mycanvas <Button-3> "pdtk_canvas_rightclick %W %x %y %b"
+ }
+ }
+ #TODO bind $mytoplevel <MouseWheel>
+
+ # window protocol bindings
+ wm protocol $mytoplevel WM_DELETE_WINDOW "pdsend \"$mytoplevel menuclose 0\""
+}
+
+
+#------------------------------------------------------------------------------#
+# event handlers
+
+proc ::pd_bindings::window_configure {mytoplevel} {
+ pdtk_canvas_getscroll $mytoplevel
+}
+
+# do tasks when changing focus (Window menu, scrollbars, etc.)
+proc ::pd_bindings::window_focusin {mytoplevel} {
+ ::dialog_find::set_canvas_to_search $mytoplevel
+ ::pd_menucommands::set_menu_new_dir $mytoplevel
+ # TODO handle enabling/disabling the Undo and Redo menu items in Edit
+ # TODO handle enabling/disabling the Cut/Copy/Paste menu items in Edit
+ # TODO enable menu items that the Pd window or panels might have disabled
+}
+
+proc ::pd_bindings::panel_focusin {mytoplevel} {
+ # TODO disable things on the menus that don't work for panels
+}
+
+# "map" event tells us when the canvas becomes visible, and "unmap",
+# invisible. Invisibility means the Window Manager has minimized us. We
+# don't get a final "unmap" event when we destroy the window.
+proc ::pd_bindings::map {mytoplevel} {
+ # puts "map $mytoplevel [wm title $mytoplevel]"
+ pdsend "$mytoplevel map 1"
+}
+
+proc ::pd_bindings::unmap {mytoplevel} {
+ pdsend "$mytoplevel map 0"
+}
diff --git a/pd/tcl/pd_connect.tcl b/pd/tcl/pd_connect.tcl
new file mode 100644
index 00000000..6d900068
--- /dev/null
+++ b/pd/tcl/pd_connect.tcl
@@ -0,0 +1,90 @@
+
+package provide pd_connect 0.1
+
+namespace eval ::pd_connect:: {
+ variable pd_socket
+
+ namespace export to_pd
+ namespace export create_socket
+ namespace export pdsend
+}
+
+proc ::pd_connect::configure_socket {sock} {
+ fconfigure $sock -blocking 0 -buffering line -encoding utf-8;
+ fileevent $sock readable {::pd_connect::pd_readsocket ""}
+}
+
+# if pd opens first, it starts pd-gui, then pd-gui connects to the port pd sent
+proc ::pd_connect::to_pd {port} {
+ # puts "::pd_connect::to_pd"
+ variable pd_socket
+ # puts stderr "Connecting to localhost $port ..."
+ if {[catch {set pd_socket [socket localhost $port]}]} {
+ puts stderr "WARNING: connect to pd failed, retrying port $port."
+ after 1000 ::pd_connect::to_pd $port
+ return
+ }
+ ::pd_connect::configure_socket $pd_socket
+}
+
+# if pd-gui opens first, it creates socket and requests a port. The function
+# then returns the portnumber it receives. pd then connects to that port.
+proc ::pd_connect::create_socket {} {
+ if {[catch {set sock [socket -server ::pd_connect::from_pd -myaddr localhost 0]}]} {
+ puts stderr "ERROR: failed to allocate port, exiting!"
+ exit 3
+ }
+ return [lindex [fconfigure $sock -sockname] 2]
+}
+
+proc ::pd_connect::from_pd {channel clientaddr clientport} {
+ puts "::pd_connect::from_pd"
+ variable pd_socket $channel
+ puts "Connection from $clientaddr:$clientport registered"
+ ::pd_connect::configure_socket $pd_socket
+}
+
+# send a pd/FUDI message from Tcl to Pd. This function aims to behave like a
+# [; message( in Pd. Basically, whatever is in quotes after the proc name
+# will be sent as if it was sent from a message box with a leading semi-colon
+proc ::pd_connect::pdsend {message} {
+ variable pd_socket
+ append message \;
+ if {[catch {puts $pd_socket $message} errorname]} {
+ puts stderr "pdsend errorname: >>$errorname<<"
+ error "Not connected to 'pd' process"
+ }
+}
+
+proc ::pd_connect::pd_readsocket {cmd_from_pd} {
+ variable pd_socket
+ if {[eof $pd_socket]} {
+ # if we lose the socket connection, that means pd quit, so we quit
+ close $pd_socket
+ exit
+ }
+ append cmd_from_pd [read $pd_socket]
+ while {![info complete $cmd_from_pd] || \
+ [string index $cmd_from_pd end] != "\n"} {
+ append cmd_from_pd [read $pd_socket]
+ if {[eof $pd_socket]} {
+ close $pd_socket
+ exit
+ }
+ }
+# puts stderr [concat CMD: $cmd_from_pd :CMD]
+ if {[catch {uplevel #0 $cmd_from_pd} errorname]} {
+ global errorInfo
+ puts stderr "errorname: >>$errorname<<"
+ switch -regexp -- $errorname {
+ "missing close-brace" {
+ # TODO consider using [info complete $cmd_from_pd] in a loop
+ pd_readsocket $cmd_from_pd
+ } "^invalid command name" {
+ puts stderr "INVALID COMMAND NAME: $errorInfo"
+ } default {
+ puts stderr "UNHANDLED ERROR: $errorInfo"
+ }
+ }
+ }
+}
diff --git a/pd/tcl/pd_menucommands.tcl b/pd/tcl/pd_menucommands.tcl
new file mode 100644
index 00000000..6530c52a
--- /dev/null
+++ b/pd/tcl/pd_menucommands.tcl
@@ -0,0 +1,167 @@
+
+package provide pd_menucommands 0.1
+
+namespace eval ::pd_menucommands:: {
+ variable untitled_number "1"
+ variable menu_new_dir [pwd]
+ variable menu_open_dir [pwd]
+
+ namespace export menu_*
+}
+
+# ------------------------------------------------------------------------------
+# functions called from File menu
+
+proc ::pd_menucommands::menu_new {} {
+ variable untitled_number
+ variable menu_new_dir
+ if { ! [file isdirectory $menu_new_dir]} {set menu_new_dir $::env(HOME)}
+ pdsend "pd filename Untitled-$untitled_number [enquote_path $menu_new_dir]"
+ pdsend "#N canvas"
+ pdsend "#X pop 1"
+ incr untitled_number
+}
+
+proc ::pd_menucommands::menu_open {} {
+ variable menu_open_dir
+ if { ! [file isdirectory $menu_open_dir]} {set menu_open_dir $::env(HOME)}
+ set files [tk_getOpenFile -defaultextension .pd \
+ -multiple true \
+ -filetypes $::filetypes \
+ -initialdir $menu_open_dir]
+ if {$files ne ""} {
+ foreach filename $files {
+ puts "open_file $filename"
+ open_file $filename
+ }
+ set menu_open_dir [file dirname $filename]
+ }
+}
+
+proc ::pd_menucommands::menu_print {mytoplevel} {
+ set filename [tk_getSaveFile -initialfile pd.ps \
+ -defaultextension .ps \
+ -filetypes { {{postscript} {.ps}} }]
+ if {$filename != ""} {
+ $mytoplevel.c postscript -file $filename
+ }
+}
+
+# panel types:
+# global (only one): find, sendmessage, prefs, helpbrowser
+# per-canvas: font, canvas properties (created with a message from pd)
+# per object: gatom, iemgui, array, data structures (created with a message from pd)
+
+
+# ------------------------------------------------------------------------------
+# functions called from Edit menu
+
+proc menu_undo {mytoplevel} {
+ puts stderr "menu_undo $mytoplevel not implemented yet"
+}
+
+proc menu_redo {mytoplevel} {
+ puts stderr "menu_redo $mytoplevel not implemented yet"
+}
+
+# ------------------------------------------------------------------------------
+# open the panels
+
+proc ::pd_menucommands::menu_message_panel {} {
+ if {[winfo exists .send_message]} {
+ wm deiconify .send_message
+ raise .message
+ } else {
+ # TODO insert real message panel here
+ toplevel .send_message
+ wm title .send_message [_ "Send Message..."]
+ wm resizable .send_message 0 0
+ ::pd_bindings::panel_bindings .send_message "send_message"
+ frame .send_message.frame
+ label .send_message.label -text "message" -width 30 -height 15
+ pack .send_message.label .send_message.frame -side top -expand yes -fill both
+ }
+}
+
+
+proc ::pd_menucommands::menu_dialog_font {mytoplevel} {
+ if {[winfo exists .font]} {
+ wm deiconify .font
+ raise .font
+ } else {
+ # TODO insert real preference panel here
+ toplevel .font
+ wm title .font [_ "Font"]
+ ::pd_bindings::panel_bindings .font "font"
+ frame .font.frame
+ label .font.label -text "font" -width 30 -height 15
+ pack .font.label .font.frame -side top -expand yes -fill both
+ }
+}
+
+proc ::pd_menucommands::menu_path_panel {} {
+ if {[winfo exists .path]} {
+ raise .path
+ } else {
+ pdsend "pd start-path-dialog"
+ }
+}
+
+proc ::pd_menucommands::menu_startup_panel {} {
+ if {[winfo exists .startup]} {
+ raise .startup
+ } else {
+ pdsend "pd start-startup-dialog"
+ }
+}
+
+# ------------------------------------------------------------------------------
+# window management functions
+
+proc ::pd_menucommands::menu_minimize {mytoplevel} {
+ wm iconify $mytoplevel
+}
+
+proc ::pd_menucommands::menu_maximize {mytoplevel} {
+ wm state $mytoplevel zoomed
+}
+
+proc menu_raise_pdwindow {} {
+ set pd_window .
+ set top_window [lindex [wm stackorder $pd_window] end]
+ if {$pd_window eq $top_window} {
+ lower $pd_window
+ } else {
+ wm deiconify $pd_window
+ raise $pd_window
+ }
+}
+
+# ------------------------------------------------------------------------------
+# manage the saving of the directories for the new commands
+
+# this gets the dir from the path of a window's title
+proc ::pd_menucommands::set_menu_new_dir {mytoplevel} {
+ variable menu_new_dir
+ # TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath]
+ if {$mytoplevel eq "."} {
+ set menu_new_dir [pwd]
+ } else {
+ regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored menu_new_dir
+ }
+}
+
+# ------------------------------------------------------------------------------
+# Mac OS X specific functions
+
+proc ::pd_menucommands::menu_bringalltofront {} {
+ # use [winfo children .] here to include windows that are minimized
+ foreach item [winfo children .] {
+ # get all toplevel windows, exclude menubar windows
+ if { [string equal [winfo toplevel $item] $item] && \
+ [catch {$item cget -tearoff}]} {
+ wm deiconify $item
+ }
+ }
+ wm deiconify .
+}
diff --git a/pd/tcl/pd_menus.tcl b/pd/tcl/pd_menus.tcl
new file mode 100644
index 00000000..f8dc2469
--- /dev/null
+++ b/pd/tcl/pd_menus.tcl
@@ -0,0 +1,355 @@
+# Copyright (c) 1997-2009 Miller Puckette.
+#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
+
+package provide pd_menus 0.1
+
+package require pd_menucommands
+package require Tk
+#package require tile
+## replace Tk widgets with Ttk widgets on 8.5
+#namespace import -force ttk::*
+
+# TODO figure out Undo/Redo/Cut/Copy/Paste/DSP state changes for menus
+# TODO figure out parent window/window list for Window menu
+# TODO what is the Tcl package constructor or init()?
+
+
+
+# ------------------------------------------------------------------------------
+# global variables
+
+# TODO this should properly be inside the pd_menus namespace, now it is global
+namespace import ::pd_menucommands::*
+
+namespace eval ::pd_menus:: {
+ variable accelerator
+
+ namespace export create_menubar
+ namespace export configure_pdwindow
+
+ # turn off tearoff menus globally
+ option add *tearOff 0
+}
+
+# ------------------------------------------------------------------------------
+#
+proc ::pd_menus::create_menubar {mymenubar mytoplevel} {
+ variable accelerator
+ if {$::windowingsystem eq "aqua"} {
+ set accelerator "Cmd"
+ } else {
+ set accelerator "Ctrl"
+ }
+ menu $mymenubar
+ set menulist "file edit put find media window help"
+ if { $::windowingsystem eq "aqua" } {create_apple_menu $mymenubar}
+#TODO figure out why this took my menubars out? -msp
+# if { $::windowingsystem eq "win32" } {create_system_menu $mymenubar}
+ foreach mymenu $menulist {
+ menu $mymenubar.$mymenu
+ $mymenubar add cascade -label [_ [string totitle $mymenu]] \
+ -menu $mymenubar.$mymenu
+ [format build_%s_menu $mymenu] $mymenubar.$mymenu $mytoplevel
+ if {$::windowingsystem eq "win32"} {
+ # fix menu font size on Windows with tk scaling = 1
+ $mymenubar.$mymenu configure -font menufont
+ }
+ }
+}
+
+proc ::pd_menus::configure_pdwindow {mymenubar} {
+ # these are meaningless for the Pd window, so disable them
+ set file_items_to_disable {"Save" "Save As..." "Print..." "Close"}
+ foreach menuitem $file_items_to_disable {
+ $mymenubar.file entryconfigure [_ $menuitem] -state disabled
+ }
+ set edit_items_to_disable {"Undo" "Redo" "Duplicate" "Tidy Up" "Edit Mode"}
+ foreach menuitem $edit_items_to_disable {
+ $mymenubar.edit entryconfigure [_ $menuitem] -state disabled
+ }
+ # disable everything on the Put menu
+ for {set i 0} {$i <= [$mymenubar.put index end]} {incr i} {
+ # catch errors by trying to disable separators
+ catch {$mymenubar.put entryconfigure $i -state disabled }
+ }
+}
+
+# ------------------------------------------------------------------------------
+# menu building functions
+proc ::pd_menus::build_file_menu {mymenu mytoplevel} {
+ [format build_file_menu_%s $::windowingsystem] $mymenu
+ $mymenu entryconfigure [_ "New"] -command "menu_new"
+ $mymenu entryconfigure [_ "Open"] -command "menu_open"
+ $mymenu entryconfigure [_ "Save"] -command "pdsend \"$mytoplevel menusave\""
+ $mymenu entryconfigure [_ "Save As..."] -command "pdsend \"$mytoplevel menusaveas\""
+ # $mymenu entryconfigure "Revert*" -command "menu_revert $mytoplevel"
+ $mymenu entryconfigure [_ "Close"] -command "pdsend \"$mytoplevel menuclose 0\""
+ $mymenu entryconfigure [_ "Message"] -command "menu_message_panel"
+ $mymenu entryconfigure [_ "Print..."] -command "menu_print $mytoplevel"
+}
+
+proc ::pd_menus::build_edit_menu {mymenu mytoplevel} {
+ variable accelerator
+ $mymenu add command -label [_ "Undo"] -accelerator "$accelerator+Z" \
+ -command "menu_undo $mytoplevel"
+ $mymenu add command -label [_ "Redo"] -accelerator "Shift+$accelerator+Z" \
+ -command "menu_redo $mytoplevel"
+ $mymenu add separator
+ $mymenu add command -label [_ "Cut"] -accelerator "$accelerator+X" \
+ -command "pdsend \"$mytoplevel cut\""
+ $mymenu add command -label [_ "Copy"] -accelerator "$accelerator+C" \
+ -command "pdsend \"$mytoplevel copy\""
+ $mymenu add command -label [_ "Paste"] -accelerator "$accelerator+V" \
+ -command "pdsend \"$mytoplevel paste\""
+ $mymenu add command -label [_ "Duplicate"] -accelerator "$accelerator+D" \
+ -command "pdsend \"$mytoplevel duplicate\""
+ $mymenu add command -label [_ "Select All"] -accelerator "$accelerator+A" \
+ -command "pdsend \"$mytoplevel selectall\""
+ $mymenu add separator
+ if {$::windowingsystem eq "aqua"} {
+ $mymenu add command -label [_ "Text Editor"] \
+ -command "menu_texteditor $mytoplevel"
+ $mymenu add command -label [_ "Font"] -accelerator "$accelerator+T" \
+ -command "menu_dialog_font $mytoplevel"
+ } else {
+ $mymenu add command -label [_ "Text Editor"] -accelerator "$accelerator+T"\
+ -command "menu_texteditor $mytoplevel"
+ $mymenu add command -label [_ "Font"] \
+ -command "menu_dialog_font $mytoplevel"
+ }
+ $mymenu add command -label [_ "Tidy Up"] \
+ -command "pdsend \"$mytoplevel tidy\""
+ # $mymenu add command -label [_ "Toggle Console"] -accelerator "Shift+$accelerator+R" \
+ # -command {.controls.switches.console invoke}
+ # $mymenu add command -label [_ "Clear Console"] -accelerator "Shift+$accelerator+L" \
+ # -command "menu_clear_console"
+ $mymenu add separator
+ $mymenu add radiobutton -label [_ "Edit Mode"] -accelerator "$accelerator+E" \
+ -indicatoron true -selectcolor grey85 \
+ -command "pdsend \"$mytoplevel editmode 0\""
+ # if { $editable == 0 } {
+ # $mymenu entryconfigure "Edit Mode" -indicatoron false
+ # }
+
+ #if { ! [catch {console hide}]} {
+ # TODO set up menu item to show/hide the Tcl/Tk console, if it available
+ #}
+
+ if {$::windowingsystem ne "aqua"} {
+ $mymenu add separator
+ $mymenu add command -label [_ "Path..."] \
+ -command "menu_path_panel"
+ $mymenu add command -label [_ "Startup..."] \
+ -command "menu_startup_panel"
+ }
+}
+
+proc ::pd_menus::build_put_menu {mymenu mytoplevel} {
+ variable accelerator
+ $mymenu add command -label [_ "Object"] -accelerator "$accelerator+1" \
+ -command "pdsend \"$mytoplevel obj 0\""
+ $mymenu add command -label [_ "Message"] -accelerator "$accelerator+2" \
+ -command "pdsend \"$mytoplevel msg 0\""
+ $mymenu add command -label [_ "Number"] -accelerator "$accelerator+3" \
+ -command "pdsend \"$mytoplevel floatatom 0\""
+ $mymenu add command -label [_ "Symbol"] -accelerator "$accelerator+4" \
+ -command "pdsend \"$mytoplevel symbolatom 0\""
+ $mymenu add command -label [_ "Comment"] -accelerator "$accelerator+5" \
+ -command "pdsend \"$mytoplevel text 0\""
+ $mymenu add separator
+ $mymenu add command -label [_ "Bang"] -accelerator "Shift+$accelerator+B" \
+ -command "pdsend \"$mytoplevel bng 0\""
+ $mymenu add command -label [_ "Toggle"] -accelerator "Shift+$accelerator+T" \
+ -command "pdsend \"$mytoplevel toggle 0\""
+ $mymenu add command -label [_ "Number2"] -accelerator "Shift+$accelerator+N" \
+ -command "pdsend \"$mytoplevel numbox 0\""
+ $mymenu add command -label [_ "Vslider"] -accelerator "Shift+$accelerator+V" \
+ -command "pdsend \"$mytoplevel vslider 0\""
+ $mymenu add command -label [_ "Hslider"] -accelerator "Shift+$accelerator+H" \
+ -command "pdsend \"$mytoplevel hslider 0\""
+ $mymenu add command -label [_ "Vradio"] -accelerator "Shift+$accelerator+D" \
+ -command "pdsend \"$mytoplevel vradio 0\""
+ $mymenu add command -label [_ "Hradio"] -accelerator "Shift+$accelerator+I" \
+ -command "pdsend \"$mytoplevel hradio 0\""
+ $mymenu add command -label [_ "VU Meter"] -accelerator "Shift+$accelerator+U"\
+ -command "pdsend \"$mytoplevel vumeter 0\""
+ $mymenu add command -label [_ "Canvas"] -accelerator "Shift+$accelerator+C" \
+ -command "pdsend \"$mytoplevel mycnv 0\""
+ $mymenu add separator
+ $mymenu add command -label Graph -command "pdsend \"$mytoplevel graph\""
+ $mymenu add command -label Array -command "pdsend \"$mytoplevel menuarray\""
+}
+
+proc ::pd_menus::build_find_menu {mymenu mytoplevel} {
+ variable accelerator
+ $mymenu add command -label [_ "Find..."] -accelerator "$accelerator+F" \
+ -command "::dialog_find::menu_dialog_find $mytoplevel"
+ $mymenu add command -label [_ "Find Again"] -accelerator "$accelerator+G" \
+ -command "pdsend \"$mytoplevel findagain\""
+ $mymenu add command -label [_ "Find Last Error"] \
+ -command "pdsend \"$mytoplevel finderror\""
+}
+
+proc ::pd_menus::build_media_menu {mymenu mytoplevel} {
+ variable accelerator
+ $mymenu add radiobutton -label [_ "Audio ON"] -accelerator "$accelerator+/" \
+ -command "pdsend \"pd dsp 1\""
+ $mymenu add radiobutton -label [_ "Audio OFF"] -accelerator "$accelerator+." \
+ -command "pdsend \"pd dsp 0\"" -indicatoron true
+ $mymenu add separator
+ $mymenu add command -label [_ "Audio settings..."] \
+ -command "pdsend \"pd audio-properties\""
+ $mymenu add command -label [_ "MIDI settings..."] \
+ -command "pdsend \"pd midi-properties\""
+ $mymenu add separator
+ $mymenu add command -label [_ "Test Audio and MIDI..."] \
+ -command "menu_doc_open doc/7.stuff/tools testtone.pd"
+ $mymenu add command -label [_ "Load Meter"] \
+ -command "menu_doc_open doc/7.stuff/tools load-meter.pd"
+}
+
+proc ::pd_menus::build_window_menu {mymenu mytoplevel} {
+ variable accelerator
+ if {$::windowingsystem eq "aqua"} {
+ $mymenu add command -label [_ "Minimize"] -command "menu_minimize ." \
+ -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Zoom"] -command "menu_zoom ."
+ $mymenu add separator
+ }
+ $mymenu add command -label [_ "Parent Window"] \
+ -command "pdsend \"$mytoplevel findparent\""
+ $mymenu add command -label [_ "Pd window"] -command "menu_raise_pdwindow" \
+ -accelerator "$accelerator+R"
+ $mymenu add separator
+ if {$::windowingsystem eq "aqua"} {
+ $mymenu add command -label [_ "Bring All to Front"] \
+ -command "menu_bringalltofront"
+ $mymenu add separator
+ }
+}
+
+proc ::pd_menus::build_help_menu {mymenu mytoplevel} {
+ if {$::windowingsystem ne "aqua"} {
+ $mymenu add command -label {About Pd} \
+ -command "placeholder menu_doc_open doc/1.manual 1.introduction.txt"
+ }
+ $mymenu add command -label {HTML ...} \
+ -command "placeholder menu_doc_open doc/1.manual index.htm"
+ $mymenu add command -label {Browser ...} \
+ -command "placeholder menu_helpbrowser \$help_top_directory"
+}
+
+# ------------------------------------------------------------------------------
+# menu building functions for Mac OS X/aqua
+
+# for Mac OS X only
+proc ::pd_menus::create_apple_menu {mymenu} {
+ puts stderr BUILD_APPLE_MENU
+ # TODO this should open a Pd patch called about.pd
+ menu $mymenu.apple
+ $mymenu.apple add command -label [_ "About Pd"] \
+ -command "menu_doc_open doc/1.manual 1.introduction.txt"
+ $mymenu add cascade -label "Apple" -menu $mymenu.apple
+ $mymenu.apple add separator
+ # starting in 8.4.14, this is created automatically
+ set patchlevel [split [info patchlevel] .]
+ if {[lindex $patchlevel 1] < 5 && [lindex $patchlevel 2] < 14} {
+ $mymenu.apple add command -label [_ "Preferences..."] \
+ -command "menu_preferences_panel" -accelerator "Cmd+,"
+ }
+}
+
+proc ::pd_menus::build_file_menu_aqua {mymenu} {
+ variable accelerator
+ $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
+ $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
+ $mymenu add cascade -label [_ "Open Recent"]
+ $mymenu add separator
+ $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
+ $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
+ $mymenu add command -label [_ "Save As..."] -accelerator "$accelerator+Shift+S"
+ #$mymenu add command -label [_ "Save All"]
+ #$mymenu add command -label [_ "Revert to Saved"]
+ $mymenu add separator
+ $mymenu add command -label [_ "Message"]
+ $mymenu add separator
+ $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
+}
+
+# the "Edit", "Put", and "Find" menus do not have cross-platform differences
+
+proc ::pd_menus::build_media_menu_aqua {mymenu} {
+}
+
+proc ::pd_menus::build_window_menu_aqua {mymenu} {
+}
+
+# the "Help" does not have cross-platform differences
+
+# ------------------------------------------------------------------------------
+# menu building functions for UNIX/X11
+
+proc ::pd_menus::build_file_menu_x11 {mymenu} {
+ variable accelerator
+ $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
+ $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
+ $mymenu add separator
+ $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
+ $mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
+ # $mymenu add command -label "Revert"
+ $mymenu add separator
+ $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
+ $mymenu add separator
+ $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
+ $mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q" \
+ -command "pdsend \"pd verifyquit\""
+}
+
+# the "Edit", "Put", and "Find" menus do not have cross-platform differences
+
+proc ::pd_menus::build_media_menu_x11 {mymenu} {
+}
+
+proc ::pd_menus::build_window_menu_x11 {mymenu} {
+}
+
+# the "Help" does not have cross-platform differences
+
+# ------------------------------------------------------------------------------
+# menu building functions for Windows/Win32
+
+# for Windows only
+proc ::pd_menus::create_system_menu {mymenu} {
+ $mymenu add cascade -menu [menu $mymenu.system]
+ # TODO add Close, Minimize, etc and whatever else is on the little menu
+ # that is on the top left corner of the window frame
+}
+
+proc ::pd_menus::build_file_menu_win32 {mymenu} {
+ variable accelerator
+ $mymenu add command -label [_ "New"] -accelerator "$accelerator+N"
+ $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O"
+ $mymenu add separator
+ $mymenu add command -label [_ "Save"] -accelerator "$accelerator+S"
+ $mymenu add command -label [_ "Save As..."] -accelerator "Shift+$accelerator+S"
+ # $mymenu add command -label "Revert"
+ $mymenu add separator
+ $mymenu add command -label [_ "Message"] -accelerator "$accelerator+M"
+ $mymenu add command -label [_ "Print..."] -accelerator "$accelerator+P"
+ $mymenu add separator
+ $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W"
+ $mymenu add command -label [_ "Quit"] -accelerator "$accelerator+Q"\
+ -command "pdsend \"pd verifyquit\""
+}
+
+# the "Edit", "Put", and "Find" menus do not have cross-platform differences
+
+proc ::pd_menus::build_media_menu_win32 {mymenu} {
+}
+
+proc ::pd_menus::build_window_menu_win32 {mymenu} {
+}
+
+# the "Help" does not have cross-platform differences
+
diff --git a/pd/tcl/pdtk_array.tcl b/pd/tcl/pdtk_array.tcl
new file mode 100644
index 00000000..107a722c
--- /dev/null
+++ b/pd/tcl/pdtk_array.tcl
@@ -0,0 +1,346 @@
+package provide pdtk_array 0.1
+
+#### jsarlo #####
+proc pdtk_array_listview_setpage {arrayName page} {
+ global pd_array_listview_page
+ set pd_array_listview_page($arrayName) $page
+}
+
+proc pdtk_array_listview_changepage {arrayName np} {
+ global pd_array_listview_page
+ pdtk_array_listview_setpage \
+ $arrayName [expr $pd_array_listview_page($arrayName) + $np]
+ pdtk_array_listview_fillpage $arrayName
+}
+
+proc pdtk_array_listview_fillpage {arrayName} {
+ global pd_array_listview_page
+ global pd_array_listview_id
+ set windowName [format ".%sArrayWindow" $arrayName]
+ set topItem [expr [lindex [$windowName.lb yview] 0] * \
+ [$windowName.lb size]]
+
+ if {[winfo exists $windowName]} {
+ set cmd "$pd_array_listview_id($arrayName) \
+ arrayviewlistfillpage \
+ $pd_array_listview_page($arrayName) \
+ $topItem"
+
+ pdsend $cmd
+ }
+}
+
+proc pdtk_array_listview_new {id arrayName page} {
+ global pd_array_listview_page
+ global pd_array_listview_id
+ global fontname fontweight
+ set pd_array_listview_page($arrayName) $page
+ set pd_array_listview_id($arrayName) $id
+ set windowName [format ".%sArrayWindow" $arrayName]
+ if [winfo exists $windowName] then [destroy $windowName]
+ toplevel $windowName
+ wm protocol $windowName WM_DELETE_WINDOW \
+ "pdtk_array_listview_close $id $arrayName"
+ wm title $windowName [concat $arrayName "(list view)"]
+ # FIXME
+ set font 12
+ set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
+ -selectmode extended \
+ -relief solid -background white -borderwidth 1 \
+ -font [format {{%s} %d %s} $fontname $font $fontweight]\
+ -yscrollcommand "$windowName.lb.sb set"]
+ set $windowName.lb.sb [scrollbar $windowName.lb.sb \
+ -command "$windowName.lb yview" -orient vertical]
+ place configure $windowName.lb.sb -relheight 1 -relx 0.9 -relwidth 0.1
+ pack $windowName.lb -expand 1 -fill both
+ bind $windowName.lb <Double-ButtonPress-1> \
+ "pdtk_array_listview_edit $arrayName $page $font"
+ # handle copy/paste
+ if {[tk windowingsystem] eq "x11"} {
+ selection handle $windowName.lb \
+ "pdtk_array_listview_lbselection $arrayName"
+ } else {
+ if {[tk windowingsystem] eq "win32"} {
+ bind $windowName.lb <ButtonPress-3> \
+ "pdtk_array_listview_popup $arrayName"
+ }
+ }
+ set $windowName.prevBtn [button $windowName.prevBtn -text "<-" \
+ -command "pdtk_array_listview_changepage $arrayName -1"]
+ set $windowName.nextBtn [button $windowName.nextBtn -text "->" \
+ -command "pdtk_array_listview_changepage $arrayName 1"]
+ pack $windowName.prevBtn -side left -ipadx 20 -pady 10 -anchor s
+ pack $windowName.nextBtn -side right -ipadx 20 -pady 10 -anchor s
+ focus $windowName
+}
+
+proc pdtk_array_listview_lbselection {arrayName off size} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ set itemNums [$windowName.lb curselection]
+ set cbString ""
+ for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ append cbString "\n"
+ }
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ set last $cbString
+}
+
+# Win32 uses a popup menu for copy/paste
+proc pdtk_array_listview_popup {arrayName} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ if [winfo exists $windowName.popup] then [destroy $windowName.popup]
+ menu $windowName.popup -tearoff false
+ $windowName.popup add command -label {Copy} \
+ -command "pdtk_array_listview_copy $arrayName; \
+ destroy $windowName.popup"
+ $windowName.popup add command -label {Paste} \
+ -command "pdtk_array_listview_paste $arrayName; \
+ destroy $windowName.popup"
+ tk_popup $windowName.popup [winfo pointerx $windowName] \
+ [winfo pointery $windowName] 0
+}
+
+proc pdtk_array_listview_copy {arrayName} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ set itemNums [$windowName.lb curselection]
+ set cbString ""
+ for {set i 0} {$i < [expr [llength $itemNums] - 1]} {incr i} {
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ append cbString "\n"
+ }
+ set listItem [$windowName.lb get [lindex $itemNums $i]]
+ append cbString [string range $listItem \
+ [expr [string first ") " $listItem] + 2] \
+ end]
+ clipboard clear
+ clipboard append $cbString
+}
+
+proc pdtk_array_listview_paste {arrayName} {
+ global pd_array_listview_page
+ global pd_array_listview_pagesize
+ set cbString [selection get -selection CLIPBOARD]
+ set lbName [format ".%sArrayWindow.lb" $arrayName]
+ set itemNum [lindex [$lbName curselection] 0]
+ set splitChars ", \n"
+ set itemString [split $cbString $splitChars]
+ set flag 1
+ for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
+ if {[lindex $itemString $i] != {}} {
+ pdsend "$arrayName [expr $itemNum + \
+ [expr $counter + \
+ [expr $pd_array_listview_pagesize \
+ * $pd_array_listview_page($arrayName)]]] \
+ [lindex $itemString $i]"
+ incr counter
+ set flag 0
+ }
+ }
+}
+
+proc pdtk_array_listview_edit {arrayName page font} {
+ global pd_array_listview_entry
+ global fontname fontweight
+ set lbName [format ".%sArrayWindow.lb" $arrayName]
+ if {[winfo exists $lbName.entry]} {
+ pdtk_array_listview_update_entry \
+ $arrayName $pd_array_listview_entry($arrayName)
+ unset pd_array_listview_entry($arrayName)
+ }
+ set itemNum [$lbName index active]
+ set pd_array_listview_entry($arrayName) $itemNum
+ set bbox [$lbName bbox $itemNum]
+ set y [expr [lindex $bbox 1] - 4]
+ set $lbName.entry [entry $lbName.entry \
+ -font [format {{%s} %d %s} $fontname $font $fontweight]]
+ $lbName.entry insert 0 []
+ place configure $lbName.entry -relx 0 -y $y -relwidth 1
+ lower $lbName.entry
+ focus $lbName.entry
+ bind $lbName.entry <Return> \
+ "pdtk_array_listview_update_entry $arrayName $itemNum;"
+}
+
+proc pdtk_array_listview_update_entry {arrayName itemNum} {
+ global pd_array_listview_page
+ global pd_array_listview_pagesize
+ set lbName [format ".%sArrayWindow.lb" $arrayName]
+ set splitChars ", \n"
+ set itemString [split [$lbName.entry get] $splitChars]
+ set flag 1
+ for {set i 0; set counter 0} {$i < [llength $itemString]} {incr i} {
+ if {[lindex $itemString $i] != {}} {
+ pdsend [concat $arrayName [expr $itemNum + \
+ [expr $counter + \
+ [expr $pd_array_listview_pagesize \
+ * $pd_array_listview_page($arrayName)]]] \
+ [lindex $itemString $i] \;]
+ incr counter
+ set flag 0
+ }
+ }
+ pdtk_array_listview_fillpage $arrayName
+ destroy $lbName.entry
+}
+
+proc pdtk_array_listview_closeWindow {arrayName} {
+ set windowName [format ".%sArrayWindow" $arrayName]
+ destroy $windowName
+}
+
+proc pdtk_array_listview_close {id arrayName} {
+ pdtk_array_listview_closeWindow $arrayName
+ pdsend "$id arrayviewclose"
+}
+##### end jsarlo #####
+
+############ pdtk_array_dialog -- dialog window for arrays #########
+# see comments above (pdtk_gatom_dialog) about variable name handling
+
+proc array_apply {id} {
+ # strip "." from the TK id to make a variable name suffix
+ set vid [string trimleft $id .]
+ # for each variable, make a local variable to hold its name...
+ set var_array_name [concat array_name_$vid]
+ global $var_array_name
+ set var_array_n [concat array_n_$vid]
+ global $var_array_n
+ set var_array_saveit [concat array_saveit_$vid]
+ global $var_array_saveit
+ set var_array_drawasrects [concat array_drawasrects_$vid]
+ global $var_array_drawasrects
+ set var_array_otherflag [concat array_otherflag_$vid]
+ global $var_array_otherflag
+ set mofo [eval concat $$var_array_name]
+ if {[string index $mofo 0] == "$"} {
+ set mofo [string replace $mofo 0 0 #] }
+
+ set saveit [eval concat $$var_array_saveit]
+ set drawasrects [eval concat $$var_array_drawasrects]
+
+ pdsend "$id arraydialog $mofo [eval concat $$var_array_n] \
+ [expr $saveit + 2 * $drawasrects] [eval concat $$var_array_otherflag]"
+}
+
+# jsarlo
+proc array_viewlist {id} {
+ pdsend "$id arrayviewlistnew"
+}
+# end jsarlo
+
+proc array_cancel {id} {
+ pdsend "$id cancel"
+}
+
+proc array_ok {id} {
+ array_apply $id
+ array_cancel $id
+}
+
+proc pdtk_array_dialog {id name n flags newone} {
+ set vid [string trimleft $id .]
+
+ set var_array_name [concat array_name_$vid]
+ global $var_array_name
+ set var_array_n [concat array_n_$vid]
+ global $var_array_n
+ set var_array_saveit [concat array_saveit_$vid]
+ global $var_array_saveit
+ set var_array_drawasrects [concat array_drawasrects_$vid]
+ global $var_array_drawasrects
+ set var_array_otherflag [concat array_otherflag_$vid]
+ global $var_array_otherflag
+
+ set $var_array_name $name
+ set $var_array_n $n
+ set $var_array_saveit [expr ( $flags & 1 ) != 0]
+ set $var_array_drawasrects [expr ( $flags & 2 ) != 0]
+ set $var_array_otherflag 0
+
+ toplevel $id
+ wm title $id {array}
+ wm resizable $id 0 0
+ wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id]
+
+ ::pd_bindings::panel_bindings $id "array"
+
+ frame $id.name
+ pack $id.name -side top
+ label $id.name.label -text "name"
+ entry $id.name.entry -textvariable $var_array_name
+ pack $id.name.label $id.name.entry -side left
+
+ frame $id.n
+ pack $id.n -side top
+ label $id.n.label -text "size"
+ entry $id.n.entry -textvariable $var_array_n
+ pack $id.n.label $id.n.entry -side left
+
+ checkbutton $id.saveme -text {save contents} -variable $var_array_saveit \
+ -anchor w
+ pack $id.saveme -side top
+
+ frame $id.drawasrects
+ pack $id.drawasrects -side top
+ radiobutton $id.drawasrects.drawasrects0 -value 0 \
+ -variable $var_array_drawasrects \
+ -text "draw as points"
+ radiobutton $id.drawasrects.drawasrects1 -value 1 \
+ -variable $var_array_drawasrects \
+ -text "polygon"
+ radiobutton $id.drawasrects.drawasrects2 -value 2 \
+ -variable $var_array_drawasrects \
+ -text "bezier curve"
+ pack $id.drawasrects.drawasrects0 -side top -anchor w
+ pack $id.drawasrects.drawasrects1 -side top -anchor w
+ pack $id.drawasrects.drawasrects2 -side top -anchor w
+
+ if {$newone != 0} {
+ frame $id.radio
+ pack $id.radio -side top
+ radiobutton $id.radio.radio0 -value 0 \
+ -variable $var_array_otherflag \
+ -text "in new graph"
+ radiobutton $id.radio.radio1 -value 1 \
+ -variable $var_array_otherflag \
+ -text "in last graph"
+ pack $id.radio.radio0 -side top -anchor w
+ pack $id.radio.radio1 -side top -anchor w
+ } else {
+ checkbutton $id.deleteme -text {delete me} \
+ -variable $var_array_otherflag -anchor w
+ pack $id.deleteme -side top
+ }
+ # jsarlo
+ if {$newone == 0} {
+ button $id.listview -text {View list}\
+ -command "array_viewlist $id $name 0"
+ pack $id.listview -side left
+ }
+ # end jsarlo
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "array_cancel $id"
+ if {$newone == 0} {button $id.buttonframe.apply -text {Apply}\
+ -command "array_apply $id"}
+ button $id.buttonframe.ok -text {OK}\
+ -command "array_ok $id"
+ pack $id.buttonframe.cancel -side left -expand 1
+ if {$newone == 0} {pack $id.buttonframe.apply -side left -expand 1}
+ pack $id.buttonframe.ok -side left -expand 1
+
+ $id.name.entry select from 0
+ $id.name.entry select adjust end
+ focus $id.name.entry
+}
diff --git a/pd/tcl/pdtk_canvas.tcl b/pd/tcl/pdtk_canvas.tcl
new file mode 100644
index 00000000..656dd327
--- /dev/null
+++ b/pd/tcl/pdtk_canvas.tcl
@@ -0,0 +1,152 @@
+
+package provide pdtk_canvas 0.1
+
+package require pd_bindings
+
+namespace eval ::pdtk_canvas:: {
+}
+# keep track of the location of the popup
+set popup_xpix 0
+set popup_ypix 0
+
+#------------------------------------------------------------------------------#
+# canvas new/saveas
+
+proc pdtk_canvas_new {mytoplevel width height geometry editable} {
+ # TODO check size of window
+ toplevel $mytoplevel -width $width -height $height -class CanvasWindow
+ ::pd_menus::create_menubar $mytoplevel.menubar $mytoplevel
+ $mytoplevel configure -menu $mytoplevel.menubar
+
+ # TODO slide off screen windows into view
+ wm geometry $mytoplevel $geometry
+ if {$::windowingsystem eq "aqua"} { # no menubar, it can be small
+ wm minsize $mytoplevel 50 20
+ } else { # leave room for the menubar
+ wm minsize $mytoplevel 310 30
+ }
+ set mycanvas $mytoplevel.c
+ canvas $mycanvas -width $width -height $height -background white \
+ -highlightthickness 0
+ # TODO add scrollbars here
+ pack $mycanvas -side left -expand 1 -fill both
+
+ ::pd_bindings::canvas_bindings $mytoplevel
+
+ # the popup menu for the canvas
+ menu $mytoplevel.popup -tearoff false
+ $mytoplevel.popup add command -label [_ "Properties"] \
+ -command "popup_action $mytoplevel 0"
+ $mytoplevel.popup add command -label [_ "Open"] \
+ -command "popup_action $mytoplevel 1"
+ $mytoplevel.popup add command -label [_ "Help"] \
+ -command "popup_action $mytoplevel 2"
+
+ # give focus to the canvas so it gets the events rather than the window
+ focus $mycanvas
+}
+
+proc pdtk_canvas_saveas {name initialfile initialdir} {
+ if { ! [file isdirectory $initialdir]} {set initialdir $::env(HOME)}
+ set filename [tk_getSaveFile -initialfile $initialfile -initialdir $initialdir \
+ -defaultextension .pd -filetypes $::filetypes]
+ if {$filename eq ""} return; # they clicked cancel
+
+ set extension [file extension $filename]
+ set oldfilename $filename
+ set filename [regsub -- "$extension$" $filename [string tolower $extension]]
+ if { ! [regexp -- "\.(pd|pat|mxt)$" $filename]} {
+ # we need the file extention even on Mac OS X
+ set filename $filename.pd
+ }
+ # test again after downcasing and maybe adding a ".pd" on the end
+ if {$filename ne $oldfilename && [file exists $filename]} {
+ set answer [tk_messageBox -type okcancel -icon question -default cancel\
+ -message [_ "\"$filename\" already exists. Do you want to replace it?"]]
+ if {$answer eq "cancel"} return; # they clicked cancel
+ }
+ set dirname [file dirname $filename]
+ set basename [file tail $filename]
+ pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]"
+ set ::pd_menucommands::menu_new_dir $dirname
+}
+
+#------------------------------------------------------------------------------#
+# mouse usage
+
+proc pdtk_canvas_motion {mycanvas x y mods} {
+ set mytoplevel [winfo toplevel $mycanvas]
+ pdsend "$mytoplevel motion [$mycanvas canvasx $x] [$mycanvas canvasy $y] $mods"
+}
+
+proc pdtk_canvas_mouse {mycanvas x y b f} {
+ # TODO perhaps the Tcl/C function names should match "mouse" message
+ # rather than "mousedown" function
+ set mytoplevel [winfo toplevel $mycanvas]
+ pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b $f"
+}
+
+proc pdtk_canvas_mouseup {mycanvas x y b} {
+ set mytoplevel [winfo toplevel $mycanvas]
+ pdsend "$mytoplevel mouseup [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b"
+}
+
+proc pdtk_canvas_rightclick {mycanvas x y b} {
+ set mytoplevel [winfo toplevel $mycanvas]
+ pdsend "$mytoplevel mouse [$mycanvas canvasx $x] [$mycanvas canvasy $y] $b 8"
+}
+
+# on X11, button 2 pastes from X11 clipboard, so simulate normal paste actions
+proc pdtk_canvas_clickpaste {mycanvas x y b} {
+ pdtk_canvas_mouse $mycanvas $x $y $b 0
+ pdtk_canvas_mouseup $mycanvas $x $y $b
+ pdtk_pastetext
+}
+
+#------------------------------------------------------------------------------#
+# canvas popup menu
+
+proc popup_action {mytoplevel action} {
+ pdsend "$mytoplevel done-popup $action $::popup_xpix $::popup_ypix"
+}
+
+proc pdtk_canvas_popup {mytoplevel xpix ypix hasproperties hasopen} {
+ set ::popup_xpix $xpix
+ set ::popup_ypix $ypix
+ if {$hasproperties} {
+ $mytoplevel.popup entryconfigure 0 -state normal
+ } else {
+ $mytoplevel.popup entryconfigure 0 -state disabled
+ }
+ if {$hasopen} {
+ $mytoplevel.popup entryconfigure 1 -state normal
+ } else {
+ $mytoplevel.popup entryconfigure 1 -state disabled
+ }
+ set mycanvas "$mytoplevel.c"
+ tk_popup $mytoplevel.popup [expr $xpix + [winfo rootx $mycanvas]] \
+ [expr $ypix + [winfo rooty $mycanvas]] 0
+}
+
+
+#------------------------------------------------------------------------------#
+# procs for canvas events
+
+# check or uncheck the "edit" menu item
+proc pdtk_canvas_editval {mytoplevel value} {
+ $mytoplevel.menubar.edit invoke [_ "Edit Mode"]
+# $mytoplevel.menubar.edit entryconfigure "Edit Mode" -indicatoron $value
+ # TODO make this work
+}
+
+proc pdtk_canvas_getscroll {mycanvas} {
+ # TODO make this work
+ # the C code still sends a .c canvas, so get the toplevel
+ set mytoplevel [winfo toplevel $mycanvas]
+ # puts stderr "pdtk_canvas_getscroll $mycanvas"
+}
+
+proc pdtk_undomenu {args} {
+ # TODO make this work
+ puts "pdtk_undomenu $args"
+}
diff --git a/pd/tcl/pdtk_text.tcl b/pd/tcl/pdtk_text.tcl
new file mode 100644
index 00000000..bb37ccc3
--- /dev/null
+++ b/pd/tcl/pdtk_text.tcl
@@ -0,0 +1,20 @@
+
+package provide pdtk_text 0.1
+
+############ pdtk_text_new -- create a new text object #2###########
+proc pdtk_text_new {mycanvas canvasitem x y text font_size color} {
+ $mycanvas create text $x $y -tags $canvasitem -text $text -fill $color \
+ -anchor nw -font [get_font_for_size $font_size]
+ $mycanvas bind $canvasitem <Home> "$mycanvas icursor $canvasitem 0"
+ $mycanvas bind $canvasitem <End> "$mycanvas icursor $canvasitem end"
+ if {$::windowingsystem eq "aqua"} { # emacs bindings for Mac OS X
+ $mycanvas bind $canvasitem <Control-a> "$mycanvas icursor $canvasitem 0"
+ $mycanvas bind $canvasitem <Control-e> "$mycanvas icursor $canvasitem end"
+ }
+}
+
+################ pdtk_text_set -- change the text ##################
+proc pdtk_text_set {mycanvas canvasitem text} {
+ $mycanvas itemconfig $canvasitem -text $text
+}
+
diff --git a/pd/tcl/pkgIndex.tcl b/pd/tcl/pkgIndex.tcl
new file mode 100644
index 00000000..c6e6f7d8
--- /dev/null
+++ b/pd/tcl/pkgIndex.tcl
@@ -0,0 +1,23 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+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 dialog_find 0.1 [list source [file join $dir dialog_find.tcl]]
+package ifneeded dialog_font 0.1 [list source [file join $dir dialog_font.tcl]]
+package ifneeded dialog_gatom 0.1 [list source [file join $dir dialog_gatom.tcl]]
+package ifneeded dialog_iemgui 0.1 [list source [file join $dir dialog_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]]
+package ifneeded pdtk_array 0.1 [list source [file join $dir pdtk_array.tcl]]
+package ifneeded pdtk_canvas 0.1 [list source [file join $dir pdtk_canvas.tcl]]
+package ifneeded pdtk_text 0.1 [list source [file join $dir pdtk_text.tcl]]
+package ifneeded wheredoesthisgo 0.1 [list source [file join $dir wheredoesthisgo.tcl]]
diff --git a/pd/tcl/pkg_mkIndex.tcl b/pd/tcl/pkg_mkIndex.tcl
new file mode 100755
index 00000000..12f3ba47
--- /dev/null
+++ b/pd/tcl/pkg_mkIndex.tcl
@@ -0,0 +1,9 @@
+#!/usr/bin/tclsh
+
+puts stdout "Watch out, this doesn't work on packages with namespace import"
+pkg_mkIndex -verbose -- [pwd] *.tcl *.[info sharedlibextension]
+
+## this currently needs to be added to pkg_mkIndex manually, ug
+#package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]]
+
+
diff --git a/pd/tcl/wheredoesthisgo.tcl b/pd/tcl/wheredoesthisgo.tcl
new file mode 100644
index 00000000..148f9878
--- /dev/null
+++ b/pd/tcl/wheredoesthisgo.tcl
@@ -0,0 +1,1054 @@
+
+package provide wheredoesthisgo 0.1
+
+# a place to temporarily store things until they find a home or go away
+
+set help_top_directory ""
+
+
+proc post_tclinfo {} {
+ pdtk_post "Tcl library: [info library]"
+ pdtk_post "executable: [info nameofexecutable]"
+ pdtk_post "tclversion: [info tclversion]"
+ pdtk_post "patchlevel: [info patchlevel]"
+ pdtk_post "sharedlibextension: [info sharedlibextension]"
+}
+
+
+proc placeholder {args} {
+ # PLACEHOLDER
+ pdtk_post "PLACEHOLDER $args"
+}
+
+
+proc open_file {filename} {
+ set directory [file dirname $filename]
+ set basename [file tail $filename]
+ if {[regexp -nocase -- "\.(pd|pat|mxt)$" $filename]} {
+ pdsend "pd open [enquote_path $basename] [enquote_path $directory]"
+ }
+}
+
+# ------------------------------------------------------------------------------
+# quoting functions
+
+# enquote a filename to send it to pd, " isn't handled properly tho...
+proc enquote_path {message} {
+ string map {"," "\\," ";" "\\;" " " "\\ "} $message
+}
+
+#enquote a string to send it to Pd. Blow off semi and comma; alias spaces
+#we also blow off "{", "}", "\" because they'll just cause bad trouble later.
+proc unspace_text {x} {
+ set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
+ if {$y == ""} {set y "empty"}
+ concat $y
+}
+
+
+#------------------------------------------------------------------------------#
+# key usage
+
+proc pdsend_key {mycanvas state key iso shift} {
+ # TODO canvas_key on the C side should be refactored with this proc as well
+ switch -- $key {
+ "BackSpace" { set iso ""; set key 8 }
+ "Tab" { set iso ""; set key 9 }
+ "Return" { set iso ""; set key 10 }
+ "Escape" { set iso ""; set key 27 }
+ "Space" { set iso ""; set key 32 }
+ "Delete" { set iso ""; set key 127 }
+ "KP_Delete" { set iso ""; set key 127 }
+ }
+ if {$iso != ""} {
+ scan $iso %c key
+ }
+ pdsend "[winfo toplevel $mycanvas] key $state $key $shift"
+}
+
+# ------------------------------------------------------------------------------
+# lost pdtk functions...
+
+# set the checkbox on the "Compute Audio" menuitem and checkbox
+proc pdtk_pd_dsp {value} {
+ if {$value eq "ON"} {
+ #TODO
+ } else {
+ }
+}
+
+proc pdtk_pd_dio {red} {
+ # puts stderr [concat pdtk_pd_dio $red]
+}
+
+
+proc pdtk_watchdog {} {
+ pdsend "pd watchdog"
+ after 2000 {pdtk_watchdog}
+}
+
+
+proc pdtk_ping {} {
+ pdsend "pd ping"
+}
+
+# ------------------------------------------------------------------------------
+# kludges to avoid changing C code
+
+proc .mbar.find {command number} {
+ # this should be changed in g_canvas.c, around line 800
+ .menubar.find $command $number
+}
+
+# ------------------------------------------------------------------------------
+# stuff Miller added to get up and running...
+
+proc menu_doc_open {dirname basename} {
+ global argv0
+ set slashed $argv0
+ if {[tk windowingsystem] eq "win32"} {
+ set slashed [string map {"\\" "/"} $slashed]
+ }
+
+ set pddir [string range $slashed 0 [expr [string last / $slashed ] - 1]]
+
+ if {[regexp ".*\.(txt|c)$" $basename]} {
+ menu_opentext $pddir/../$dirname/$basename
+ } elseif {[regexp ".*\.html?$" $basename]} {
+ menu_openhtml $pddir/../$dirname/$basename
+ } else {
+ pdsend [concat pd open [enquote_path $basename] \
+ [enquote_path $pddir/../$dirname] \;]
+ }
+}
+
+set pd_window_exists 0
+
+proc create_pdwindow {} {
+ global pd_window_exists
+ set pd_window_exists 1
+ wm title . [_ "Pd window"]
+ wm geometry . +500+50
+
+ frame .printout
+ text .printout.text -relief raised -bd 2 -font console_font \
+ -yscrollcommand ".printout.scroll set" -width 80
+ # .printout.text insert end "\n\n\n\n\n\n\n\n\n\n"
+ scrollbar .printout.scroll -command ".printout.text yview"
+ pack .printout.scroll -side right -fill y
+ pack .printout.text -side left -fill both -expand 1
+ pack .printout -side bottom -fill both -expand 1
+
+ ::pd_menus::create_menubar .menubar .
+ . configure -menu .menubar -width 400 -height 250
+ ::pd_menus::configure_pdwindow .menubar
+ ::pd_bindings::pdwindow_bindings .
+}
+
+proc pdtk_post {message} {
+ global pd_window_exists
+ if {$pd_window_exists} {
+ .printout.text insert end $message
+ .printout.text yview end-2char
+ } else {
+ puts stderr $message
+ }
+}
+
+proc pdtk_standardkeybindings {id} {
+ bind $id <Control-Key> {pdtk_pd_ctrlkey %W %K 0}
+ bind $id <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1}
+ if {[tk windowingsystem] eq "win32"} {
+ bind $id <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
+ bind $id <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
+ }
+}
+
+proc pdtk_encodedialog {x} {
+ concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
+}
+
+####################### audio dialog ##################3
+
+proc audio_apply {id} {
+ global audio_indev1 audio_indev2 audio_indev3 audio_indev4
+ global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
+ global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
+ global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
+ global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
+ global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
+ global audio_sr audio_advance audio_callback
+
+ pdsend [concat pd audio-dialog \
+ $audio_indev1 \
+ $audio_indev2 \
+ $audio_indev3 \
+ $audio_indev4 \
+ [expr $audio_inchan1 * ( $audio_inenable1 ? 1 : -1 ) ]\
+ [expr $audio_inchan2 * ( $audio_inenable2 ? 1 : -1 ) ]\
+ [expr $audio_inchan3 * ( $audio_inenable3 ? 1 : -1 ) ]\
+ [expr $audio_inchan4 * ( $audio_inenable4 ? 1 : -1 ) ]\
+ $audio_outdev1 \
+ $audio_outdev2 \
+ $audio_outdev3 \
+ $audio_outdev4 \
+ [expr $audio_outchan1 * ( $audio_outenable1 ? 1 : -1 ) ]\
+ [expr $audio_outchan2 * ( $audio_outenable2 ? 1 : -1 ) ]\
+ [expr $audio_outchan3 * ( $audio_outenable3 ? 1 : -1 ) ]\
+ [expr $audio_outchan4 * ( $audio_outenable4 ? 1 : -1 ) ]\
+ $audio_sr \
+ $audio_advance \
+ $audio_callback \
+ \;]
+}
+
+proc audio_cancel {id} {
+ pdsend [concat $id cancel \;]
+}
+
+proc audio_ok {id} {
+ audio_apply $id
+ audio_cancel $id
+}
+
+# callback from popup menu
+proc audio_popup_action {buttonname varname devlist index} {
+ global audio_indevlist audio_outdevlist $varname
+ $buttonname configure -text [lindex $devlist $index]
+# puts stderr [concat popup_action $buttonname $varname $index]
+ set $varname $index
+}
+
+# create a popup menu
+proc audio_popup {name buttonname varname devlist} {
+ if [winfo exists $name.popup] {destroy $name.popup}
+ menu $name.popup -tearoff false
+ if {[tk windowingsystem] eq "win32"} {
+ $name.popup configure -font menuFont
+ }
+# puts stderr [concat $devlist ]
+ for {set x 0} {$x<[llength $devlist]} {incr x} {
+ $name.popup add command -label [lindex $devlist $x] \
+ -command [list audio_popup_action \
+ $buttonname $varname $devlist $x]
+ }
+ tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
+}
+
+# start a dialog window to select audio devices and settings. "multi"
+# is 0 if only one device is allowed; 1 if one apiece may be specified for
+# input and output; and 2 if we can select multiple devices. "longform"
+# (which only makes sense if "multi" is 2) asks us to make controls for
+# opening several devices; if not, we get an extra button to turn longform
+# on and restart the dialog.
+
+proc pdtk_audio_dialog {id indev1 indev2 indev3 indev4 \
+ inchan1 inchan2 inchan3 inchan4 \
+ outdev1 outdev2 outdev3 outdev4 \
+ outchan1 outchan2 outchan3 outchan4 sr advance multi callback \
+ longform} {
+ global audio_indev1 audio_indev2 audio_indev3 audio_indev4
+ global audio_inchan1 audio_inchan2 audio_inchan3 audio_inchan4
+ global audio_inenable1 audio_inenable2 audio_inenable3 audio_inenable4
+ global audio_outdev1 audio_outdev2 audio_outdev3 audio_outdev4
+ global audio_outchan1 audio_outchan2 audio_outchan3 audio_outchan4
+ global audio_outenable1 audio_outenable2 audio_outenable3 audio_outenable4
+ global audio_sr audio_advance audio_callback
+ global audio_indevlist audio_outdevlist
+ global pd_indev pd_outdev
+
+ set audio_indev1 $indev1
+ set audio_indev2 $indev2
+ set audio_indev3 $indev3
+ set audio_indev4 $indev4
+
+ set audio_inchan1 [expr ( $inchan1 > 0 ? $inchan1 : -$inchan1 ) ]
+ set audio_inenable1 [expr $inchan1 > 0 ]
+ set audio_inchan2 [expr ( $inchan2 > 0 ? $inchan2 : -$inchan2 ) ]
+ set audio_inenable2 [expr $inchan2 > 0 ]
+ set audio_inchan3 [expr ( $inchan3 > 0 ? $inchan3 : -$inchan3 ) ]
+ set audio_inenable3 [expr $inchan3 > 0 ]
+ set audio_inchan4 [expr ( $inchan4 > 0 ? $inchan4 : -$inchan4 ) ]
+ set audio_inenable4 [expr $inchan4 > 0 ]
+
+ set audio_outdev1 $outdev1
+ set audio_outdev2 $outdev2
+ set audio_outdev3 $outdev3
+ set audio_outdev4 $outdev4
+
+ set audio_outchan1 [expr ( $outchan1 > 0 ? $outchan1 : -$outchan1 ) ]
+ set audio_outenable1 [expr $outchan1 > 0 ]
+ set audio_outchan2 [expr ( $outchan2 > 0 ? $outchan2 : -$outchan2 ) ]
+ set audio_outenable2 [expr $outchan2 > 0 ]
+ set audio_outchan3 [expr ( $outchan3 > 0 ? $outchan3 : -$outchan3 ) ]
+ set audio_outenable3 [expr $outchan3 > 0 ]
+ set audio_outchan4 [expr ( $outchan4 > 0 ? $outchan4 : -$outchan4 ) ]
+ set audio_outenable4 [expr $outchan4 > 0 ]
+
+ set audio_sr $sr
+ set audio_advance $advance
+ set audio_callback $callback
+ toplevel $id
+ wm title $id {audio}
+ wm protocol $id WM_DELETE_WINDOW [concat audio_cancel $id]
+
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "audio_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "audio_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "audio_ok $id"
+ button $id.buttonframe.save -text {Save all settings}\
+ -command "audio_apply $id \; pdsend \"pd save-preferences\""
+ pack $id.buttonframe.cancel $id.buttonframe.apply $id.buttonframe.ok \
+ $id.buttonframe.save -side left -expand 1
+
+ # sample rate and advance
+ frame $id.srf
+ pack $id.srf -side top
+
+ label $id.srf.l1 -text "sample rate:"
+ entry $id.srf.x1 -textvariable audio_sr -width 7
+ label $id.srf.l2 -text "delay (msec):"
+ entry $id.srf.x2 -textvariable audio_advance -width 4
+ pack $id.srf.l1 $id.srf.x1 $id.srf.l2 $id.srf.x2 -side left
+ if {$audio_callback >= 0} {
+ checkbutton $id.srf.x3 -variable audio_callback \
+ -text {use callbacks} -anchor e
+ pack $id.srf.x3 -side left
+ }
+ # input device 1
+ frame $id.in1f
+ pack $id.in1f -side top
+
+ checkbutton $id.in1f.x0 -variable audio_inenable1 \
+ -text {input device 1} -anchor e
+ button $id.in1f.x1 -text [lindex $audio_indevlist $audio_indev1] \
+ -command [list audio_popup $id $id.in1f.x1 audio_indev1 $audio_indevlist]
+ label $id.in1f.l2 -text "channels:"
+ entry $id.in1f.x2 -textvariable audio_inchan1 -width 3
+ pack $id.in1f.x0 $id.in1f.x1 $id.in1f.l2 $id.in1f.x2 -side left
+
+ # input device 2
+ if {$longform && $multi > 1 && [llength $audio_indevlist] > 1} {
+ frame $id.in2f
+ pack $id.in2f -side top
+
+ checkbutton $id.in2f.x0 -variable audio_inenable2 \
+ -text {input device 2} -anchor e
+ button $id.in2f.x1 -text [lindex $audio_indevlist $audio_indev2] \
+ -command [list audio_popup $id $id.in2f.x1 audio_indev2 \
+ $audio_indevlist]
+ label $id.in2f.l2 -text "channels:"
+ entry $id.in2f.x2 -textvariable audio_inchan2 -width 3
+ pack $id.in2f.x0 $id.in2f.x1 $id.in2f.l2 $id.in2f.x2 -side left
+ }
+
+ # input device 3
+ if {$longform && $multi > 1 && [llength $audio_indevlist] > 2} {
+ frame $id.in3f
+ pack $id.in3f -side top
+
+ checkbutton $id.in3f.x0 -variable audio_inenable3 \
+ -text {input device 3} -anchor e
+ button $id.in3f.x1 -text [lindex $audio_indevlist $audio_indev3] \
+ -command [list audio_popup $id $id.in3f.x1 audio_indev3 \
+ $audio_indevlist]
+ label $id.in3f.l2 -text "channels:"
+ entry $id.in3f.x2 -textvariable audio_inchan3 -width 3
+ pack $id.in3f.x0 $id.in3f.x1 $id.in3f.l2 $id.in3f.x2 -side left
+ }
+
+ # input device 4
+ if {$longform && $multi > 1 && [llength $audio_indevlist] > 3} {
+ frame $id.in4f
+ pack $id.in4f -side top
+
+ checkbutton $id.in4f.x0 -variable audio_inenable4 \
+ -text {input device 4} -anchor e
+ button $id.in4f.x1 -text [lindex $audio_indevlist $audio_indev4] \
+ -command [list audio_popup $id $id.in4f.x1 audio_indev4 \
+ $audio_indevlist]
+ label $id.in4f.l2 -text "channels:"
+ entry $id.in4f.x2 -textvariable audio_inchan4 -width 3
+ pack $id.in4f.x0 $id.in4f.x1 $id.in4f.l2 $id.in4f.x2 -side left
+ }
+
+ # output device 1
+ frame $id.out1f
+ pack $id.out1f -side top
+
+ checkbutton $id.out1f.x0 -variable audio_outenable1 \
+ -text {output device 1} -anchor e
+ if {$multi == 0} {
+ label $id.out1f.l1 \
+ -text "(same as input device) .............. "
+ } else {
+ button $id.out1f.x1 -text [lindex $audio_outdevlist $audio_outdev1] \
+ -command [list audio_popup $id $id.out1f.x1 audio_outdev1 \
+ $audio_outdevlist]
+ }
+ label $id.out1f.l2 -text "channels:"
+ entry $id.out1f.x2 -textvariable audio_outchan1 -width 3
+ if {$multi == 0} {
+ pack $id.out1f.x0 $id.out1f.l1 $id.out1f.x2 -side left
+ } else {
+ pack $id.out1f.x0 $id.out1f.x1 $id.out1f.l2 $id.out1f.x2 -side left
+ }
+
+ # output device 2
+ if {$longform && $multi > 1 && [llength $audio_outdevlist] > 1} {
+ frame $id.out2f
+ pack $id.out2f -side top
+
+ checkbutton $id.out2f.x0 -variable audio_outenable2 \
+ -text {output device 2} -anchor e
+ button $id.out2f.x1 -text [lindex $audio_outdevlist $audio_outdev2] \
+ -command \
+ [list audio_popup $id $id.out2f.x1 audio_outdev2 $audio_outdevlist]
+ label $id.out2f.l2 -text "channels:"
+ entry $id.out2f.x2 -textvariable audio_outchan2 -width 3
+ pack $id.out2f.x0 $id.out2f.x1 $id.out2f.l2 $id.out2f.x2 -side left
+ }
+
+ # output device 3
+ if {$longform && $multi > 1 && [llength $audio_outdevlist] > 2} {
+ frame $id.out3f
+ pack $id.out3f -side top
+
+ checkbutton $id.out3f.x0 -variable audio_outenable3 \
+ -text {output device 3} -anchor e
+ button $id.out3f.x1 -text [lindex $audio_outdevlist $audio_outdev3] \
+ -command \
+ [list audio_popup $id $id.out3f.x1 audio_outdev3 $audio_outdevlist]
+ label $id.out3f.l2 -text "channels:"
+ entry $id.out3f.x2 -textvariable audio_outchan3 -width 3
+ pack $id.out3f.x0 $id.out3f.x1 $id.out3f.l2 $id.out3f.x2 -side left
+ }
+
+ # output device 4
+ if {$longform && $multi > 1 && [llength $audio_outdevlist] > 3} {
+ frame $id.out4f
+ pack $id.out4f -side top
+
+ checkbutton $id.out4f.x0 -variable audio_outenable4 \
+ -text {output device 4} -anchor e
+ button $id.out4f.x1 -text [lindex $audio_outdevlist $audio_outdev4] \
+ -command \
+ [list audio_popup $id $id.out4f.x1 audio_outdev4 $audio_outdevlist]
+ label $id.out4f.l2 -text "channels:"
+ entry $id.out4f.x2 -textvariable audio_outchan4 -width 3
+ pack $id.out4f.x0 $id.out4f.x1 $id.out4f.l2 $id.out4f.x2 -side left
+ }
+
+ # if not the "long form" but if "multi" is 2, make a button to
+ # restart with longform set.
+
+ if {$longform == 0 && $multi > 1} {
+ frame $id.longbutton
+ pack $id.longbutton -side top
+ button $id.longbutton.b -text {use multiple devices} \
+ -command {pdsend "pd audio-properties 1"}
+ pack $id.longbutton.b
+ }
+ bind $id.srf.x1 <KeyPress-Return> [concat audio_ok $id]
+ bind $id.srf.x2 <KeyPress-Return> [concat audio_ok $id]
+ bind $id.in1f.x2 <KeyPress-Return> [concat audio_ok $id]
+ bind $id.out1f.x2 <KeyPress-Return> [concat audio_ok $id]
+ $id.srf.x1 select from 0
+ $id.srf.x1 select adjust end
+ focus $id.srf.x1
+ pdtk_standardkeybindings $id.srf.x1
+ pdtk_standardkeybindings $id.srf.x2
+ pdtk_standardkeybindings $id.in1f.x2
+ pdtk_standardkeybindings $id.out1f.x2
+}
+
+####################### midi dialog ##################
+
+proc midi_apply {id} {
+ global midi_indev1 midi_indev2 midi_indev3 midi_indev4
+ global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
+ global midi_alsain midi_alsaout
+
+ pdsend [concat pd midi-dialog \
+ $midi_indev1 \
+ $midi_indev2 \
+ $midi_indev3 \
+ $midi_indev4 \
+ $midi_outdev1 \
+ $midi_outdev2 \
+ $midi_outdev3 \
+ $midi_outdev4 \
+ $midi_alsain \
+ $midi_alsaout \
+ \;]
+}
+
+proc midi_cancel {id} {
+ pdsend [concat $id cancel \;]
+}
+
+proc midi_ok {id} {
+ midi_apply $id
+ midi_cancel $id
+}
+
+# callback from popup menu
+proc midi_popup_action {buttonname varname devlist index} {
+ global midi_indevlist midi_outdevlist $varname
+ $buttonname configure -text [lindex $devlist $index]
+# puts stderr [concat popup_action $buttonname $varname $index]
+ set $varname $index
+}
+
+# create a popup menu
+proc midi_popup {name buttonname varname devlist} {
+ if [winfo exists $name.popup] {destroy $name.popup}
+ menu $name.popup -tearoff false
+ if {[tk windowingsystem] eq "win32"} {
+ $name.popup configure -font menuFont
+ }
+# puts stderr [concat $devlist ]
+ for {set x 0} {$x<[llength $devlist]} {incr x} {
+ $name.popup add command -label [lindex $devlist $x] \
+ -command [list midi_popup_action \
+ $buttonname $varname $devlist $x]
+ }
+ tk_popup $name.popup [winfo pointerx $name] [winfo pointery $name] 0
+}
+
+# start a dialog window to select midi devices. "longform" asks us to make
+# controls for opening several devices; if not, we get an extra button to
+# turn longform on and restart the dialog.
+proc pdtk_midi_dialog {id indev1 indev2 indev3 indev4 \
+ outdev1 outdev2 outdev3 outdev4 longform} {
+ global midi_indev1 midi_indev2 midi_indev3 midi_indev4
+ global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
+ global midi_indevlist midi_outdevlist
+ global midi_alsain midi_alsaout
+
+ set midi_indev1 $indev1
+ set midi_indev2 $indev2
+ set midi_indev3 $indev3
+ set midi_indev4 $indev4
+ set midi_outdev1 $outdev1
+ set midi_outdev2 $outdev2
+ set midi_outdev3 $outdev3
+ set midi_outdev4 $outdev4
+ set midi_alsain [llength $midi_indevlist]
+ set midi_alsaout [llength $midi_outdevlist]
+
+ toplevel $id
+ wm title $id {midi}
+ wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id]
+
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "midi_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "midi_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "midi_ok $id"
+ pack $id.buttonframe.cancel -side left -expand 1
+ pack $id.buttonframe.apply -side left -expand 1
+ pack $id.buttonframe.ok -side left -expand 1
+
+ # input device 1
+ frame $id.in1f
+ pack $id.in1f -side top
+
+ label $id.in1f.l1 -text "input device 1:"
+ button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
+ -command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
+ pack $id.in1f.l1 $id.in1f.x1 -side left
+
+ # input device 2
+ if {$longform && [llength $midi_indevlist] > 2} {
+ frame $id.in2f
+ pack $id.in2f -side top
+
+ label $id.in2f.l1 -text "input device 2:"
+ button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
+ -command [list midi_popup $id $id.in2f.x1 midi_indev2 \
+ $midi_indevlist]
+ pack $id.in2f.l1 $id.in2f.x1 -side left
+ }
+
+ # input device 3
+ if {$longform && [llength $midi_indevlist] > 3} {
+ frame $id.in3f
+ pack $id.in3f -side top
+
+ label $id.in3f.l1 -text "input device 3:"
+ button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
+ -command [list midi_popup $id $id.in3f.x1 midi_indev3 \
+ $midi_indevlist]
+ pack $id.in3f.l1 $id.in3f.x1 -side left
+ }
+
+ # input device 4
+ if {$longform && [llength $midi_indevlist] > 4} {
+ frame $id.in4f
+ pack $id.in4f -side top
+
+ label $id.in4f.l1 -text "input device 4:"
+ button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
+ -command [list midi_popup $id $id.in4f.x1 midi_indev4 \
+ $midi_indevlist]
+ pack $id.in4f.l1 $id.in4f.x1 -side left
+ }
+
+ # output device 1
+
+ frame $id.out1f
+ pack $id.out1f -side top
+ label $id.out1f.l1 -text "output device 1:"
+ button $id.out1f.x1 -text [lindex $midi_outdevlist $midi_outdev1] \
+ -command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
+ $midi_outdevlist]
+ pack $id.out1f.l1 $id.out1f.x1 -side left
+
+ # output device 2
+ if {$longform && [llength $midi_outdevlist] > 2} {
+ frame $id.out2f
+ pack $id.out2f -side top
+ label $id.out2f.l1 -text "output device 2:"
+ button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
+ -command \
+ [list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
+ pack $id.out2f.l1 $id.out2f.x1 -side left
+ }
+
+ # output device 3
+ if {$longform && [llength $midi_midi_outdevlist] > 3} {
+ frame $id.out3f
+ pack $id.out3f -side top
+ label $id.out3f.l1 -text "output device 3:"
+ button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
+ -command \
+ [list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
+ pack $id.out3f.l1 $id.out3f.x1 -side left
+ }
+
+ # output device 4
+ if {$longform && [llength $midi_midi_outdevlist] > 4} {
+ frame $id.out4f
+ pack $id.out4f -side top
+ label $id.out4f.l1 -text "output device 4:"
+ button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
+ -command \
+ [list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_outdevlist]
+ pack $id.out4f.l1 $id.out4f.x1 -side left
+ }
+
+ # if not the "long form" make a button to
+ # restart with longform set.
+
+ if {$longform == 0} {
+ frame $id.longbutton
+ pack $id.longbutton -side top
+ button $id.longbutton.b -text {use multiple devices} \
+ -command {pdsend "pd midi-properties 1"}
+ pack $id.longbutton.b
+ }
+}
+
+proc pdtk_alsa_midi_dialog {id indev1 indev2 indev3 indev4 \
+ outdev1 outdev2 outdev3 outdev4 longform alsa} {
+ global midi_indev1 midi_indev2 midi_indev3 midi_indev4
+ global midi_outdev1 midi_outdev2 midi_outdev3 midi_outdev4
+ global midi_indevlist midi_outdevlist
+ global midi_alsain midi_alsaout
+
+ set midi_indev1 $indev1
+ set midi_indev2 $indev2
+ set midi_indev3 $indev3
+ set midi_indev4 $indev4
+ set midi_outdev1 $outdev1
+ set midi_outdev2 $outdev2
+ set midi_outdev3 $outdev3
+ set midi_outdev4 $outdev4
+ set midi_alsain [llength $midi_indevlist]
+ set midi_alsaout [llength $midi_outdevlist]
+
+ toplevel $id
+ wm title $id {midi}
+ wm protocol $id WM_DELETE_WINDOW [concat midi_cancel $id]
+
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "midi_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "midi_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "midi_ok $id"
+ pack $id.buttonframe.cancel -side left -expand 1
+ pack $id.buttonframe.apply -side left -expand 1
+ pack $id.buttonframe.ok -side left -expand 1
+
+ frame $id.in1f
+ pack $id.in1f -side top
+
+ if {$alsa == 0} {
+ # input device 1
+ label $id.in1f.l1 -text "input device 1:"
+ button $id.in1f.x1 -text [lindex $midi_indevlist $midi_indev1] \
+ -command [list midi_popup $id $id.in1f.x1 midi_indev1 $midi_indevlist]
+ pack $id.in1f.l1 $id.in1f.x1 -side left
+
+ # input device 2
+ if {$longform && [llength $midi_indevlist] > 2} {
+ frame $id.in2f
+ pack $id.in2f -side top
+
+ label $id.in2f.l1 -text "input device 2:"
+ button $id.in2f.x1 -text [lindex $midi_indevlist $midi_indev2] \
+ -command [list midi_popup $id $id.in2f.x1 midi_indev2 \
+ $midi_indevlist]
+ pack $id.in2f.l1 $id.in2f.x1 -side left
+ }
+
+ # input device 3
+ if {$longform && [llength $midi_indevlist] > 3} {
+ frame $id.in3f
+ pack $id.in3f -side top
+
+ label $id.in3f.l1 -text "input device 3:"
+ button $id.in3f.x1 -text [lindex $midi_indevlist $midi_indev3] \
+ -command [list midi_popup $id $id.in3f.x1 midi_indev3 \
+ $midi_indevlist]
+ pack $id.in3f.l1 $id.in3f.x1 -side left
+ }
+
+ # input device 4
+ if {$longform && [llength $midi_indevlist] > 4} {
+ frame $id.in4f
+ pack $id.in4f -side top
+
+ label $id.in4f.l1 -text "input device 4:"
+ button $id.in4f.x1 -text [lindex $midi_indevlist $midi_indev4] \
+ -command [list midi_popup $id $id.in4f.x1 midi_indev4 \
+ $midi_indevlist]
+ pack $id.in4f.l1 $id.in4f.x1 -side left
+ }
+
+ # output device 1
+
+ frame $id.out1f
+ pack $id.out1f -side top
+ label $id.out1f.l1 -text "output device 1:"
+ button $id.out1f.x1 -text [lindex $midi_outdevlist $midi_outdev1] \
+ -command [list midi_popup $id $id.out1f.x1 midi_outdev1 \
+ $midi_outdevlist]
+ pack $id.out1f.l1 $id.out1f.x1 -side left
+
+ # output device 2
+ if {$longform && [llength $midi_outdevlist] > 2} {
+ frame $id.out2f
+ pack $id.out2f -side top
+ label $id.out2f.l1 -text "output device 2:"
+ button $id.out2f.x1 -text [lindex $midi_outdevlist $midi_outdev2] \
+ -command \
+ [list midi_popup $id $id.out2f.x1 midi_outdev2 $midi_outdevlist]
+ pack $id.out2f.l1 $id.out2f.x1 -side left
+ }
+
+ # output device 3
+ if {$longform && [llength $midi_outdevlist] > 3} {
+ frame $id.out3f
+ pack $id.out3f -side top
+ label $id.out3f.l1 -text "output device 3:"
+ button $id.out3f.x1 -text [lindex $midi_outdevlist $midi_outdev3] \
+ -command \
+ [list midi_popup $id $id.out3f.x1 midi_outdev3 $midi_outdevlist]
+ pack $id.out3f.l1 $id.out3f.x1 -side left
+ }
+
+ # output device 4
+ if {$longform && [llength $midi_outdevlist] > 4} {
+ frame $id.out4f
+ pack $id.out4f -side top
+ label $id.out4f.l1 -text "output device 4:"
+ button $id.out4f.x1 -text [lindex $midi_outdevlist $midi_outdev4] \
+ -command \
+ [list midi_popup $id $id.out4f.x1 midi_outdev4 $midi_outdevlist]
+ pack $id.out4f.l1 $id.out4f.x1 -side left
+ }
+
+ # if not the "long form" make a button to
+ # restart with longform set.
+
+ if {$longform == 0} {
+ frame $id.longbutton
+ pack $id.longbutton -side top
+ button $id.longbutton.b -text {use multiple alsa devices} \
+ -command {pdsend "pd midi-properties 1"}
+ pack $id.longbutton.b
+ }
+ }
+ if {$alsa} {
+ label $id.in1f.l1 -text "In Ports:"
+ entry $id.in1f.x1 -textvariable midi_alsain -width 4
+ pack $id.in1f.l1 $id.in1f.x1 -side left
+ label $id.in1f.l2 -text "Out Ports:"
+ entry $id.in1f.x2 -textvariable midi_alsaout -width 4
+ pack $id.in1f.l2 $id.in1f.x2 -side left
+ }
+}
+
+############ pdtk_path_dialog -- dialog window for search path #########
+
+proc path_apply {id} {
+ global pd_extrapath pd_verbose
+ global pd_path_count
+ set pd_path {}
+
+ for {set x 0} {$x < $pd_path_count} {incr x} {
+ global pd_path$x
+ set this_path [set pd_path$x]
+ if {0==[string match "" $this_path]} {
+ lappend pd_path [pdtk_encodedialog $this_path]
+ }
+ }
+
+ pdsend [concat pd path-dialog $pd_extrapath $pd_verbose $pd_path \;]
+}
+
+proc path_cancel {id} {
+ pdsend [concat $id cancel \;]
+}
+
+proc path_ok {id} {
+ path_apply $id
+ path_cancel $id
+}
+
+proc pdtk_path_dialog {id extrapath verbose} {
+ global pd_extrapath pd_verbose
+ global pd_path
+ global pd_path_count
+
+ set pd_path_count [expr [llength $pd_path] + 2]
+ if { $pd_path_count < 10 } { set pd_path_count 10 }
+
+ for {set x 0} {$x < $pd_path_count} {incr x} {
+ global pd_path$x
+ set pd_path$x [lindex $pd_path $x]
+ }
+
+ set pd_extrapath $extrapath
+ set pd_verbose $verbose
+ toplevel $id
+ wm title $id {PD search path for patches and other files}
+ wm protocol $id WM_DELETE_WINDOW [concat path_cancel $id]
+
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "path_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "path_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "path_ok $id"
+ pack $id.buttonframe.cancel -side left -expand 1
+ pack $id.buttonframe.apply -side left -expand 1
+ pack $id.buttonframe.ok -side left -expand 1
+
+ frame $id.extraframe
+ pack $id.extraframe -side bottom -fill x -pady 2m
+ checkbutton $id.extraframe.extra -text {use standard extensions} \
+ -variable pd_extrapath -anchor w
+ checkbutton $id.extraframe.verbose -text {verbose} \
+ -variable pd_verbose -anchor w
+ button $id.extraframe.save -text {Save all settings}\
+ -command "path_apply $id \; pdsend \"pd save-preferences\""
+ pack $id.extraframe.extra $id.extraframe.verbose $id.extraframe.save \
+ -side left -expand 1
+
+ for {set x 0} {$x < $pd_path_count} {incr x} {
+ entry $id.f$x -textvariable pd_path$x -width 80
+ bind $id.f$x <KeyPress-Return> [concat path_ok $id]
+ pdtk_standardkeybindings $id.f$x
+ pack $id.f$x -side top
+ }
+
+ focus $id.f0
+}
+
+proc pd_set {var value} {
+ global $var
+ set $var $value
+}
+
+########## pdtk_startup_dialog -- dialog window for startup options #########
+
+proc startup_apply {id} {
+ global pd_nort pd_flags
+ global pd_startup_count
+
+ set pd_startup {}
+ for {set x 0} {$x < $pd_startup_count} {incr x} {
+ global pd_startup$x
+ set this_startup [set pd_startup$x]
+ if {0==[string match "" $this_startup]} {lappend pd_startup [pdtk_encodedialog $this_startup]}
+ }
+
+ pdsend [concat pd startup-dialog $pd_nort [pdtk_encodedialog $pd_flags] $pd_startup \;]
+}
+
+proc startup_cancel {id} {
+ pdsend [concat $id cancel \;]
+}
+
+proc startup_ok {id} {
+ startup_apply $id
+ startup_cancel $id
+}
+
+proc pdtk_startup_dialog {id nort flags} {
+ global pd_nort pd_flags
+ global pd_startup
+ global pd_startup_count
+
+ set pd_startup_count [expr [llength $pd_startup] + 2]
+ if { $pd_startup_count < 10 } { set pd_startup_count 10 }
+
+ for {set x 0} {$x < $pd_startup_count} {incr x} {
+ global pd_startup$x
+ set pd_startup$x [lindex $pd_startup $x]
+ }
+
+ set pd_nort $nort
+ set pd_flags $flags
+ toplevel $id
+ wm title $id {Pd binaries to load (on next startup)}
+ wm protocol $id WM_DELETE_WINDOW [concat startup_cancel $id]
+
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "startup_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "startup_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "startup_ok $id"
+ pack $id.buttonframe.cancel -side left -expand 1
+ pack $id.buttonframe.apply -side left -expand 1
+ pack $id.buttonframe.ok -side left -expand 1
+
+ frame $id.flags
+ pack $id.flags -side bottom
+ label $id.flags.entryname -text {startup flags}
+ entry $id.flags.entry -textvariable pd_flags -width 80
+ bind $id.flags.entry <KeyPress-Return> [concat startup_ok $id]
+ pdtk_standardkeybindings $id.flags.entry
+ pack $id.flags.entryname $id.flags.entry -side left
+
+ frame $id.nortframe
+ pack $id.nortframe -side bottom -fill x -pady 2m
+ if {[tk windowingsystem] ne "win32"} {
+ checkbutton $id.nortframe.nort -text {defeat real-time scheduling} \
+ -variable pd_nort -anchor w
+ }
+ button $id.nortframe.save -text {Save all settings}\
+ -command "startup_apply $id \; pdsend \"pd save-preferences\""
+ if {[tk windowingsystem] ne "win32"} {
+ pack $id.nortframe.nort $id.nortframe.save -side left -expand 1
+ } else {
+ pack $id.nortframe.save -side left -expand 1
+ }
+
+
+
+ for {set x 0} {$x < $pd_startup_count} {incr x} {
+ entry $id.f$x -textvariable pd_startup$x -width 80
+ bind $id.f$x <KeyPress-Return> [concat startup_ok $id]
+ pdtk_standardkeybindings $id.f$x
+ pack $id.f$x -side top
+ }
+
+ focus $id.f0
+}
+
+########## data-driven dialog -- convert others to this someday? ##########
+
+proc ddd_apply {id} {
+ set vid [string trimleft $id .]
+ set var_count [concat ddd_count_$vid]
+ global $var_count
+ set count [eval concat $$var_count]
+ set values {}
+
+ for {set x 0} {$x < $count} {incr x} {
+ set varname [concat ddd_var_$vid$x]
+ global $varname
+ lappend values [eval concat $$varname]
+ }
+ set cmd [concat $id done $values \;]
+
+# puts stderr $cmd
+ pd $cmd
+}
+
+proc ddd_cancel {id} {
+ set cmd [concat $id cancel \;]
+# puts stderr $cmd
+ pd $cmd
+}
+
+proc ddd_ok {id} {
+ ddd_apply $id
+ ddd_cancel $id
+}
+
+proc ddd_dialog {id dialogname} {
+ global ddd_fields
+ set vid [string trimleft $id .]
+ set count [llength $ddd_fields]
+
+ set var_count [concat ddd_count_$vid]
+ global $var_count
+ set $var_count $count
+
+ toplevel $id
+ label $id.label -text $dialogname
+ pack $id.label -side top
+ wm title $id "Pd dialog"
+ wm resizable $id 0 0
+ wm protocol $id WM_DELETE_WINDOW [concat ddd_cancel $id]
+
+ for {set x 0} {$x < $count} {incr x} {
+ set varname [concat ddd_var_$vid$x]
+ global $varname
+ set fieldname [lindex $ddd_fields $x 0]
+ set $varname [lindex $ddd_fields $x 1]
+ frame $id.frame$x
+ pack $id.frame$x -side top -anchor e
+ label $id.frame$x.label -text $fieldname
+ entry $id.frame$x.entry -textvariable $varname -width 20
+ bind $id.frame$x.entry <KeyPress-Return> [concat ddd_ok $id]
+ pdtk_standardkeybindings $id.frame$x.entry
+ pack $id.frame$x.entry $id.frame$x.label -side right
+ }
+
+ frame $id.buttonframe -pady 5
+ pack $id.buttonframe -side top -fill x -pady 2
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "ddd_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "ddd_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "ddd_ok $id"
+ pack $id.buttonframe.cancel $id.buttonframe.apply \
+ $id.buttonframe.ok -side left -expand 1
+
+# $id.params.entry select from 0
+# $id.params.entry select adjust end
+# focus $id.params.entry
+}
+
generated by cgit v1.2.1 (git 2.18.0) at 2024-06-08 10:03:19 +0000