/*this is file plots.c */ #include #include #include #include "ana_structures.h" extern struct sym_desc sym[]; extern struct sym_list *subr_sym_list[]; extern int temp_base; extern int ana_float(), ck_events(), ana_xflush(); extern int ana_type_size[]; extern int vfix_top, num_ana_subr, next_user_subr_num; extern int lastmin_sym, lastmax_sym; extern float callig_xb, callig_yb; extern float float_arg(); extern double double_arg(); extern int postrawout(char *s); extern int postxlabel(float x, float y, char *label); extern int postylabel(float x, float y, char *label); extern int postytitle(float x, float y, char *label); extern int xfontylabel(float x, float y, char *label, float *xleftmost); union types_ptr { byte *b; short *w; int *l; float *f; double *d;}; /* some common variables */ struct ahead *h; union types_ptr q1, q2; int symplot(float x, float y, int ip); int tkplot(float x, float y, int ip); /* plotting context */ int lunplt = 0, ixlow, ixhigh, iylow, iyhigh; float xfac, yfac, biggest_x, biggest_y; int numarrays, numstrings, numscalars; static int xsym, ysym, xtitlesym, ytitlesym, titlesym, pmode, nx, ny; static int nelem; char form[20]; /* 12/1/95 made iorder = 2 the default */ int landscape = 1, iorder=2, psfontflag=0, xfontflag=1; float current_gray=0, current_pen=1.0; int nlabel(); /* contents of VMS common plots follows */ int ilabx=1, ilaby=1, irxf=1, iryf=1, ndx; int nd, ipltyp, ifz, ifzx=1, ndxs, ndys, ier=1; int ifont=5, ndlabx=2, ndlaby=2, iblank=1, ndot=1, ifirstflag; float xmin, xmax, ymin, ymax, ybotmost, xleftmost; float wxb=.15,wxt=.9,wyb=.1,wyt=.7; float ticx=.01,ticy=.01,plims[4],xlimit=.9998,ylimit=.9998; float fsized=1,symsize=1.0; float symratio=1.0,ticxr=.5,ticyr=.5,dvx,dv; /* end of VMS common plots */ /*------------------------------------------------------------------------- */ int ana_plot(int narg,int ps[]) /* plot routine */ /* plots data */ { if (preplot(narg,ps) != 1) return -1; if (plotxy(q1.f, q2.f, nelem, pmode) != 1) return -1; if (labels() != 1) return -1; /* 10/12/92 flush if needed, only matters for X at present */ switch (lunplt) { case 0: ana_xflush(); break; } return 1; } /*------------------------------------------------------------------------- */ int ana_oplot(int narg,int ps[]) /* oplot routine */ /* over plot data */ { if (preplot(narg,ps) != 1) return -1; if (oplotx(q1.f, q2.f, nelem, pmode) != 1) return -1; /* 10/12/92 flush if needed, only matters for X at present */ switch (lunplt) { case 0: ana_xflush(); break; } return 1; } /*------------------------------------------------------------------------- */ int preplot(int narg,int ps[]) /* used by plot and oplot to setup */ /* 5/16/2001 - doesn't seem to do any drawing, just argument stuff */ { int i, iq, nd, j; /* loop through the args and check what we have */ xsym = ysym = ytitlesym = xtitlesym = titlesym = 0; pmode = 1; numarrays = 0; numscalars = 0; numstrings = 0; for (i=0;indim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ nx = nelem; q1.f = (float *) ((char *) h + sizeof( struct ahead )); ysym = ana_float(1, &ysym); h = (struct ahead *) sym[ysym].spec.array.ptr; nd = h->ndim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ ny = nelem; q2.f = (float *) ((char *) h + sizeof( struct ahead )); nelem = MIN( nx, ny); /* 10/12/92 also do any preps for pdev, only matters for X at present */ switch (lunplt) { case 0: ck_events(); break; } return 1; } /*------------------------------------------------------------------------- */ int labels() /* labels x and y axis and top title */ { char *p; if (xtitlesym) { p = (char *) sym[xtitlesym].spec.array.ptr; titles(1,p); } if (ytitlesym) { p = (char *) sym[ytitlesym].spec.array.ptr; titles(2,p); } if (titlesym) { p = (char *) sym[titlesym].spec.array.ptr; titles(3,p); } return 1; } /*------------------------------------------------------------------------- */ int mm(x, n, max, min) float *x, *max, *min; int n; { float rmin, rmax; /* just return the min and max of a floating array */ if (n <= 0 ) { printf("bad count in mm, n = %d\n",n); return -1; } rmax = rmin = *x++; n--; while (n--) { if (*x > rmax) rmax = *x; if (*x < rmin) rmin = *x; x++; } *min = rmin; *max = rmax; return 1; } /*------------------------------------------------------------------------- */ int plotxy(xx, yy, n, mode) float xx[], yy[]; int n, mode; /* 5/16/2001 - should be updated, tkplot is getting a bit old afterall */ { int i, j, iylog, ixlog; float xq, ymin_log, xmax_log, zq, c, tic,y, yq, x; xleftmost = wxb; ybotmost = wyb; /* used for y axis label */ /* do we need either xmax or xmin ? */ if ((plims[0] == 0) || (plims[1] == 0)) mm(xx,n,&xmax,&xmin); if ((plims[2] == 0) || (plims[3] == 0)) mm(yy,n,&ymax,&ymin); /* in linear mode, set up mins according to !fz and !fzx, but allow !yb,!xb to take precedence */ iylog = ipltyp % 2; ixlog = (ipltyp/2) % 2; if (ifz == 0 && iylog == 0) ymin = MIN(ymin,0.); if (ifzx == 0 && ixlog == 0) xmin = MIN(xmin,0.); /* now put in !xb,!yb (from plims) if the user has specified if user specified any limit, we put it in now what if the limit is zero?? the user should set the limit to a very small # if 0 is desired */ if (plims[3] != 0) ymax = plims[3]; /* yt */ if (plims[2] != 0) ymin = plims[2]; /* yb */ if (plims[1] != 0) xmax = plims[1]; /* xt */ if (plims[0] != 0) xmin = plims[0]; /* xb */ /* get rounded limits & division size make sure the maxes aren't equal to the mins */ if (ymax == ymin) ymax = ymin+1; if (xmax == xmin) xmax = xmin+1; ndlabx = MAX(ndlabx,1); ndlaby = MAX(ndlaby,1); /* check for rounding and get limits and tick spacings */ if ((iryf == 0) && (iylog == 0)) { /* no rounding (linear mode only) */ nd=8; if (ndys > 0) nd=ndys; /* # divisions on axis */ dv=(ymax-ymin) / (float) nd; /* data per division */ } else setl(&ymax,&ymin,&nd,&dv,iylog,wyb,wyt); if ((irxf == 0) && (ixlog == 0)) { /* no rounding (linear mode only) */ ndx=8; if (ndxs > 0) ndx=ndxs; dvx=(xmax-xmin) / (float) ndx; } else setl(&xmax,&xmin,&ndx,&dvx,ixlog,wxb,wxt); /* draw the box, ticks, & labels */ /*printf("nd, ndx = %d %d\n",nd,ndx);*/ if (ier == 1) ana_erase(0); if ((ilabx == 0 && ilaby == 0) && (ticx == 0 && ticy == 0)) { /* just draw a box for this case */ tkplot(wxb,wyb,0); tkplot(wxt,wyb,1); if (ipltyp < 4) { tkplot(wxt,wyt,1); tkplot(wxb,wyt,1); } else tkplot(wxb,wyt,0); tkplot(wxb,wyb,1); tkplot(wxb,wyb,1); } else { /* most of the rest of the code is the else case */ /* get stuff for log plotting if needed */ if (iylog == 1) ymin_log = log10(ymin); if (ixlog == 1) xmax_log = log10(xmax); /* first the lhs y axis */ if (iylog == 1) { /* log mode */ zq=wxb; /* printf("lhs log mode, ymin_log = %f\n", ymin_log); */ /* draw a tick mark only if outside the box (i.e., negative) */ if (ticy < 0) { zq += ticy; tkplot(wxb,wyb,0); tkplot(wxb+ticy,wyb,1); } if (ilaby != 0) nlabel(ymin_log,zq,wyb,0,1); tkplot(wxb,wyb,0); xq = wyb; for ( i=1;i<=nd;i++) { /* #cycles */ /* use ticy to decide if ticks are drawn */ if (ticy != 0) { /* this draws 1 long tick and eight short ticks for each log cycle */ tic = ticy * ticyr + wxb; for (j=2;j<10;j++) { y = xq + log10( (float) j ) * dv; tkplot(wxb,y,1); tkplot(tic,y,1); tkplot(wxb,y,0); } } xq = xq + dv; /* screen coord of bottom of next cycle */ tkplot(wxb,xq,1); /* get up to the next cycle */ if (ilaby != 0) { y = (ymin_log + i); nlabel(y,zq,xq,1,1); } /* a tick mark is needed here unless at top, even at top if negative tick */ if (ticy < 0 || i < nd || ipltyp >= 4) { tkplot(wxb,xq,0); tkplot(wxb+ticy,xq,1); } tkplot(wxb,xq,0); /* back to bottom of next cycle */ } } else { /* linear mode */ xq = dv * (wyt-wyb)/(ymax-ymin); yq=wyb; if (ilaby != 0) { sform(ymin,ymax, nd/ndlaby); /*format for y axis (linear)*/ zq = wxb; if (ticy < 0) { zq = zq + ticy; /* so label not on tick */ /* and draw a tick (this is first interval, tick needed only if neg) */ tkplot(wxb,wyb,0); tkplot(wxb+ticy,wyb,1); } nlabel(ymin,zq,wyb,0,0); } tkplot(wxb,wyb,0); y = ymin; for ( i=1;i<=nd;i++) { yq += xq; tkplot(wxb,yq,1); if ( (i % ndlaby) == 0 && ilaby != 0) { y += ndlaby*dv; nlabel(y,zq,yq,1,0); } if (ticy != 0 && (i != nd || ticy < 0 || ipltyp >= 4)) { if((i % ndlaby) == 0) x=wxb+ticy; else x=wxb+ticy*ticyr; tkplot(wxb,yq,0); tkplot(x,yq,1); tkplot(wxb,yq,0); } tkplot(wxb,yq,0); } } /* now the top, entire top and rhs skipped for pltyp's ge 4 */ if (ipltyp < 4) { if( ixlog == 1) { if (ticx != 0) { xq=wxb; tkplot(wxb,wyt,0); /* an intial tick may be needed */ if (ticx < 0) { tkplot(wxb,wyt-ticx,1); tkplot(wxb,wyt,0); } tic=ticx*ticxr; for (i=1;i<=ndx;i++) { for (j=2;j<10;j++) { x = xq + log10( (float) j ) * dvx; tkplot(x,wyt,1); tkplot(x,wyt-tic,1); tkplot(x,wyt,0); } xq += dvx; tkplot(xq,wyt,1); /* a tick is usually needed here */ if (i != nd || ticx < 0) { tkplot(xq,wyt-ticx,1); tkplot(xq,wyt,0); } } } else /* in this else, there are no ticks*/ { tkplot(wxb,wyt,0); tkplot(wxt,wyt,1); } } else { /* linear case */ xq = dvx*(wxt-wxb)/(xmax-xmin); x=wxb; if (ticx != 0) { tkplot(wxb,wyt,1); /* need a tick here ? */ if (ticx < 0) { tkplot(wxb,wyt-ticx,1); tkplot(wxb,wyt,0); } for (i=1;i<=ndx;i++) { x += xq; tkplot(x,wyt,1); if ( (i % ndlabx) == 0) y = wyt-ticx; else y = wyt-ticx*ticxr; if (i != ndx || ticx < 0 || ipltyp >= 4) { tkplot(x,y,1); tkplot(x,wyt,0); } } } else { tkplot(wxb,wyt,0); } /* this is the no tick case */ } tkplot(wxt,wyt,1); /* now the rhs */ if (iylog == 1) { if (ticy != 0) { xq=wyt; if (ticy < 0) tkplot(wxt-ticy,wyt,1); for (i=1;i<=nd;i++) { tkplot(wxt,xq,0); tic = ticy*ticyr; /* this draws 1 long tick and eight short ticks for each log cycle */ for (j=9;j>=2;j--) { y = xq - dv*(1.- log10( (float) j)); tkplot(wxt,y,1); tkplot(wxt-tic,y,1); tkplot(wxt,y,0); } xq = xq - dv; tkplot(wxt,xq,1); /* a tick is usually needed here */ if (i != nd || ticy < 0) { tkplot(wxt-ticy,xq,1); tkplot(wxt,xq,0); } } } else tkplot(wxt,wyt,0); } else { /* this is linear case for rhs */ if (ticy != 0) { xq = dv*(wyt-wyb)/(ymax-ymin); yq = wyt; /* need a tick here */ if (ticy < 0) { if (( nd % ndlaby) == 0) tkplot(wxt-ticy,wyt,1); else tkplot(wxt-ticy*ticyr,wyt,1); } tkplot(wxt,wyt,0); /* note that the nd-1,0 range needed to label modulus */ for (i=nd-1;i>=0;i--) { yq = yq - xq; tkplot(wxt,yq,1); if (( i % ndlaby) == 0) x = wxt-ticy; else x = wxt - ticy*ticyr; if (i != 0 || ticy < 0) { tkplot(x,yq,1); tkplot(wxt,yq,0); } } } else tkplot(wxt,wyt,0); } tkplot(wxt,wyb,1); } /* end of pltype < 4 test */ /* now the bottom */ if(ixlog == 1) { xq=wxt; zq=wyb; /* log bottom */ /* draw first tick mark only if outside the box (i.e., negative) or open box */ if (ticx < 0) { zq = zq + ticx; tkplot(wxt,wyb,0); tkplot(wxt,wyb+ticx,1); } if (ilabx != 0) nlabel(xmax_log,wxt,zq,2,1); tkplot(wxt,wyb,0); tic=ticx*ticxr; for (i=1;i<=ndx;i++) { if (ticx != 0) { tkplot(xq,wyb,0); for (j=9;j>=2;j--) { x = xq-dvx*(1.-log10( (float) j )); tkplot(x,wyb,1); tkplot(x,wyb+tic,1); tkplot(x,wyb,0); } x = xq - dvx; tkplot(x,wyb,1); /* the last tick is not always drawn */ if (i != ndx || ticx < 0 || ipltyp >= 4) tkplot(x,wyb+ticx,1); } /* end of ticx condition */ xq = xq - dvx; if (ilabx != 0) { y = (xmax_log - i); nlabel(y,xq,zq,2,1); } tkplot(xq,wyb,0); } /* linear bottom */ } else { zq = wyb; if (ticx < 0 || ipltyp >= 4) { zq = zq + ticx; tkplot(wxt,wyb,0); if ( (ndx % ndlabx) == 0) tkplot(wxt,wyb+ticx,1); else tkplot(wxt,wyb+ticx*ticxr,1); } if ( ilabx != 0 && (ndx % ndlabx) == 0) { sform(xmin,xmax, ndx/ndlabx); /* format for x axis */ nlabel(xmax,wxt,zq,2,0); } tkplot(wxt,wyb,0); x = wxt; xq = dvx*(wxt-wxb)/(xmax-xmin); for (i=ndx-1;i>=0;i--) { x = x - xq; if (ticx != 0) { if ( (i % ndlabx ) == 0) yq = wyb + ticx; else yq = wyb + ticx*ticxr; tkplot(x,wyb,1); if (i != 0 || ticx < 0) tkplot(x,yq,1); } else tkplot(wxb,wyb,1); if ( (i % ndlabx ) == 0 && ilabx != 0) { y = i*dvx+xmin; //printf("xlabel at %g, %g\n", x,zq); nlabel(y, x, zq, 2, 0); } tkplot(x, wyb, 0); } } } if (n > 0 && mode != 0) return oplotx(xx,yy,n,mode); return 1; } /*------------------------------------------------------------------------- */ int oplotx(x, y, n, imm) float x[], y[]; int imm; { float sm[10], xx, yy, xr, yr, xdi, ydi, s, sd, s0, xl, yl,xc,yc,dx, dy; int mode, ixlog, iylog, i, m, id, ndash; mode = imm; /* printf("mode in oplotx = %d\n", mode); */ ifirstflag = 1; /* used by symplot if blanking enabled */ iylog = ipltyp % 2; /* log scaling if iylog=1 */ ixlog = ipltyp/2 % 2; /* get scale and first set of coordinates all plot points must lie between physical limits of plot */ xx = MAX( xmin, (MIN( x[0], xmax))); yy = MAX( ymin, (MIN( y[0], ymax))); if (ixlog) { /* log x mode */ xr = (wxt-wxb) / ( log10(xmax/xmin)); xdi=wxb + log10(xx/xmin) * xr; } else { /* linear x mode */ xr = (wxt-wxb)/(xmax-xmin); xdi = wxb+(xx-xmin)*xr; } if (iylog) { /* log y mode */ yr = (wyt-wyb)/(log10(ymax/ymin)); ydi = wyb + log10(yy/ymin) * yr; } else { /* linear y mode */ yr=(wyt-wyb)/(ymax-ymin); ydi=wyb+(yy-ymin)*yr; } if ( mode < 10 || (mode > 20 && mode < 30) ) { tkplot(xdi,ydi,0); if (mode != 1) tkplot(xdi,ydi,mode); if (n > 1) { for (i=1;i s0) { xc=xc+s0*dx; yc=yc+s0*dy; tkplot(xc,yc,m); s=s-s0; id = (id+1) % ndash; s0 = sm[id]; if (s0 <= 0) { printf("error in dash line data base\n"); return -1; } if (m == 0) m = 1; else m = 0; } s0 = s0 - s; tkplot(xdi,ydi,m); xl = xx; yl = yy; } } else if (mode == 20) { /*do a bar type graph */ tkplot(xdi,ydi,0); for (i=1;i (log10( (double) *ymin)+1.e-7)) yn = yn - 1.; yn = pow(10., floor(yn)); yx = pow(10., floor((log10( (double) *ymax) + 1.) )); xq = log10( (yx / yn) ); *nq = xq; /* Note, NQ is 1 cycle too big if YMAX is exactly a power of 10 */ if ( log10( (double) *ymax) == floor( log10( (double) *ymax) )) (*nq)--; if (*nq <= 0) { printf("internal error in setl, plot may be very strange\n"); *nq = 1; } *ymin = yn; *ymax = yn * pow( 10., (double) *nq); *dv = (wyt - wyb) / *nq; } else { /* linear case */ xq = *ymax - *ymin; if ( xq <= 0) xq = 2.; ilg = log10( xq ); if ( xq <= 1) ilg--; yq = pow(10., (double) ilg); zq = xq / yq; rdx = 1.; if ( zq <= 6 ) rdx = .5; if ( zq <= 2 ) rdx = .2; if ( zq <= 1 ) rdx = .1; xq = yq * rdx; *dv = xq; j2 = *ymax / xq; j1 = *ymin / xq; xt = j2 * xq; xb = j1 * xq; if ( xt < *ymax) j2++; if ( xb > *ymin) j1--; /* j1 should be even */ if ( ABS(j1) % 2 == 1) j1--; *nq = ABS(j2 - j1); if ( *nq % 2 == 1) j2++; *ymax = xq * j2; *ymin = xq * j1; *nq = ABS( j2 - j1 ); } return 1; } /*------------------------------------------------------------------------- */ int tkplot(float x, float y, int ip) { int ix, iy; //printf("tkplot, x %f, y %f, ip = %d\n", x, y, ip); /* use current context to convert to device dependent coords (DD) and call routine for current device */ if (ip > 1 || ip < 0 ) return symplot(x,y,ip); switch (lunplt) { /* lump all cases that convert to DD here */ case 0: if (x < 1.0 ) x = x * xfac; if (y < 1.0 ) y = y * yfac; ix = (int) (x + .5); iy = (int) ( y + .5); //ix = MAX(ix, ixlow); iy = MAX(iy, iylow); //ix = MIN(ix, ixhigh); iy = MIN(iy, iyhigh); iy = iyhigh - iy; /* upside down */ } /*printf("tkplot mid\n");*/ /* now switch again for calls */ switch (lunplt) { case 0: return xwindow_plot(ix, iy, ip); case 1: return postvec(x, y, ip); } return 1; } /*------------------------------------------------------------------------*/ int ana_pen(narg, ps) /* set pen width, in pixels for X and in multiples of 1/300 inch for PS */ /* answers to pen and penwidth, a second arg is used as gray value for PS */ /* also see pencolor which also supports gray value */ int narg, ps[]; { float pen; if (narg) { current_pen = float_arg( ps[0]); current_gray = 0.0; if (narg > 1) current_gray = float_arg( ps[1]); return set_pen(current_pen); } else { printf("current pen setting = %f\n", current_pen); } } /*------------------------------------------------------------------------*/ int ana_pencolor(narg, ps) int narg, ps[]; { int iq, nx, xflag, n; static float red, green, blue; char *pc; struct ahead *h; float *pf; if (lunplt == 0) xflag = 1; else xflag =0; if (narg) { switch (sym[ ps[0] ].class) { case 2: /* a string */ pc = (char *) sym[ps[0] ].spec.array.ptr; /* get rgb values for this color name, if for X, also set foreground */ if (getXcolor(pc, &red, &green, &blue, xflag) != 1) return -1; if (xflag) break; /* if postscript (only other case at present), normalize to 1 */ printf("returned color values = %f, %f, %f\n", red, green, blue); red=red/65535.; green=green/65535.; blue=blue/65535.; break; case 4: /* an array */ iq = ana_float(1,ps); h = (struct ahead *) sym[iq].spec.array.ptr; nx = h->dims[0]; if (nx < 3) { return pencolor_err(); } pf = (float *) ((char *)h + sizeof(struct ahead)); /* check first */ n = 3; while (n--) { if (*pf > 1.0 || *pf < 0.0) return pencolor_err(); pf++; } /* now set the values */ pf = (float *) ((char *)h + sizeof(struct ahead)); red = *pf++; green = *pf++; blue = *pf++; if (xflag) { xflag = 2; if (getXcolor(pc, &red, &green, &blue, xflag) != 1) return -1; } break; } if (lunplt == 1) return postcolorpen( red, green, blue); } else { printf("current pen color setting (RGB) = %f %f %f\n", red, green, blue); } return 1; } /*------------------------------------------------------------------------*/ int pencolor_err() { printf("PENCOLOR: requires a string naming color or an array of 3 values\n"); printf(" in the range 0 to 1.0\n"); return -1; } /*------------------------------------------------------------------------*/ int set_pen(pen) float pen; { switch (lunplt) { case 0: return ana_xpen(pen); case 1: return postpen(pen,current_gray); } } /*------------------------------------------------------------------------*/ int ana_erase(narg, ps) int narg, ps[]; { switch (lunplt) { case 0: return ana_xerase(narg, ps); case 1: return postcopy(); } } /*------------------------------------------------------------------------- */ int ana_limits(narg,ps) /*set or examine limits */ int narg, ps[]; { if (narg == 0 ) { printf("current plot range x axis %f to %f\n",plims[0],plims[1]); printf(" y axis %f to %f\n",plims[2],plims[3]); return 1; } if (narg > 0) plims[0] = float_arg( ps[0]); if (narg > 1) plims[1] = float_arg( ps[1]); if (narg > 2) plims[2] = float_arg( ps[2]); if (narg > 3) plims[3] = float_arg( ps[3]); return 1; } /*------------------------------------------------------------------------- */ int ana_window(narg,ps) /*set or examine window */ int narg, ps[]; { if (narg == 0 ) { printf("current window x axis %f to %f\n",wxb, wxt); printf(" y axis %f to %f\n",wyb, wyt); return 1; } if (narg > 0) wxb = float_arg( ps[0]); if (narg > 1) wxt = float_arg( ps[1]); if (narg > 2) wyb = float_arg( ps[2]); if (narg > 3) wyt = float_arg( ps[3]); return 1; } /*------------------------------------------------------------------------- */ int ana_pdev(narg,ps) int narg, ps[]; { if (narg > 0) { int iq; lunplt = int_arg( ps[0]); switch (lunplt) { case 1: /* postscript file */ if (landscape == 0) { biggest_y = 0.9999; biggest_x = 0.8000; } else { biggest_x = 0.9999; biggest_y = 0.8000; } xlimit = biggest_x; ylimit = biggest_y; if (narg<2) post_startup(0); else { char *s; iq = ps[1]; if ( sym[iq].class != 2 ) return execute_error(70); s = (char *) sym[iq].spec.array.ptr; post_startup(s); } break; case 0: /* reset xlimit and ylimit */ xlimit=.9998; ylimit=.9998; break; } } else { printf(" 0 X window terminal\n 1 postscript file (landscape)\n"); printf("current setting = %d\n",lunplt); } return 1; } /*------------------------------------------------------------------------- */ int nlabel(x, xx, yy, modes, log) float x, xx, yy; int modes, log; { /* x is value to use in label, xx and yy are position the modes are 0 bottom y axis 1 rest of y axis 2 x axis 3 display times on x axis */ char label[32]; int mode, jtop, j, leng, callig_flag; char *s, *s2, sq; float xdi, ydi, fsize, xq; /* printf("nlabel, xx, yy, x = %f %f %f\n", xx,yy,x); printf("modes = %d\n", modes); */ mode = modes; xdi = xx; ydi = yy; /* first encode the value using form leng is actual length of label minus leading blanks j is the index of the first nonblank character in label */ if (mode == 3) mode = 2; if (modes != 3) { if (log == 0) sprintf(label, form, x); else sprintf(label, "%d", (int) rint(x) ); /* log case */ /* this is the modes=3 case, ut label, label already constructed in form */ } else strcpy(label, form); /* count number of leading blanks */ j = 0; s = label; while ( *s++ == ' ') j++; leng = strlen(label); /* remove any pluses */ /* if we end in a decimal point, just strip it off */ if (label[leng-1] == '.' ) { leng--; label[leng] = 0; } if (j) { strcpy(label, &label[j]); leng = strlen(label); } /* remove any pluses, awkwardly */ j = leng; leng = 0; s = s2 = label; while (j--) { sq = *s++; if ( sq != '+') { *s2++ = sq; leng++; } } label[leng] = 0; if (fsized <= 0) fsized = 1.0; fsize = fsized/32.; /* fsize is in di units, fsized is different */ /* this is for historical reasons, a character size of 1 gives a height of 32 tektronix pixels hence we multiply by 32./1024. which is eq. to 1./32. this means we can use fsize together with character size fractions */ if (log != 0) sprintf(label,"10^%d", (int) rint(x)); /* the log case */ /* split according to Postscript or non (only X at present), but if we do callig, then take the callig option (which works for either) */ callig_flag = 0; if (lunplt == 0 && xfontflag == 0) callig_flag = 1; if (lunplt == 1 && psfontflag == 0) callig_flag = 1; if (callig_flag) { /* callig case, used for X and for PS if no font set*/ /* initial call to get width */ xq = 0.0; callig(label,xq,xq,fsized,xq,ifont,0); /* the width of our label is in callig_xb */ if (mode == 2) { /* x axis cases */ ydi = ydi - fsize * 1.25; if (log != 0) ydi = ydi - fsize * 0.156; /* lower a bit for exponents */ ybotmost = MIN(ybotmost,ydi); xdi = xdi - callig_xb / 2; /* if there is a minus sign, don't include when centering ! */ if (x < 0 && log == 0) xdi = xdi-.375*fsize; /* about .375 ? */ } else { /* the y axis */ xdi = xdi - callig_xb - 0.219 * fsize; xleftmost = MIN(xleftmost,xdi); if (log != 0) xdi = xleftmost; /* helps line up log labels, but should check entire range of values */ if (mode == 1) ydi = ydi - fsize * .3125; } xdi = MIN(xdi, xlimit - callig_xb - .001); xdi = MAX(xdi, 0.); ydi = MAX(ydi, 0.); xq = 0; callig( label, xdi, ydi, fsized, xq, ifont, 1); } else { /* Postscript or X font case */ switch (mode) { case 1: //ydi = ydi - fsize * .3125; /* continue with case 0 code */ ydi = ydi - fsize * .3125; /* continue with case 0 code */ case 0: xdi = xdi - 0.219 * fsize; xleftmost = MIN(xleftmost,xdi); if (log != 0) xdi = xleftmost; /* helps line up log labels, but should check entire range of values */ /* printf("xdi, ydi = %f %f\n", xdi, ydi); printf("label = %s\n", label); printf("label address = %d\n", label); */ switch (lunplt) { case 0: xfontylabel(xdi,ydi,label,&xleftmost); break; case 1: postylabel(xdi,ydi,label); break; } break; case 2: /* x axis */ /* for the x window case, the fsize is now di but height has a lot of room at the top */ if (log != 0) ydi = ydi - fsize * 0.156; /* lower a bit for exponents */ /* if there is a minus sign, don't include when centering ! */ if (x < 0 && log == 0) xdi = xdi-.3*fsize; /* about .3 for PS ? */ switch (lunplt) { case 0: ydi = ydi - fsize * 1.00; //printf("xdi, ydi %g %g\n",xdi,ydi); xfontxlabel(xdi,ydi,label); break; case 1: ydi = ydi - fsize * 1.25; postxlabel(xdi,ydi,label); break; } ybotmost = MIN(ybotmost,ydi); break; } } return 1; } /*------------------------------------------------------------------------- */ int titles(i,ilab) /* print any labels etc */ int i; char *ilab; { float xdi, ydi, fsize, ang; int callig_flag; /* check if a null, save work and hassel if it is */ if ( *ilab == 0) return; /* repeat setup of fsize in case numeric labels were not drawn */ if (fsized <= 0) fsized = 1.0; fsize = fsized/32.; /* fsize is in di units, fsized is different */ /* support Postscript, X, or drawn letters (callig) */ callig_flag = 0; if (lunplt == 0 && xfontflag == 0) callig_flag = 1; if (lunplt == 1 && psfontflag == 0) callig_flag = 1; if (callig_flag) { /* callig case, used for X and for PS if no font set*/ /* initial call to get width */ xdi = 0; ydi = 0; ang = 0; callig(ilab,xdi,ydi,fsized,ang,ifont,0); switch (i) { case 1: /* x axis title */ xdi=.5 * (wxb + wxt) - callig_xb / 2.; ydi = MAX(.0, ybotmost -1.1 * fsize); ang = 0.; break; case 2: /* y axis title */ ydi = .5 * (wyb+wyt) - callig_xb / 2.; xdi = MAX(.0, xleftmost - .625 * fsize); ang = 90.; break; case 3: /* main title */ xdi = .5 * (wxb + wxt) - callig_xb / 2.; ydi = MIN(wyt + 0.9375 * fsize, ylimit - fsize * 0.78125); ang = 0.; break; } return callig(ilab, xdi, ydi, fsized, ang, ifont,1); } else { /* Postscript or X font case */ switch (i) { case 1: /* x axis title */ xdi=.5 * (wxb + wxt); ydi = MAX(.0, ybotmost -1.2 * fsize); switch (lunplt) { case 0: xfontxlabel(xdi,ydi,ilab); break; case 1: postxlabel(xdi,ydi,ilab); break; } break; case 2: /* y axis title */ ydi = .5 * (wyb+wyt); /* note that leftmost for PS is handled via a PS variable that is updated for each numeric label */ switch (lunplt) { case 0: ydi = .5 * (wyb+wyt) - callig_xb / 2.; xdi = MAX(.0, xleftmost - .625 * fsize); xfontytitle(xdi,ydi,ilab); break; case 1: postytitle(- .625 * fsize, ydi, ilab); break; } break; /* main title */ case 3: xdi = .5 * (wxb + wxt); ydi = MIN(wyt + 0.9375 * fsize, ylimit - fsize * 0.78125); switch (lunplt) { case 0: xfontxlabel(xdi,ydi,ilab); break; case 1: postxlabel(xdi,ydi,ilab); break; } break; } } } /*------------------------------------------------------------------------- */ int sform(xb, xt, nd) /* make a nice format for plot labels */ float xb, xt; { /* set default form */ int ie, il; float xq, xc, xd; xc = MAX(ABS(xb),ABS(xt)); xd = MIN(ABS(xb),ABS(xt)); sprintf( form, "%s", "%8.1E"); /*default*/ if (xc >= 1.e6 || xc < 1.e-5 ) return 1; /* other cases (more common actually) */ sprintf( form, "%s", "%8.0f"); xq = (xt-xb)/nd; if (xq <= 0) { printf("equal limits in sform, xb, xt = %e, %e\n",xb,xt); return -1; } if (xq < 1) { xq = -log10(xq); ie = xq; if (xq > ie) ie++; /* how many digits on lhs ? */ xq = log10(xc); il = (int) xq; if (xq > il) il++; il = MAX(il,0); /* we have a max of 7 available */ ie = MIN(ie,7-il); form[3] = (char) (ie + 48); } return 1; } /*------------------------------------------------------------------------- */ int empty() /* flush the plot channel (whatever it is) */ { return 1; } /*------------------------------------------------------------------------- */ int symplot(float x, float y, int ip) { static int is[] = { 1,5,9,14,18,23,27,35,76,76}; static float poly[] = { 0.0085,.01,0,0,0,0,0.01,0.0075,0,0 }; static byte mode[] = { 0,1,0,1,0,1,0,1,0,1,1,1,1,0,1,1,1,0,1,1, 1,1,0,1,1,1,0,1,0,1,0,1,0,1,0,1,1,1,1,1,1,1,1,1,1, 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}; static float dx[] = {0,0,.005,-.005,.005,-.005,-.005,.005,.005,.005,-.005, -.005,.005,-.007,0,.007,-.007,-.007,0,.007,0,-.007, -.007,0,.007,-.007,0,0,.005,-.005,-.007,.007,-.005,.005, 0.00000,0.00110,0.00216,0.00318,0.00411,0.00495,0.00566,0.00624, 0.00666,0.00691,0.00700,0.00691,0.00666,0.00624,0.00566,0.00495, 0.00411,0.00318,0.00216,0.00110,0.00000,-.00110,-.00216,-.00318, -.00411,-.00495,-.00566,-.00624,-.00666,-.00691,-.00700,-.00691, -.00666,-.00624,-.00566,-.00495,-.00411,-.00318,-.00216,-.00110, 0 }; static float dy[] = {.005,-.005,0,0,.005,-.005,.005,-.005,.005,-.005,-.005, .005,.005,-.005,.007,-.005,-.005,0,.007,0,-.007,0, .005,-.007,.005,.005,.007,-.007,.005,-.005,0,0,.005,-.005, 0.00700,0.00691,0.00666,0.00624,0.00566,0.00495,0.00411,0.00318, 0.00216,0.00110,0.00000,-.00110,-.00216,-.00318,-.00411,-.00495, -.00566,-.00624,-.00666,-.00691,-.00700,-.00691,-.00666,-.00624, -.00566,-.00495,-.00411,-.00318,-.00216,-.00110,0.00000,0.00110, 0.00216,0.00318,0.00411,0.00495,0.00566,0.00624,0.00666,0.00691, .007 }; static float xp, yp; int nsym = 8, ns, nsm, ia, ib, ysize, icept, i, iq, ng; float tol = 1.e-5, delx, xq, yq, zq, xq2, yq2, slope, x2, y2, sq, pr; float x1, y1; char thing[2]; //printf("symplot: x,y,ip = %f, %f, %d\n", x,y,ip); ns = ABS( ip); if ( ns <= 1 ) { /* the -1 dot case or an error */ tkplot(x,y,0); tkplot(x,y,1); ifirstflag = 0; return 1; } nsm = ns - 1; if ( ip > 0 ) { /* draw line and symbol, first the line */ if (iblank == 0 ) tkplot(x,y,1); /* easy if no blanking */ else { /* blanking case */ if ( ifirstflag != 1 ) { if ( nsm <= nsym || ns > 20 ) { if ( nsm <= nsym ) pr = poly[nsm-1] * symsize; else pr = symsize *.01; /* we find the two endpoints of the line, 2 special cases are infinite slope and zero slope */ delx = x - xp; if ( delx != 0) slope = (y - yp)/delx; if ( pr > 0 ) { /* elliptical zone case */ if (delx == 0) { xq = xp; xq2 = x; zq = pr * symratio; if (y > yp) { yq=yp+zq; yq2=y-zq;} else { yq=yp-zq; yq2=y+zq;} } else { zq = pr/ sqrt( (slope*slope)/(symratio*symratio) + 1.0); if (x > xp) { xq=xp+zq; xq2=x-zq;} else { xq=xp-zq; xq2=x+zq;} zq = ABS(zq * slope); if (y > yp) { yq=yp+zq; yq2=y-zq;} else { yq=yp-zq; yq2=y+zq;} } } else { /* a polygon symbol, more work */ ysize = symsize * symratio; ia = is[nsm-1]; ib = is[ns-1] - 1; /* we assume that this is a connected series of lines */ icept = 0; for (i=ia;i= 0 && xq2 <= 0) || (xq <= 0 && xq2 >= 0) ) if ( (yq >= 0 && yq2 <= 0) || (yq <= 0 && yq2 >= 0) ) icept = 2; x1 = MIN(xq, xq2); x2 = MAX(xq, xq2); y1 = MIN(yq, yq2); y2 = MAX(yq, yq2); if (x>xp) { xq=xp+x2; xq2=x+x1; } else {xq2=x+x2; xq=xp+x1; } if (y>yp) { yq=yp+y2; yq2=y+y1; } else {yq2=y+y2; yq=yp+y1; } break; } icept = 1; /* must have been first one */ xq2 = xq; yq2 = yq; } } } /* end of for loop */ if (icept != 2) { printf("internal error in SYMPLOT, icept = %d\n",icept); return -1; } } /* ready to plot the line but we need to check if these points are really within the line (i.e., the symbols could be bigger than the spacing) */ if ( ABS(xq-xp) <= ABS(xq-x) && ABS(xq2-x) <= ABS(xq2-xp) ) if ( ABS(yq-yp) <= ABS(yq-y) && ABS(yq2-y) <= ABS(yq2-yp) ) { tkplot(xq,yq,0); tkplot(xq2,yq2,1); } } } xp = x; yp = y; } } /* draw the symbol if in range */ if (nsm <= nsym) { ysize = symsize * symratio; ia = is[nsm-1] - 1; ib = is[ns-1] - 1; for (i=ia;i 20 && ns < 30 ) { thing[0] = (char) (ns+48); thing[1] = 0; callig(thing, x-.005, y-.005, fsized, 0.0, 3,1); } } ifirstflag = 0; /* always go back to center, put a dot there if !dot is on and it is a closed polygon */ iq = 0; //printf("ns, ndot, poly[ns-2] %d %d %f\n", ns, ndot, poly[ns-2]); if ( ndot == 1 && (poly[ns-2] == 0 || ns == 9 )) iq = -1; //printf("calling tkplot from symplot, x %f, y %f, iq %d\n", x,y,iq); tkplot(x, y, iq); return 1; } /*------------------------------------------------------------------------- */ int ana_xymov(narg,ps) /* xymov routine */ /* subroutine, call is xymov(x,y,mode) */ int narg, ps[]; { /* the x, y, and mode arguments can be scalars or vectors in various combinations, if no mode, then assume a pen up to first point and then pen down */ int mode, nx, ny, nm, *mp, dx, dy, dm, iq, j; float *x, *y; mode = 0; mp = &mode; dm = 0; nm = 1; /* x, could be scalar or array */ iq = ps[0]; switch (sym[iq].class) { case 8: iq = class8_to_1(iq); /*scalar ptr case */ case 1: nx = 1; iq = ana_float(1, &iq); dx = 0; x = &sym[iq].spec.scalar.f; break; case 4: iq = ana_float(1, &iq); h = (struct ahead *) sym[iq].spec.array.ptr; nd = h->ndim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ nx = nelem; if (nx) dx = 1; else dx = 0; x = (float *) ((char *) h + sizeof( struct ahead )); break; } /* y, could be scalar or array */ iq = ps[1]; switch (sym[iq].class) { case 8: iq = class8_to_1(iq); /*scalar ptr case */ case 1: ny = 1; iq = ana_float(1, &iq); dy = 0; y = &sym[iq].spec.scalar.f; break; case 4: iq = ana_float(1, &iq); h = (struct ahead *) sym[iq].spec.array.ptr; nd = h->ndim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ ny = nelem; if (ny) dy = 1; else dy = 0; y = (float *) ((char *) h + sizeof( struct ahead )); break; } if ( nx == 1 || ny == 1) nelem = MAX( nx, ny); else nelem = MIN( nx, ny); /* now check out the mode */ if (narg > 2) { iq = ps[2]; switch (sym[iq].class) { case 8: iq = class8_to_1(iq); /*scalar ptr case */ case 1: nm = 1; iq = ana_long(1, &iq); dm = 0; mp = &sym[iq].spec.scalar.l; break; case 4: iq = ana_long(1, &iq); h = (struct ahead *) sym[iq].spec.array.ptr; nd = h->ndim; nelem = 1; for (j=0;jdims[j]; /*# of elements */ nm = nelem; if (nm) dm = 1; else dm = 0; mp = (int *) ((char *) h + sizeof( struct ahead )); break; } } if ( nm != 1 ) nelem = MIN( nm, nelem); /* 10/12/92 also do any preps for pdev, only matters for X at present */ switch (lunplt) { case 0: ck_events(); break; } /* ready for series (or just 1) of tkplot calls */ tkplot( *x, *y, *mp); x += dx; y += dy; mp += dm; if (narg < 3) mode = 1; nelem--; while (nelem>0) { tkplot( *x, *y, *mp); x += dx; y += dy; mp += dm; nelem--; } /* 10/12/92 flush if needed, only matters for X at present */ switch (lunplt) { case 0: ana_xflush(); break; } return 1; } /*------------------------------------------------------------------------- */ int ana_postimage(narg,ps) /* postimage routine */ /* subroutine, call is postimage(image,x0,x1,y0,y1) */ int narg, ps[]; { extern int scalemax, scalemin; extern float tvix, tviy, tvixb, tviyb; float x0,x1,y0,y1; int iq, nd, nx, ny, s1, s2; char *ptr; struct ahead *h; x0 = wxb; x1 = wxt; y0 = wyb; y1 = wyt; iq = ps[0]; if ( sym[iq].class != 4 ) return execute_error(66); if ( sym[iq].type != 0 ) { /* scale using (0,255) for scalemax and scalemin */ s1 = scalemin; s2 = scalemax; scalemin = 0; scalemax = 255; iq = ana_scale(1, &ps[0]); } h = (struct ahead *) sym[iq].spec.array.ptr; nd = h->ndim; if ( nd != 2) { return execute_error(101); } nx = h->dims[0]; ny = h->dims[1]; ptr = (char *) ( (char *) h + sizeof( struct ahead ) ); if (narg>1) x0 = float_arg( ps[1]); if (narg>2) x1 = float_arg( ps[2]); if (narg>3) y0 = float_arg( ps[3]); if (narg>4) y1 = float_arg( ps[4]); tvix = x0; tvixb = x1; tviy = y0; tviyb = y1; return postgray(ptr, nx,ny, x0,x1,y0,y1, iorder); } /*------------------------------------------------------------------------- */ int ana_postcolorimage(narg,ps) /* postcolorimage routine */ /* 2/27/2000 - modified to accept rgb packed arrays */ /* subroutine, call is postimage(red,green,blue,x0,x1,y0,y1) where red, green, and blue are separate arrays or the form postimage(rgb,x0,x1,y0,y1) where rgb is a (3,nx,ny) array */ int narg, ps[]; { extern int scalemax, scalemin; extern float tvix, tviy, tvixb, tviyb; float x0,x1,y0,y1; int iq, nd, nx, ny, s1, s2, i, nxq, nyq, mode = 0; char *pr=NULL, *pg=NULL, *pb=NULL; struct ahead *h; x0 = wxb; x1 = wxt; y0 = wyb; y1 = wyt; /* could be 3 arrays or just one, the first one tells us */ /* the 3 image arrays must all be bytes and of the same size */ for (i=0;i<3;i++) { iq = ps[i]; if ( sym[iq].class != 4 ) return execute_error(66); if ( sym[iq].type != 0 ) { printf("byte array required\n"); return -1;} h = (struct ahead *) sym[iq].spec.array.ptr; nd = h->ndim; if (nd == 3) { /* should be a single (3,nx,ny) byte array */ if (i) { printf("misplaced rgb array in POSTCOLORIMAGE\n"); return -1; } if ( h->dims[0] != 3) { printf("bad rgb array in POSTCOLORIMAGE\n"); return -1; } pr = (char *) ( (char *) h + sizeof( struct ahead ) ); nx = h->dims[1]; ny = h->dims[2]; mode = 1; break; } if ( nd != 2) return execute_error(101); switch (i) { case 0: nx = h->dims[0]; ny = h->dims[1]; pr = (char *) ( (char *) h + sizeof( struct ahead ) ); break; case 1: nxq = h->dims[0]; nyq = h->dims[1]; if ( nx != nxq || ny != nyq ) return execute_error(103); pg = (char *) ( (char *) h + sizeof( struct ahead ) ); break; case 2: nxq = h->dims[0]; nyq = h->dims[1]; if ( nx != nxq || ny != nyq ) return execute_error(103); pb = (char *) ( (char *) h + sizeof( struct ahead ) ); break; } } if (nd == 2) i = 3; else i = 1; if (narg>i) x0 = float_arg( ps[i]); i++; if (narg>i) x1 = float_arg( ps[i]); i++; if (narg>i) y0 = float_arg( ps[i]); i++; if (narg>i) y1 = float_arg( ps[i]); tvix = x0; tvixb = x1; tviy = y0; tviyb = y1; /* mode in postcolor is used to indicate type of array(s) */ return postcolor(pr, pg, pb, nx,ny, x0,x1,y0,y1, iorder, mode); } /*------------------------------------------------------------------------- */ int ana_postraw(narg,ps) /* postraw routine */ /* subroutine, call is postraw(string) */ int narg, ps[]; { int iq; char *s; iq = ps[0]; if ( sym[iq].class != 2 ) return execute_error(70); s = (char *) sym[iq].spec.array.ptr; return postrawout(s); } /*------------------------------------------------------------------------- */