aboutsummaryrefslogtreecommitdiff
path: root/pd/src
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/src
parent76d1c8472e025126a4b3e1571f817198b2fec9f9 (diff)
merge in new tcl implementation by Steiner & Chun
svn path=/trunk/; revision=11934
Diffstat (limited to 'pd/src')
-rw-r--r--pd/src/configure.in4
-rw-r--r--pd/src/g_all_guis.c2
-rw-r--r--pd/src/g_bang.c2
-rw-r--r--pd/src/g_editor.c16
-rw-r--r--pd/src/g_graph.c2
-rw-r--r--pd/src/g_hdial.c2
-rw-r--r--pd/src/g_hslider.c2
-rw-r--r--pd/src/g_mycanvas.c2
-rw-r--r--pd/src/g_numbox.c2
-rw-r--r--pd/src/g_rtext.c2
-rw-r--r--pd/src/g_text.c2
-rw-r--r--pd/src/g_toggle.c2
-rw-r--r--pd/src/g_vdial.c2
-rw-r--r--pd/src/g_vslider.c2
-rw-r--r--pd/src/g_vumeter.c2
-rw-r--r--pd/src/m_binbuf.c2
-rw-r--r--pd/src/m_class.c2
-rw-r--r--pd/src/m_sched.c2
-rw-r--r--pd/src/makefile.in24
-rw-r--r--pd/src/makefile.nt11
-rw-r--r--pd/src/notes.txt4
-rw-r--r--pd/src/s_audio.c2
-rw-r--r--pd/src/s_audio_jack.c2
-rw-r--r--pd/src/s_file.c2
-rw-r--r--pd/src/s_inter.c126
-rw-r--r--pd/src/s_loader.c11
-rw-r--r--pd/src/s_main.c38
-rw-r--r--pd/src/s_midi.c2
-rw-r--r--pd/src/s_midi_alsa.c2
-rw-r--r--pd/src/s_midi_oss.c2
-rw-r--r--pd/src/s_midi_pm.c2
-rw-r--r--pd/src/s_path.c4
-rw-r--r--pd/src/t_main.c115
-rw-r--r--pd/src/t_tk.h10
-rw-r--r--pd/src/t_tkcmd.c669
-rw-r--r--pd/src/u_main.tk4489
-rw-r--r--pd/src/x_gui.c2
-rw-r--r--pd/src/x_misc.c8
-rw-r--r--pd/src/x_qlist.c2
39 files changed, 125 insertions, 5454 deletions
diff --git a/pd/src/configure.in b/pd/src/configure.in
index bc5d5f7b..dfc1b862 100644
--- a/pd/src/configure.in
+++ b/pd/src/configure.in
@@ -195,7 +195,7 @@ dnl This should be fixed so Pd can use ALSA shared libraries where appropriate.
LDFLAGS="$LDFLAGS -static"
fi
EXT=pd_linux
- CPPFLAGS="-DDL_OPEN -DPA_USE_OSS -DUNIX -DUNISTD\
+ CPPFLAGS="-DHAVE_LIBDL -DPA_USE_OSS -DUNIX -DHAVE_UNISTD_H\
-DUSEAPI_OSS \
-fno-strict-aliasing"
SYSSRC="s_midi_oss.c s_audio_oss.c"
@@ -273,7 +273,7 @@ then
-framework AudioUnit -framework AudioToolbox \
-framework Carbon -framework CoreMIDI"
EXT=pd_darwin
- CPPFLAGS="-DDL_OPEN -DMACOSX -DUNISTD -I/usr/X11R6/include \
+ CPPFLAGS="-DHAVE_LIBDL -DMACOSX -DHAVE_UNISTD_H -I/usr/X11R6/include \
-I../portaudio/include -I../portaudio/src/common \
-I../portaudio/src/os/mac_osx/ \
-I../portmidi/pm_common -I../portmidi/pm_mac \
diff --git a/pd/src/g_all_guis.c b/pd/src/g_all_guis.c
index 6f196e34..f9314995 100644
--- a/pd/src/g_all_guis.c
+++ b/pd/src/g_all_guis.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_bang.c b/pd/src/g_bang.c
index 1e5d6604..8606b0ac 100644
--- a/pd/src/g_bang.c
+++ b/pd/src/g_bang.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_editor.c b/pd/src/g_editor.c
index 0fbce41a..7ef5266a 100644
--- a/pd/src/g_editor.c
+++ b/pd/src/g_editor.c
@@ -1421,7 +1421,7 @@ void canvas_doclick(t_canvas *x, int xpos, int ypos, int which,
}
}
-void canvas_mousedown(t_canvas *x, t_floatarg xpos, t_floatarg ypos,
+void canvas_mouse(t_canvas *x, t_floatarg xpos, t_floatarg ypos,
t_floatarg which, t_floatarg mod)
{
canvas_doclick(x, xpos, ypos, which, mod, 1);
@@ -2454,9 +2454,9 @@ bad:
(sink? class_getname(pd_class(&sink->g_pd)) : "???"));
}
-#define XTOLERANCE 4
-#define YTOLERANCE 3
-#define NHIST 15
+#define XTOLERANCE 18
+#define YTOLERANCE 17
+#define NHIST 35
/* LATER might have to speed this up */
static void canvas_tidy(t_canvas *x)
@@ -2514,10 +2514,10 @@ static void canvas_tidy(t_canvas *x)
}
}
}
- for (i = 1, besthist = 0, bestdist = 4, ip = histogram + 1;
- i < (NHIST-1); i++, ip++)
+ for (i = 2, besthist = 0, bestdist = 4, ip = histogram + 2;
+ i < (NHIST-2); i++, ip++)
{
- int hit = ip[-1] + 2 * ip[0] + ip[1];
+ int hit = ip[-2] + 2 * ip[-1] + 3 * ip[0] + 2* ip[1] + ip[2];
if (hit > besthist)
{
besthist = hit;
@@ -2665,7 +2665,7 @@ static void glist_setlastxy(t_glist *gl, int xval, int yval)
void g_editor_setup(void)
{
/* ------------------------ events ---------------------------------- */
- class_addmethod(canvas_class, (t_method)canvas_mousedown, gensym("mouse"),
+ class_addmethod(canvas_class, (t_method)canvas_mouse, gensym("mouse"),
A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, A_NULL);
class_addmethod(canvas_class, (t_method)canvas_mouseup, gensym("mouseup"),
A_FLOAT, A_FLOAT, A_FLOAT, A_NULL);
diff --git a/pd/src/g_graph.c b/pd/src/g_graph.c
index cfda6c2c..b4112ddd 100644
--- a/pd/src/g_graph.c
+++ b/pd/src/g_graph.c
@@ -8,7 +8,7 @@ to this file... */
#include <stdlib.h>
#include "m_pd.h"
-#include "t_tk.h"
+
#include "g_canvas.h"
#include "s_stuff.h" /* for sys_hostfontsize */
#include <stdio.h>
diff --git a/pd/src/g_hdial.c b/pd/src/g_hdial.c
index ace2ce66..19d21e84 100644
--- a/pd/src/g_hdial.c
+++ b/pd/src/g_hdial.c
@@ -14,7 +14,7 @@ put out a "float" as in sliders, toggles, etc. */
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_hslider.c b/pd/src/g_hslider.c
index 8dc3d0e6..143a8988 100644
--- a/pd/src/g_hslider.c
+++ b/pd/src/g_hslider.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_mycanvas.c b/pd/src/g_mycanvas.c
index 1040c11f..f673f8ed 100644
--- a/pd/src/g_mycanvas.c
+++ b/pd/src/g_mycanvas.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_numbox.c b/pd/src/g_numbox.c
index db25e918..75f6bbbf 100644
--- a/pd/src/g_numbox.c
+++ b/pd/src/g_numbox.c
@@ -10,7 +10,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_rtext.c b/pd/src/g_rtext.c
index 63a7485b..976901e9 100644
--- a/pd/src/g_rtext.c
+++ b/pd/src/g_rtext.c
@@ -13,7 +13,7 @@
#include "m_pd.h"
#include "s_stuff.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#define LMARGIN 2
#define RMARGIN 2
diff --git a/pd/src/g_text.c b/pd/src/g_text.c
index f927bf38..cff52274 100644
--- a/pd/src/g_text.c
+++ b/pd/src/g_text.c
@@ -10,7 +10,7 @@
#include "m_pd.h"
#include "m_imp.h"
#include "s_stuff.h"
-#include "t_tk.h"
+
#include "g_canvas.h"
#include <stdio.h>
#include <string.h>
diff --git a/pd/src/g_toggle.c b/pd/src/g_toggle.c
index 830e99cb..344e1522 100644
--- a/pd/src/g_toggle.c
+++ b/pd/src/g_toggle.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_vdial.c b/pd/src/g_vdial.c
index 9f7732f5..f5364750 100644
--- a/pd/src/g_vdial.c
+++ b/pd/src/g_vdial.c
@@ -13,7 +13,7 @@ put out a "float" as in sliders, toggles, etc. */
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_vslider.c b/pd/src/g_vslider.c
index 87309029..6b547f84 100644
--- a/pd/src/g_vslider.c
+++ b/pd/src/g_vslider.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/g_vumeter.c b/pd/src/g_vumeter.c
index f0ec30aa..75047e8d 100644
--- a/pd/src/g_vumeter.c
+++ b/pd/src/g_vumeter.c
@@ -12,7 +12,7 @@
#include <ctype.h>
#include "m_pd.h"
#include "g_canvas.h"
-#include "t_tk.h"
+
#include "g_all_guis.h"
#include <math.h>
diff --git a/pd/src/m_binbuf.c b/pd/src/m_binbuf.c
index 05ef1888..360512d0 100644
--- a/pd/src/m_binbuf.c
+++ b/pd/src/m_binbuf.c
@@ -7,7 +7,7 @@
#include "m_pd.h"
#include "s_stuff.h"
#include <stdio.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef MSW
diff --git a/pd/src/m_class.c b/pd/src/m_class.c
index cd4fbb1c..93d9c71b 100644
--- a/pd/src/m_class.c
+++ b/pd/src/m_class.c
@@ -7,7 +7,7 @@
#include "m_imp.h"
#include "s_stuff.h"
#include <stdlib.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef MSW
diff --git a/pd/src/m_sched.c b/pd/src/m_sched.c
index 411d1963..ae9f3664 100644
--- a/pd/src/m_sched.c
+++ b/pd/src/m_sched.c
@@ -45,7 +45,7 @@ struct _clock
t_clock *clock_setlist;
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
diff --git a/pd/src/makefile.in b/pd/src/makefile.in
index cba0f7a8..7713be99 100644
--- a/pd/src/makefile.in
+++ b/pd/src/makefile.in
@@ -59,10 +59,6 @@ SRC = g_canvas.c g_graph.c g_text.c g_rtext.c g_array.c g_template.c g_io.c \
OBJ = $(SRC:.c=.o)
-GSRC = @GUISRC@
-
-GOBJ = $(GSRC:.c=.o)
-
# get version from m_pd.h to use in doc/1.manual/1.introduction.txt
PD_MAJOR_VERSION := $(shell grep PD_MAJOR_VERSION m_pd.h | \
sed 's|^.define *PD_MAJOR_VERSION *\([0-9]*\).*|\1|' )
@@ -84,10 +80,10 @@ endif
.PHONY: pd gui externs all
all: pd $(BIN_DIR)/pd-watchdog gui $(BIN_DIR)/pdsend \
- $(BIN_DIR)/pdreceive $(BIN_DIR)/pd.tk externs
+ $(BIN_DIR)/pdreceive externs
bin: pd $(BIN_DIR)/pd-watchdog gui $(BIN_DIR)/pdsend \
- $(BIN_DIR)/pdreceive $(BIN_DIR)/pd.tk
+ $(BIN_DIR)/pdreceive
$(OBJ) : %.o : %.c
$(CC) $(CFLAGS) $(GFLAGS) $(INCLUDE) -c -o $(OBJ_DIR)/$*.o $*.c
@@ -100,12 +96,6 @@ $(ASIOOBJ): %.o : %.cpp
pd: $(PDEXEC)
-ifneq ($(GSRC),)
-gui: $(BIN_DIR)/$(GUINAME)
-else
-gui:
-endif
-
pd-watchdog: $(BIN_DIR)/pd-watchdog
$(BIN_DIR):
@@ -123,13 +113,6 @@ $(BIN_DIR)/pdreceive: u_pdreceive.c $(BIN_DIR)
$(PDEXEC): $(OBJ) $(BIN_DIR)
cd ../obj; $(CC) $(LDFLAGS) $(DBG_CFLAGS) -o $(PDEXEC) $(OBJ) $(LIB)
-$(BIN_DIR)/pd-gui: $(GOBJ) $(GSRC)
- cd ../obj; $(CC) $(INCLUDE) -o $(BIN_DIR)/$(GUINAME) $(GOBJ) $(GLIB)
-
-$(BIN_DIR)/pd.tk: u_main.tk $(BIN_DIR)
- cp u_main.tk $(BIN_DIR)/pd.tk
- touch -r makefile.dependencies $(BIN_DIR)
-
#this is for Max OSX only...
$(BIN_DIR)/libPdTcl.dylib: $(GOBJ) $(GSRC)
cd ../obj && $(CC) $(CFLAGS) -dynamiclib -read_only_relocs warning \
@@ -203,7 +186,8 @@ install: all
local-clean:
-rm -f ../obj/* $(BIN_DIR)/pd $(BIN_DIR)/$(GUINAME) $(BIN_DIR)/pdsend \
- $(BIN_DIR)/pdreceive $(BIN_DIR)/pd-watchdog m_stamp.c
+ $(BIN_DIR)/pdreceive $(BIN_DIR)/pd-watchdog m_stamp.c \
+ $(BIN_DIR)/*.tcl
-rm -f `find ../portaudio -name "*.o"`
-rm -f *~
-(cd ../doc/6.externs; rm -f *.pd_linux)
diff --git a/pd/src/makefile.nt b/pd/src/makefile.nt
index cda842f2..7b4e834e 100644
--- a/pd/src/makefile.nt
+++ b/pd/src/makefile.nt
@@ -1,6 +1,6 @@
# Makefile for PD on MSW
-all: pd gui ..\bin\pd.tk ..\bin\pdsend.exe ..\bin\pdreceive.exe
+all: pd ..\bin\pdsend.exe ..\bin\pdreceive.exe
VCSDK = "C:\Program Files\Microsoft SDKs\Windows\v6.0A"
@@ -18,7 +18,6 @@ LIB = /NODEFAULTLIB:libcmt /NODEFAULTLIB:oldnames /NODEFAULTLIB:libc \
$(LDIR)\setupapi.lib ..\bin\pthreadVC.lib \
$(LD2)\libcmt.lib $(LD2)\oldnames.lib
-GLIB = $(LIB) ..\bin\tcl84.lib ..\bin\tk84.lib
CFLAGS = /nologo /W3 /DMSW /DNT /DPD /DPD_INTERNAL /DWIN32 /DWINDOWS /Ox \
-DPA_LITTLE_ENDIAN -DUSEAPI_MMIO -DUSEAPI_PORTAUDIO -D__i386__ -DPA19 \
-D_CRT_SECURE_NO_WARNINGS
@@ -98,8 +97,6 @@ ALLCF = $(CFLAGS) $(INCLUDE) $(INCASIO) $(INCPA) $(INCPM) /D_WINDOWS \
pd: ..\bin\pd.exe ..\bin\pd.com
-gui: ..\bin\pdtcl.dll
-
..\bin\pd.exe: s_entry.obj ..\bin\pd.lib
link $(LFLAGS) /OUT:..\bin\pd.exe /INCREMENTAL:NO s_entry.obj \
..\bin\pd.lib $(LIB) $(ASIOLIB)
@@ -108,12 +105,6 @@ gui: ..\bin\pdtcl.dll
link /DLL /OUT:..\bin\pd.dll /EXPORT:sys_main $(LFLAGS) $(OBJC) \
$(OBJASIO) $(LIB) $(ASIOLIB)
-..\bin\pdtcl.dll: t_tkcmd.obj
- link $(LFLAGS) /dll /export:Pdtcl_Init /out:..\bin\pdtcl.dll \
- t_tkcmd.obj $(GLIB)
-
-..\bin\pd.tk: u_main.tk; copy u_main.tk ..\bin\pd.tk
-
..\bin\pdsend.exe: u_pdsend.obj
link $(LFLAGS) /out:..\bin\pdsend.exe /INCREMENTAL:NO u_pdsend.obj \
$(LIB)
diff --git a/pd/src/notes.txt b/pd/src/notes.txt
index 6c98ca0a..0cf0ee61 100644
--- a/pd/src/notes.txt
+++ b/pd/src/notes.txt
@@ -1,10 +1,6 @@
---------------- dolist --------------------
-doc:
-exp~, abs~ fixes
-pd~ -ninsig 0 bug fixed
-
compile on various versions of linux
windows:
modal dialogs confuse watchdog
diff --git a/pd/src/s_audio.c b/pd/src/s_audio.c
index 81438bbe..2f274fc6 100644
--- a/pd/src/s_audio.c
+++ b/pd/src/s_audio.c
@@ -9,7 +9,7 @@
#include "m_pd.h"
#include "s_stuff.h"
#include <stdio.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#include <sys/time.h>
#include <sys/resource.h>
diff --git a/pd/src/s_audio_jack.c b/pd/src/s_audio_jack.c
index f00e2f13..990a7a8c 100644
--- a/pd/src/s_audio_jack.c
+++ b/pd/src/s_audio_jack.c
@@ -13,7 +13,7 @@
#define MAX_CLIENTS 100
-#define NUM_JACK_PORTS 32
+#define NUM_JACK_PORTS 128 /* seems like higher values give bad xrun problems */
#define BUF_JACK 4096
static jack_nframes_t jack_out_max;
#define JACK_OUT_MAX 64
diff --git a/pd/src/s_file.c b/pd/src/s_file.c
index fe266b37..e5510011 100644
--- a/pd/src/s_file.c
+++ b/pd/src/s_file.c
@@ -16,7 +16,7 @@
#include <stdlib.h>
#include <stdio.h>
#include <errno.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/types.h>
diff --git a/pd/src/s_inter.c b/pd/src/s_inter.c
index c67076f3..1f17ce70 100644
--- a/pd/src/s_inter.c
+++ b/pd/src/s_inter.c
@@ -47,6 +47,7 @@ typedef int socklen_t;
#include <sys/types.h>
#include <sys/stat.h>
#include <pthread.h>
+#include <glob.h>
#else
#include <stdlib.h>
#endif
@@ -58,6 +59,10 @@ typedef int socklen_t;
#define PDBINDIR "bin/"
#endif
+#ifndef PDTCLDIR
+#define PDTCLDIR "tcl/"
+#endif
+
#ifndef WISHAPP
#define WISHAPP "wish84.exe"
#endif
@@ -206,7 +211,7 @@ void sys_microsleep(int microsec)
sys_domicrosleep(microsec, 1);
}
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
typedef void (*sighandler_t)(int);
static void sys_signal(int signo, sighandler_t sigfun)
@@ -554,7 +559,7 @@ void socketreceiver_read(t_socketreceiver *x, int fd)
void sys_closesocket(int fd)
{
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
close(fd);
#endif
#ifdef MSW
@@ -858,7 +863,7 @@ static int defaultfontshit[MAXFONTS] = {
24, 15, 28};
#define NDEFAULTFONT (sizeof(defaultfontshit)/sizeof(*defaultfontshit))
-int sys_startgui(const char *guidir)
+int sys_startgui(const char *libdir)
{
pid_t childpid;
char cmdbuf[4*MAXPDSTRING];
@@ -872,7 +877,7 @@ int sys_startgui(const char *guidir)
short version = MAKEWORD(2, 0);
WSADATA nobby;
#endif
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
int stdinpipe[2];
#endif
/* create an empty FD poll list */
@@ -880,7 +885,7 @@ int sys_startgui(const char *guidir)
sys_nfdpoll = 0;
inbinbuf = binbuf_new();
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
signal(SIGHUP, sys_huphandler);
signal(SIGINT, sys_exithandler);
signal(SIGQUIT, sys_exithandler);
@@ -910,7 +915,7 @@ int sys_startgui(const char *guidir)
if (GetCurrentDirectory(MAXPDSTRING, cmdbuf) == 0)
strcpy(cmdbuf, ".");
#endif
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
if (!getcwd(cmdbuf, MAXPDSTRING))
strcpy(cmdbuf, ".");
@@ -1019,68 +1024,52 @@ int sys_startgui(const char *guidir)
if (sys_verbose) fprintf(stderr, "port %d\n", portno);
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
if (!sys_guicmd)
{
#ifdef __APPLE__
- char *homedir = getenv("HOME"), filename[250];
+ int i;
struct stat statbuf;
- /* first look for Wish bundled with and renamed "Pd" */
- sprintf(filename, "%s/../../MacOS/Pd", guidir);
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- if (!homedir || strlen(homedir) > 150)
- goto nohomedir;
- /* Look for Wish in user's Applications. Might or might
- not be names "Wish Shell", and might or might not be
- in "Utilities" subdir. */
- sprintf(filename,
- "%s/Applications/Utilities/Wish shell.app/Contents/MacOS/Wish Shell",
- homedir);
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- sprintf(filename,
- "%s/Applications/Utilities/Wish.app/Contents/MacOS/Wish",
- homedir);
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- sprintf(filename,
- "%s/Applications/Wish shell.app/Contents/MacOS/Wish Shell",
- homedir);
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- sprintf(filename,
- "%s/Applications/Wish.app/Contents/MacOS/Wish",
- homedir);
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- nohomedir:
- /* Perform the same search among system applications. */
- strcpy(filename,
- "/usr/bin/wish");
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- strcpy(filename,
- "/Applications/Utilities/Wish Shell.app/Contents/MacOS/Wish Shell");
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- strcpy(filename,
- "/Applications/Utilities/Wish.app/Contents/MacOS/Wish");
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- strcpy(filename,
- "/Applications/Wish Shell.app/Contents/MacOS/Wish Shell");
- if (stat(filename, &statbuf) >= 0)
- goto foundit;
- strcpy(filename,
- "/Applications/Wish.app/Contents/MacOS/Wish");
- foundit:
- sprintf(cmdbuf, "\"%s\" %s/pd.tk %d\n", filename, guidir, portno);
+ glob_t glob_buffer;
+ char *homedir = getenv("HOME");
+ char embed_glob[FILENAME_MAX];
+ char embed_filename[FILENAME_MAX], home_filename[FILENAME_MAX];
+ char *wish_paths[10] = {
+ "(did not find an embedded wish)",
+ "(did not find a home directory)",
+ "/Applications/Utilities/Wish.app/Contents/MacOS/Wish",
+ "/Applications/Utilities/Wish Shell.app/Contents/MacOS/Wish Shell",
+ "/Applications/Wish.app/Contents/MacOS/Wish",
+ "/Applications/Wish Shell.app/Contents/MacOS/Wish Shell",
+ "/usr/bin/wish"
+ };
+ /* this glob is needed so the Wish executable can have the same
+ * filename as the Pd.app, i.e. 'Pd-0.42-3.app' should have a Wish
+ * executable called 'Pd-0.42-3.app/Contents/MacOS/Pd-0.42-3' */
+ sprintf(embed_glob, "%s/../MacOS/Pd*", libdir);
+ glob_buffer.gl_matchc = 1; /* we only need one match */
+ glob(embed_glob, GLOB_LIMIT, NULL, &glob_buffer);
+ if (glob_buffer.gl_pathc > 0) {
+ strcpy(embed_filename, glob_buffer.gl_pathv[0]);
+ wish_paths[0] = embed_filename;
+ }
+ sprintf(home_filename,
+ "%s/Applications/Wish.app/Contents/MacOS/Wish",homedir);
+ wish_paths[1] = home_filename;
+ for(i=0; i<10; i++)
+ {
+ if (sys_verbose)
+ fprintf(stderr, "Trying Wish at \"%s\"\n", wish_paths[i]);
+ if (stat(wish_paths[i], &statbuf) >= 0)
+ break;
+ }
+ sprintf(cmdbuf,"\"%s\" %s/tcl/pd.tcl %d\n", wish_paths[i],
+ libdir, portno);
#else
sprintf(cmdbuf,
- "TCL_LIBRARY=\"%s/tcl/library\" TK_LIBRARY=\"%s/tk/library\" \
- \"%s/pd-gui\" %d\n",
- sys_libdir->s_name, sys_libdir->s_name, guidir, portno);
+ "TCL_LIBRARY=\"%s/lib/tcl/library\" TK_LIBRARY=\"%s/lib/tk/library\" \
+ wish \"%s/tcl/pd.tcl\" %d\n",
+ libdir, libdir, libdir, portno);
#endif
sys_guicmd = cmdbuf;
}
@@ -1099,6 +1088,7 @@ int sys_startgui(const char *guidir)
{
setuid(getuid()); /* lose setuid priveliges */
#ifndef __APPLE__
+// TODO this seems unneeded on any platform hans@eds.org
/* the wish process in Unix will make a wish shell and
read/write standard in and out unless we close the
file descriptors. Somehow this doesn't make the MAC OSX
@@ -1122,18 +1112,16 @@ int sys_startgui(const char *guidir)
#endif /* UNISTD */
#ifdef MSW
- /* in MSW land "guipath" is unused; we just do everything from
- the libdir. */
- /* fprintf(stderr, "%s\n", sys_libdir->s_name); */
+ /* fprintf(stderr, "%s\n", libdir); */
strcpy(scriptbuf, "\"");
- strcat(scriptbuf, sys_libdir->s_name);
- strcat(scriptbuf, "/" PDBINDIR "pd.tk\"");
+ strcat(scriptbuf, libdir);
+ strcat(scriptbuf, "/" PDTCLDIR "pd.tcl\"");
sys_bashfilename(scriptbuf, scriptbuf);
sprintf(portbuf, "%d", portno);
- strcpy(wishbuf, sys_libdir->s_name);
+ strcpy(wishbuf, libdir);
strcat(wishbuf, "/" PDBINDIR WISHAPP);
sys_bashfilename(wishbuf, wishbuf);
@@ -1197,7 +1185,7 @@ int sys_startgui(const char *guidir)
}
close(pipe9[1]);
- sprintf(cmdbuf, "%s/pd-watchdog\n", guidir);
+ sprintf(cmdbuf, "%s/bin/pd-watchdog\n", libdir);
if (sys_verbose) fprintf(stderr, "%s", cmdbuf);
execl("/bin/sh", "sh", "-c", cmdbuf, (char*)0);
perror("pd: exec");
diff --git a/pd/src/s_loader.c b/pd/src/s_loader.c
index 6cc497c4..b708961c 100644
--- a/pd/src/s_loader.c
+++ b/pd/src/s_loader.c
@@ -2,10 +2,10 @@
* For information on usage and redistribution, and for a DISCLAIMER OF ALL
* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
-#ifdef DL_OPEN
+#ifdef HAVE_LIBDL
#include <dlfcn.h>
#endif
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <stdlib.h>
#include <unistd.h>
#include <sys/types.h>
@@ -169,7 +169,7 @@ gotone:
strncat(filename, nameptr, MAXPDSTRING-strlen(filename));
filename[MAXPDSTRING-1] = 0;
-#ifdef DL_OPEN
+#ifdef HAVE_LIBDL
dlobj = dlopen(filename, RTLD_NOW | RTLD_GLOBAL);
if (!dlobj)
{
@@ -178,6 +178,7 @@ gotone:
return (0);
}
makeout = (t_xxx)dlsym(dlobj, symname);
+ fprintf(stderr, "symbol %s\n", symname);
#endif
#ifdef MSW
sys_bashfilename(filename, filename);
@@ -262,6 +263,7 @@ int sys_run_scheduler(const char *externalschedlibname,
(t_externalschedlibmain)GetProcAddress(ntdll, "main");
}
#else
+#ifdef HAVE_LIBDL
{
void *dlobj;
struct stat statbuf;
@@ -282,6 +284,9 @@ int sys_run_scheduler(const char *externalschedlibname,
externalmainfunc = (t_externalschedlibmain)dlsym(dlobj,
"pd_extern_sched");
}
+#else
+ return (0);
+#endif
#endif
return((*externalmainfunc)(sys_extraflagsstring));
}
diff --git a/pd/src/s_main.c b/pd/src/s_main.c
index a246e38a..058f0232 100644
--- a/pd/src/s_main.c
+++ b/pd/src/s_main.c
@@ -13,7 +13,7 @@
#include <fcntl.h>
#include <stdlib.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef MSW
@@ -51,7 +51,6 @@ int sys_nosleep = 0; /* skip all "sleep" calls and spin instead */
char *sys_guicmd;
t_symbol *sys_libdir;
-t_symbol *sys_guidir;
static t_namelist *sys_openlist;
static t_namelist *sys_messagelist;
static int sys_version;
@@ -63,12 +62,12 @@ int sys_midiindevlist[MAXMIDIINDEV] = {1};
int sys_midioutdevlist[MAXMIDIOUTDEV] = {1};
char sys_font[100] =
-#ifdef MSW
- "Courier";
+#ifdef __APPLE__
+ "Monaco";
#else
"Courier";
#endif
-char sys_fontweight[] = "bold "; /* currently only used for iemguis */
+char sys_fontweight[] = "bold ";
static int sys_main_srate;
static int sys_main_advance;
static int sys_main_callback;
@@ -297,7 +296,7 @@ int sys_main(int argc, char **argv)
pd_version, pd_compiletime, pd_compiledate);
if (sys_version) /* if we were just asked our version, exit here. */
return (0);
- if (sys_startgui(sys_guidir->s_name)) /* start the gui */
+ if (sys_startgui(sys_libdir->s_name)) /* start the gui */
return(1);
if (sys_externalschedlib)
return (sys_run_scheduler(sys_externalschedlibname,
@@ -391,7 +390,7 @@ static char *(usagemessage[]) = {
"-guicmd \"cmd...\" -- start alternatve GUI program (e.g., remote via ssh)\n",
"-send \"msg...\" -- send a message at startup, after patches are loaded\n",
"-noprefs -- suppress loading preferences on startup\n",
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
"-rt or -realtime -- use real-time priority\n",
"-nrt -- don't use real-time priority\n",
#endif
@@ -441,7 +440,7 @@ void sys_findprogdir(char *progname)
{
char sbuf[MAXPDSTRING], sbuf2[MAXPDSTRING], *sp;
char *lastslash;
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
struct stat statbuf;
#endif
@@ -451,7 +450,7 @@ void sys_findprogdir(char *progname)
sbuf2[MAXPDSTRING-1] = 0;
sys_unbashfilename(sbuf2, sbuf);
#endif /* MSW */
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
strncpy(sbuf, progname, MAXPDSTRING);
sbuf[MAXPDSTRING-1] = 0;
#endif
@@ -483,22 +482,23 @@ void sys_findprogdir(char *progname)
pd was found in. We now want to infer the "lib" directory and the
"gui" directory. In "simple" unix installations, the layout is
.../bin/pd
- .../bin/pd-gui
+ .../bin/pd-watchdog (etc)
+ .../tcl/pd.tcl
.../doc
and in "complicated" unix installations, it's:
.../bin/pd
- .../lib/pd/bin/pd-gui
+ .../lib/pd/bin/pd-watchdog
+ .../lib/tcl/pd.tcl
.../lib/pd/doc
To decide which, we stat .../lib/pd; if that exists, we assume it's
the complicated layout. In MSW, it's the "simple" layout, but
- the gui program is straight wish80:
+ "wish" is found in bin:
.../bin/pd
.../bin/wish80.exe
.../doc
*/
#ifdef MSW
sys_libdir = gensym(sbuf2);
- sys_guidir = &s_; /* in MSW the guipath just depends on the libdir */
#else
strncpy(sbuf, sbuf2, MAXPDSTRING-30);
sbuf[MAXPDSTRING-30] = 0;
@@ -507,21 +507,11 @@ void sys_findprogdir(char *progname)
{
/* complicated layout: lib dir is the one we just stat-ed above */
sys_libdir = gensym(sbuf);
- /* gui lives in .../lib/pd/bin */
- strncpy(sbuf, sbuf2, MAXPDSTRING-30);
- sbuf[MAXPDSTRING-30] = 0;
- strcat(sbuf, "/lib/pd/bin");
- sys_guidir = gensym(sbuf);
}
else
{
/* simple layout: lib dir is the parent */
sys_libdir = gensym(sbuf2);
- /* gui lives in .../bin */
- strncpy(sbuf, sbuf2, MAXPDSTRING-30);
- sbuf[MAXPDSTRING-30] = 0;
- strcat(sbuf, "/bin");
- sys_guidir = gensym(sbuf);
}
#endif
}
@@ -839,7 +829,7 @@ int sys_argparse(int argc, char **argv)
sys_noautopatch = 1;
argc--; argv++;
}
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
else if (!strcmp(*argv, "-rt") || !strcmp(*argv, "-realtime"))
{
sys_hipriority = 1;
diff --git a/pd/src/s_midi.c b/pd/src/s_midi.c
index 67e5e4c7..11669366 100644
--- a/pd/src/s_midi.c
+++ b/pd/src/s_midi.c
@@ -7,7 +7,7 @@
#include "m_pd.h"
#include "s_stuff.h"
#include "m_imp.h"
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#include <sys/time.h>
#ifdef HAVE_BSTRING_H
diff --git a/pd/src/s_midi_alsa.c b/pd/src/s_midi_alsa.c
index dcc50006..d0d82f30 100644
--- a/pd/src/s_midi_alsa.c
+++ b/pd/src/s_midi_alsa.c
@@ -6,7 +6,7 @@
/* MIDI I/O for Linux using ALSA */
#include <stdio.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <stdlib.h>
diff --git a/pd/src/s_midi_oss.c b/pd/src/s_midi_oss.c
index 5c11bae3..15d77253 100644
--- a/pd/src/s_midi_oss.c
+++ b/pd/src/s_midi_oss.c
@@ -6,7 +6,7 @@
/* MIDI I/O for Linux using OSS */
#include <stdio.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#include <stdlib.h>
diff --git a/pd/src/s_midi_pm.c b/pd/src/s_midi_pm.c
index 831f3f06..e1c05b1a 100644
--- a/pd/src/s_midi_pm.c
+++ b/pd/src/s_midi_pm.c
@@ -10,7 +10,7 @@
#include "m_pd.h"
#include "s_stuff.h"
#include <stdio.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#include <sys/time.h>
#include <sys/resource.h>
diff --git a/pd/src/s_path.c b/pd/src/s_path.c
index d74aa0f6..f9c232a3 100644
--- a/pd/src/s_path.c
+++ b/pd/src/s_path.c
@@ -14,7 +14,7 @@
#define DEBUG(x)
#include <stdlib.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#include <sys/stat.h>
#endif
@@ -228,7 +228,7 @@ int sys_trytoopenone(const char *dir, const char *name, const char* ext,
if ((fd=open(dirresult,O_RDONLY | MSWOPENFLAG(bin))) >= 0)
{
/* in unix, further check that it's not a directory */
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
struct stat statbuf;
int ok = ((fstat(fd, &statbuf) >= 0) &&
!S_ISDIR(statbuf.st_mode));
diff --git a/pd/src/t_main.c b/pd/src/t_main.c
deleted file mode 100644
index 2ed68841..00000000
--- a/pd/src/t_main.c
+++ /dev/null
@@ -1,115 +0,0 @@
-/* Copyright (c) 1997-1999 Miller Puckette.
-* For information on usage and redistribution, and for a DISCLAIMER OF ALL
-* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
-
-/* This file should be compared with the corresponding thing in the TK
-* distribution whenever updating to newer versions of TCL/TK. */
-
-/*
- * Copyright (c) 1993 The Regents of the University of California.
- * Copyright (c) 1994 Sun Microsystems, Inc.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-
-#ifndef __APPLE__ /* linux and IRIX only; in __APPLE__ we don't link this in */
-#include "tk.h"
-#include <stdlib.h>
-
-/*
- *----------------------------------------------------------------------
- *
- * main --
- *
- * This is the main program for the application.
- *
- * Results:
- * None: Tk_Main never returns here, so this procedure never
- * returns either.
- *
- * Side effects:
- * Whatever the application does.
- *
- *----------------------------------------------------------------------
- */
-
-void pdgui_startup(Tcl_Interp *interp);
-void pdgui_setname(char *name);
-void pdgui_setsock(int port);
-void pdgui_sethost(char *name);
-
-int
-main(int argc, char **argv)
-{
- pdgui_setname(argv[0]);
- if (argc >= 2)
- {
- pdgui_setsock(atoi(argv[1]));
- argc--; argv++;
- argv[0] = "Pd";
- }
- if (argc >= 2)
- {
- pdgui_sethost(argv[1]);
- argc--; argv++;
- argv[0] = "Pd";
- }
- Tk_Main(argc, argv, Tcl_AppInit);
- return 0; /* Needed only to prevent compiler warning. */
-}
-
-
-/*
- *----------------------------------------------------------------------
- *
- * Tcl_AppInit --
- *
- * This procedure performs application-specific initialization.
- * Most applications, especially those that incorporate additional
- * packages, will have their own version of this procedure.
- *
- * Results:
- * Returns a standard Tcl completion code, and leaves an error
- * message in interp->result if an error occurs.
- *
- * Side effects:
- * Depends on the startup script.
- *
- *----------------------------------------------------------------------
- */
-
-
-int
-Tcl_AppInit(interp)
- Tcl_Interp *interp; /* Interpreter for application. */
-{
- Tk_Window mainwindow;
-
- if (Tcl_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
- if (Tk_Init(interp) == TCL_ERROR) {
- return TCL_ERROR;
- }
-
- /* setup specific to pd-gui: */
-
- pdgui_startup(interp);
-
- /*
- * Specify a user-specific startup file to invoke if the application
- * is run interactively. Typically the startup file is "~/.apprc"
- * where "app" is the name of the application. If this line is deleted
- * then no user-specific startup file will be run under any conditions.
- */
-
-#if 0
- tcl_RcFileName = "~/.apprc";
-#endif
-
- return TCL_OK;
-}
-
-#endif /* __APPLE__ */
diff --git a/pd/src/t_tk.h b/pd/src/t_tk.h
deleted file mode 100644
index a6943679..00000000
--- a/pd/src/t_tk.h
+++ /dev/null
@@ -1,10 +0,0 @@
-/* Copyright (c) 1997-1999 Miller Puckette.
-* For information on usage and redistribution, and for a DISCLAIMER OF ALL
-* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
-
-void pdgui_vmess(char *fmt, ...);
-void pdgui_mess(char *s);
-
-void pdgui_evalfile(char *s);
-
-#define GUISTRING 1000
diff --git a/pd/src/t_tkcmd.c b/pd/src/t_tkcmd.c
deleted file mode 100644
index b8cac71e..00000000
--- a/pd/src/t_tkcmd.c
+++ /dev/null
@@ -1,669 +0,0 @@
-/* Copyright (c) 1997-1999 Miller Puckette.
-* For information on usage and redistribution, and for a DISCLAIMER OF ALL
-* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
-
-#ifndef MSW /* in unix this only works first; in MSW it only works last. */
-#include "tk.h"
-#endif
-
-#include "t_tk.h"
-#include <stdlib.h>
-#include <string.h>
-#include <stdio.h>
-#include <stdarg.h>
-#include <sys/types.h>
-
-#ifndef MSW
-#include <unistd.h>
-#include <sys/socket.h>
-#include <netinet/in.h>
-#include <netinet/tcp.h>
-#include <netdb.h>
-#ifdef HAVE_BSTRING_H
-#include <bstring.h>
-#endif
-#include <sys/time.h>
-#include <errno.h>
-#include <fcntl.h>
-#endif
-#ifdef MSW
-#include <winsock.h>
-#include <io.h>
-#endif
-
-/* These pragmas are only used for MSVC, not MinGW or Cygwin <hans@at.or.at> */
-#ifdef _MSC_VER
-#pragma warning( disable : 4305 ) /* uncast const double to float */
-#pragma warning( disable : 4244 ) /* uncast double to float */
-#pragma warning( disable : 4101 ) /* unused local variables */
-#endif
-
-#ifdef MSW
-#include "tk.h"
-#endif
-
-#ifdef __APPLE__
-#define STARTGUI
-#endif
-
-#ifdef __linux__
-#define STARTGUI
-#endif
-
-#define FIRSTPORTNUM 5600
-
-void tcl_mess(char *s);
-static Tcl_Interp *tk_pdinterp;
-static int pd_portno = 0;
-
-
-/***************** the socket setup code ********************/
-
-/* If this is reset by pdgui_setsock(), it's the port number Pd will try to
-connect to; but if zero, that means we should set it and start Pd ourselves. */
-
-
- /* some installations of linux don't know about "localhost" so give
- the loopback address; NT, on the other hand, can't understand the
- hostname "127.0.0.1". */
-char hostname[100] =
-#ifdef __linux__
- "127.0.0.1";
-#else
- "localhost";
-#endif
-
-void pdgui_setsock(int port)
-{
- pd_portno = port;
-}
-
- /* why is this here??? probably never used (see t_main.c). */
-void pdgui_sethost(char *name)
-{
- strncpy(hostname, name, 100);
- hostname[99] = 0;
-}
-
-static void pdgui_sockerror(char *s)
-{
-#ifdef MSW
- int err = WSAGetLastError();
-#endif
-#ifndef MSW
- int err = errno;
-#endif
-
- fprintf(stderr, "%s: %s (%d)\n", s, strerror(err), err);
- tcl_mess("exit\n");
- exit(1);
-}
-
-static int sockfd;
-
-/* The "pd_readsocket" command, which polls the socket. */
-
-#define CHUNKSIZE 20000 /* chunks to allocate memory for reading socket */
-#define READSIZE 10000 /* size of read to issue */
-
-static char *pd_tkbuf = 0; /* buffer for reading */
-static int pd_tkbufsize = 0; /* current buffer size */
-static int pd_buftail = 0; /* number of bytes already in buffer */
-static int pd_bufhead = 0; /* index of first byte to read */
-
- /* mask argument unused but is here to follow tcl's prototype. */
-static void pd_readsocket(ClientData cd, int mask)
-{
- fd_set readset, writeset, exceptset;
- struct timeval timout;
-
- timout.tv_sec = 0;
- timout.tv_usec = 0;
- FD_ZERO(&writeset);
- FD_ZERO(&readset);
- FD_ZERO(&exceptset);
- FD_SET(sockfd, &readset);
- FD_SET(sockfd, &exceptset);
- if (!pd_tkbuf)
- {
- if (!(pd_tkbuf = malloc(CHUNKSIZE)))
- {
- fprintf(stderr, "pd-gui: out of memory\n");
- tcl_mess("exit\n");
- }
- pd_tkbufsize = CHUNKSIZE;
- }
- if (pd_buftail + READSIZE + 1 > pd_tkbufsize)
- {
- int newsize = pd_tkbufsize + CHUNKSIZE;
- char *newbuf = realloc(pd_tkbuf, newsize);
- if (!newbuf)
- {
- fprintf(stderr, "pd-gui: out of memory\n");
- tcl_mess("exit\n");
- }
- pd_tkbuf = newbuf;
- pd_tkbufsize = newsize;
- }
- if (select(sockfd+1, &readset, &writeset, &exceptset, &timout) < 0)
- perror("select");
- if (FD_ISSET(sockfd, &exceptset) || FD_ISSET(sockfd, &readset))
- {
- int ret;
- ret = recv(sockfd, pd_tkbuf + pd_buftail, READSIZE, 0);
- if (ret < 0)
- pdgui_sockerror("socket receive error");
- else if (ret == 0)
- {
- /* fprintf(stderr, "read %d\n", SOCKSIZE - pd_buftail); */
- fprintf(stderr, "pd_gui: pd process exited\n");
- tcl_mess("exit\n");
- }
- else
- {
- pd_buftail += ret;
- while (1)
- {
- char lastc = 0, *gotcr = 0, *bp = pd_tkbuf + pd_bufhead,
- *ep = pd_tkbuf + pd_buftail;
- int brace = 0;
- /* search for locations that terminate a complete TK
- command. These are carriage returns which are not inside
- any braces. Braces can be escaped with backslashes (but
- backslashes themselves can't.) */
- while (bp < ep)
- {
- char c = *bp;
- if (c == '}' && brace)
- brace--;
- else if (c == '{')
- brace++;
- else if (!brace && c == '\n' && lastc != '\\')
- {
- gotcr = bp;
- break;
- }
- lastc = c;
- bp++;
- }
- /* if gotcr is set there is at least one complete TK
- command in the buffer, and gotcr terminates the first one.
- Because sending the command to tcl may cause this code to
- be reentered, we first copy the command and take it out of
- the buffer, then execute the command.
- Execute it and slide any
- extra bytes to beginning of the buffer. */
- if (gotcr)
- {
- int bytesincmd = (gotcr - (pd_tkbuf+pd_bufhead)) + 1;
- char smallcmdbuf[1000], *realcmdbuf;
- if (gotcr - (pd_tkbuf+pd_bufhead) < 998)
- realcmdbuf = smallcmdbuf;
- else realcmdbuf = malloc(bytesincmd+1);
- if (realcmdbuf)
- {
- strncpy(realcmdbuf, pd_tkbuf+pd_bufhead, bytesincmd);
- realcmdbuf[bytesincmd] = 0;
- }
- pd_bufhead += bytesincmd;
- if (realcmdbuf)
- {
- tcl_mess(realcmdbuf);
- if (realcmdbuf != smallcmdbuf)
- free(realcmdbuf);
- }
- if (pd_buftail < pd_bufhead)
- fprintf(stderr, "tkcmd bug\n");
- }
- else break;
- }
- if (pd_bufhead)
- {
- if (pd_buftail > pd_bufhead)
- memmove(pd_tkbuf, pd_tkbuf + pd_bufhead,
- pd_buftail-pd_bufhead);
- pd_buftail -= pd_bufhead;
- pd_bufhead = 0;
- }
- }
- }
-}
-
-#ifdef MSW
- /* if we're in Gatesland, we add a tcl command to poll the
- socket for data. */
-static int pd_pollsocketCmd(ClientData cd, Tcl_Interp *interp,
- int argc, char **argv)
-{
- pd_readsocket(cd, 0);
- return (TCL_OK);
-}
-#endif
-
-static void pd_sockerror(char *s)
-{
-#ifdef MSW
- int err = WSAGetLastError();
- if (err == 10054) return;
- else if (err == 10044)
- {
- fprintf(stderr,
- "Warning: you might not have TCP/IP \"networking\" turned on\n");
- fprintf(stderr, "which is needed for Pd to talk to its GUI layer.\n");
- }
-#else
- int err = errno;
-#endif
- fprintf(stderr, "%s: %s (%d)\n", s, strerror(err), err);
-}
-
-static void pdgui_connecttosocket(void)
-{
- struct sockaddr_in server;
- struct hostent *hp;
-#ifndef MSW
- int retry = 10;
-#else
- int retry = 1;
-#endif
-#ifdef MSW
- short version = MAKEWORD(2, 0);
- WSADATA nobby;
-
- if (WSAStartup(version, &nobby)) pdgui_sockerror("setup");
-#endif
-
- /* create a socket */
- sockfd = socket(AF_INET, SOCK_STREAM, 0);
- if (sockfd < 0) pdgui_sockerror("socket");
-
- /* connect socket using hostname provided in command line */
- server.sin_family = AF_INET;
-
- hp = gethostbyname(hostname);
-
- if (hp == 0)
- {
- fprintf(stderr,
- "localhost not found (inet protocol not installed?)\n");
- exit(1);
- }
- memcpy((char *)&server.sin_addr, (char *)hp->h_addr, hp->h_length);
-
- /* assign client port number */
- server.sin_port = htons((unsigned short)pd_portno);
-
- /* try to connect */
- while (1)
- {
- if (connect(sockfd, (struct sockaddr *) &server, sizeof (server)) >= 0)
- goto gotit;
- retry--;
- if (retry <= 0)
- break;
- /* In unix there's a race condition; the child won't be
- able to connect before the parent (pd) has shed its
- setuid-ness. In case this is the problem, sleep and
- retry. */
- else
- {
-#ifndef MSW
- fd_set readset, writeset, exceptset;
- struct timeval timout;
-
- timout.tv_sec = 0;
- timout.tv_usec = 100000;
- FD_ZERO(&writeset);
- FD_ZERO(&readset);
- FD_ZERO(&exceptset);
- fprintf(stderr, "retrying connect...\n");
- if (select(1, &readset, &writeset, &exceptset, &timout) < 0)
- perror("select");
-#endif /* !MSW */
- }
- }
- pdgui_sockerror("connecting stream socket");
-gotit: ;
-#ifndef MSW
- /* normally we ask TK to call us back; but in MSW we have to poll. */
- Tk_CreateFileHandler(sockfd, TK_READABLE | TK_EXCEPTION,
- pd_readsocket, 0);
-#endif /* !MSW */
-}
-
-#ifdef STARTGUI
-
-/* #define DEBUGCONNECT */
-
-#ifdef DEBUGCONNECT
-static FILE *debugfd;
-#endif
-
-
-static void pd_startfromgui( void)
-{
- pid_t childpid;
- char cmdbuf[1000], pdbuf[1000], *lastchar;
- const char *arg0;
- struct sockaddr_in server;
- int msgsock;
- int len = sizeof(server), nchar;
- int ntry = 0, portno = FIRSTPORTNUM;
- int xsock = -1;
- char morebuf[256];
-#ifdef MSW
- short version = MAKEWORD(2, 0);
- WSADATA nobby;
- char scriptbuf[1000], wishbuf[1000], portbuf[80];
- int spawnret;
- char intarg;
-#else
- int intarg;
-#endif
-
- arg0 = Tcl_GetVar(tk_pdinterp, "argv0", 0);
- if (!arg0)
- {
- fprintf(stderr, "Pd-gui: can't get arg 0\n");
- return;
- }
- lastchar = strrchr(arg0, '/');
- if (lastchar)
- snprintf(pdbuf, lastchar - arg0 + 1, "%s", arg0);
- else strcpy(pdbuf, ".");
- strcat(pdbuf, "/../bin/pd");
-#ifdef DEBUGCONNECT
- fprintf(stderr, "pdbuf is %s\n", pdbuf);
-#endif
-
-#ifdef MSW
- if (WSAStartup(version, &nobby))
- pd_sockerror("WSAstartup");
-#endif
-
- /* create a socket */
- xsock = socket(AF_INET, SOCK_STREAM, 0);
- if (xsock < 0) pd_sockerror("socket");
- intarg = 1;
- if (setsockopt(xsock, IPPROTO_TCP, TCP_NODELAY,
- &intarg, sizeof(intarg)) < 0)
- fprintf(stderr, "setsockopt (TCP_NODELAY) failed\n");
-
- server.sin_family = AF_INET;
- server.sin_addr.s_addr = INADDR_ANY;
-
- /* assign server port number */
- server.sin_port = htons((unsigned short)portno);
-
- /* name the socket */
- while (bind(xsock, (struct sockaddr *)&server, sizeof(server)) < 0)
- {
-#ifdef MSW
- int err = WSAGetLastError();
-#else
- int err = errno;
-#endif
- if ((ntry++ > 20) || (err != EADDRINUSE))
- {
- perror("bind");
- fprintf(stderr,
- "couldn't open GUI-to-pd network connection\n");
- return;
- }
- portno++;
- server.sin_port = htons((unsigned short)(portno));
- }
-
-#ifdef DEBUGCONNECT
- fprintf(debugfd, "port %d\n", portno);
- fflush(debugfd);
-#endif
-
-#ifdef UNISTD
- sprintf(cmdbuf, "\"%s\" -guiport %d\n", pdbuf, portno);
- childpid = fork();
- if (childpid < 0)
- {
- if (errno) perror("sys_startgui");
- else fprintf(stderr, "sys_startgui failed\n");
- return;
- }
- else if (!childpid) /* we're the child */
- {
-#ifdef DEBUGCONNECT
- fprintf(debugfd, "%s", cmdbuf);
- fflush(debugfd);
-#endif
- execl("/bin/sh", "sh", "-c", cmdbuf, (char*)0);
- perror("pd: exec");
- _exit(1);
- }
-#endif /* UNISTD */
-
-#ifdef MSW
-
-#error not yet used.... sys_bashfilename() not filled in here
-
- strcpy(cmdbuf, pdcmd);
- strcat(cmdbuf, "/pd.exe");
- sys_bashfilename(scriptbuf, scriptbuf);
-
- sprintf(portbuf, "%d", portno);
-
- spawnret = _spawnl(P_NOWAIT, cmdbuf, "pd.exe", "-port", portbuf, 0);
- if (spawnret < 0)
- {
- perror("spawnl");
- fprintf(stderr, "%s: couldn't start\n", cmdbuf);
- return;
- }
-
-#endif /* MSW */
-
-#ifdef DEBUGCONNECT
- fprintf(stderr, "Waiting for connection request... \n");
-#endif
- if (listen(xsock, 5) < 0) pd_sockerror("listen");
- sockfd = accept(xsock, (struct sockaddr *) &server, (unsigned int *)&len);
- if (sockfd < 0) pd_sockerror("accept");
-#ifdef DEBUGCONNECT
- fprintf(stderr, "... connected\n");
-#endif
-
-#ifndef MSW
- /* normally we ask TK to call us back; but in MSW we have to poll. */
- Tk_CreateFileHandler(sockfd, TK_READABLE | TK_EXCEPTION,
- pd_readsocket, 0);
-#endif /* !MSW */
-}
-
-#endif /* STARTGUI */
-
-static void pdgui_setupsocket(void)
-{
-#ifdef MSW
- pdgui_connecttosocket();
-#else
- if (pd_portno)
- pdgui_connecttosocket();
- else pd_startfromgui() ;
-#endif
-}
-
-/**************************** commands ************************/
-static char *pdgui_path;
-
-/* The "pd" command, which cats its args together and throws the result
-* at the Pd interpreter.
-*/
-#define MAXWRITE 1024
-
-static int pdCmd(ClientData cd, Tcl_Interp *interp, int argc, char **argv)
-{
- if (argc == 2)
- {
- int n = strlen(argv[1]);
- if (send(sockfd, argv[1], n, 0) < n)
- {
- perror("stdout");
- tcl_mess("exit\n");
- }
- }
- else
- {
- int i;
- char buf[MAXWRITE];
- buf[0] = 0;
- for (i = 1; i < argc; i++)
- {
- if (strlen(argv[i]) + strlen(buf) + 2 > MAXWRITE)
- {
- interp->result = "pd: arg list too long";
- return (TCL_ERROR);
- }
- if (i > 1) strcat(buf, " ");
- strcat(buf, argv[i]);
- }
- if (send(sockfd, buf, strlen(buf), 0) < 0)
- {
- perror("stdout");
- tcl_mess("exit\n");
- }
- }
- return (TCL_OK);
-}
-
-/*********** "c" level access to tk functions. ******************/
-
-void tcl_mess(char *s)
-{
- int result;
- result = Tcl_Eval(tk_pdinterp, s);
- if (result != TCL_OK)
- {
- if (*tk_pdinterp->result) printf("%s\n", tk_pdinterp->result);
- }
-}
-
- /* in linux, we load the tk code from here (in MSW and MACOS, this
- is done by passing the name of the file as a startup argument to
- the wish shell.) */
-#if !defined(MSW) && !defined(__APPLE__)
-void pdgui_doevalfile(Tcl_Interp *interp, char *s)
-{
- char buf[GUISTRING];
- sprintf(buf, "set pd_guidir \"%s\"\n", pdgui_path);
- tcl_mess(buf);
- strcpy(buf, pdgui_path);
- strcat(buf, "/bin/");
- strcat(buf, s);
- if (Tcl_EvalFile(interp, buf) != TCL_OK)
- {
- char buf2[1000];
- sprintf(buf2, "puts [concat tcl: %s: can't open script]\n",
- buf);
- tcl_mess(buf2);
- }
-}
-
-void pdgui_evalfile(char *s)
-{
- pdgui_doevalfile(tk_pdinterp, s);
-}
-#endif
-
-void pdgui_startup(Tcl_Interp *interp)
-{
- /* save pointer to the main interpreter */
- tk_pdinterp = interp;
-
- /* add our own TK commands */
- Tcl_CreateCommand(interp, "pd", (Tcl_CmdProc*)pdCmd, (ClientData)NULL,
- (Tcl_CmdDeleteProc *)NULL);
-#ifdef MSW
- Tcl_CreateCommand(interp, "pd_pollsocket",(Tcl_CmdProc*) pd_pollsocketCmd,
- (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL);
-#endif
- pdgui_setupsocket();
- /* read in the startup file */
-#if !defined(MSW) && !defined(__APPLE__)
- pdgui_evalfile("pd.tk");
-#endif
-}
-
-#ifndef MSW
-void pdgui_setname(char *s)
-{
- char *t;
- char *str;
- int n;
- if (t = strrchr(s, '/')) str = s, n = (t-s) + 1;
- else str = "./", n = 2;
- if (n > GUISTRING-100) n = GUISTRING-100;
- pdgui_path = malloc(n+9);
-
- strncpy(pdgui_path, str, n);
- while (strlen(pdgui_path) > 0 && pdgui_path[strlen(pdgui_path)-1] == '/')
- pdgui_path[strlen(pdgui_path)-1] = 0;
- if (t = strrchr(pdgui_path, '/'))
- *t = 0;
-}
-#endif
-
- /* this is called when an off-the-shelf "wish" has to "load" this module
- at runtime. In Linux, this module is linked in and Pdtcl_Init() is not
- called; instead, the code in t_main.c calls pdgui_setsock() and
- pdgui_startup(). */
-
-int Pdtcl_Init(Tcl_Interp *interp)
-{
- const char *argv = Tcl_GetVar(interp, "argv", 0);
- int portno = 0, i;
- if (argv)
- {
- /* search for arg of form "-guiport %d"; if so we're the
- child. For some reason, the second version is too stringent
- a test on MSW so the first, incorrect one, is conditionally
- used. */
-#ifdef MSW
- for (i = 0; i < (int)strlen(argv) - 1; i++)
- if (argv[i] >= '0' && argv[i] <= '9')
- {
- portno = atoi(argv+i);
- break;
- }
-#else
- for (i = 0; i < (int)strlen(argv) - 3; i++)
- if (argv[i] == ' ' &&
- argv[i+1] >= '0' && argv[i+1] <= '9')
- {
- portno = atoi(argv+i+1);
- break;
- }
-#endif
- }
- if (portno)
- pdgui_setsock(portno);
-#ifdef DEBUGCONNECT
- debugfd = fopen("/tmp/bratwurst", "w");
- fprintf(debugfd, "turning stderr back on\n");
- fflush(debugfd);
- dup2(fileno(debugfd), 2);
- fprintf(stderr, "duped to stderr?\n");
- fprintf(stderr, "portno %d\n", pd_portno);
- fprintf(stderr, "argv %s\n", argv);
-#endif
- tk_pdinterp = interp;
- pdgui_startup(interp);
- interp->result = "loaded pdtcl_init";
-
- return (TCL_OK);
-}
-
-#if 0
-int Pdtcl_SafeInit(Tcl_Interp *interp) {
- fprintf(stderr, "Pdtcl_Safeinit 51\n");
- return (TCL_OK);
-}
-#endif
-
diff --git a/pd/src/u_main.tk b/pd/src/u_main.tk
deleted file mode 100644
index 8834d232..00000000
--- a/pd/src/u_main.tk
+++ /dev/null
@@ -1,4489 +0,0 @@
-#!/usr/bin/wish
-# Copyright (c) 1997-1999 Miller Puckette.
-# For information on usage and redistribution, and for a DISCLAIMER OF ALL
-# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
-
-# changed by Thomas Musil 09.2001
-# between "pdtk_graph_dialog -- dialog window for graphs"
-# and "pdtk_array_dialog -- dialog window for arrays"
-# a new dialogbox was inserted, named:
-# "pdtk_iemgui_dialog -- dialog window for iem guis"
-#
-# all this changes are labeled with #######iemlib##########
-
-# set pd_nt (bad name) 0 for unix, 1 for microsoft, and 2 for Mac OSX.
-if { $tcl_platform(platform) == "windows" } {
- set pd_nt 1
- set defaultFontFamily {Bitstream Vera Sans Mono}
- set defaultFontWeight normal
- font create menuFont -family Tahoma -size -11
-} elseif { $tcl_platform(os) == "Darwin" } {
- set pd_nt 2
- set defaultFontFamily Monaco
- set defaultFontWeight normal
-} else {
- set pd_nt 0
- set defaultFontFamily Courier
- set defaultFontWeight bold
-}
-
-# start Pd-extended font hacks -----------------------------
-
-# Pd-0.39.2-extended hacks to make font/box sizes the same across platform
-# puts stderr "tk scaling is [tk scaling]"
-# tk scaling 1
-
-# this font is for the Pd Window console text
-font create console_font -family $defaultFontFamily -size -12 \
- -weight $defaultFontWeight
-# this font is for text in Pd windows
-font create text_font -family {Times} -size -14 -weight normal
-# for text in Properties Panels and other panes
-font create highlight_font -family $defaultFontFamily -size -14 -weight bold
-
-# end Pd-extended font hacks -----------------------------
-
-
-# Tearoff is set to true by default:
-set pd_tearoff 1
-
-# jsarlo
-set pd_array_listview_pagesize 1000
-set pd_array_listview_id(0) 0
-set pd_array_listview_entry(0) 0
-set pd_array_listview_page(0) 0
-# end jsarlo
-
-if {$pd_nt == 1} {
- global pd_guidir
- global pd_tearoff
- set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]]
- regsub -all \\\\ $pd_gui2 / pd_gui3
- set pd_guidir $pd_gui3/..
- load $pd_guidir/bin/pdtcl.dll
- set pd_tearoff 1
-}
-
-if {$pd_nt == 2} {
-# turn on James Tittle II's fast drawing
- set tk::mac::useCGDrawing 1
-# anti-alias all lines that need it
- set tk::mac::CGAntialiasLimit 2
- global pd_guidir
- global pd_tearoff
- set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]]
- set pd_guidir $pd_gui2/..
- load $pd_guidir/bin/libPdTcl.dylib
- set pd_tearoff 0
- global pd_macready
- set pd_macready 0
- global pd_macdropped
- set pd_macdropped ""
- # tk::mac::OpenDocument is called with the filenames put into the
- # var args whenever docs are either dropped on the Pd.app icon or
- # opened from the Finder.
- # It uses menu_doc_open so it can handles numerous file types.
- proc tk::mac::OpenDocument {args} {
- global pd_macready pd_macdropped
- foreach file $args {
- if {$pd_macready != 0} {
- pd [concat pd open [pdtk_enquote [file tail $file]] \
- [pdtk_enquote [file dirname $file]] \;]
- menu_doc_open [file dirname $file] [file tail $file]
- } else {
- set pd_macdropped $args
- }
- }
- }
-}
-
-# hack so you can easily test-run this script in linux... define pd_guidir
-# (which is normally defined at startup in pd under linux...)
-
-if {$pd_nt == 0} {
- if {! [info exists pd_guidir]} {
- global pd_guidir
- puts stderr {setting pd_guidir to '.'}
- set pd_guidir .
- }
-}
-
-set pd_deffont {courier 12 bold}
-
-set help_top_directory $pd_guidir/doc
-
-# it's unfortunate but we seem to have to turn off global bindings
-# for Text objects to get control-s and control-t to do what we want for
-# "text" dialogs below. Also we have to get rid of tab's changing the focus.
-
-bind all <Key-Tab> ""
-bind all <<PrevWindow>> ""
-bind Text <Control-t> {}
-bind Text <Control-s> {}
-# puts stderr [bind all]
-
-################## set up main window #########################
-# the menus are instantiated here for the main window
-# for the patch windows, they are created by pdtk_canvas_new
-menu .mbar
-
-frame .controls
-pack .controls -side top -fill x
-menu .mbar.file -tearoff $pd_tearoff
-.mbar add cascade -label "File" -menu .mbar.file
-menu .mbar.find -tearoff $pd_tearoff
-.mbar add cascade -label "Find" -menu .mbar.find
-menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff
-menu .mbar.audio -tearoff $pd_tearoff
-if {$pd_nt != 2} {
- .mbar add cascade -label "Windows" -menu .mbar.windows
- .mbar add cascade -label "Media" -menu .mbar.audio
- menu .mbar.help -tearoff $pd_tearoff
- .mbar add cascade -label "Help" -menu .mbar.help
-} else {
- menu .mbar.apple -tearoff 0
- .mbar add cascade -label "Apple" -menu .mbar.apple
-# arrange menus according to Apple HIG
- .mbar add cascade -label "Media" -menu .mbar.audio
- .mbar add cascade -label "Window" -menu .mbar.windows
- menu .mbar.help -tearoff $pd_tearoff
- .mbar add cascade -label "Help" -menu .mbar.help
-}
-
-# fix menu font size on Windows with tk scaling = 1
-if {$pd_nt == 1} {
- .mbar.file configure -font menuFont
- .mbar.find configure -font menuFont
- .mbar.windows configure -font menuFont
- .mbar.audio configure -font menuFont
- .mbar.help configure -font menuFont
-}
-
-set ctrls_audio_on 0
-set ctrls_meter_on 0
-set ctrls_inlevel 0
-set ctrls_outlevel 0
-
-frame .controls.switches
-checkbutton .controls.switches.audiobutton -text {compute audio} \
- -variable ctrls_audio_on \
- -command {pd [concat pd dsp $ctrls_audio_on \;]}
-
-checkbutton .controls.switches.meterbutton -text {peak meters} \
- -variable ctrls_meter_on \
- -command {pd [concat pd meters $ctrls_meter_on \;]}
-
-pack .controls.switches.audiobutton .controls.switches.meterbutton \
- -side top -anchor w
-
-frame .controls.inout
-frame .controls.inout.in
-label .controls.inout.in.label -text IN
-entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3
-button .controls.inout.in.clip -text {CLIP} -state disabled
-pack .controls.inout.in.label .controls.inout.in.level \
- .controls.inout.in.clip -side top -pady 2
-
-frame .controls.inout.out
-label .controls.inout.out.label -text OUT
-entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3
-button .controls.inout.out.clip -text {CLIP} -state disabled
-pack .controls.inout.out.label .controls.inout.out.level \
- .controls.inout.out.clip -side top -pady 2
-
-button .controls.dio -text "DIO\nerrors" \
- -command {pd [concat pd audiostatus \;]}
-button .controls.clear -text "clear\nprintout" \
- -command {.printout.text delete 0.0 end}
-
-pack .controls.inout.in .controls.inout.out -side left -padx 6
-pack .controls.inout -side left -padx 14
-pack .controls.switches -side left
-pack .controls.dio -side left -padx 20
-pack .controls.clear -side right -padx 6
-
-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
-
-proc pdtk_post {stuff} {
- .printout.text insert end $stuff
- .printout.text yview end-2char
-}
-
-proc pdtk_standardkeybindings {id} {
- global pd_nt
- bind $id <Control-Key> {pdtk_pd_ctrlkey %W %K 0}
- bind $id <Control-Shift-Key> {pdtk_pd_ctrlkey %W %K 1}
- if {$pd_nt == 2} {
- bind $id <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
- bind $id <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
- }
-}
-
-pdtk_standardkeybindings .
-
-wm title . "Pd"
-. configure -menu .mbar -width 200 -height 150
-
-# Intercept closing the main pd window: MP 20060413:
-wm protocol . WM_DELETE_WINDOW menu_quit
-
-############### set up global variables ################################
-
-set untitled_number 1
-set untitled_directory [pwd]
-set saveas_client doggy
-set pd_opendir $untitled_directory
-set pd_savedir $untitled_directory
-set pd_undoaction no
-set pd_redoaction no
-set pd_undocanvas no
-
-################ utility functions #########################
-
-# enquote a string to send it to a tcl function
-proc pdtk_enquote {x} {
- set foo [string map {"," "" ";" "" \" ""} $x]
- set foo2 [string map {" " "\\ "} $foo]
- concat $foo2
-}
-
-#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 pdtk_unspace {x} {
- set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
- if {$y == ""} {set y "empty"}
- concat $y
-}
-
-#enquote a string for preferences (command strings etc.)
-proc pdtk_encodedialog {x} {
- concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
-}
-
-proc pdtk_debug {x} {
- tk_messageBox -message $x -type ok
-}
-
-proc pdtk_watchdog {} {
- pd [concat pd watchdog \;]
- after 2000 {pdtk_watchdog}
-}
-
-proc pdtk_ping {} {
- pd [concat pd ping \;]
-}
-
-##### routine to ask user if OK and, if so, send a message on to Pd ######
-proc pdtk_check {canvas x message default} {
- global pd_nt
- if {$pd_nt == 1} {
- set answer [tk_messageBox -message $x -type yesno -default $default \
- -icon question]
- } else {
- set answer [tk_messageBox -message $x -type yesno -default $default \
- -parent $canvas -icon question]
- }
- if {! [string compare $answer yes]} {pd $message}
-}
-
-set menu_windowlist {}
-
-proc pdtk_fixwindowmenu {} {
- global menu_windowlist
- .mbar.windows delete 0 end
- foreach i $menu_windowlist {
- .mbar.windows add command -label [lindex $i 0] \
- -command [concat menu_domenuwindow [lindex $i 1]]
- menu_fixwindowmenu [lindex $i 1]
- }
-}
-
-####### Odd little function to make better Mac accelerators #####
-
-proc accel_munge {acc} {
- global pd_nt
-
- if {$pd_nt == 2} {
- if [string is upper [string index $acc end]] {
- return [format "%s%s" "Shift+" \
- [string toupper [string map {Ctrl Meta} $acc] end]]
- } else {
- return [string toupper [string map {Ctrl Meta} $acc] end]
- }
- } else {
- return $acc
- }
-}
-
-
-
-############### the "New" menu command ########################
-proc menu_new {} {
- global untitled_number
- global untitled_directory
- pd [concat pd filename Untitled-$untitled_number $untitled_directory \;]
- pd {
- #N canvas;
- #X pop 1;
- }
- set untitled_number [expr $untitled_number + 1]
-}
-
-################## the "Open" menu command #########################
-
-proc menu_open {parent} {
- global pd_opendir
- set filename [tk_getOpenFile -defaultextension .pd -parent $parent\
- -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \
- -initialdir $pd_opendir]
- if {$filename != ""} {open_file $filename}
-}
-
-proc open_file {filename} {
- global pd_opendir
- set directory [string range $filename 0 [expr [string last / $filename] - 1]]
- set pd_opendir $directory
- set basename [string range $filename [expr [string last / $filename] + 1] end]
- if {[string last .pd $filename] >= 0} {
- pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
- }
-}
-
-catch {
- package require tkdnd
- dnd bindtarget . text/uri-list <Drop> {
- foreach file %D {open_file $file}
- }
-}
-
-################## the "Message" menu command #########################
-proc menu_send {} {
- toplevel .sendpanel
- entry .sendpanel.entry -textvariable send_textvariable
- pack .sendpanel.entry -side bottom -fill both -ipadx 100
- .sendpanel.entry select from 0
- .sendpanel.entry select adjust end
- bind .sendpanel.entry <KeyPress-Return> {
- pd [concat $send_textvariable \;]
- }
- pdtk_standardkeybindings .sendpanel.entry
- focus .sendpanel.entry
-}
-
-################## the "Quit" menu command #########################
-proc menu_really_quit {} {pd {pd quit;}}
-
-proc menu_quit {} {pd {pd verifyquit;}}
-
-######### the "Pd" menu command, which puts the Pd window on top ########
-proc menu_pop_pd {} {raise .}
-
-######### the "audio" menu command ###############
-proc menu_audio {flag} {pd [concat pd dsp $flag \;]}
-
-######### the "reselect" menu command ################
-proc menu_reselect {name} {pd [concat $name reselect \;]}
-
-######### the "documentation" menu command ###############
-
-set doc_number 1
-
-# open text docs in a Pd window
-proc menu_opentext {filename} {
- global doc_number
- global pd_guidir
- global pd_myversion
- set name [format ".help%d" $doc_number]
- toplevel $name
- text $name.text -relief raised -bd 2 -font text_font \
- -yscrollcommand "$name.scroll set" -background white
- scrollbar $name.scroll -command "$name.text yview"
- pack $name.scroll -side right -fill y
- pack $name.text -side left -fill both -expand 1
-
- set f [open $filename]
- while {![eof $f]} {
- set bigstring [read $f 1000]
- regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2
- regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3
- $name.text insert end $bigstring3
- }
- close $f
- set doc_number [expr $doc_number + 1]
-}
-
-# open HTML docs from the menu using the OS-default HTML viewer
-proc menu_openhtml {filename} {
- global pd_nt
-
- if {$pd_nt == 0} {
- foreach candidate \
- { gnome-open xdg-open sensible-browser iceweasel firefox mozilla \
- galeon konqueror netscape lynx } {
- set browser [lindex [auto_execok $candidate] 0]
- if {[string length $browser]} {
- puts stderr [format "%s %s" $browser $filename]
- exec -- sh -c [format "%s %s" $browser $filename] &
- break
- }
- }
- } elseif {$pd_nt == 2} {
- puts stderr [format "open %s" $filename]
- exec sh -c [format "open %s" $filename]
- } else {
- exec rundll32 url.dll,FileProtocolHandler \
- [format "file://%s" $filename] &
- }
-}
-
-proc menu_doc_open {subdir basename} {
- global pd_guidir
-
- set dirname $pd_guidir/$subdir
-
- if {[regexp ".*\.(txt|c)$" $basename]} {
- menu_opentext $dirname/$basename
- } elseif {[regexp ".*\.html?$" $basename]} {
- menu_openhtml $dirname/$basename
- } else {
- pd [concat pd open [pdtk_enquote $basename] \
- [pdtk_enquote $dirname] \;]
- }
-}
-
-
-################## help browser and support functions #########################
-proc menu_doc_browser {dir} {
- global .mbar
- if {![file isdirectory $dir]} {
- puts stderr "menu_doc_browser non-directory $dir\n"
- }
- if { [winfo exists .help_browser.frame] } {
- raise .help_browser
- } else {
- toplevel .help_browser -menu .mbar
- wm title .help_browser "Pd Documentation Browser"
- frame .help_browser.frame
- pack .help_browser.frame -side top -fill both
- doc_make_listbox .help_browser.frame $dir 0
- }
- }
-
-proc doc_make_listbox {base dir count} {
- # check for [file readable]?
- #if { [info tclversion] >= 8.5 } {
- # requires Tcl 8.5 but probably deals with special chars better
-# destroy {expand}[lrange [winfo children $base] [expr {2 * $count}] end]
- #} else {
- if { [catch { eval destroy [lrange [winfo children $base] \
- [expr { 2 * $count }] end] } \
- errorMessage] } {
- puts stderr "doc_make_listbox: error listing $dir\n"
- }
- #}
- # exportselection 0 looks good, but selection gets easily out-of-sync
- set current_listbox [listbox "[set b "$base.listbox$count"]-list" -yscrollcommand \
- [list "$b-scroll" set] -height 20 -exportselection 0]
- pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \
- -side left -expand 1 -fill y -anchor w
- foreach item [concat [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] \
- [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- *]]] {
- $current_listbox insert end "[file tail $item][expr {[file isdirectory $item] ? {/} : {}}]"
- }
- bind $current_listbox <Button-1> [list doc_navigate $dir $count %W %x %y]
- bind $current_listbox <Double-Button-1> [list doc_double_button $dir $count %W %x %y]
-}
-
-proc doc_navigate {dir count width x y} {
- if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} {
- return
- }
- set dir_to_open [file join $dir $newdir]
- if {[file isdirectory $dir_to_open]} {
- doc_make_listbox [winfo parent $width] $dir_to_open [incr count]
- }
-}
-
-proc doc_double_button {dir count width x y} {
- global pd_guidir
- if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} {
- return
- }
- set dir_to_open [file join $dir $newdir]
- if {[file isdirectory $dir_to_open]} {
- doc_navigate $dir $count $width $x $y
- } else {
- regsub -- $pd_guidir [file dirname $dir_to_open] "" subdir
- set file [file tail $dir_to_open]
- if { [catch {menu_doc_open $subdir $file} fid] } {
- puts stderr "Could not open $pd_guidir/$subdir/$file\n"
- }
- return;
- }
-}
-
-############# routine to add media, help, and apple menu items ###############
-
-proc menu_addstd {mbar} {
- global pd_apilist pd_midiapilist pd_nt pd_tearoff
-# the "Audio" menu
- $mbar.audio add command -label {audio ON} -accelerator [accel_munge "Ctrl+/"] \
- -command {menu_audio 1}
- $mbar.audio add command -label {audio OFF} -accelerator [accel_munge "Ctrl+."] \
- -command {menu_audio 0}
- for {set x 0} {$x<[llength $pd_apilist]} {incr x} {
- $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \
- -command {menu_audio 0} -variable pd_whichapi \
- -value [lindex [lindex $pd_apilist $x] 1]\
- -command {pd [concat pd audio-setapi $pd_whichapi \;]}
- }
- for {set x 0} {$x<[llength $pd_midiapilist]} {incr x} {
- $mbar.audio add radiobutton -label [lindex [lindex $pd_midiapilist $x] 0] \
- -command {menu_midi 0} -variable pd_whichmidiapi \
- -value [lindex [lindex $pd_midiapilist $x] 1]\
- -command {pd [concat pd midi-setapi $pd_whichmidiapi \;]}
- }
- if {$pd_nt != 2} {
- $mbar.audio add command -label {Audio settings...} \
- -command {pd pd audio-properties \;}
- $mbar.audio add command -label {MIDI settings...} \
- -command {pd pd midi-properties \;}
- }
-
- $mbar.audio add command -label {Test Audio and MIDI} \
- -command {menu_doc_open doc/7.stuff/tools testtone.pd}
- $mbar.audio add command -label {Load Meter} \
- -command {menu_doc_open doc/7.stuff/tools load-meter.pd}
-
-# the MacOS X app menu
-
-# The menu on the main menubar named $whatever.apple while be treated
-# as a special menu on MacOS X. Tcl/Tk assigns the $whatever.apple menu
-# to the app-specific menu in MacOS X that is named after the app,
-# so in our case, the Pd menu. <hans@at.or.at>
-# See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
- if {$pd_nt == 2} {
- $mbar.apple add command -label "About Pd..." -command \
- {menu_doc_open doc/1.manual 1.introduction.txt}
- menu $mbar.apple.preferences -tearoff 0
- $mbar.apple add cascade -label "Preferences" -menu $mbar.apple.preferences
- $mbar.apple.preferences add command -label "Path..." \
- -command {pd pd start-path-dialog \;}
- $mbar.apple.preferences add command -label "Startup..." \
- -command {pd pd start-startup-dialog \;}
- $mbar.apple.preferences add command -label "Audio Settings..." \
- -command {pd pd audio-properties \;}
- $mbar.apple.preferences add command -label "MIDI settings..." \
- -command {pd pd midi-properties \;}
- }
-
-
- # the "Help" menu
- if {$pd_nt != 2} {
- $mbar.help add command -label {About Pd} \
- -command {menu_doc_open doc/1.manual 1.introduction.txt}
- }
- $mbar.help add command -label {Html ...} \
- -command {menu_doc_open doc/1.manual index.htm}
- $mbar.help add command -label {Browser ...} \
- -command {menu_doc_browser $help_top_directory}
-}
-
-#################### the "File" menu for the Pd window ##############
-
-.mbar.file add command -label New -command {menu_new} \
- -accelerator [accel_munge "Ctrl+n"]
-.mbar.file add command -label Open -command {menu_open .} \
- -accelerator [accel_munge "Ctrl+o"]
-.mbar.file add separator
-.mbar.file add command -label Message -command {menu_send} \
- -accelerator [accel_munge "Ctrl+m"]
-# On MacOS X, these are in the standard HIG locations
-# i.e. the Preferences menu under "Pd"
-if {$pd_nt != 2} {
-.mbar.file add command -label Path... \
- -command {pd pd start-path-dialog \;}
-.mbar.file add command -label Startup... \
- -command {pd pd start-startup-dialog \;}
-}
-.mbar.file add separator
-.mbar.file add command -label Quit -command {menu_quit} \
- -accelerator [accel_munge "Ctrl+q"]
-
-#################### the "Find" menu for the Pd window ##############
-.mbar.find add command -label {Find last error} -command {menu_finderror}
-
-########### functions for menu functions on document windows ########
-
-proc menu_save {name} {
- pdtk_canvas_checkgeometry $name
- pd [concat $name menusave \;]
-}
-
-proc menu_saveas {name} {
- pdtk_canvas_checkgeometry $name
- pd [concat $name menusaveas \;]
-}
-
-proc menu_print {name} {
- set filename [tk_getSaveFile -initialfile pd.ps \
- -defaultextension .ps \
- -filetypes { {{postscript} {.ps}} }]
-
- if {$filename != ""} {
- $name.c postscript -file $filename
- }
-}
-
-proc menu_close {name} {
- pdtk_canvas_checkgeometry $name
- pd [concat $name menuclose 0 \;]
-}
-
-proc menu_really_close {name} {
- pdtk_canvas_checkgeometry $name
- pd [concat $name menuclose 1 \;]
-}
-
-proc menu_undo {name} {
- global pd_undoaction
- global pd_redoaction
- global pd_undocanvas
- if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
- pd [concat $name undo \;]
- }
-}
-
-proc menu_redo {name} {
- global pd_undoaction
- global pd_redoaction
- global pd_undocanvas
- if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
- pd [concat $name redo \;]
- }
-}
-
-proc menu_cut {name} {
- pd [concat $name cut \;]
-}
-
-proc menu_copy {name} {
- pd [concat $name copy \;]
-}
-
-proc menu_paste {name} {
- pd [concat $name paste \;]
-}
-
-proc menu_duplicate {name} {
- pd [concat $name duplicate \;]
-}
-
-proc menu_selectall {name} {
- pd [concat $name selectall \;]
-}
-
-proc menu_texteditor {name} {
- pd [concat $name texteditor \;]
-}
-
-proc menu_font {name} {
- pd [concat $name menufont \;]
-}
-
-proc menu_tidyup {name} {
- pd [concat $name tidy \;]
-}
-
-proc menu_editmode {name} {
- pd [concat $name editmode 0 \;]
-}
-
-proc menu_object {name accel} {
- pd [concat $name obj $accel \;]
-}
-
-proc menu_message {name accel} {
- pd [concat $name msg $accel \;]
-}
-
-proc menu_floatatom {name accel} {
- pd [concat $name floatatom $accel \;]
-}
-
-proc menu_symbolatom {name accel} {
- pd [concat $name symbolatom $accel \;]
-}
-
-proc menu_comment {name accel} {
- pd [concat $name text $accel \;]
-}
-
-proc menu_graph {name} {
- pd [concat $name graph \;]
-}
-
-proc menu_array {name} {
- pd [concat $name menuarray \;]
-}
-
-############iemlib##################
-proc menu_bng {name accel} {
- pd [concat $name bng $accel \;]
-}
-
-proc menu_toggle {name accel} {
- pd [concat $name toggle $accel \;]
-}
-
-proc menu_numbox {name accel} {
- pd [concat $name numbox $accel \;]
-}
-
-proc menu_vslider {name accel} {
- pd [concat $name vslider $accel \;]
-}
-
-proc menu_hslider {name accel} {
- pd [concat $name hslider $accel \;]
-}
-
-proc menu_hradio {name accel} {
- pd [concat $name hradio $accel \;]
-}
-
-proc menu_vradio {name accel} {
- pd [concat $name vradio $accel \;]
-}
-
-proc menu_vumeter {name accel} {
- pd [concat $name vumeter $accel \;]
-}
-
-proc menu_mycnv {name accel} {
- pd [concat $name mycnv $accel \;]
-}
-
-############iemlib##################
-
-# correct edit menu, enabling or disabling undo/redo
-# LATER also cut/copy/paste
-proc menu_fixeditmenu {name} {
- global pd_undoaction
- global pd_redoaction
- global pd_undocanvas
-# puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction]
- if {$name == $pd_undocanvas && $pd_undoaction != "no"} {
- $name.m.edit entryconfigure "Undo*" -state normal \
- -label [concat "Undo " $pd_undoaction]
- } else {
- $name.m.edit entryconfigure "Undo*" -state disabled -label "Undo"
- }
- if {$name == $pd_undocanvas && $pd_redoaction != "no"} {
- $name.m.edit entryconfigure "Redo*" -state normal\
- -label [concat "Redo " $pd_redoaction]
- } else {
- $name.m.edit entryconfigure "Redo*" -state disabled
- }
-}
-
-# message from Pd to update the currently available undo/redo action
-proc pdtk_undomenu {name undoaction redoaction} {
- global pd_undoaction
- global pd_redoaction
- global pd_undocanvas
-# puts stderr [concat pdtk_undomenu $name $undoaction $redoaction]
- set pd_undocanvas $name
- set pd_undoaction $undoaction
- set pd_redoaction $redoaction
- if {$name != "nobody"} {
-# unpleasant way of avoiding a more unpleasant bug situation --atl 2002.11.25
- menu_fixeditmenu $name
- }
-}
-
-proc menu_windowparent {name} {
- pd [concat $name findparent \;]
-}
-
-proc menu_findagain {name} {
- pd [concat $name findagain \;]
-}
-
-proc menu_finderror {} {
- pd [concat pd finderror \;]
-}
-
-proc menu_domenuwindow {i} {
- raise $i
-}
-
-proc menu_fixwindowmenu {name} {
- global menu_windowlist
- global pd_tearoff
- $name.m.windows add command
- if $pd_tearoff {
- $name.m.windows delete 4 end
- } else {
- $name.m.windows delete 3 end
- }
- foreach i $menu_windowlist {
- $name.m.windows add command -label [lindex $i 0] \
- -command [concat menu_domenuwindow [lindex $i 1]]
- }
-}
-
-################## the "find" menu item ###################
-
-set find_canvas nobody
-set find_string ""
-set find_count 1
-set find_wholeword 1
-
-proc find_apply {name} {
- global find_string find_canvas find_wholeword
- pd [concat $find_canvas find [pdtk_encodedialog $find_string] \
- $find_wholeword \;]
- after 50 destroy $name
-}
-
-proc find_cancel {name} {
- after 50 destroy $name
-}
-
-proc menu_findobject {canvas} {
- global find_string find_canvas find_count find_wholeword
-
- set name [format ".find%d" $find_count]
- set find_count [expr $find_count + 1]
-
- set find_canvas $canvas
-
- toplevel $name
-
- label $name.label -text {find...}
- pack $name.label -side top
-
- entry $name.entry -textvariable find_string
- pack $name.entry -side top
- checkbutton $name.wholeword -variable find_wholeword \
- -text {whole word} -anchor e
- pack $name.wholeword -side bottom
-
- frame $name.buttonframe
- pack $name.buttonframe -side bottom -fill x -pady 2m
- button $name.buttonframe.cancel -text {Cancel}\
- -command "find_cancel $name"
- button $name.buttonframe.ok -text {OK}\
- -command "find_apply $name"
- pack $name.buttonframe.cancel -side left -expand 1
- pack $name.buttonframe.ok -side left -expand 1
-
- $name.entry select from 0
- $name.entry select adjust end
- bind $name.entry <KeyPress-Return> [ concat find_apply $name]
- pdtk_standardkeybindings $name.entry
- focus $name.entry
-}
-
-
-############# pdtk_canvas_new -- create a new canvas ###############
-proc pdtk_canvas_new {name width height geometry editable} {
- global pd_opendir
- global pd_tearoff
- global pd_nt
- global tcl_version
-
- toplevel $name -menu $name.m
- # if we're a mac, refuse to make window so big you can't get to
- # the resizing control
- if {$pd_nt == 2} {
- if {$width > [winfo screenwidth $name] - 80} {
- set width [expr [winfo screenwidth $name] - 80]
- }
- if {$height > [winfo screenheight $name] - 80} {
- set height [expr [winfo screenheight $name] - 80]
- }
- }
-
-# slide offscreen windows into view
- if {$tcl_version >= 8.4} {
- set geometry [split $geometry +]
- set i 1
- foreach geo {width height} {
- set screen($geo) [winfo screen$geo .]
- if {[expr [lindex $geometry $i] + [set $geo]] > $screen($geo)} {
- set pos($geo) [expr $screen($geo) - [set $geo]]
- if {$pos($geo) < 0} {set pos($geo) 0}
- lset geometry $i $pos($geo)
- }
- incr i
- }
- set geometry [join $geometry +]
- }
- wm geometry $name $geometry
- canvas $name.c -width $width -height $height -background white \
- -yscrollcommand "$name.scrollvert set" \
- -xscrollcommand "$name.scrollhort set" \
- -scrollregion [concat 0 0 $width $height]
-
- scrollbar $name.scrollvert -command "$name.c yview"
- scrollbar $name.scrollhort -command "$name.c xview" \
- -orient horizontal
-
- pack $name.scrollhort -side bottom -fill x
- pack $name.scrollvert -side right -fill y
- pack $name.c -side left -expand 1 -fill both
- wm minsize $name 1 1
- wm geometry $name $geometry
-# the file menu
-
-# The menus are instantiated here for the patch windows.
-# For the main window, they are created on load, at the
-# top of this file.
- menu $name.m
- menu $name.m.file -tearoff $pd_tearoff
- $name.m add cascade -label File -menu $name.m.file
-
- $name.m.file add command -label New -command {menu_new} \
- -accelerator [accel_munge "Ctrl+n"]
-
- $name.m.file add command -label Open -command [concat menu_open $name] \
- -accelerator [accel_munge "Ctrl+o"]
-
- $name.m.file add separator
- $name.m.file add command -label Message -command {menu_send} \
- -accelerator [accel_munge "Ctrl+m"]
-
- # arrange menus according to Apple HIG
- # these are now part of Preferences...
- if {$pd_nt != 2 } {
- $name.m.file add command -label Path... \
- -command {pd pd start-path-dialog \;}
-
- $name.m.file add command -label Startup... \
- -command {pd pd start-startup-dialog \;}
- }
-
- $name.m.file add separator
- $name.m.file add command -label Close \
- -command [concat menu_close $name] \
- -accelerator [accel_munge "Ctrl+w"]
-
- $name.m.file add command -label Save -command [concat menu_save $name] \
- -accelerator [accel_munge "Ctrl+s"]
-
- $name.m.file add command -label "Save as..." \
- -command [concat menu_saveas $name] \
- -accelerator [accel_munge "Ctrl+S"]
-
- $name.m.file add command -label Print -command [concat menu_print $name] \
- -accelerator [accel_munge "Ctrl+p"]
-
- $name.m.file add separator
-
- $name.m.file add command -label Quit -command {menu_quit} \
- -accelerator [accel_munge "Ctrl+q"]
-
-# the edit menu
- menu $name.m.edit -postcommand [concat menu_fixeditmenu $name] -tearoff $pd_tearoff
- $name.m add cascade -label Edit -menu $name.m.edit
-
- $name.m.edit add command -label Undo -command [concat menu_undo $name] \
- -accelerator [accel_munge "Ctrl+z"]
-
- $name.m.edit add command -label Redo -command [concat menu_redo $name] \
- -accelerator [accel_munge "Ctrl+Z"]
-
- $name.m.edit add separator
-
- $name.m.edit add command -label Cut -command [concat menu_cut $name] \
- -accelerator [accel_munge "Ctrl+x"]
-
- $name.m.edit add command -label Copy -command [concat menu_copy $name] \
- -accelerator [accel_munge "Ctrl+c"]
-
- $name.m.edit add command -label Paste \
- -command [concat menu_paste $name] \
- -accelerator [accel_munge "Ctrl+v"]
-
- $name.m.edit add command -label Duplicate \
- -command [concat menu_duplicate $name] \
- -accelerator [accel_munge "Ctrl+d"]
-
- $name.m.edit add command -label {Select all} \
- -command [concat menu_selectall $name] \
- -accelerator [accel_munge "Ctrl+a"]
-
- $name.m.edit add command -label {Reselect} \
- -command [concat menu_reselect $name] \
- -accelerator "Ctrl+Enter"
-
- $name.m.edit add separator
-
- $name.m.edit add command -label {Text Editor} \
- -command [concat menu_texteditor $name] \
- -accelerator [accel_munge "Ctrl+t"]
-
- $name.m.edit add command -label Font \
- -command [concat menu_font $name]
-
- $name.m.edit add command -label {Tidy Up} \
- -command [concat menu_tidyup $name]
-
- $name.m.edit add separator
-
-# Apple, Microsoft, and others put find functions in the Edit menu.
- $name.m.edit add command -label {Find...} \
- -accelerator [accel_munge "Ctrl+f"] \
- -command [concat menu_findobject $name]
- $name.m.edit add command -label {Find Again} \
- -accelerator [accel_munge "Ctrl+g"] \
- -command [concat menu_findagain $name]
- $name.m.edit add command -label {Find last error} \
- -command [concat menu_finderror]
-
- $name.m.edit add separator
-
-############iemlib##################
-# instead of "red = #BC3C60" we take "grey85", so there is no difference,
-# if widget is selected or not.
-
- $name.m.edit add checkbutton -label "Edit mode" \
- -indicatoron true -selectcolor grey85 \
- -command [concat menu_editmode $name] \
- -accelerator [accel_munge "Ctrl+e"]
-
- if { $editable == 0 } {
- $name.m.edit entryconfigure "Edit mode" -indicatoron false }
-
-
-############iemlib##################
-
-
-# the put menu
- menu $name.m.put -tearoff $pd_tearoff
- $name.m add cascade -label Put -menu $name.m.put
-
- $name.m.put add command -label Object \
- -command [concat menu_object $name 0] \
- -accelerator [accel_munge "Ctrl+1"]
-
- $name.m.put add command -label Message \
- -command [concat menu_message $name 0] \
- -accelerator [accel_munge "Ctrl+2"]
-
- $name.m.put add command -label Number \
- -command [concat menu_floatatom $name 0] \
- -accelerator [accel_munge "Ctrl+3"]
-
- $name.m.put add command -label Symbol \
- -command [concat menu_symbolatom $name 0] \
- -accelerator [accel_munge "Ctrl+4"]
-
- $name.m.put add command -label Comment \
- -command [concat menu_comment $name 0] \
- -accelerator [accel_munge "Ctrl+5"]
-
- $name.m.put add separator
-
-############iemlib##################
-
- $name.m.put add command -label Bang \
- -command [concat menu_bng $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+b"]
-
- $name.m.put add command -label Toggle \
- -command [concat menu_toggle $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+t"]
-
- $name.m.put add command -label Number2 \
- -command [concat menu_numbox $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+n"]
-
- $name.m.put add command -label Vslider \
- -command [concat menu_vslider $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+v"]
-
- $name.m.put add command -label Hslider \
- -command [concat menu_hslider $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+h"]
-
- $name.m.put add command -label Vradio \
- -command [concat menu_vradio $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+d"]
-
- $name.m.put add command -label Hradio \
- -command [concat menu_hradio $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+i"]
-
- $name.m.put add command -label VU \
- -command [concat menu_vumeter $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+u"]
-
- $name.m.put add command -label Canvas \
- -command [concat menu_mycnv $name 0] \
- -accelerator [accel_munge "Shift+Ctrl+c"]
-
-############iemlib##################
-
- $name.m.put add separator
-
- $name.m.put add command -label Graph \
- -command [concat menu_graph $name]
-
- $name.m.put add command -label Array \
- -command [concat menu_array $name]
-
-# the find menu
-# Apple, Microsoft, and others put find functions in the Edit menu.
-# But in order to move these items to the Edit menu, the Find menu
-# handling needs to be dealt with, including this line in g_canvas.c:
-# sys_vgui(".mbar.find delete %d\n", i);
-# <hans@at.or.at>
- menu $name.m.find -tearoff $pd_tearoff
- $name.m add cascade -label Find -menu $name.m.find
-
- $name.m.find add command -label {Find...} \
- -accelerator [accel_munge "Ctrl+f"] \
- -command [concat menu_findobject $name]
- $name.m.find add command -label {Find Again} \
- -accelerator [accel_munge "Ctrl+g"] \
- -command [concat menu_findagain $name]
- $name.m.find add command -label {Find last error} \
- -command [concat menu_finderror]
-
-# the window menu
- menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \
- -tearoff $pd_tearoff
-
- $name.m.windows add command -label {parent window}\
- -command [concat menu_windowparent $name]
- $name.m.windows add command -label {Pd window} -command menu_pop_pd
- $name.m.windows add separator
-
-# the audio menu
- menu $name.m.audio -tearoff $pd_tearoff
-
- if {$pd_nt != 2} {
- $name.m add cascade -label Windows -menu $name.m.windows
- $name.m add cascade -label Media -menu $name.m.audio
- } else {
- $name.m add cascade -label Media -menu $name.m.audio
- $name.m add cascade -label Window -menu $name.m.windows
-# the MacOS X app menu
- menu $name.m.apple -tearoff $pd_tearoff
- $name.m add cascade -label "Apple" -menu $name.m.apple
- }
-
-# the help menu
-
- menu $name.m.help -tearoff $pd_tearoff
- $name.m add cascade -label Help -menu $name.m.help
-
- menu_addstd $name.m
-
-# the popup menu
- menu $name.popup -tearoff false
- $name.popup add command -label {Properties} \
- -command [concat popup_action $name 0]
- $name.popup add command -label {Open} \
- -command [concat popup_action $name 1]
- $name.popup add command -label {Help} \
- -command [concat popup_action $name 2]
-
-# fix menu font size on Windows with tk scaling = 1
-if {$pd_nt == 1} {
- $name.m.file configure -font menuFont
- $name.m.edit configure -font menuFont
- $name.m.find configure -font menuFont
- $name.m.put configure -font menuFont
- $name.m.windows configure -font menuFont
- $name.m.audio configure -font menuFont
- $name.m.help configure -font menuFont
- $name.popup configure -font menuFont
-}
-
-# WM protocol
- wm protocol $name WM_DELETE_WINDOW [concat menu_close $name]
-
-# bindings.
-# this is idiotic -- how do you just sense what mod keys are down and
-# pass them on? I can't find it anywhere.
-# Here we encode shift as 1, control 2, alt 4, in agreement
-# with definitions in g_canvas.c. The third button gets "8" but we don't
-# bother with modifiers there.
-# We don't handle multiple clicks yet.
-
- bind $name.c <Button> {pdtk_canvas_click %W %x %y %b 0}
- bind $name.c <Shift-Button> {pdtk_canvas_click %W %x %y %b 1}
- bind $name.c <Control-Shift-Button> {pdtk_canvas_click %W %x %y %b 3}
- # Alt key is called Option on the Mac
- if {$pd_nt == 2} {
- bind $name.c <Option-Button> {pdtk_canvas_click %W %x %y %b 4}
- bind $name.c <Option-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
- bind $name.c <Option-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
- bind $name.c <Mod1-Button> {pdtk_canvas_click %W %x %y %b 6}
- bind $name.c <Option-Control-Shift-Button> \
- {pdtk_canvas_click %W %x %y %b 7}
- } else {
- bind $name.c <Alt-Button> {pdtk_canvas_click %W %x %y %b 4}
- bind $name.c <Alt-Shift-Button> {pdtk_canvas_click %W %x %y %b 5}
- bind $name.c <Alt-Control-Button> {pdtk_canvas_click %W %x %y %b 6}
- bind $name.c <Alt-Control-Shift-Button> \
- {pdtk_canvas_click %W %x %y %b 7}
- }
- global pd_nt
-# button 2 is the right button on Mac; on other platforms it's button 3.
- if {$pd_nt == 2} {
- bind $name.c <Button-2> {pdtk_canvas_click %W %x %y %b 8}
- bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 8}
- } else {
- bind $name.c <Button-3> {pdtk_canvas_click %W %x %y %b 8}
- bind $name.c <Control-Button> {pdtk_canvas_click %W %x %y %b 2}
- }
-#on linux, button 2 "pastes" from the X windows clipboard
- if {$pd_nt == 0} {
- bind $name.c <Button-2> {\
- pdtk_canvas_click %W %x %y %b 0;\
- pdtk_canvas_mouseup %W %x %y %b;\
- pdtk_pastetext}
- }
-
- bind $name.c <ButtonRelease> {pdtk_canvas_mouseup %W %x %y %b}
- bind $name.c <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
- bind $name.c <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
-# bind $name.c <Mod1-Key> {puts stderr [concat mod1 %W %K %A]}
- if {$pd_nt == 2} {
- bind $name.c <Mod1-Key> {pdtk_canvas_ctrlkey %W %K 0}
- bind $name.c <Mod1-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
- }
- bind $name.c <Key> {pdtk_canvas_key %W %K %A 0}
- bind $name.c <Shift-Key> {pdtk_canvas_key %W %K %A 1}
- bind $name.c <KeyRelease> {pdtk_canvas_keyup %W %K %A}
- bind $name.c <Motion> {pdtk_canvas_motion %W %x %y 0}
- bind $name.c <Control-Motion> {pdtk_canvas_motion %W %x %y 2}
- if {$pd_nt == 2} {
- bind $name.c <Option-Motion> {pdtk_canvas_motion %W %x %y 4}
- } else {
- bind $name.c <Alt-Motion> {pdtk_canvas_motion %W %x %y 4}
- }
- bind $name.c <Map> {pdtk_canvas_map %W}
- bind $name.c <Unmap> {pdtk_canvas_unmap %W}
- focus $name.c
-
- switch $pd_nt { 0 {
- bind $name.c <Button-4> "pdtk_canvas_scroll $name.c y -1"
- bind $name.c <Button-5> "pdtk_canvas_scroll $name.c y +1"
- bind $name.c <Shift-Button-4> "pdtk_canvas_scroll $name.c x -1"
- bind $name.c <Shift-Button-5> "pdtk_canvas_scroll $name.c x +1"
- } default {
- bind $name.c <MouseWheel> \
- "pdtk_canvas_scroll $name.c y \[expr -abs(%D)/%D\]"
- bind $name.c <Shift-MouseWheel> \
- "pdtk_canvas_scroll $name.c x \[expr -abs(%D)/%D\]"
- }}
-
- catch {
- dnd bindtarget $name.c text/uri-list <Drop> \
- "pdtk_canvas_makeobjs $name %D %x %y"
- }
-
-# puts stderr "all done"
-# after 1 [concat raise $name]
- global pdtk_canvas_mouseup_name
- set pdtk_canvas_mouseup_name ""
-}
-
-#### 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"
-
- pd [concat $cmd \;]
- }
-}
-
-proc pdtk_array_listview_new {id arrayName page} {
- global pd_nt
- 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 {$pd_nt == 0} {
- selection handle $windowName.lb \
- "pdtk_array_listview_lbselection $arrayName"
- } else {
- if {$pd_nt == 1} {
- 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] != {}} {
- pd [concat $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 pd_nt
- 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] != {}} {
- pd [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
- set cmd [concat $id "arrayviewclose" \;]
- pd $cmd
-}
-##### end jsarlo #####
-
-#################### event binding procedures ################
-
-#get the name of the toplevel window for a canvas; this is also
-#the name of the canvas object in Pd.
-
-proc canvastosym {name} {
- string range $name 0 [expr [string length $name] - 3]
-}
-
-set pdtk_lastcanvasconfigured ""
-set pdtk_lastcanvasconfiguration ""
-set pdtk_lastcanvasconfiguration2 ""
-
-proc pdtk_canvas_checkgeometry {topname} {
- set boo [winfo geometry $topname.c]
- set boo2 [wm geometry $topname]
- global pdtk_lastcanvasconfigured
- global pdtk_lastcanvasconfiguration
- global pdtk_lastcanvasconfiguration2
- if {$topname != $pdtk_lastcanvasconfigured || \
- $boo != $pdtk_lastcanvasconfiguration || \
- $boo2 != $pdtk_lastcanvasconfiguration2} {
- set pdtk_lastcanvasconfigured $topname
- set pdtk_lastcanvasconfiguration $boo
- set pdtk_lastcanvasconfiguration2 $boo2
- pd $topname relocate $boo $boo2 \;
- }
-}
-
-proc pdtk_canvas_click {name x y b f} {
- global pd_nt
- if {$pd_nt == 0} {focus $name}
- pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b $f \;
-}
-
-proc pdtk_canvas_shiftclick {name x y b} {
- pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 1 \;
-}
-
-proc pdtk_canvas_ctrlclick {name x y b} {
- pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 2 \;
-}
-
-proc pdtk_canvas_altclick {name x y b} {
- pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 3 \;
-}
-
-proc pdtk_canvas_dblclick {name x y b} {
- pd [canvastosym $name] mouse [$name canvasx $x] [$name canvasy $y] $b 4 \;
-}
-
-set pdtk_canvas_mouseup_name 0
-set pdtk_canvas_mouseup_xminval 0
-set pdtk_canvas_mouseup_xmaxval 0
-set pdtk_canvas_mouseup_yminval 0
-set pdtk_canvas_mouseup_ymaxval 0
-
-proc pdtk_canvas_mouseup {name x y b} {
- pd [concat [canvastosym $name] mouseup [$name canvasx $x] \
- [$name canvasy $y] $b \;]
-}
-
-proc pdtk_canvas_getscroll {name} {
- global pdtk_canvas_mouseup_name
- global pdtk_canvas_mouseup_xminval
- global pdtk_canvas_mouseup_xmaxval
- global pdtk_canvas_mouseup_yminval
- global pdtk_canvas_mouseup_ymaxval
-
- set size [$name bbox all]
- if {$size != ""} {
- set xminval 0
- set yminval 0
- set xmaxval 100
- set ymaxval 100
- set x1 [lindex $size 0]
- set x2 [lindex $size 2]
- set y1 [lindex $size 1]
- set y2 [lindex $size 3]
-
- if {$x1 < 0} {set xminval $x1}
- if {$y1 < 0} {set yminval $y1}
-
- if {$x2 > 100} {set xmaxval $x2}
- if {$y2 > 100} {set ymaxval $y2}
-
- if {$pdtk_canvas_mouseup_name != $name || \
- $pdtk_canvas_mouseup_xminval != $xminval || \
- $pdtk_canvas_mouseup_xmaxval != $xmaxval || \
- $pdtk_canvas_mouseup_yminval != $yminval || \
- $pdtk_canvas_mouseup_ymaxval != $ymaxval } {
-
- set newsize "$xminval $yminval $xmaxval $ymaxval"
- $name configure -scrollregion $newsize
- set pdtk_canvas_mouseup_name $name
- set pdtk_canvas_mouseup_xminval $xminval
- set pdtk_canvas_mouseup_xmaxval $xmaxval
- set pdtk_canvas_mouseup_yminval $yminval
- set pdtk_canvas_mouseup_ymaxval $ymaxval
- }
-
- }
- pdtk_canvas_checkgeometry [canvastosym $name]
-}
-
-proc pdtk_canvas_key {name key iso shift} {
-# puts stderr [concat down key= $key iso= $iso]
-# .controls.switches.meterbutton configure -text $key
-# HACK for MAC OSX -- backspace seems different; I don't understand why.
-# invesigate this LATER...
- global pd_nt
- if {$pd_nt == 2} {
- if {$key == "BackSpace"} {
- set key 8
- set keynum 8
- }
- if {$key == "Delete"} {
- set key 8
- set keynum 8
- }
- }
- if {$key == "KP_Delete"} {
- set key 127
- set keynum 127
- }
- if {$iso != ""} {
- scan $iso %c keynum
- pd [canvastosym $name] key 1 $keynum $shift\;
- } else {
- pd [canvastosym $name] key 1 $key $shift\;
- }
-}
-
-proc pdtk_canvas_keyup {name key iso} {
-# puts stderr [concat up key= $key iso= $iso]
- if {$iso != ""} {
- scan $iso %c keynum
- pd [canvastosym $name] key 0 $keynum 0 \;
- } else {
- pd [canvastosym $name] key 0 $key 0 \;
- }
-}
-
-proc pdtk_canvas_ctrlkey {name key shift} {
-# first get rid of ".c" suffix; we'll refer to the toplevel instead
- set topname [string trimright $name .c]
-# puts stderr [concat ctrl-key $key $topname]
-
- if {$key == "1"} {menu_object $topname 1}
- if {$key == "2"} {menu_message $topname 1}
- if {$key == "3"} {menu_floatatom $topname 1}
- if {$key == "4"} {menu_symbolatom $topname 1}
- if {$key == "5"} {menu_comment $topname 1}
- if {$key == "slash"} {menu_audio 1}
- if {$key == "period"} {menu_audio 0}
- if {$key == "Return"} {menu_reselect $topname}
- if {$shift == 1} {
- if {$key == "q" || $key == "Q"} {menu_really_quit}
- if {$key == "w" || $key == "W"} {menu_really_close $topname}
- if {$key == "s" || $key == "S"} {menu_saveas $topname}
- if {$key == "z" || $key == "Z"} {menu_redo $topname}
- if {$key == "b" || $key == "B"} {menu_bng $topname 1}
- if {$key == "t" || $key == "T"} {menu_toggle $topname 1}
- if {$key == "n" || $key == "N"} {menu_numbox $topname 1}
- if {$key == "v" || $key == "V"} {menu_vslider $topname 1}
- if {$key == "h" || $key == "H"} {menu_hslider $topname 1}
- if {$key == "i" || $key == "I"} {menu_hradio $topname 1}
- if {$key == "d" || $key == "D"} {menu_vradio $topname 1}
- if {$key == "u" || $key == "U"} {menu_vumeter $topname 1}
- if {$key == "c" || $key == "C"} {menu_mycnv $topname 1}
- } else {
- if {$key == "e" || $key == "E"} {menu_editmode $topname}
- if {$key == "q" || $key == "Q"} {menu_quit}
- if {$key == "s" || $key == "S"} {menu_save $topname}
- if {$key == "z" || $key == "Z"} {menu_undo $topname}
- if {$key == "n" || $key == "N"} {menu_new}
- if {$key == "o" || $key == "O"} {menu_open $topname}
- if {$key == "m" || $key == "M"} {menu_send}
- if {$key == "w" || $key == "W"} {menu_close $topname}
- if {$key == "p" || $key == "P"} {menu_print $topname}
- if {$key == "x" || $key == "X"} {menu_cut $topname}
- if {$key == "c" || $key == "C"} {menu_copy $topname}
- if {$key == "v" || $key == "V"} {menu_paste $topname}
- if {$key == "d" || $key == "D"} {menu_duplicate $topname}
- if {$key == "a" || $key == "A"} {menu_selectall $topname}
- if {$key == "t" || $key == "T"} {menu_texteditor $topname}
- if {$key == "f" || $key == "F"} {menu_findobject $topname}
- if {$key == "g" || $key == "G"} {menu_findagain $topname}
- }
-}
-
-proc pdtk_canvas_scroll {canvas xy distance} {
- $canvas [list $xy]view scroll $distance units
-}
-
-proc pdtk_canvas_motion {name x y mods} {
-# puts stderr [concat [canvastosym $name] $name $x $y]
- pd [canvastosym $name] motion [$name canvasx $x] [$name canvasy $y] $mods \;
-}
-
-# "map" event tells us when the canvas becomes visible (arg is "0") or
-# invisible (arg is ""). Invisibility means the Window Manager has minimized
-# us. We don't get a final "unmap" event when we destroy the window.
-proc pdtk_canvas_map {name} {
-# puts stderr [concat map $name]
- pd [canvastosym $name] map 1 \;
-}
-
-proc pdtk_canvas_unmap {name} {
-# puts stderr [concat unmap $name]
- pd [canvastosym $name] map 0 \;
-}
-
-proc pdtk_canvas_makeobjs {name files x y} {
- set c 0
- for {set n 0} {$n < [llength $files]} {incr n} {
- if {[regexp {.*/(.+).pd$} [lindex $files $n] file obj] == 1} {
- pd $name obj $x [expr $y + ($c * 30)] [pdtk_enquote $obj] \;
- incr c
- }
- }
-}
-
-set saveas_dir nowhere
-
-############ pdtk_canvas_saveas -- run a saveas dialog ##############
-
-proc pdtk_canvas_saveas {name initfile initdir} {
- global pd_nt
- set filename [tk_getSaveFile -initialfile $initfile \
- -initialdir $initdir -defaultextension .pd -parent $name.c \
- -filetypes { {{pd files} {.pd}} {{max files} {.pat}} }]
-
- if {$filename != ""} {
-# yes, we need the extent even if we're on a mac.
- if {$pd_nt == 2} {
- if {[string last .pd $filename] < 0 && \
- [string last .PD $filename] < 0 && \
- [string last .pat $filename] < 0 && \
- [string last .PAT $filename] < 0} {
- set filename $filename.pd
- if {[file exists $filename]} {
- set answer [tk_messageBox \
- \-message [concat overwrite $filename "?"] \
- \-type yesno \-icon question]
- if {! [string compare $answer no]} {return}
- }
- }
- }
-
- set directory [string range $filename 0 \
- [expr [string last / $filename ] - 1]]
- set basename [string range $filename \
- [expr [string last / $filename ] + 1] end]
- pd [concat $name savetofile [pdtk_enquote $basename] \
- [pdtk_enquote $directory] \;]
-# pd [concat $name savetofile $basename $directory \;]
- }
-}
-
-############ pdtk_canvas_dofont -- run a font and resize dialog #########
-
-set fontsize 0
-set stretchval 0
-set whichstretch 0
-
-proc dofont_apply {name} {
- global fontsize
- global stretchval
- global whichstretch
- set cmd [concat $name font $fontsize $stretchval $whichstretch \;]
-# puts stderr $cmd
- pd $cmd
-}
-
-proc dofont_cancel {name} {
- set cmd [concat $name cancel \;]
-# puts stderr $cmd
- pd $cmd
-}
-
-proc pdtk_canvas_dofont {name initsize} {
-
- global fontsize
- set fontsize $initsize
-
- global stretchval
- set stretchval 100
-
- global whichstretch
- set whichstretch 1
-
- toplevel $name
- wm title $name {FONT BOMB}
- wm protocol $name WM_DELETE_WINDOW [concat dofont_cancel $name]
-
- frame $name.buttonframe
- pack $name.buttonframe -side bottom -fill x -pady 2m
- button $name.buttonframe.cancel -text {Cancel}\
- -command "dofont_cancel $name"
- button $name.buttonframe.ok -text {Do it}\
- -command "dofont_apply $name"
- pack $name.buttonframe.cancel -side left -expand 1
- pack $name.buttonframe.ok -side left -expand 1
-
- frame $name.radiof
- pack $name.radiof -side left
-
- label $name.radiof.label -text {Font Size:}
- pack $name.radiof.label -side top
-
- radiobutton $name.radiof.radio8 -value 8 -variable fontsize -text "8"
- radiobutton $name.radiof.radio10 -value 10 -variable fontsize -text "10"
- radiobutton $name.radiof.radio12 -value 12 -variable fontsize -text "12"
- radiobutton $name.radiof.radio16 -value 16 -variable fontsize -text "16"
- radiobutton $name.radiof.radio24 -value 24 -variable fontsize -text "24"
- radiobutton $name.radiof.radio36 -value 36 -variable fontsize -text "36"
- pack $name.radiof.radio8 -side top -anchor w
- pack $name.radiof.radio10 -side top -anchor w
- pack $name.radiof.radio12 -side top -anchor w
- pack $name.radiof.radio16 -side top -anchor w
- pack $name.radiof.radio24 -side top -anchor w
- pack $name.radiof.radio36 -side top -anchor w
-
- frame $name.stretchf
- pack $name.stretchf -side left
-
- label $name.stretchf.label -text {Stretch:}
- pack $name.stretchf.label -side top
-
- entry $name.stretchf.entry -textvariable stretchval -width 5
- pack $name.stretchf.entry -side left
-
- radiobutton $name.stretchf.radio1 \
- -value 1 -variable whichstretch -text "X and Y"
- radiobutton $name.stretchf.radio2 \
- -value 2 -variable whichstretch -text "X only"
- radiobutton $name.stretchf.radio3 \
- -value 3 -variable whichstretch -text "Y only"
-
- pack $name.stretchf.radio1 -side top -anchor w
- pack $name.stretchf.radio2 -side top -anchor w
- pack $name.stretchf.radio3 -side top -anchor w
-
-}
-
-############ pdtk_gatom_dialog -- run a gatom dialog #########
-
-# dialogs like this one can come up in many copies; but in TK the easiest
-# way to get data from an "entry", etc., is to set an associated variable
-# name. This is especially true for grouped "radio buttons". So we have
-# to synthesize variable names for each instance of the dialog. The dialog
-# gets a TK pathname $id, from which it strips the leading "." to make a
-# variable suffix $vid. Then you can get the actual value out by asking for
-# [eval concat $$variablename]. There should be an easier way but I don't see
-# it yet.
-
-proc gatom_escape {sym} {
- if {[string length $sym] == 0} {
- set ret "-"
-# puts stderr [concat escape1 $sym $ret]
- } else {
- if {[string equal -length 1 $sym "-"]} {
- set ret [string replace $sym 0 0 "--"]
-# puts stderr [concat escape $sym $ret]
- } else {
- set ret [string map {"$" "#"} $sym]
-# puts stderr [concat unescape $sym $ret]
- }
- }
- pdtk_unspace $ret
-}
-
-proc gatom_unescape {sym} {
- if {[string equal -length 1 $sym "-"]} {
- set ret [string replace $sym 0 0 ""]
-# puts stderr [concat unescape $sym $ret]
- } else {
- set ret [string map {"#" "$"} $sym]
-# puts stderr [concat unescape $sym $ret]
- }
- concat $ret
-}
-
-proc dogatom_apply {id} {
- set vid [string trimleft $id .]
-
- set var_gatomwidth [concat gatomwidth_$vid]
- global $var_gatomwidth
- set var_gatomlo [concat gatomlo_$vid]
- global $var_gatomlo
- set var_gatomhi [concat gatomhi_$vid]
- global $var_gatomhi
- set var_gatomwherelabel [concat gatomwherelabel_$vid]
- global $var_gatomwherelabel
- set var_gatomlabel [concat gatomlabel_$vid]
- global $var_gatomlabel
- set var_gatomsymfrom [concat gatomsymfrom_$vid]
- global $var_gatomsymfrom
- set var_gatomsymto [concat gatomsymto_$vid]
- global $var_gatomsymto
-
-# set cmd [concat $id param $gatomwidth $gatomlo $gatomhi \;]
-
- set cmd [concat $id param \
- [eval concat $$var_gatomwidth] \
- [eval concat $$var_gatomlo] \
- [eval concat $$var_gatomhi] \
- [eval gatom_escape $$var_gatomlabel] \
- [eval concat $$var_gatomwherelabel] \
- [eval gatom_escape $$var_gatomsymfrom] \
- [eval gatom_escape $$var_gatomsymto] \
- \;]
-
-# puts stderr $cmd
- pd $cmd
-}
-
-proc dogatom_cancel {name} {
- set cmd [concat $name cancel \;]
-# puts stderr $cmd
- pd $cmd
-}
-
-proc dogatom_ok {name} {
- dogatom_apply $name
- dogatom_cancel $name
-}
-
-proc pdtk_gatom_dialog {id initwidth initlo inithi \
- wherelabel label symfrom symto} {
-
- set vid [string trimleft $id .]
-
- global pd_nt
-
- set var_gatomwidth [concat gatomwidth_$vid]
- global $var_gatomwidth
- set var_gatomlo [concat gatomlo_$vid]
- global $var_gatomlo
- set var_gatomhi [concat gatomhi_$vid]
- global $var_gatomhi
- set var_gatomwherelabel [concat gatomwherelabel_$vid]
- global $var_gatomwherelabel
- set var_gatomlabel [concat gatomlabel_$vid]
- global $var_gatomlabel
- set var_gatomsymfrom [concat gatomsymfrom_$vid]
- global $var_gatomsymfrom
- set var_gatomsymto [concat gatomsymto_$vid]
- global $var_gatomsymto
-
- set $var_gatomwidth $initwidth
- set $var_gatomlo $initlo
- set $var_gatomhi $inithi
- set $var_gatomwherelabel $wherelabel
- set $var_gatomlabel [gatom_unescape $label]
- set $var_gatomsymfrom [gatom_unescape $symfrom]
- set $var_gatomsymto [gatom_unescape $symto]
-
- toplevel $id
- wm title $id "atom box properties"
- wm resizable $id 0 0
- wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id]
-
- frame $id.params -height 7
- pack $id.params -side top
- label $id.params.entryname -text "width"
- entry $id.params.entry -textvariable $var_gatomwidth -width 4
- pack $id.params.entryname $id.params.entry -side left
-
- labelframe $id.limits -text "limits" -padx 15 -pady 4 -borderwidth 1 \
- -font highlight_font
- pack $id.limits -side top -fill x
- frame $id.limits.lower
- pack $id.limits.lower -side left
- label $id.limits.lower.entryname -text "lower"
- entry $id.limits.lower.entry -textvariable $var_gatomlo -width 8
- pack $id.limits.lower.entryname $id.limits.lower.entry -side left
- frame $id.limits.upper
- pack $id.limits.upper -side left
- frame $id.limits.upper.spacer -width 20
- label $id.limits.upper.entryname -text "upper"
- entry $id.limits.upper.entry -textvariable $var_gatomhi -width 8
- pack $id.limits.upper.spacer $id.limits.upper.entryname \
- $id.limits.upper.entry -side left
-
- frame $id.spacer1 -height 7
- pack $id.spacer1 -side top
-
- labelframe $id.label -text "label" -padx 5 -pady 4 -borderwidth 1 \
- -font highlight_font
- pack $id.label -side top -fill x
- frame $id.label.name
- pack $id.label.name -side top
- entry $id.label.name.entry -textvariable $var_gatomlabel -width 33
- pack $id.label.name.entry -side left
- frame $id.label.radio
- pack $id.label.radio -side top
- radiobutton $id.label.radio.left -value 0 \
- -variable $var_gatomwherelabel \
- -text "left " -justify left
- radiobutton $id.label.radio.right -value 1 \
- -variable $var_gatomwherelabel \
- -text "right" -justify left
- radiobutton $id.label.radio.top -value 2 \
- -variable $var_gatomwherelabel \
- -text "top" -justify left
- radiobutton $id.label.radio.bottom -value 3 \
- -variable $var_gatomwherelabel \
- -text "bottom" -justify left
- pack $id.label.radio.left -side left -anchor w
- pack $id.label.radio.right -side right -anchor w
- pack $id.label.radio.top -side top -anchor w
- pack $id.label.radio.bottom -side bottom -anchor w
-
- frame $id.spacer2 -height 7
- pack $id.spacer2 -side top
-
- labelframe $id.s_r -text "messages" -padx 5 -pady 4 -borderwidth 1 \
- -font highlight_font
- pack $id.s_r -side top -fill x
- frame $id.s_r.paramsymto
- pack $id.s_r.paramsymto -side top -anchor e
- label $id.s_r.paramsymto.entryname -text "send symbol"
- entry $id.s_r.paramsymto.entry -textvariable $var_gatomsymto -width 21
- pack $id.s_r.paramsymto.entry $id.s_r.paramsymto.entryname -side right
-
- frame $id.s_r.paramsymfrom
- pack $id.s_r.paramsymfrom -side top -anchor e
- label $id.s_r.paramsymfrom.entryname -text "receive symbol"
- entry $id.s_r.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 21
- pack $id.s_r.paramsymfrom.entry $id.s_r.paramsymfrom.entryname -side right
-
- frame $id.buttonframe -pady 5
- pack $id.buttonframe -side top -fill x -pady 2m
- button $id.buttonframe.cancel -text {Cancel}\
- -command "dogatom_cancel $id"
- pack $id.buttonframe.cancel -side left -expand 1
- button $id.buttonframe.apply -text {Apply}\
- -command "dogatom_apply $id"
- pack $id.buttonframe.apply -side left -expand 1
- button $id.buttonframe.ok -text {OK}\
- -command "dogatom_ok $id"
- pack $id.buttonframe.ok -side left -expand 1
-
- bind $id.limits.upper.entry <KeyPress-Return> [concat dogatom_ok $id]
- bind $id.limits.lower.entry <KeyPress-Return> [concat dogatom_ok $id]
- bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id]
- pdtk_standardkeybindings $id.limits.upper.entry
- pdtk_standardkeybindings $id.limits.lower.entry
- pdtk_standardkeybindings $id.params.entry
- $id.params.entry select from 0
- $id.params.entry select adjust end
- focus $id.params.entry
-}
-
-############ pdtk_canvas_popup -- popup menu for canvas #########
-
-set popup_xpix 0
-set popup_ypix 0
-
-proc popup_action {name action} {
- global popup_xpix popup_ypix
- set cmd [concat $name done-popup $action $popup_xpix $popup_ypix \;]
-# puts stderr $cmd
- pd $cmd
-}
-
-proc pdtk_canvas_popup {name xpix ypix canprop canopen} {
- global popup_xpix popup_ypix
- set popup_xpix $xpix
- set popup_ypix $ypix
- if {$canprop == 0} {$name.popup entryconfigure 0 -state disabled}
- if {$canprop == 1} {$name.popup entryconfigure 0 -state active}
- if {$canopen == 0} {$name.popup entryconfigure 1 -state disabled}
- if {$canopen == 1} {$name.popup entryconfigure 1 -state active}
- tk_popup $name.popup [expr $xpix + [winfo rootx $name.c]] \
- [expr $ypix + [winfo rooty $name.c]] 0
-}
-
-
-# begin of change "iemlib"
-############ pdtk_iemgui_dialog -- dialog window for iem guis #########
-
-set iemgui_define_min_flashhold 50
-set iemgui_define_min_flashbreak 10
-set iemgui_define_min_fontsize 4
-
-proc iemgui_clip_dim {id} {
- set vid [string trimleft $id .]
-
- 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]
- $id.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]
- $id.dim.h_ent configure -textvariable $var_iemgui_hgt
- }
-}
-
-proc iemgui_clip_num {id} {
- set vid [string trimleft $id .]
-
- set var_iemgui_num [concat iemgui_num_$vid]
- global $var_iemgui_num
-
- if {[eval concat $$var_iemgui_num] > 2000} {
- set $var_iemgui_num 2000
- $id.para.num_ent configure -textvariable $var_iemgui_num
- }
- if {[eval concat $$var_iemgui_num] < 1} {
- set $var_iemgui_num 1
- $id.para.num_ent configure -textvariable $var_iemgui_num
- }
-}
-
-proc iemgui_sched_rng {id} {
- set vid [string trimleft $id .]
-
- 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
-
- global iemgui_define_min_flashhold
- global iemgui_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
- $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
- $id.rng.min_ent configure -textvariable $var_iemgui_min_rng }
- if {[eval concat $$var_iemgui_max_rng] < $iemgui_define_min_flashhold} {
- set $var_iemgui_max_rng $iemgui_define_min_flashhold
- $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
- }
- if {[eval concat $$var_iemgui_min_rng] < $iemgui_define_min_flashbreak} {
- set $var_iemgui_min_rng $iemgui_define_min_flashbreak
- $id.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
- $id.rng.min_ent configure -textvariable $var_iemgui_min_rng
- }
- }
-}
-
-proc iemgui_verify_rng {id} {
- set vid [string trimleft $id .]
-
- 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
- $id.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]
- $id.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]
- $id.rng.max_ent configure -textvariable $var_iemgui_max_rng
- }
- }
- }
-}
-
-proc iemgui_clip_fontsize {id} {
- set vid [string trimleft $id .]
-
- set var_iemgui_gn_fs [concat iemgui_gn_fs_$vid]
- global $var_iemgui_gn_fs
-
- global iemgui_define_min_fontsize
-
- if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} {
- set $var_iemgui_gn_fs $iemgui_define_min_fontsize
- $id.label.fs_ent configure -textvariable $var_iemgui_gn_fs
- }
-}
-
-proc iemgui_set_col_example {id} {
- set vid [string trimleft $id .]
-
- 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
-
- $id.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 } {
- $id.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 {
- $id.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 iemgui_preset_col {id presetcol} {
- set vid [string trimleft $id .]
-
- 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 }
- iemgui_set_col_example $id
-}
-
-proc iemgui_choose_col_bkfrlb {id} {
- set vid [string trimleft $id .]
-
- 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 "Front-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] }
- }
- iemgui_set_col_example $id
-}
-
-proc iemgui_lilo {id} {
- set vid [string trimleft $id .]
-
- 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
-
- iemgui_sched_rng $id
-
- if {[eval concat $$var_iemgui_lin0_log1] == 0} {
- set $var_iemgui_lin0_log1 1
- $id.para.lilo configure -text [eval concat $$var_iemgui_lilo1]
- iemgui_verify_rng $id
- iemgui_sched_rng $id
- } else {
- set $var_iemgui_lin0_log1 0
- $id.para.lilo configure -text [eval concat $$var_iemgui_lilo0]
- }
-}
-
-proc iemgui_toggle_font {id gn_f} {
- set vid [string trimleft $id .]
-
- set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
- global $var_iemgui_gn_f
- global fontname fontweight
-
- set $var_iemgui_gn_f $gn_f
-
- switch -- $gn_f {
- 0 { set current_font $fontname}
- 1 { set current_font "Helvetica" }
- 2 { set current_font "Times" }
- }
- set current_font_spec "{$current_font} 12 $fontweight"
-
- $id.label.fontpopup_label configure -text $current_font \
- -font $current_font_spec
- $id.label.name_entry configure -font $current_font_spec
- $id.colors.sections.fr_bk configure -font $current_font_spec
- $id.colors.sections.lb_bk configure -font $current_font_spec
-}
-
-proc iemgui_lb {id} {
- set vid [string trimleft $id .]
-
- set var_iemgui_loadbang [concat iemgui_loadbang_$vid]
- global $var_iemgui_loadbang
-
- if {[eval concat $$var_iemgui_loadbang] == 0} {
- set $var_iemgui_loadbang 1
- $id.para.lb configure -text "init"
- } else {
- set $var_iemgui_loadbang 0
- $id.para.lb configure -text "no init"
- }
-}
-
-proc iemgui_stdy_jmp {id} {
- set vid [string trimleft $id .]
-
- set var_iemgui_steady [concat iemgui_steady_$vid]
- global $var_iemgui_steady
-
- if {[eval concat $$var_iemgui_steady]} {
- set $var_iemgui_steady 0
- $id.para.stdy_jmp configure -text "jump on click"
- } else {
- set $var_iemgui_steady 1
- $id.para.stdy_jmp configure -text "steady on click"
- }
-}
-
-proc iemgui_apply {id} {
- set vid [string trimleft $id .]
-
- 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
-
- iemgui_clip_dim $id
- iemgui_clip_num $id
- iemgui_sched_rng $id
- iemgui_verify_rng $id
- iemgui_sched_rng $id
- iemgui_clip_fontsize $id
-
- 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 [pdtk_unspace $hhhsnd]
- set hhhrcv [pdtk_unspace $hhhrcv]
- set hhhgui_nam [pdtk_unspace $hhhgui_nam]
-
- pd [concat $id 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 {id} {pd [concat $id cancel \;]}
-
-proc iemgui_ok {id} {
- iemgui_apply $id
- iemgui_cancel $id
-}
-
-proc pdtk_iemgui_dialog {id 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 $id .]
-
- global pd_nt
- global fontname fontweight
-
- 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 $id
- wm title $id [format "%s Properties" $mainheader]
- wm resizable $id 0 0
- wm protocol $id WM_DELETE_WINDOW [concat iemgui_cancel $id]
-
- frame $id.dim
- pack $id.dim -side top
- label $id.dim.head -text $dim_header
- label $id.dim.w_lab -text $wdt_label -width 6
- entry $id.dim.w_ent -textvariable $var_iemgui_wdt -width 5
- label $id.dim.dummy1 -text " " -width 10
- label $id.dim.h_lab -text $hgt_label -width 6
- entry $id.dim.h_ent -textvariable $var_iemgui_hgt -width 5
- pack $id.dim.head -side top
- pack $id.dim.w_lab $id.dim.w_ent $id.dim.dummy1 -side left
- if { $hgt_label != "empty" } {
- pack $id.dim.h_lab $id.dim.h_ent -side left}
-
- frame $id.rng
- pack $id.rng -side top
- label $id.rng.head -text $rng_header
- label $id.rng.min_lab -text $min_rng_label -width 6
- entry $id.rng.min_ent -textvariable $var_iemgui_min_rng -width 9
- label $id.rng.dummy1 -text " " -width 1
- label $id.rng.max_lab -text $max_rng_label -width 8
- entry $id.rng.max_ent -textvariable $var_iemgui_max_rng -width 9
- if { $rng_header != "empty" } {
- pack $id.rng.head -side top
- if { $min_rng_label != "empty" } {
- pack $id.rng.min_lab $id.rng.min_ent -side left}
- if { $max_rng_label != "empty" } {
- pack $id.rng.dummy1 \
- $id.rng.max_lab $id.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 $id.space1 -text ""
- pack $id.space1 -side top }
-
- frame $id.para
- pack $id.para -side top
- label $id.para.dummy2 -text "" -width 1
- label $id.para.dummy3 -text "" -width 1
- if {[eval concat $$var_iemgui_lin0_log1] == 0} {
- button $id.para.lilo -text [eval concat $$var_iemgui_lilo0] -width 5 -command "iemgui_lilo $id" }
- if {[eval concat $$var_iemgui_lin0_log1] == 1} {
- button $id.para.lilo -text [eval concat $$var_iemgui_lilo1] -width 5 -command "iemgui_lilo $id" }
- if {[eval concat $$var_iemgui_loadbang] == 0} {
- button $id.para.lb -text "no init" -width 5 -command "iemgui_lb $id" }
- if {[eval concat $$var_iemgui_loadbang] == 1} {
- button $id.para.lb -text "init" -width 5 -command "iemgui_lb $id" }
- label $id.para.num_lab -text $num_label -width 9
- entry $id.para.num_ent -textvariable $var_iemgui_num -width 4
- if {[eval concat $$var_iemgui_steady] == 0} {
- button $id.para.stdy_jmp -text "jump on click" -width 11 -command "iemgui_stdy_jmp $id" }
- if {[eval concat $$var_iemgui_steady] == 1} {
- button $id.para.stdy_jmp -text "steady on click" -width 11 -command "iemgui_stdy_jmp $id" }
- if {[eval concat $$var_iemgui_lin0_log1] >= 0} {
- pack $id.para.lilo -side left -expand 1}
- if {[eval concat $$var_iemgui_loadbang] >= 0} {
- pack $id.para.dummy2 $id.para.lb -side left -expand 1}
- if {[eval concat $$var_iemgui_num] > 0} {
- pack $id.para.dummy3 $id.para.num_lab $id.para.num_ent -side left -expand 1}
- if {[eval concat $$var_iemgui_steady] >= 0} {
- pack $id.para.dummy3 $id.para.stdy_jmp -side left -expand 1}
-
- frame $id.spacer0 -height 4
- pack $id.spacer0 -side top
-
- labelframe $id.s_r -borderwidth 1 -pady 4 -text "messages" \
- -font highlight_font
- pack $id.s_r -side top -fill x -ipadx 5
- frame $id.s_r.send
- pack $id.s_r.send -side top
- label $id.s_r.send.lab -text " send-symbol:" -width 12 -justify right
- entry $id.s_r.send.ent -textvariable $var_iemgui_snd -width 22
- if { $snd != "nosndno" } {
- pack $id.s_r.send.lab $id.s_r.send.ent -side left}
-
- frame $id.s_r.receive
- pack $id.s_r.receive -side top
- label $id.s_r.receive.lab -text "receive-symbol:" -width 12 -justify right
- entry $id.s_r.receive.ent -textvariable $var_iemgui_rcv -width 22
- if { $rcv != "norcvno" } {
- pack $id.s_r.receive.lab $id.s_r.receive.ent -side left}
-
-# get the current font name from the int given from C-space (gn_f)
- set current_font $fontname
- 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 $id.spacer1 -height 7
- pack $id.spacer1 -side top
-
- labelframe $id.label -borderwidth 1 -text "label" -pady 4 \
- -font highlight_font
- pack $id.label -side top -fill x
- entry $id.label.name_entry -textvariable $var_iemgui_gui_nam -width 30 \
- -font [list $current_font 12 $fontweight]
- pack $id.label.name_entry -side top -expand yes -fill both -padx 5
-
- frame $id.label.xy -padx 27 -pady 1
- pack $id.label.xy -side top
- label $id.label.xy.x_lab -text "x offset" -width 6
- entry $id.label.xy.x_entry -textvariable $var_iemgui_gn_dx -width 5
- label $id.label.xy.dummy1 -text " " -width 2
- label $id.label.xy.y_lab -text "y offset" -width 6
- entry $id.label.xy.y_entry -textvariable $var_iemgui_gn_dy -width 5
- pack $id.label.xy.x_lab $id.label.xy.x_entry $id.label.xy.dummy1 \
- $id.label.xy.y_lab $id.label.xy.y_entry -side left -anchor e
-
- label $id.label.fontpopup_label -text $current_font \
- -relief groove -font [list $current_font 12 $fontweight] -padx 5
- pack $id.label.fontpopup_label -side left -anchor w -expand yes -fill x
- label $id.label.fontsize_label -text "size" -width 4
- entry $id.label.fontsize_entry -textvariable $var_iemgui_gn_fs -width 5
- pack $id.label.fontsize_entry $id.label.fontsize_label \
- -side right -anchor e -padx 5 -pady 5
- menu $id.popup
- $id.popup add command \
- -label $fontname \
- -font [format {{%s} 12 %s} $fontname $fontweight] \
- -command "iemgui_toggle_font $id 0"
- $id.popup add command \
- -label "Helvetica" \
- -font [format {Helvetica 12 %s} $fontweight] \
- -command "iemgui_toggle_font $id 1"
- $id.popup add command \
- -label "Times" \
- -font [format {Times 12 %s} $fontweight] \
- -command "iemgui_toggle_font $id 2"
- bind $id.label.fontpopup_label <Button> \
- [list tk_popup $id.popup %X %Y]
-
- frame $id.spacer2 -height 7
- pack $id.spacer2 -side top
-
- labelframe $id.colors -borderwidth 1 -text "colors" -font highlight_font
- pack $id.colors -fill x -ipadx 5 -ipady 4
-
- frame $id.colors.select
- pack $id.colors.select -side top
- radiobutton $id.colors.select.radio0 -value 0 -variable \
- $var_iemgui_l2_f1_b0 -text "background" -width 10 -justify left
- radiobutton $id.colors.select.radio1 -value 1 -variable \
- $var_iemgui_l2_f1_b0 -text "front" -width 5 -justify left
- radiobutton $id.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 $id.colors.select.radio0 $id.colors.select.radio1 \
- $id.colors.select.radio2 -side left
- } else {
- pack $id.colors.select.radio0 $id.colors.select.radio2 -side left \
- }
-
- frame $id.colors.sections
- pack $id.colors.sections -side top
- button $id.colors.sections.but -text "compose color" -width 12 \
- -command "iemgui_choose_col_bkfrlb $id"
- pack $id.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
- -expand yes -fill x
- if { [eval concat $$var_iemgui_fcol] >= 0 } {
- label $id.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 $fontweight] -padx 2 -pady 2 -relief ridge
- } else {
- label $id.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 $fontweight] -padx 2 -pady 2 -relief ridge
- }
- label $id.colors.sections.lb_bk -text "testlabel" -width 9 \
- -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 $fontweight] -padx 2 -pady 2 -relief ridge
- pack $id.colors.sections.lb_bk $id.colors.sections.fr_bk \
- -side right -anchor e -expand yes -fill both -pady 7
-
-# color scheme by Mary Ann Benedetto http://piR2.org
- frame $id.colors.r1
- pack $id.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 $id.colors.r1.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] -relief ridge \
- -padx 7 -pady 0
- bind $id.colors.r1.c$i <Button> [format "iemgui_preset_col %s %d" $id $hexcol]
- }
- pack $id.colors.r1.c0 $id.colors.r1.c1 $id.colors.r1.c2 $id.colors.r1.c3 \
- $id.colors.r1.c4 $id.colors.r1.c5 $id.colors.r1.c6 $id.colors.r1.c7 \
- $id.colors.r1.c8 $id.colors.r1.c9 -side left
-
- frame $id.colors.r2
- pack $id.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 $id.colors.r2.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] -relief ridge \
- -padx 7 -pady 0
- bind $id.colors.r2.c$i <Button> \
- [format "iemgui_preset_col %s %d" $id $hexcol]
- }
- pack $id.colors.r2.c0 $id.colors.r2.c1 $id.colors.r2.c2 $id.colors.r2.c3 \
- $id.colors.r2.c4 $id.colors.r2.c5 $id.colors.r2.c6 $id.colors.r2.c7 \
- $id.colors.r2.c8 $id.colors.r2.c9 -side left
-
- frame $id.colors.r3
- pack $id.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 $id.colors.r3.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] -relief ridge \
- -padx 7 -pady 0
- bind $id.colors.r3.c$i <Button> \
- [format "iemgui_preset_col %s %d" $id $hexcol]
- }
- pack $id.colors.r3.c0 $id.colors.r3.c1 $id.colors.r3.c2 $id.colors.r3.c3 \
- $id.colors.r3.c4 $id.colors.r3.c5 $id.colors.r3.c6 $id.colors.r3.c7 \
- $id.colors.r3.c8 $id.colors.r3.c9 -side left
-
- frame $id.cao -pady 10
- pack $id.cao -side top
- button $id.cao.cancel -text {Cancel} -width 6 \
- -command "iemgui_cancel $id"
- label $id.cao.dummy1 -text "" -width 3
- button $id.cao.apply -text {Apply} -width 6 -command "iemgui_apply $id"
- label $id.cao.dummy2 -text "" -width 3
- button $id.cao.ok -text {OK} -width 6 \
- -command "iemgui_ok $id"
-
- pack $id.cao.cancel $id.cao.dummy1 -side left
- pack $id.cao.apply $id.cao.dummy2 -side left
- pack $id.cao.ok -side left
-
- if {[info tclversion] < 8.4} {
- bind $id <Key-Tab> {tkTabToWindow [tk_focusNext %W]}
- bind $id <<PrevWindow>> {tkTabToWindow [tk_focusPrev %W]}
- } else {
- bind $id <Key-Tab> {tk::TabToWindow [tk_focusNext %W]}
- bind $id <<PrevWindow>> {tk::TabToWindow [tk_focusPrev %W]}
- }
-
- bind $id.dim.w_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.dim.h_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.rng.min_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.rng.max_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.para.num_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.s_r.send.ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.s_r.receive.ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.label.name_entry <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.label.xy.x_entry <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.label.xy.y_entry <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.label.fontsize_entry <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.cao.ok <KeyPress-Return> [concat iemgui_ok $id]
- pdtk_standardkeybindings $id.dim.w_ent
- pdtk_standardkeybindings $id.dim.h_ent
- pdtk_standardkeybindings $id.rng.min_ent
- pdtk_standardkeybindings $id.rng.max_ent
- pdtk_standardkeybindings $id.para.num_ent
- pdtk_standardkeybindings $id.s_r.send.ent
- pdtk_standardkeybindings $id.s_r.receive.ent
- pdtk_standardkeybindings $id.label.name_entry
- pdtk_standardkeybindings $id.label.xy.x_entry
- pdtk_standardkeybindings $id.label.xy.y_entry
- pdtk_standardkeybindings $id.label.fontsize_entry
- pdtk_standardkeybindings $id.cao.ok
-
- $id.dim.w_ent select from 0
- $id.dim.w_ent select adjust end
- focus $id.dim.w_ent
-}
-# end of change "iemlib"
-
-############ 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]
-
- pd [concat $id arraydialog $mofo \
- [eval concat $$var_array_n] \
- [expr $saveit + 2 * $drawasrects] \
- [eval concat $$var_array_otherflag] \
- \;]
-}
-
-# jsarlo
-proc array_viewlist {id} {
- pd [concat $id arrayviewlistnew\;]
-}
-# end jsarlo
-
-proc array_cancel {id} {
- set cmd [concat $id cancel \;]
- pd $cmd
-}
-
-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]
-
- 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"
- 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
-
- bind $id.name.entry <KeyPress-Return> [concat array_ok $id]
- bind $id.n.entry <KeyPress-Return> [concat array_ok $id]
- pdtk_standardkeybindings $id.name.entry
- pdtk_standardkeybindings $id.n.entry
- $id.name.entry select from 0
- $id.name.entry select adjust end
- focus $id.name.entry
-}
-
-############ pdtk_canvas_dialog -- dialog window for canvass #########
-# see comments above (pdtk_gatom_dialog) about variable name handling
-
-proc canvas_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_canvas_xscale [concat canvas_xscale_$vid]
- global $var_canvas_xscale
- set var_canvas_yscale [concat canvas_yscale_$vid]
- global $var_canvas_yscale
- set var_canvas_graphme [concat canvas_graphme_$vid]
- global $var_canvas_graphme
- set var_canvas_hidetext [concat canvas_hidetext_$vid]
- global $var_canvas_hidetext
- set var_canvas_x1 [concat canvas_x1_$vid]
- global $var_canvas_x1
- set var_canvas_x2 [concat canvas_x2_$vid]
- global $var_canvas_x2
- set var_canvas_xpix [concat canvas_xpix_$vid]
- global $var_canvas_xpix
- set var_canvas_xmargin [concat canvas_xmargin_$vid]
- global $var_canvas_xmargin
- set var_canvas_y1 [concat canvas_y1_$vid]
- global $var_canvas_y1
- set var_canvas_y2 [concat canvas_y2_$vid]
- global $var_canvas_y2
- set var_canvas_ypix [concat canvas_ypix_$vid]
- global $var_canvas_ypix
- set var_canvas_ymargin [concat canvas_ymargin_$vid]
- global $var_canvas_ymargin
-
- pd [concat $id donecanvasdialog \
- [eval concat $$var_canvas_xscale] \
- [eval concat $$var_canvas_yscale] \
- [expr [eval concat $$var_canvas_graphme]+2*[eval concat $$var_canvas_hidetext]] \
- [eval concat $$var_canvas_x1] \
- [eval concat $$var_canvas_y1] \
- [eval concat $$var_canvas_x2] \
- [eval concat $$var_canvas_y2] \
- [eval concat $$var_canvas_xpix] \
- [eval concat $$var_canvas_ypix] \
- [eval concat $$var_canvas_xmargin] \
- [eval concat $$var_canvas_ymargin] \
- \;]
-}
-
-proc canvas_cancel {id} {
- set cmd [concat $id cancel \;]
- pd $cmd
-}
-
-proc canvas_ok {id} {
- canvas_apply $id
- canvas_cancel $id
-}
-
-proc canvas_checkcommand {id} {
- set vid [string trimleft $id .]
-# puts stderr [concat canvas_checkcommand $id $vid]
-
- set var_canvas_xscale [concat canvas_xscale_$vid]
- global $var_canvas_xscale
- set var_canvas_yscale [concat canvas_yscale_$vid]
- global $var_canvas_yscale
- set var_canvas_graphme [concat canvas_graphme_$vid]
- global $var_canvas_graphme
- set var_canvas_hidetext [concat canvas_hidetext_$vid]
- global $var_canvas_hidetext
- set var_canvas_x1 [concat canvas_x1_$vid]
- global $var_canvas_x1
- set var_canvas_x2 [concat canvas_x2_$vid]
- global $var_canvas_x2
- set var_canvas_xpix [concat canvas_xpix_$vid]
- global $var_canvas_xpix
- set var_canvas_xmargin [concat canvas_xmargin_$vid]
- global $var_canvas_xmargin
- set var_canvas_y1 [concat canvas_y1_$vid]
- global $var_canvas_y1
- set var_canvas_y2 [concat canvas_y2_$vid]
- global $var_canvas_y2
- set var_canvas_ypix [concat canvas_ypix_$vid]
- global $var_canvas_ypix
- set var_canvas_ymargin [concat canvas_ymargin_$vid]
- global $var_canvas_ymargin
-
- if { [eval concat $$var_canvas_graphme] != 0 } {
- $id.hidetext configure -state normal
- $id.xrange.entry1 configure -state normal
- $id.xrange.entry2 configure -state normal
- $id.xrange.entry3 configure -state normal
- $id.xrange.entry4 configure -state normal
- $id.yrange.entry1 configure -state normal
- $id.yrange.entry2 configure -state normal
- $id.yrange.entry3 configure -state normal
- $id.yrange.entry4 configure -state normal
- $id.xscale.entry configure -state disabled
- $id.yscale.entry configure -state disabled
- set x1 [eval concat $$var_canvas_x1]
- set y1 [eval concat $$var_canvas_y1]
- set x2 [eval concat $$var_canvas_x2]
- set y2 [eval concat $$var_canvas_y2]
- if { [eval concat $$var_canvas_x1] == 0 && \
- [eval concat $$var_canvas_y1] == 0 && \
- [eval concat $$var_canvas_x2] == 0 && \
- [eval concat $$var_canvas_y2] == 0 } {
- set $var_canvas_x2 1
- set $var_canvas_y2 1
- }
- if { [eval concat $$var_canvas_xpix] == 0 } {
- set $var_canvas_xpix 85
- set $var_canvas_xmargin 100
- }
- if { [eval concat $$var_canvas_ypix] == 0 } {
- set $var_canvas_ypix 60
- set $var_canvas_ymargin 100
- }
- } else {
- $id.hidetext configure -state disabled
- $id.xrange.entry1 configure -state disabled
- $id.xrange.entry2 configure -state disabled
- $id.xrange.entry3 configure -state disabled
- $id.xrange.entry4 configure -state disabled
- $id.yrange.entry1 configure -state disabled
- $id.yrange.entry2 configure -state disabled
- $id.yrange.entry3 configure -state disabled
- $id.yrange.entry4 configure -state disabled
- $id.xscale.entry configure -state normal
- $id.yscale.entry configure -state normal
- if { [eval concat $$var_canvas_xscale] == 0 } {
- set $var_canvas_xscale 1
- }
- if { [eval concat $$var_canvas_yscale] == 0 } {
- set $var_canvas_yscale -1
- }
- }
-}
-
-proc pdtk_canvas_dialog {id xscale yscale graphme x1 y1 x2 y2 \
- xpix ypix xmargin ymargin} {
- set vid [string trimleft $id .]
-
- set var_canvas_xscale [concat canvas_xscale_$vid]
- global $var_canvas_xscale
- set var_canvas_yscale [concat canvas_yscale_$vid]
- global $var_canvas_yscale
- set var_canvas_graphme [concat canvas_graphme_$vid]
- global $var_canvas_graphme
- set var_canvas_hidetext [concat canvas_hidetext_$vid]
- global $var_canvas_hidetext
- set var_canvas_x1 [concat canvas_x1_$vid]
- global $var_canvas_x1
- set var_canvas_x2 [concat canvas_x2_$vid]
- global $var_canvas_x2
- set var_canvas_xpix [concat canvas_xpix_$vid]
- global $var_canvas_xpix
- set var_canvas_xmargin [concat canvas_xmargin_$vid]
- global $var_canvas_xmargin
- set var_canvas_y1 [concat canvas_y1_$vid]
- global $var_canvas_y1
- set var_canvas_y2 [concat canvas_y2_$vid]
- global $var_canvas_y2
- set var_canvas_ypix [concat canvas_ypix_$vid]
- global $var_canvas_ypix
- set var_canvas_ymargin [concat canvas_ymargin_$vid]
- global $var_canvas_ymargin
-
- set $var_canvas_xscale $xscale
- set $var_canvas_yscale $yscale
- set $var_canvas_graphme [expr ($graphme!=0)?1:0]
- set $var_canvas_hidetext [expr ($graphme&2)?1:0]
- set $var_canvas_x1 $x1
- set $var_canvas_y1 $y1
- set $var_canvas_x2 $x2
- set $var_canvas_y2 $y2
- set $var_canvas_xpix $xpix
- set $var_canvas_ypix $ypix
- set $var_canvas_xmargin $xmargin
- set $var_canvas_ymargin $ymargin
-
- toplevel $id
- wm title $id {canvas}
- wm protocol $id WM_DELETE_WINDOW [concat canvas_cancel $id]
-
- label $id.toplabel -text "Canvas Properties"
- pack $id.toplabel -side top
-
- frame $id.xscale
- pack $id.xscale -side top
- label $id.xscale.label -text "X units per pixel"
- entry $id.xscale.entry -textvariable $var_canvas_xscale -width 10
- pack $id.xscale.label $id.xscale.entry -side left
-
- frame $id.yscale
- pack $id.yscale -side top
- label $id.yscale.label -text "Y units per pixel"
- entry $id.yscale.entry -textvariable $var_canvas_yscale -width 10
- pack $id.yscale.label $id.yscale.entry -side left
-
- checkbutton $id.graphme -text {graph on parent} \
- -variable $var_canvas_graphme -anchor w \
- -command [concat canvas_checkcommand $id]
- pack $id.graphme -side top
-
- checkbutton $id.hidetext -text {hide object name and arguments} \
- -variable $var_canvas_hidetext -anchor w \
- -command [concat canvas_checkcommand $id]
- pack $id.hidetext -side top
-
- frame $id.xrange
- pack $id.xrange -side top
- label $id.xrange.label1 -text "X range: from"
- entry $id.xrange.entry1 -textvariable $var_canvas_x1 -width 6
- label $id.xrange.label2 -text "to"
- entry $id.xrange.entry2 -textvariable $var_canvas_x2 -width 6
- label $id.xrange.label3 -text "size"
- entry $id.xrange.entry3 -textvariable $var_canvas_xpix -width 4
- label $id.xrange.label4 -text "margin"
- entry $id.xrange.entry4 -textvariable $var_canvas_xmargin -width 4
- pack $id.xrange.label1 $id.xrange.entry1 \
- $id.xrange.label2 $id.xrange.entry2 \
- $id.xrange.label3 $id.xrange.entry3 \
- $id.xrange.label4 $id.xrange.entry4 \
- -side left
-
- frame $id.yrange
- pack $id.yrange -side top
- label $id.yrange.label1 -text "Y range: from"
- entry $id.yrange.entry1 -textvariable $var_canvas_y1 -width 6
- label $id.yrange.label2 -text "to"
- entry $id.yrange.entry2 -textvariable $var_canvas_y2 -width 6
- label $id.yrange.label3 -text "size"
- entry $id.yrange.entry3 -textvariable $var_canvas_ypix -width 4
- label $id.yrange.label4 -text "margin"
- entry $id.yrange.entry4 -textvariable $var_canvas_ymargin -width 4
- pack $id.yrange.label1 $id.yrange.entry1 \
- $id.yrange.label2 $id.yrange.entry2 \
- $id.yrange.label3 $id.yrange.entry3 \
- $id.yrange.label4 $id.yrange.entry4 \
- -side left
-
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
- button $id.buttonframe.cancel -text {Cancel}\
- -command "canvas_cancel $id"
- button $id.buttonframe.apply -text {Apply}\
- -command "canvas_apply $id"
- button $id.buttonframe.ok -text {OK}\
- -command "canvas_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
-
- bind $id.xscale.entry <KeyPress-Return> [concat canvas_ok $id]
- bind $id.yscale.entry <KeyPress-Return> [concat canvas_ok $id]
- pdtk_standardkeybindings $id.xscale.entry
- pdtk_standardkeybindings $id.yscale.entry
- $id.xscale.entry select from 0
- $id.xscale.entry select adjust end
- focus $id.xscale.entry
- canvas_checkcommand $id
-}
-
-############ pdtk_data_dialog -- run a data dialog #########
-proc dodata_send {name} {
-# puts stderr [$name.text get 0.0 end]
-
- for {set i 1} {[$name.text compare [concat $i.0 + 3 chars] < end]} \
- {incr i 1} {
-# puts stderr [concat it's [$name.text get $i.0 [expr $i + 1].0]]
- set cmd [concat $name data [$name.text get $i.0 [expr $i + 1].0] \;]
-# puts stderr $cmd
- pd $cmd
- }
- set cmd [concat $name end \;]
-# puts stderr $cmd
- pd $cmd
-}
-
-proc dodata_cancel {name} {
- set cmd [concat $name cancel \;]
-# puts stderr $cmd
- pd $cmd
-}
-
-proc dodata_ok {name} {
- dodata_send $name
- dodata_cancel $name
-}
-
-proc pdtk_data_dialog {name stuff} {
- global pd_deffont
- toplevel $name
- wm title $name {Atom}
- wm protocol $name WM_DELETE_WINDOW [concat dodata_cancel $name]
-
- frame $name.buttonframe
- pack $name.buttonframe -side bottom -fill x -pady 2m
- button $name.buttonframe.send -text {Send (Ctrl s)}\
- -command [concat dodata_send $name]
- button $name.buttonframe.ok -text {OK (Ctrl t)}\
- -command [concat dodata_ok $name]
- pack $name.buttonframe.send -side left -expand 1
- pack $name.buttonframe.ok -side left -expand 1
-
- text $name.text -relief raised -bd 2 -height 40 -width 60 \
- -yscrollcommand "$name.scroll set" -font $pd_deffont
- scrollbar $name.scroll -command "$name.text yview"
- pack $name.scroll -side right -fill y
- pack $name.text -side left -fill both -expand 1
- $name.text insert end $stuff
- focus $name.text
- bind $name.text <Control-t> [concat dodata_ok $name]
- bind $name.text <Control-s> [concat dodata_send $name]
-}
-
-############ check or uncheck the "edit" menu item ##############
-#####################iemlib#######################
-proc pdtk_canvas_editval {name value} {
- if { $value } {
- $name.m.edit entryconfigure "Edit mode" -indicatoron true
- } else {
- $name.m.edit entryconfigure "Edit mode" -indicatoron false
- }
-}
-#####################iemlib#######################
-
-############ pdtk_text_new -- create a new text object #2###########
-proc pdtk_text_new {canvasname myname x y text font color} {
-# if {$font < 13} {set fontname [format -*-courier-bold----%d-* $font]}
-# if {$font >= 13} {set fontname [format -*-courier-----%d-* $font]}
-
- global pd_fontlist
- switch -- $font {
- 8 { set typeface [lindex $pd_fontlist 0] }
- 9 { set typeface [lindex $pd_fontlist 1] }
- 10 { set typeface [lindex $pd_fontlist 2] }
- 12 { set typeface [lindex $pd_fontlist 3] }
- 14 { set typeface [lindex $pd_fontlist 4] }
- 16 { set typeface [lindex $pd_fontlist 5] }
- 18 { set typeface [lindex $pd_fontlist 6] }
- 24 { set typeface [lindex $pd_fontlist 7] }
- 30 { set typeface [lindex $pd_fontlist 8] }
- 36 { set typeface [lindex $pd_fontlist 9] }
- }
-
- $canvasname create text $x $y \
- -font $typeface \
- -tags $myname -text $text -fill $color -anchor nw
-# pd [concat $myname size [$canvasname bbox $myname] \;]
-}
-
-################ pdtk_text_set -- change the text ##################
-proc pdtk_text_set {canvasname myname text} {
- $canvasname itemconfig $myname -text $text
-# pd [concat $myname size [$canvasname bbox $myname] \;]
-}
-
-############### event binding procedures for Pd window ################
-
-proc pdtk_pd_ctrlkey {name key shift} {
-# puts stderr [concat key $key shift $shift]
-# .dummy itemconfig goo -text [concat ---> control-key event $key];
- if {$key == "n" || $key == "N"} {menu_new}
- if {$key == "o" || $key == "O"} {menu_open .}
- if {$key == "m" || $key == "M"} {menu_send}
- if {$key == "q" || $key == "Q"} {
- if {$shift == 1} {menu_really_quit} else {menu_quit}
- }
- if {$key == "slash"} {menu_audio 1}
- if {$key == "period"} {menu_audio 0}
-}
-
-######### startup function. ##############
-# Tell pd the current directory; this is used in case the command line
-# asked pd to open something. Also, get character width and height for
-# seven "useful" font sizes.
-
-# tb: user defined typefaces
-proc pdtk_pd_startup {version apilist midiapilist fontname_from_pd \
- fontweight_from_pd} {
-# puts stderr [concat $version $apilist $fontname]
- global pd_myversion pd_apilist pd_midiapilist pd_nt
- set pd_myversion $version
- set pd_apilist $apilist
- set pd_midiapilist $midiapilist
- global fontname fontweight
- set fontname $fontname_from_pd
- set fontweight $fontweight_from_pd
- global pd_fontlist
- set pd_fontlist {}
-
- set fontlist ""
- foreach i {8 9 10 12 14 16 18 24 30 36} {
- set font [format {{%s} %d %s} $fontname_from_pd -$i $fontweight_from_pd]
- set pd_fontlist [linsert $pd_fontlist 100000 $font]
- set width0 [font measure $font x]
- set height0 [lindex [font metrics $font] 5]
- set fontlist [concat $fontlist $i [font measure $font x] \
- [lindex [font metrics $font] 5]]
- }
-
- set tclpatch [info patchlevel]
- if {$tclpatch == "8.3.0" || \
- $tclpatch == "8.3.1" || \
- $tclpatch == "8.3.2" || \
- $tclpatch == "8.3.3" } {
- set oldtclversion 1
- } else {
- set oldtclversion 0
- }
- pd [concat pd init [pdtk_enquote [pwd]] $oldtclversion $fontlist \;];
-
- # add the audio and help menus to the Pd window. We delayed this
- # so that we'd know the value of "apilist".
- menu_addstd .mbar
-
- global pd_nt
- if {$pd_nt == 2} {
- global pd_macdropped pd_macready
- set pd_macready 1
- foreach file $pd_macdropped {
- pd [concat pd open [pdtk_enquote [file tail $file]] \
- [pdtk_enquote [file dirname $file]] \;]
- menu_doc_open [file dirname $file] [file tail $file]
- }
- }
-}
-
-##################### DSP ON/OFF, METERS, DIO ERROR ###################
-proc pdtk_pd_dsp {value} {
- global ctrls_audio_on
- if {$value == "ON"} {set ctrls_audio_on 1} else {set ctrls_audio_on 0}
-# puts stderr [concat its $ctrls_audio_on]
-}
-
-proc pdtk_pd_meters {indb outdb inclip outclip} {
-# puts stderr [concat meters $indb $outdb $inclip $outclip]
- global ctrls_inlevel ctrls_outlevel
- set ctrls_inlevel $indb
- if {$inclip == 1} {
- .controls.inout.in.clip configure -background red
- } else {
- .controls.inout.in.clip configure -background grey
- }
- set ctrls_outlevel $outdb
- if {$outclip == 1} {
- .controls.inout.out.clip configure -background red
- } else {
- .controls.inout.out.clip configure -background grey
- }
-
-}
-
-proc pdtk_pd_dio {red} {
-# puts stderr [concat dio $red]
- if {$red == 1} {
- .controls.dio configure -background red -activebackground red
- } else {
- .controls.dio configure -background grey -activebackground lightgrey
- }
-
-}
-
-############# text editing from the "edit" menu ###################
-set edit_number 1
-
-proc texteditor_send {name} {
- set topname [string trimright $name .text]
- for {set i 0} \
- {[$name compare [concat 0.0 + [expr $i + 1] chars] < end]} \
- {incr i 1} {
- set cha [$name get [concat 0.0 + $i chars]]
- scan $cha %c keynum
- pd [concat pd key 1 $keynum 0 \;]
- }
-}
-
-proc texteditor_ok {name} {
- set topname [string trimright $name .text]
- texteditor_send $name
- destroy $topname
-}
-
-
-proc pdtk_pd_texteditor {stuff} {
- global edit_number pd_deffont
- set name [format ".text%d" $edit_number]
- set edit_number [expr $edit_number + 1]
-
- toplevel $name
- wm title $name {TEXT}
-
- frame $name.buttons
- pack $name.buttons -side bottom -fill x -pady 2m
- button $name.buttons.send -text {Send (Ctrl s)}\
- -command "texteditor_send $name.text"
- button $name.buttons.ok -text {OK (Ctrl t)}\
- -command "texteditor_ok $name.text"
- pack $name.buttons.send -side left -expand 1
- pack $name.buttons.ok -side left -expand 1
-
- text $name.text -relief raised -bd 2 -height 12 -width 60 \
- -yscrollcommand "$name.scroll set" -font $pd_deffont
- scrollbar $name.scroll -command "$name.text yview"
- pack $name.scroll -side right -fill y
- pack $name.text -side left -fill both -expand 1
- $name.text insert end $stuff
- focus $name.text
- bind $name.text <Control-t> {texteditor_ok %W}
- bind $name.text <Control-s> {texteditor_send %W}
-}
-
-# paste text into a text box
-proc pdtk_pastetext {} {
- global pdtk_pastebuffer
- set pdtk_pastebuffer ""
- catch {global pdtk_pastebuffer; set pdtk_pastebuffer [clipboard get]}
-# puts stderr [concat paste $pdtk_pastebuffer]
- for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} {
- set cha [string index $pdtk_pastebuffer $i]
- scan $cha %c keynum
- pd [concat pd key 1 $keynum 0 \;]
- }
-}
-
-############# open and save dialogs for objects in Pd ##########
-
-proc pdtk_openpanel {target localdir} {
- global pd_opendir
- if {$localdir == ""} {
- set localdir $pd_opendir
- }
- set filename [tk_getOpenFile -initialdir $localdir]
- if {$filename != ""} {
- set directory [string range $filename 0 \
- [expr [string last / $filename ] - 1]]
- set pd_opendir $directory
-
- pd [concat $target callback [pdtk_enquote $filename] \;]
- }
-}
-
-proc pdtk_savepanel {target localdir} {
- global pd_savedir
- if {$localdir == ""} {
- set localdir $pd_savedir
- }
- set filename [tk_getSaveFile -initialdir $localdir]
- if {$filename != ""} {
- pd [concat $target callback [pdtk_enquote $filename] \;]
- }
-}
-
-########################### comport hack ########################
-
-set com1 0
-set com2 0
-set com3 0
-set com4 0
-
-proc com1_open {} {
- global com1
- set com1 [open com1 w]
- .dummy itemconfig goo -text $com1
- fconfigure $com1 -buffering none
- fconfigure $com1 -mode 19200,e,8,2
-}
-
-proc com1_send {str} {
- global com1
- puts -nonewline $com1 $str
-}
-
-
-############# start a polling process to watch the socket ##############
-# this is needed for nt, and presumably for Mac as well.
-# in UNIX this is handled by a tcl callback (set up in t_tkcmd.c)
-
-if {$pd_nt == 1} {
- proc polleofloop {} {
- pd_pollsocket
- after 20 polleofloop
- }
-
- polleofloop
-}
-
-####################### 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
-
- pd [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} {
- pd [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} {
- global pd_nt
- if [winfo exists $name.popup] {destroy $name.popup}
- menu $name.popup -tearoff false
- if {$pd_nt == 1} {
- $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 \; pd 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 {pd 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
-
- pd [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} {
- pd [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} {
- global pd_nt
- if [winfo exists $name.popup] {destroy $name.popup}
- menu $name.popup -tearoff false
- if {$pd_nt == 1} {
- $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 {pd 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 {pd 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]
- }
- }
-
- pd [concat pd path-dialog $pd_extrapath $pd_verbose $pd_path \;]
-}
-
-proc path_cancel {id} {
- pd [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 \; pd 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]}
- }
-
- pd [concat pd startup-dialog $pd_nort [pdtk_encodedialog $pd_flags] $pd_startup \;]
-}
-
-proc startup_cancel {id} {
- pd [concat $id cancel \;]
-}
-
-proc startup_ok {id} {
- startup_apply $id
- startup_cancel $id
-}
-
-proc pdtk_startup_dialog {id nort flags} {
- global pd_nort pd_nt 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 {$pd_nt != 1} {
- 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 \; pd pd save-preferences \\;"
- if {$pd_nt != 1} {
- 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
-}
-
-
diff --git a/pd/src/x_gui.c b/pd/src/x_gui.c
index 6ba58a7b..e83981bb 100644
--- a/pd/src/x_gui.c
+++ b/pd/src/x_gui.c
@@ -8,7 +8,7 @@ away before the panel does... */
#include "m_pd.h"
#include <stdio.h>
#include <string.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
diff --git a/pd/src/x_misc.c b/pd/src/x_misc.c
index 8a67a5d1..2d7860d9 100644
--- a/pd/src/x_misc.c
+++ b/pd/src/x_misc.c
@@ -9,7 +9,7 @@
#include <math.h>
#include <stdio.h>
#include <string.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <sys/types.h>
#include <sys/time.h>
#include <sys/times.h>
@@ -194,7 +194,7 @@ static t_class *cputime_class;
typedef struct _cputime
{
t_object x_obj;
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
struct tms x_setcputime;
#endif
#ifdef MSW
@@ -206,7 +206,7 @@ typedef struct _cputime
static void cputime_bang(t_cputime *x)
{
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
times(&x->x_setcputime);
#endif
#ifdef MSW
@@ -227,7 +227,7 @@ static void cputime_bang(t_cputime *x)
static void cputime_bang2(t_cputime *x)
{
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
t_float elapsedcpu;
struct tms newcputime;
times(&newcputime);
diff --git a/pd/src/x_qlist.c b/pd/src/x_qlist.c
index fe6df0f3..7c5ec57c 100644
--- a/pd/src/x_qlist.c
+++ b/pd/src/x_qlist.c
@@ -4,7 +4,7 @@
#include "m_pd.h"
#include <string.h>
-#ifdef UNISTD
+#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef MSW