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