/* Set a variable. */
void
cp_vset(char *varname, char type, char *value)
{
struct variable *v, *u, *w;
int i;
bool alreadythere = FALSE;
char* copyvarname;
/* varname = cp_unquote(varname); DG: Memory leak old varname is lost*/
copyvarname = cp_unquote(varname);
w = NULL;
for (v = variables; v; v = v->va_next) {
if (eq(copyvarname, v->va_name)) {
alreadythere = TRUE;
break;
}
w = v;
}
if (!v) {
v = alloc(struct variable);
v->va_name = copy(copyvarname);
v->va_next = NULL;
}
/* Set a variable. */
void
cp_vset(char *varname, enum cp_types type, void *value)
{
struct variable *v, *u, *w;
int i;
//bool alreadythere = FALSE, v_free = FALSE;
int alreadythere = FALSE, v_free = FALSE;
char *copyvarname;
/* varname = cp_unquote(varname); DG: Memory leak old varname is lost*/
copyvarname = cp_unquote(varname);
w = NULL;
for (v = variables; v; v = v->va_next) {
if (eq(copyvarname, v->va_name)) {
alreadythere = TRUE;
break;
}
w = v;
}
if (alreadythere) {
if (v->va_type == CP_LIST)
free_struct_variable(v->va_vlist);
if (v->va_type == CP_STRING)
tfree(v->va_string);
}
if (!v) {
v = alloc(struct variable);
v->va_name = copy(copyvarname);
v->va_next = NULL;
v_free = TRUE;
}
void
settrace(wordlist *wl, int what, char *name)
{
struct dbcomm *d, *td;
char *s;
while (wl) {
s = cp_unquote(wl->wl_word);
d = TMALLOC(struct dbcomm, 1);
d->db_number = debugnumber++;
d->db_analysis = name;
if (eq(s, "all")) {
switch (what) {
case VF_PRINT:
d->db_type = DB_TRACEALL;
break;
/* case VF_PLOT:
d->db_type = DB_IPLOTALL;
break; */
case VF_ACCUM:
/* d->db_type = DB_SAVEALL; */
d->db_nodename1 = copy(s);
d->db_type = DB_SAVE;
break;
}
/* wrd_chtrace(NULL, TRUE, what); */
} else {
switch (what) {
case VF_PRINT:
d->db_type = DB_TRACENODE;
break;
/* case VF_PLOT:
d->db_type = DB_IPLOT;
break; */
case VF_ACCUM:
d->db_type = DB_SAVE;
break;
}
/* v(2) --> 2, i(vds) --> vds#branch */
d->db_nodename1 = copynode(s);
/* wrd_chtrace(s, TRUE, what); */
}
tfree(s); /*DG avoid memoy leak */
if (dbs) {
for (td = dbs; td->db_next; td = td->db_next)
;
td->db_next = d;
} else {
ft_curckt->ci_dbs = dbs = d;
}
wl = wl->wl_next;
}
}
wordlist *
cp_varwl(struct variable *var)
{
wordlist *wl = NULL, *w, *wx = NULL;
char buf[BSIZE_SP],*copystring;
struct variable *vt;
switch(var->va_type) {
case VT_BOOL:
/* Can't ever be FALSE. */
sprintf(buf, "%s", var->va_bool ? "TRUE" : "FALSE");
break;
case VT_NUM:
sprintf(buf, "%d", var->va_num);
break;
case VT_REAL:
/* This is a case where printnum isn't too good... */
sprintf(buf, "%G", var->va_real);
break;
case VT_STRING:
/*strcpy(buf, cp_unquote(var->va_string)); DG: memory leak here*/
copystring= cp_unquote(var->va_string);/*DG*/
strcpy(buf,copystring);
tfree(copystring);
break;
case VT_LIST: /* The tricky case. */
for (vt = var->va_vlist; vt; vt = vt->va_next) {
w = cp_varwl(vt);
if (wl == NULL)
wl = wx = w;
else {
wx->wl_next = w;
w->wl_prev = wx;
wx = w;
}
}
return (wl);
default:
fprintf(cp_err,
"cp_varwl: Internal Error: bad variable type %d\n",
var->va_type);
return (NULL);
}
wl = alloc(struct wordlist);
wl->wl_next = wl->wl_prev = NULL;
wl->wl_word = copy(buf);
return (wl);
}
void
com_load(wordlist *wl)
{
char *copypath;
if (!wl)
ft_loadfile(ft_rawfile);
else
while (wl) {
/*ft_loadfile(cp_unquote(wl->wl_word)); DG: bad memory leak*/
copypath = cp_unquote(wl->wl_word);/*DG*/
ft_loadfile(copypath);
tfree(copypath);
wl = wl->wl_next;
}
/* note: default is to display the vectors in the last (current) plot */
com_display(NULL);
}
wordlist *
cp_varwl(struct variable *var)
{
wordlist *wl = NULL, *w, *wx = NULL;
char *buf;
struct variable *vt;
switch (var->va_type) {
case CP_BOOL:
/* Can't ever be FALSE. */
buf = copy(var->va_bool ? "TRUE" : "FALSE");
break;
case CP_NUM:
buf = tprintf("%d", var->va_num);
break;
case CP_REAL:
/* This is a case where printnum isn't too good... */
buf = tprintf("%G", var->va_real);
break;
case CP_STRING:
buf = cp_unquote(var->va_string);
break;
case CP_LIST: /* The tricky case. */
for (vt = var->va_vlist; vt; vt = vt->va_next) {
w = cp_varwl(vt);
if (wl == NULL) {
wl = wx = w;
} else {
wx->wl_next = w;
w->wl_prev = wx;
wx = w;
}
}
return (wl);
default:
fprintf(cp_err,
"cp_varwl: Internal Error: bad variable type %d\n",
var->va_type);
return (NULL);
}
return wl_cons(buf, NULL);
}
void
ft_xgraph(double *xlims, double *ylims, char *filename, char *title, char *xlabel, char *ylabel, GRIDTYPE gridtype, PLOTTYPE plottype, struct dvec *vecs)
{
FILE *file;
struct dvec *v, *scale;
double xval, yval;
int i, numVecs, linewidth;
bool xlog, ylog, nogrid, markers;
char buf[BSIZE_SP], pointstyle[BSIZE_SP], *text;
/* Sanity checking. */
for (v = vecs, numVecs = 0; v; v = v->v_link2)
numVecs++;
if (numVecs == 0) {
return;
} else if (numVecs > XG_MAXVECTORS) {
fprintf(cp_err, "Error: too many vectors for Xgraph.\n");
return;
}
if (!cp_getvar("xbrushwidth", CP_NUM, &linewidth))
linewidth = 1;
if (linewidth < 1)
linewidth = 1;
if (!cp_getvar("pointstyle", CP_STRING, pointstyle)) {
markers = FALSE;
} else {
if (cieq(pointstyle, "markers"))
markers = TRUE;
else
markers = FALSE;
}
/* Make sure the gridtype is supported. */
switch (gridtype) {
case GRID_LIN:
nogrid = xlog = ylog = FALSE;
break;
case GRID_XLOG:
xlog = TRUE;
nogrid = ylog = FALSE;
break;
case GRID_YLOG:
ylog = TRUE;
nogrid = xlog = FALSE;
break;
case GRID_LOGLOG:
xlog = ylog = TRUE;
nogrid = FALSE;
break;
case GRID_NONE:
nogrid = TRUE;
xlog = ylog = FALSE;
break;
default:
fprintf(cp_err, "Error: grid type unsupported by Xgraph.\n");
return;
}
/* Open the output file. */
if ((file = fopen(filename, "w")) == NULL) {
perror(filename);
return;
}
/* Set up the file header. */
if (title) {
text = cp_unquote(title);
fprintf(file, "TitleText: %s\n", text);
tfree(text);
}
if (xlabel) {
text = cp_unquote(xlabel);
fprintf(file, "XUnitText: %s\n", text);
tfree(text);
}
if (ylabel) {
text = cp_unquote(ylabel);
fprintf(file, "YUnitText: %s\n", text);
tfree(text);
}
if (nogrid) {
fprintf(file, "Ticks: True\n");
}
if (xlog) {
fprintf(file, "LogX: True\n");
if (xlims) {
fprintf(file, "XLowLimit: % e\n", log10(xlims[0]));
fprintf(file, "XHighLimit: % e\n", log10(xlims[1]));
}
} else {
if (xlims) {
fprintf(file, "XLowLimit: % e\n", xlims[0]);
fprintf(file, "XHighLimit: % e\n", xlims[1]);
}
}
if (ylog) {
fprintf(file, "LogY: True\n");
if (ylims) {
fprintf(file, "YLowLimit: % e\n", log10(ylims[0]));
fprintf(file, "YHighLimit: % e\n", log10(ylims[1]));
}
} else {
if (ylims) {
fprintf(file, "YLowLimit: % e\n", ylims[0]);
fprintf(file, "YHighLimit: % e\n", ylims[1]);
}
}
fprintf(file, "LineWidth: %d\n", linewidth);
fprintf(file, "BoundBox: True\n");
if (plottype == PLOT_COMB) {
fprintf(file, "BarGraph: True\n");
fprintf(file, "NoLines: True\n");
} else if (plottype == PLOT_POINT) {
if (markers)
fprintf(file, "Markers: True\n");
else
fprintf(file, "LargePixels: True\n");
fprintf(file, "NoLines: True\n");
}
/* Write out the data. */
for (v = vecs; v; v = v->v_link2) {
scale = v->v_scale;
if (v->v_name)
fprintf(file, "\"%s\"\n", v->v_name);
for (i = 0; i < scale->v_length; i++) {
xval = isreal(scale) ?
scale->v_realdata[i] : realpart(scale->v_compdata[i]);
yval = isreal(v) ?
v->v_realdata[i] : realpart(v->v_compdata[i]);
fprintf(file, "% e % e\n", xval, yval);
}
fprintf(file, "\n");
}
(void) fclose(file);
(void) sprintf(buf, "xgraph %s &", filename);
(void) system(buf);
}
/* Set a variable. */
void
cp_vset(char *varname, enum cp_types type, void *value)
{
struct variable *v, *u, *w;
int i;
bool alreadythere = FALSE, v_free = FALSE;
char *copyvarname;
/* varname = cp_unquote(varname); DG: Memory leak old varname is lost*/
copyvarname = cp_unquote(varname);
w = NULL;
for (v = variables; v; v = v->va_next) {
if (eq(copyvarname, v->va_name)) {
alreadythere = TRUE;
break;
}
w = v;
}
if (alreadythere) {
if (v->va_type == CP_LIST)
free_struct_variable(v->va_vlist);
if (v->va_type == CP_STRING)
tfree(v->va_string);
}
if (!v) {
v = var_alloc(copy(copyvarname), NULL);
v_free = TRUE;
}
switch (type) {
case CP_BOOL:
if (* ((bool *) value) == FALSE) {
cp_remvar(copyvarname);
if (v_free) {
tfree(v->va_name);
tfree(v);
}
tfree(copyvarname);
return;
} else {
var_set_bool(v, TRUE);
}
break;
case CP_NUM:
var_set_num(v, * (int *) value);
break;
case CP_REAL:
var_set_real(v, * (double *) value);
break;
case CP_STRING:
var_set_string(v, copy((char*) value));
break;
case CP_LIST:
var_set_vlist(v, (struct variable *) value);
break;
default:
fprintf(cp_err,
"cp_vset: Internal Error: bad variable type %d.\n",
type);
tfree(copyvarname);
return;
}
/* Now, see if there is anything interesting going on. We
* recognise these special variables: noglob, nonomatch, history,
* echo, noclobber, prompt, and verbose. cp_remvar looks for these
* variables too. The host program will get any others. */
if (eq(copyvarname, "noglob"))
cp_noglob = TRUE;
else if (eq(copyvarname, "nonomatch"))
cp_nonomatch = TRUE;
else if (eq(copyvarname, "history") && (type == CP_NUM))
cp_maxhistlength = v->va_num;
else if (eq(copyvarname, "history") && (type == CP_REAL))
cp_maxhistlength = (int)floor(v->va_real + 0.5);
else if (eq(copyvarname, "noclobber"))
cp_noclobber = TRUE;
else if (eq(varname, "echo")) /*CDHW*/
cp_echo = TRUE; /*CDHW*/
else if (eq(copyvarname, "prompt") && (type == CP_STRING))
cp_promptstring = v->va_string;
else if (eq(copyvarname, "ignoreeof"))
cp_ignoreeof = TRUE;
else if (eq(copyvarname, "cpdebug")) {
cp_debug = TRUE;
#ifndef CPDEBUG
fprintf(cp_err,
"Warning: program not compiled with cshpar debug messages\n");
#endif
}
switch (i = cp_usrset(v, TRUE)) {
case US_OK:
/* Normal case. */
if (!alreadythere) {
v->va_next = variables;
variables = v;
}
else if (v_free)
free_struct_variable(v);
break;
case US_DONTRECORD:
/* 'curplot' 'curplotname' 'curplottitle' 'curplotdate' */
/* Do nothing... */
if (alreadythere) {
fprintf(cp_err, "cp_vset: Internal Error: "
"%s already there, but 'dont record'\n", v->va_name);
}
if (v_free)
free_struct_variable(v);
break;
case US_READONLY:
/* 'plots' and any var in plot_cur->pl_env */
fprintf(cp_err, "Error: %s is a read-only variable.\n", v->va_name);
if (alreadythere)
fprintf(cp_err, "cp_vset: Internal Error: "
"it was already there too!!\n");
break;
case US_SIMVAR:
/* variables processed by if_option(ft_curckt->ci_ckt, ...) */
if (alreadythere) {
/* somehow it got into the front-end list of variables */
if (w) {
w->va_next = v->va_next;
} else {
variables = v->va_next;
}
}
alreadythere = FALSE;
if (ft_curckt) {
for (u = ft_curckt->ci_vars; u; u = u->va_next)
if (eq(copyvarname, u->va_name)) {
alreadythere = TRUE;
break;
}
if (!alreadythere) {
v->va_next = ft_curckt->ci_vars;
ft_curckt->ci_vars = v;
} else {
if (u->va_type == CP_STRING)
tfree(u->va_string);
else if (u->va_type == CP_LIST)
tfree(u->va_vlist);
u->va_V = v->va_V;
u->va_type = v->va_type;
/* va_name is the same string */
tfree(u->va_name);
u->va_name = v->va_name;
/* va_next left unchanged */
tfree(v);
}
}
break;
case US_NOSIMVAR:
/* variables processed by if_option(NULL, ...) */
/* What do you do? */
free_struct_variable(v);
break;
default:
fprintf(cp_err, "cp_vset: Internal Error: bad US val %d\n", i);
break;
}
tfree(copyvarname);
}
/* Determine the value of a variable. Fail if the variable is unset,
* and if the type doesn't match, try and make it work... */
bool
cp_getvar(char *name, enum cp_types type, void *retval)
{
struct variable *v;
struct variable *uv1;
uv1 = cp_usrvars();
#ifdef TRACE
/* SDB debug statement */
fprintf(stderr, "in cp_getvar, trying to get value of variable %s.\n", name);
#endif
for (v = variables; v; v = v->va_next)
if (eq(name, v->va_name))
break;
if (!v)
for (v = uv1; v; v = v->va_next)
if (eq(name, v->va_name))
break;
if (!v && plot_cur)
for (v = plot_cur->pl_env; v; v = v->va_next)
if (eq(name, v->va_name))
break;
if (!v && ft_curckt)
for (v = ft_curckt->ci_vars; v; v = v->va_next)
if (eq(name, v->va_name))
break;
if (!v) {
if (type == CP_BOOL && retval)
*(bool *) retval = FALSE;
free_struct_variable(uv1);
return (FALSE);
}
if (v->va_type == type) {
if (retval)
switch (type) {
case CP_BOOL:
*(bool *) retval = TRUE;
break;
case CP_NUM:
*(int *) retval = v->va_num;
break;
case CP_REAL:
*(double *) retval = v->va_real;
break;
case CP_STRING: { /* Gotta be careful to have room. */
char *s = cp_unquote(v->va_string);
cp_wstrip(s);
strcpy((char*) retval, s);
tfree(s);
break;
}
case CP_LIST: /* Funny case... */
*(struct variable **) retval = v->va_vlist;
break;
default:
fprintf(cp_err,
"cp_getvar: Internal Error: bad var type %d.\n", type);
break;
}
free_struct_variable(uv1);
return (TRUE);
}
/* Try to coerce it.. */
if ((type == CP_NUM) && (v->va_type == CP_REAL)) {
*(int *) retval = (int) v->va_real;
} else if ((type == CP_REAL) && (v->va_type == CP_NUM)) {
*(double *) retval = (double) v->va_num;
} else if ((type == CP_STRING) && (v->va_type == CP_NUM)) {
sprintf((char*) retval, "%d", v->va_num);
} else if ((type == CP_STRING) && (v->va_type == CP_REAL)) {
sprintf((char*) retval, "%f", v->va_real);
} else {
free_struct_variable(uv1);
return (FALSE);
}
free_struct_variable(uv1);
return (TRUE);
}
/*CDHW This needs leak checking carefully CDHW*/
struct variable *
cp_setparse(wordlist *wl)
{
char *name = NULL, *val, *copyval, *s, *ss;
double *td;
struct variable *listv = NULL, *vv, *lv = NULL;
struct variable *vars = NULL;
int balance;
while (wl) {
if (name)
tfree(name);
name = cp_unquote(wl->wl_word);
wl = wl->wl_next;
if ((!wl || (*wl->wl_word != '=')) && !strchr(name, '=')) {
vars = var_alloc_bool(copy(name), TRUE, vars);
tfree(name); /*DG: cp_unquote Memory leak*/
continue;
}
if (wl && eq(wl->wl_word, "=")) {
wl = wl->wl_next;
if (wl == NULL) {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /*DG: cp_unquote Memory leak*/
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
val = wl->wl_word;
wl = wl->wl_next;
} else if (wl && (*wl->wl_word == '=')) {
val = wl->wl_word + 1;
wl = wl->wl_next;
} else if ((s = strchr(name, '=')) != NULL) {
val = s + 1;
*s = '\0';
if (*val == '\0') {
if (!wl) {
fprintf(cp_err, "Error: %s equals what?.\n", name);
tfree(name); /*DG: cp_unquote Memory leak: free name before exiting*/
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
} else {
val = wl->wl_word;
wl = wl->wl_next;
}
}
} else {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /*DG: cp_unquote Memory leak: free name befor exiting */
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
/* val = cp_unquote(val); DG: bad old val is lost*/
copyval = cp_unquote(val); /*DG*/
strcpy(val, copyval);
tfree(copyval);
if (eq(val, "(")) {
/* The beginning of a list... We have to walk down the
* list until we find a close paren... If there are nested
* ()'s, treat them as tokens... */
balance = 1;
while (wl && wl->wl_word) {
if (eq(wl->wl_word, "(")) {
balance++;
} else if (eq(wl->wl_word, ")")) {
if (!--balance)
break;
}
copyval = ss = cp_unquote(wl->wl_word);
td = ft_numparse(&ss, FALSE);
if (td)
vv = var_alloc_real(NULL, *td, NULL);
else
vv = var_alloc_string(NULL, copy(ss), NULL);
tfree(copyval); /*DG: must free ss any way to avoid cp_unquote memory leak*/
if (listv) {
lv->va_next = vv;
lv = vv;
} else {
listv = lv = vv;
}
wl = wl->wl_next;
}
if (balance && !wl) {
fprintf(cp_err, "Error: bad set form.\n");
tfree(name); /* va: cp_unquote memory leak: free name before exiting */
if (ft_stricterror)
controlled_exit(EXIT_BAD);
return (NULL);
}
vars = var_alloc_vlist(copy(name), listv, vars);
wl = wl->wl_next;
continue;
}
copyval = ss = cp_unquote(val);
td = ft_numparse(&ss, FALSE);
if (td) {
/*** We should try to get CP_NUM's... */
vars = var_alloc_real(copy(name), *td, vars);
} else {
vars = var_alloc_string(copy(name), copy(val), vars);
}
tfree(copyval); /*DG: must free ss any way to avoid cp_unquote memory leak */
tfree(name); /* va: cp_unquote memory leak: free name for every loop */
}
if (name)
tfree(name);
return (vars);
}
void
ft_gnuplot(double *xlims, double *ylims, char *filename, char *title, char *xlabel, char *ylabel, GRIDTYPE gridtype, PLOTTYPE plottype, struct dvec *vecs)
{
FILE *file, *file_data;
struct dvec *v, *scale = NULL;
double xval, yval, extrange;
int i, numVecs, linewidth, err, terminal_type;
bool xlog, ylog, nogrid, markers;
char buf[BSIZE_SP], pointstyle[BSIZE_SP], *text, plotstyle[BSIZE_SP], terminal[BSIZE_SP];
char filename_data[128];
char filename_plt[128];
sprintf(filename_data, "%s.data", filename);
sprintf(filename_plt, "%s.plt", filename);
/* Sanity checking. */
for (v = vecs, numVecs = 0; v; v = v->v_link2)
numVecs++;
if (numVecs == 0) {
return;
} else if (numVecs > GP_MAXVECTORS) {
fprintf(cp_err, "Error: too many vectors for gnuplot.\n");
return;
}
if (fabs((ylims[1]-ylims[0])/ylims[0]) < 1.0e-6) {
fprintf(cp_err, "Error: range min ... max too small for using gnuplot.\n");
fprintf(cp_err, " Consider plotting with offset %g.\n", ylims[0]);
return;
}
extrange = 0.05 * (ylims[1] - ylims[0]);
if (!cp_getvar("gnuplot_terminal", CP_STRING, terminal)) {
terminal_type = 1;
} else {
terminal_type = 1;
if (cieq(terminal,"png"))
terminal_type = 2;
}
if (!cp_getvar("xbrushwidth", CP_NUM, &linewidth))
linewidth = 1;
if (linewidth < 1) linewidth = 1;
if (!cp_getvar("pointstyle", CP_STRING, pointstyle)) {
markers = FALSE;
} else {
if (cieq(pointstyle,"markers"))
markers = TRUE;
else
markers = FALSE;
}
/* Make sure the gridtype is supported. */
switch (gridtype) {
case GRID_LIN:
nogrid = xlog = ylog = FALSE;
break;
case GRID_XLOG:
xlog = TRUE;
nogrid = ylog = FALSE;
break;
case GRID_YLOG:
ylog = TRUE;
nogrid = xlog = FALSE;
break;
case GRID_LOGLOG:
xlog = ylog = TRUE;
nogrid = FALSE;
break;
case GRID_NONE:
nogrid = TRUE;
xlog = ylog = FALSE;
break;
default:
fprintf(cp_err, "Error: grid type unsupported by gnuplot.\n");
return;
}
/* Open the output gnuplot file. */
if ((file = fopen(filename_plt, "w")) == NULL) {
perror(filename);
return;
}
/* Set up the file header. */
#if !defined(__MINGW__) && !defined(_MSC_VER)
fprintf(file, "set terminal X11\n");
#endif
if (title) {
text = cp_unquote(title);
fprintf(file, "set title \"%s\"\n", text);
tfree(text);
}
if (xlabel) {
text = cp_unquote(xlabel);
fprintf(file, "set xlabel \"%s\"\n", text);
tfree(text);
}
if (ylabel) {
text = cp_unquote(ylabel);
fprintf(file, "set ylabel \"%s\"\n", text);
tfree(text);
}
if (!nogrid) {
if (linewidth > 1)
fprintf(file, "set grid lw %d \n" , linewidth);
else
fprintf(file, "set grid\n");
}
if (xlog) {
fprintf(file, "set logscale x\n");
if (xlims)
fprintf(file, "set xrange [%1.0e:%1.0e]\n",
pow(10, floor(log10(xlims[0]))), pow(10, ceil(log10(xlims[1]))));
fprintf(file, "set xrange [%e:%e]\n", xlims[0], xlims[1]);
fprintf(file, "set mxtics 10\n");
fprintf(file, "set grid mxtics\n");
} else {
fprintf(file, "unset logscale x \n");
if (xlims)
fprintf(file, "set xrange [%e:%e]\n", xlims[0], xlims[1]);
}
if (ylog) {
fprintf(file, "set logscale y \n");
if (ylims)
fprintf(file, "set yrange [%1.0e:%1.0e]\n",
pow(10, floor(log10(ylims[0]))), pow(10, ceil(log10(ylims[1]))));
fprintf(file, "set mytics 10\n");
fprintf(file, "set grid mytics\n");
} else {
fprintf(file, "unset logscale y \n");
if (ylims)
fprintf(file, "set yrange [%e:%e]\n", ylims[0] - extrange, ylims[1] + extrange);
}
fprintf(file, "#set xtics 1\n");
fprintf(file, "#set x2tics 1\n");
fprintf(file, "#set ytics 1\n");
fprintf(file, "#set y2tics 1\n");
if (linewidth > 1)
fprintf(file, "set border lw %d\n", linewidth);
if (plottype == PLOT_COMB) {
strcpy(plotstyle, "boxes");
} else if (plottype == PLOT_POINT) {
if (markers) {
// fprintf(file, "Markers: True\n");
} else {
// fprintf(file, "LargePixels: True\n");
}
strcpy(plotstyle, "points");
} else {
strcpy(plotstyle, "lines");
}
/* Open the output gnuplot data file. */
if ((file_data = fopen(filename_data, "w")) == NULL) {
perror(filename);
return;
}
fprintf(file, "set format y \"%%g\"\n");
fprintf(file, "set format x \"%%g\"\n");
fprintf(file, "plot ");
i = 0;
/* Write out the gnuplot command */
for (v = vecs; v; v = v->v_link2) {
scale = v->v_scale;
if (v->v_name) {
i = i + 2;
if (i > 2) fprintf(file, ",\\\n");
fprintf(file, "\'%s\' using %d:%d with %s lw %d title \"%s\" ",
filename_data, i-1, i, plotstyle, linewidth, v->v_name);
}
}
fprintf(file, "\n");
fprintf(file, "set terminal push\n");
if (terminal_type == 1) {
fprintf(file, "set terminal postscript eps color\n");
fprintf(file, "set out \'%s.eps\'\n", filename);
} else {
fprintf(file, "set terminal png\n");
fprintf(file, "set out \'%s.png\'\n", filename);
}
fprintf(file, "replot\n");
fprintf(file, "set term pop\n");
fprintf(file, "replot\n");
(void) fclose(file);
/* Write out the data and setup arrays */
for (i = 0; i < scale->v_length; i++) {
for (v = vecs; v; v = v->v_link2) {
scale = v->v_scale;
xval = isreal(scale) ?
scale->v_realdata[i] : realpart(scale->v_compdata[i]);
yval = isreal(v) ?
v->v_realdata[i] : realpart(v->v_compdata[i]);
fprintf(file_data, "%e %e ", xval, yval);
}
fprintf(file_data, "\n");
}
(void) fclose(file_data);
#if defined(__MINGW32__) || defined(_MSC_VER)
/* for external fcn system() */
// (void) sprintf(buf, "start /B wgnuplot %s -" , filename_plt);
(void) sprintf(buf, "start /B wgnuplot -persist %s " , filename_plt);
_flushall();
#else
/* for external fcn system() from LINUX environment */
(void) sprintf(buf, "xterm -e gnuplot %s - &", filename_plt);
#endif
err = system(buf);
}
void
com_compose(wordlist *wl)
{
double start = 0.0;
double stop = 0.0;
double step = 0.0;
double lin = 0.0;
double center;
double span;
double mean, sd;
bool startgiven = FALSE, stopgiven = FALSE, stepgiven = FALSE;
bool lingiven = FALSE;
bool loggiven = FALSE, decgiven = FALSE, gaussgiven = FALSE;
bool randmgiven = FALSE;
bool spangiven = FALSE;
bool centergiven = FALSE;
bool meangiven = FALSE;
bool poolgiven = FALSE;
bool sdgiven = FALSE;
int log, dec, gauss, randm;
char *pool;
int i;
char *s, *var, *val;
double *td, tt;
double *data = NULL;
ngcomplex_t *cdata = NULL;
int length = 0;
int dim, type = SV_NOTYPE, blocksize;
bool realflag = TRUE;
int dims[MAXDIMS];
struct dvec *result, *vecs = NULL, *v, *lv = NULL;
struct pnode *pn, *names = NULL;
bool reverse = FALSE;
char *resname = cp_unquote(wl->wl_word);
vec_remove(resname);
wl = wl->wl_next;
if (eq(wl->wl_word, "values")) {
/* Build up the vector from the rest of the line... */
wl = wl->wl_next;
names = ft_getpnames(wl, TRUE);
if (!names)
goto done;
for (pn = names; pn; pn = pn->pn_next) {
if ((v = ft_evaluate(pn)) == NULL)
goto done;
if (!vecs)
vecs = lv = v;
else
lv->v_link2 = v;
for (lv = v; lv->v_link2; lv = lv->v_link2)
;
}
/* Now make sure these are all of the same dimensionality. We
* can coerce the sizes...
*/
dim = vecs->v_numdims;
if (dim < 2)
dim = (vecs->v_length > 1) ? 1 : 0;
if (dim == MAXDIMS) {
fprintf(cp_err, "Error: max dimensionality is %d\n",
MAXDIMS);
goto done;
}
for (v = vecs; v; v = v->v_link2)
if (v->v_numdims < 2)
v->v_dims[0] = v->v_length;
for (v = vecs->v_link2, length = 1; v; v = v->v_link2) {
i = v->v_numdims;
if (i < 2)
i = (v->v_length > 1) ? 1 : 0;
if (i != dim) {
fprintf(cp_err,
"Error: all vectors must be of the same dimensionality\n");
goto done;
}
length++;
if (iscomplex(v))
realflag = FALSE;
}
for (i = 0; i < dim; i++) {
dims[i] = vecs->v_dims[i];
for (v = vecs->v_link2; v; v = v->v_link2)
if (v->v_dims[i] > dims[i])
dims[i] = v->v_dims[i];
}
dim++;
dims[dim - 1] = length;
for (i = 0, blocksize = 1; i < dim - 1; i++)
blocksize *= dims[i];
if (realflag)
data = TMALLOC(double, length * blocksize);
else
