From a2bfe438b965756452ce4a7f6f54af6febabf786 Mon Sep 17 00:00:00 2001
From: Miller Puckette <msp@ucsd.edu>
Date: Mon, 17 Sep 2007 11:39:13 -0700
Subject: [PATCH] rm *.orig
---
src/g_template.c.orig | 2333 ----------------------
src/s_inter.c.orig | 1300 -------------
src/s_main.c.orig | 1001 ----------
src/u_main.tk.orig | 4252 -----------------------------------------
4 files changed, 8886 deletions(-)
delete mode 100644 src/g_template.c.orig
delete mode 100644 src/s_inter.c.orig
delete mode 100644 src/s_main.c.orig
delete mode 100644 src/u_main.tk.orig
diff --git a/src/g_template.c.orig b/src/g_template.c.orig
deleted file mode 100644
index f5519e654..000000000
--- a/src/g_template.c.orig
+++ /dev/null
@@ -1,2333 +0,0 @@
-/* Copyright (c) 1997-1999 Miller Puckette.
-* For information on usage and redistribution, and for a DISCLAIMER OF ALL
-* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
-
-#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/s_inter.c.orig b/src/s_inter.c.orig
deleted file mode 100644
index 9945466f1..000000000
--- a/src/s_inter.c.orig
+++ /dev/null
@@ -1,1300 +0,0 @@
-/* Copyright (c) 1997-1999 Miller Puckette.
-* For information on usage and redistribution, and for a DISCLAIMER OF ALL
-* WARRANTIES, see the file, "LICENSE.txt," in this distribution. */
-
-/* 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.orig b/src/s_main.c.orig
deleted file mode 100644
index ded67c886..000000000
--- a/src/s_main.c.orig
+++ /dev/null
@@ -1,1001 +0,0 @@
-/* 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.orig b/src/u_main.tk.orig
deleted file mode 100644
index 2a736ca5d..000000000
--- a/src/u_main.tk.orig
+++ /dev/null
@@ -1,4252 +0,0 @@
-#!/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
-}
-
--
GitLab