From 9fae1676221a4a0f6c26a3902fe31bdf62d340a6 Mon Sep 17 00:00:00 2001
From: Miller Puckette <msp@ucsd.edu>
Date: Mon, 17 Sep 2007 11:36:46 -0700
Subject: [PATCH] font patch from HC
---
src/g_all_guis.c | 9 +-
src/g_all_guis.h | 2 +-
src/g_bang.c | 13 +-
src/g_graph.c | 19 +-
src/g_hdial.c | 12 +-
src/g_hslider.c | 13 +-
src/g_mycanvas.c | 14 +-
src/g_numbox.c | 22 +-
src/g_rtext.c | 10 +-
src/g_template.c | 4 +-
src/g_template.c.orig | 2333 ++++++++++++++++++++++
src/g_toggle.c | 13 +-
src/g_vdial.c | 12 +-
src/g_vslider.c | 13 +-
src/g_vumeter.c | 51 +-
src/m_pd.h | 2 +
src/makefile.in | 4 +-
src/s_inter.c | 8 +-
src/s_inter.c.orig | 1300 +++++++++++++
src/s_main.c | 36 +-
src/s_main.c.orig | 1001 ++++++++++
src/u_main.tk | 579 +++---
src/u_main.tk.orig | 4252 +++++++++++++++++++++++++++++++++++++++++
src/x_qlist.c | 11 +-
24 files changed, 9379 insertions(+), 354 deletions(-)
create mode 100644 src/g_template.c.orig
create mode 100644 src/s_inter.c.orig
create mode 100644 src/s_main.c.orig
create mode 100644 src/u_main.tk.orig
diff --git a/src/g_all_guis.c b/src/g_all_guis.c
index 2d18f4801..0547b0de7 100644
--- a/src/g_all_guis.c
+++ b/src/g_all_guis.c
@@ -438,7 +438,7 @@ void iemgui_label_font(void *x, t_iemgui *iemgui, t_symbol *s, int ac, t_atom *a
else
{
f = 0;
- strcpy(iemgui->x_font, "courier");
+ strcpy(iemgui->x_font, sys_font);
}
iemgui->x_fsf.x_font_style = f;
f = (int)atom_getintarg(1, ac, av);
@@ -446,8 +446,9 @@ void iemgui_label_font(void *x, t_iemgui *iemgui, t_symbol *s, int ac, t_atom *a
f = 4;
iemgui->x_fontsize = f;
if(glist_isvisible(iemgui->x_glist))
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold}\n",
- glist_getcanvas(iemgui->x_glist), x, iemgui->x_font, iemgui->x_fontsize);
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s}\n",
+ glist_getcanvas(iemgui->x_glist), x, iemgui->x_font,
+ iemgui->x_fontsize, sys_fontweight);
}
void iemgui_size(void *x, t_iemgui *iemgui)
@@ -622,7 +623,7 @@ int iemgui_dialog(t_iemgui *iemgui, t_symbol **srl, int argc, t_atom *argv)
else
{
f = 0;
- strcpy(iemgui->x_font, "courier");
+ strcpy(iemgui->x_font, sys_font);
}
iemgui->x_fsf.x_font_style = f;
if(fs < 4)
diff --git a/src/g_all_guis.h b/src/g_all_guis.h
index 2d7d7dd67..189d2c768 100644
--- a/src/g_all_guis.h
+++ b/src/g_all_guis.h
@@ -144,7 +144,7 @@ typedef struct _iemgui
int x_w;
int x_ldx;
int x_ldy;
- char x_font[16];
+ char x_font[MAXPDSTRING]; /* font names can be long! */
t_iem_fstyle_flags x_fsf;
int x_fontsize;
t_iem_init_symargs x_isa;
diff --git a/src/g_bang.c b/src/g_bang.c
index 3a5ef4d31..cd4b71291 100644
--- a/src/g_bang.c
+++ b/src/g_bang.c
@@ -55,11 +55,12 @@ void bng_draw_new(t_bng *x, t_glist *glist)
xpos + x->x_gui.x_w-1, ypos + x->x_gui.x_h-1,
x->x_flashed?x->x_gui.x_fcol:x->x_gui.x_bcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xpos+x->x_gui.x_ldx,
ypos+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
canvas, xpos,
@@ -115,8 +116,8 @@ void bng_draw_config(t_bng* x, t_glist* glist)
{
t_canvas *canvas=glist_getcanvas(glist);
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
sys_vgui(".x%lx.c itemconfigure %lxBASE -fill #%6.6x\n", canvas, x, x->x_gui.x_bcol);
@@ -237,7 +238,7 @@ static void bng_properties(t_gobj *z, t_glist *owner)
t_symbol *srl[3];
iemgui_properties(&x->x_gui, srl);
- sprintf(buf, "pdtk_iemgui_dialog %%s BANG \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |bang| \
----------dimensions(pix):----------- %d %d size: 0 0 empty \
--------flash-time(ms)(ms):--------- %d intrrpt: %d hold: %d \
%d empty empty %d %d empty %d \
@@ -481,7 +482,7 @@ static void *bng_new(t_symbol *s, int argc, t_atom *argv)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if (x->x_gui.x_fsf.x_rcv_able)
pd_bind(&x->x_gui.x_obj.ob_pd, x->x_gui.x_rcv);
diff --git a/src/g_graph.c b/src/g_graph.c
index 1f449a63c..7db14b5e6 100644
--- a/src/g_graph.c
+++ b/src/g_graph.c
@@ -741,9 +741,9 @@ static void graph_vis(t_gobj *gr, t_glist *parent_glist, int vis)
{
i -= sys_fontheight(glist_getfont(x));
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor nw\
- -font -*-courier-bold--normal--%d-* -tags %s\n",
- (long)glist_getcanvas(x), x1, i, arrayname->s_name,
- sys_hostfontsize(glist_getfont(x)), tag);
+ -font {{%s} %d %s} -tags %s\n",
+ (long)glist_getcanvas(x), x1, i, arrayname->s_name, sys_font,
+ sys_hostfontsize(glist_getfont(x)), sys_fontweight, tag);
}
/* draw ticks on horizontal borders. If lperb field is
@@ -823,21 +823,22 @@ static void graph_vis(t_gobj *gr, t_glist *parent_glist, int vis)
/* draw x labels */
for (i = 0; i < x->gl_nxlabels; i++)
sys_vgui(".x%lx.c create text\
- %d %d -text {%s} -font -*-courier-bold--normal--%d-* -tags %s\n",
+ %d %d -text {%s} -font {{%s} %d %s} -tags %s\n",
glist_getcanvas(x),
(int)glist_xtopixels(x, atof(x->gl_xlabel[i]->s_name)),
- (int)glist_ytopixels(x, x->gl_xlabely), x->gl_xlabel[i]->s_name,
- glist_getfont(x), tag);
+ (int)glist_ytopixels(x, x->gl_xlabely),
+ x->gl_xlabel[i]->s_name, sys_font,
+ glist_getfont(x), sys_fontweight, tag);
/* draw y labels */
for (i = 0; i < x->gl_nylabels; i++)
sys_vgui(".x%lx.c create text\
- %d %d -text {%s} -font -*-courier-bold--normal--%d-* -tags %s\n",
+ %d %d -text {%s} -font {{%s} %d %s} -tags %s\n",
glist_getcanvas(x),
(int)glist_xtopixels(x, x->gl_ylabelx),
(int)glist_ytopixels(x, atof(x->gl_ylabel[i]->s_name)),
- x->gl_ylabel[i]->s_name,
- glist_getfont(x), tag);
+ x->gl_ylabel[i]->s_name, sys_font,
+ glist_getfont(x), sys_fontweight, tag);
/* draw contents of graph as glist */
for (g = x->gl_list; g; g = g->g_next)
diff --git a/src/g_hdial.c b/src/g_hdial.c
index df5951269..64b0711e2 100644
--- a/src/g_hdial.c
+++ b/src/g_hdial.c
@@ -73,10 +73,10 @@ void hradio_draw_new(t_hradio *x, t_glist *glist)
x->x_drawn = x->x_on;
}
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xx11b+x->x_gui.x_ldx, yy11+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize,
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
@@ -141,8 +141,8 @@ void hradio_draw_config(t_hradio* x, t_glist* glist)
t_canvas *canvas=glist_getcanvas(glist);
int n=x->x_number, i;
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
for(i=0; i<n; i++)
@@ -264,7 +264,7 @@ static void hradio_properties(t_gobj *z, t_glist *owner)
iemgui_properties(&x->x_gui, srl);
if (pd_class(&x->x_gui.x_obj.ob_pd) == hradio_old_class)
hchange = x->x_change;
- sprintf(buf, "pdtk_iemgui_dialog %%s hradio \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |hradio| \
----------dimensions(pix):----------- %d %d size: 0 0 empty \
empty 0.0 empty 0.0 empty %d \
%d new-only new&old %d %d number: %d \
@@ -589,7 +589,7 @@ static void *hradio_donew(t_symbol *s, int argc, t_atom *argv, int old)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if(num < 1)
num = 1;
if(num > IEM_RADIO_MAX)
diff --git a/src/g_hslider.c b/src/g_hslider.c
index 4958639ab..cc776be41 100644
--- a/src/g_hslider.c
+++ b/src/g_hslider.c
@@ -76,11 +76,12 @@ static void hslider_draw_new(t_hslider *x, t_glist *glist)
canvas, r, ypos+1, r,
ypos + x->x_gui.x_h, x->x_gui.x_fcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xpos+x->x_gui.x_ldx,
ypos+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
canvas, xpos-3, ypos + x->x_gui.x_h-1,
@@ -136,8 +137,8 @@ static void hslider_draw_config(t_hslider* x,t_glist* glist)
{
t_canvas *canvas=glist_getcanvas(glist);
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
sys_vgui(".x%lx.c itemconfigure %lxKNOB -fill #%6.6x\n", canvas, x, x->x_gui.x_fcol);
@@ -285,7 +286,7 @@ static void hslider_properties(t_gobj *z, t_glist *owner)
t_symbol *srl[3];
iemgui_properties(&x->x_gui, srl);
- sprintf(buf, "pdtk_iemgui_dialog %%s HSLIDER \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |hsl| \
--------dimensions(pix)(pix):-------- %d %d width: %d %d height: \
-----------output-range:----------- %g left: %g right: %g \
%d lin log %d %d empty %d \
@@ -586,7 +587,7 @@ static void *hslider_new(t_symbol *s, int argc, t_atom *argv)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if(x->x_gui.x_fsf.x_rcv_able)
pd_bind(&x->x_gui.x_obj.ob_pd, x->x_gui.x_rcv);
x->x_gui.x_ldx = ldx;
diff --git a/src/g_mycanvas.c b/src/g_mycanvas.c
index 93f96ff59..50abdcabf 100644
--- a/src/g_mycanvas.c
+++ b/src/g_mycanvas.c
@@ -44,10 +44,11 @@ void my_canvas_draw_new(t_my_canvas *x, t_glist *glist)
xpos + x->x_gui.x_w, ypos + x->x_gui.x_h,
x->x_gui.x_bcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xpos+x->x_gui.x_ldx, ypos+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
}
void my_canvas_draw_move(t_my_canvas *x, t_glist *glist)
@@ -84,8 +85,9 @@ void my_canvas_draw_config(t_my_canvas* x, t_glist* glist)
x->x_gui.x_bcol, x->x_gui.x_bcol);
sys_vgui(".x%lx.c itemconfigure %lxBASE -outline #%6.6x\n", canvas, x,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_bcol);
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
}
@@ -152,7 +154,7 @@ static void my_canvas_properties(t_gobj *z, t_glist *owner)
t_symbol *srl[3];
iemgui_properties(&x->x_gui, srl);
- sprintf(buf, "pdtk_iemgui_dialog %%s MY_CANVAS \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |cnv| \
------selectable_dimensions(pix):------ %d %d size: 0.0 0.0 empty \
------visible_rectangle(pix)(pix):------ %d width: %d height: %d \
%d empty empty %d %d empty %d \
@@ -331,7 +333,7 @@ static void *my_canvas_new(t_symbol *s, int argc, t_atom *argv)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if (x->x_gui.x_fsf.x_rcv_able)
pd_bind(&x->x_gui.x_obj.ob_pd, x->x_gui.x_rcv);
x->x_gui.x_ldx = ldx;
diff --git a/src/g_numbox.c b/src/g_numbox.c
index 04c9c1bb5..099acc301 100644
--- a/src/g_numbox.c
+++ b/src/g_numbox.c
@@ -195,15 +195,17 @@ static void my_numbox_draw_new(t_my_numbox *x, t_glist *glist)
xpos, ypos + x->x_gui.x_h,
x->x_gui.x_fcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xpos+x->x_gui.x_ldx, ypos+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
my_numbox_ftoa(x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxNUMBER\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxNUMBER\n",
canvas, xpos+half+2, ypos+half+d,
- x->x_buf, x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_fcol, x);
+ x->x_buf, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_fcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
canvas,
@@ -269,12 +271,12 @@ static void my_numbox_draw_config(t_my_numbox* x,t_glist* glist)
{
t_canvas *canvas=glist_getcanvas(glist);
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
- sys_vgui(".x%lx.c itemconfigure %lxNUMBER -font {%s %d bold} -fill #%6.6x \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxNUMBER -font {{%s} %d %s} -fill #%6.6x \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_fcol);
sys_vgui(".x%lx.c itemconfigure %lxBASE1 -fill #%6.6x\n", canvas,
x, x->x_gui.x_bcol);
@@ -451,7 +453,7 @@ static void my_numbox_properties(t_gobj *z, t_glist *owner)
sys_queuegui(x, x->x_gui.x_glist, my_numbox_draw_update);
}
- sprintf(buf, "pdtk_iemgui_dialog %%s NUMBERBOX \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |nbx| \
-------dimensions(digits)(pix):------- %d %d width: %d %d height: \
-----------output-range:----------- %g min: %g max: %d \
%d lin log %d %d log-height: %d \
@@ -806,7 +808,7 @@ static void *my_numbox_new(t_symbol *s, int argc, t_atom *argv)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if (x->x_gui.x_fsf.x_rcv_able)
pd_bind(&x->x_gui.x_obj.ob_pd, x->x_gui.x_rcv);
x->x_gui.x_ldx = ldx;
diff --git a/src/g_rtext.c b/src/g_rtext.c
index cbb0ba887..8af48b1a5 100644
--- a/src/g_rtext.c
+++ b/src/g_rtext.c
@@ -15,10 +15,16 @@
#include "g_canvas.h"
#include "t_tk.h"
-#define LMARGIN 1
-#define RMARGIN 1
+#define LMARGIN 2
+#define RMARGIN 2
+/* for some reason, it draws text 1 pixel lower on Mac OS X (& linux too?) */
+#ifndef MSW
#define TMARGIN 2
#define BMARGIN 2
+#else
+#define TMARGIN 3
+#define BMARGIN 1
+#endif
#define SEND_FIRST 1
#define SEND_UPDATE 2
diff --git a/src/g_template.c b/src/g_template.c
index f5519e654..fecb805f1 100644
--- a/src/g_template.c
+++ b/src/g_template.c
@@ -2136,8 +2136,8 @@ static void drawnumber_vis(t_gobj *z, t_glist *glist,
drawnumber_sprintf(x, buf, &at);
sys_vgui(".x%lx.c create text %d %d -anchor nw -fill %s -text {%s}",
glist_getcanvas(glist), xloc, yloc, colorstring, buf);
- sys_vgui(" -font -*-courier-bold--normal--%d-*",
- sys_hostfontsize(glist_getfont(glist)));
+ sys_vgui(" -font {{%s} %d %s}", sys_font,
+ sys_hostfontsize(glist_getfont(glist)), sys_fontweight);
sys_vgui(" -tags drawnumber%lx\n", data);
}
else sys_vgui(".x%lx.c delete drawnumber%lx\n", glist_getcanvas(glist), data);
diff --git a/src/g_template.c.orig b/src/g_template.c.orig
new file mode 100644
index 000000000..f5519e654
--- /dev/null
+++ b/src/g_template.c.orig
@@ -0,0 +1,2333 @@
+/* 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. */
+
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+
+#include "m_pd.h"
+#include "s_stuff.h" /* for sys_hostfontsize */
+#include "g_canvas.h"
+
+void array_redraw(t_array *a, t_glist *glist);
+
+/*
+This file contains text objects you would put in a canvas to define a
+template. Templates describe objects of type "array" (g_array.c) and
+"scalar" (g_scalar.c).
+*/
+
+ /* the structure of a "struct" object (also the obsolete "gtemplate"
+ you get when using the name "template" in a box.) */
+
+struct _gtemplate
+{
+ t_object x_obj;
+ t_template *x_template;
+ t_canvas *x_owner;
+ t_symbol *x_sym;
+ struct _gtemplate *x_next;
+ int x_argc;
+ t_atom *x_argv;
+};
+
+/* ---------------- forward definitions ---------------- */
+
+static void template_conformarray(t_template *tfrom, t_template *tto,
+ int *conformaction, t_array *a);
+static void template_conformglist(t_template *tfrom, t_template *tto,
+ t_glist *glist, int *conformaction);
+
+/* ---------------------- storage ------------------------- */
+
+static t_class *gtemplate_class;
+static t_class *template_class;
+
+/* there's a pre-defined "float" template. LATER should we bind this
+to a symbol such as "pd-float"??? */
+
+ /* return true if two dataslot definitions match */
+static int dataslot_matches(t_dataslot *ds1, t_dataslot *ds2,
+ int nametoo)
+{
+ return ((!nametoo || ds1->ds_name == ds2->ds_name) &&
+ ds1->ds_type == ds2->ds_type &&
+ (ds1->ds_type != DT_ARRAY ||
+ ds1->ds_arraytemplate == ds2->ds_arraytemplate));
+}
+
+/* -- templates, the active ingredient in gtemplates defined below. ------- */
+
+t_template *template_new(t_symbol *templatesym, int argc, t_atom *argv)
+{
+ t_template *x = (t_template *)pd_new(template_class);
+ x->t_n = 0;
+ x->t_vec = (t_dataslot *)t_getbytes(0);
+ while (argc > 0)
+ {
+ int newtype, oldn, newn;
+ t_symbol *newname, *newarraytemplate = &s_, *newtypesym;
+ if (argc < 2 || argv[0].a_type != A_SYMBOL ||
+ argv[1].a_type != A_SYMBOL)
+ goto bad;
+ newtypesym = argv[0].a_w.w_symbol;
+ newname = argv[1].a_w.w_symbol;
+ if (newtypesym == &s_float)
+ newtype = DT_FLOAT;
+ else if (newtypesym == &s_symbol)
+ newtype = DT_SYMBOL;
+ else if (newtypesym == &s_list)
+ newtype = DT_LIST;
+ else if (newtypesym == gensym("array"))
+ {
+ if (argc < 3 || argv[2].a_type != A_SYMBOL)
+ {
+ pd_error(x, "array lacks element template or name");
+ goto bad;
+ }
+ newarraytemplate = canvas_makebindsym(argv[2].a_w.w_symbol);
+ newtype = DT_ARRAY;
+ argc--;
+ argv++;
+ }
+ else
+ {
+ pd_error(x, "%s: no such type", newtypesym->s_name);
+ goto bad;
+ }
+ newn = (oldn = x->t_n) + 1;
+ x->t_vec = (t_dataslot *)t_resizebytes(x->t_vec,
+ oldn * sizeof(*x->t_vec), newn * sizeof(*x->t_vec));
+ x->t_n = newn;
+ x->t_vec[oldn].ds_type = newtype;
+ x->t_vec[oldn].ds_name = newname;
+ x->t_vec[oldn].ds_arraytemplate = newarraytemplate;
+ bad:
+ argc -= 2; argv += 2;
+ }
+ if (templatesym->s_name)
+ {
+ x->t_sym = templatesym;
+ pd_bind(&x->t_pdobj, x->t_sym);
+ }
+ else x->t_sym = templatesym;
+ return (x);
+}
+
+int template_size(t_template *x)
+{
+ return (x->t_n * sizeof(t_word));
+}
+
+int template_find_field(t_template *x, t_symbol *name, int *p_onset,
+ int *p_type, t_symbol **p_arraytype)
+{
+ t_template *t;
+ int i, n;
+ if (!x)
+ {
+ bug("template_find_field");
+ return (0);
+ }
+ n = x->t_n;
+ for (i = 0; i < n; i++)
+ if (x->t_vec[i].ds_name == name)
+ {
+ *p_onset = i * sizeof(t_word);
+ *p_type = x->t_vec[i].ds_type;
+ *p_arraytype = x->t_vec[i].ds_arraytemplate;
+ return (1);
+ }
+ return (0);
+}
+
+t_float template_getfloat(t_template *x, t_symbol *fieldname, t_word *wp,
+ int loud)
+{
+ int onset, type;
+ t_symbol *arraytype;
+ float val = 0;
+ if (template_find_field(x, fieldname, &onset, &type, &arraytype))
+ {
+ if (type == DT_FLOAT)
+ val = *(t_float *)(((char *)wp) + onset);
+ else if (loud) error("%s.%s: not a number",
+ x->t_sym->s_name, fieldname->s_name);
+ }
+ else if (loud) error("%s.%s: no such field",
+ x->t_sym->s_name, fieldname->s_name);
+ return (val);
+}
+
+void template_setfloat(t_template *x, t_symbol *fieldname, t_word *wp,
+ t_float f, int loud)
+{
+ int onset, type;
+ t_symbol *arraytype;
+ if (template_find_field(x, fieldname, &onset, &type, &arraytype))
+ {
+ if (type == DT_FLOAT)
+ *(t_float *)(((char *)wp) + onset) = f;
+ else if (loud) error("%s.%s: not a number",
+ x->t_sym->s_name, fieldname->s_name);
+ }
+ else if (loud) error("%s.%s: no such field",
+ x->t_sym->s_name, fieldname->s_name);
+}
+
+t_symbol *template_getsymbol(t_template *x, t_symbol *fieldname, t_word *wp,
+ int loud)
+{
+ int onset, type;
+ t_symbol *arraytype;
+ t_symbol *val = &s_;
+ if (template_find_field(x, fieldname, &onset, &type, &arraytype))
+ {
+ if (type == DT_SYMBOL)
+ val = *(t_symbol **)(((char *)wp) + onset);
+ else if (loud) error("%s.%s: not a symbol",
+ x->t_sym->s_name, fieldname->s_name);
+ }
+ else if (loud) error("%s.%s: no such field",
+ x->t_sym->s_name, fieldname->s_name);
+ return (val);
+}
+
+void template_setsymbol(t_template *x, t_symbol *fieldname, t_word *wp,
+ t_symbol *s, int loud)
+{
+ int onset, type;
+ t_symbol *arraytype;
+ if (template_find_field(x, fieldname, &onset, &type, &arraytype))
+ {
+ if (type == DT_SYMBOL)
+ *(t_symbol **)(((char *)wp) + onset) = s;
+ else if (loud) error("%s.%s: not a symbol",
+ x->t_sym->s_name, fieldname->s_name);
+ }
+ else if (loud) error("%s.%s: no such field",
+ x->t_sym->s_name, fieldname->s_name);
+}
+
+ /* stringent check to see if a "saved" template, x2, matches the current
+ one (x1). It's OK if x1 has additional scalar elements but not (yet)
+ arrays or lists. This is used for reading in "data files". */
+int template_match(t_template *x1, t_template *x2)
+{
+ int i;
+ if (x1->t_n < x2->t_n)
+ return (0);
+ for (i = x2->t_n; i < x1->t_n; i++)
+ {
+ if (x1->t_vec[i].ds_type == DT_ARRAY ||
+ x1->t_vec[i].ds_type == DT_LIST)
+ return (0);
+ }
+ if (x2->t_n > x1->t_n)
+ post("add elements...");
+ for (i = 0; i < x2->t_n; i++)
+ if (!dataslot_matches(&x1->t_vec[i], &x2->t_vec[i], 1))
+ return (0);
+ return (1);
+}
+
+/* --------------- CONFORMING TO CHANGES IN A TEMPLATE ------------ */
+
+/* the following routines handle updating scalars to agree with changes
+in their template. The old template is assumed to be the "installed" one
+so we can delete old items; but making new ones we have to avoid scalar_new
+which would make an old one whereas we will want a new one (but whose array
+elements might still be old ones.)
+ LATER deal with graphics updates too... */
+
+ /* conform the word vector of a scalar to the new template */
+static void template_conformwords(t_template *tfrom, t_template *tto,
+ int *conformaction, t_word *wfrom, t_word *wto)
+{
+ int nfrom = tfrom->t_n, nto = tto->t_n, i;
+ for (i = 0; i < nto; i++)
+ {
+ if (conformaction[i] >= 0)
+ {
+ /* we swap the two, in case it's an array or list, so that
+ when "wfrom" is deleted the old one gets cleaned up. */
+ t_word wwas = wto[i];
+ wto[i] = wfrom[conformaction[i]];
+ wfrom[conformaction[i]] = wwas;
+ }
+ }
+}
+
+ /* conform a scalar, recursively conforming sublists and arrays */
+static t_scalar *template_conformscalar(t_template *tfrom, t_template *tto,
+ int *conformaction, t_glist *glist, t_scalar *scfrom)
+{
+ t_scalar *x;
+ t_gpointer gp;
+ int nto = tto->t_n, nfrom = tfrom->t_n, i;
+ t_template *scalartemplate;
+ /* post("conform scalar"); */
+ /* possibly replace the scalar */
+ if (scfrom->sc_template == tfrom->t_sym)
+ {
+ /* see scalar_new() for comment about the gpointer. */
+ gpointer_init(&gp);
+ x = (t_scalar *)getbytes(sizeof(t_scalar) +
+ (tto->t_n - 1) * sizeof(*x->sc_vec));
+ x->sc_gobj.g_pd = scalar_class;
+ x->sc_template = tfrom->t_sym;
+ gpointer_setglist(&gp, glist, x);
+ /* Here we initialize to the new template, but array and list
+ elements will still belong to old template. */
+ word_init(x->sc_vec, tto, &gp);
+
+ template_conformwords(tfrom, tto, conformaction,
+ scfrom->sc_vec, x->sc_vec);
+
+ /* replace the old one with the new one in the list */
+ if (glist->gl_list == &scfrom->sc_gobj)
+ {
+ glist->gl_list = &x->sc_gobj;
+ x->sc_gobj.g_next = scfrom->sc_gobj.g_next;
+ }
+ else
+ {
+ t_gobj *y, *y2;
+ for (y = glist->gl_list; y2 = y->g_next; y = y2)
+ if (y2 == &scfrom->sc_gobj)
+ {
+ x->sc_gobj.g_next = y2->g_next;
+ y->g_next = &x->sc_gobj;
+ goto nobug;
+ }
+ bug("template_conformscalar");
+ nobug: ;
+ }
+ /* burn the old one */
+ pd_free(&scfrom->sc_gobj.g_pd);
+ scalartemplate = tto;
+ }
+ else
+ {
+ x = scfrom;
+ scalartemplate = template_findbyname(x->sc_template);
+ }
+ /* convert all array elements and sublists */
+ for (i = 0; i < scalartemplate->t_n; i++)
+ {
+ t_dataslot *ds = scalartemplate->t_vec + i;
+ if (ds->ds_type == DT_LIST)
+ {
+ t_glist *gl2 = x->sc_vec[i].w_list;
+ template_conformglist(tfrom, tto, gl2, conformaction);
+ }
+ else if (ds->ds_type == DT_ARRAY)
+ {
+ template_conformarray(tfrom, tto, conformaction,
+ x->sc_vec[i].w_array);
+ }
+ }
+ return (x);
+}
+
+ /* conform an array, recursively conforming sublists and arrays */
+static void template_conformarray(t_template *tfrom, t_template *tto,
+ int *conformaction, t_array *a)
+{
+ int i, j;
+ t_template *scalartemplate = 0;
+ if (a->a_templatesym == tfrom->t_sym)
+ {
+ /* the array elements must all be conformed */
+ int oldelemsize = sizeof(t_word) * tfrom->t_n,
+ newelemsize = sizeof(t_word) * tto->t_n;
+ char *newarray = getbytes(newelemsize * a->a_n);
+ char *oldarray = a->a_vec;
+ if (a->a_elemsize != oldelemsize)
+ bug("template_conformarray");
+ for (i = 0; i < a->a_n; i++)
+ {
+ t_word *wp = (t_word *)(newarray + newelemsize * i);
+ word_init(wp, tto, &a->a_gp);
+ template_conformwords(tfrom, tto, conformaction,
+ (t_word *)(oldarray + oldelemsize * i), wp);
+ word_free((t_word *)(oldarray + oldelemsize * i), tfrom);
+ }
+ scalartemplate = tto;
+ a->a_vec = newarray;
+ freebytes(oldarray, oldelemsize * a->a_n);
+ }
+ else scalartemplate = template_findbyname(a->a_templatesym);
+ /* convert all arrays and sublist fields in each element of the array */
+ for (i = 0; i < a->a_n; i++)
+ {
+ t_word *wp = (t_word *)(a->a_vec + sizeof(t_word) * a->a_n * i);
+ for (j = 0; j < scalartemplate->t_n; j++)
+ {
+ t_dataslot *ds = scalartemplate->t_vec + j;
+ if (ds->ds_type == DT_LIST)
+ {
+ t_glist *gl2 = wp[j].w_list;
+ template_conformglist(tfrom, tto, gl2, conformaction);
+ }
+ else if (ds->ds_type == DT_ARRAY)
+ {
+ template_conformarray(tfrom, tto, conformaction,
+ wp[j].w_array);
+ }
+ }
+ }
+}
+
+ /* this routine searches for every scalar in the glist that belongs
+ to the "from" template and makes it belong to the "to" template. Descend
+ glists recursively.
+ We don't handle redrawing here; this is to be filled in LATER... */
+
+t_array *garray_getarray(t_garray *x);
+
+static void template_conformglist(t_template *tfrom, t_template *tto,
+ t_glist *glist, int *conformaction)
+{
+ t_gobj *g;
+ /* post("conform glist %s", glist->gl_name->s_name); */
+ for (g = glist->gl_list; g; g = g->g_next)
+ {
+ if (pd_class(&g->g_pd) == scalar_class)
+ g = &template_conformscalar(tfrom, tto, conformaction,
+ glist, (t_scalar *)g)->sc_gobj;
+ else if (pd_class(&g->g_pd) == canvas_class)
+ template_conformglist(tfrom, tto, (t_glist *)g, conformaction);
+ else if (pd_class(&g->g_pd) == garray_class)
+ template_conformarray(tfrom, tto, conformaction,
+ garray_getarray((t_garray *)g));
+ }
+}
+
+ /* globally conform all scalars from one template to another */
+void template_conform(t_template *tfrom, t_template *tto)
+{
+ int nto = tto->t_n, nfrom = tfrom->t_n, i, j,
+ *conformaction = (int *)getbytes(sizeof(int) * nto),
+ *conformedfrom = (int *)getbytes(sizeof(int) * nfrom), doit = 0;
+ for (i = 0; i < nto; i++)
+ conformaction[i] = -1;
+ for (i = 0; i < nfrom; i++)
+ conformedfrom[i] = 0;
+ for (i = 0; i < nto; i++)
+ {
+ t_dataslot *dataslot = &tto->t_vec[i];
+ for (j = 0; j < nfrom; j++)
+ {
+ t_dataslot *dataslot2 = &tfrom->t_vec[j];
+ if (dataslot_matches(dataslot, dataslot2, 1))
+ {
+ conformaction[i] = j;
+ conformedfrom[j] = 1;
+ }
+ }
+ }
+ for (i = 0; i < nto; i++)
+ if (conformaction[i] < 0)
+ {
+ t_dataslot *dataslot = &tto->t_vec[i];
+ for (j = 0; j < nfrom; j++)
+ if (!conformedfrom[j] &&
+ dataslot_matches(dataslot, &tfrom->t_vec[j], 0))
+ {
+ conformaction[i] = j;
+ conformedfrom[j] = 1;
+ }
+ }
+ if (nto != nfrom)
+ doit = 1;
+ else for (i = 0; i < nto; i++)
+ if (conformaction[i] != i)
+ doit = 1;
+
+ if (doit)
+ {
+ t_glist *gl;
+ post("conforming template '%s' to new structure",
+ tfrom->t_sym->s_name);
+ for (i = 0; i < nto; i++)
+ post("... %d", conformaction[i]);
+ for (gl = canvas_list; gl; gl = gl->gl_next)
+ template_conformglist(tfrom, tto, gl, conformaction);
+ }
+ freebytes(conformaction, sizeof(int) * nto);
+ freebytes(conformedfrom, sizeof(int) * nfrom);
+}
+
+t_template *template_findbyname(t_symbol *s)
+{
+ return ((t_template *)pd_findbyclass(s, template_class));
+}
+
+t_canvas *template_findcanvas(t_template *template)
+{
+ t_gtemplate *gt;
+ if (!template)
+ bug("template_findcanvas");
+ if (!(gt = template->t_list))
+ return (0);
+ return (gt->x_owner);
+ /* return ((t_canvas *)pd_findbyclass(template->t_sym, canvas_class)); */
+}
+
+void template_notify(t_template *template, t_symbol *s, int argc, t_atom *argv)
+{
+ if (template->t_list)
+ outlet_anything(template->t_list->x_obj.ob_outlet, s, argc, argv);
+}
+
+ /* bash the first of (argv) with a pointer to a scalar, and send on
+ to template as a notification message */
+static void template_notifyforscalar(t_template *template, t_glist *owner,
+ t_scalar *sc, t_symbol *s, int argc, t_atom *argv)
+{
+ t_gpointer gp;
+ gpointer_init(&gp);
+ gpointer_setglist(&gp, owner, sc);
+ SETPOINTER(argv, &gp);
+ template_notify(template, s, argc, argv);
+ gpointer_unset(&gp);
+}
+
+ /* call this when reading a patch from a file to declare what templates
+ we'll need. If there's already a template, check if it matches.
+ If it doesn't it's still OK as long as there are no "struct" (gtemplate)
+ objects hanging from it; we just conform everyone to the new template.
+ If there are still struct objects belonging to the other template, we're
+ in trouble. LATER we'll figure out how to conform the new patch's objects
+ to the pre-existing struct. */
+static void *template_usetemplate(void *dummy, t_symbol *s,
+ int argc, t_atom *argv)
+{
+ t_template *x;
+ t_symbol *templatesym =
+ canvas_makebindsym(atom_getsymbolarg(0, argc, argv));
+ if (!argc)
+ return (0);
+ argc--; argv++;
+ /* check if there's already a template by this name. */
+ if ((x = (t_template *)pd_findbyclass(templatesym, template_class)))
+ {
+ t_template *y = template_new(&s_, argc, argv), *y2;
+ /* If the new template is the same as the old one,
+ there's nothing to do. */
+ if (!template_match(x, y))
+ {
+ /* Are there "struct" objects upholding this template? */
+ if (x->t_list)
+ {
+ /* don't know what to do here! */
+ error("%s: template mismatch",
+ templatesym->s_name);
+ }
+ else
+ {
+ /* conform everyone to the new template */
+ template_conform(x, y);
+ pd_free(&x->t_pdobj);
+ y2 = template_new(templatesym, argc, argv);
+ y2->t_list = 0;
+ }
+ }
+ pd_free(&y->t_pdobj);
+ }
+ /* otherwise, just make one. */
+ else template_new(templatesym, argc, argv);
+ return (0);
+}
+
+ /* here we assume someone has already cleaned up all instances of this. */
+void template_free(t_template *x)
+{
+ if (*x->t_sym->s_name)
+ pd_unbind(&x->t_pdobj, x->t_sym);
+ t_freebytes(x->t_vec, x->t_n * sizeof(*x->t_vec));
+}
+
+static void template_setup(void)
+{
+ template_class = class_new(gensym("template"), 0, (t_method)template_free,
+ sizeof(t_template), CLASS_PD, 0);
+ class_addmethod(pd_canvasmaker, (t_method)template_usetemplate,
+ gensym("struct"), A_GIMME, 0);
+
+}
+
+/* ---------------- gtemplates. One per canvas. ----------- */
+
+/* "Struct": an object that searches for, and if necessary creates,
+a template (above). Other objects in the canvas then can give drawing
+instructions for the template. The template doesn't go away when the
+"struct" is deleted, so that you can replace it with
+another one to add new fields, for example. */
+
+static void *gtemplate_donew(t_symbol *sym, int argc, t_atom *argv)
+{
+ t_gtemplate *x = (t_gtemplate *)pd_new(gtemplate_class);
+ t_template *t = template_findbyname(sym);
+ int i;
+ t_symbol *sx = gensym("x");
+ x->x_owner = canvas_getcurrent();
+ x->x_next = 0;
+ x->x_sym = sym;
+ x->x_argc = argc;
+ x->x_argv = (t_atom *)getbytes(argc * sizeof(t_atom));
+ for (i = 0; i < argc; i++)
+ x->x_argv[i] = argv[i];
+
+ /* already have a template by this name? */
+ if (t)
+ {
+ x->x_template = t;
+ /* if it's already got a "struct" object we
+ just tack this one to the end of the list and leave it
+ there. */
+ if (t->t_list)
+ {
+ t_gtemplate *x2, *x3;
+ for (x2 = x->x_template->t_list; x3 = x2->x_next; x2 = x3)
+ ;
+ x2->x_next = x;
+ post("template %s: warning: already exists.", sym->s_name);
+ }
+ else
+ {
+ /* if there's none, we just replace the template with
+ our own and conform it. */
+ t_template *y = template_new(&s_, argc, argv);
+ canvas_redrawallfortemplate(t, 2);
+ /* Unless the new template is different from the old one,
+ there's nothing to do. */
+ if (!template_match(t, y))
+ {
+ /* conform everyone to the new template */
+ template_conform(t, y);
+ pd_free(&t->t_pdobj);
+ t = template_new(sym, argc, argv);
+ }
+ pd_free(&y->t_pdobj);
+ t->t_list = x;
+ canvas_redrawallfortemplate(t, 1);
+ }
+ }
+ else
+ {
+ /* otherwise make a new one and we're the only struct on it. */
+ x->x_template = t = template_new(sym, argc, argv);
+ t->t_list = x;
+ }
+ outlet_new(&x->x_obj, 0);
+ return (x);
+}
+
+static void *gtemplate_new(t_symbol *s, int argc, t_atom *argv)
+{
+ t_symbol *sym = atom_getsymbolarg(0, argc, argv);
+ if (argc >= 1)
+ argc--; argv++;
+ return (gtemplate_donew(canvas_makebindsym(sym), argc, argv));
+}
+
+ /* old version (0.34) -- delete 2003 or so */
+static void *gtemplate_new_old(t_symbol *s, int argc, t_atom *argv)
+{
+ t_symbol *sym = canvas_makebindsym(canvas_getcurrent()->gl_name);
+ static int warned;
+ if (!warned)
+ {
+ post("warning -- 'template' (%s) is obsolete; replace with 'struct'",
+ sym->s_name);
+ warned = 1;
+ }
+ return (gtemplate_donew(sym, argc, argv));
+}
+
+t_template *gtemplate_get(t_gtemplate *x)
+{
+ return (x->x_template);
+}
+
+static void gtemplate_free(t_gtemplate *x)
+{
+ /* get off the template's list */
+ t_template *t = x->x_template;
+ t_gtemplate *y;
+ if (x == t->t_list)
+ {
+ canvas_redrawallfortemplate(t, 2);
+ if (x->x_next)
+ {
+ /* if we were first on the list, and there are others on
+ the list, make a new template corresponding to the new
+ first-on-list and replace the existing template with it. */
+ t_template *z = template_new(&s_,
+ x->x_next->x_argc, x->x_next->x_argv);
+ template_conform(t, z);
+ pd_free(&t->t_pdobj);
+ pd_free(&z->t_pdobj);
+ z = template_new(x->x_sym, x->x_next->x_argc, x->x_next->x_argv);
+ z->t_list = x->x_next;
+ for (y = z->t_list; y ; y = y->x_next)
+ y->x_template = z;
+ }
+ else t->t_list = 0;
+ canvas_redrawallfortemplate(t, 1);
+ }
+ else
+ {
+ t_gtemplate *x2, *x3;
+ for (x2 = t->t_list; x3 = x2->x_next; x2 = x3)
+ {
+ if (x == x3)
+ {
+ x2->x_next = x3->x_next;
+ break;
+ }
+ }
+ }
+ freebytes(x->x_argv, sizeof(t_atom) * x->x_argc);
+}
+
+static void gtemplate_setup(void)
+{
+ gtemplate_class = class_new(gensym("struct"),
+ (t_newmethod)gtemplate_new, (t_method)gtemplate_free,
+ sizeof(t_gtemplate), CLASS_NOINLET, A_GIMME, 0);
+ class_addcreator((t_newmethod)gtemplate_new_old, gensym("template"),
+ A_GIMME, 0);
+}
+
+/* --------------- FIELD DESCRIPTORS ---------------------- */
+
+/* a field descriptor can hold a constant or a variable; if a variable,
+it's the name of a field in the template we belong to. LATER, we might
+want to cache the offset of the field so we don't have to search for it
+every single time we draw the object.
+*/
+
+struct _fielddesc
+{
+ char fd_type; /* LATER consider removing this? */
+ char fd_var;
+ union
+ {
+ t_float fd_float; /* the field is a constant float */
+ t_symbol *fd_symbol; /* the field is a constant symbol */
+ t_symbol *fd_varsym; /* the field is variable and this is the name */
+ } fd_un;
+ float fd_v1; /* min and max values */
+ float fd_v2;
+ float fd_screen1; /* min and max screen values */
+ float fd_screen2;
+ float fd_quantum; /* quantization in value */
+};
+
+static void fielddesc_setfloat_const(t_fielddesc *fd, float f)
+{
+ fd->fd_type = A_FLOAT;
+ fd->fd_var = 0;
+ fd->fd_un.fd_float = f;
+ fd->fd_v1 = fd->fd_v2 = fd->fd_screen1 = fd->fd_screen2 =
+ fd->fd_quantum = 0;
+}
+
+static void fielddesc_setsymbol_const(t_fielddesc *fd, t_symbol *s)
+{
+ fd->fd_type = A_SYMBOL;
+ fd->fd_var = 0;
+ fd->fd_un.fd_symbol = s;
+ fd->fd_v1 = fd->fd_v2 = fd->fd_screen1 = fd->fd_screen2 =
+ fd->fd_quantum = 0;
+}
+
+static void fielddesc_setfloat_var(t_fielddesc *fd, t_symbol *s)
+{
+ char *s1, *s2, *s3, strbuf[MAXPDSTRING];
+ int i;
+ fd->fd_type = A_FLOAT;
+ fd->fd_var = 1;
+ if (!(s1 = strchr(s->s_name, '(')) || !(s2 = strchr(s->s_name, ')'))
+ || (s1 > s2))
+ {
+ fd->fd_un.fd_varsym = s;
+ fd->fd_v1 = fd->fd_v2 = fd->fd_screen1 = fd->fd_screen2 =
+ fd->fd_quantum = 0;
+ }
+ else
+ {
+ int cpy = s1 - s->s_name, got;
+ if (cpy > MAXPDSTRING-5)
+ cpy = MAXPDSTRING-5;
+ strncpy(strbuf, s->s_name, cpy);
+ strbuf[cpy] = 0;
+ fd->fd_un.fd_varsym = gensym(strbuf);
+ got = sscanf(s1, "(%f:%f)(%f:%f)(%f)",
+ &fd->fd_v1, &fd->fd_v2, &fd->fd_screen1, &fd->fd_screen2,
+ &fd->fd_quantum);
+ if (got < 2)
+ goto fail;
+ if (got == 3 || (got < 4 && strchr(s2, '(')))
+ goto fail;
+ if (got < 5 && (s3 = strchr(s2, '(')) && strchr(s3+1, '('))
+ goto fail;
+ if (got == 4)
+ fd->fd_quantum = 0;
+ else if (got == 2)
+ {
+ fd->fd_quantum = 0;
+ fd->fd_screen1 = fd->fd_v1;
+ fd->fd_screen2 = fd->fd_v2;
+ }
+ return;
+ fail:
+ post("parse error: %s", s->s_name);
+ fd->fd_v1 = fd->fd_screen1 = fd->fd_v2 = fd->fd_screen2 =
+ fd->fd_quantum = 0;
+ }
+}
+
+#define CLOSED 1
+#define BEZ 2
+#define NOMOUSE 4
+#define A_ARRAY 55 /* LATER decide whether to enshrine this in m_pd.h */
+
+static void fielddesc_setfloatarg(t_fielddesc *fd, int argc, t_atom *argv)
+{
+ if (argc <= 0) fielddesc_setfloat_const(fd, 0);
+ else if (argv->a_type == A_SYMBOL)
+ fielddesc_setfloat_var(fd, argv->a_w.w_symbol);
+ else fielddesc_setfloat_const(fd, argv->a_w.w_float);
+}
+
+static void fielddesc_setsymbolarg(t_fielddesc *fd, int argc, t_atom *argv)
+{
+ if (argc <= 0) fielddesc_setsymbol_const(fd, &s_);
+ else if (argv->a_type == A_SYMBOL)
+ {
+ fd->fd_type = A_SYMBOL;
+ fd->fd_var = 1;
+ fd->fd_un.fd_varsym = argv->a_w.w_symbol;
+ fd->fd_v1 = fd->fd_v2 = fd->fd_screen1 = fd->fd_screen2 =
+ fd->fd_quantum = 0;
+ }
+ else fielddesc_setsymbol_const(fd, &s_);
+}
+
+static void fielddesc_setarrayarg(t_fielddesc *fd, int argc, t_atom *argv)
+{
+ if (argc <= 0) fielddesc_setfloat_const(fd, 0);
+ else if (argv->a_type == A_SYMBOL)
+ {
+ fd->fd_type = A_ARRAY;
+ fd->fd_var = 1;
+ fd->fd_un.fd_varsym = argv->a_w.w_symbol;
+ }
+ else fielddesc_setfloat_const(fd, argv->a_w.w_float);
+}
+
+ /* getting and setting values via fielddescs -- note confusing names;
+ the above are setting up the fielddesc itself. */
+static t_float fielddesc_getfloat(t_fielddesc *f, t_template *template,
+ t_word *wp, int loud)
+{
+ if (f->fd_type == A_FLOAT)
+ {
+ if (f->fd_var)
+ return (template_getfloat(template, f->fd_un.fd_varsym, wp, loud));
+ else return (f->fd_un.fd_float);
+ }
+ else
+ {
+ if (loud)
+ error("symbolic data field used as number");
+ return (0);
+ }
+}
+
+ /* convert a variable's value to a screen coordinate via its fielddesc */
+t_float fielddesc_cvttocoord(t_fielddesc *f, float val)
+{
+ float coord, pix, extreme, div;
+ if (f->fd_v2 == f->fd_v1)
+ return (val);
+ div = (f->fd_screen2 - f->fd_screen1)/(f->fd_v2 - f->fd_v1);
+ coord = f->fd_screen1 + (val - f->fd_v1) * div;
+ extreme = (f->fd_screen1 < f->fd_screen2 ?
+ f->fd_screen1 : f->fd_screen2);
+ if (coord < extreme)
+ coord = extreme;
+ extreme = (f->fd_screen1 > f->fd_screen2 ?
+ f->fd_screen1 : f->fd_screen2);
+ if (coord > extreme)
+ coord = extreme;
+ return (coord);
+}
+
+ /* read a variable via fielddesc and convert to screen coordinate */
+t_float fielddesc_getcoord(t_fielddesc *f, t_template *template,
+ t_word *wp, int loud)
+{
+ if (f->fd_type == A_FLOAT)
+ {
+ if (f->fd_var)
+ {
+ float val = template_getfloat(template,
+ f->fd_un.fd_varsym, wp, loud);
+ return (fielddesc_cvttocoord(f, val));
+ }
+ else return (f->fd_un.fd_float);
+ }
+ else
+ {
+ if (loud)
+ error("symbolic data field used as number");
+ return (0);
+ }
+}
+
+static t_symbol *fielddesc_getsymbol(t_fielddesc *f, t_template *template,
+ t_word *wp, int loud)
+{
+ if (f->fd_type == A_SYMBOL)
+ {
+ if (f->fd_var)
+ return(template_getsymbol(template, f->fd_un.fd_varsym, wp, loud));
+ else return (f->fd_un.fd_symbol);
+ }
+ else
+ {
+ if (loud)
+ error("numeric data field used as symbol");
+ return (&s_);
+ }
+}
+
+ /* convert from a screen coordinate to a variable value */
+float fielddesc_cvtfromcoord(t_fielddesc *f, float coord)
+{
+ float val;
+ if (f->fd_screen2 == f->fd_screen1)
+ val = coord;
+ else
+ {
+ float div = (f->fd_v2 - f->fd_v1)/(f->fd_screen2 - f->fd_screen1);
+ float extreme;
+ val = f->fd_v1 + (coord - f->fd_screen1) * div;
+ if (f->fd_quantum != 0)
+ val = ((int)((val/f->fd_quantum) + 0.5)) * f->fd_quantum;
+ extreme = (f->fd_v1 < f->fd_v2 ?
+ f->fd_v1 : f->fd_v2);
+ if (val < extreme) val = extreme;
+ extreme = (f->fd_v1 > f->fd_v2 ?
+ f->fd_v1 : f->fd_v2);
+ if (val > extreme) val = extreme;
+ }
+ return (val);
+ }
+
+void fielddesc_setcoord(t_fielddesc *f, t_template *template,
+ t_word *wp, float coord, int loud)
+{
+ if (f->fd_type == A_FLOAT && f->fd_var)
+ {
+ float val = fielddesc_cvtfromcoord(f, coord);
+ template_setfloat(template,
+ f->fd_un.fd_varsym, wp, val, loud);
+ }
+ else
+ {
+ if (loud)
+ error("attempt to set constant or symbolic data field to a number");
+ }
+}
+
+/* ---------------- curves and polygons (joined segments) ---------------- */
+
+/*
+curves belong to templates and describe how the data in the template are to
+be drawn. The coordinates of the curve (and other display features) can
+be attached to fields in the template.
+*/
+
+t_class *curve_class;
+
+typedef struct _curve
+{
+ t_object x_obj;
+ int x_flags; /* CLOSED and/or BEZ and/or NOMOUSE */
+ t_fielddesc x_fillcolor;
+ t_fielddesc x_outlinecolor;
+ t_fielddesc x_width;
+ t_fielddesc x_vis;
+ int x_npoints;
+ t_fielddesc *x_vec;
+ t_canvas *x_canvas;
+} t_curve;
+
+static void *curve_new(t_symbol *classsym, t_int argc, t_atom *argv)
+{
+ t_curve *x = (t_curve *)pd_new(curve_class);
+ char *classname = classsym->s_name;
+ int flags = 0;
+ int nxy, i;
+ t_fielddesc *fd;
+ x->x_canvas = canvas_getcurrent();
+ if (classname[0] == 'f')
+ {
+ classname += 6;
+ flags |= CLOSED;
+ }
+ else classname += 4;
+ if (classname[0] == 'c') flags |= BEZ;
+ fielddesc_setfloat_const(&x->x_vis, 1);
+ while (1)
+ {
+ t_symbol *firstarg = atom_getsymbolarg(0, argc, argv);
+ if (!strcmp(firstarg->s_name, "-v") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_vis, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(firstarg->s_name, "-x"))
+ {
+ flags |= NOMOUSE;
+ argc -= 1; argv += 1;
+ }
+ else break;
+ }
+ x->x_flags = flags;
+ if ((flags & CLOSED) && argc)
+ fielddesc_setfloatarg(&x->x_fillcolor, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_fillcolor, 0);
+ if (argc) fielddesc_setfloatarg(&x->x_outlinecolor, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_outlinecolor, 0);
+ if (argc) fielddesc_setfloatarg(&x->x_width, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_width, 1);
+ if (argc < 0) argc = 0;
+ nxy = (argc + (argc & 1));
+ x->x_npoints = (nxy>>1);
+ x->x_vec = (t_fielddesc *)t_getbytes(nxy * sizeof(t_fielddesc));
+ for (i = 0, fd = x->x_vec; i < argc; i++, fd++, argv++)
+ fielddesc_setfloatarg(fd, 1, argv);
+ if (argc & 1) fielddesc_setfloat_const(fd, 0);
+
+ return (x);
+}
+
+void curve_float(t_curve *x, t_floatarg f)
+{
+ int viswas;
+ if (x->x_vis.fd_type != A_FLOAT || x->x_vis.fd_var)
+ {
+ pd_error(x, "global vis/invis for a template with variable visibility");
+ return;
+ }
+ viswas = (x->x_vis.fd_un.fd_float != 0);
+
+ if ((f != 0 && viswas) || (f == 0 && !viswas))
+ return;
+ canvas_redrawallfortemplatecanvas(x->x_canvas, 2);
+ fielddesc_setfloat_const(&x->x_vis, (f != 0));
+ canvas_redrawallfortemplatecanvas(x->x_canvas, 1);
+}
+
+/* -------------------- widget behavior for curve ------------ */
+
+static void curve_getrect(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int *xp1, int *yp1, int *xp2, int *yp2)
+{
+ t_curve *x = (t_curve *)z;
+ int i, n = x->x_npoints;
+ t_fielddesc *f = x->x_vec;
+ int x1 = 0x7fffffff, x2 = -0x7fffffff, y1 = 0x7fffffff, y2 = -0x7fffffff;
+ if (!fielddesc_getfloat(&x->x_vis, template, data, 0) ||
+ (x->x_flags & NOMOUSE))
+ {
+ *xp1 = *yp1 = 0x7fffffff;
+ *xp2 = *yp2 = -0x7fffffff;
+ return;
+ }
+ for (i = 0, f = x->x_vec; i < n; i++, f += 2)
+ {
+ int xloc = glist_xtopixels(glist,
+ basex + fielddesc_getcoord(f, template, data, 0));
+ int yloc = glist_ytopixels(glist,
+ basey + fielddesc_getcoord(f+1, template, data, 0));
+ if (xloc < x1) x1 = xloc;
+ if (xloc > x2) x2 = xloc;
+ if (yloc < y1) y1 = yloc;
+ if (yloc > y2) y2 = yloc;
+ }
+ *xp1 = x1;
+ *yp1 = y1;
+ *xp2 = x2;
+ *yp2 = y2;
+}
+
+static void curve_displace(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int dx, int dy)
+{
+ /* refuse */
+}
+
+static void curve_select(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int state)
+{
+ /* fill in later */
+}
+
+static void curve_activate(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int state)
+{
+ /* fill in later */
+}
+
+#if 0
+static int rangecolor(int n) /* 0 to 9 in 5 steps */
+{
+ int n2 = n/2; /* 0 to 4 */
+ int ret = (n2 << 6); /* 0 to 256 in 5 steps */
+ if (ret > 255) ret = 255;
+ return (ret);
+}
+#endif
+
+static int rangecolor(int n) /* 0 to 9 in 5 steps */
+{
+ int n2 = (n == 9 ? 8 : n); /* 0 to 8 */
+ int ret = (n2 << 5); /* 0 to 256 in 9 steps */
+ if (ret > 255) ret = 255;
+ return (ret);
+}
+
+static void numbertocolor(int n, char *s)
+{
+ int red, blue, green;
+ if (n < 0) n = 0;
+ red = n / 100;
+ blue = ((n / 10) % 10);
+ green = n % 10;
+ sprintf(s, "#%2.2x%2.2x%2.2x", rangecolor(red), rangecolor(blue),
+ rangecolor(green));
+}
+
+static void curve_vis(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int vis)
+{
+ t_curve *x = (t_curve *)z;
+ int i, n = x->x_npoints;
+ t_fielddesc *f = x->x_vec;
+
+ /* see comment in plot_vis() */
+ if (vis && !fielddesc_getfloat(&x->x_vis, template, data, 0))
+ return;
+ if (vis)
+ {
+ if (n > 1)
+ {
+ int flags = x->x_flags, closed = (flags & CLOSED);
+ float width = fielddesc_getfloat(&x->x_width, template, data, 1);
+ char outline[20], fill[20];
+ int pix[200];
+ if (n > 100)
+ n = 100;
+ /* calculate the pixel values before we start printing
+ out the TK message so that "error" printout won't be
+ interspersed with it. Only show up to 100 points so we don't
+ have to allocate memory here. */
+ for (i = 0, f = x->x_vec; i < n; i++, f += 2)
+ {
+ pix[2*i] = glist_xtopixels(glist,
+ basex + fielddesc_getcoord(f, template, data, 1));
+ pix[2*i+1] = glist_ytopixels(glist,
+ basey + fielddesc_getcoord(f+1, template, data, 1));
+ }
+ if (width < 1) width = 1;
+ numbertocolor(
+ fielddesc_getfloat(&x->x_outlinecolor, template, data, 1),
+ outline);
+ if (flags & CLOSED)
+ {
+ numbertocolor(
+ fielddesc_getfloat(&x->x_fillcolor, template, data, 1),
+ fill);
+ sys_vgui(".x%lx.c create polygon\\\n",
+ glist_getcanvas(glist));
+ }
+ else sys_vgui(".x%lx.c create line\\\n", glist_getcanvas(glist));
+ for (i = 0; i < n; i++)
+ sys_vgui("%d %d\\\n", pix[2*i], pix[2*i+1]);
+ sys_vgui("-width %f\\\n", width);
+ if (flags & CLOSED) sys_vgui("-fill %s -outline %s\\\n",
+ fill, outline);
+ else sys_vgui("-fill %s\\\n", outline);
+ if (flags & BEZ) sys_vgui("-smooth 1\\\n");
+ sys_vgui("-tags curve%lx\n", data);
+ }
+ else post("warning: curves need at least two points to be graphed");
+ }
+ else
+ {
+ if (n > 1) sys_vgui(".x%lx.c delete curve%lx\n",
+ glist_getcanvas(glist), data);
+ }
+}
+
+static int curve_motion_field;
+static float curve_motion_xcumulative;
+static float curve_motion_xbase;
+static float curve_motion_xper;
+static float curve_motion_ycumulative;
+static float curve_motion_ybase;
+static float curve_motion_yper;
+static t_glist *curve_motion_glist;
+static t_scalar *curve_motion_scalar;
+static t_array *curve_motion_array;
+static t_word *curve_motion_wp;
+static t_template *curve_motion_template;
+static t_gpointer curve_motion_gpointer;
+
+ /* LATER protect against the template changing or the scalar disappearing
+ probably by attaching a gpointer here ... */
+
+static void curve_motion(void *z, t_floatarg dx, t_floatarg dy)
+{
+ t_curve *x = (t_curve *)z;
+ t_fielddesc *f = x->x_vec + curve_motion_field;
+ t_atom at;
+ if (!gpointer_check(&curve_motion_gpointer, 0))
+ {
+ post("curve_motion: scalar disappeared");
+ return;
+ }
+ curve_motion_xcumulative += dx;
+ curve_motion_ycumulative += dy;
+ if (f->fd_var && (dx != 0))
+ {
+ fielddesc_setcoord(f, curve_motion_template, curve_motion_wp,
+ curve_motion_xbase + curve_motion_xcumulative * curve_motion_xper,
+ 1);
+ }
+ if ((f+1)->fd_var && (dy != 0))
+ {
+ fielddesc_setcoord(f+1, curve_motion_template, curve_motion_wp,
+ curve_motion_ybase + curve_motion_ycumulative * curve_motion_yper,
+ 1);
+ }
+ /* LATER figure out what to do to notify for an array? */
+ if (curve_motion_scalar)
+ template_notifyforscalar(curve_motion_template, curve_motion_glist,
+ curve_motion_scalar, gensym("change"), 1, &at);
+ if (curve_motion_scalar)
+ scalar_redraw(curve_motion_scalar, curve_motion_glist);
+ if (curve_motion_array)
+ array_redraw(curve_motion_array, curve_motion_glist);
+}
+
+static int curve_click(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, t_scalar *sc, t_array *ap,
+ float basex, float basey,
+ int xpix, int ypix, int shift, int alt, int dbl, int doit)
+{
+ t_curve *x = (t_curve *)z;
+ int i, n = x->x_npoints;
+ int bestn = -1;
+ int besterror = 0x7fffffff;
+ t_fielddesc *f;
+ if (!fielddesc_getfloat(&x->x_vis, template, data, 0))
+ return (0);
+ for (i = 0, f = x->x_vec; i < n; i++, f += 2)
+ {
+ int xval = fielddesc_getcoord(f, template, data, 0),
+ xloc = glist_xtopixels(glist, basex + xval);
+ int yval = fielddesc_getcoord(f+1, template, data, 0),
+ yloc = glist_ytopixels(glist, basey + yval);
+ int xerr = xloc - xpix, yerr = yloc - ypix;
+ if (!f->fd_var && !(f+1)->fd_var)
+ continue;
+ if (xerr < 0)
+ xerr = -xerr;
+ if (yerr < 0)
+ yerr = -yerr;
+ if (yerr > xerr)
+ xerr = yerr;
+ if (xerr < besterror)
+ {
+ curve_motion_xbase = xval;
+ curve_motion_ybase = yval;
+ besterror = xerr;
+ bestn = i;
+ }
+ }
+ if (besterror > 6)
+ return (0);
+ if (doit)
+ {
+ curve_motion_xper = glist_pixelstox(glist, 1)
+ - glist_pixelstox(glist, 0);
+ curve_motion_yper = glist_pixelstoy(glist, 1)
+ - glist_pixelstoy(glist, 0);
+ curve_motion_xcumulative = 0;
+ curve_motion_ycumulative = 0;
+ curve_motion_glist = glist;
+ curve_motion_scalar = sc;
+ curve_motion_array = ap;
+ curve_motion_wp = data;
+ curve_motion_field = 2*bestn;
+ curve_motion_template = template;
+ if (curve_motion_scalar)
+ gpointer_setglist(&curve_motion_gpointer, curve_motion_glist,
+ curve_motion_scalar);
+ else gpointer_setarray(&curve_motion_gpointer,
+ curve_motion_array, curve_motion_wp);
+ glist_grab(glist, z, curve_motion, 0, xpix, ypix);
+ }
+ return (1);
+}
+
+t_parentwidgetbehavior curve_widgetbehavior =
+{
+ curve_getrect,
+ curve_displace,
+ curve_select,
+ curve_activate,
+ curve_vis,
+ curve_click,
+};
+
+static void curve_free(t_curve *x)
+{
+ t_freebytes(x->x_vec, 2 * x->x_npoints * sizeof(*x->x_vec));
+}
+
+static void curve_setup(void)
+{
+ curve_class = class_new(gensym("drawpolygon"), (t_newmethod)curve_new,
+ (t_method)curve_free, sizeof(t_curve), 0, A_GIMME, 0);
+ class_setdrawcommand(curve_class);
+ class_addcreator((t_newmethod)curve_new, gensym("drawcurve"),
+ A_GIMME, 0);
+ class_addcreator((t_newmethod)curve_new, gensym("filledpolygon"),
+ A_GIMME, 0);
+ class_addcreator((t_newmethod)curve_new, gensym("filledcurve"),
+ A_GIMME, 0);
+ class_setparentwidget(curve_class, &curve_widgetbehavior);
+ class_addfloat(curve_class, curve_float);
+}
+
+/* --------- plots for showing arrays --------------- */
+
+t_class *plot_class;
+
+typedef struct _plot
+{
+ t_object x_obj;
+ t_canvas *x_canvas;
+ t_fielddesc x_outlinecolor;
+ t_fielddesc x_width;
+ t_fielddesc x_xloc;
+ t_fielddesc x_yloc;
+ t_fielddesc x_xinc;
+ t_fielddesc x_style;
+ t_fielddesc x_data;
+ t_fielddesc x_xpoints;
+ t_fielddesc x_ypoints;
+ t_fielddesc x_wpoints;
+ t_fielddesc x_vis; /* visible */
+ t_fielddesc x_scalarvis; /* true if drawing the scalar at each point */
+} t_plot;
+
+static void *plot_new(t_symbol *classsym, t_int argc, t_atom *argv)
+{
+ t_plot *x = (t_plot *)pd_new(plot_class);
+ int defstyle = PLOTSTYLE_POLY;
+ x->x_canvas = canvas_getcurrent();
+
+ fielddesc_setfloat_var(&x->x_xpoints, gensym("x"));
+ fielddesc_setfloat_var(&x->x_ypoints, gensym("y"));
+ fielddesc_setfloat_var(&x->x_wpoints, gensym("w"));
+
+ fielddesc_setfloat_const(&x->x_vis, 1);
+ fielddesc_setfloat_const(&x->x_scalarvis, 1);
+ while (1)
+ {
+ t_symbol *firstarg = atom_getsymbolarg(0, argc, argv);
+ if (!strcmp(firstarg->s_name, "curve") ||
+ !strcmp(firstarg->s_name, "-c"))
+ {
+ defstyle = PLOTSTYLE_BEZ;
+ argc--, argv++;
+ }
+ else if (!strcmp(firstarg->s_name, "-v") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_vis, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(firstarg->s_name, "-vs") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_scalarvis, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(firstarg->s_name, "-x") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_xpoints, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(firstarg->s_name, "-y") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_ypoints, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(firstarg->s_name, "-w") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_wpoints, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else break;
+ }
+ if (argc) fielddesc_setarrayarg(&x->x_data, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_data, 1);
+ if (argc) fielddesc_setfloatarg(&x->x_outlinecolor, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_outlinecolor, 0);
+ if (argc) fielddesc_setfloatarg(&x->x_width, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_width, 1);
+ if (argc) fielddesc_setfloatarg(&x->x_xloc, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_xloc, 1);
+ if (argc) fielddesc_setfloatarg(&x->x_yloc, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_yloc, 1);
+ if (argc) fielddesc_setfloatarg(&x->x_xinc, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_xinc, 1);
+ if (argc) fielddesc_setfloatarg(&x->x_style, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_style, defstyle);
+ return (x);
+}
+
+void plot_float(t_plot *x, t_floatarg f)
+{
+ int viswas;
+ if (x->x_vis.fd_type != A_FLOAT || x->x_vis.fd_var)
+ {
+ pd_error(x, "global vis/invis for a template with variable visibility");
+ return;
+ }
+ viswas = (x->x_vis.fd_un.fd_float != 0);
+
+ if ((f != 0 && viswas) || (f == 0 && !viswas))
+ return;
+ canvas_redrawallfortemplatecanvas(x->x_canvas, 2);
+ fielddesc_setfloat_const(&x->x_vis, (f != 0));
+ canvas_redrawallfortemplatecanvas(x->x_canvas, 1);
+}
+
+/* -------------------- widget behavior for plot ------------ */
+
+
+ /* get everything we'll need from the owner template of the array being
+ plotted. Not used for garrays, but see below */
+static int plot_readownertemplate(t_plot *x,
+ t_word *data, t_template *ownertemplate,
+ t_symbol **elemtemplatesymp, t_array **arrayp,
+ float *linewidthp, float *xlocp, float *xincp, float *ylocp, float *stylep,
+ float *visp, float *scalarvisp,
+ t_fielddesc **xfield, t_fielddesc **yfield, t_fielddesc **wfield)
+{
+ int arrayonset, type;
+ t_symbol *elemtemplatesym;
+ t_array *array;
+
+ /* find the data and verify it's an array */
+ if (x->x_data.fd_type != A_ARRAY || !x->x_data.fd_var)
+ {
+ error("plot: needs an array field");
+ return (-1);
+ }
+ if (!template_find_field(ownertemplate, x->x_data.fd_un.fd_varsym,
+ &arrayonset, &type, &elemtemplatesym))
+ {
+ error("plot: %s: no such field", x->x_data.fd_un.fd_varsym->s_name);
+ return (-1);
+ }
+ if (type != DT_ARRAY)
+ {
+ error("plot: %s: not an array", x->x_data.fd_un.fd_varsym->s_name);
+ return (-1);
+ }
+ array = *(t_array **)(((char *)data) + arrayonset);
+ *linewidthp = fielddesc_getfloat(&x->x_width, ownertemplate, data, 1);
+ *xlocp = fielddesc_getfloat(&x->x_xloc, ownertemplate, data, 1);
+ *xincp = fielddesc_getfloat(&x->x_xinc, ownertemplate, data, 1);
+ *ylocp = fielddesc_getfloat(&x->x_yloc, ownertemplate, data, 1);
+ *stylep = fielddesc_getfloat(&x->x_style, ownertemplate, data, 1);
+ *visp = fielddesc_getfloat(&x->x_vis, ownertemplate, data, 1);
+ *scalarvisp = fielddesc_getfloat(&x->x_scalarvis, ownertemplate, data, 1);
+ *elemtemplatesymp = elemtemplatesym;
+ *arrayp = array;
+ *xfield = &x->x_xpoints;
+ *yfield = &x->x_ypoints;
+ *wfield = &x->x_wpoints;
+ return (0);
+}
+
+ /* get everything else you could possibly need about a plot,
+ either for plot's own purposes or for plotting a "garray" */
+int array_getfields(t_symbol *elemtemplatesym,
+ t_canvas **elemtemplatecanvasp,
+ t_template **elemtemplatep, int *elemsizep,
+ t_fielddesc *xfielddesc, t_fielddesc *yfielddesc, t_fielddesc *wfielddesc,
+ int *xonsetp, int *yonsetp, int *wonsetp)
+{
+ int arrayonset, elemsize, yonset, wonset, xonset, type;
+ t_template *elemtemplate;
+ t_symbol *dummy, *varname;
+ t_canvas *elemtemplatecanvas = 0;
+
+ /* the "float" template is special in not having to have a canvas;
+ template_findbyname is hardwired to return a predefined
+ template. */
+
+ if (!(elemtemplate = template_findbyname(elemtemplatesym)))
+ {
+ error("plot: %s: no such template", elemtemplatesym->s_name);
+ return (-1);
+ }
+ if (!((elemtemplatesym == &s_float) ||
+ (elemtemplatecanvas = template_findcanvas(elemtemplate))))
+ {
+ error("plot: %s: no canvas for this template", elemtemplatesym->s_name);
+ return (-1);
+ }
+ elemsize = elemtemplate->t_n * sizeof(t_word);
+ if (yfielddesc && yfielddesc->fd_var)
+ varname = yfielddesc->fd_un.fd_varsym;
+ else varname = gensym("y");
+ if (!template_find_field(elemtemplate, varname, &yonset, &type, &dummy)
+ || type != DT_FLOAT)
+ yonset = -1;
+ if (xfielddesc && xfielddesc->fd_var)
+ varname = xfielddesc->fd_un.fd_varsym;
+ else varname = gensym("x");
+ if (!template_find_field(elemtemplate, varname, &xonset, &type, &dummy)
+ || type != DT_FLOAT)
+ xonset = -1;
+ if (wfielddesc && wfielddesc->fd_var)
+ varname = wfielddesc->fd_un.fd_varsym;
+ else varname = gensym("w");
+ if (!template_find_field(elemtemplate, varname, &wonset, &type, &dummy)
+ || type != DT_FLOAT)
+ wonset = -1;
+
+ /* fill in slots for return values */
+ *elemtemplatecanvasp = elemtemplatecanvas;
+ *elemtemplatep = elemtemplate;
+ *elemsizep = elemsize;
+ *xonsetp = xonset;
+ *yonsetp = yonset;
+ *wonsetp = wonset;
+ return (0);
+}
+
+static void plot_getrect(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int *xp1, int *yp1, int *xp2, int *yp2)
+{
+ t_plot *x = (t_plot *)z;
+ int elemsize, yonset, wonset, xonset;
+ t_canvas *elemtemplatecanvas;
+ t_template *elemtemplate;
+ t_symbol *elemtemplatesym;
+ float linewidth, xloc, xinc, yloc, style, xsum, yval, vis, scalarvis;
+ t_array *array;
+ int x1 = 0x7fffffff, y1 = 0x7fffffff, x2 = -0x7fffffff, y2 = -0x7fffffff;
+ int i;
+ float xpix, ypix, wpix;
+ t_fielddesc *xfielddesc, *yfielddesc, *wfielddesc;
+ if (!plot_readownertemplate(x, data, template,
+ &elemtemplatesym, &array, &linewidth, &xloc, &xinc, &yloc, &style,
+ &vis, &scalarvis, &xfielddesc, &yfielddesc, &wfielddesc) &&
+ (vis != 0) &&
+ !array_getfields(elemtemplatesym, &elemtemplatecanvas,
+ &elemtemplate, &elemsize,
+ xfielddesc, yfielddesc, wfielddesc,
+ &xonset, &yonset, &wonset))
+ {
+ /* if it has more than 2000 points, just check 1000 of them. */
+ int incr = (array->a_n <= 2000 ? 1 : array->a_n / 1000);
+ for (i = 0, xsum = 0; i < array->a_n; i += incr)
+ {
+ float usexloc, useyloc;
+ t_gobj *y;
+ /* get the coords of the point proper */
+ array_getcoordinate(glist, (char *)(array->a_vec) + i * elemsize,
+ xonset, yonset, wonset, i, basex + xloc, basey + yloc, xinc,
+ xfielddesc, yfielddesc, wfielddesc, &xpix, &ypix, &wpix);
+ if (xpix < x1)
+ x1 = xpix;
+ if (xpix > x2)
+ x2 = xpix;
+ if (ypix - wpix < y1)
+ y1 = ypix - wpix;
+ if (ypix + wpix > y2)
+ y2 = ypix + wpix;
+
+ if (scalarvis != 0)
+ {
+ /* check also the drawing instructions for the scalar */
+ if (xonset >= 0)
+ usexloc = basex + xloc + fielddesc_cvttocoord(xfielddesc,
+ *(float *)(((char *)(array->a_vec) + elemsize * i)
+ + xonset));
+ else usexloc = basex + xsum, xsum += xinc;
+ if (yonset >= 0)
+ yval = *(float *)(((char *)(array->a_vec) + elemsize * i)
+ + yonset);
+ else yval = 0;
+ useyloc = basey + yloc + fielddesc_cvttocoord(yfielddesc, yval);
+ for (y = elemtemplatecanvas->gl_list; y; y = y->g_next)
+ {
+ int xx1, xx2, yy1, yy2;
+ t_parentwidgetbehavior *wb = pd_getparentwidget(&y->g_pd);
+ if (!wb) continue;
+ (*wb->w_parentgetrectfn)(y, glist,
+ (t_word *)((char *)(array->a_vec) + elemsize * i),
+ elemtemplate, usexloc, useyloc,
+ &xx1, &yy1, &xx2, &yy2);
+ if (xx1 < x1)
+ x1 = xx1;
+ if (yy1 < y1)
+ y1 = yy1;
+ if (xx2 > x2)
+ x2 = xx2;
+ if (yy2 > y2)
+ y2 = yy2;
+ }
+ }
+ }
+ }
+
+ *xp1 = x1;
+ *yp1 = y1;
+ *xp2 = x2;
+ *yp2 = y2;
+}
+
+static void plot_displace(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int dx, int dy)
+{
+ /* not yet */
+}
+
+static void plot_select(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int state)
+{
+ /* not yet */
+}
+
+static void plot_activate(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int state)
+{
+ /* not yet */
+}
+
+static void plot_vis(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int tovis)
+{
+ t_plot *x = (t_plot *)z;
+ int elemsize, yonset, wonset, xonset, i;
+ t_canvas *elemtemplatecanvas;
+ t_template *elemtemplate;
+ t_symbol *elemtemplatesym;
+ float linewidth, xloc, xinc, yloc, style, usexloc, xsum, yval, vis,
+ scalarvis;
+ t_array *array;
+ int nelem;
+ char *elem;
+ t_fielddesc *xfielddesc, *yfielddesc, *wfielddesc;
+ /* even if the array is "invisible", if its visibility is
+ set by an instance variable you have to explicitly erase it,
+ because the flag could earlier have been on when we were getting
+ drawn. Rather than look to try to find out whether we're
+ visible we just do the erasure. At the TK level this should
+ cause no action because the tag matches nobody. LATER we
+ might want to optimize this somehow. Ditto the "vis()" routines
+ for other drawing instructions. */
+
+ if (plot_readownertemplate(x, data, template,
+ &elemtemplatesym, &array, &linewidth, &xloc, &xinc, &yloc, &style,
+ &vis, &scalarvis, &xfielddesc, &yfielddesc, &wfielddesc) ||
+ ((vis == 0) && tovis) /* see above for 'tovis' */
+ || array_getfields(elemtemplatesym, &elemtemplatecanvas,
+ &elemtemplate, &elemsize, xfielddesc, yfielddesc, wfielddesc,
+ &xonset, &yonset, &wonset))
+ return;
+ nelem = array->a_n;
+ elem = (char *)array->a_vec;
+
+ if (tovis)
+ {
+ if (style == PLOTSTYLE_POINTS)
+ {
+ float minyval = 1e20, maxyval = -1e20;
+ int ndrawn = 0;
+ for (xsum = basex + xloc, i = 0; i < nelem; i++)
+ {
+ float yval, xpix, ypix, nextxloc;
+ int ixpix, inextx;
+
+ if (xonset >= 0)
+ {
+ usexloc = basex + xloc +
+ *(float *)((elem + elemsize * i) + xonset);
+ ixpix = glist_xtopixels(glist,
+ fielddesc_cvttocoord(xfielddesc, usexloc));
+ inextx = ixpix + 2;
+ }
+ else
+ {
+ usexloc = xsum;
+ xsum += xinc;
+ ixpix = glist_xtopixels(glist,
+ fielddesc_cvttocoord(xfielddesc, usexloc));
+ inextx = glist_xtopixels(glist,
+ fielddesc_cvttocoord(xfielddesc, xsum));
+ }
+
+ if (yonset >= 0)
+ yval = yloc + *(float *)((elem + elemsize * i) + yonset);
+ else yval = 0;
+ if (yval > maxyval)
+ maxyval = yval;
+ if (yval < minyval)
+ minyval = yval;
+ if (i == nelem-1 || inextx != ixpix)
+ {
+ sys_vgui(
+".x%lx.c create rectangle %d %d %d %d -fill black -width 0 -tags plot%lx\n",
+ glist_getcanvas(glist),
+ ixpix, (int)glist_ytopixels(glist,
+ basey + fielddesc_cvttocoord(yfielddesc, minyval)),
+ inextx, (int)(glist_ytopixels(glist,
+ basey + fielddesc_cvttocoord(yfielddesc, maxyval))
+ + linewidth), data);
+ ndrawn++;
+ minyval = 1e20;
+ maxyval = -1e20;
+ }
+ if (ndrawn > 2000 || ixpix >= 3000) break;
+ }
+ }
+ else
+ {
+ char outline[20];
+ int lastpixel = -1, ndrawn = 0;
+ float yval = 0, wval = 0, xpix;
+ int ixpix = 0;
+ /* draw the trace */
+ numbertocolor(fielddesc_getfloat(&x->x_outlinecolor, template,
+ data, 1), outline);
+ if (wonset >= 0)
+ {
+ /* found "w" field which controls linewidth. The trace is
+ a filled polygon with 2n points. */
+ sys_vgui(".x%lx.c create polygon \\\n",
+ glist_getcanvas(glist));
+
+ for (i = 0, xsum = xloc; i < nelem; i++)
+ {
+ if (xonset >= 0)
+ usexloc = xloc + *(float *)((elem + elemsize * i)
+ + xonset);
+ else usexloc = xsum, xsum += xinc;
+ if (yonset >= 0)
+ yval = *(float *)((elem + elemsize * i) + yonset);
+ else yval = 0;
+ wval = *(float *)((elem + elemsize * i) + wonset);
+ xpix = glist_xtopixels(glist,
+ basex + fielddesc_cvttocoord(xfielddesc, usexloc));
+ ixpix = xpix + 0.5;
+ if (xonset >= 0 || ixpix != lastpixel)
+ {
+ sys_vgui("%d %f \\\n", ixpix,
+ glist_ytopixels(glist,
+ basey + fielddesc_cvttocoord(yfielddesc,
+ yloc + yval) -
+ fielddesc_cvttocoord(wfielddesc,wval)));
+ ndrawn++;
+ }
+ lastpixel = ixpix;
+ if (ndrawn >= 1000) goto ouch;
+ }
+ lastpixel = -1;
+ for (i = nelem-1; i >= 0; i--)
+ {
+ float usexloc;
+ if (xonset >= 0)
+ usexloc = xloc + *(float *)((elem + elemsize * i)
+ + xonset);
+ else xsum -= xinc, usexloc = xsum;
+ if (yonset >= 0)
+ yval = *(float *)((elem + elemsize * i) + yonset);
+ else yval = 0;
+ wval = *(float *)((elem + elemsize * i) + wonset);
+ xpix = glist_xtopixels(glist,
+ basex + fielddesc_cvttocoord(xfielddesc, usexloc));
+ ixpix = xpix + 0.5;
+ if (xonset >= 0 || ixpix != lastpixel)
+ {
+ sys_vgui("%d %f \\\n", ixpix, glist_ytopixels(glist,
+ basey + yloc + fielddesc_cvttocoord(yfielddesc,
+ yval) +
+ fielddesc_cvttocoord(wfielddesc, wval)));
+ ndrawn++;
+ }
+ lastpixel = ixpix;
+ if (ndrawn >= 1000) goto ouch;
+ }
+ /* TK will complain if there aren't at least 3 points.
+ There should be at least two already. */
+ if (ndrawn < 4)
+ {
+ sys_vgui("%d %f \\\n", ixpix + 10, glist_ytopixels(glist,
+ basey + yloc + fielddesc_cvttocoord(yfielddesc,
+ yval) +
+ fielddesc_cvttocoord(wfielddesc, wval)));
+ sys_vgui("%d %f \\\n", ixpix + 10, glist_ytopixels(glist,
+ basey + yloc + fielddesc_cvttocoord(yfielddesc,
+ yval) -
+ fielddesc_cvttocoord(wfielddesc, wval)));
+ }
+ ouch:
+ sys_vgui(" -width 1 -fill %s -outline %s\\\n",
+ outline, outline);
+ if (style == PLOTSTYLE_BEZ) sys_vgui("-smooth 1\\\n");
+
+ sys_vgui("-tags plot%lx\n", data);
+ }
+ else if (linewidth > 0)
+ {
+ /* no "w" field. If the linewidth is positive, draw a
+ segmented line with the requested width; otherwise don't
+ draw the trace at all. */
+ sys_vgui(".x%lx.c create line \\\n", glist_getcanvas(glist));
+
+ for (xsum = xloc, i = 0; i < nelem; i++)
+ {
+ float usexloc;
+ if (xonset >= 0)
+ usexloc = xloc + *(float *)((elem + elemsize * i) +
+ xonset);
+ else usexloc = xsum, xsum += xinc;
+ if (yonset >= 0)
+ yval = *(float *)((elem + elemsize * i) + yonset);
+ else yval = 0;
+ xpix = glist_xtopixels(glist,
+ basex + fielddesc_cvttocoord(xfielddesc, usexloc));
+ ixpix = xpix + 0.5;
+ if (xonset >= 0 || ixpix != lastpixel)
+ {
+ sys_vgui("%d %f \\\n", ixpix,
+ glist_ytopixels(glist,
+ basey + yloc + fielddesc_cvttocoord(yfielddesc,
+ yval)));
+ ndrawn++;
+ }
+ lastpixel = ixpix;
+ if (ndrawn >= 1000) break;
+ }
+ /* TK will complain if there aren't at least 2 points... */
+ if (ndrawn == 0) sys_vgui("0 0 0 0 \\\n");
+ else if (ndrawn == 1) sys_vgui("%d %f \\\n", ixpix + 10,
+ glist_ytopixels(glist, basey + yloc +
+ fielddesc_cvttocoord(yfielddesc, yval)));
+
+ sys_vgui("-width %f\\\n", linewidth);
+ sys_vgui("-fill %s\\\n", outline);
+ if (style == PLOTSTYLE_BEZ) sys_vgui("-smooth 1\\\n");
+
+ sys_vgui("-tags plot%lx\n", data);
+ }
+ }
+ /* We're done with the outline; now draw all the points.
+ This code is inefficient since the template has to be
+ searched for drawing instructions for every last point. */
+ if (scalarvis != 0)
+ {
+ for (xsum = xloc, i = 0; i < nelem; i++)
+ {
+ float usexloc, useyloc;
+ t_gobj *y;
+ if (xonset >= 0)
+ usexloc = basex + xloc +
+ *(float *)((elem + elemsize * i) + xonset);
+ else usexloc = basex + xsum, xsum += xinc;
+ if (yonset >= 0)
+ yval = *(float *)((elem + elemsize * i) + yonset);
+ else yval = 0;
+ useyloc = basey + yloc +
+ fielddesc_cvttocoord(yfielddesc, yval);
+ for (y = elemtemplatecanvas->gl_list; y; y = y->g_next)
+ {
+ t_parentwidgetbehavior *wb = pd_getparentwidget(&y->g_pd);
+ if (!wb) continue;
+ (*wb->w_parentvisfn)(y, glist,
+ (t_word *)(elem + elemsize * i),
+ elemtemplate, usexloc, useyloc, tovis);
+ }
+ }
+ }
+ }
+ else
+ {
+ /* un-draw the individual points */
+ if (scalarvis != 0)
+ {
+ int i;
+ for (i = 0; i < nelem; i++)
+ {
+ t_gobj *y;
+ for (y = elemtemplatecanvas->gl_list; y; y = y->g_next)
+ {
+ t_parentwidgetbehavior *wb = pd_getparentwidget(&y->g_pd);
+ if (!wb) continue;
+ (*wb->w_parentvisfn)(y, glist,
+ (t_word *)(elem + elemsize * i), elemtemplate,
+ 0, 0, 0);
+ }
+ }
+ }
+ /* and then the trace */
+ sys_vgui(".x%lx.c delete plot%lx\n",
+ glist_getcanvas(glist), data);
+ }
+}
+
+static int plot_click(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, t_scalar *sc, t_array *ap,
+ float basex, float basey,
+ int xpix, int ypix, int shift, int alt, int dbl, int doit)
+{
+ t_plot *x = (t_plot *)z;
+ t_symbol *elemtemplatesym;
+ float linewidth, xloc, xinc, yloc, style, vis, scalarvis;
+ t_array *array;
+ t_fielddesc *xfielddesc, *yfielddesc, *wfielddesc;
+
+ if (!plot_readownertemplate(x, data, template,
+ &elemtemplatesym, &array, &linewidth, &xloc, &xinc, &yloc, &style,
+ &vis, &scalarvis,
+ &xfielddesc, &yfielddesc, &wfielddesc) && (vis != 0))
+ {
+ return (array_doclick(array, glist, sc, ap,
+ elemtemplatesym,
+ linewidth, basex + xloc, xinc, basey + yloc, scalarvis,
+ xfielddesc, yfielddesc, wfielddesc,
+ xpix, ypix, shift, alt, dbl, doit));
+ }
+ else return (0);
+}
+
+t_parentwidgetbehavior plot_widgetbehavior =
+{
+ plot_getrect,
+ plot_displace,
+ plot_select,
+ plot_activate,
+ plot_vis,
+ plot_click,
+};
+
+static void plot_setup(void)
+{
+ plot_class = class_new(gensym("plot"), (t_newmethod)plot_new, 0,
+ sizeof(t_plot), 0, A_GIMME, 0);
+ class_setdrawcommand(plot_class);
+ class_addfloat(plot_class, plot_float);
+ class_setparentwidget(plot_class, &plot_widgetbehavior);
+}
+
+/* ---------------- drawnumber: draw a number (or symbol) ---------------- */
+
+/*
+ drawnumbers draw numeric fields at controllable locations, with
+ controllable color and label. invocation:
+ (drawnumber|drawsymbol) [-v <visible>] variable x y color label
+*/
+
+t_class *drawnumber_class;
+
+#define DRAW_SYMBOL 1
+
+typedef struct _drawnumber
+{
+ t_object x_obj;
+ t_fielddesc x_value;
+ t_fielddesc x_xloc;
+ t_fielddesc x_yloc;
+ t_fielddesc x_color;
+ t_fielddesc x_vis;
+ t_symbol *x_label;
+ int x_flags;
+ t_canvas *x_canvas;
+} t_drawnumber;
+
+static void *drawnumber_new(t_symbol *classsym, t_int argc, t_atom *argv)
+{
+ t_drawnumber *x = (t_drawnumber *)pd_new(drawnumber_class);
+ char *classname = classsym->s_name;
+ int flags = 0;
+
+ if (classname[4] == 's')
+ flags |= DRAW_SYMBOL;
+ x->x_flags = flags;
+ fielddesc_setfloat_const(&x->x_vis, 1);
+ x->x_canvas = canvas_getcurrent();
+ while (1)
+ {
+ t_symbol *firstarg = atom_getsymbolarg(0, argc, argv);
+ if (!strcmp(firstarg->s_name, "-v") && argc > 1)
+ {
+ fielddesc_setfloatarg(&x->x_vis, 1, argv+1);
+ argc -= 2; argv += 2;
+ }
+ else break;
+ }
+ if (flags & DRAW_SYMBOL)
+ {
+ if (argc) fielddesc_setsymbolarg(&x->x_value, argc--, argv++);
+ else fielddesc_setsymbol_const(&x->x_value, &s_);
+ }
+ else
+ {
+ if (argc) fielddesc_setfloatarg(&x->x_value, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_value, 0);
+ }
+ if (argc) fielddesc_setfloatarg(&x->x_xloc, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_xloc, 0);
+ if (argc) fielddesc_setfloatarg(&x->x_yloc, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_yloc, 0);
+ if (argc) fielddesc_setfloatarg(&x->x_color, argc--, argv++);
+ else fielddesc_setfloat_const(&x->x_color, 1);
+ if (argc)
+ x->x_label = atom_getsymbolarg(0, argc, argv);
+ else x->x_label = &s_;
+
+ return (x);
+}
+
+void drawnumber_float(t_drawnumber *x, t_floatarg f)
+{
+ int viswas;
+ if (x->x_vis.fd_type != A_FLOAT || x->x_vis.fd_var)
+ {
+ pd_error(x, "global vis/invis for a template with variable visibility");
+ return;
+ }
+ viswas = (x->x_vis.fd_un.fd_float != 0);
+
+ if ((f != 0 && viswas) || (f == 0 && !viswas))
+ return;
+ canvas_redrawallfortemplatecanvas(x->x_canvas, 2);
+ fielddesc_setfloat_const(&x->x_vis, (f != 0));
+ canvas_redrawallfortemplatecanvas(x->x_canvas, 1);
+}
+
+/* -------------------- widget behavior for drawnumber ------------ */
+
+#define DRAWNUMBER_BUFSIZE 80
+static void drawnumber_sprintf(t_drawnumber *x, char *buf, t_atom *ap)
+{
+ int nchars;
+ strncpy(buf, x->x_label->s_name, DRAWNUMBER_BUFSIZE);
+ buf[DRAWNUMBER_BUFSIZE - 1] = 0;
+ nchars = strlen(buf);
+ atom_string(ap, buf + nchars, DRAWNUMBER_BUFSIZE - nchars);
+}
+
+static void drawnumber_getrect(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int *xp1, int *yp1, int *xp2, int *yp2)
+{
+ t_drawnumber *x = (t_drawnumber *)z;
+ t_atom at;
+ int xloc, yloc, font, fontwidth, fontheight;
+ char buf[DRAWNUMBER_BUFSIZE];
+
+ if (!fielddesc_getfloat(&x->x_vis, template, data, 0))
+ {
+ *xp1 = *yp1 = 0x7fffffff;
+ *xp2 = *yp2 = -0x7fffffff;
+ return;
+ }
+ xloc = glist_xtopixels(glist,
+ basex + fielddesc_getcoord(&x->x_xloc, template, data, 0));
+ yloc = glist_ytopixels(glist,
+ basey + fielddesc_getcoord(&x->x_yloc, template, data, 0));
+ font = glist_getfont(glist);
+ fontwidth = sys_fontwidth(font);
+ fontheight = sys_fontheight(font);
+ if (x->x_flags & DRAW_SYMBOL)
+ SETSYMBOL(&at, fielddesc_getsymbol(&x->x_value, template, data, 0));
+ else SETFLOAT(&at, fielddesc_getfloat(&x->x_value, template, data, 0));
+ drawnumber_sprintf(x, buf, &at);
+ *xp1 = xloc;
+ *yp1 = yloc;
+ *xp2 = xloc + fontwidth * strlen(buf);
+ *yp2 = yloc + fontheight;
+}
+
+static void drawnumber_displace(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int dx, int dy)
+{
+ /* refuse */
+}
+
+static void drawnumber_select(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int state)
+{
+ post("drawnumber_select %d", state);
+ /* fill in later */
+}
+
+static void drawnumber_activate(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int state)
+{
+ post("drawnumber_activate %d", state);
+}
+
+static void drawnumber_vis(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, float basex, float basey,
+ int vis)
+{
+ t_drawnumber *x = (t_drawnumber *)z;
+
+ /* see comment in plot_vis() */
+ if (vis && !fielddesc_getfloat(&x->x_vis, template, data, 0))
+ return;
+ if (vis)
+ {
+ t_atom at;
+ int xloc = glist_xtopixels(glist,
+ basex + fielddesc_getcoord(&x->x_xloc, template, data, 0));
+ int yloc = glist_ytopixels(glist,
+ basey + fielddesc_getcoord(&x->x_yloc, template, data, 0));
+ char colorstring[20], buf[DRAWNUMBER_BUFSIZE];
+ numbertocolor(fielddesc_getfloat(&x->x_color, template, data, 1),
+ colorstring);
+ if (x->x_flags & DRAW_SYMBOL)
+ SETSYMBOL(&at, fielddesc_getsymbol(&x->x_value, template, data, 0));
+ else SETFLOAT(&at, fielddesc_getfloat(&x->x_value, template, data, 0));
+ drawnumber_sprintf(x, buf, &at);
+ sys_vgui(".x%lx.c create text %d %d -anchor nw -fill %s -text {%s}",
+ glist_getcanvas(glist), xloc, yloc, colorstring, buf);
+ sys_vgui(" -font -*-courier-bold--normal--%d-*",
+ sys_hostfontsize(glist_getfont(glist)));
+ sys_vgui(" -tags drawnumber%lx\n", data);
+ }
+ else sys_vgui(".x%lx.c delete drawnumber%lx\n", glist_getcanvas(glist), data);
+}
+
+static float drawnumber_motion_ycumulative;
+static t_glist *drawnumber_motion_glist;
+static t_scalar *drawnumber_motion_scalar;
+static t_array *drawnumber_motion_array;
+static t_word *drawnumber_motion_wp;
+static t_template *drawnumber_motion_template;
+static t_gpointer drawnumber_motion_gpointer;
+static int drawnumber_motion_symbol;
+static int drawnumber_motion_firstkey;
+
+ /* LATER protect against the template changing or the scalar disappearing
+ probably by attaching a gpointer here ... */
+
+static void drawnumber_motion(void *z, t_floatarg dx, t_floatarg dy)
+{
+ t_drawnumber *x = (t_drawnumber *)z;
+ t_fielddesc *f = &x->x_value;
+ t_atom at;
+ if (!gpointer_check(&drawnumber_motion_gpointer, 0))
+ {
+ post("drawnumber_motion: scalar disappeared");
+ return;
+ }
+ if (drawnumber_motion_symbol)
+ {
+ post("drawnumber_motion: symbol");
+ return;
+ }
+ drawnumber_motion_ycumulative -= dy;
+ template_setfloat(drawnumber_motion_template,
+ f->fd_un.fd_varsym,
+ drawnumber_motion_wp,
+ drawnumber_motion_ycumulative,
+ 1);
+ if (drawnumber_motion_scalar)
+ template_notifyforscalar(drawnumber_motion_template,
+ drawnumber_motion_glist, drawnumber_motion_scalar,
+ gensym("change"), 1, &at);
+
+ if (drawnumber_motion_scalar)
+ scalar_redraw(drawnumber_motion_scalar, drawnumber_motion_glist);
+ if (drawnumber_motion_array)
+ array_redraw(drawnumber_motion_array, drawnumber_motion_glist);
+}
+
+static void drawnumber_key(void *z, t_floatarg fkey)
+{
+ t_drawnumber *x = (t_drawnumber *)z;
+ t_fielddesc *f = &x->x_value;
+ int key = fkey;
+ char sbuf[MAXPDSTRING];
+ t_atom at;
+ if (!gpointer_check(&drawnumber_motion_gpointer, 0))
+ {
+ post("drawnumber_motion: scalar disappeared");
+ return;
+ }
+ if (key == 0)
+ return;
+ if (drawnumber_motion_symbol)
+ {
+ /* key entry for a symbol field */
+ if (drawnumber_motion_firstkey)
+ sbuf[0] = 0;
+ else strncpy(sbuf, template_getsymbol(drawnumber_motion_template,
+ f->fd_un.fd_varsym, drawnumber_motion_wp, 1)->s_name,
+ MAXPDSTRING);
+ sbuf[MAXPDSTRING-1] = 0;
+ if (key == '\b')
+ {
+ if (*sbuf)
+ sbuf[strlen(sbuf)-1] = 0;
+ }
+ else
+ {
+ sbuf[strlen(sbuf)+1] = 0;
+ sbuf[strlen(sbuf)] = key;
+ }
+ }
+ else
+ {
+ /* key entry for a numeric field. This is just a stopgap. */
+ float newf;
+ if (drawnumber_motion_firstkey)
+ sbuf[0] = 0;
+ else sprintf(sbuf, "%g", template_getfloat(drawnumber_motion_template,
+ f->fd_un.fd_varsym, drawnumber_motion_wp, 1));
+ drawnumber_motion_firstkey = (key == '\n');
+ if (key == '\b')
+ {
+ if (*sbuf)
+ sbuf[strlen(sbuf)-1] = 0;
+ }
+ else
+ {
+ sbuf[strlen(sbuf)+1] = 0;
+ sbuf[strlen(sbuf)] = key;
+ }
+ if (sscanf(sbuf, "%g", &newf) < 1)
+ newf = 0;
+ template_setfloat(drawnumber_motion_template,
+ f->fd_un.fd_varsym, drawnumber_motion_wp, newf, 1);
+ if (drawnumber_motion_scalar)
+ template_notifyforscalar(drawnumber_motion_template,
+ drawnumber_motion_glist, drawnumber_motion_scalar,
+ gensym("change"), 1, &at);
+ if (drawnumber_motion_scalar)
+ scalar_redraw(drawnumber_motion_scalar, drawnumber_motion_glist);
+ if (drawnumber_motion_array)
+ array_redraw(drawnumber_motion_array, drawnumber_motion_glist);
+ }
+}
+
+static int drawnumber_click(t_gobj *z, t_glist *glist,
+ t_word *data, t_template *template, t_scalar *sc, t_array *ap,
+ float basex, float basey,
+ int xpix, int ypix, int shift, int alt, int dbl, int doit)
+{
+ t_drawnumber *x = (t_drawnumber *)z;
+ int x1, y1, x2, y2;
+ drawnumber_getrect(z, glist,
+ data, template, basex, basey,
+ &x1, &y1, &x2, &y2);
+ if (xpix >= x1 && xpix <= x2 && ypix >= y1 && ypix <= y2
+ && x->x_value.fd_var &&
+ fielddesc_getfloat(&x->x_vis, template, data, 0))
+ {
+ if (doit)
+ {
+ drawnumber_motion_glist = glist;
+ drawnumber_motion_wp = data;
+ drawnumber_motion_template = template;
+ drawnumber_motion_scalar = sc;
+ drawnumber_motion_array = ap;
+ drawnumber_motion_firstkey = 1;
+ drawnumber_motion_ycumulative =
+ fielddesc_getfloat(&x->x_value, template, data, 0);
+ drawnumber_motion_symbol = ((x->x_flags & DRAW_SYMBOL) != 0);
+ if (drawnumber_motion_scalar)
+ gpointer_setglist(&drawnumber_motion_gpointer,
+ drawnumber_motion_glist, drawnumber_motion_scalar);
+ else gpointer_setarray(&drawnumber_motion_gpointer,
+ drawnumber_motion_array, drawnumber_motion_wp);
+ glist_grab(glist, z, drawnumber_motion, drawnumber_key,
+ xpix, ypix);
+ }
+ return (1);
+ }
+ else return (0);
+}
+
+t_parentwidgetbehavior drawnumber_widgetbehavior =
+{
+ drawnumber_getrect,
+ drawnumber_displace,
+ drawnumber_select,
+ drawnumber_activate,
+ drawnumber_vis,
+ drawnumber_click,
+};
+
+static void drawnumber_free(t_drawnumber *x)
+{
+}
+
+static void drawnumber_setup(void)
+{
+ drawnumber_class = class_new(gensym("drawnumber"),
+ (t_newmethod)drawnumber_new, (t_method)drawnumber_free,
+ sizeof(t_drawnumber), 0, A_GIMME, 0);
+ class_setdrawcommand(drawnumber_class);
+ class_addfloat(drawnumber_class, drawnumber_float);
+ class_addcreator((t_newmethod)drawnumber_new, gensym("drawsymbol"),
+ A_GIMME, 0);
+ class_setparentwidget(drawnumber_class, &drawnumber_widgetbehavior);
+}
+
+/* ---------------------- setup function ---------------------------- */
+
+void g_template_setup(void)
+{
+ template_setup();
+ gtemplate_setup();
+ curve_setup();
+ plot_setup();
+ drawnumber_setup();
+}
+
diff --git a/src/g_toggle.c b/src/g_toggle.c
index e36be5fac..c0c36f1ac 100644
--- a/src/g_toggle.c
+++ b/src/g_toggle.c
@@ -61,11 +61,12 @@ void toggle_draw_new(t_toggle *x, t_glist *glist)
canvas, xx+w+1, yy + x->x_gui.x_h-w-1, xx + x->x_gui.x_w-w, yy+w, w,
(x->x_on!=0.0)?x->x_gui.x_fcol:x->x_gui.x_bcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xx+x->x_gui.x_ldx,
yy+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
canvas, xx, yy + x->x_gui.x_h-1, xx + IOWIDTH, yy + x->x_gui.x_h, x, 0);
@@ -120,8 +121,8 @@ void toggle_draw_config(t_toggle* x, t_glist* glist)
{
t_canvas *canvas=glist_getcanvas(glist);
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
sys_vgui(".x%lx.c itemconfigure %lxBASE -fill #%6.6x\n", canvas, x,
@@ -225,7 +226,7 @@ static void toggle_properties(t_gobj *z, t_glist *owner)
t_symbol *srl[3];
iemgui_properties(&x->x_gui, srl);
- sprintf(buf, "pdtk_iemgui_dialog %%s TOGGLE \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |tgl| \
----------dimensions(pix):----------- %d %d size: 0 0 empty \
-----------non-zero-value:----------- %g value: 0.0 empty %g \
-1 lin log %d %d empty %d \
@@ -407,7 +408,7 @@ static void *toggle_new(t_symbol *s, int argc, t_atom *argv)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
x->x_nonzero = (nonzero!=0.0)?nonzero:1.0;
if(x->x_gui.x_isa.x_loadinit)
x->x_on = (on!=0.0)?nonzero:0.0;
diff --git a/src/g_vdial.c b/src/g_vdial.c
index 3d352b355..80c857f51 100644
--- a/src/g_vdial.c
+++ b/src/g_vdial.c
@@ -75,10 +75,10 @@ void vradio_draw_new(t_vradio *x, t_glist *glist)
x->x_drawn = x->x_on;
}
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xx11+x->x_gui.x_ldx, yy11b+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize,
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
@@ -141,8 +141,8 @@ void vradio_draw_config(t_vradio* x, t_glist* glist)
t_canvas *canvas=glist_getcanvas(glist);
int n=x->x_number, i;
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
for(i=0; i<n; i++)
@@ -265,7 +265,7 @@ static void vradio_properties(t_gobj *z, t_glist *owner)
iemgui_properties(&x->x_gui, srl);
if(pd_class(&x->x_gui.x_obj.ob_pd) == vradio_old_class)
hchange = x->x_change;
- sprintf(buf, "pdtk_iemgui_dialog %%s vradio \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |vradio| \
----------dimensions(pix):----------- %d %d size: 0 0 empty \
empty 0.0 empty 0.0 empty %d \
%d new-only new&old %d %d number: %d \
@@ -590,7 +590,7 @@ static void *vradio_donew(t_symbol *s, int argc, t_atom *argv, int old)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if(num < 1)
num = 1;
if(num > IEM_RADIO_MAX)
diff --git a/src/g_vslider.c b/src/g_vslider.c
index 1b575dac0..a5b9cc860 100644
--- a/src/g_vslider.c
+++ b/src/g_vslider.c
@@ -59,10 +59,11 @@ static void vslider_draw_new(t_vslider *x, t_glist *glist)
canvas, xpos+1, r,
xpos + x->x_gui.x_w, r, x->x_gui.x_fcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xpos+x->x_gui.x_ldx, ypos+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
canvas,
@@ -122,8 +123,8 @@ static void vslider_draw_config(t_vslider* x,t_glist* glist)
{
t_canvas *canvas=glist_getcanvas(glist);
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
sys_vgui(".x%lx.c itemconfigure %lxKNOB -fill #%6.6x\n", canvas,
@@ -277,7 +278,7 @@ static void vslider_properties(t_gobj *z, t_glist *owner)
iemgui_properties(&x->x_gui, srl);
- sprintf(buf, "pdtk_iemgui_dialog %%s VSLIDER \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |vsl| \
--------dimensions(pix)(pix):-------- %d %d width: %d %d height: \
-----------output-range:----------- %g bottom: %g top: %d \
%d lin log %d %d empty %d \
@@ -562,7 +563,7 @@ static void *vslider_new(t_symbol *s, int argc, t_atom *argv)
if(x->x_gui.x_fsf.x_font_style == 1) strcpy(x->x_gui.x_font, "helvetica");
else if(x->x_gui.x_fsf.x_font_style == 2) strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if(x->x_gui.x_fsf.x_rcv_able) pd_bind(&x->x_gui.x_obj.ob_pd, x->x_gui.x_rcv);
x->x_gui.x_ldx = ldx;
x->x_gui.x_ldy = ldy;
diff --git a/src/g_vumeter.c b/src/g_vumeter.c
index ac6ee0ae7..813e63c97 100644
--- a/src/g_vumeter.c
+++ b/src/g_vumeter.c
@@ -116,17 +116,19 @@ static void vu_draw_new(t_vu *x, t_glist *glist)
canvas, quad1, yyy, quad3, yyy, x->x_led_size, iemgui_color_hex[led_col], x, i);
if(((i+2)&3) && (x->x_scale))
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxSCALE%d\n",
- canvas, end, yyy+k3, iemgui_vu_scale_str[i], x->x_gui.x_font, x->x_gui.x_fontsize,
- x->x_gui.x_lcol, x, i);
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxSCALE%d\n",
+ canvas, end, yyy+k3, iemgui_vu_scale_str[i],
+ x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_fontweight, x->x_gui.x_lcol, x, i);
}
if(x->x_scale)
{
i=IEM_VU_STEPS+1;
yyy = k4 + k1*(k2-i);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxSCALE%d\n",
- canvas, end, yyy+k3, iemgui_vu_scale_str[i], x->x_gui.x_font, x->x_gui.x_fontsize,
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxSCALE%d\n",
+ canvas, end, yyy+k3, iemgui_vu_scale_str[i], x->x_gui.x_font,
+ x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_lcol, x, i);
}
sys_vgui(".x%lx.c create rectangle %d %d %d %d -fill #%6.6x -outline #%6.6x -tags %lxRCOVER\n",
@@ -136,10 +138,11 @@ static void vu_draw_new(t_vu *x, t_glist *glist)
canvas, mid, ypos+10,
mid, ypos+10, x->x_led_size, x->x_gui.x_bcol, x);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxLABEL\n",
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxLABEL\n",
canvas, xpos+x->x_gui.x_ldx, ypos+x->x_gui.x_ldy,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"",
- x->x_gui.x_font, x->x_gui.x_fontsize, x->x_gui.x_lcol, x);
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ x->x_gui.x_lcol, x);
if(!x->x_gui.x_fsf.x_snd_able)
{
sys_vgui(".x%lx.c create rectangle %d %d %d %d -tags %lxOUT%d\n",
@@ -274,19 +277,21 @@ static void vu_draw_config(t_vu* x, t_glist* glist)
sys_vgui(".x%lx.c itemconfigure %lxRLED%d -width %d\n", canvas, x, i,
x->x_led_size);
if(((i+2)&3) && (x->x_scale))
- sys_vgui(".x%lx.c itemconfigure %lxSCALE%d -text {%s} -font {%s %d bold} -fill #%6.6x\n",
- canvas, x, i, iemgui_vu_scale_str[i], x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxSCALE%d -text {%s} -font {{%s} %d %s} -fill #%6.6x\n",
+ canvas, x, i, iemgui_vu_scale_str[i], x->x_gui.x_font,
+ x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol);
}
if(x->x_scale)
{
i=IEM_VU_STEPS+1;
- sys_vgui(".x%lx.c itemconfigure %lxSCALE%d -text {%s} -font {%s %d bold} -fill #%6.6x\n",
- canvas, x, i, iemgui_vu_scale_str[i], x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxSCALE%d -text {%s} -font {{%s} %d %s} -fill #%6.6x\n",
+ canvas, x, i, iemgui_vu_scale_str[i], x->x_gui.x_font,
+ x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol);
}
- sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {%s %d bold} -fill #%6.6x -text {%s} \n",
- canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_vgui(".x%lx.c itemconfigure %lxLABEL -font {{%s} %d %s} -fill #%6.6x -text {%s} \n",
+ canvas, x, x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
x->x_gui.x_fsf.x_selected?IEM_GUI_COLOR_SELECTED:x->x_gui.x_lcol,
strcmp(x->x_gui.x_lab->s_name, "empty")?x->x_gui.x_lab->s_name:"");
@@ -476,16 +481,18 @@ static void vu_scale(t_vu *x, t_floatarg fscale)
yyy = k4 + k1*(k2-i);
if((i+2)&3)
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxSCALE%d\n",
- canvas, end, yyy+k3, iemgui_vu_scale_str[i], x->x_gui.x_font, x->x_gui.x_fontsize,
- x->x_gui.x_lcol, x, i);
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxSCALE%d\n",
+ canvas, end, yyy+k3, iemgui_vu_scale_str[i],
+ x->x_gui.x_font, x->x_gui.x_fontsize,
+ sys_fontweight, x->x_gui.x_lcol, x, i);
}
i=IEM_VU_STEPS+1;
yyy = k4 + k1*(k2-i);
sys_vgui(".x%lx.c create text %d %d -text {%s} -anchor w \
- -font {%s %d bold} -fill #%6.6x -tags %lxSCALE%d\n",
- canvas, end, yyy+k3, iemgui_vu_scale_str[i], x->x_gui.x_font, x->x_gui.x_fontsize,
- x->x_gui.x_lcol, x, i);
+ -font {{%s} %d %s} -fill #%6.6x -tags %lxSCALE%d\n",
+ canvas, end, yyy+k3, iemgui_vu_scale_str[i],
+ x->x_gui.x_font, x->x_gui.x_fontsize, sys_fontweight,
+ sys_fontweight, x->x_gui.x_lcol, x, i);
}
}
}
@@ -497,7 +504,7 @@ static void vu_properties(t_gobj *z, t_glist *owner)
t_symbol *srl[3];
iemgui_properties(&x->x_gui, srl);
- sprintf(buf, "pdtk_iemgui_dialog %%s VU-METER \
+ sprintf(buf, "pdtk_iemgui_dialog %%s |vu| \
--------dimensions(pix)(pix):-------- %d %d width: %d %d height: \
empty 0.0 empty 0.0 empty %d \
%d no_scale scale %d %d empty %d \
@@ -627,7 +634,7 @@ static void *vu_new(t_symbol *s, int argc, t_atom *argv)
t_vu *x = (t_vu *)pd_new(vu_class);
int bflcol[]={-66577, -1, -1};
int w=IEM_GUI_DEFAULTSIZE, h=IEM_VU_STEPS*IEM_VU_DEFAULTSIZE;
- int ldx=-1, ldy=-8, f=0, fs=8, scale=1;
+ int ldx=-1, ldy=-8, f=0, fs=10, scale=1;
int ftbreak=IEM_BNG_DEFAULTBREAKFLASHTIME, fthold=IEM_BNG_DEFAULTHOLDFLASHTIME;
char str[144];
@@ -667,7 +674,7 @@ static void *vu_new(t_symbol *s, int argc, t_atom *argv)
else if(x->x_gui.x_fsf.x_font_style == 2)
strcpy(x->x_gui.x_font, "times");
else { x->x_gui.x_fsf.x_font_style = 0;
- strcpy(x->x_gui.x_font, "courier"); }
+ strcpy(x->x_gui.x_font, sys_font); }
if(x->x_gui.x_fsf.x_rcv_able)
pd_bind(&x->x_gui.x_obj.ob_pd, x->x_gui.x_rcv);
x->x_gui.x_ldx = ldx;
diff --git a/src/m_pd.h b/src/m_pd.h
index 5460c517c..9ecc559a3 100644
--- a/src/m_pd.h
+++ b/src/m_pd.h
@@ -368,6 +368,8 @@ EXTERN t_glist *canvas_getcurrent(void);
EXTERN void canvas_makefilename(t_glist *c, char *file,
char *result,int resultsize);
EXTERN t_symbol *canvas_getdir(t_glist *x);
+EXTERN char sys_font[]; /* default typeface set in s_main.c */
+EXTERN char sys_fontweight[]; /* default font weight set in s_main.c */
EXTERN int sys_fontwidth(int fontsize);
EXTERN int sys_fontheight(int fontsize);
EXTERN void canvas_dataproperties(t_glist *x, t_scalar *sc, t_binbuf *b);
diff --git a/src/makefile.in b/src/makefile.in
index d77d4ac4d..c019c078f 100644
--- a/src/makefile.in
+++ b/src/makefile.in
@@ -170,12 +170,12 @@ install: all
for dir in $(shell ls -1 ../doc | grep -v CVS); do \
echo "installing $$dir"; \
install -d $(pddocdir)/$$dir ; \
- install -p ../doc/$$dir/*.* $(pddocdir)/$$dir ; \
+ install -m644 -p ../doc/$$dir/*.* $(pddocdir)/$$dir ; \
done
for dir in $(shell ls -1 ../doc/7.stuff | grep -v CVS); do \
echo "installing 7.stuff/$$dir"; \
install -d $(pddocdir)/7.stuff/$$dir ; \
- install -p ../doc/7.stuff/$$dir/*.* $(pddocdir)/7.stuff/$$dir ; \
+ install -m644 -p ../doc/7.stuff/$$dir/*.* $(pddocdir)/7.stuff/$$dir ; \
done
mv $(ABOUT_FILE) $(ABOUT_FILE).tmp
cat $(ABOUT_FILE).tmp | sed 's|PD_VERSION|Pd version $(PD_VERSION)|' \
diff --git a/src/s_inter.c b/src/s_inter.c
index 9945466f1..bbfaf23f3 100644
--- a/src/s_inter.c
+++ b/src/s_inter.c
@@ -90,7 +90,6 @@ struct _socketreceiver
extern char *pd_version;
extern int sys_guisetportnumber;
-extern char sys_font[]; /* tb: typeface */
static int sys_nfdpoll;
static t_fdpoll *sys_fdpoll;
@@ -849,7 +848,8 @@ void glob_watchdog(t_pd *dummy)
#define FIRSTPORTNUM 5400
-static int defaultfontshit[] = {
+#define MAXFONTS 21
+static int defaultfontshit[MAXFONTS] = {
8, 5, 9, 10, 6, 10, 12, 7, 13, 14, 9, 17, 16, 10, 19, 24, 15, 28,
24, 15, 28};
#define NDEFAULTFONT (sizeof(defaultfontshit)/sizeof(*defaultfontshit))
@@ -1257,8 +1257,8 @@ int sys_startgui(const char *guidir)
#endif
sys_get_audio_apis(buf);
sys_get_midi_apis(buf2);
- sys_vgui("pdtk_pd_startup {%s} %s %s {%s}\n", pd_version, buf, buf2,
- sys_font);
+ sys_vgui("pdtk_pd_startup {%s} %s %s {%s} %s\n", pd_version, buf, buf2,
+ sys_font, sys_fontweight);
}
return (0);
diff --git a/src/s_inter.c.orig b/src/s_inter.c.orig
new file mode 100644
index 000000000..9945466f1
--- /dev/null
+++ b/src/s_inter.c.orig
@@ -0,0 +1,1300 @@
+/* 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. */
+
+/* Pd side of the Pd/Pd-gui interface. Also, some system interface routines
+that didn't really belong anywhere. */
+
+#include "m_pd.h"
+#include "s_stuff.h"
+#include "m_imp.h"
+#include "g_canvas.h" /* for GUI queueing stuff */
+#ifndef MSW
+#include <unistd.h>
+#include <sys/socket.h>
+#include <netinet/in.h>
+#include <netinet/tcp.h>
+#include <netdb.h>
+#include <stdlib.h>
+#include <sys/time.h>
+#include <sys/mman.h>
+#include <sys/resource.h>
+#endif
+#ifdef HAVE_BSTRING_H
+#include <bstring.h>
+#endif
+#ifdef _WIN32
+#include <io.h>
+#include <fcntl.h>
+#include <process.h>
+#include <winsock.h>
+#include <windows.h>
+# ifdef _MSC_VER
+typedef int pid_t;
+# endif
+typedef int socklen_t;
+#define EADDRINUSE WSAEADDRINUSE
+#endif
+
+#include <stdarg.h>
+#include <signal.h>
+#include <fcntl.h>
+#include <errno.h>
+#include <string.h>
+#include <stdio.h>
+
+#ifdef __APPLE__
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <pthread.h>
+#else
+#include <stdlib.h>
+#endif
+
+#define DEBUG_MESSUP 1 /* messages up from pd to pd-gui */
+#define DEBUG_MESSDOWN 2 /* messages down from pd-gui to pd */
+
+#ifndef PDBINDIR
+#define PDBINDIR "bin/"
+#endif
+
+#ifndef WISHAPP
+#define WISHAPP "wish84.exe"
+#endif
+
+#ifdef __linux__
+#define LOCALHOST "127.0.0.1"
+#else
+#define LOCALHOST "localhost"
+#endif
+
+typedef struct _fdpoll
+{
+ int fdp_fd;
+ t_fdpollfn fdp_fn;
+ void *fdp_ptr;
+} t_fdpoll;
+
+#define INBUFSIZE 4096
+
+struct _socketreceiver
+{
+ char *sr_inbuf;
+ int sr_inhead;
+ int sr_intail;
+ void *sr_owner;
+ int sr_udp;
+ t_socketnotifier sr_notifier;
+ t_socketreceivefn sr_socketreceivefn;
+};
+
+extern char *pd_version;
+extern int sys_guisetportnumber;
+extern char sys_font[]; /* tb: typeface */
+
+static int sys_nfdpoll;
+static t_fdpoll *sys_fdpoll;
+static int sys_maxfd;
+static int sys_guisock;
+
+static t_binbuf *inbinbuf;
+static t_socketreceiver *sys_socketreceiver;
+extern int sys_addhist(int phase);
+
+/* ----------- functions for timing, signals, priorities, etc --------- */
+
+#ifdef MSW
+static LARGE_INTEGER nt_inittime;
+static double nt_freq = 0;
+
+static void sys_initntclock(void)
+{
+ LARGE_INTEGER f1;
+ LARGE_INTEGER now;
+ QueryPerformanceCounter(&now);
+ if (!QueryPerformanceFrequency(&f1))
+ {
+ fprintf(stderr, "pd: QueryPerformanceFrequency failed\n");
+ f1.QuadPart = 1;
+ }
+ nt_freq = f1.QuadPart;
+ nt_inittime = now;
+}
+
+#if 0
+ /* this is a version you can call if you did the QueryPerformanceCounter
+ call yourself. Necessary for time tagging incoming MIDI at interrupt
+ level, for instance; but we're not doing that just now. */
+
+double nt_tixtotime(LARGE_INTEGER *dumbass)
+{
+ if (nt_freq == 0) sys_initntclock();
+ return (((double)(dumbass->QuadPart - nt_inittime.QuadPart)) / nt_freq);
+}
+#endif
+#endif /* MSW */
+
+ /* get "real time" in seconds; take the
+ first time we get called as a reference time of zero. */
+double sys_getrealtime(void)
+{
+#ifndef MSW
+ static struct timeval then;
+ struct timeval now;
+ gettimeofday(&now, 0);
+ if (then.tv_sec == 0 && then.tv_usec == 0) then = now;
+ return ((now.tv_sec - then.tv_sec) +
+ (1./1000000.) * (now.tv_usec - then.tv_usec));
+#else
+ LARGE_INTEGER now;
+ QueryPerformanceCounter(&now);
+ if (nt_freq == 0) sys_initntclock();
+ return (((double)(now.QuadPart - nt_inittime.QuadPart)) / nt_freq);
+#endif
+}
+
+extern int sys_nosleep;
+
+static int sys_domicrosleep(int microsec, int pollem)
+{
+ struct timeval timout;
+ int i, didsomething = 0;
+ t_fdpoll *fp;
+ timout.tv_sec = 0;
+ timout.tv_usec = (sys_nosleep ? 0 : microsec);
+ if (pollem)
+ {
+ fd_set readset, writeset, exceptset;
+ FD_ZERO(&writeset);
+ FD_ZERO(&readset);
+ FD_ZERO(&exceptset);
+ for (fp = sys_fdpoll, i = sys_nfdpoll; i--; fp++)
+ FD_SET(fp->fdp_fd, &readset);
+#ifdef MSW
+ if (sys_maxfd == 0)
+ Sleep(microsec/1000);
+ else
+#endif
+ select(sys_maxfd+1, &readset, &writeset, &exceptset, &timout);
+ for (i = 0; i < sys_nfdpoll; i++)
+ if (FD_ISSET(sys_fdpoll[i].fdp_fd, &readset))
+ {
+#ifdef THREAD_LOCKING
+ sys_lock();
+#endif
+ (*sys_fdpoll[i].fdp_fn)(sys_fdpoll[i].fdp_ptr, sys_fdpoll[i].fdp_fd);
+#ifdef THREAD_LOCKING
+ sys_unlock();
+#endif
+ didsomething = 1;
+ }
+ return (didsomething);
+ }
+ else
+ {
+#ifdef MSW
+ if (sys_maxfd == 0)
+ Sleep(microsec/1000);
+ else
+#endif
+ select(0, 0, 0, 0, &timout);
+ return (0);
+ }
+}
+
+void sys_microsleep(int microsec)
+{
+ sys_domicrosleep(microsec, 1);
+}
+
+#ifdef UNISTD
+typedef void (*sighandler_t)(int);
+
+static void sys_signal(int signo, sighandler_t sigfun)
+{
+ struct sigaction action;
+ action.sa_flags = 0;
+ action.sa_handler = sigfun;
+ memset(&action.sa_mask, 0, sizeof(action.sa_mask));
+#if 0 /* GG says: don't use that */
+ action.sa_restorer = 0;
+#endif
+ if (sigaction(signo, &action, 0) < 0)
+ perror("sigaction");
+}
+
+static void sys_exithandler(int n)
+{
+ static int trouble = 0;
+ if (!trouble)
+ {
+ trouble = 1;
+ fprintf(stderr, "Pd: signal %d\n", n);
+ sys_bail(1);
+ }
+ else _exit(1);
+}
+
+static void sys_alarmhandler(int n)
+{
+ fprintf(stderr, "Pd: system call timed out\n");
+}
+
+static void sys_huphandler(int n)
+{
+ struct timeval timout;
+ timout.tv_sec = 0;
+ timout.tv_usec = 30000;
+ select(1, 0, 0, 0, &timout);
+}
+
+void sys_setalarm(int microsec)
+{
+ struct itimerval gonzo;
+#if 0
+ fprintf(stderr, "timer %d\n", microsec);
+#endif
+ gonzo.it_interval.tv_sec = 0;
+ gonzo.it_interval.tv_usec = 0;
+ gonzo.it_value.tv_sec = 0;
+ gonzo.it_value.tv_usec = microsec;
+ if (microsec)
+ sys_signal(SIGALRM, sys_alarmhandler);
+ else sys_signal(SIGALRM, SIG_IGN);
+ setitimer(ITIMER_REAL, &gonzo, 0);
+}
+
+#endif
+
+#ifdef __linux
+
+#if defined(_POSIX_PRIORITY_SCHEDULING) || defined(_POSIX_MEMLOCK)
+#include <sched.h>
+#endif
+
+void sys_set_priority(int higher)
+{
+#ifdef _POSIX_PRIORITY_SCHEDULING
+ struct sched_param par;
+ int p1 ,p2, p3;
+ p1 = sched_get_priority_min(SCHED_FIFO);
+ p2 = sched_get_priority_max(SCHED_FIFO);
+#ifdef USEAPI_JACK
+ p3 = (higher ? p1 + 7 : p1 + 5);
+#else
+ p3 = (higher ? p2 - 1 : p2 - 3);
+#endif
+ par.sched_priority = p3;
+ if (sched_setscheduler(0,SCHED_FIFO,&par) != -1)
+ fprintf(stderr, "priority %d scheduling enabled.\n", p3);
+#endif
+
+#ifdef REALLY_POSIX_MEMLOCK /* this doesn't work on Fedora 4, for example. */
+#ifdef _POSIX_MEMLOCK
+ /* tb: force memlock to physical memory { */
+ {
+ struct rlimit mlock_limit;
+ mlock_limit.rlim_cur=0;
+ mlock_limit.rlim_max=0;
+ setrlimit(RLIMIT_MEMLOCK,&mlock_limit);
+ }
+ /* } tb */
+ if (mlockall(MCL_FUTURE) != -1)
+ fprintf(stderr, "memory locking enabled.\n");
+#endif
+#endif
+}
+
+#endif /* __linux__ */
+
+#ifdef IRIX /* hack by <olaf.matthes@gmx.de> at 2003/09/21 */
+
+#if defined(_POSIX_PRIORITY_SCHEDULING) || defined(_POSIX_MEMLOCK)
+#include <sched.h>
+#endif
+
+void sys_set_priority(int higher)
+{
+#ifdef _POSIX_PRIORITY_SCHEDULING
+ struct sched_param par;
+ /* Bearing the table found in 'man realtime' in mind, I found it a */
+ /* good idea to use 192 as the priority setting for Pd. Any thoughts? */
+ if (higher)
+ par.sched_priority = 250; /* priority for watchdog */
+ else
+ par.sched_priority = 192; /* priority for pd (DSP) */
+
+ if (sched_setscheduler(0, SCHED_FIFO, &par) != -1)
+ fprintf(stderr, "priority %d scheduling enabled.\n", par.sched_priority);
+#endif
+
+#ifdef _POSIX_MEMLOCK
+ if (mlockall(MCL_FUTURE) != -1)
+ fprintf(stderr, "memory locking enabled.\n");
+#endif
+}
+/* end of hack */
+#endif /* IRIX */
+
+/* ------------------ receiving incoming messages over sockets ------------- */
+
+void sys_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);
+}
+
+void sys_addpollfn(int fd, t_fdpollfn fn, void *ptr)
+{
+ int nfd = sys_nfdpoll;
+ int size = nfd * sizeof(t_fdpoll);
+ t_fdpoll *fp;
+ sys_fdpoll = (t_fdpoll *)t_resizebytes(sys_fdpoll, size,
+ size + sizeof(t_fdpoll));
+ fp = sys_fdpoll + nfd;
+ fp->fdp_fd = fd;
+ fp->fdp_fn = fn;
+ fp->fdp_ptr = ptr;
+ sys_nfdpoll = nfd + 1;
+ if (fd >= sys_maxfd) sys_maxfd = fd + 1;
+}
+
+void sys_rmpollfn(int fd)
+{
+ int nfd = sys_nfdpoll;
+ int i, size = nfd * sizeof(t_fdpoll);
+ t_fdpoll *fp;
+ for (i = nfd, fp = sys_fdpoll; i--; fp++)
+ {
+ if (fp->fdp_fd == fd)
+ {
+ while (i--)
+ {
+ fp[0] = fp[1];
+ fp++;
+ }
+ sys_fdpoll = (t_fdpoll *)t_resizebytes(sys_fdpoll, size,
+ size - sizeof(t_fdpoll));
+ sys_nfdpoll = nfd - 1;
+ return;
+ }
+ }
+ post("warning: %d removed from poll list but not found", fd);
+}
+
+t_socketreceiver *socketreceiver_new(void *owner, t_socketnotifier notifier,
+ t_socketreceivefn socketreceivefn, int udp)
+{
+ t_socketreceiver *x = (t_socketreceiver *)getbytes(sizeof(*x));
+ x->sr_inhead = x->sr_intail = 0;
+ x->sr_owner = owner;
+ x->sr_notifier = notifier;
+ x->sr_socketreceivefn = socketreceivefn;
+ x->sr_udp = udp;
+ if (!(x->sr_inbuf = malloc(INBUFSIZE))) bug("t_socketreceiver");;
+ return (x);
+}
+
+void socketreceiver_free(t_socketreceiver *x)
+{
+ free(x->sr_inbuf);
+ freebytes(x, sizeof(*x));
+}
+
+ /* this is in a separately called subroutine so that the buffer isn't
+ sitting on the stack while the messages are getting passed. */
+static int socketreceiver_doread(t_socketreceiver *x)
+{
+ char messbuf[INBUFSIZE], *bp = messbuf;
+ int indx;
+ int inhead = x->sr_inhead;
+ int intail = x->sr_intail;
+ char *inbuf = x->sr_inbuf;
+ if (intail == inhead) return (0);
+ for (indx = intail; indx != inhead; indx = (indx+1)&(INBUFSIZE-1))
+ {
+ /* if we hit a semi that isn't preceeded by a \, it's a message
+ boundary. LATER we should deal with the possibility that the
+ preceeding \ might itself be escaped! */
+ char c = *bp++ = inbuf[indx];
+ if (c == ';' && (!indx || inbuf[indx-1] != '\\'))
+ {
+ intail = (indx+1)&(INBUFSIZE-1);
+ binbuf_text(inbinbuf, messbuf, bp - messbuf);
+ if (sys_debuglevel & DEBUG_MESSDOWN)
+ {
+ write(2, messbuf, bp - messbuf);
+ write(2, "\n", 1);
+ }
+ x->sr_inhead = inhead;
+ x->sr_intail = intail;
+ return (1);
+ }
+ }
+ return (0);
+}
+
+static void socketreceiver_getudp(t_socketreceiver *x, int fd)
+{
+ char buf[INBUFSIZE+1];
+ int ret = recv(fd, buf, INBUFSIZE, 0);
+ if (ret < 0)
+ {
+ sys_sockerror("recv");
+ sys_rmpollfn(fd);
+ sys_closesocket(fd);
+ }
+ else if (ret > 0)
+ {
+ buf[ret] = 0;
+#if 0
+ post("%s", buf);
+#endif
+ if (buf[ret-1] != '\n')
+ {
+#if 0
+ buf[ret] = 0;
+ error("dropped bad buffer %s\n", buf);
+#endif
+ }
+ else
+ {
+ char *semi = strchr(buf, ';');
+ if (semi)
+ *semi = 0;
+ binbuf_text(inbinbuf, buf, strlen(buf));
+ outlet_setstacklim();
+ if (x->sr_socketreceivefn)
+ (*x->sr_socketreceivefn)(x->sr_owner, inbinbuf);
+ else bug("socketreceiver_getudp");
+ }
+ }
+}
+
+void sys_exit(void);
+
+void socketreceiver_read(t_socketreceiver *x, int fd)
+{
+ if (x->sr_udp) /* UDP ("datagram") socket protocol */
+ socketreceiver_getudp(x, fd);
+ else /* TCP ("streaming") socket protocol */
+ {
+ char *semi;
+ int readto =
+ (x->sr_inhead >= x->sr_intail ? INBUFSIZE : x->sr_intail-1);
+ int ret;
+
+ /* the input buffer might be full. If so, drop the whole thing */
+ if (readto == x->sr_inhead)
+ {
+ fprintf(stderr, "pd: dropped message from gui\n");
+ x->sr_inhead = x->sr_intail = 0;
+ readto = INBUFSIZE;
+ }
+ else
+ {
+ ret = recv(fd, x->sr_inbuf + x->sr_inhead,
+ readto - x->sr_inhead, 0);
+ if (ret < 0)
+ {
+ sys_sockerror("recv");
+ if (x == sys_socketreceiver) sys_bail(1);
+ else
+ {
+ if (x->sr_notifier) (*x->sr_notifier)(x->sr_owner);
+ sys_rmpollfn(fd);
+ sys_closesocket(fd);
+ }
+ }
+ else if (ret == 0)
+ {
+ if (x == sys_socketreceiver)
+ {
+ fprintf(stderr, "pd: exiting\n");
+ sys_exit();
+ return;
+ }
+ else
+ {
+ post("EOF on socket %d\n", fd);
+ if (x->sr_notifier) (*x->sr_notifier)(x->sr_owner);
+ sys_rmpollfn(fd);
+ sys_closesocket(fd);
+ }
+ }
+ else
+ {
+ x->sr_inhead += ret;
+ if (x->sr_inhead >= INBUFSIZE) x->sr_inhead = 0;
+ while (socketreceiver_doread(x))
+ {
+ outlet_setstacklim();
+ if (x->sr_socketreceivefn)
+ (*x->sr_socketreceivefn)(x->sr_owner, inbinbuf);
+ else binbuf_eval(inbinbuf, 0, 0, 0);
+ }
+ }
+ }
+ }
+}
+
+void sys_closesocket(int fd)
+{
+#ifdef UNISTD
+ close(fd);
+#endif
+#ifdef MSW
+ closesocket(fd);
+#endif
+}
+
+/* ---------------------- sending messages to the GUI ------------------ */
+#define GUI_ALLOCCHUNK 8192
+#define GUI_UPDATESLICE 512 /* how much we try to do in one idle period */
+#define GUI_BYTESPERPING 1024 /* how much we send up per ping */
+
+typedef struct _guiqueue
+{
+ void *gq_client;
+ t_glist *gq_glist;
+ t_guicallbackfn gq_fn;
+ struct _guiqueue *gq_next;
+} t_guiqueue;
+
+static t_guiqueue *sys_guiqueuehead;
+static char *sys_guibuf;
+static int sys_guibufhead;
+static int sys_guibuftail;
+static int sys_guibufsize;
+static int sys_waitingforping;
+static int sys_bytessincelastping;
+
+static void sys_trytogetmoreguibuf(int newsize)
+{
+ char *newbuf = realloc(sys_guibuf, newsize);
+#if 0
+ static int sizewas;
+ if (newsize > 70000 && sizewas < 70000)
+ {
+ int i;
+ for (i = sys_guibuftail; i < sys_guibufhead; i++)
+ fputc(sys_guibuf[i], stderr);
+ }
+ sizewas = newsize;
+#endif
+#if 0
+ fprintf(stderr, "new size %d (head %d, tail %d)\n",
+ newsize, sys_guibufhead, sys_guibuftail);
+#endif
+
+ /* if realloc fails, make a last-ditch attempt to stay alive by
+ synchronously writing out the existing contents. LATER test
+ this by intentionally setting newbuf to zero */
+ if (!newbuf)
+ {
+ int bytestowrite = sys_guibuftail - sys_guibufhead;
+ int written = 0;
+ while (1)
+ {
+ int res = send(sys_guisock,
+ sys_guibuf + sys_guibuftail + written, bytestowrite, 0);
+ if (res < 0)
+ {
+ perror("pd output pipe");
+ sys_bail(1);
+ }
+ else
+ {
+ written += res;
+ if (written >= bytestowrite)
+ break;
+ }
+ }
+ sys_guibufhead = sys_guibuftail = 0;
+ }
+ else
+ {
+ sys_guibufsize = newsize;
+ sys_guibuf = newbuf;
+ }
+}
+
+void sys_vgui(char *fmt, ...)
+{
+ int msglen, bytesleft, headwas, nwrote;
+ va_list ap;
+
+ if (sys_nogui)
+ return;
+ if (!sys_guibuf)
+ {
+ if (!(sys_guibuf = malloc(GUI_ALLOCCHUNK)))
+ {
+ fprintf(stderr, "Pd: couldn't allocate GUI buffer\n");
+ sys_bail(1);
+ }
+ sys_guibufsize = GUI_ALLOCCHUNK;
+ sys_guibufhead = sys_guibuftail = 0;
+ }
+ if (sys_guibufhead > sys_guibufsize - (GUI_ALLOCCHUNK/2))
+ sys_trytogetmoreguibuf(sys_guibufsize + GUI_ALLOCCHUNK);
+ va_start(ap, fmt);
+ msglen = vsnprintf(sys_guibuf + sys_guibufhead,
+ sys_guibufsize - sys_guibufhead, fmt, ap);
+ va_end(ap);
+ if(msglen < 0)
+ {
+ fprintf(stderr, "Pd: buffer space wasn't sufficient for long GUI string\n");
+ return;
+ }
+ if (msglen >= sys_guibufsize - sys_guibufhead)
+ {
+ int msglen2, newsize = sys_guibufsize + 1 +
+ (msglen > GUI_ALLOCCHUNK ? msglen : GUI_ALLOCCHUNK);
+ sys_trytogetmoreguibuf(newsize);
+
+ va_start(ap, fmt);
+ msglen2 = vsnprintf(sys_guibuf + sys_guibufhead,
+ sys_guibufsize - sys_guibufhead, fmt, ap);
+ va_end(ap);
+ if (msglen2 != msglen)
+ bug("sys_vgui");
+ if (msglen >= sys_guibufsize - sys_guibufhead)
+ msglen = sys_guibufsize - sys_guibufhead;
+ }
+ if (sys_debuglevel & DEBUG_MESSUP)
+ fprintf(stderr, "%s", sys_guibuf + sys_guibufhead);
+ sys_guibufhead += msglen;
+ sys_bytessincelastping += msglen;
+}
+
+void sys_gui(char *s)
+{
+ sys_vgui("%s", s);
+}
+
+static int sys_flushtogui( void)
+{
+ int writesize = sys_guibufhead - sys_guibuftail, nwrote = 0;
+ if (writesize > 0)
+ nwrote = send(sys_guisock, sys_guibuf + sys_guibuftail, writesize, 0);
+
+#if 0
+ if (writesize)
+ fprintf(stderr, "wrote %d of %d\n", nwrote, writesize);
+#endif
+
+ if (nwrote < 0)
+ {
+ perror("pd-to-gui socket");
+ sys_bail(1);
+ }
+ else if (!nwrote)
+ return (0);
+ else if (nwrote >= sys_guibufhead - sys_guibuftail)
+ sys_guibufhead = sys_guibuftail = 0;
+ else if (nwrote)
+ {
+ sys_guibuftail += nwrote;
+ if (sys_guibuftail > (sys_guibufsize >> 2))
+ {
+ memmove(sys_guibuf, sys_guibuf + sys_guibuftail,
+ sys_guibufhead - sys_guibuftail);
+ sys_guibufhead = sys_guibufhead - sys_guibuftail;
+ sys_guibuftail = 0;
+ }
+ }
+ return (1);
+}
+
+void glob_ping(t_pd *dummy)
+{
+ sys_waitingforping = 0;
+}
+
+static int sys_flushqueue(void )
+{
+ int wherestop = sys_bytessincelastping + GUI_UPDATESLICE;
+ if (wherestop + (GUI_UPDATESLICE >> 1) > GUI_BYTESPERPING)
+ wherestop = 0x7fffffff;
+ if (sys_waitingforping)
+ return (0);
+ if (!sys_guiqueuehead)
+ return (0);
+ while (1)
+ {
+ if (sys_bytessincelastping >= GUI_BYTESPERPING)
+ {
+ sys_gui("pdtk_ping\n");
+ sys_bytessincelastping = 0;
+ sys_waitingforping = 1;
+ return (1);
+ }
+ if (sys_guiqueuehead)
+ {
+ t_guiqueue *headwas = sys_guiqueuehead;
+ sys_guiqueuehead = headwas->gq_next;
+ (*headwas->gq_fn)(headwas->gq_client, headwas->gq_glist);
+ t_freebytes(headwas, sizeof(*headwas));
+ if (sys_bytessincelastping >= wherestop)
+ break;
+ }
+ else break;
+ }
+ sys_flushtogui();
+ return (1);
+}
+
+ /* flush output buffer and update queue to gui in small time slices */
+static int sys_poll_togui(void) /* returns 1 if did anything */
+{
+ if (sys_nogui)
+ return (0);
+ /* see if there is stuff still in the buffer, if so we
+ must have fallen behind, so just try to clear that. */
+ if (sys_flushtogui())
+ return (1);
+ /* if the flush wasn't complete, wait. */
+ if (sys_guibufhead > sys_guibuftail)
+ return (0);
+
+ /* check for queued updates */
+ if (sys_flushqueue())
+ return (1);
+
+ return (0);
+}
+
+ /* if some GUI object is having to do heavy computations, it can tell
+ us to back off from doing more updates by faking a big one itself. */
+void sys_pretendguibytes(int n)
+{
+ sys_bytessincelastping += n;
+}
+
+void sys_queuegui(void *client, t_glist *glist, t_guicallbackfn f)
+{
+ t_guiqueue **gqnextptr, *gq;
+ if (!sys_guiqueuehead)
+ gqnextptr = &sys_guiqueuehead;
+ else
+ {
+ for (gq = sys_guiqueuehead; gq->gq_next; gq = gq->gq_next)
+ if (gq->gq_client == client)
+ return;
+ if (gq->gq_client == client)
+ return;
+ gqnextptr = &gq->gq_next;
+ }
+ gq = t_getbytes(sizeof(*gq));
+ gq->gq_next = 0;
+ gq->gq_client = client;
+ gq->gq_glist = glist;
+ gq->gq_fn = f;
+ gq->gq_next = 0;
+ *gqnextptr = gq;
+}
+
+void sys_unqueuegui(void *client)
+{
+ t_guiqueue *gq, *gq2;
+ if (!sys_guiqueuehead)
+ return;
+ if (sys_guiqueuehead->gq_client == client)
+ {
+ t_freebytes(sys_guiqueuehead, sizeof(*sys_guiqueuehead));
+ sys_guiqueuehead = 0;
+ }
+ else for (gq = sys_guiqueuehead; gq2 = gq->gq_next; gq = gq2)
+ if (gq2->gq_client == client)
+ {
+ gq->gq_next = gq2->gq_next;
+ t_freebytes(gq2, sizeof(*gq2));
+ break;
+ }
+}
+
+int sys_pollgui(void)
+{
+ return (sys_domicrosleep(0, 1) || sys_poll_togui());
+}
+
+
+
+/* --------------------- starting up the GUI connection ------------- */
+
+static int sys_watchfd;
+
+#ifdef __linux__
+void glob_watchdog(t_pd *dummy)
+{
+ if (write(sys_watchfd, "\n", 1) < 1)
+ {
+ fprintf(stderr, "pd: watchdog process died\n");
+ sys_bail(1);
+ }
+}
+#endif
+
+#define FIRSTPORTNUM 5400
+
+static int defaultfontshit[] = {
+ 8, 5, 9, 10, 6, 10, 12, 7, 13, 14, 9, 17, 16, 10, 19, 24, 15, 28,
+ 24, 15, 28};
+#define NDEFAULTFONT (sizeof(defaultfontshit)/sizeof(*defaultfontshit))
+
+int sys_startgui(const char *guidir)
+{
+ pid_t childpid;
+ char cmdbuf[4*MAXPDSTRING];
+ struct sockaddr_in server;
+ int msgsock;
+ char buf[15];
+ int len = sizeof(server);
+ int ntry = 0, portno = FIRSTPORTNUM;
+ int xsock = -1;
+#ifdef MSW
+ short version = MAKEWORD(2, 0);
+ WSADATA nobby;
+#endif
+#ifdef UNISTD
+ int stdinpipe[2];
+#endif
+ /* create an empty FD poll list */
+ sys_fdpoll = (t_fdpoll *)t_getbytes(0);
+ sys_nfdpoll = 0;
+ inbinbuf = binbuf_new();
+
+#ifdef UNISTD
+ signal(SIGHUP, sys_huphandler);
+ signal(SIGINT, sys_exithandler);
+ signal(SIGQUIT, sys_exithandler);
+ signal(SIGILL, sys_exithandler);
+ signal(SIGIOT, sys_exithandler);
+ signal(SIGFPE, SIG_IGN);
+ /* signal(SIGILL, sys_exithandler);
+ signal(SIGBUS, sys_exithandler);
+ signal(SIGSEGV, sys_exithandler); */
+ signal(SIGPIPE, SIG_IGN);
+ signal(SIGALRM, SIG_IGN);
+#if 0 /* GG says: don't use that */
+ signal(SIGSTKFLT, sys_exithandler);
+#endif
+#endif
+#ifdef MSW
+ if (WSAStartup(version, &nobby)) sys_sockerror("WSAstartup");
+#endif
+
+ if (sys_nogui)
+ {
+ /* fake the GUI's message giving cwd and font sizes; then
+ skip starting the GUI up. */
+ t_atom zz[NDEFAULTFONT+2];
+ int i;
+#ifdef MSW
+ if (GetCurrentDirectory(MAXPDSTRING, cmdbuf) == 0)
+ strcpy(cmdbuf, ".");
+#endif
+#ifdef UNISTD
+ if (!getcwd(cmdbuf, MAXPDSTRING))
+ strcpy(cmdbuf, ".");
+
+#endif
+ SETSYMBOL(zz, gensym(cmdbuf));
+ for (i = 0; i < (int)NDEFAULTFONT; i++)
+ SETFLOAT(zz+i+1, defaultfontshit[i]);
+ SETFLOAT(zz+NDEFAULTFONT+1,0);
+ glob_initfromgui(0, 0, 23, zz);
+ }
+ else if (sys_guisetportnumber) /* GUI exists and sent us a port number */
+ {
+ struct sockaddr_in server;
+ struct hostent *hp;
+ /* create a socket */
+ sys_guisock = socket(AF_INET, SOCK_STREAM, 0);
+ if (sys_guisock < 0)
+ sys_sockerror("socket");
+
+ /* connect socket using hostname provided in command line */
+ server.sin_family = AF_INET;
+
+ hp = gethostbyname(LOCALHOST);
+
+ 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)sys_guisetportnumber);
+
+ /* try to connect */
+ if (connect(sys_guisock, (struct sockaddr *) &server, sizeof (server))
+ < 0)
+ {
+ sys_sockerror("connecting stream socket");
+ exit(1);
+ }
+ }
+ else /* default behavior: start up the GUI ourselves. */
+ {
+#ifdef MSW
+ char scriptbuf[MAXPDSTRING+30], wishbuf[MAXPDSTRING+30], portbuf[80];
+ int spawnret;
+
+#endif
+#ifdef MSW
+ char intarg;
+#else
+ int intarg;
+#endif
+
+ /* create a socket */
+ xsock = socket(AF_INET, SOCK_STREAM, 0);
+ if (xsock < 0) sys_sockerror("socket");
+#if 0
+ intarg = 0;
+ if (setsockopt(xsock, SOL_SOCKET, SO_SNDBUF,
+ &intarg, sizeof(intarg)) < 0)
+ post("setsockopt (SO_RCVBUF) failed\n");
+ intarg = 0;
+ if (setsockopt(xsock, SOL_SOCKET, SO_RCVBUF,
+ &intarg, sizeof(intarg)) < 0)
+ post("setsockopt (SO_RCVBUF) failed\n");
+#endif
+ intarg = 1;
+ if (setsockopt(xsock, IPPROTO_TCP, TCP_NODELAY,
+ &intarg, sizeof(intarg)) < 0)
+#ifndef MSW
+ post("setsockopt (TCP_NODELAY) failed\n")
+#endif
+ ;
+
+
+ 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,
+ "Pd needs your machine to be configured with\n");
+ fprintf(stderr,
+ "'networking' turned on (see Pd's html doc for details.)\n");
+ exit(1);
+ }
+ portno++;
+ server.sin_port = htons((unsigned short)(portno));
+ }
+
+ if (sys_verbose) fprintf(stderr, "port %d\n", portno);
+
+
+#ifdef UNISTD
+ childpid = fork();
+ if (childpid < 0)
+ {
+ if (errno) perror("sys_startgui");
+ else fprintf(stderr, "sys_startgui failed\n");
+ return (1);
+ }
+ else if (!childpid) /* we're the child */
+ {
+ seteuid(getuid()); /* lose setuid priveliges */
+#ifndef __APPLE__
+ /* 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
+ version of Wish happy...*/
+ if (pipe(stdinpipe) < 0)
+ sys_sockerror("pipe");
+ else
+ {
+ if (stdinpipe[0] != 0)
+ {
+ close (0);
+ dup2(stdinpipe[0], 0);
+ close(stdinpipe[0]);
+ }
+ }
+#endif
+ if (!sys_guicmd)
+ {
+#ifdef __APPLE__
+ char *homedir = getenv("HOME"), filename[250];
+ 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);
+#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);
+#endif
+ sys_guicmd = cmdbuf;
+ }
+ if (sys_verbose) fprintf(stderr, "%s", sys_guicmd);
+ execl("/bin/sh", "sh", "-c", sys_guicmd, (char*)0);
+ perror("pd: exec");
+ _exit(1);
+ }
+#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); */
+
+ strcpy(scriptbuf, "\"");
+ strcat(scriptbuf, sys_libdir->s_name);
+ strcat(scriptbuf, "/" PDBINDIR "pd.tk\"");
+ sys_bashfilename(scriptbuf, scriptbuf);
+
+ sprintf(portbuf, "%d", portno);
+
+ strcpy(wishbuf, sys_libdir->s_name);
+ strcat(wishbuf, "/" PDBINDIR WISHAPP);
+ sys_bashfilename(wishbuf, wishbuf);
+
+ spawnret = _spawnl(P_NOWAIT, wishbuf, WISHAPP, scriptbuf, portbuf, 0);
+ if (spawnret < 0)
+ {
+ perror("spawnl");
+ fprintf(stderr, "%s: couldn't load TCL\n", wishbuf);
+ exit(1);
+ }
+
+#endif /* MSW */
+ }
+
+#if defined(__linux__) || defined(IRIX)
+ /* now that we've spun off the child process we can promote
+ our process's priority, if we can and want to. If not specfied
+ (-1), we check root status. This misses the case where we might
+ have permission from a "security module" (linux 2.6) -- I don't
+ know how to test for that. The "-rt" flag must b eset in that
+ case. */
+ if (sys_hipriority == -1)
+ sys_hipriority = (!getuid() || !geteuid());
+
+ if (sys_hipriority)
+ {
+ /* To prevent lockup, we fork off a watchdog process with
+ higher real-time priority than ours. The GUI has to send
+ a stream of ping messages to the watchdog THROUGH the Pd
+ process which has to pick them up from the GUI and forward
+ them. If any of these things aren't happening the watchdog
+ starts sending "stop" and "cont" signals to the Pd process
+ to make it timeshare with the rest of the system. (Version
+ 0.33P2 : if there's no GUI, the watchdog pinging is done
+ from the scheduler idle routine in this process instead.) */
+ int pipe9[2], watchpid;
+
+ if (pipe(pipe9) < 0)
+ {
+ seteuid(getuid()); /* lose setuid priveliges */
+ sys_sockerror("pipe");
+ return (1);
+ }
+ watchpid = fork();
+ if (watchpid < 0)
+ {
+ seteuid(getuid()); /* lose setuid priveliges */
+ if (errno)
+ perror("sys_startgui");
+ else fprintf(stderr, "sys_startgui failed\n");
+ return (1);
+ }
+ else if (!watchpid) /* we're the child */
+ {
+ sys_set_priority(1);
+ seteuid(getuid()); /* lose setuid priveliges */
+ if (pipe9[1] != 0)
+ {
+ dup2(pipe9[0], 0);
+ close(pipe9[0]);
+ }
+ close(pipe9[1]);
+
+ sprintf(cmdbuf, "%s/pd-watchdog\n", guidir);
+ if (sys_verbose) fprintf(stderr, "%s", cmdbuf);
+ execl("/bin/sh", "sh", "-c", cmdbuf, (char*)0);
+ perror("pd: exec");
+ _exit(1);
+ }
+ else /* we're the parent */
+ {
+ sys_set_priority(0);
+ seteuid(getuid()); /* lose setuid priveliges */
+ close(pipe9[0]);
+ sys_watchfd = pipe9[1];
+ /* We also have to start the ping loop in the GUI;
+ this is done later when the socket is open. */
+ }
+ }
+
+ seteuid(getuid()); /* lose setuid priveliges */
+#endif /* __linux__ */
+
+#ifdef MSW
+ if (!SetPriorityClass(GetCurrentProcess(), HIGH_PRIORITY_CLASS))
+ fprintf(stderr, "pd: couldn't set high priority class\n");
+#endif
+#ifdef __APPLE__
+ if (sys_hipriority)
+ {
+ struct sched_param param;
+ int policy = SCHED_RR;
+ int err;
+ param.sched_priority = 80; /* adjust 0 : 100 */
+
+ err = pthread_setschedparam(pthread_self(), policy, ¶m);
+ if (err)
+ post("warning: high priority scheduling failed\n");
+ }
+#endif /* __APPLE__ */
+
+ if (!sys_nogui && !sys_guisetportnumber)
+ {
+ if (sys_verbose)
+ fprintf(stderr, "Waiting for connection request... \n");
+ if (listen(xsock, 5) < 0) sys_sockerror("listen");
+
+ sys_guisock = accept(xsock, (struct sockaddr *) &server,
+ (socklen_t *)&len);
+#ifdef OOPS
+ close(xsock);
+#endif
+ if (sys_guisock < 0) sys_sockerror("accept");
+ if (sys_verbose)
+ fprintf(stderr, "... connected\n");
+ }
+ if (!sys_nogui)
+ {
+ char buf[256], buf2[256];
+ sys_socketreceiver = socketreceiver_new(0, 0, 0, 0);
+ sys_addpollfn(sys_guisock, (t_fdpollfn)socketreceiver_read,
+ sys_socketreceiver);
+
+ /* here is where we start the pinging. */
+#if defined(__linux__) || defined(IRIX)
+ if (sys_hipriority)
+ sys_gui("pdtk_watchdog\n");
+#endif
+ sys_get_audio_apis(buf);
+ sys_get_midi_apis(buf2);
+ sys_vgui("pdtk_pd_startup {%s} %s %s {%s}\n", pd_version, buf, buf2,
+ sys_font);
+ }
+ return (0);
+
+}
+
+extern void sys_exit(void);
+
+/* This is called when something bad has happened, like a segfault.
+Call glob_quit() below to exit cleanly.
+LATER try to save dirty documents even in the bad case. */
+void sys_bail(int n)
+{
+ static int reentered = 0;
+ if (!reentered)
+ {
+ reentered = 1;
+#ifndef __linux__ /* sys_close_audio() hangs if you're in a signal? */
+ fprintf(stderr, "closing audio...\n");
+ sys_close_audio();
+ fprintf(stderr, "closing MIDI...\n");
+ sys_close_midi();
+ fprintf(stderr, "... done.\n");
+#endif
+ exit(n);
+ }
+ else _exit(1);
+}
+
+void glob_quit(void *dummy)
+{
+ sys_vgui("exit\n");
+ if (!sys_nogui)
+ {
+ close(sys_guisock);
+ sys_rmpollfn(sys_guisock);
+ }
+ sys_bail(0);
+}
+
diff --git a/src/s_main.c b/src/s_main.c
index ded67c886..de282d043 100644
--- a/src/s_main.c
+++ b/src/s_main.c
@@ -58,7 +58,12 @@ int sys_nmidiin = -1;
int sys_midiindevlist[MAXMIDIINDEV] = {1};
int sys_midioutdevlist[MAXMIDIOUTDEV] = {1};
-char sys_font[100] = "courier"; /* tb: font name */
+#ifdef __APPLE__
+char sys_font[] = "Monaco"; /* tb: font name */
+#else
+char sys_font[] = "Bitstream Vera Sans Mono"; /* tb: font name */
+#endif
+char sys_fontweight[] = "normal"; /* currently only used for iemguis */
static int sys_main_srate;
static int sys_main_advance;
static int sys_main_callback;
@@ -107,8 +112,12 @@ typedef struct _fontinfo
in the six fonts. */
static t_fontinfo sys_fontlist[] = {
- {8, 6, 10, 0, 0, 0}, {10, 7, 13, 0, 0, 0}, {12, 9, 16, 0, 0, 0},
- {16, 10, 20, 0, 0, 0}, {24, 15, 25, 0, 0, 0}, {36, 25, 45, 0, 0, 0}};
+ {8, 6, 10, 8, 6, 10}, {10, 7, 13, 10, 7, 13}, {12, 9, 16, 12, 9, 16},
+ {16, 10, 20, 16, 10, 20}, {24, 15, 25, 24, 15, 25},
+ {36, 25, 45, 36, 25, 45}};
+/* {8, 5, 11, 8, 5, 11}, {10, 6, 13, 10, 6, 13}, {12, 7, 16, 12, 7, 16},
+ {16, 10, 19, 16, 10, 19}, {24, 14, 29, 24, 14, 29}, {36, 23, 44, 36, 23, 44}};
+*/
#define NFONT (sizeof(sys_fontlist)/sizeof(*sys_fontlist))
/* here are the actual font size structs on msp's systems:
@@ -159,11 +168,7 @@ int sys_fontheight(int fontsize)
}
int sys_defaultfont;
-#ifdef MSW
-#define DEFAULTFONT 12
-#else
#define DEFAULTFONT 10
-#endif
static void openit(const char *dirname, const char *filename)
{
@@ -383,8 +388,9 @@ static char *(usagemessage[]) = {
"-helppath <path> -- add to help file search path\n",
"-open <file> -- open file(s) on startup\n",
"-lib <file> -- load object library(s)\n",
-"-font <n> -- specify default font size in points\n",
-"-typeface <name> -- specify default font (default: courier)\n",
+"-font-size <n> -- specify default font size in points\n",
+"-font-face <name> -- specify default font (default: Bitstream Vera Sans Mono)\n",
+"-font-weight <name>-- specify default font weight (normal or bold)\n",
"-verbose -- extra printout on startup and when searching for files\n",
"-version -- don't run Pd; just print out which version it is \n",
"-d <n> -- specify debug level\n",
@@ -744,21 +750,25 @@ int sys_argparse(int argc, char **argv)
sys_externlist = namelist_append_files(sys_externlist, argv[1]);
argc -= 2; argv += 2;
}
- else if (!strcmp(*argv, "-font") && argc > 1)
+ else if ((!strcmp(*argv, "-font-size") || !strcmp(*argv, "-font")) && argc > 1)
{
sys_defaultfont = sys_nearestfontsize(atoi(argv[1]));
argc -= 2;
argv += 2;
}
- /* tb: font name { */
- else if (!strcmp(*argv, "-typeface") && argc > 1)
+ else if ((!strcmp(*argv, "-font-face") || !strcmp(*argv, "-typeface")) && argc > 1)
{
strncpy(sys_font,*(argv+1),sizeof(sys_font)-1);
sys_font[sizeof(sys_font)-1] = 0;
argc -= 2;
argv += 2;
}
- /* } tb */
+ else if (!strcmp(*argv, "-font-weight") && argc > 1)
+ {
+ strcpy(sys_fontweight,*(argv+1));
+ argc -= 2;
+ argv += 2;
+ }
else if (!strcmp(*argv, "-verbose"))
{
sys_verbose++;
diff --git a/src/s_main.c.orig b/src/s_main.c.orig
new file mode 100644
index 000000000..ded67c886
--- /dev/null
+++ b/src/s_main.c.orig
@@ -0,0 +1,1001 @@
+/* Copyright (c) 1997-1999 Miller Puckette and others.
+* For information on usage and redistribution, and for a DISCLAIMER OF ALL
+* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
+
+#include "m_pd.h"
+#include "m_imp.h"
+#include "s_stuff.h"
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <limits.h>
+#include <string.h>
+#include <stdio.h>
+#include <fcntl.h>
+#include <stdlib.h>
+
+#ifdef UNISTD
+#include <unistd.h>
+#endif
+#ifdef MSW
+#include <io.h>
+#include <windows.h>
+#include <winbase.h>
+#endif
+
+char *pd_version;
+char pd_compiletime[] = __TIME__;
+char pd_compiledate[] = __DATE__;
+
+void pd_init(void);
+int sys_argparse(int argc, char **argv);
+void sys_findprogdir(char *progname);
+int sys_startgui(const char *guipath);
+int sys_rcfile(void);
+int m_mainloop(void);
+void sys_addhelppath(char *p);
+#ifdef USEAPI_ALSA
+void alsa_adddev(char *name);
+#endif
+
+int sys_debuglevel;
+int sys_verbose;
+int sys_noloadbang;
+int sys_nogui;
+int sys_hipriority = -1; /* -1 = don't care; 0 = no; 1 = yes */
+int sys_guisetportnumber; /* if started from the GUI, this is the port # */
+int sys_nosleep = 0; /* skip all "sleep" calls and spin instead */
+
+char *sys_guicmd;
+t_symbol *sys_libdir;
+static t_symbol *sys_guidir;
+static t_namelist *sys_openlist;
+static t_namelist *sys_messagelist;
+static int sys_version;
+int sys_oldtclversion; /* hack to warn g_rtext.c about old text sel */
+
+int sys_nmidiout = -1;
+int sys_nmidiin = -1;
+int sys_midiindevlist[MAXMIDIINDEV] = {1};
+int sys_midioutdevlist[MAXMIDIOUTDEV] = {1};
+
+char sys_font[100] = "courier"; /* tb: font name */
+static int sys_main_srate;
+static int sys_main_advance;
+static int sys_main_callback;
+static int sys_listplease;
+
+int sys_externalschedlib;
+char sys_externalschedlibname[MAXPDSTRING];
+int sys_extraflags;
+char sys_extraflagsstring[MAXPDSTRING];
+
+
+ /* here the "-1" counts signify that the corresponding vector hasn't been
+ specified in command line arguments; sys_set_audio_settings will detect it
+ and fill things in. */
+static int sys_nsoundin = -1;
+static int sys_nsoundout = -1;
+static int sys_soundindevlist[MAXAUDIOINDEV];
+static int sys_soundoutdevlist[MAXAUDIOOUTDEV];
+
+static int sys_nchin = -1;
+static int sys_nchout = -1;
+static int sys_chinlist[MAXAUDIOINDEV];
+static int sys_choutlist[MAXAUDIOOUTDEV];
+
+t_sample* get_sys_soundout() { return sys_soundout; }
+t_sample* get_sys_soundin() { return sys_soundin; }
+int* get_sys_main_advance() { return &sys_main_advance; }
+double* get_sys_time_per_dsp_tick() { return &sys_time_per_dsp_tick; }
+int* get_sys_schedblocksize() { return &sys_schedblocksize; }
+double* get_sys_time() { return &sys_time; }
+float* get_sys_dacsr() { return &sys_dacsr; }
+int* get_sys_sleepgrain() { return &sys_sleepgrain; }
+int* get_sys_schedadvance() { return &sys_schedadvance; }
+
+typedef struct _fontinfo
+{
+ int fi_fontsize;
+ int fi_maxwidth;
+ int fi_maxheight;
+ int fi_hostfontsize;
+ int fi_width;
+ int fi_height;
+} t_fontinfo;
+
+ /* these give the nominal point size and maximum height of the characters
+ in the six fonts. */
+
+static t_fontinfo sys_fontlist[] = {
+ {8, 6, 10, 0, 0, 0}, {10, 7, 13, 0, 0, 0}, {12, 9, 16, 0, 0, 0},
+ {16, 10, 20, 0, 0, 0}, {24, 15, 25, 0, 0, 0}, {36, 25, 45, 0, 0, 0}};
+#define NFONT (sizeof(sys_fontlist)/sizeof(*sys_fontlist))
+
+/* here are the actual font size structs on msp's systems:
+MSW:
+font 8 5 9 8 5 11
+font 10 7 13 10 6 13
+font 12 9 16 14 8 16
+font 16 10 20 16 10 18
+font 24 15 25 16 10 18
+font 36 25 42 36 22 41
+
+linux:
+font 8 5 9 8 5 9
+font 10 7 13 12 7 13
+font 12 9 16 14 9 15
+font 16 10 20 16 10 19
+font 24 15 25 24 15 24
+font 36 25 42 36 22 41
+*/
+
+static t_fontinfo *sys_findfont(int fontsize)
+{
+ unsigned int i;
+ t_fontinfo *fi;
+ for (i = 0, fi = sys_fontlist; i < (NFONT-1); i++, fi++)
+ if (fontsize < fi[1].fi_fontsize) return (fi);
+ return (sys_fontlist + (NFONT-1));
+}
+
+int sys_nearestfontsize(int fontsize)
+{
+ return (sys_findfont(fontsize)->fi_fontsize);
+}
+
+int sys_hostfontsize(int fontsize)
+{
+ return (sys_findfont(fontsize)->fi_hostfontsize);
+}
+
+int sys_fontwidth(int fontsize)
+{
+ return (sys_findfont(fontsize)->fi_width);
+}
+
+int sys_fontheight(int fontsize)
+{
+ return (sys_findfont(fontsize)->fi_height);
+}
+
+int sys_defaultfont;
+#ifdef MSW
+#define DEFAULTFONT 12
+#else
+#define DEFAULTFONT 10
+#endif
+
+static void openit(const char *dirname, const char *filename)
+{
+ char dirbuf[MAXPDSTRING], *nameptr;
+ int fd = open_via_path(dirname, filename, "", dirbuf, &nameptr,
+ MAXPDSTRING, 0);
+ if (fd)
+ {
+ close (fd);
+ glob_evalfile(0, gensym(nameptr), gensym(dirbuf));
+ }
+ else
+ error("%s: can't open", filename);
+}
+
+/* this is called from the gui process. The first argument is the cwd, and
+succeeding args give the widths and heights of known fonts. We wait until
+these are known to open files and send messages specified on the command line.
+We ask the GUI to specify the "cwd" in case we don't have a local OS to get it
+from; for instance we could be some kind of RT embedded system. However, to
+really make this make sense we would have to implement
+open(), read(), etc, calls to be served somehow from the GUI too. */
+
+void glob_initfromgui(void *dummy, t_symbol *s, int argc, t_atom *argv)
+{
+ char *cwd = atom_getsymbolarg(0, argc, argv)->s_name;
+ t_namelist *nl;
+ unsigned int i;
+ int j;
+ int nhostfont = (argc-2)/3;
+ sys_oldtclversion = atom_getfloatarg(1, argc, argv);
+ if (argc != 2 + 3 * nhostfont) bug("glob_initfromgui");
+ for (i = 0; i < NFONT; i++)
+ {
+ int best = 0;
+ int wantheight = sys_fontlist[i].fi_maxheight;
+ int wantwidth = sys_fontlist[i].fi_maxwidth;
+ for (j = 1; j < nhostfont; j++)
+ {
+ if (atom_getintarg(3 * j + 4, argc, argv) <= wantheight &&
+ atom_getintarg(3 * j + 3, argc, argv) <= wantwidth)
+ best = j;
+ }
+ /* best is now the host font index for the desired font index i. */
+ sys_fontlist[i].fi_hostfontsize =
+ atom_getintarg(3 * best + 2, argc, argv);
+ sys_fontlist[i].fi_width = atom_getintarg(3 * best + 3, argc, argv);
+ sys_fontlist[i].fi_height = atom_getintarg(3 * best + 4, argc, argv);
+ }
+#if 0
+ for (i = 0; i < 6; i++)
+ fprintf(stderr, "font (%d %d %d) -> (%d %d %d)\n",
+ sys_fontlist[i].fi_fontsize,
+ sys_fontlist[i].fi_maxwidth,
+ sys_fontlist[i].fi_maxheight,
+ sys_fontlist[i].fi_hostfontsize,
+ sys_fontlist[i].fi_width,
+ sys_fontlist[i].fi_height);
+#endif
+ /* load dynamic libraries specified with "-lib" args */
+ for (nl = sys_externlist; nl; nl = nl->nl_next)
+ if (!sys_load_lib(0, nl->nl_string))
+ post("%s: can't load library", nl->nl_string);
+ /* open patches specifies with "-open" args */
+ for (nl = sys_openlist; nl; nl = nl->nl_next)
+ openit(cwd, nl->nl_string);
+ namelist_free(sys_openlist);
+ sys_openlist = 0;
+ /* send messages specified with "-send" args */
+ for (nl = sys_messagelist; nl; nl = nl->nl_next)
+ {
+ t_binbuf *b = binbuf_new();
+ binbuf_text(b, nl->nl_string, strlen(nl->nl_string));
+ binbuf_eval(b, 0, 0, 0);
+ binbuf_free(b);
+ }
+ namelist_free(sys_messagelist);
+ sys_messagelist = 0;
+}
+
+static void sys_afterargparse(void);
+
+static void pd_makeversion(void)
+{
+ char foo[100];
+ sprintf(foo, "Pd version %d.%d-%d%s\n",PD_MAJOR_VERSION,
+ PD_MINOR_VERSION,PD_BUGFIX_VERSION,PD_TEST_VERSION);
+ pd_version = malloc(strlen(foo)+1);
+ strcpy(pd_version, foo);
+}
+
+/* this is called from main() in s_entry.c */
+int sys_main(int argc, char **argv)
+{
+ int i, noprefs;
+ sys_externalschedlib = 0;
+ sys_extraflags = 0;
+#ifdef PD_DEBUG
+ fprintf(stderr, "Pd: COMPILED FOR DEBUGGING\n");
+#endif
+ pd_init(); /* start the message system */
+ sys_findprogdir(argv[0]); /* set sys_progname, guipath */
+ for (i = noprefs = 0; i < argc; i++) /* prescan args for noprefs */
+ if (!strcmp(argv[i], "-noprefs"))
+ noprefs = 1;
+ if (!noprefs)
+ sys_loadpreferences(); /* load default settings */
+#ifndef MSW
+ sys_rcfile(); /* parse the startup file */
+#endif
+ if (sys_argparse(argc-1, argv+1)) /* parse cmd line */
+ return (1);
+ sys_afterargparse(); /* post-argparse settings */
+ /* build version string from defines in m_pd.h */
+ pd_makeversion();
+ if (sys_verbose || sys_version) fprintf(stderr, "%scompiled %s %s\n",
+ 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 */
+ return(1);
+ if (sys_externalschedlib)
+ {
+#ifdef MSW
+ typedef int (*t_externalschedlibmain)(char *);
+ t_externalschedlibmain externalmainfunc;
+ HINSTANCE ntdll;
+ char filename[MAXPDSTRING];
+
+ sprintf(filename, "%s.dll", sys_externalschedlibname);
+ sys_bashfilename(filename, filename);
+ ntdll = LoadLibrary(filename);
+ if (!ntdll)
+ {
+ post("%s: couldn't load external scheduler lib ", filename);
+ return (0);
+ }
+ externalmainfunc = (t_externalschedlibmain)GetProcAddress(ntdll,
+ "main");
+ return((*externalmainfunc)(sys_extraflagsstring));
+#else
+ return (0);
+#endif
+ }
+ else
+ {
+ /* open audio and MIDI */
+ sys_reopen_midi();
+ sys_reopen_audio();
+ /* run scheduler until it quits */
+ return (m_mainloop());
+ }
+}
+
+static char *(usagemessage[]) = {
+"usage: pd [-flags] [file]...\n",
+"\naudio configuration flags:\n",
+"-r <n> -- specify sample rate\n",
+"-audioindev ... -- audio in devices; e.g., \"1,3\" for first and third\n",
+"-audiooutdev ... -- audio out devices (same)\n",
+"-audiodev ... -- specify input and output together\n",
+"-inchannels ... -- audio input channels (by device, like \"2\" or \"16,8\")\n",
+"-outchannels ... -- number of audio out channels (same)\n",
+"-channels ... -- specify both input and output channels\n",
+"-audiobuf <n> -- specify size of audio buffer in msec\n",
+"-blocksize <n> -- specify audio I/O block size in sample frames\n",
+"-sleepgrain <n> -- specify number of milliseconds to sleep when idle\n",
+"-nodac -- suppress audio output\n",
+"-noadc -- suppress audio input\n",
+"-noaudio -- suppress audio input and output (-nosound is synonym) \n",
+"-listdev -- list audio and MIDI devices\n",
+
+#ifdef USEAPI_OSS
+"-oss -- use OSS audio API\n",
+"-32bit ----- allow 32 bit OSS audio (for RME Hammerfall)\n",
+#endif
+
+#ifdef USEAPI_ALSA
+"-alsa -- use ALSA audio API\n",
+"-alsaadd <name> -- add an ALSA device name to list\n",
+#endif
+
+#ifdef USEAPI_JACK
+"-jack -- use JACK audio API\n",
+#endif
+
+#ifdef USEAPI_PORTAUDIO
+#ifdef MSW
+"-asio -- use ASIO audio driver (via Portaudio)\n",
+"-pa -- synonym for -asio\n",
+#else
+"-pa -- use Portaudio API\n",
+#endif
+#endif
+
+#ifdef USEAPI_MMIO
+"-mmio -- use MMIO audio API (default for Windows)\n",
+#endif
+" (default audio API for this platform: ", API_DEFSTRING, ")\n\n",
+
+"\nMIDI configuration flags:\n",
+"-midiindev ... -- midi in device list; e.g., \"1,3\" for first and third\n",
+"-midioutdev ... -- midi out device list, same format\n",
+"-mididev ... -- specify -midioutdev and -midiindev together\n",
+"-nomidiin -- suppress MIDI input\n",
+"-nomidiout -- suppress MIDI output\n",
+"-nomidi -- suppress MIDI input and output\n",
+#ifdef USEAPI_ALSA
+"-alsamidi -- use ALSA midi API\n",
+#endif
+
+
+"\nother flags:\n",
+"-path <path> -- add to file search path\n",
+"-nostdpath -- don't search standard (\"extra\") directory\n",
+"-stdpath -- search standard directory (true by default)\n",
+"-helppath <path> -- add to help file search path\n",
+"-open <file> -- open file(s) on startup\n",
+"-lib <file> -- load object library(s)\n",
+"-font <n> -- specify default font size in points\n",
+"-typeface <name> -- specify default font (default: courier)\n",
+"-verbose -- extra printout on startup and when searching for files\n",
+"-version -- don't run Pd; just print out which version it is \n",
+"-d <n> -- specify debug level\n",
+"-noloadbang -- suppress all loadbangs\n",
+"-stderr -- send printout to standard error instead of GUI\n",
+"-nogui -- suppress starting the GUI\n",
+"-guiport <n> -- connect to pre-existing GUI over port <n>\n",
+"-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
+"-rt or -realtime -- use real-time priority\n",
+"-nrt -- don't use real-time priority\n",
+#endif
+"-nosleep -- spin, don't sleep (may lower latency on multi-CPUs)\n",
+};
+
+static void sys_parsedevlist(int *np, int *vecp, int max, char *str)
+{
+ int n = 0;
+ while (n < max)
+ {
+ if (!*str) break;
+ else
+ {
+ char *endp;
+ vecp[n] = strtol(str, &endp, 10);
+ if (endp == str)
+ break;
+ n++;
+ if (!endp)
+ break;
+ str = endp + 1;
+ }
+ }
+ *np = n;
+}
+
+static int sys_getmultidevchannels(int n, int *devlist)
+{
+ int sum = 0;
+ if (n<0)return(-1);
+ if (n==0)return 0;
+ while(n--)sum+=*devlist++;
+ return sum;
+}
+
+
+ /* this routine tries to figure out where to find the auxilliary files
+ Pd will need to run. This is either done by looking at the command line
+ invokation for Pd, or if that fails, by consulting the variable
+ INSTALL_PREFIX. In MSW, we don't try to use INSTALL_PREFIX. */
+void sys_findprogdir(char *progname)
+{
+ char sbuf[MAXPDSTRING], sbuf2[MAXPDSTRING], *sp;
+ char *lastslash;
+#ifdef UNISTD
+ struct stat statbuf;
+#endif
+
+ /* find out by what string Pd was invoked; put answer in "sbuf". */
+#ifdef MSW
+ GetModuleFileName(NULL, sbuf2, sizeof(sbuf2));
+ sbuf2[MAXPDSTRING-1] = 0;
+ sys_unbashfilename(sbuf2, sbuf);
+#endif /* MSW */
+#ifdef UNISTD
+ strncpy(sbuf, progname, MAXPDSTRING);
+ sbuf[MAXPDSTRING-1] = 0;
+#endif
+ lastslash = strrchr(sbuf, '/');
+ if (lastslash)
+ {
+ /* bash last slash to zero so that sbuf is directory pd was in,
+ e.g., ~/pd/bin */
+ *lastslash = 0;
+ /* go back to the parent from there, e.g., ~/pd */
+ lastslash = strrchr(sbuf, '/');
+ if (lastslash)
+ {
+ strncpy(sbuf2, sbuf, lastslash-sbuf);
+ sbuf2[lastslash-sbuf] = 0;
+ }
+ else strcpy(sbuf2, "..");
+ }
+ else
+ {
+ /* no slashes found. Try INSTALL_PREFIX. */
+#ifdef INSTALL_PREFIX
+ strcpy(sbuf2, INSTALL_PREFIX);
+#else
+ strcpy(sbuf2, ".");
+#endif
+ }
+ /* now we believe sbuf2 holds the parent directory of the directory
+ 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
+ .../doc
+ and in "complicated" unix installations, it's:
+ .../bin/pd
+ .../lib/pd/bin/pd-gui
+ .../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:
+ .../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;
+ strcat(sbuf, "/lib/pd");
+ if (stat(sbuf, &statbuf) >= 0)
+ {
+ /* 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
+}
+
+#ifdef MSW
+static int sys_mmio = 1;
+#else
+static int sys_mmio = 0;
+#endif
+
+int sys_argparse(int argc, char **argv)
+{
+ char sbuf[MAXPDSTRING];
+ int i;
+ while ((argc > 0) && **argv == '-')
+ {
+ if (!strcmp(*argv, "-r") && argc > 1 &&
+ sscanf(argv[1], "%d", &sys_main_srate) >= 1)
+ {
+ argc -= 2;
+ argv += 2;
+ }
+ else if (!strcmp(*argv, "-inchannels") && (argc > 1))
+ {
+ sys_parsedevlist(&sys_nchin,
+ sys_chinlist, MAXAUDIOINDEV, argv[1]);
+
+ if (!sys_nchin)
+ goto usage;
+
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-outchannels") && (argc > 1))
+ {
+ sys_parsedevlist(&sys_nchout, sys_choutlist,
+ MAXAUDIOOUTDEV, argv[1]);
+
+ if (!sys_nchout)
+ goto usage;
+
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-channels") && (argc > 1))
+ {
+ sys_parsedevlist(&sys_nchin, sys_chinlist,MAXAUDIOINDEV,
+ argv[1]);
+ sys_parsedevlist(&sys_nchout, sys_choutlist,MAXAUDIOOUTDEV,
+ argv[1]);
+
+ if (!sys_nchout)
+ goto usage;
+
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-soundbuf") || !strcmp(*argv, "-audiobuf") && (argc > 1))
+ {
+ sys_main_advance = atoi(argv[1]);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-callback"))
+ {
+ sys_main_callback = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-blocksize"))
+ {
+ sys_setblocksize(atoi(argv[1]));
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-sleepgrain") && (argc > 1))
+ {
+ sys_sleepgrain = 1000 * atof(argv[1]);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-nodac"))
+ {
+ sys_nsoundout=0;
+ sys_nchout = 0;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-noadc"))
+ {
+ sys_nsoundin=0;
+ sys_nchin = 0;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-nosound") || !strcmp(*argv, "-noaudio"))
+ {
+ sys_nsoundin=sys_nsoundout = 0;
+ sys_nchin = sys_nchout = 0;
+ argc--; argv++;
+ }
+#ifdef USEAPI_OSS
+ else if (!strcmp(*argv, "-oss"))
+ {
+ sys_set_audio_api(API_OSS);
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-32bit"))
+ {
+ sys_set_audio_api(API_OSS);
+ oss_set32bit();
+ argc--; argv++;
+ }
+#endif
+#ifdef USEAPI_ALSA
+ else if (!strcmp(*argv, "-alsa"))
+ {
+ sys_set_audio_api(API_ALSA);
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-alsaadd") && (argc > 1))
+ {
+ if (argc > 1)
+ alsa_adddev(argv[1]);
+ else goto usage;
+ argc -= 2; argv +=2;
+ }
+ else if (!strcmp(*argv, "-alsamidi"))
+ {
+ sys_set_midi_api(API_ALSA);
+ argc--; argv++;
+ }
+#endif
+#ifdef USEAPI_JACK
+ else if (!strcmp(*argv, "-jack"))
+ {
+ sys_set_audio_api(API_JACK);
+ argc--; argv++;
+ }
+#endif
+#ifdef USEAPI_PORTAUDIO
+ else if (!strcmp(*argv, "-pa") || !strcmp(*argv, "-portaudio")
+#ifdef MSW
+ || !strcmp(*argv, "-asio")
+#endif
+ )
+ {
+ sys_set_audio_api(API_PORTAUDIO);
+ sys_mmio = 0;
+ argc--; argv++;
+ }
+#endif
+#ifdef USEAPI_MMIO
+ else if (!strcmp(*argv, "-mmio"))
+ {
+ sys_set_audio_api(API_MMIO);
+ sys_mmio = 1;
+ argc--; argv++;
+ }
+#endif
+ else if (!strcmp(*argv, "-nomidiin"))
+ {
+ sys_nmidiin = 0;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-nomidiout"))
+ {
+ sys_nmidiout = 0;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-nomidi"))
+ {
+ sys_nmidiin = sys_nmidiout = 0;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-midiindev"))
+ {
+ sys_parsedevlist(&sys_nmidiin, sys_midiindevlist, MAXMIDIINDEV,
+ argv[1]);
+ if (!sys_nmidiin)
+ goto usage;
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-midioutdev") && (argc > 1))
+ {
+ sys_parsedevlist(&sys_nmidiout, sys_midioutdevlist, MAXMIDIOUTDEV,
+ argv[1]);
+ if (!sys_nmidiout)
+ goto usage;
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-mididev") && (argc > 1))
+ {
+ sys_parsedevlist(&sys_nmidiin, sys_midiindevlist, MAXMIDIINDEV,
+ argv[1]);
+ sys_parsedevlist(&sys_nmidiout, sys_midioutdevlist, MAXMIDIOUTDEV,
+ argv[1]);
+ if (!sys_nmidiout)
+ goto usage;
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-path") && (argc > 1))
+ {
+ sys_searchpath = namelist_append_files(sys_searchpath, argv[1]);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-nostdpath"))
+ {
+ sys_usestdpath = 0;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-stdpath"))
+ {
+ sys_usestdpath = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-helppath"))
+ {
+ sys_helppath = namelist_append_files(sys_helppath, argv[1]);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-open") && argc > 1)
+ {
+ sys_openlist = namelist_append_files(sys_openlist, argv[1]);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-lib") && argc > 1)
+ {
+ sys_externlist = namelist_append_files(sys_externlist, argv[1]);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-font") && argc > 1)
+ {
+ sys_defaultfont = sys_nearestfontsize(atoi(argv[1]));
+ argc -= 2;
+ argv += 2;
+ }
+ /* tb: font name { */
+ else if (!strcmp(*argv, "-typeface") && argc > 1)
+ {
+ strncpy(sys_font,*(argv+1),sizeof(sys_font)-1);
+ sys_font[sizeof(sys_font)-1] = 0;
+ argc -= 2;
+ argv += 2;
+ }
+ /* } tb */
+ else if (!strcmp(*argv, "-verbose"))
+ {
+ sys_verbose++;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-version"))
+ {
+ sys_version = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-d") && argc > 1 &&
+ sscanf(argv[1], "%d", &sys_debuglevel) >= 1)
+ {
+ argc -= 2;
+ argv += 2;
+ }
+ else if (!strcmp(*argv, "-noloadbang"))
+ {
+ sys_noloadbang = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-nogui"))
+ {
+ sys_printtostderr = sys_nogui = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-guiport") && argc > 1 &&
+ sscanf(argv[1], "%d", &sys_guisetportnumber) >= 1)
+ {
+ argc -= 2;
+ argv += 2;
+ }
+ else if (!strcmp(*argv, "-stderr"))
+ {
+ sys_printtostderr = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-guicmd") && argc > 1)
+ {
+ sys_guicmd = argv[1];
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-send") && argc > 1)
+ {
+ sys_messagelist = namelist_append(sys_messagelist, argv[1], 1);
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-listdev"))
+ {
+ sys_listplease = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-schedlib"))
+ {
+ sys_externalschedlib = 1;
+ strcpy(sys_externalschedlibname, argv[1]);
+ argv += 2;
+ argc -= 2;
+ }
+ else if (!strcmp(*argv, "-extraflags"))
+ {
+ sys_extraflags = 1;
+ strcpy(sys_extraflagsstring, argv[1]);
+ argv += 2;
+ argc -= 2;
+ }
+#ifdef UNISTD
+ else if (!strcmp(*argv, "-rt") || !strcmp(*argv, "-realtime"))
+ {
+ sys_hipriority = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-nrt"))
+ {
+ sys_hipriority = 0;
+ argc--; argv++;
+ }
+#endif
+ else if (!strcmp(*argv, "-nosleep"))
+ {
+ sys_nosleep = 1;
+ argc--; argv++;
+ }
+ else if (!strcmp(*argv, "-soundindev") ||
+ !strcmp(*argv, "-audioindev"))
+ {
+ sys_parsedevlist(&sys_nsoundin, sys_soundindevlist,
+ MAXAUDIOINDEV, argv[1]);
+ if (!sys_nsoundin)
+ goto usage;
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-soundoutdev") ||
+ !strcmp(*argv, "-audiooutdev"))
+ {
+ sys_parsedevlist(&sys_nsoundout, sys_soundoutdevlist,
+ MAXAUDIOOUTDEV, argv[1]);
+ if (!sys_nsoundout)
+ goto usage;
+ argc -= 2; argv += 2;
+ }
+ else if ((!strcmp(*argv, "-sounddev") || !strcmp(*argv, "-audiodev"))
+ && (argc > 1))
+ {
+ sys_parsedevlist(&sys_nsoundin, sys_soundindevlist,
+ MAXAUDIOINDEV, argv[1]);
+ sys_parsedevlist(&sys_nsoundout, sys_soundoutdevlist,
+ MAXAUDIOOUTDEV, argv[1]);
+ if (!sys_nsoundout)
+ goto usage;
+ argc -= 2; argv += 2;
+ }
+ else if (!strcmp(*argv, "-noprefs")) /* did this earlier */
+ argc--, argv++;
+ else
+ {
+ unsigned int i;
+ usage:
+ for (i = 0; i < sizeof(usagemessage)/sizeof(*usagemessage); i++)
+ fprintf(stderr, "%s", usagemessage[i]);
+ return (1);
+ }
+ }
+ if (!sys_defaultfont)
+ sys_defaultfont = DEFAULTFONT;
+ for (; argc > 0; argc--, argv++)
+ sys_openlist = namelist_append_files(sys_openlist, *argv);
+
+
+ return (0);
+}
+
+int sys_getblksize(void)
+{
+ return (DEFDACBLKSIZE);
+}
+
+ /* stuff to do, once, after calling sys_argparse() -- which may itself
+ be called more than once (first from "settings, second from .pdrc, then
+ from command-line arguments */
+static void sys_afterargparse(void)
+{
+ char sbuf[MAXPDSTRING];
+ int i;
+ int naudioindev, audioindev[MAXAUDIOINDEV], chindev[MAXAUDIOINDEV];
+ int naudiooutdev, audiooutdev[MAXAUDIOOUTDEV], choutdev[MAXAUDIOOUTDEV];
+ int nchindev, nchoutdev, rate, advance, callback;
+ int nmidiindev = 0, midiindev[MAXMIDIINDEV];
+ int nmidioutdev = 0, midioutdev[MAXMIDIOUTDEV];
+ /* add "extra" library to path */
+ strncpy(sbuf, sys_libdir->s_name, MAXPDSTRING-30);
+ sbuf[MAXPDSTRING-30] = 0;
+ strcat(sbuf, "/extra");
+ sys_setextrapath(sbuf);
+ /* add "doc/5.reference" library to helppath */
+ strncpy(sbuf, sys_libdir->s_name, MAXPDSTRING-30);
+ sbuf[MAXPDSTRING-30] = 0;
+ strcat(sbuf, "/doc/5.reference");
+ sys_helppath = namelist_append_files(sys_helppath, sbuf);
+ /* correct to make audio and MIDI device lists zero based. On
+ MMIO, however, "1" really means the second device (the first one
+ is "mapper" which is was not included when the command args were
+ set up, so we leave it that way for compatibility. */
+ if (!sys_mmio)
+ {
+ for (i = 0; i < sys_nsoundin; i++)
+ sys_soundindevlist[i]--;
+ for (i = 0; i < sys_nsoundout; i++)
+ sys_soundoutdevlist[i]--;
+ }
+ for (i = 0; i < sys_nmidiin; i++)
+ sys_midiindevlist[i]--;
+ for (i = 0; i < sys_nmidiout; i++)
+ sys_midioutdevlist[i]--;
+ if (sys_listplease)
+ sys_listdevs();
+
+ /* get the current audio parameters. These are set
+ by the preferences mechanism (sys_loadpreferences()) or
+ else are the default. Overwrite them with any results
+ of argument parsing, and store them again. */
+ sys_get_audio_params(&naudioindev, audioindev, chindev,
+ &naudiooutdev, audiooutdev, choutdev, &rate, &advance, &callback);
+ if (sys_nchin >= 0)
+ {
+ nchindev = sys_nchin;
+ for (i = 0; i < nchindev; i++)
+ chindev[i] = sys_chinlist[i];
+ }
+ else nchindev = naudioindev;
+ if (sys_nsoundin >= 0)
+ {
+ naudioindev = sys_nsoundin;
+ for (i = 0; i < naudioindev; i++)
+ audioindev[i] = sys_soundindevlist[i];
+ }
+
+ if (sys_nchout >= 0)
+ {
+ nchoutdev = sys_nchout;
+ for (i = 0; i < nchoutdev; i++)
+ choutdev[i] = sys_choutlist[i];
+ }
+ else nchoutdev = naudiooutdev;
+ if (sys_nsoundout >= 0)
+ {
+ naudiooutdev = sys_nsoundout;
+ for (i = 0; i < naudiooutdev; i++)
+ audiooutdev[i] = sys_soundoutdevlist[i];
+ }
+ sys_get_midi_params(&nmidiindev, midiindev, &nmidioutdev, midioutdev);
+ if (sys_nmidiin >= 0)
+ {
+ post("sys_nmidiin %d, nmidiindev %d", sys_nmidiin, nmidiindev);
+ nmidiindev = sys_nmidiin;
+ for (i = 0; i < nmidiindev; i++)
+ midiindev[i] = sys_midiindevlist[i];
+ }
+ if (sys_nmidiout >= 0)
+ {
+ nmidioutdev = sys_nmidiout;
+ for (i = 0; i < nmidioutdev; i++)
+ midioutdev[i] = sys_midioutdevlist[i];
+ }
+ if (sys_main_advance)
+ advance = sys_main_advance;
+ if (sys_main_srate)
+ rate = sys_main_srate;
+ if (sys_main_callback)
+ callback = sys_main_callback;
+ sys_set_audio_settings(naudioindev, audioindev, nchindev, chindev,
+ naudiooutdev, audiooutdev, nchoutdev, choutdev, rate, advance,
+ callback);
+ sys_open_midi(nmidiindev, midiindev, nmidioutdev, midioutdev, 0);
+}
+
+static void sys_addreferencepath(void)
+{
+ char sbuf[MAXPDSTRING];
+}
diff --git a/src/u_main.tk b/src/u_main.tk
index 2a736ca5d..8da3b4503 100644
--- a/src/u_main.tk
+++ b/src/u_main.tk
@@ -1,14 +1,4 @@
#!/usr/bin/wish
-
-# 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
-} elseif { $tcl_platform(os) == "Darwin" } {
- set pd_nt 2
-} else {
- set pd_nt 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.
@@ -21,6 +11,35 @@ if { $tcl_platform(platform) == "windows" } {
#
# 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}
+ font create menuFont -family Tahoma -size 11
+} elseif { $tcl_platform(os) == "Darwin" } {
+ set pd_nt 2
+ set defaultFontFamily Monaco
+} else {
+ set pd_nt 0
+ set defaultFontFamily {Bitstream Vera Sans Mono}
+}
+
+# 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 normal
+# 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
@@ -44,12 +63,8 @@ if {$pd_nt == 1} {
if {$pd_nt == 2} {
# turn on James Tittle II's fast drawing
set tk::mac::useCGDrawing 1
- # set minimum line size for anti-aliasing. If set to 1 or 0, then every
- # line will be anti-aliased. While this makes connections and circles in
- # [bng] and such look really good, it makes boxes and messages look out of
- # focus. Setting this to 2 makes it so the thick audio rate connections
- # are anti-aliased. <hans@at.or.at> 2005-06-09
- set tk::mac::CGAntialiasLimit 2
+# anti-alias all lines that need it
+ set tk::mac::CGAntialiasLimit 0
global pd_guidir
global pd_tearoff
set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]]
@@ -132,6 +147,15 @@ if {$pd_nt != 2} {
.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
@@ -175,7 +199,7 @@ pack .controls.dio -side right -padx 20
frame .printout
-text .printout.text -relief raised -bd 2 -font -*-courier-bold--normal--12-* \
+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"
@@ -365,7 +389,7 @@ proc menu_opentext {filename} {
global pd_myversion
set name [format ".help%d" $doc_number]
toplevel $name
- text $name.text -relief raised -bd 2 -font -*-times-regular--normal--14-* \
+ 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
@@ -1143,6 +1167,18 @@ proc pdtk_canvas_new {name width height geometry editable} {
$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]
@@ -1267,6 +1303,7 @@ 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]
@@ -1280,8 +1317,7 @@ proc pdtk_array_listview_new {id arrayName page} {
set $windowName.lb [listbox $windowName.lb -height 20 -width 25\
-selectmode extended \
-relief solid -background white -borderwidth 1 \
- -font [format -*-courier-bold--normal--%d-* \
- $font] \
+ -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]
@@ -1385,9 +1421,7 @@ proc pdtk_array_listview_paste {arrayName} {
proc pdtk_array_listview_edit {arrayName page font} {
global pd_array_listview_entry
global pd_nt
- if {$pd_nt == 0} {
- set font [expr $font - 2]
- }
+ global fontname fontweight
set lbName [format ".%sArrayWindow.lb" $arrayName]
if {[winfo exists $lbName.entry]} {
pdtk_array_listview_update_entry \
@@ -1399,7 +1433,7 @@ proc pdtk_array_listview_edit {arrayName page font} {
set bbox [$lbName bbox $itemNum]
set y [expr [lindex $bbox 1] - 4]
set $lbName.entry [entry $lbName.entry \
- -font [format -*-courier-bold--normal--%d-* $font]]
+ -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
@@ -1875,6 +1909,8 @@ proc pdtk_gatom_dialog {id initwidth initlo inithi \
set vid [string trimleft $id .]
+ global pd_nt
+
set var_gatomwidth [concat gatomwidth_$vid]
global $var_gatomwidth
set var_gatomlo [concat gatomlo_$vid]
@@ -1899,87 +1935,96 @@ proc pdtk_gatom_dialog {id initwidth initlo inithi \
set $var_gatomsymto [gatom_unescape $symto]
toplevel $id
- wm title $id {Atom}
+ wm title $id "atom box properties"
+ wm resizable $id 0 0
wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id]
- frame $id.buttonframe
- pack $id.buttonframe -side bottom -fill x -pady 2m
+ 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.cancel -side left -expand 1
- pack $id.buttonframe.apply -side left -expand 1
pack $id.buttonframe.ok -side left -expand 1
- frame $id.paramsymto
- pack $id.paramsymto -side bottom
- label $id.paramsymto.entryname -text {send symbol}
- entry $id.paramsymto.entry -textvariable $var_gatomsymto -width 20
- pack $id.paramsymto.entryname $id.paramsymto.entry -side left
-
- frame $id.paramsymfrom
- pack $id.paramsymfrom -side bottom
- label $id.paramsymfrom.entryname -text {receive symbol}
- entry $id.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 20
- pack $id.paramsymfrom.entryname $id.paramsymfrom.entry -side left
-
- frame $id.radio
- pack $id.radio -side bottom
- label $id.radio.label -text {show label on:}
- frame $id.radio.l
- frame $id.radio.r
- pack $id.radio.label -side top
- pack $id.radio.l $id.radio.r -side left
- radiobutton $id.radio.l.radio0 -value 0 \
- -variable $var_gatomwherelabel \
- -text "left"
- radiobutton $id.radio.l.radio1 -value 1 \
- -variable $var_gatomwherelabel \
- -text "right"
- radiobutton $id.radio.r.radio2 -value 2 \
- -variable $var_gatomwherelabel \
- -text "top"
- radiobutton $id.radio.r.radio3 -value 3 \
- -variable $var_gatomwherelabel \
- -text "bottom"
- pack $id.radio.l.radio0 $id.radio.l.radio1 -side top -anchor w
- pack $id.radio.r.radio2 $id.radio.r.radio3 -side top -anchor w
-
-
- frame $id.paramlabel
- pack $id.paramlabel -side bottom
- label $id.paramlabel.entryname -text label
- entry $id.paramlabel.entry -textvariable $var_gatomlabel -width 20
- pack $id.paramlabel.entryname $id.paramlabel.entry -side left
-
- frame $id.paramhi
- pack $id.paramhi -side bottom
- label $id.paramhi.entryname -text "upper limit"
- entry $id.paramhi.entry -textvariable $var_gatomhi -width 8
- pack $id.paramhi.entryname $id.paramhi.entry -side left
-
- frame $id.paramlo
- pack $id.paramlo -side bottom
- label $id.paramlo.entryname -text "lower limit"
- entry $id.paramlo.entry -textvariable $var_gatomlo -width 8
- pack $id.paramlo.entryname $id.paramlo.entry -side left
-
- frame $id.params
- pack $id.params -side bottom
- label $id.params.entryname -text width
- entry $id.params.entry -textvariable $var_gatomwidth -width 4
- pack $id.params.entryname $id.params.entry -side left
-
-
-
- bind $id.paramhi.entry <KeyPress-Return> [concat dogatom_ok $id]
- bind $id.paramlo.entry <KeyPress-Return> [concat dogatom_ok $id]
+ 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.paramhi.entry
- pdtk_standardkeybindings $id.paramlo.entry
+ 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
@@ -2132,7 +2177,7 @@ proc iemgui_clip_fontsize {id} {
if {[eval concat $$var_iemgui_gn_fs] < $iemgui_define_min_fontsize} {
set $var_iemgui_gn_fs $iemgui_define_min_fontsize
- $id.gnfs.fs_ent configure -textvariable $var_iemgui_gn_fs
+ $id.label.fs_ent configure -textvariable $var_iemgui_gn_fs
}
}
@@ -2146,20 +2191,20 @@ proc iemgui_set_col_example {id} {
set var_iemgui_lcol [concat iemgui_lcol_$vid]
global $var_iemgui_lcol
- $id.col_example_choose.lb_bk configure \
+ $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.col_example_choose.fr_bk configure \
+ $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.col_example_choose.fr_bk configure \
+ $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]] \
@@ -2243,17 +2288,27 @@ proc iemgui_lilo {id} {
}
}
-proc iemgui_toggle_font {id} {
+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 [expr [eval concat $$var_iemgui_gn_f] + 1]
- if {[eval concat $$var_iemgui_gn_f] > 2} {set $var_iemgui_gn_f 0}
- if {[eval concat $$var_iemgui_gn_f] == 0} {$id.gnfs.fb configure -text "courier" -font {courier 10 bold}}
- if {[eval concat $$var_iemgui_gn_f] == 1} {$id.gnfs.fb configure -text "helvetica" -font {helvetica 10 bold}}
- if {[eval concat $$var_iemgui_gn_f] == 2} {$id.gnfs.fb configure -text "times" -font {times 10 bold}}
+ 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} {
@@ -2399,6 +2454,9 @@ proc pdtk_iemgui_dialog {id mainheader \
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]
@@ -2486,7 +2544,8 @@ proc pdtk_iemgui_dialog {id mainheader \
set $var_iemgui_l2_f1_b0 0
toplevel $id
- wm title $id [format "%s-PROPERTIES" $mainheader]
+ 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
@@ -2519,7 +2578,7 @@ proc pdtk_iemgui_dialog {id mainheader \
$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 "---------------------------------"
+ label $id.space1 -text ""
pack $id.space1 -side top }
frame $id.para
@@ -2548,157 +2607,189 @@ proc pdtk_iemgui_dialog {id mainheader \
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}
- if { $snd != "nosndno" || $rcv != "norcvno" } {
- label $id.space2 -text "---------------------------------"
- pack $id.space2 -side top }
+
+ frame $id.spacer0 -height 4
+ pack $id.spacer0 -side top
- frame $id.snd
- pack $id.snd -side top
- label $id.snd.dummy1 -text "" -width 2
- label $id.snd.lab -text "send-symbol:" -width 12
- entry $id.snd.ent -textvariable $var_iemgui_snd -width 20
+ 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.snd.dummy1 $id.snd.lab $id.snd.ent -side left}
+ pack $id.s_r.send.lab $id.s_r.send.ent -side left}
- frame $id.rcv
- pack $id.rcv -side top
- label $id.rcv.lab -text "receive-symbol:" -width 15
- entry $id.rcv.ent -textvariable $var_iemgui_rcv -width 20
+ 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.rcv.lab $id.rcv.ent -side left}
+ pack $id.s_r.receive.lab $id.s_r.receive.ent -side left}
- frame $id.gnam
- pack $id.gnam -side top
- label $id.gnam.head -text "--------------label:---------------"
- label $id.gnam.dummy1 -text "" -width 1
- label $id.gnam.lab -text "name:" -width 6
- entry $id.gnam.ent -textvariable $var_iemgui_gui_nam -width 29
- label $id.gnam.dummy2 -text "" -width 1
- pack $id.gnam.head -side top
- pack $id.gnam.dummy1 $id.gnam.lab $id.gnam.ent $id.gnam.dummy2 -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
- frame $id.gnxy
- pack $id.gnxy -side top
- label $id.gnxy.x_lab -text "x_off:" -width 6
- entry $id.gnxy.x_ent -textvariable $var_iemgui_gn_dx -width 5
- label $id.gnxy.dummy1 -text " " -width 10
- label $id.gnxy.y_lab -text "y_off:" -width 6
- entry $id.gnxy.y_ent -textvariable $var_iemgui_gn_dy -width 5
- pack $id.gnxy.x_lab $id.gnxy.x_ent $id.gnxy.dummy1 \
- $id.gnxy.y_lab $id.gnxy.y_ent -side left
+ 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.gnfs
- pack $id.gnfs -side top
- label $id.gnfs.f_lab -text "font:" -width 6
- if {[eval concat $$var_iemgui_gn_f] == 0} {
- button $id.gnfs.fb -text "courier" -font {courier 10 bold} -width 7 -command "iemgui_toggle_font $id" }
- if {[eval concat $$var_iemgui_gn_f] == 1} {
- button $id.gnfs.fb -text "helvetica" -font {helvetica 10 bold} -width 7 -command "iemgui_toggle_font $id" }
- if {[eval concat $$var_iemgui_gn_f] == 2} {
- button $id.gnfs.fb -text "times" -font {times 10 bold} -width 7 -command "iemgui_toggle_font $id" }
- label $id.gnfs.dummy1 -text "" -width 1
- label $id.gnfs.fs_lab -text "fontsize:" -width 8
- entry $id.gnfs.fs_ent -textvariable $var_iemgui_gn_fs -width 5
- pack $id.gnfs.f_lab $id.gnfs.fb $id.gnfs.dummy1 \
- $id.gnfs.fs_lab $id.gnfs.fs_ent -side left
+ 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.col_head -text "--------------colors:--------------"
- pack $id.col_head -side top
+ 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
- frame $id.col_select
- pack $id.col_select -side top
- radiobutton $id.col_select.radio0 -value 0 -variable $var_iemgui_l2_f1_b0 \
- -text "backgd" -width 5
- radiobutton $id.col_select.radio1 -value 1 -variable $var_iemgui_l2_f1_b0 \
- -text "front" -width 5
- radiobutton $id.col_select.radio2 -value 2 -variable $var_iemgui_l2_f1_b0 \
- -text "label" -width 5
+ 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.col_select.radio0 $id.col_select.radio1 $id.col_select.radio2 -side left
- } else {pack $id.col_select.radio0 $id.col_select.radio2 -side left}
+ 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.col_example_choose
- pack $id.col_example_choose -side top
- button $id.col_example_choose.but -text "compose color" -width 10 \
+ 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"
- label $id.col_example_choose.dummy1 -text "" -width 1
+ pack $id.colors.sections.but -side left -anchor w -padx 10 -pady 5 \
+ -expand yes -fill x
if { [eval concat $$var_iemgui_fcol] >= 0 } {
- button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \
+ 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]] -pady 2
+ -activeforeground [format "#%6.6x" [eval concat $$var_iemgui_fcol]] \
+ -font [list $current_font 12 $fontweight] -padx 2 -pady 2 -relief ridge
} else {
- button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \
+ 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]] -pady 2}
- button $id.col_example_choose.lb_bk -text "testlabel" -width 7 \
+ -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]] -pady 2
-
- pack $id.col_example_choose.but $id.col_example_choose.dummy1 \
- $id.col_example_choose.fr_bk $id.col_example_choose.lb_bk -side left
+ -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
- label $id.space3 -text "------or click color preset:-------"
- pack $id.space3 -side top
+ 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.bcol
- pack $id.bcol -side top
- foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 16579836 14737632 12369084 \
- 16572640 16572608 16579784 14220504 14220540 14476540 16308476 } {
- button $id.bcol.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] \
- -font {courier 2 normal} -padx 7 -pady 6 \
- -command [format "iemgui_preset_col %s %d" $id $hexcol] }
- pack $id.bcol.c0 $id.bcol.c1 $id.bcol.c2 $id.bcol.c3 $id.bcol.c4 \
- $id.bcol.c5 $id.bcol.c6 $id.bcol.c7 $id.bcol.c8 $id.bcol.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.fcol
- pack $id.fcol -side top
- foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 10526880 8158332 6316128 \
- 16525352 16559172 15263784 1370132 2684148 3952892 16003312 } {
- button $id.fcol.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] \
- -font {courier 2 normal} -padx 7 -pady 6 \
- -command [format "iemgui_preset_col %s %d" $id $hexcol] }
- pack $id.fcol.c0 $id.fcol.c1 $id.fcol.c2 $id.fcol.c3 $id.fcol.c4 \
- $id.fcol.c5 $id.fcol.c6 $id.fcol.c7 $id.fcol.c8 $id.fcol.c9 -side left
-
- frame $id.lcol
- pack $id.lcol -side top
- foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 4210752 2105376 0 \
- 9177096 5779456 7874580 2641940 17488 5256 5767248 } {
- button $id.lcol.c$i -background [format "#%6.6x" $hexcol] \
- -activebackground [format "#%6.6x" $hexcol] \
- -font {courier 2 normal} -padx 7 -pady 6 \
- -command [format "iemgui_preset_col %s %d" $id $hexcol] }
- pack $id.lcol.c0 $id.lcol.c1 $id.lcol.c2 $id.lcol.c3 $id.lcol.c4 \
- $id.lcol.c5 $id.lcol.c6 $id.lcol.c7 $id.lcol.c8 $id.lcol.c9 -side left
-
-
- label $id.space4 -text "---------------------------------"
- pack $id.space4 -side top
-
- frame $id.cao
+ 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"
+ 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 \
- $id.cao.apply $id.cao.dummy2 \
- $id.cao.ok -side left
- label $id.space5 -text ""
- pack $id.space5 -side top
+ 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]}
@@ -2713,24 +2804,24 @@ proc pdtk_iemgui_dialog {id mainheader \
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.snd.ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.rcv.ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.gnam.ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.gnxy.x_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.gnxy.y_ent <KeyPress-Return> [concat iemgui_ok $id]
- bind $id.gnfs.fs_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.snd.ent
- pdtk_standardkeybindings $id.rcv.ent
- pdtk_standardkeybindings $id.gnam.ent
- pdtk_standardkeybindings $id.gnxy.x_ent
- pdtk_standardkeybindings $id.gnxy.y_ent
- pdtk_standardkeybindings $id.gnfs.fs_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
@@ -2808,6 +2899,7 @@ proc pdtk_array_dialog {id name n flags newone} {
toplevel $id
wm title $id {array}
+ wm resizable $id 0 0
wm protocol $id WM_DELETE_WINDOW [concat array_cancel $id]
frame $id.name
@@ -3265,18 +3357,21 @@ proc pdtk_pd_ctrlkey {name key shift} {
# seven "useful" font sizes.
# tb: user defined typefaces
-proc pdtk_pd_startup {version apilist midiapilist fontname} {
+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
+ 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 [concat $fontname -$i bold]
+ 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]
@@ -3523,8 +3618,12 @@ proc audio_popup_action {buttonname varname devlist 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] \
@@ -3805,8 +3904,12 @@ proc midi_popup_action {buttonname varname devlist 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] \
diff --git a/src/u_main.tk.orig b/src/u_main.tk.orig
new file mode 100644
index 000000000..2a736ca5d
--- /dev/null
+++ b/src/u_main.tk.orig
@@ -0,0 +1,4252 @@
+#!/usr/bin/wish
+
+# 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
+} elseif { $tcl_platform(os) == "Darwin" } {
+ set pd_nt 2
+} else {
+ set pd_nt 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.
+
+# 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##########
+
+# 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
+ # set minimum line size for anti-aliasing. If set to 1 or 0, then every
+ # line will be anti-aliased. While this makes connections and circles in
+ # [bng] and such look really good, it makes boxes and messages look out of
+ # focus. Setting this to 2 makes it so the thick audio rate connections
+ # are anti-aliased. <hans@at.or.at> 2005-06-09
+ 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
+canvas .dummy -height 2p -width 6c
+
+frame .controls
+pack .controls .dummy -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
+}
+
+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 \
+ -anchor w \
+ -command {pd [concat pd dsp $ctrls_audio_on \;]}
+
+checkbutton .controls.switches.meterbutton -text {peak meters} \
+ -variable ctrls_meter_on \
+ -anchor w \
+ -command {pd [concat pd meters $ctrls_meter_on \;]}
+
+pack .controls.switches.audiobutton .controls.switches.meterbutton -side top
+
+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 \;]}
+
+pack .controls.inout.in .controls.inout.out -side left -padx 6
+pack .controls.inout -side left -padx 14
+pack .controls.switches -side right
+pack .controls.dio -side right -padx 20
+
+
+frame .printout
+text .printout.text -relief raised -bd 2 -font -*-courier-bold--normal--12-* \
+ -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 {x message default} {
+ set answer [tk_messageBox \-message $x \-type yesno -default $default \
+ -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 {} {
+ global pd_opendir
+ set filename [tk_getOpenFile -defaultextension .pd \
+ -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 "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 -*-times-regular--normal--14-* \
+ -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} {
+ exec sh -c \
+ [format "firefox file:%s || mozilla file:%s " \
+ $filename $filename] &
+ } 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
+
+proc find_apply {name} {
+ global find_string
+ global find_canvas
+ regsub -all \; $find_string " _semi_ " find_string2
+ regsub -all \, $find_string2 " _comma_ " find_string3
+# puts stderr [concat $find_canvas find $find_string3 \
+# \;]
+ pd [concat $find_canvas find $find_string3 \
+ \;]
+ after 50 destroy $name
+}
+
+proc find_cancel {name} {
+ after 50 destroy $name
+}
+
+proc menu_findobject {canvas} {
+ global find_string
+ global find_canvas
+ global find_count
+
+ 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
+
+ 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
+# 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 {menu_open} \
+ -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 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]
+
+# 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 <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
+ 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 -*-courier-bold--normal--%d-* \
+ $font] \
+ -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
+ if {$pd_nt == 0} {
+ set font [expr $font - 2]
+ }
+ 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 -*-courier-bold--normal--%d-* $font]]
+ $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 {$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}
+ 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 \
+ -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 .]
+
+ 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}
+ wm protocol $id WM_DELETE_WINDOW [concat dogatom_cancel $id]
+
+ frame $id.buttonframe
+ pack $id.buttonframe -side bottom -fill x -pady 2m
+ button $id.buttonframe.cancel -text {Cancel}\
+ -command "dogatom_cancel $id"
+ button $id.buttonframe.apply -text {Apply}\
+ -command "dogatom_apply $id"
+ button $id.buttonframe.ok -text {OK}\
+ -command "dogatom_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.paramsymto
+ pack $id.paramsymto -side bottom
+ label $id.paramsymto.entryname -text {send symbol}
+ entry $id.paramsymto.entry -textvariable $var_gatomsymto -width 20
+ pack $id.paramsymto.entryname $id.paramsymto.entry -side left
+
+ frame $id.paramsymfrom
+ pack $id.paramsymfrom -side bottom
+ label $id.paramsymfrom.entryname -text {receive symbol}
+ entry $id.paramsymfrom.entry -textvariable $var_gatomsymfrom -width 20
+ pack $id.paramsymfrom.entryname $id.paramsymfrom.entry -side left
+
+ frame $id.radio
+ pack $id.radio -side bottom
+ label $id.radio.label -text {show label on:}
+ frame $id.radio.l
+ frame $id.radio.r
+ pack $id.radio.label -side top
+ pack $id.radio.l $id.radio.r -side left
+ radiobutton $id.radio.l.radio0 -value 0 \
+ -variable $var_gatomwherelabel \
+ -text "left"
+ radiobutton $id.radio.l.radio1 -value 1 \
+ -variable $var_gatomwherelabel \
+ -text "right"
+ radiobutton $id.radio.r.radio2 -value 2 \
+ -variable $var_gatomwherelabel \
+ -text "top"
+ radiobutton $id.radio.r.radio3 -value 3 \
+ -variable $var_gatomwherelabel \
+ -text "bottom"
+ pack $id.radio.l.radio0 $id.radio.l.radio1 -side top -anchor w
+ pack $id.radio.r.radio2 $id.radio.r.radio3 -side top -anchor w
+
+
+ frame $id.paramlabel
+ pack $id.paramlabel -side bottom
+ label $id.paramlabel.entryname -text label
+ entry $id.paramlabel.entry -textvariable $var_gatomlabel -width 20
+ pack $id.paramlabel.entryname $id.paramlabel.entry -side left
+
+ frame $id.paramhi
+ pack $id.paramhi -side bottom
+ label $id.paramhi.entryname -text "upper limit"
+ entry $id.paramhi.entry -textvariable $var_gatomhi -width 8
+ pack $id.paramhi.entryname $id.paramhi.entry -side left
+
+ frame $id.paramlo
+ pack $id.paramlo -side bottom
+ label $id.paramlo.entryname -text "lower limit"
+ entry $id.paramlo.entry -textvariable $var_gatomlo -width 8
+ pack $id.paramlo.entryname $id.paramlo.entry -side left
+
+ frame $id.params
+ pack $id.params -side bottom
+ label $id.params.entryname -text width
+ entry $id.params.entry -textvariable $var_gatomwidth -width 4
+ pack $id.params.entryname $id.params.entry -side left
+
+
+
+ bind $id.paramhi.entry <KeyPress-Return> [concat dogatom_ok $id]
+ bind $id.paramlo.entry <KeyPress-Return> [concat dogatom_ok $id]
+ bind $id.params.entry <KeyPress-Return> [concat dogatom_ok $id]
+ pdtk_standardkeybindings $id.paramhi.entry
+ pdtk_standardkeybindings $id.paramlo.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.gnfs.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.col_example_choose.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.col_example_choose.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.col_example_choose.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} {
+ set vid [string trimleft $id .]
+
+ set var_iemgui_gn_f [concat iemgui_gn_f_$vid]
+ global $var_iemgui_gn_f
+
+ set $var_iemgui_gn_f [expr [eval concat $$var_iemgui_gn_f] + 1]
+ if {[eval concat $$var_iemgui_gn_f] > 2} {set $var_iemgui_gn_f 0}
+ if {[eval concat $$var_iemgui_gn_f] == 0} {$id.gnfs.fb configure -text "courier" -font {courier 10 bold}}
+ if {[eval concat $$var_iemgui_gn_f] == 1} {$id.gnfs.fb configure -text "helvetica" -font {helvetica 10 bold}}
+ if {[eval concat $$var_iemgui_gn_f] == 2} {$id.gnfs.fb configure -text "times" -font {times 10 bold}}
+}
+
+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 .]
+
+ 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 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}
+ if { $snd != "nosndno" || $rcv != "norcvno" } {
+ label $id.space2 -text "---------------------------------"
+ pack $id.space2 -side top }
+
+ frame $id.snd
+ pack $id.snd -side top
+ label $id.snd.dummy1 -text "" -width 2
+ label $id.snd.lab -text "send-symbol:" -width 12
+ entry $id.snd.ent -textvariable $var_iemgui_snd -width 20
+ if { $snd != "nosndno" } {
+ pack $id.snd.dummy1 $id.snd.lab $id.snd.ent -side left}
+
+ frame $id.rcv
+ pack $id.rcv -side top
+ label $id.rcv.lab -text "receive-symbol:" -width 15
+ entry $id.rcv.ent -textvariable $var_iemgui_rcv -width 20
+ if { $rcv != "norcvno" } {
+ pack $id.rcv.lab $id.rcv.ent -side left}
+
+ frame $id.gnam
+ pack $id.gnam -side top
+ label $id.gnam.head -text "--------------label:---------------"
+ label $id.gnam.dummy1 -text "" -width 1
+ label $id.gnam.lab -text "name:" -width 6
+ entry $id.gnam.ent -textvariable $var_iemgui_gui_nam -width 29
+ label $id.gnam.dummy2 -text "" -width 1
+ pack $id.gnam.head -side top
+ pack $id.gnam.dummy1 $id.gnam.lab $id.gnam.ent $id.gnam.dummy2 -side left
+
+ frame $id.gnxy
+ pack $id.gnxy -side top
+ label $id.gnxy.x_lab -text "x_off:" -width 6
+ entry $id.gnxy.x_ent -textvariable $var_iemgui_gn_dx -width 5
+ label $id.gnxy.dummy1 -text " " -width 10
+ label $id.gnxy.y_lab -text "y_off:" -width 6
+ entry $id.gnxy.y_ent -textvariable $var_iemgui_gn_dy -width 5
+ pack $id.gnxy.x_lab $id.gnxy.x_ent $id.gnxy.dummy1 \
+ $id.gnxy.y_lab $id.gnxy.y_ent -side left
+
+ frame $id.gnfs
+ pack $id.gnfs -side top
+ label $id.gnfs.f_lab -text "font:" -width 6
+ if {[eval concat $$var_iemgui_gn_f] == 0} {
+ button $id.gnfs.fb -text "courier" -font {courier 10 bold} -width 7 -command "iemgui_toggle_font $id" }
+ if {[eval concat $$var_iemgui_gn_f] == 1} {
+ button $id.gnfs.fb -text "helvetica" -font {helvetica 10 bold} -width 7 -command "iemgui_toggle_font $id" }
+ if {[eval concat $$var_iemgui_gn_f] == 2} {
+ button $id.gnfs.fb -text "times" -font {times 10 bold} -width 7 -command "iemgui_toggle_font $id" }
+ label $id.gnfs.dummy1 -text "" -width 1
+ label $id.gnfs.fs_lab -text "fontsize:" -width 8
+ entry $id.gnfs.fs_ent -textvariable $var_iemgui_gn_fs -width 5
+ pack $id.gnfs.f_lab $id.gnfs.fb $id.gnfs.dummy1 \
+ $id.gnfs.fs_lab $id.gnfs.fs_ent -side left
+
+ label $id.col_head -text "--------------colors:--------------"
+ pack $id.col_head -side top
+
+ frame $id.col_select
+ pack $id.col_select -side top
+ radiobutton $id.col_select.radio0 -value 0 -variable $var_iemgui_l2_f1_b0 \
+ -text "backgd" -width 5
+ radiobutton $id.col_select.radio1 -value 1 -variable $var_iemgui_l2_f1_b0 \
+ -text "front" -width 5
+ radiobutton $id.col_select.radio2 -value 2 -variable $var_iemgui_l2_f1_b0 \
+ -text "label" -width 5
+ if { [eval concat $$var_iemgui_fcol] >= 0 } {
+ pack $id.col_select.radio0 $id.col_select.radio1 $id.col_select.radio2 -side left
+ } else {pack $id.col_select.radio0 $id.col_select.radio2 -side left}
+
+ frame $id.col_example_choose
+ pack $id.col_example_choose -side top
+ button $id.col_example_choose.but -text "compose color" -width 10 \
+ -command "iemgui_choose_col_bkfrlb $id"
+ label $id.col_example_choose.dummy1 -text "" -width 1
+ if { [eval concat $$var_iemgui_fcol] >= 0 } {
+ button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \
+ -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]] -pady 2
+ } else {
+ button $id.col_example_choose.fr_bk -text "o=||=o" -width 5 \
+ -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]] -pady 2}
+ button $id.col_example_choose.lb_bk -text "testlabel" -width 7 \
+ -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]] -pady 2
+
+ pack $id.col_example_choose.but $id.col_example_choose.dummy1 \
+ $id.col_example_choose.fr_bk $id.col_example_choose.lb_bk -side left
+
+ label $id.space3 -text "------or click color preset:-------"
+ pack $id.space3 -side top
+
+ frame $id.bcol
+ pack $id.bcol -side top
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 16579836 14737632 12369084 \
+ 16572640 16572608 16579784 14220504 14220540 14476540 16308476 } {
+ button $id.bcol.c$i -background [format "#%6.6x" $hexcol] \
+ -activebackground [format "#%6.6x" $hexcol] \
+ -font {courier 2 normal} -padx 7 -pady 6 \
+ -command [format "iemgui_preset_col %s %d" $id $hexcol] }
+ pack $id.bcol.c0 $id.bcol.c1 $id.bcol.c2 $id.bcol.c3 $id.bcol.c4 \
+ $id.bcol.c5 $id.bcol.c6 $id.bcol.c7 $id.bcol.c8 $id.bcol.c9 -side left
+
+ frame $id.fcol
+ pack $id.fcol -side top
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 10526880 8158332 6316128 \
+ 16525352 16559172 15263784 1370132 2684148 3952892 16003312 } {
+ button $id.fcol.c$i -background [format "#%6.6x" $hexcol] \
+ -activebackground [format "#%6.6x" $hexcol] \
+ -font {courier 2 normal} -padx 7 -pady 6 \
+ -command [format "iemgui_preset_col %s %d" $id $hexcol] }
+ pack $id.fcol.c0 $id.fcol.c1 $id.fcol.c2 $id.fcol.c3 $id.fcol.c4 \
+ $id.fcol.c5 $id.fcol.c6 $id.fcol.c7 $id.fcol.c8 $id.fcol.c9 -side left
+
+ frame $id.lcol
+ pack $id.lcol -side top
+ foreach i { 0 1 2 3 4 5 6 7 8 9 } hexcol { 4210752 2105376 0 \
+ 9177096 5779456 7874580 2641940 17488 5256 5767248 } {
+ button $id.lcol.c$i -background [format "#%6.6x" $hexcol] \
+ -activebackground [format "#%6.6x" $hexcol] \
+ -font {courier 2 normal} -padx 7 -pady 6 \
+ -command [format "iemgui_preset_col %s %d" $id $hexcol] }
+ pack $id.lcol.c0 $id.lcol.c1 $id.lcol.c2 $id.lcol.c3 $id.lcol.c4 \
+ $id.lcol.c5 $id.lcol.c6 $id.lcol.c7 $id.lcol.c8 $id.lcol.c9 -side left
+
+
+ label $id.space4 -text "---------------------------------"
+ pack $id.space4 -side top
+
+ frame $id.cao
+ 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 \
+ $id.cao.apply $id.cao.dummy2 \
+ $id.cao.ok -side left
+
+ label $id.space5 -text ""
+ pack $id.space5 -side top
+
+ 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.snd.ent <KeyPress-Return> [concat iemgui_ok $id]
+ bind $id.rcv.ent <KeyPress-Return> [concat iemgui_ok $id]
+ bind $id.gnam.ent <KeyPress-Return> [concat iemgui_ok $id]
+ bind $id.gnxy.x_ent <KeyPress-Return> [concat iemgui_ok $id]
+ bind $id.gnxy.y_ent <KeyPress-Return> [concat iemgui_ok $id]
+ bind $id.gnfs.fs_ent <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.snd.ent
+ pdtk_standardkeybindings $id.rcv.ent
+ pdtk_standardkeybindings $id.gnam.ent
+ pdtk_standardkeybindings $id.gnxy.x_ent
+ pdtk_standardkeybindings $id.gnxy.y_ent
+ pdtk_standardkeybindings $id.gnfs.fs_ent
+ 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 name page} {
+ 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 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 $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
+
+ 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} {
+# puts stderr [concat $version $apilist $fontname]
+ global pd_myversion pd_apilist pd_midiapilist
+ set pd_myversion $version
+ set pd_apilist $apilist
+ set pd_midiapilist $midiapilist
+ global pd_fontlist
+ set pd_fontlist {}
+
+ set fontlist ""
+ foreach i {8 9 10 12 14 16 18 24 30 36} {
+ set font [concat $fontname -$i bold]
+ 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 [selection 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} {
+ if [winfo exists $name.popup] {destroy $name.popup}
+ menu $name.popup -tearoff false
+# 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} {
+ if [winfo exists $name.popup] {destroy $name.popup}
+ menu $name.popup -tearoff false
+# 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_path0 pd_path1 pd_path2 pd_path3 pd_path4
+ global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9
+
+ pd [concat pd path-dialog $pd_extrapath $pd_verbose \
+ [pdtk_encodedialog $pd_path0] [pdtk_encodedialog $pd_path1] \
+ [pdtk_encodedialog $pd_path2] [pdtk_encodedialog $pd_path3] \
+ [pdtk_encodedialog $pd_path4] [pdtk_encodedialog $pd_path5] \
+ [pdtk_encodedialog $pd_path6] [pdtk_encodedialog $pd_path7] \
+ [pdtk_encodedialog $pd_path8] [pdtk_encodedialog $pd_path9] \;]
+}
+
+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_path0 pd_path1 pd_path2 pd_path3 pd_path4
+ global pd_path5 pd_path6 pd_path7 pd_path8 pd_path9
+
+ 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 < 10} {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_startup0 pd_startup1 pd_startup2 pd_startup3 pd_startup4
+ global pd_startup5 pd_startup6 pd_startup7 pd_startup8 pd_startup9
+
+ pd [concat pd startup-dialog $pd_nort [pdtk_encodedialog $pd_flags] \
+ [pdtk_encodedialog $pd_startup0] [pdtk_encodedialog $pd_startup1] \
+ [pdtk_encodedialog $pd_startup2] [pdtk_encodedialog $pd_startup3] \
+ [pdtk_encodedialog $pd_startup4] [pdtk_encodedialog $pd_startup5] \
+ [pdtk_encodedialog $pd_startup6] [pdtk_encodedialog $pd_startup7] \
+ [pdtk_encodedialog $pd_startup8] [pdtk_encodedialog $pd_startup9] \;]
+
+}
+
+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_startup0 pd_startup1 pd_startup2 pd_startup3 pd_startup4
+ global pd_startup5 pd_startup6 pd_startup7 pd_startup8 pd_startup9
+
+ 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 < 10} {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
+}
+
diff --git a/src/x_qlist.c b/src/x_qlist.c
index 271259a30..c0be1d52f 100644
--- a/src/x_qlist.c
+++ b/src/x_qlist.c
@@ -100,7 +100,8 @@ static void qlist_donext(t_qlist *x, int drop, int automatic)
if (ap->a_type != A_SYMBOL) continue;
else if (!(target = ap->a_w.w_symbol->s_thing))
{
- error("qlist: %s: no such object", ap->a_w.w_symbol->s_name);
+ pd_error(x, "qlist: %s: no such object",
+ ap->a_w.w_symbol->s_name);
continue;
}
ap++;
@@ -180,10 +181,10 @@ static void qlist_read(t_qlist *x, t_symbol *filename, t_symbol *format)
if (!strcmp(format->s_name, "cr"))
cr = 1;
else if (*format->s_name)
- error("qlist_read: unknown flag: %s", format->s_name);
+ pd_error(x, "qlist_read: unknown flag: %s", format->s_name);
if (binbuf_read_via_canvas(x->x_binbuf, filename->s_name, x->x_canvas, cr))
- error("%s: read failed", filename->s_name);
+ pd_error(x, "%s: read failed", filename->s_name);
x->x_onset = 0x7fffffff;
x->x_reentered = 1;
}
@@ -197,9 +198,9 @@ static void qlist_write(t_qlist *x, t_symbol *filename, t_symbol *format)
if (!strcmp(format->s_name, "cr"))
cr = 1;
else if (*format->s_name)
- error("qlist_read: unknown flag: %s", format->s_name);
+ pd_error(x, "qlist_read: unknown flag: %s", format->s_name);
if (binbuf_write(x->x_binbuf, buf, "", cr))
- error("%s: write failed", filename->s_name);
+ pd_error(x, "%s: write failed", filename->s_name);
}
static void qlist_print(t_qlist *x)
--
GitLab