/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "xyplo.p" */ #include /* xyplo: x, y data plotter (pronounced: "zyplo") Dr. Thomas D. Schneider National Institutes of Health National Cancer Institute Center for Cancer Research Nanobiology Program Molecular Information Theory Group Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu (use only if first address fails) http://www.ccrnp.ncifcrf.gov/~toms/ modules: prgmods, matmods, delman, dops */ /* end of program */ /* begin module version */ #define version 9.16 /* of xyplo.p 2008 Aug 05 2008 Aug 05, 9.16: handle parenthesis in titles 2007 Aug 30, 9.15: upgrade axis - subtics to the end (finished) 2007 Aug 30, 9.14: upgrade axis - subtics to the end 2007 May 24, 9.13: count data points so warning is more informative 2007 May 05, 9.12: stop if xyin is empty 2006 Dec 06, 9.11: tag regression line in output 2006 Dec 06, 9.10: add r^2 to output 2006 Sep 07, 9.09: Fisher's z' transformation 2005 Aug 14, 9.08: remove duplicate warnings 2005 Jul 26, 9.07: upgrade from prgmod to get tabs ignored 2005 Jul 26, 9.06: user linetype can be any of l.-in 2004 Aug 25, 9.05: bug: in edgecontrol ury was a function of x 2004 Aug 2, 9.04: Accept '#' as the start of a comment line. 2004 Jan 19, 9.03: change color adjustment to be 0.84*hue+0.16 2003 Dec 21, 9.02: setlinewidth bug 2003 Aug 28, 9.01: better error message for missing parameterversion 2003 Aug 28, 9.00: substitute in corrected stringreal from dops.p 2003 Aug 28, 8.99: about to substitute in corrected stringreal from dops.p 2003 Aug 28, 8.98: bug: at 0.0, roundoff makes -0.00! 2003 Aug 28, 8.97: cleanup 2003 Aug 28, 8.96: bug1992: - captured and fixed 2003 Aug 28, 8.95: bug1992: - stringinteger cannot handle -0 of course! 2003 Aug 28, 8.94: bug1992: - sign missing on y axis 2003 Aug 28, 8.93: read and write edge and parameterversion params correctly 2003 Aug 27, 8.92: bug: userlines set nil in readparams 2003 Aug 22, 8.91: cleanup message 2003 Aug 22, 8.90: space in line section bombs. 2003 Aug 22, 8.89: upgrading xyplop to create edge control parameters 2003 Aug 22, 8.88: bug in boundary box fixed 2003 Aug 22, 8.87: fix bounding box values to be integer 2003 Aug 22, 8.86: clean up 2003 Aug 22, 8.84: user control of bounding box edges 2003 Aug 22, 8.83: clean up 2003 Aug 22, 8.82: graph controls bounding box 2003 Jul 31, 8.81: tabs accepted as blanks 2003 Mar 11, 8.80: xyplop.std in see also 2002 Nov 7, 8.79: fill bottom of skybox 2002 Nov 7, 8.78: skybox (s symbol) allows histogram 2002 May 5, 8.77: pure comment xyin crashes program; fix skipcopy 2002 May 5, 8.76: gpc ready; warnings file used in main now. 2001 Jun 1, 8.75: define postscript bounding box 2000 Jun 21, 8.74: no warning file unless there are warnings 2000 May 26, 8.73: introduce maxinterval to prevent too many intervals 2000 Mar 30, 8.72: allow removal of axis 2000 Jan 28, 8.71: L symbol for drawing thick lines 1999 Dec 4, 8.69: put warnings into warnings file to keep out of way. 1999 Dec 4, 8.68: Warning for neg log values gives both x and y 1999 Dec 4, 8.67: blank lines and lines that begin with "*" are ignored in user line section. Negative values ignored for log scale rather than halt. 1999 Dec 3, 8.66: on a log plot, values <= zero are dropped rather than messing up the graph. 1999 July 30, 8.65: C, B colored lines 1999 June 1, 8.64: correct documentation: colors range from 0 to 0.85. 1996 August 5 xyplo reads user defined symbols in xyplom 1996 August 5 xyplo now accepts blank lines (and skips them) 1996 March 21 conversion from inches to cm finally! origin 1985 dec 24 from linreg */ /* end module version */ /* begin module describe.xyplo */ /* name xyplo: x, y data plotter (pronounced: "zyplo") synopsis xyplo(xyin: in, xyout: out, xyplop: inout, xyplom: in, warnings: out, output: out) files xyin: A set of header lines that begin with asterisk ('*') or pound sign ('#') are copied to output. Remaining lines are the data in columns, ending with end of file. Tabs may separate data. Missing columns are not allowed. See the demonstration file xyin.demo for an example. Once the first data line has been read, lines that begin with an '*' or '#" or that are entirely blank will be ignored. This allows one to place comments or other information deeper into the file without having xyplo object. The # allows files to be read by gnuplot too. xyplop: Parameters to control the plot, on lines as shown. The major sections of the parameter file are separated by lines that are used by the program as separators. A separator line may begin with blanks, and these must be followed by asterisks, as shown below. These lines simply make the file easier to deal with, but you must have them in the file! The easiest way to create a xyplop file is to copy the demonstration file (xyplop.std or xyplop.demo) and modify that to suite your needs. xzero yzero amounts to move the graph origin (cm) zx min max (character, real, real) if zx='x' then set xaxis zy min max (character, real, real) if zy='y' then set yaxis These two lines set the minimum and maximum range of the data to graph. Other characters mean the program automatically uses the range of the data. xinterval yinterval xsubintervals ysubintervals: These 4 parameters, all on one line, define the number of numbered intervals on each axes to plot and the number of unnumbered subintervals. Note that on a regular scale, going from 10 to 20 requires 10 intervals (to get whole numbers), but on a log scale, going from 10 to 100 requires 9 intervals (to get tics every 10), not 10 intervals! xwidth ywidth width of numbers in characters xdecimal ydecimal number of decimal places xsize ysize size of axes in cm xlabel the x axis label ylabel the y axis label zc if zc='c' then a crosshairs put on zero of x and y 'x' then only X axis is plotted 'X' then only X axis and crosshairs 'y' then only Y axis is plotted 'Y' then only Y axis and crosshairs 'n' then neither axis nor crosshairs 'N' then neither axis with crosshairs 'i' then numbering and tic marks but no line (invisible) Otherwise, both axes are plotted without crosshairs. zxl base if zxl='l' then convert the x axes to a log scale using the indicated base. zxl='L' is like 'l' but the numbers given on the axis have not had the log taken of them. zyl base if zyl='l' then convert the y axes to a log scale using the indicated base. zyl='L' is like 'l' but the numbers given on the axis have not had the log taken of them. * define columns to read data from *********************************** This section defines which column of xyin contains what kind of data. You can use a column only once. xcolumn ycolumn columns of xyin that determine the location of the symbol symbol-column the xyin column to read symbols from if zero, then use the first symbol defined below xscolumn yscolumn columns of xyin that determine the size of the symbol. If zero, then no data is expected. NOTE: for most symbols this is the entire size of the symbol. For the I beam symbol, the yscolumn is half of the total size plotted. Thus one may use standard deviations and obtain a symbol of 2 standard deviations high centered on the y coordinate. hucolumn sacolumn brcolumn hue saturation brightness columns. These control the color of the rectangle symbol. 1 0 0 is black (assumed if columns are all zero) 1 0 1 is white Hue runs from red (value 0) through the spectrum to violet (value 1). See the technical notes for further details. * define one or more symbols ***************************************** Each of these sections defines one of the symbols by specifying what to do for each symbol flag seen in the symbol column. There may be as many symbols as will fit in memory. The last of these sections must contain just a '.' as the 'symbol-to-plot'. This is required to end the symbol definition section since there are an indefinite number of symbols. symbol-to-plot (character) Most symbols are plotted at the coordinates given in xcolumn and ycolumn. 'c' plot a circle 'C' plot a circle; with connections in color 'b' plot a box 'B' plot a box; with connections in color 'x' plot an x '+' plot a plus 'I' plot an I beam symbol 'd' plot a box with central dot 'p' point (or dot) alone. 'm' mark according to a xyplom definition 'M' mark according to a xyplom definition, with connections in color 'R' plot a filled rectangle in color. Unlike the other symbols, which are centered on the data, the lower right hand corner of this rectangle is placed on the data. This allows the user more control on placement. 's' plot a histogram from zero to the height 'r' like 'R' but gray scale. The brightness column is used for controlling the brightness. 'f' Means to plot the symbol-flag (defined below). The 'f' type allows several symbols to be made each with its own regression and connection lines, but plotted with the entire flag string in xyin. The symbols are distinguished by their first character. The symbol-flag in xyplop should be set to the string that one desires to be recognized. 'f' will center the string. 'F' will left justify the string. 'g' Means 'grab bag'. The 'g' type has lower priority than any other symbol. Xyplo searches through all the available symbols looking for a match to the symbol-flag. If a symbol-flag cannot be found, then the data are assigned to the 'grab-bag'. The program uses the symbol-flag on the graph. The symbol-flag in xyplop can be anything. 'g' will center the string. 'G' will left justify the string. 'L' will make just lines using the current colors. The symbol underscore (_) in xyin is converted to a blank to allow the appearance of separated words. One can do grab-bag connected curves without symbols by setting g and the symbol-flag to ' '. One can also set the symbol-to-plot to blank (or other unrecognized symbol) to get specific connected curves. In this case, the symbols MUST be connected or the program will object (invisible symbol and invisible connection means data loss). 'm' Means to look up the symbol-flag name in the xyplom file and to use the PostScript definition there to create the symbol. symbol-flag The string of characters that indicates that this symbol should be plotted. Eg, if the 'symbol-to-plot' is I and the flag is x, then whenever an x is seen in the symbol column, an I beam will be plotted. The flag can be more than one character long, but (unfortunately) it cannot contain blanks. symbol-sizex Side in cm on the x axis of the symbol. If this value is negative, the data in xscolumn is used to determine the size. For circles, sizex determines the radius, sizey is ignored. symbol-sizey Side in cm on the y axis of the symbol. If this value is negative, the data in yscolumn is used to determine the size. For circles, sizeX determines the radius but a positive number is still required for sizey. connection linetype size If the first character is 'c' then the symbols will be connected by lines of linetype as defined below. (Linetype must follow the c immediately, without blanks.) linetype size linetype is a character defining the kind of regression line to plot for this symbol: 'l' means do regression line 'i' invisible, '.' dotted '-' dashed 'n' means no line. '-' and '.' require a size in cm for the spacing. The others also require a number, but it is ignored. * end the symbol definitions with a period (left justified!) ********* . * define zero or more user defined lines ***************************** linetype m b size One or more lines to be drawn on the plot, m and b are slope and intercept. Linetype and size are define as for the symbol connection lines. blank lines and lines that begin with "*" are ignored. in this section linetype is defined as for the regression lines. * end of the line definitions and start of more parameters *********** edgecontrol edgeleft, edgeright, edgelow, edgehigh: edgecontrol is a single character that controls how the bounding box of the figure is handled. If it is 'n' then the bounding box will be the page parameters defined in constants inside the program (llx, lly, urx, ury AND changes as set by the previous parameter line). If the parameter is 'p', there are four real numbers that define the edges around the clist in cm. To allow a map to be imbedded into another figure, its size must be defined in PostScript (with %%BoundingBox). By setting these four numbers, the edges are defined. Negative values are allowed, so one may move the edges as desired. (New as of 2003 Aug 22) xyout: regression results, ready for PostScript input. (See technical notes.) xyplom: A file containing definitions of additional symbols, written in PostScript. The symbols must be of the form: /mysymbol { % xsize ysize mysymbol - % xsize x size in points % ysize y size in points /xsize exch def /ysize exch def ... } bind def Xyplo translates to the proper location and sets the color before calling the routine. This allows the xyin file to control the color of the symbols, but of course it can be overridden by the user's routine. It is even possible for the symbol to use both colors! Be sure to define the symbol in the xyplop. If the xyplom file is empty, there are no user defined symbols. warnings: extensive warning messages. These get in the way if they go to output. One line appears on the output file if there are any warnings. output: messages to the user description The data in the xyin file are converted to graphics in the PostScript language on the xyout file, under control of the parameters set in xyplop. There are several distinct sections of the parameters: 1. The first set of parameters determine the overall characteristics of the graph. 2. The second set of parameters defines the columns of xyin to be read. 3. The next section of the parameter file defines one or more symbols to be plotted on the graph. If desired, a linear regression is performed between the data columns, and this may be graphed for each symbol. The invisible option allows one to obtain the regression data without the graph. Regression data include the correlation coefficient and Fisher's z'. 4. A section with just a period ends the symbols section. 5. The last section contains lines you define. Recommended procedure for using xyplo: obtain a copy of xyplop.demo and xyin.demo, set permission to read them for yourself (on a Unix system use chmod), and copy them to the names xyplop and xyin. Try them out as is. If you don't get a graph, doing your own data will not do any good! Then convert the xyplop to your own use by changing the xyplop.demo file and substitute your xyin file. This way the complexity of xyplop can be held at bay. see also {Basic example files:} xyin, xyout, xyplop, xyplom, {Standard parameter file: } xyplop.std {Demonstration examples: } xyplop.demo, xyin.demo, xyplop.test, xyin.test, xyplop.mul, xyin.mul, xyin.logs xyplop.xn xyplop.xl xyplop.xL xyplop.yn xyplop.yl xyplop.yL xyin.genbank xyplop.genbank {Related program - generate histogram:} genhis.p {Related programs - graphics routines:} dops.p doodle.p {Technical note: To define the bounding box for the graph must be defined. The postscript program} ftp://ftp.ncifcrf.gov/pub/delila/printerarea.ps {will give the values for your printer.} {substitute in the values at %%BoundingBox} {Xyplo now accepts the '#' as the start of a comment so that data files can also be used for gnuplot. See:} http://www.gnuplot.info/ {Confidence Limits for the Correlation, Fisher's z':} http://sportsci.org/resource/stats/sscorr.html#fisherz {who says that to get the confidence limits of the correlation} {coefficient,} {"use the Fisher z transformation: z = 0.5log[(1 + r)/(1 - r)]. } {The transformed correlation (z) is normally distributed with} {variance 1/(n - 3), so the 95% confidence limits are given by z} {± 1.96/sqrt(n - 3). You then have to back-transform these} {limits to correlation coefficients using the equation r =} {[(e^(2z) - 1)/(e^(2z) + 1)]."} {See also:} {Fisher RA (1921). On the probable error of a coefficient of correlation deduced from a small sample. Metron 1, 3-32.} http://davidmlane.com/hyperstat/A50760.html author Thomas Schneider technical notes The program originally generated output in the pic format. One could then run this through pic and troff to produce a graph. However, the program has been modified to eliminate the pic notation (by substituting modules from dops rather than domods). All lines outside the graphics now are preceeded by a %, which is beginning of a comment in PostScript. Thus the output of the program can be run directly into a PostScript interpreter. This saves on both memory and speed of graphing since the intermediate file is no longer created. Colors in PostScript are defined with hue, saturation and brightness with the sethsbcolor function. (Xyplo does not use red, green, blue model because it does not give the most useful continuous scale, though maybe someday I'll put in a switch.) The standard hue runs from red at 0 to red at 1 with the Roy G. Biv in between. (The famous physicist Roy G. Biv stands for: red, orange, yellow, green, blue, indigo, violet, the colors of the spectrum. On 1992 September 16 I realized that, amazingly, the wavelength in nm match quite nicely! 700 red 750 orange 600 yellow 650 green 500 blue 550 indego 400 violet Ok, Ok, back to xyplo! Since the hue runs in a circle, the spectrum is not generated from the hue range 0 to 1. Xyplo therefore converts the input numbers by multiplying by 0.84 and adding 0.16. This gives the color range from yellow through red corresponding to values 0 to 1. (Note: adding 0.16 give the range from yellow through red, but that is not a spectrum which runs from red through violet.) As of version 8.50 (1996 March 21) the xyplo program now uses cm (YEA!) which means that ALL previous graphs are out of date. If you happen to be stuck in a backwards, primitive country, tough luck. Bite the bullet. Minor unobvious things have prevented people from getting graphs. Most problems occur when badly formed xyplop files are used, and the program has no way to tell what the difficulty is. More checks have been put it, so the program can detect most oddly formed xylop and xyin files. Check your xyplop carefully. Setting the Default Printer Area: The size of the page in PostScript is determined with 4 constants llx, lly, urx and ury. These must be set correctly for each printer. These can be easily obtained by printing the file: ftp://ftp.ncifcrf.gov/pub/delila/printerarea.ps In this program these parameters are set as 4 constants defaultllx, defaultlly, defaulturx and defaultury. The parameters for page edges define whether to use the defaults or to compute the size to show. bugs ENHANCEMENTS: * xyplo should apply a PostScript to clip everything outside the drawing area * xyplo has a numerical drift problem. For extremely large numbers of data points, the computed position differes from the position rendered by PostScript. This should be corrected by using gsave and restore, but it is not clear how to modify the draw routines to do this cleanly. As it is the program tracks the location of where it THINKS it is on the graphical display. ENHANCEMENTS: * xyplo: cannot handle error bars in log mode * xyplo: user defined lines have to be type l?? * xyplo: define symbols in postscript - should speed graphics a lot * xyplo bug: when the last line of the file is empty, the program halts (that's fine). The count of the location of the error does NOT include the * lines though! Yet it says: "at line 27 of data (INCLUDING * lines)" Correct this. * xyplo bug from Mark (email 1992 May 27) */ /* end module describe.xyplo */ /* solved bugs: * MAJOR XYPLO BUG: xyplo bug1992 negative 0.50 did not show the minus sign- demo is in ~/current/xyplo.bug [directory is lost?] also in ~/sites/yeast/gcn4/asym/affinity. problem is probably in xaxis calls picnumber, leading to stringreal. with width 6 decimal 2 , a negative number like -0.40 comes out 0.40, -0.80 as 0.80 but (!) -1.20 is -1.20! 2003 Aug 28 Extremely odd - bug found with same description as this one! ~/sites/yeast/gcn4/asym/affinity still exists. Date: Sep 5 1992 ... but the graph there is ok. SOLVED!! Simply: * set so that there are enough tics * minus signs of tic marks between -1 and 0 are not shown. * True for both axes. * SOLVED 2003 Aug 28 - new stringreal routine in dops.p * this was probably bug1992: * xyplo bug: when program choses range, negative values are lost? ******** Line 928: [Warning 371] routine not referenced, code deleted: LINEA. ******** Line 546: [Information 279] Value assigned to Y is never used; assignment is eliminated by optimizer. ******** Line 546: [Information 279] Value assigned to X is never used; assignment is eliminated by optimizer. ******** Line 837: [Information 279] Value assigned to Y is never used; assignment is eliminated by optimizer. ******** Line 1358: [Information 279] Value assigned to DTHETA is never used; assignment is eliminated by optimizer. ******** Line 1699: [Information 279] Value assigned to NOTEQUAL is never used; assignment is eliminated by optimizer. ******** Line 2688: [Warning 243] Variable Y was not initialized before this use. ******** Line 2688: [Warning 243] Variable X was not initialized before this use. */ /* begin module xyplo.const */ #define dsafety 5 /* decimal place safety; assures at least this many decimal places are printed for the line regression data */ /* distances in cm */ #define YaxisXshift (-0.127) /* for Y axis, shift numbers in X direction */ #define YaxisYshift (-0.127) /* for Y axis, shift numbers in Y direction */ #define Yticlength 0.127 /* Y axis tic mark length */ #define XaxisXshift 0.000 /* for X axis, shift numbers in X direction */ #define XaxisYshift (-0.508) /* for X axis, shift numbers in Y direction */ #define Xticlength 0.127 /* X axis tic mark length */ #define labelabovey 0.508 /* amount above the Y axis to put the label */ #define labelbelowx 1.143 /* amount below the X axis to put the label */ /* default bounding box definitions. See the technical notes for how to set this for a different printer. */ /* The following bounding box is for the Canon Color Laser Copier 1150. */ #define defaultllx 7.10999 /* default for llx, lower left x */ #define defaultlly 7.01995 /* default for lly, lower left y */ #define defaulturx 588.15 /* default for urx, upper right x */ #define defaultury 784.98 /* default for ury, upper right y */ /* PostScript constants */ #define pwid 8 /* width in character places to print PostScript numbers */ #define pdec 5 /* decimal places to print PostScript numbers */ #define maxinterval 1000 /* upper bound on xinterval yinterval, a safety net */ /* end module xyplo.const */ /* begin module xyplo.interact.const */ #define maxstring 300 /* the maximum string */ /* end module xyplo.interact.const */ /* begin module pic.const */ #define pi 3.14159265354 /* circumference divided by diameter of circle */ #define picwidth 8 /* width of numbers printed to the file */ #define picdecim 5 /* number of decimal places for numbers */ #define charwidth 0.15875 /* the width of characters in cm (ie, cm/char) this allows centering of strings. */ /* note: for the Times-Roman font, 0.0625 is a good value. for the Courier-Bold font, 0.08 is a good value. */ #define dotfactor 0.015875 /* the size of dots */ /* defscale = 72; (* default scale factor. coordinate units per in *) */ #define defscale 28.35 /* default scale factor. coordinate units per cm */ /* making this change would be a big shock to all the programs that use it, unfortunately. A major user is xyplo. */ /* end module pic.const version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module interact.type */ /* begin module string.type */ /* pointer to a string */ typedef struct string { /* a string of characters */ Char letters[maxstring]; /* the letters in the string */ long length; /* the number of characters in the string */ long current; /* the letter we are working on */ Char *next; /* the next string in a series */ } string; /* end module string.type version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* end module interact.type version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module xyplo.type */ typedef struct line { /* define a line */ Char linetype; /* i invisible, - dashed, . dotted, l means line, n means no line, see drawa */ double m, b; /* slope and intercept as in y=m*x+b */ double linesize; /* size of dash or dots for line in cm */ /* internal records on the line. see procedure regress for defs. */ double sumx, sumy, sumxsqd, sumysqd, sumxy, ex, ey, varx, vary, covxy, r; long n; } line; /* a pointer to a set of lines */ typedef struct lines { /* a set of line */ line l; /* one line */ struct lines *next; /* the following lines */ } lines; typedef struct symbol { /* define a symbol */ Char symboltoplot; /* symbol to plot: character c=circle, b=box x, +, I=Ibeam, d=dotted box, p=point, f=use flag, g = grab-bag from flag m = call postscript in xyplom */ string symbolflag; /* what characters to recognize for this symbol */ double symbolxsize; /* x radius or side in cm, if negative convert the data in xscolumn to the size */ double symbolysize; /* y radius or side in cm, as for x */ boolean doconnection; /* connect the symbols with connecttype */ Char connecttype; /* i invisible, - dashed, . dotted, l means line, n means no line, see drawa */ double connectsize; /* spacing on the connected line dashes or dots */ boolean didlastpoint; /* true if the previous point was plotted this implies that we can draw from that point to the present point */ double oldx, oldy; /* the previous coordinate for connecting */ boolean doline; /* do regression line */ line l; /* the data on the line for this symbol */ } symbol; /* a pointer to a set of symbols */ typedef struct symbols { /* the defined symbols */ symbol s; /* one symbol */ struct symbols *next; /* the following lines */ } symbols; typedef struct param { /* parameters to control the plot */ double parameterversion; /* parameter version number */ /* Definitions for the BoundingBox of the encapsulated PostScript (eps): */ double llx, lly; /* lower left x and y */ double urx, ury; /* upper right x and y */ Char edgecontrol; /* if 'p' then use page instead of edges */ double edgeleft; /* left edge margin */ double edgelow; /* lower edge margin */ double edgeright; /* right edge margin */ double edgehigh; /* high edge margin */ boolean setx, sety; /* the user sets x and y max and min */ double xmin, xmax; /* minimum and maximum for x axis plot */ double ymin, ymax; /* minimum and maximum for y axis plot */ double xscale; /* the scale factors to multiply x and y by to make them fit the graph */ double yscale, xzero, yzero; /* the location of the zero coordinate of the final graph (cm) */ long xinterval, yinterval; /* number of intervals on x and y to plot */ long xsubintervals, ysubintervals; /* number of subintervals on x and y to plot */ long xwidth, ywidth; /* width of numbers on graph in characters */ long xdecimal, ydecimal; /* number of decimal places for numbers */ double xsize, ysize; /* size of axes in cm */ string xlabel; /* the x axis label */ string ylabel; /* the y axis label */ boolean crosshairs; /* if true then cross hairs put on zero of x and y */ boolean doXaxis; /* true if the x axis should be plotted */ boolean doYaxis; /* true if the x axis should be plotted */ boolean doaxisline; /* line on axis is plotted */ boolean logxscale; /* if true then convert x scale to log scale */ boolean logxnormal; /* if true then print x scale without taking log */ double xbase; /* the base to use for the log x scale */ double logxbase; /* the natural log of base, for converting x values to log to the base by division */ boolean logyscale; /* if true then convert y scale to log scale */ boolean logynormal; /* if true then print y scale without taking log */ double ybase; /* the base to use for the log y scale */ double logybase; /* the natural log of base, for converting y values to log to the base by division */ long xcolumn, ycolumn; /* columns of input to chose */ long scolumn; /* the xyin column to read symbols from */ long xscolumn, yscolumn; /* columns of xyin that determine the size of the symbols */ long hucolumn, sacolumn; /* columns of xyin that determine the color of the symbols */ long brcolumn; /* these are true when at least one variable needs the corresponding column data */ boolean needscolumn, needxscolumn, needyscolumn, needcocolumn; symbols *usersymbols; /* all the symbols */ lines *userlines; /* a set of user defined lines */ double xrect, yrect; /* current sizes of rectangles. These are kept track of so that rectinit only will be called when the size changes */ boolean startrectangles; /* When the parameters are read, this flag is set, it is true if a rectangle symbol was found. The code for starting a rectangle is written later. */ boolean usermarks; /* if true, user definitions were copied from xyplom to the xyout */ } param; /* end module xyplo.type */ /* begin module xyplo.var */ Static _TEXT xyin; /* input data */ Static _TEXT xyout; /* output regression graph */ Static _TEXT xyplom; /* file from which to read the user defined marks */ Static _TEXT xyplop; /* file from which to read the parameters */ Static _TEXT warnings; /* warnings */ Static long warningcount; /* the number of warnings */ Static long datacount; /* count of data items to make warning more useful */ /* end module xyplo.var */ /* begin module pic.var */ Static boolean inpicture; /* true if we are drawing the picture, ie, startpic has been called */ Static double picxglobal, picyglobal; /* absolute location in the graph */ Static double pictolerance; /* 10 raised to the picwidth, to detect values close to zero */ Static double scale; /* scale factor. graphic coordinate units per cm */ /* NONSTANDARD for efficient use of postscript, keep track of whether there is a current path */ Static boolean inpath; /* NONSTANDARD keep track of number of segments drawn so that they can be stroked. This (probably) solves the problem of the Apple printer dying because it can't handle the data. */ Static long segments; Static double xsideold, ysideold; /* current size of a rectangle. see rectsize */ Static jmp_buf _JL1; /* end module pic.var version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module halt */ Static Void halt() { /* stop the program. the procedure performs a goto to the end of the program. you must have a label: label 1; declared, and also the end of the program must have this label: 1: end. examples are in the module libraries. this is the only goto in the delila system. */ printf(" program halt.\n"); longjmp(_JL1, 1); } #define tab 9 /* tab character */ /* end module halt version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module skipblanks */ /* 2003 July 31: tab is considered a blank character */ Static boolean isblank(c) Char c; { /* is the character c blank or tab? */ return (c == ' ' || c == tab); } #undef tab Static Void skipblanks(thefile) _TEXT *thefile; { /* skip over blanks until a non-blank, or end of line, is found */ while (isblank(P_peek(thefile->f)) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipnonblanks(thefile) _TEXT *thefile; { /* skip over nonblanks until a blank, or end of line, is found */ while ((!isblank(P_peek(thefile->f))) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipcolumn(thefile) _TEXT *thefile; { /* skip over a data column */ skipblanks(thefile); skipnonblanks(thefile); } /* end module skipblanks version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module copyaline */ Static Void copyaline(fin, fout) _TEXT *fin, *fout; { /* copy a line from file fin to file fout */ while (!P_eoln(fin->f)) { putc(P_peek(fin->f), fout->f); getc(fin->f); } fscanf(fin->f, "%*[^\n]"); getc(fin->f); putc('\n', fout->f); } /* copyaline */ /* end module copyaline version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module interact.clearstring */ /* begin module clearstring */ /* These modules clear strings in various ways */ /* ---- */ Static Void emptystring(ribbon) string *ribbon; { /* clearstring */ /* empty the contents of the string but do NOT remove the pointer. This is useful for clearing one string within a linked list of them. */ long index; /* to the ribbon */ for (index = 0; index < maxstring; index++) ribbon->letters[index] = ' '; ribbon->length = 0; ribbon->current = 0; } /* emptystring */ /* ---- */ Static Void clearstring(ribbon) string *ribbon; { /* empty the string and remove the pointer */ emptystring(ribbon); ribbon->next = NULL; } /* clearstring */ /* ---- */ Static Void initializestring(ribbon) string *ribbon; { /* start the string with a nil pointer. This routine should be called before doing linked list work. This allows the standard string routines to clear the string without killing the pointer. This is now deprecated, do not use it since clearstring still clears the next pointer. */ printf("remove initializestring routine!\n"); printf("replace it with clearstring routine!\n"); halt(); /* to force deprecation */ clearstring(ribbon); ribbon->next = NULL; } /* initializestring */ /* end module clearstring version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* end module interact.clearstring version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module interact.getstring */ Static Void getstring(afile, buffer, gotten) _TEXT *afile; string *buffer; boolean *gotten; { /* get a line (as a string) from a file not using string calls. this lets one obtain lines from a file without interactive prompts */ long index = 0; /* of buffer */ clearstring(buffer); if (BUFEOF(afile->f)) { *gotten = false; return; } while (!P_eoln(afile->f) && index < maxstring) { index++; buffer->letters[index-1] = getc(afile->f); if (buffer->letters[index-1] == '\n') buffer->letters[index-1] = ' '; } if (!P_eoln(afile->f)) { printf(" getstring: a line exceeds maximum string size (%ld)\n", (long)maxstring); halt(); } buffer->length = index; buffer->current = 1; fscanf(afile->f, "%*[^\n]"); getc(afile->f); *gotten = true; } /* getstring */ /* end module interact.getstring version = 5.22; (@ of prgmod.p 2005 Jul 12 */ /* begin module interact.writestring */ /* begin module writestring */ Static Void writestring(tofile, s) _TEXT *tofile; string *s; { /* write the string s to file tofile, no writeln */ long i; /* index to s */ long FORLIM; FORLIM = s->length; for (i = 0; i < FORLIM; i++) putc(s->letters[i], tofile->f); } /* writestring */ /* end module writestring version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* end module interact.writestring version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module linear.regression */ /* linear regression procedure origin: 1980 august 5 by thomas schneider copyright 1986 */ Static Void regress(control, x, y, sumx, sumy, sumxsqd, sumysqd, sumxy, ex, ey, varx, vary, covxy, r, m, b, n) Char control; double x, y, *sumx, *sumy, *sumxsqd, *sumysqd, *sumxy, *ex, *ey, *varx, *vary, *covxy, *r, *m, *b; long *n; { /* described below */ /* the data pairs */ /* internal records */ /* mean, variance and covariance of x and y: */ /* correlation coefficient: */ /* m = slope, b = y intercept as in y = mx + b */ /* number of data pairs entered: */ /* linear regression for variables x and y. the control variable has only three acceptable states: c clear all variables to zero (note that r is set to 2.0, so that a program can check whether or not the results have been calculated yet. the recommended test is not for equality, since round-off could cause problems. use if r > 1.5 then (no calculations yet) else (calculations done) ) e enter the x and y values into the internal sums r results are calculated from the sums */ if (control != 'r' && control != 'e' && control != 'c') { printf(" linear regression control variable value, \"%c\" is not acceptable.\n", control); printf(" it must be in [\"c\",\"e\",\"r\"]\n"); halt(); return; } switch (control) { case 'c': /* clear */ x = 0.0; y = 0.0; *sumx = 0.0; *sumy = 0.0; *sumxsqd = 0.0; *sumysqd = 0.0; *sumxy = 0.0; *ex = 0.0; *ey = 0.0; *varx = 0.0; *vary = 0.0; *covxy = 0.0; *r = 2.0; /* this (impossible) value can act as a flag that shows that the calculations have not been made. */ *m = 0.0; *b = 0.0; *n = 0; break; case 'e': /* enter data */ *sumx += x; *sumy += y; *sumxsqd += x * x; *sumysqd += y * y; *sumxy += x * y; (*n)++; break; case 'r': /* calculate results */ /* check for conditions that would bomb the program */ if (*n == 0) { printf("regress: n is 0; no samples recorded\n"); halt(); } if (*n == 1) { printf("regress: n is 1; regression impossible\n"); halt(); } *ex = *sumx / *n; *ey = *sumy / *n; *varx = *sumxsqd / *n - *ex * *ex; *vary = *sumysqd / *n - *ey * *ey; if (*varx == 0.0) { printf("regress: variance of x is zero; regression impossible\n"); halt(); } if (*vary == 0.0) { printf("regress: variance of y is zero; regression impossible\n"); halt(); } *covxy = *sumxy / *n - *ex * *ey; *r = *covxy / sqrt(*varx * *vary); *m = *covxy / *varx; *b = *ey - *m * *ex; break; } } /* end module linear.regression version = 'matmod 1.98 86 nov 23 tds/gds'; */ /* begin module pic.functions */ /* ********************************************************************** */ /* begin module pic.await */ Static Void await() { /* Wait for user to type a carriage return. the routine assumes that there is a global file called input. */ /* the infinite way: writeln(output); writeln(output,'*********************************'); writeln(output,'* Use control-c to kill program *'); writeln(output,'*********************************'); while true do begin end;*/ } /* end module pic.await version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.startpic */ Static Void startpic(afile, setscale, x, y, thefont) _TEXT *afile; double setscale, x, y; Char thefont; { /* open the graphics field, with the given scale, and at (x,y) in that scale. scale is in device coordinates per cm. The font is chosen with thefont; t = Times-Roman, c = Courier-Bold */ /* start pic output to file afile, set the globals */ /* NONSTANDARD */ /* this is the actual "world" coordinates used: */ /* xmin, xmax, ymin, ymax */ /* ns; if (setwindow(-5.0/scale, +5.0/scale, -5.0/scale, +5.0/scale)*/ fprintf(afile->f, "gsave\n"); /* save the current graphics state */ /*2005 Aug 6: get rid of these finally writeln(afile,'% initgraphics'); (* make sure the printer is ready to print, without this, sometimes an Apple laserwriter will print the graph upside down, tiny and backwards! *) writeln(afile,'% clear erasepage'); (* clean residue from before *) */ scale = setscale; /* set the global scale */ switch (thefont) { case 'c': fprintf(afile->f, "/Courier-Bold findfont\n"); /* locate the font */ fprintf(afile->f, "%d scalefont\n", 10); /* set the font size in points*/ break; case 't': fprintf(afile->f, "/Times-Roman findfont\n"); /* locate the font */ fprintf(afile->f, "%d scalefont\n", 12); /* set the font size in points*/ break; } fprintf(afile->f, "setfont\n"); /* put the font into the current font */ /* If the following statement is done then it will work on the sun, but will kill the applewriter!!!! Sun's non-standard PostScript extension, setlinewidth has default 0, as stated in the Read This First and the NeWS Manual. This draws very quickly with 1 bit wide lines. If '1 setlinequality' is not done, then one cannot set the width of lines. So to use PostScript on the screen, I must first do '1 setlinequality'. However, if I send this code to the Applewriter, it kills PostScript on the Applewriter and I get no output whatsoever! (It took me several hours to figure this out, since once PostScript is killed on the Applewriter, the NEXT output is also smashed and I had to figure that out also...) So a standard PostScript program will not work correctly with the default. "Correcting" the PostScript program so that it works on the Sun means that it BOMBS on the Applewriter. The default for setlinequality should be '1 setlinequality' so that the same PostScript code can be used both on the Sun and with other devices. If you want speed, use the nonstandard form. An alternative is to redefine setlinequality so that '0 setlinequality' does give correct results with standard PostScript. Please review this, Randy. I think that Sun should fix it. writeln(afile,'1 setlinequality'); makes lines at least 1 bit wide */ /* set the scale to cm writeln(afile, scale:picwidth:picdecim,' ', scale:picwidth:picdecim,' scale'); */ /* define some things in postscript */ /* doline allows less stuff to be put in the output file. it takes two numbers off the stack, copies them, draws a line to them as coordinates. */ /* replaced by 'currentpoint translate' writeln(afile,'/doline { 2 copy lineto } def'); */ /* define a function that makes cm out of a number */ /* do this all internally here, it's faster writeln(afile,'/i { ',scale:picwidth:picdecim,' mul} def'); */ /* move to the start point on the page */ fprintf(afile->f, "%*.*f %*.*f translate\n\n", picwidth, picdecim, x * scale, picwidth, picdecim, y * scale); fprintf(afile->f, "%% Define functions so the text produced is smaller\n"); fprintf(afile->f, "/a {stroke newpath 0 0} def %% special for arc\n"); fprintf(afile->f, "/c {stroke 0 0 moveto} def %% current point\n"); fprintf(afile->f, "/f {findfont 10 scalefont setfont} def\n"); fprintf(afile->f, " %% to set fonts simply use the f function. Example:\n"); fprintf(afile->f, " %%/Symbol f (\\142) /Courier-Bold f (-galactosidase\n"); fprintf(afile->f, "/l {lineto} def\n"); fprintf(afile->f, "/m {moveto} def\n"); fprintf(afile->f, "/n {stroke newpath 0 0 moveto} def\n"); /* new segment */ fprintf(afile->f, "/rl {rlineto} def\n"); fprintf(afile->f, "/rm {rmoveto} def\n"); fprintf(afile->f, "/s {newpath 0 0 moveto} def %% Start path \n"); fprintf(afile->f, "/t {currentpoint translate} def %% translate \n"); fprintf(afile->f, "/x {show} def %% show teXt \n\n"); /* start out the pathway */ inpath = false; /* start the number of segments written: */ segments = 0; /* now for the normal pic stuff: */ inpicture = true; picxglobal = 0.0; picyglobal = 0.0; pictolerance = (long)(exp(picwidth * log(10.0)) + 0.5); /*;writeln(output,'pictolerance = ',pictolerance:picwidth:picdecim);*/ } /* end module pic.startpic version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.stoppic */ Static Void stoppic(afile) _TEXT *afile; { /* stop pic output to file afile */ /* NONSTANDARD */ if (inpath) { fprintf(afile->f, "stroke\n"); inpath = false; } fprintf(afile->f, "showpage\n"); fprintf(afile->f, "grestore\n"); /* restore the current graphics state to what it was before the startpic */ await(); inpicture = false; } #define buffer 10 Local Void checkseg(afile) _TEXT *afile; { /* NONSTANDARD checks how many segments have been written, if more than 'buffer', stroke them to the postscript page */ if (segments >= buffer) { fprintf(afile->f, "n\n"); segments = 0; } /* New segment: writeln(afile,'stroke newpath 0 0 moveto'); */ else segments++; } #undef buffer /* end module pic.stoppic version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.drawr */ Static Void drawr(afile, dx, dy, visibility, spacing) _TEXT *afile; double dx, dy; Char visibility; double spacing; { /* make a line to file afile by relative draw of dx,dy with visibility i invisible - dashed . dotted l line with the dashes or dots separated by the spacing given (this has no effect with invisible and line). */ /* NONSTANDARD */ double ddx, ddy; /* changes in dx and dy for dots and dashes */ double dr; /* the hypotenuse, the distance actually drawn */ boolean on; /* draw linesegment if true */ double y; /* the variable for tracking dots and dashes */ long r; /* number of times to cycle for dots and dashes */ double ss; /* precalculated value to make things a bit faster */ double theta; /* angle of the line */ long FORLIM; if (!inpath) { fprintf(afile->f, "s\n"); inpath = true; } /* starts from current coordinates */ /* Start path: writeln(afile,'newpath 0 0 moveto'); */ else checkseg(afile); /* checks if not (visibility in ['l','i','.','-']) then writeln(afile,'%YELLLLLL!!!',visibility,'!'); writeln(afile,'% ',visibility,' line');*/ /* put these on the stack, they will always be used */ fprintf(afile->f, "%*.*f %*.*f", picwidth, picdecim, dx * scale, picwidth, picdecim, dy * scale); switch (visibility) { case 'l': case 'i': switch (visibility) { case 'i': fprintf(afile->f, " m"); break; case 'l': fprintf(afile->f, " l"); break; } break; case '.': case '-': /* make up our own dots and dashes */ putc('\n', afile->f); /* move away from the (dx,dy) on the stack */ if (spacing <= 0.0) { printf("drawr: spacing zero with . or - line\n"); halt(); } if (dx == 0.0) { ddx = 0.0; /* avoid division by zero */ ddy = scale * spacing; if (dy < 0) ddy = -ddy; /* this makes sure that we draw lines straight down if that was the request */ } else { /* find out the angle of the slope, intentionally lose the sign */ theta = atan(fabs(dy / dx)); ddx = scale * spacing * cos(theta); ddy = scale * spacing * sin(theta); /* return the sign to the little buggers */ if (dx < 0) ddx = -ddx; if (dy < 0) ddy = -ddy; } y = 0.0; switch (visibility) { case '.': ss = scale * dotfactor; break; case '-': on = true; break; } dr = sqrt(dx * dx + dy * dy); FORLIM = (long)floor(dr / spacing + 0.5); for (r = 1; r <= FORLIM; r++) { switch (visibility) { case '-': fprintf(afile->f, "%*.*f %*.*f", picwidth, picdecim, ddx, picwidth, picdecim, ddy); if (on) fprintf(afile->f, " rl\n"); else fprintf(afile->f, " rm\n"); on = !on; break; case '.': fprintf(afile->f, "%*.*f 0 rl", picwidth, picdecim, ss); fprintf(afile->f, " %*.*f 0 rl", picwidth, picdecim, -ss); fprintf(afile->f, " %*.*f %*.*f", picwidth, picdecim, ddx, picwidth, picdecim, ddy); fprintf(afile->f, " rm\n"); break; /* put out a dot like in dotr */ } } /* let's make really sure we got there!! */ fprintf(afile->f, " m\n"); /* pulled from the stack */ break; } /* an elegant way to make postscript keep a global record is to translate the coordinates! */ /* writeln(afile,' currentpoint translate'); */ fprintf(afile->f, " t\n"); picxglobal += dx; picyglobal += dy; } /* end module pic.drawr version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.mover */ Static Void mover(afile, dx, dy) _TEXT *afile; double dx, dy; { /* move relative the amount (dx, dy). */ drawr(afile, dx, dy, 'i', 0.0); } /* end module pic.mover version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.liner */ Static Void liner(afile, dx, dy) _TEXT *afile; double dx, dy; { /* draw a line the relative amount (dx, dy). */ drawr(afile, dx, dy, 'l', 0.0); } /* end module pic.liner version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.drawa */ Static Void drawa(afile, x, y, visibility, spacing) _TEXT *afile; double x, y; Char visibility; double spacing; { /* make a line to file afile to absolute coordinate x,y with visibility i invisible - dashed . dotted l line with the dashes or dots separated by the spacing given (this has no effect with invisible and line). */ double dx, dy; /* differences between current and desired locations */ dx = x - picxglobal; dy = y - picyglobal; drawr(afile, dx, dy, visibility, spacing); } /* end module pic.drawa version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.movea */ Static Void movea(afile, x, y) _TEXT *afile; double x, y; { /* move to absolute x and y */ drawa(afile, x, y, 'i', 0.0); } /* end module pic.movea version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.linea */ Static Void linea(afile, x, y) _TEXT *afile; double x, y; { /* draw a line from current position to absolute x and y */ drawa(afile, x, y, 'l', 0.0); } Local Void postscriptprotect(afile, c) _TEXT *afile; Char c; { /* 2008 Aug 05: protect parenthesis */ if (c == '(' || c == ')') putc('\\', afile->f); } /* end module pic.linea version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.graphstring */ Static Void graphstring(tofile, s, justification) _TEXT *tofile; string *s; Char justification; { /* graph the string s. If it is recognized as a quoted string (surrounded by double quotes), graph it without the quotes and center it. Otherwise justify it based on the justification character: 'l' left, 'c' centered, 'r' right. For right and centered justification, the drawing point is the same as before the string was done. For left justification it is at the right of the string to allow more to be added on there. If not in picture (global variable inpicture), there is no output. 2008 Aug 05. '(' and ')' need to be protected by putting '\' in front of them. */ /* NONSTANDARD: PostScript dependent code. Since different fonts have different sized characters, one must rely on the PostScript to handle the justification of the string. */ long i; /* index to s, and temporary storage */ boolean quoted; /* true if the string is quoted */ boolean skipping; /* true if skipping leading blanks */ long FORLIM; if (!(inpicture && s->length > 0)) return; /* There is no output if not in picture else begin writestring(tofile,s); writeln(tofile) end */ if (s->length > 2) { if (s->letters[0] == '"' && s->letters[s->length - 1] == '"') quoted = true; else quoted = false; } else quoted = false; /* override so quoted strings are always centered */ if (quoted) justification = 'c'; /* do the non-standard postscript: */ if (justification != 'l') fprintf(tofile->f, "gsave "); /* do postscript to complete pervious path */ /* set current point: writeln(tofile,'stroke 0 0 moveto'); */ fprintf(tofile->f, "c\n"); if (justification == 'c') { /* when centering, skip leading blanks */ if (s->letters[0] == ' ') skipping = true; else skipping = false; } else skipping = false; putc('(', tofile->f); /* begin postscript literal */ if (quoted) { /* take it literally */ FORLIM = s->length - 2; for (i = 1; i <= FORLIM; i++) { postscriptprotect(tofile, s->letters[i]); putc(s->letters[i], tofile->f); } } else { FORLIM = s->length; for (i = 0; i < FORLIM; i++) { if (skipping) { /* skip leading blanks */ if (s->letters[i] != ' ') { skipping = false; postscriptprotect(tofile, s->letters[i]); putc(s->letters[i], tofile->f); } /* else skip the blank by not writing it */ } else { postscriptprotect(tofile, s->letters[i]); putc(s->letters[i], tofile->f); } } } putc(')', tofile->f); /* end postscript literal */ if (justification == 'c') /* center the string */ fprintf(tofile->f, " dup stringwidth pop neg 2 div 0 rmoveto"); else if (justification == 'r') /* rigth justify the string */ fprintf(tofile->f, " dup stringwidth pop neg 0 rmoveto"); fprintf(tofile->f, " x\n"); /* show the literal */ inpath = false; /* force new path from here */ if (justification != 'l') fprintf(tofile->f, "grestore "); } /* end module pic.graphstring version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.stringinteger */ Static Void stringinteger(number, name, width, leadingzeros) long number; string *name; long width; boolean leadingzeros; { /* make the string from the number, start putting characters in after the current length point. use width characters. if leadingzeros is true, trail zeros before the number. */ long bigdigit; /* the location of the biggest digit */ long dig; /* number of digits in the number */ long place; /* place to write the next digit of the number */ long sign; /* the sign of the number */ if (number < 0) { sign = -1; name->length++; /* provide room for the sign!! */ number = -number; if (leadingzeros) printf( "WARNING: stringinteger: the sign of a negative number with leading zeros is lost\n"); } else sign = 1; /* log 10 of the number plus 1 is the number of digits in the number. On this sun computer ln(1000)/ln(10) is 2.9999, which when truncated gives 2, rather than the desired 3. To avoid this kind of problem, 0.1 is added. */ if (number > 9) dig = (long)(log(number + 0.1) / log(10.0)) + 1; else dig = 1; if (dig > width) { printf("stringinteger: number width too small\n"); printf("%ld digit number (%ld)\n", dig, number); printf("does not fit in %ld characters\n", width); halt(); } if (leadingzeros) bigdigit = name->length + 1; /* no sign if leading zeros */ else { bigdigit = name->length + width - dig + 1; if (bigdigit <= name->length && sign < 0) { printf("stringinteger: no room for sign\n"); halt(); } } if (sign < 0) name->letters[bigdigit-2] = '-'; for (place = name->length + width - 1; place >= bigdigit - 1; place--) { /* p2c: xyplo.p, line 1496: * Note: Using % for possibly-negative arguments [317] */ switch (number % 10) { case 0: name->letters[place] = '0'; break; case 1: name->letters[place] = '1'; break; case 2: name->letters[place] = '2'; break; case 3: name->letters[place] = '3'; break; case 4: name->letters[place] = '4'; break; case 5: name->letters[place] = '5'; break; case 6: name->letters[place] = '6'; break; case 7: name->letters[place] = '7'; break; case 8: name->letters[place] = '8'; break; case 9: name->letters[place] = '9'; break; } number /= 10; } name->length += width; } /* end module pic.stringinteger version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.stringreal */ Static Void stringreal(number, name, width, decimal) double number; string *name; long width, decimal; { /* make the string from the real number, start putting characters in at the start point. use width characters and decimal characters after the decimal place */ /* note that the rounding operation to get the digits below zero must be done first. then the digits above zero can be lopped off. this makes 99.99 come out correctly to 100.0 (to 1 decimal place) otherwise, 99.99 -> 0.99 -> 1.0 (rounded) -> 10 (print with 1 decimal place), and stringinteger won't be happy about that. 2003 Aug 28. corrected missing minus sign for -1 < number <= 0. */ long abovezero; /* the number shifted above the decimal place, to 'decimal' positions (and rounded) */ long shift; /* power of ten used to shift a number around relative to the decimal point */ long sign; /* the sign of the number */ long thedecimal; /* integer version of the decimal part of the number */ long theupper; /* integer version of the upper part of the number */ long signspot; /* of the spot the sign will go. */ /* sanity check: */ if (name->length + width > maxstring) { printf("real number =% .1E would exceed maxstring = %ld\n", number, (long)maxstring); halt(); } if (number < 0) sign = -1; else sign = 1; number = fabs(number); /* make positive */ /* the amount to shift the number above zero */ shift = (long)floor(exp(decimal * log(10.0)) + 0.5); /* amount to move above zero */ abovezero = (long)floor(number * shift + 0.5); /* move above zero, round off */ theupper = (long)((double)abovezero / shift); thedecimal = abovezero - shift * theupper; /* writeln(output,' stringreal: number = ',number:pwid:pdec); writeln(output,' stringreal: sign = ',sign:pwid); writeln(output,' stringreal: theupper = ',theupper:pwid); */ /* create the actual real number */ /* before decimal point */ /* provide a space for the sign in the resulting string: */ /* put in the decimal point */ /* force a space for the sign by making the number negative */ signspot = name->length + 1; /* take note of the spot the sign will go. */ stringinteger(sign * theupper, name, width - decimal - 1, false); /* 2003 Aug 28 There is a very special case, known as bug1992. when the (number > -1) and (number < 0) the upper part of the number is zero (theupper = 0) BUT as an integer the sign cannot be passed to stringinteger, since -0 is of course 0 (usually, or sometimes). SO we have to handle that case and put a minus sign in 'by hand' here. */ if (sign < 1 && theupper == 0 && (long)floor(exp(decimal * log(10.0)) * number + 0.5) != 0) { /* if number is tic = -0.000000000000000055511151231257827021181583405 (a real example!!) then we would get -0.0 on rounding. SO round to the number of decimal places. The number of decimal places: 10^decimal = exp(ln(10^decimal)) = exp(decimal*ln(10)) */ /* ok, starting at signspot, move to the right until we are snug up against the number */ while (name->letters[signspot] == ' ') signspot++; name->letters[signspot-1] = '-'; } /* write(output, 'stringinteger(',sign*theupper:1,',"'); writestring(output, name); write(output, '",', width-decimal-1:1,',',false); writeln(output,')'); */ /* put in the decimal point */ name->length++; name->letters[name->length - 1] = '.'; stringinteger(thedecimal, name, decimal, true); /* after decimal point */ } /* end module pic.stringreal version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.picnumber */ Static Void picnumber(afile, dx, dy, number, width, decimal, justification) _TEXT *afile; double dx, dy, number; long width, decimal; Char justification; { /* Supply graphic commands for a 'number' whose center is at the relative point (dx, dy) from the current point, 'width' characters wide and 'decimal' characters beyond the decimal point. If the width is zero, no number is produced. procedure stringnumber(number: integer; start: integer; var name: string); the location after the call is the same as before the call. The string is optionally justified: left, centered or right: lcr. */ string name; /* the string to pack the number into for shipping out */ if (width <= 0) return; mover(afile, dx, dy); clearstring(&name); if (decimal > 0) stringreal(number, &name, width, decimal); else stringinteger((long)floor(number + 0.5), &name, width, false); graphstring(afile, &name, justification); mover(afile, -dx, -dy); } /* end module pic.picnumber version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.xtic */ Static Void xtic(afile, length, dx, dy, number, width, decimal, logxnormal, logxbase) _TEXT *afile; double length, dx, dy, number; long width, decimal; boolean logxnormal; double logxbase; { /* produce a tic mark for the x axis of "length" long. Supply a number whose center is at the relative point (dx, dy) from the end to the tick, 'width' characters wide and 'decimal' characters beyond the decimal point. If the width is zero, no number is produced. the location after the call is the same as before the call. If logxnormal is true, then raise the number to logxbase. */ liner(afile, 0.0, -length); if (logxnormal) picnumber(afile, dx, dy, exp(number * logxbase), width, decimal, 'c'); else picnumber(afile, dx, dy, number, width, decimal, 'c'); mover(afile, 0.0, length); } /* end module pic.xtic version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.ytic */ Static Void ytic(afile, length, dx, dy, number, width, decimal, logynormal, logybase) _TEXT *afile; double length, dx, dy, number; long width, decimal; boolean logynormal; double logybase; { /* produce a tic mark for the y axis of "length" long. Supply a number whose right side is started at the relative point (dx, dy) from the end to the tick, 'width' characters wide and 'decimal' characters beyond the decimal point. If the width is zero, no number is produced. the location after the call is the same as before the call. If logynormal is true, then raise the number to logybase. */ liner(afile, -length, 0.0); /* convert the number if we are doing logynormal: */ if (logynormal) number = exp(number * logybase); picnumber(afile, dx, dy, number, width, decimal, 'r'); mover(afile, length, 0.0); } /* end module pic.ytic version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.doaxis */ Static Void doaxis(afile, theaxis, doaxisline, alength, fromtic, interval, totic, subintervals, length, dx, dy, width, decimal, logscale, lognormal, logbase) _TEXT *afile; Char theaxis; boolean doaxisline; double alength, fromtic, interval, totic, subintervals, length, dx, dy; long width, decimal; boolean logscale, lognormal; double logbase; { /* draw an axis starting from the current position. Which axis it is is defined by theaxis, 'x' (horizontal) or 'y' (vertical). Combining the code for both axes into one procedure is a little slower, but drawing the axis does note ever take significant time, and this allows improvements to be made on both axes simultaneously. The length of the axis is alength. If doaxisline is true then the axis line is drawn. The axis is labeled with numbers starting with fromtic at intervals given up to totic. The remaining variables describe the form of the tic marks as in ytic. If the width is zero, no number is produced. the location after the call is the same as before the call. If logscale and lognormal is true, then raise the tic numbers to logbase. */ double half; /* half the jump interval. By adding this to the while loops, we assure that the very last tic gets done, and isn't lost due to roundoff */ double jump; /* the space to move on the graph between tic marks */ double jumpdistance = 0.0; /* the total jumps made. this may not be a simple function of the input variables since they may not work out to an exact number of jumps */ double tic; /* the numerical value of the tic label */ boolean dosubtics; /* do sub tics */ double subtic; /* the numerical value of the (unlabeled) subtic */ double subinterval; /* the numerical interval between subtics */ double subjump; /* the space to move on the graph between subtic marks */ double halfsubinterval; /* half a subjump, see half */ double currentspot; /* current graphing spot */ double oldspot; /* previous graphing spot */ double axisscale; /* axis scaling factor */ fprintf(afile->f, "gsave\n"); /* writeln(output,'In doaxis'); writeln(output,'interval=',interval:10:4); writeln(output,'subintervals=',subintervals:10:4); writeln(output,'logbase=',logbase:10:4); */ if (theaxis == 'x') { if (doaxisline) { liner(afile, alength, 0.0); mover(afile, -alength, 0.0); } } else { if (doaxisline) { liner(afile, 0.0, alength); mover(afile, 0.0, -alength); } } if (totic == fromtic) { printf("doaxis: %c axis fromtic and totic cannot be equal\n", theaxis); halt(); } if (alength == 0.0 || interval == 0.0) { printf("doaxis: neither %c axis length nor interval can be zero\n", theaxis); halt(); } axisscale = alength / (totic - fromtic); jump = axisscale * interval; half = interval / 2.0; if (subintervals > 1) { dosubtics = true; subinterval = interval / subintervals; halfsubinterval = subinterval / 2.0; subjump = jump / subintervals; } else { dosubtics = false; subinterval = 0.0; halfsubinterval = 0.0; subjump = 0.0; } /* writeln(output,'fromtic = ',fromtic:10:4); writeln(output,'totic = ',totic:10:4); writeln(output,'interval = ',interval:10:4); writeln(output,'half = ',half:10:4); */ tic = fromtic; if (interval > 0.0) { while (tic <= totic + interval) { /* writeln(output,'* tic=',tic:10:4); */ if (tic <= totic) { if (theaxis == 'x') xtic(afile, length, dx, dy, tic, width, decimal, lognormal, logbase); else ytic(afile, length, dx, dy, tic, width, decimal, lognormal, logbase); } /* 2007 Aug 30 the extra interval makes subtics go to the end of the graph rather than ending at the last tic mark */ if (tic <= totic + interval) { /* writeln(output,'totic+half + interval=',totic+half + interval:10:4); writeln(output,'totic+interval=',totic+interval:10:4); if tic <= totic+half + 1 then begin writeln(output,'TIC=',tic:10:4); writeln(afile,'% tic=',tic:10:4); mover(afile,0.05,0.0); */ if (dosubtics) { /* do subtic marks */ if (logscale) { /* do subtic marks on log scale */ /* subtic starts as a "normal" number (ie, no log taken) at tic: */ /* writeln(output,'2^tic=',exp(tic*logbase):10:4); writeln(output,'2^(tic+interval)=',exp((tic+interval)*logbase):10:4); */ subtic = exp(tic * logbase); /* subtic will proceed to the same but at tic+interval. We divide that into the subintervals. */ /* writeln(output,'halfsubinterval=',halfsubinterval:10:4,' original'); */ subinterval = (exp((tic + interval) * logbase) - subtic) / subintervals; halfsubinterval = subinterval / 2.0; /* writeln(output,'subtic= ',subtic:10:4); writeln(output,'subinterval= ',subinterval:10:4); writeln(output,'halfsubinterval=',halfsubinterval:10:4); */ oldspot = axisscale * tic; while (subtic < exp(logbase * (tic + interval)) - halfsubinterval) { /* although tic is on a log scale, we have to have subtic on the regular scale to alter the positions of the subtics */ /* if subinterval is constant, the following makes linearly spaced marks: */ subtic += subinterval; /* the actual jumps have to be in the log form: */ currentspot = axisscale * log(subtic) / logbase; subjump = currentspot - oldspot; /* writeln(output,' SUBTIC=',subtic:10:4); writeln(output,' ln(SUBTIC)/logbase=',ln(subtic)/logbase:10:4); writeln(output,' currentspot=',currentspot:10:4); writeln(output,' subjump=',subjump:10:4); writeln(output,' oldspot=',oldspot:10:4); writeln(afile,'% subtic=',subtic:10:4); */ oldspot = currentspot; if (theaxis == 'x') { xtic(afile, length / 2, dx, dy, 0.0, 0L, 0L, lognormal, logbase); mover(afile, subjump, 0.0); } else { ytic(afile, length / 2, dx, dy, 0.0, 0L, 0L, lognormal, logbase); mover(afile, 0.0, subjump); } jumpdistance += subjump; } } else { subtic = tic; while (subtic < tic + interval - halfsubinterval) { subtic += subinterval; if (theaxis == 'x') { mover(afile, subjump, 0.0); if (subtic <= totic) xtic(afile, length / 2, dx, dy, 0.0, 0L, 0L, lognormal, logbase); } else { mover(afile, 0.0, subjump); if (subtic <= totic) ytic(afile, length / 2, dx, dy, 0.0, 0L, 0L, lognormal, logbase); } jumpdistance += subjump; } } } else { /* do subtic marks on regular scale */ if (theaxis == 'x') mover(afile, jump, 0.0); else mover(afile, 0.0, jump); jumpdistance += jump; } } /* do regular tic marks */ tic += interval; } } else if (interval < 0.0) { while (tic >= totic - half) { if (dosubtics) printf("Sorry, no subtics with negative scales\n"); if (theaxis == 'x') xtic(afile, length, dx, dy, tic, width, decimal, lognormal, logbase); else ytic(afile, length, dx, dy, tic, width, decimal, lognormal, logbase); tic += interval; if (tic < totic - half) break; if (theaxis == 'x') mover(afile, jump, 0.0); else mover(afile, 0.0, jump); jumpdistance += jump; } } if (theaxis == 'x') mover(afile, -jumpdistance, 0.0); else mover(afile, 0.0, -jumpdistance); fprintf(afile->f, "grestore\n"); } /* end module pic.doaxis version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.xaxis */ Static Void xaxis(afile, doaxisline, axlength, fromtic, interval, totic, xsubintervals, length, dx, dy, width, decimal, logxscale, logxnormal, logxbase) _TEXT *afile; boolean doaxisline; double axlength, fromtic, interval, totic, xsubintervals, length, dx, dy; long width, decimal; boolean logxscale, logxnormal; double logxbase; { /* line on axis is plotted */ /* draw an x axis starting from the current position. */ doaxis(afile, 'x', doaxisline, axlength, fromtic, interval, totic, xsubintervals, length, dx, dy, width, decimal, logxscale, logxnormal, logxbase); } /* end module pic.xaxis version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.yaxis */ Static Void yaxis(afile, doaxisline, aylength, fromtic, interval, totic, ysubintervals, length, dx, dy, width, decimal, logyscale, logynormal, logybase) _TEXT *afile; boolean doaxisline; double aylength, fromtic, interval, totic, ysubintervals, length, dx, dy; long width, decimal; boolean logyscale, logynormal; double logybase; { /* line on axis is plotted */ /* draw an y axis starting from the current position. */ doaxis(afile, 'y', doaxisline, aylength, fromtic, interval, totic, ysubintervals, length, dx, dy, width, decimal, logyscale, logynormal, logybase); } /* end module pic.yaxis version = 2.77; (@ of dops.p 2008 Aug 05 */ /* ********************************************************************** */ /* end module pic.functions version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.cboxr */ Static Void cboxr(afile, width, height) _TEXT *afile; double width, height; { /* make a box to file afile with width in the x direction and height in the y direction as given. the box is centered at the current position. the box is relative to the current position, so it returns to original position afterwards */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, -h2); liner(afile, 0.0, height); liner(afile, width, 0.0); liner(afile, 0.0, -height); liner(afile, -width, 0.0); mover(afile, w2, h2); } /* end module pic.cboxr version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.skybox */ Static Void skybox(afile, x, y, width, height) _TEXT *afile; double x, y, width, height; { /* make a box to file afile with width in the x direction. The top center of the box is at x,y and the bottom is at x,0. height is not used in this version. */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; movea(afile, x - h2, 0.0); linea(afile, x + h2, 0.0); linea(afile, x + h2, y); linea(afile, x - h2, y); linea(afile, x - h2, 0.0); } /* end module pic.skybox */ /* begin module pic.dotr */ Static Void dotr(afile) _TEXT *afile; { /* draw a dot at the current position */ /* a zero length line won't work here, since some systems really believe it and draw nothing. (eg. PostScript on the Applewriter draws nothing, but PostScript on the Sun puts one pixle */ drawr(afile, dotfactor, 0.0, 'l', 0.0); } /* end module pic.dotr version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.degtorad */ Static double degtorad(angle) double angle; { /* convert angle in degrees to radians */ return (angle / 360 * 2 * pi); } /* end module pic.degtorad version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.polrec */ Static Void polrec(r, theta, x, y) double r, theta, *x, *y; { /* convert polar to rectangular coordinates, theta is in radians */ *x = r * cos(theta); *y = r * sin(theta); } /* end module pic.polrec version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.arc */ Static Void arc(thefile, angle1, angle2, radius, steps) _TEXT *thefile; double angle1, angle2, radius; long steps; { /* create an arc in thefile going from angle1 to angle2 (degrees) in the positive direction of angle, with the given radius. use the given number of steps to make it. return to the same position as before the arc was drawn. */ double dtheta; /* change in theta */ /* s: integer; (@ index to the steps */ double theta; /* current angle */ double x, y; /* coordinates around starting point */ /* zerox,zeroy: real; (@ starting location, center of curve */ /* zerox := picxglobal; zeroy := picyglobal; */ theta = degtorad(angle1); dtheta = degtorad(fabs(angle2 - angle1) / steps); polrec(radius, theta, &x, &y); /* can't do this for postscript arc: movea(thefile,zerox+x,zeroy+y); ' ',scale*zerox: picwidth:picdecim, ' ',scale*zeroy: picwidth:picdecim, */ /* NONSTANDARD postscript, much faster */ /* 'stroke newpath', */ /* force there to be no current point */ /* ' 0 0', */ fprintf(thefile->f, "a %*.*f %*.*f %*.*f\n", picwidth, picdecim, scale * radius, picwidth, picdecim, angle1, picwidth, picdecim, angle2); fprintf(thefile->f, "arc"); if (angle2 < angle1) /* for negative draws */ putc('n', thefile->f); /* origin move: writeln(thefile,' stroke newpath 0 0 moveto'); */ fprintf(thefile->f, " n\n"); /* the moveto puts us back to the origin */ /* for s := 1 to steps do begin theta := theta + dtheta; polrec(radius,theta, x,y); linea(thefile,zerox+x,zeroy+y); end; movea(thefile,zerox,zeroy) */ } /* end module pic.arc version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.circler */ Static Void circler(afile, radius) _TEXT *afile; double radius; { /* make a circle at the current position of some radius. */ long steps; /* number of steps to make the circle */ /* number of segments increases with diameter, but the constant still should be a function of how good it looks on a particular graphic system, I'm afraid. However, there should be a lower bound on the number of steps, so even small circles look good */ if (radius < 1.0) steps = 25; else steps = (long)floor(radius * 25 + 0.5); arc(afile, 0.0, 360.0, radius, steps); } /* end module pic.circler version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.ibeam */ Static Void ibeam(afile, width, height) _TEXT *afile; double width, height; { /* Make an ibeam shaped symbol to file afile with width in the x direction and height in the y direction. Center it at the current position. Put a circle at the center, with radius 1/4th the width Return to original position afterwards. */ double h2, w2; /* height and width over 2 */ double r; /* the radius of the circle */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, -h2); liner(afile, width, 0.0); mover(afile, -width, height); liner(afile, width, 0.0); mover(afile, -w2, 0.0); liner(afile, 0.0, -height); mover(afile, 0.0, h2); r = width / 8; /* this is silly for the new printers if r < 0.025 then r := 0.025; (* small circles do not come out well *) */ circler(afile, r); } /* end module pic.ibeam version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.xr */ Static Void xr(afile, width, height) _TEXT *afile; double width, height; { /* make an x to file afile with width in the x direction and height in the y direction as given. the box is centered at the current position. the box is relative to the current position, so it returns to original position afterwards */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, -h2); liner(afile, width, height); mover(afile, 0.0, -height); liner(afile, -width, height); mover(afile, w2, -h2); } /* end module pic.xr version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.plusr */ Static Void plusr(afile, width, height) _TEXT *afile; double width, height; { /* make a plus sign to file afile with width in the x direction and height in the y direction as given. the box is centered at the current position. the box is relative to the current position, so it returns to original position afterwards */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, 0.0); liner(afile, width, 0.0); mover(afile, -w2, h2); liner(afile, 0.0, -height); mover(afile, 0.0, h2); } /* end module pic.plusr version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.rectinit */ Static Void rectinit(outfile) _TEXT *outfile; { /* create the definition of a rectangle. Rectsize must be called to initialize and to change the size of the rectangle. */ fprintf(outfile->f, "/rct\n"); fprintf(outfile->f, "{gsave\n"); fprintf(outfile->f, " newpath\n"); fprintf(outfile->f, " 0 0 moveto\n"); fprintf(outfile->f, " xs 0 lineto\n"); /* xs is the x side length */ fprintf(outfile->f, " xs ys lineto\n"); /* ys is the x side length */ fprintf(outfile->f, " 0 ys lineto\n"); fprintf(outfile->f, " closepath fill\n"); fprintf(outfile->f, "grestore} def\n"); } /* end module pic.rectinit version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.rectsize */ Static Void rectsize(afile, xsideold, ysideold, xside, yside) _TEXT *afile; double *xsideold, *ysideold, *xside, *yside; { /* determine if the values of xside and yside have changed from xsideold and ysideold. If either has changed, write the instructions to change the size of the rectangle into afile. */ if (*xside != *xsideold) { fprintf(afile->f, "/xs %*.*f def\n", picwidth, picdecim, *xside * scale); /* xs is the x side length used in rectinit */ *xsideold = *xside; } if (*yside != *ysideold) { fprintf(afile->f, "/ys %*.*f def\n", picwidth, picdecim, *yside * scale); /* ys is the y side length used in rectinit */ *ysideold = *yside; } } /* end module pic.rectsize version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.rectdo */ Static Void rectdo(afile) _TEXT *afile; { /* Make a rectangle with lower right hand corner at (x,y) and the given side (position and color are determined by earlier calls to setcolor and move). Return to original position afterwards. */ fprintf(afile->f, " rct\n"); } #define colfield 8 /* width of numbers printed to the file */ #define colwidth 4 /* number of decimal places for numbers */ /* end module pic.rectdo version = 2.77; (@ of dops.p 2008 Aug 05 */ /* begin module pic.setgray */ Static Void setgray(afile, brightness) _TEXT *afile; double brightness; { /* set the gray scale to the requested one. Range of the variables is 0 to 1. */ /* PostScript on a Sun 4 cannot handle 5 decimal places! Use 4 or less */ putc('n', afile->f); /* be sure it's started cleanly */ fprintf(afile->f, " %*.*f", colfield, colwidth, brightness); fprintf(afile->f, " setgray\n"); } #undef colfield #undef colwidth #define colfield 8 /* width of numbers printed to the file */ #define colwidth 4 /* number of decimal places for numbers */ /* PostScript on a Sun 4 cannot handle 5 decimal places! Use 4 or less */ #define huefactor 0.84 /* number of decimal places for numbers */ /* end module pic.setgray version = 2.77; (@ of dops.p 2008 Aug 05 */ /* LOCK begin module pic.setcolor */ Static Void setcolor(afile, hue, saturation, brightness) _TEXT *afile; double hue, saturation, brightness; { /* Set the color to the requested one. Range of the variables is 0 to 1. Colors in PostScript are defined with hue, saturation and brightness with the sethsbcolor function. The standard hue runs from red at 0 to red at 1 with the Roy G. Biv in between. The famous physicist Roy G. Biv stands for: red, orange, yellow, green, blue, indigo, violet, the colors of the spectrum. On 1992 September 16 I realized that, amazingly, the wavelength in nm match quite nicely! 700 red 750 orange 600 yellow 650 green 500 blue 550 indego 400 violet Since the hue runs in a circle, the spectrum is not generated from the hue range 0 to 1. The routine setcolor therefore converts the input numbers by multiplying by 0.84 and adding 0.16. This gives the color range from yellow through red corresponding to values 0 to 1. (Note: adding 0.16 give the range from yellow through red, but that is not a spectrum which runs from red through violet.) */ putc('n', afile->f); /* be sure it's started cleanly */ /* write (afile,' ',hue*huefactor: colfield:colwidth); */ fprintf(afile->f, " %*.*f", colfield, colwidth, hue * huefactor + 1 - huefactor); fprintf(afile->f, " %*.*f", colfield, colwidth, saturation); fprintf(afile->f, " %*.*f", colfield, colwidth, brightness); fprintf(afile->f, " sethsbcolor\n"); } #undef colfield #undef colwidth #undef huefactor /* Local variables for boxintercept: */ struct LOC_boxintercept { double xmin, ymin, xmax, ymax, m, b; boolean *intercept; double *x1, *y1, *x2, *y2; long count; /* number of sides the line intersects */ boolean xlo, xhi, ylo, yhi; } ; /* whether the line intersects the box at the low value of x, etc */ Local double fny(x, LINK) double x; struct LOC_boxintercept *LINK; { /* calculate the y value given the x */ return (LINK->m * x + LINK->b); } Local double fnx(y, LINK) double y; struct LOC_boxintercept *LINK; { /* calculate the x value given the y */ return ((y - LINK->b) / LINK->m); } Local boolean between(a, b, c, LINK) double a, b, c; struct LOC_boxintercept *LINK; { /* is b between a and c? */ return (a <= b && b <= c); } Local Void normalcases(LINK) struct LOC_boxintercept *LINK; { /* analyze for the usual cases when the slope m is not zero */ /* writeln(output,'m=',m:5:4,' b=',b:5:4,' in normalcases');*/ /* ymin, ymax, xmin and xmax are the coordinates of the box; xlo, yhi, xhi, and ylo are which sides are intersected | ymax +----yhi----+ | | | | xlo xhi | | | | ymin +----ylo----+ | xmin xmax | | */ LINK->xlo = between(LINK->ymin, fny(LINK->xmin, LINK), LINK->ymax, LINK); LINK->xhi = between(LINK->ymin, fny(LINK->xmax, LINK), LINK->ymax, LINK); LINK->ylo = between(LINK->xmin, fnx(LINK->ymin, LINK), LINK->xmax, LINK); LINK->yhi = between(LINK->xmin, fnx(LINK->ymax, LINK), LINK->xmax, LINK); /* writeln(output,'xlo = ',xlo); writeln(output,'xhi = ',xhi); writeln(output,'ylo = ',ylo); writeln(output,'yhi = ',yhi); */ *LINK->intercept = true; /* optimistic */ /* simplify cases which intersect corners. These are the ones where more than two side intersections are true. */ LINK->count = 0; if (LINK->xlo) LINK->count++; if (LINK->xhi) LINK->count++; if (LINK->ylo) LINK->count++; if (LINK->yhi) LINK->count++; if (LINK->count > 2) { /* one corner must be intersected. Simplify by preserving the opposing intersections. When there are 4 intersections, only one pair is preserved. The calculations will be correct either way. */ if (LINK->xlo && LINK->xhi) { LINK->yhi = false; LINK->ylo = false; } else if (LINK->ylo && LINK->yhi) { LINK->xhi = false; LINK->xlo = false; } else { printf("error in between count!\n"); halt(); } } if (LINK->xlo && LINK->xhi) { *LINK->x1 = LINK->xmin; *LINK->x2 = LINK->xmax; } else if (LINK->xlo && LINK->ylo) { *LINK->x1 = LINK->xmin; *LINK->x2 = fnx(LINK->ymin, LINK); } else if (LINK->xlo && LINK->yhi) { *LINK->x1 = LINK->xmin; *LINK->x2 = fnx(LINK->ymax, LINK); } else if (LINK->xhi && LINK->ylo) { *LINK->x1 = LINK->xmax; *LINK->x2 = fnx(LINK->ymin, LINK); } else if (LINK->xhi && LINK->yhi) { *LINK->x1 = LINK->xmax; *LINK->x2 = fnx(LINK->ymax, LINK); } else if (LINK->ylo && LINK->yhi) { *LINK->x1 = fnx(LINK->ymin, LINK); *LINK->x2 = fnx(LINK->ymax, LINK); } else *LINK->intercept = false; if (*LINK->intercept) { *LINK->y1 = fny(*LINK->x1, LINK); *LINK->y2 = fny(*LINK->x2, LINK); } } /* normalcases */ /* LOCK end module pic.setcolor version = 2.73; (@ of dops.p 2003 Aug 28 */ /* begin module pic.boxintercept */ Static Void boxintercept(xmin_, ymin_, xmax_, ymax_, m_, b_, intercept_, x1_, y1_, x2_, y2_) double xmin_, ymin_, xmax_, ymax_, m_, b_; boolean *intercept_; double *x1_, *y1_, *x2_, *y2_; { /* does the line y=m*x+b intercept the box defined by the points (xmin,ymin) and (xmax,ymax)? if so, intercept is true and the intercept points are given by (x1,y1) and (x2,y2) */ struct LOC_boxintercept V; V.xmin = xmin_; V.ymin = ymin_; V.xmax = xmax_; V.ymax = ymax_; V.m = m_; V.b = b_; V.intercept = intercept_; V.x1 = x1_; V.y1 = y1_; V.x2 = x2_; V.y2 = y2_; /* note: abs(m) is required to protect against negative zero... */ if (fabs(V.m) != 0.0) { normalcases(&V); return; } *V.intercept = between(V.ymin, V.b, V.ymax, &V); if (!*V.intercept) return; *V.x1 = V.xmin; *V.y1 = V.b; *V.x2 = V.xmax; *V.y2 = V.b; } /* boxintercept */ /* Local variables for checknumber: */ struct LOC_checknumber { _TEXT *afile; boolean ok; /* result of this check */ } ; Local Void conclude(LINK) struct LOC_checknumber *LINK; { _TEXT TEMP; printf("Including this character, the rest of the data line is:\n"); TEMP.f = stdout; *TEMP.name = '\0'; copyaline(LINK->afile, &TEMP); LINK->ok = false; } /* end module pic.boxintercept version = 2.77; (@ of dops.p 2008 Aug 05 */ /* ************************************************************************ */ /* ************************************************************************ */ /* begin module checknumber */ Static boolean checknumber(afile_) _TEXT *afile_; { /* check that there is a number next in the file. If not, return false. This is useful for protection when reading a parameter file. */ struct LOC_checknumber V; V.afile = afile_; V.ok = true; /* be optimistic */ if (BUFEOF(V.afile->f)) { V.ok = false; printf("A number was expected on a data line, but"); printf(" the end of the file was found instead.\n"); return false; } skipblanks(V.afile); if (P_eoln(V.afile->f)) { printf("A number was expected on a data line, but"); printf(" the end of the line was found instead.\n"); conclude(&V); } if (P_peek(V.afile->f) == '+' || P_peek(V.afile->f) == '-' || P_peek(V.afile->f) == '.' || P_peek(V.afile->f) == '9' || P_peek(V.afile->f) == '8' || P_peek(V.afile->f) == '7' || P_peek(V.afile->f) == '6' || P_peek(V.afile->f) == '5' || P_peek(V.afile->f) == '4' || P_peek(V.afile->f) == '3' || P_peek(V.afile->f) == '2' || P_peek(V.afile->f) == '1' || P_peek(V.afile->f) == '0') return V.ok; printf("A number was expected on a data line, but"); printf(" the character \"%c\" was found instead.\n", P_peek(V.afile->f)); conclude(&V); return V.ok; } /* end module checknumber version = 5.22; (@ of prgmod.p 2005 Jul 12 */ /* begin module xyplo.tellwarning */ Static Void tellwarning() { /* tell the user that there are warnings. Unfortunately these are globals: warnings: text, warningcount: integer. */ warningcount++; if (warningcount == 1) { if (*warnings.name != '\0') { if (warnings.f != NULL) warnings.f = freopen(warnings.name, "w", warnings.f); else warnings.f = fopen(warnings.name, "w"); } else { if (warnings.f != NULL) rewind(warnings.f); else warnings.f = tmpfile(); } if (warnings.f == NULL) _EscIO2(FileNotFound, warnings.name); SETUPBUF(warnings.f, Char); fprintf(warnings.f, "xyplo %4.2f\n", version); } fprintf(warnings.f, "\n%ld ", warningcount); } /* end module xyplo.tellwarning */ /* begin module marksdo */ Static Void marksdo(afile, width, height, flagstring) _TEXT *afile; double width, height; string flagstring; { /* make the postscript mark defined by the user */ if (flagstring.length == 0) { printf("WARNING: user defined mark not used in xyin\n"); return; } fprintf(afile->f, "\ngsave %% marksdo\n"); fprintf(afile->f, "%*.*f %*.*f ", picwidth, picdecim, scale * width, picwidth, picdecim, scale * height); writestring(afile, &flagstring); fprintf(afile->f, "\ngrestore %% marksdo\n\n"); } /* end module marksdo */ /* begin module xyplo.gettoken */ Static Void gettoken(infile, flag, tokenstring, gots) _TEXT *infile; Char *flag; string *tokenstring; boolean *gots; { /* get the tokenstring from infile. the first character of the string is placed in flag. gots is true if a non-blank token was found. */ boolean done = false; /* done reading characters */ clearstring(tokenstring); while (!done) { if (P_eoln(infile->f)) { done = true; break; } if (P_peek(infile->f) == ' ') { done = true; break; } tokenstring->length++; tokenstring->letters[tokenstring->length - 1] = getc(infile->f); if (tokenstring->letters[tokenstring->length - 1] == '\n') tokenstring->letters[tokenstring->length - 1] = ' '; } *gots = (tokenstring->length != 0); *flag = tokenstring->letters[0]; } /* end module xyplo.gettoken */ /* begin module xyplo.equalstring */ Static boolean equalstring(a, b) string a, b; { /* are the two strings equal up to their lengths? */ boolean notequal; /* true if the strings are not equal */ long j; /* index to positions in the strings */ if (a.length != b.length) return false; else { /* until proven guilty */ j = 1; notequal = false; do { notequal = (a.letters[j-1] != b.letters[j-1]); j++; } while (!(j > a.length || notequal)); return (!notequal && j > a.length); } } /* end module xyplo.equalstring */ /* begin module xyplo.bar */ Static Void bar(f, c) _TEXT *f; Char c; { /* produce a bar of the character c to separate parts of the file f */ long i; /* index */ for (i = 1; i <= 50; i++) putc(c, f->f); putc('\n', f->f); } /* Local variables for readsymbol: */ struct LOC_readsymbol { _TEXT *f; } ; Local Void t(LINK) struct LOC_readsymbol *LINK; { /* test that the file is still there to read */ if (BUFEOF(LINK->f->f)) { printf("missing symbol parameters\n"); halt(); } } /* end module xyplo.bar */ /* begin module xyplo.readsymbol */ Static Void readsymbol(f_, symb, p, s) _TEXT *f_; Char symb; param *p; symbol *s; { /* read the symbol definition from f */ struct LOC_readsymbol V; Char flag; /* first character of symbolflag string */ boolean gotsymbol; /* the symbol string was read ok */ line *WITH1; _TEXT TEMP; V.f = f_; s->symboltoplot = symb; WITH1 = &s->l; /* what to recognize for this symbol */ t(&V); gettoken(V.f, &flag, &s->symbolflag, &gotsymbol); if (!gotsymbol) { printf("Could not find symbol flag for symbol \"%c\"\n", symb); printf("while reading symbols in the xyplop file.\n"); printf("Trying to read a symbol from this token:\n"); TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &s->symbolflag); printf("\nThe rest of the file contains: \n"); while (!BUFEOF(V.f->f)) { TEMP.f = stdout; *TEMP.name = '\0'; copyaline(V.f, &TEMP); } halt(); } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); t(&V); fscanf(V.f->f, "%lg%*[^\n]", &s->symbolxsize); getc(V.f->f); /* its size on the x axis */ if (s->symbolxsize <= 0 && !p->needxscolumn) { printf("While reading symbol \"%c\" with flag \"%c\" you asked that its\n", symb, flag); printf("x size be determined from a column.\n"); printf("unfortunately you did not specify a positive column!\n"); halt(); } /*writeln(output,'in readsymbol: needxscolumn = ',p.needxscolumn);*/ /*writeln(output,'symbolxsize = ',symbolxsize:10:2);*/ t(&V); fscanf(V.f->f, "%lg%*[^\n]", &s->symbolysize); getc(V.f->f); /* its size on the y axis */ if (s->symbolysize <= 0 && !p->needyscolumn) { printf("While reading symbol \"%c\" with flag \"%c\" you asked that its\n", symb, flag); printf("y size be determined from a column.\n"); printf("unfortunately you did not specify a positive column!\n"); halt(); } /*writeln(output,'in readsymbol: needyscolumn = ',p.needyscolumn);*/ /*writeln(output,'symbolysize = ',symbolysize:10:2);*/ if (s->symbolxsize == 0.0 || s->symbolysize == 0.0) { printf("symbol size cannot be zero\n"); halt(); } /* decide on connection lines */ if (P_peek(V.f->f) == 'c') { getc(V.f->f); if ((P_peek(V.f->f) == 'n') | (P_peek(V.f->f) == 'i')) s->doconnection = false; /* oh well */ else { s->doconnection = true; s->connecttype = getc(V.f->f); if (s->connecttype == '\n') s->connecttype = ' '; if (s->connecttype == '.' || s->connecttype == '-') { skipnonblanks(V.f); fscanf(V.f->f, "%lg", &s->connectsize); } else s->connectsize = 0.05; s->didlastpoint = false; } } else s->doconnection = false; fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); /* read in the symbol line definition */ if (!P_eoln(V.f->f)) { WITH1->linetype = getc(V.f->f); if (WITH1->linetype == '\n') WITH1->linetype = ' '; if (WITH1->linetype == 'l' || WITH1->linetype == '.' || WITH1->linetype == '-' || WITH1->linetype == 'i') s->doline = true; else if (WITH1->linetype == 'n') s->doline = false; else { printf("for symbol %c line type must be one of \"lin.-\"\n", s->symboltoplot); halt(); } if (WITH1->linetype == '-' || WITH1->linetype == '.') { t(&V); skipnonblanks(V.f); fscanf(V.f->f, "%lg", &WITH1->linesize); } else WITH1->linesize = 0.05; } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); if (symb == 'r' || symb == 'R') /* start rectangles later */ p->startrectangles = true; } /* end module xyplo.readsymbol */ /* begin module copyfile */ Static Void copyfile(fin, fout) _TEXT *fin, *fout; { /* copy the rest of file fin to fout */ while (!BUFEOF(fin->f)) copyaline(fin, fout); } /* end module copyfile version = 5.22; (@ of prgmod.p 2005 Jul 12 */ /* begin module xyplo.upgrade1 */ Static Void upgrade1(xyplop, p) _TEXT *xyplop; param p; { /* upgrade the parameter file xyplop */ _TEXT internal; /* a place to hold the old xyplop */ internal.f = NULL; *internal.name = '\0'; if (*xyplop->name != '\0') { if (xyplop->f != NULL) xyplop->f = freopen(xyplop->name, "r", xyplop->f); else xyplop->f = fopen(xyplop->name, "r"); } else rewind(xyplop->f); if (xyplop->f == NULL) _EscIO2(FileNotFound, xyplop->name); RESETBUF(xyplop->f, Char); if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "w", internal.f); else internal.f = fopen(internal.name, "w"); } else { if (internal.f != NULL) rewind(internal.f); else internal.f = tmpfile(); } if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); SETUPBUF(internal.f, Char); /* copy xyplop to internal */ copyfile(xyplop, &internal); /* copy internal to xyplop */ if (*internal.name != '\0') { if (internal.f != NULL) internal.f = freopen(internal.name, "r", internal.f); else internal.f = fopen(internal.name, "r"); } else rewind(internal.f); if (internal.f == NULL) _EscIO2(FileNotFound, internal.name); RESETBUF(internal.f, Char); if (*xyplop->name != '\0') { if (xyplop->f != NULL) xyplop->f = freopen(xyplop->name, "w", xyplop->f); else xyplop->f = fopen(xyplop->name, "w"); } else { if (xyplop->f != NULL) rewind(xyplop->f); else xyplop->f = tmpfile(); } if (xyplop->f == NULL) _EscIO2(FileNotFound, xyplop->name); SETUPBUF(xyplop->f, Char); copyfile(&internal, xyplop); /* add the new material to the end: */ fprintf(xyplop->f, " **** more parameters\n"); fprintf(xyplop->f, "p %4.2f %4.2f %4.2f %4.2f edgecontrol (p=page),", p.edgeleft, p.edgeright, p.edgelow, p.edgehigh); fprintf(xyplop->f, " edgeleft, edgeright, edgelow, edgehigh in cm\n"); fprintf(xyplop->f, "%4.2f version of xyplo that this parameter file is designed for.\n", version); if (*xyplop->name != '\0') { if (xyplop->f != NULL) xyplop->f = freopen(xyplop->name, "r", xyplop->f); else xyplop->f = fopen(xyplop->name, "r"); } else rewind(xyplop->f); if (xyplop->f == NULL) _EscIO2(FileNotFound, xyplop->name); RESETBUF(xyplop->f, Char); /* ready to start reading again */ if (internal.f != NULL) fclose(internal.f); } #define columns 8 /* Local variables for readparam: */ struct LOC_readparam { _TEXT *f; boolean checkout; /* if true, all variable values are ok */ long symbolcount; } ; Local Void helpem(LINK) struct LOC_readparam *LINK; { /* help the poor user figure out where the problem is */ _TEXT TEMP; printf("\nTo help you locate the problem, here's the rest\n"); printf("of the xyplop file:\n"); printf( "\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\n"); while (!BUFEOF(xyplop.f)) { TEMP.f = stdout; *TEMP.name = '\0'; copyaline(&xyplop, &TEMP); } printf( "\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\"\n"); halt(); } Local Void cn(LINK) struct LOC_readparam *LINK; { /* short version of call to check number */ LINK->checkout = checknumber(LINK->f); if (!LINK->checkout) /* avoid snowballing */ helpem(LINK); } Local Void t_(LINK) struct LOC_readparam *LINK; { /* test that the file is still there to read */ if (BUFEOF(LINK->f->f)) { printf("Missing parameters: unexpected end of xyplop\n"); halt(); } } Local Void num(f, LINK) _TEXT *f; struct LOC_readparam *LINK; { /* test that a number follows */ skipblanks(f); if (P_peek(f->f) != '9' && P_peek(f->f) != '8' && P_peek(f->f) != '7' && P_peek(f->f) != '6' && P_peek(f->f) != '5' && P_peek(f->f) != '4' && P_peek(f->f) != '3' && P_peek(f->f) != '2' && P_peek(f->f) != '1' && P_peek(f->f) != '0' && P_peek(f->f) != '+' && P_peek(f->f) != '-') { printf( "found this character: \"%c\" when expecting a number in the parameter file\n", P_peek(f->f)); helpem(LINK); } } Local boolean softnumbertest(f, LINK) _TEXT *f; struct LOC_readparam *LINK; { /* test that a number follows, but don't die if there is none */ _TEXT TEMP; skipblanks(f); if (P_peek(f->f) != '9' && P_peek(f->f) != '8' && P_peek(f->f) != '7' && P_peek(f->f) != '6' && P_peek(f->f) != '5' && P_peek(f->f) != '4' && P_peek(f->f) != '3' && P_peek(f->f) != '2' && P_peek(f->f) != '1' && P_peek(f->f) != '0' && P_peek(f->f) != '+' && P_peek(f->f) != '-') { TEMP.f = stdout; *TEMP.name = '\0'; bar(&TEMP, '-'); printf("NOTE: in xyplop, another number is now allowed for this line:\n"); TEMP.f = stdout; *TEMP.name = '\0'; copyaline(f, &TEMP); return false; } else return true; } Local boolean notok(a, b) long a, b; { /* check for the locations of two columns: if they are equal and and positive, then the grabdata routine will not be able to read them both */ if (a == b && a > 0) return true; else return false; } /* notok */ Local Void testcolumns(a, b, c, d, e, f, g, h, LINK) long a, b, c, d, e, f, g, h; struct LOC_readparam *LINK; { /* test that the 8 columns do not conflict spatially */ /* number of columns. Must correspond with the number of arguments to testcolumns */ long all[8]; /* the locations of the columns */ boolean die = false; /* program will stop if any errors are found */ long x, y; /* index to all */ all[0] = a; all[1] = b; all[2] = c; all[3] = d; all[4] = e; all[5] = f; all[6] = g; all[7] = h; for (x = 0; x <= columns - 2; x++) { for (y = x + 1; y < columns; y++) { if (notok(all[x], all[y])) { if (!die) printf("no two columns can have the same positive position\n"); printf("columns in conflict are numbered %ld\n", all[x]); die = true; } } } if (die) helpem(LINK); } /* testcolumns */ #undef columns /* Local variables for nextsection: */ struct LOC_nextsection { struct LOC_readparam *LINK; Char id; } ; Local Void nosection(LINK) struct LOC_nextsection *LINK; { /* object if we did not find the next section */ printf("ERROR: SECTION DIVIDER NOT FOUND\n"); printf("Section divider lines in xyplop may (but need not) begin with blanks\n"); printf("and these must be followed by at least one asterisk (\"*\").\n"); printf("Check that your xyplop matches the current documentation.\n"); printf("The error was found while\n"); printf("Xyplo was looking for the section divider before "); switch (LINK->id) { case 'c': printf("the COLUMN section.\n"); break; case 's': printf("SYMBOL number %ld.\n", LINK->LINK->symbolcount); break; case 'l': printf("the LINE section.\n"); break; case 'm': printf("the MORE PARAMETERS section.\n"); break; } helpem(LINK->LINK); } /* nosection */ Local Void nextsection(id_, LINK) Char id_; struct LOC_readparam *LINK; { /* make sure that there is a dashed line between sections, id is the name of the section: c columns s symbols l lines m more parameters */ struct LOC_nextsection V; V.LINK = LINK; V.id = id_; skipblanks(LINK->f); if (P_eoln(LINK->f->f)) nosection(&V); if (P_peek(LINK->f->f) != '*') nosection(&V); fscanf(LINK->f->f, "%*[^\n]"); getc(LINK->f->f); } /* nextsection */ /* end module xyplo.upgrade1 */ /* begin module xyplo.readparam */ Static Void readparam(f_, p) _TEXT *f_; param *p; { /* read the parameters from f */ struct LOC_readparam V; boolean moreparameters = false; /* more parameters will be following because a blank character is ending the line definitions */ boolean gotten; /* for finding the label strings */ Char symb; /* the symbol to plot or '.' to end reading symbols */ /* the number of symbols read so far, for informing the user about errors */ lines *ul; /* a pointer for constructing the user lines */ symbols *us; /* a pointer for constructing the user symbols */ _TEXT TEMP; line *WITH1; /*;writeln(output,'end of readparam');*/ V.f = f_; V.checkout = true; /* be optimistic */ if (*V.f->name != '\0') { if (V.f->f != NULL) V.f->f = freopen(V.f->name, "r", V.f->f); else V.f->f = fopen(V.f->name, "r"); } else rewind(V.f->f); if (V.f->f == NULL) _EscIO2(FileNotFound, V.f->name); RESETBUF(V.f->f, Char); /* read in graph shift amounts */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &p->xzero); num(V.f, &V); fscanf(V.f->f, "%lg%*[^\n]", &p->yzero); getc(V.f->f); /* read in max and min for x */ p->setx = false; t_(&V); if (!P_eoln(V.f->f)) { if (P_peek(V.f->f) == 'x') { p->setx = true; skipnonblanks(V.f); t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &p->xmin); num(V.f, &V); fscanf(V.f->f, "%lg", &p->xmax); if (p->xmin > p->xmax) { printf("xmin cannot exceed xmax\n"); halt(); } } } t_(&V); fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); if (!p->setx) { p->xmin = LONG_MAX; p->xmax = -LONG_MAX; } /* read in max and min for y */ p->sety = false; t_(&V); if (!P_eoln(V.f->f)) { if (P_peek(V.f->f) == 'y') { p->sety = true; skipnonblanks(V.f); t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &p->ymin); num(V.f, &V); fscanf(V.f->f, "%lg", &p->ymax); if (p->ymin > p->ymax) { printf("ymin cannot exceed ymax\n"); halt(); } } } t_(&V); fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); if (!p->sety) { p->ymin = LONG_MAX; p->ymax = -LONG_MAX; } /* read in the xinterval and yinterval, and stay on the line */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->xinterval); num(V.f, &V); fscanf(V.f->f, "%ld", &p->yinterval); if (p->xinterval <= 0 || p->yinterval <= 0) { printf("x and y interval must be positive\n"); halt(); } if (p->xinterval >= maxinterval || p->yinterval >= maxinterval) { printf("x and y interval must be less than maxinterval (=%ld)\n", (long)maxinterval); printf("You really can't read a graph with that many intervals!!\n"); halt(); } /* continue the same line to read in the xintervals and yintervals */ if (softnumbertest(V.f, &V)) { fscanf(V.f->f, "%ld", &p->xsubintervals); if (p->xsubintervals <= 0) { printf("xsubintervals must be positive\n"); halt(); } if (softnumbertest(V.f, &V)) { fscanf(V.f->f, "%ld", &p->ysubintervals); if (p->ysubintervals <= 0) { printf("ysubintervals must be positive\n"); halt(); } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); } else { printf("You may now define the number of y subtic marks\n"); TEMP.f = stdout; *TEMP.name = '\0'; bar(&TEMP, '-'); } } else { printf("You may now define the number of x and y subtic marks\n"); TEMP.f = stdout; *TEMP.name = '\0'; bar(&TEMP, '-'); } if (p->xsubintervals >= maxinterval || p->ysubintervals >= maxinterval) { printf("x and y subintervals must be less than maxinterval (=%ld)\n", (long)maxinterval); printf("You really can't read a graph with that many intervals!!\n"); halt(); } /* read in the xwidth and ywidth */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->xwidth); num(V.f, &V); fscanf(V.f->f, "%ld%*[^\n]", &p->ywidth); getc(V.f->f); if (p->xwidth <= 0 || p->ywidth <= 0) { printf("x and y number widths must be positive\n"); halt(); } /* read in the xdecimal and ydecimal */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->xdecimal); num(V.f, &V); fscanf(V.f->f, "%ld%*[^\n]", &p->ydecimal); getc(V.f->f); if (p->xdecimal < 0 || p->ydecimal < 0) { printf("x and y decimal places must be zero or positive\n"); halt(); } /* check that the x widths and decimal places are sensible */ if (p->xdecimal > 0 && p->xwidth < p->xdecimal + 2) { printf("The width of numbers on the axis (xwidth) must be at least two larger\n"); printf( "than the number of decimal places (xdecimal), to provide for the sign and\n"); printf("decimal place.\n"); halt(); } /* check that the y widths and decimal places are sensible */ if (p->ydecimal > 0 && p->ywidth < p->ydecimal + 2) { printf("The width of numbers on the axis (ywidth) must be at least two larger\n"); printf( "than the number of decimal places (ydecimal), to provide for the sign and\n"); printf("decimal place.\n"); halt(); } /* read in the xsize and ysize */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &p->xsize); num(V.f, &V); fscanf(V.f->f, "%lg%*[^\n]", &p->ysize); getc(V.f->f); if (p->xsize < 0 || p->ysize <= 0) { printf("x and y size must be positive\n"); halt(); } /* get the labels for the axes */ getstring(V.f, &p->xlabel, &gotten); if (!gotten) { printf("cannot find xlabel\n"); halt(); } getstring(V.f, &p->ylabel, &gotten); if (!gotten) { printf("cannot find ylabel\n"); halt(); } /* define cross hairs, and set which axis to plot */ p->crosshairs = false; t_(&V); if (!P_eoln(V.f->f)) { if ((P_peek(V.f->f) == 'c') | (P_peek(V.f->f) == 'X') | (P_peek(V.f->f) == 'Y') | (P_peek(V.f->f) == 'N')) p->crosshairs = true; /* the default is true */ p->doXaxis = true; p->doYaxis = true; /* turn off the other axis */ if ((P_peek(V.f->f) == 'x') | (P_peek(V.f->f) == 'X')) p->doYaxis = false; if ((P_peek(V.f->f) == 'y') | (P_peek(V.f->f) == 'Y')) p->doXaxis = false; if ((P_peek(V.f->f) == 'n') | (P_peek(V.f->f) == 'N')) { p->doXaxis = false; p->doYaxis = false; } if (P_peek(V.f->f) == 'i') p->doaxisline = false; else p->doaxisline = true; } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); /* make type of x axis */ p->logxscale = false; p->logxnormal = false; t_(&V); if (!P_eoln(V.f->f)) { if ((P_peek(V.f->f) == 'l') | (P_peek(V.f->f) == 'L')) { p->logxscale = true; if (P_peek(V.f->f) == 'L') p->logxnormal = true; skipnonblanks(V.f); num(V.f, &V); fscanf(V.f->f, "%lg", &p->xbase); if (p->xbase <= 1.0) { printf("log x base must be > 1\n"); halt(); } p->logxbase = log(p->xbase); } } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); /* make type of y axis */ p->logyscale = false; p->logynormal = false; t_(&V); if (!P_eoln(V.f->f)) { if ((P_peek(V.f->f) == 'l') | (P_peek(V.f->f) == 'L')) { p->logyscale = true; if (P_peek(V.f->f) == 'L') p->logynormal = true; skipnonblanks(V.f); num(V.f, &V); fscanf(V.f->f, "%lg", &p->ybase); if (p->ybase <= 1.0) { printf("log y base must be > 1\n"); halt(); } p->logybase = log(p->ybase); } } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); /* skip the line between sections of the file */ nextsection('c', &V); /* define the columns to read data from */ /* read the symbol columns */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->xcolumn); num(V.f, &V); fscanf(V.f->f, "%ld", &p->ycolumn); fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); if (p->xcolumn <= 0 || p->ycolumn <= 0) { printf( " in xyplop, the defined locations of both x and y columns must be positive\n"); halt(); } t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->scolumn); fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->xscolumn); num(V.f, &V); fscanf(V.f->f, "%ld", &p->yscolumn); fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->hucolumn); /* hue column */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->sacolumn); /* saturation column */ t_(&V); num(V.f, &V); fscanf(V.f->f, "%ld", &p->brcolumn); /* brightness column */ fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); testcolumns(p->xcolumn, p->ycolumn, p->scolumn, p->xscolumn, p->yscolumn, p->hucolumn, p->sacolumn, p->brcolumn, &V); p->needscolumn = (p->scolumn > 0); p->needxscolumn = (p->xscolumn > 0); p->needyscolumn = (p->yscolumn > 0); p->needcocolumn = (p->hucolumn > 0 || p->sacolumn > 0 || p->brcolumn > 0); /* Make sure that the rectangles have a size that is not likely to be requested, so that the proper size will be set on the first attempt to make a rectangle. */ p->xrect = -LONG_MAX; p->yrect = -LONG_MAX; V.symbolcount = 1; /* skip the line between sections of the file */ nextsection('s', &V); /* define all of the symbols */ t_(&V); fscanf(V.f->f, "%c%*[^\n]", &symb); getc(V.f->f); if (symb == '\n') symb = ' '; if (symb == '.') { printf("you must define at least one symbol\n"); halt(); } p->usersymbols = (symbols *)Malloc(sizeof(symbols)); us = p->usersymbols; p->startrectangles = false; do { /*writeln(output,'reading symbols');*/ readsymbol(V.f, symb, p, &us->s); V.symbolcount++; /* skip the line between sections of the file */ nextsection('s', &V); t_(&V); fscanf(V.f->f, "%c%*[^\n]", &symb); getc(V.f->f); if (symb == '\n') symb = ' '; if (symb != '.') { /* make the next one */ us->next = (symbols *)Malloc(sizeof(symbols)); us = us->next; } else us->next = NULL; } while (symb != '.'); /* skip the line between sections of the file */ nextsection('l', &V); /*writeln(output,'user defined lines');*/ /* read in user defined lines */ p->userlines = NULL; /* set nil no matter what */ if (!BUFEOF(V.f->f)) { if (P_peek(V.f->f) == ' ') moreparameters = true; else { p->userlines = (lines *)Malloc(sizeof(lines)); ul = p->userlines; while (!BUFEOF(V.f->f) && !moreparameters) { WITH1 = &ul->l; if (P_eoln(V.f->f)) { fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); continue; } if (P_peek(V.f->f) == '*') { fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); continue; } if (P_peek(V.f->f) == ' ') { moreparameters = true; break; /* p2c: xyplo.p: Note: Deleting unreachable code [255] */ } t_(&V); WITH1->linetype = getc(V.f->f); if (WITH1->linetype == '\n') WITH1->linetype = ' '; if (WITH1->linetype != 'n' && WITH1->linetype != 'i' && WITH1->linetype != '-' && WITH1->linetype != '.' && WITH1->linetype != 'l') { printf("user defined line type must be one of \"lin.-\"\n"); printf("you had \"%c\"\n", WITH1->linetype); halt(); } t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &WITH1->m); t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &WITH1->b); if (WITH1->linetype == '-' || WITH1->linetype == '.') { t_(&V); num(V.f, &V); fscanf(V.f->f, "%lg", &WITH1->linesize); } else WITH1->linesize = 0.0; fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); if ((!BUFEOF(V.f->f)) & (P_peek(V.f->f) != ' ')) { if (!P_eoln(V.f->f)) { if (P_peek(V.f->f) != '*') { ul->next = (lines *)Malloc(sizeof(lines)); ul = ul->next; } } } else ul->next = NULL; } } } /*writeln(output,'inside user defined lines');*/ /* read additional parameters ("more") */ /* first, set defaults */ p->llx = defaultllx; p->ury = defaultury; p->urx = defaulturx; p->lly = defaultlly; p->edgecontrol = 'p'; p->edgeleft = 1.5; p->edgeright = 0.5; p->edgelow = 1.5; p->edgehigh = 1.0; p->parameterversion = 0.0; if (moreparameters) { /* skip the line between sections of the file */ nextsection('m', &V); p->edgecontrol = getc(V.f->f); if (p->edgecontrol == '\n') p->edgecontrol = ' '; if (p->edgecontrol == 'p') { cn(&V); fscanf(V.f->f, "%lg", &p->edgeleft); cn(&V); fscanf(V.f->f, "%lg", &p->edgeright); cn(&V); fscanf(V.f->f, "%lg", &p->edgelow); cn(&V); fscanf(V.f->f, "%lg", &p->edgehigh); /* writeln(output,'xsize',xsize:11:5); writeln(output,'ysize',ysize:11:5); writeln(output,'defscale',defscale:11:5); */ p->llx = (long)floor((p->xzero - p->edgeleft) * defscale + 0.5); p->lly = (long)floor((p->yzero - p->edgelow) * defscale + 0.5); p->urx = (long)floor((p->xzero + p->xsize + p->edgeright) * defscale + 0.5); p->ury = (long)floor((p->yzero + p->ysize + p->edgehigh) * defscale + 0.5); } fscanf(V.f->f, "%*[^\n]"); getc(V.f->f); cn(&V); fscanf(V.f->f, "%lg%*[^\n]", &p->parameterversion); getc(V.f->f); return; } printf("*******************************************************\n"); printf("* more parameters are now available, see *\n"); printf("* http://www.lecb.ncifcrf.gov/~toms/delila/xyplo.html *\n"); printf("*******************************************************\n"); printf(" They are being added to the parameter file ***********\n"); upgrade1(&xyplop, *p); } /* end module xyplo.readparam */ /* begin module xyplo.loglabel */ Static Void loglabel(f, s, base, justification) _TEXT *f; string s; double base; Char justification; { /* graph the string s to file f as the log to the base given in base */ long i; /* index */ string n; /* to modify the string */ /* write(f,'log\d',trunc(base):1'\u'); writestring(f,s); write(f,')'); */ clearstring(&n); n.letters[0] = 'l'; n.letters[1] = 'o'; n.letters[2] = 'g'; n.length = 3; if (base < 10) stringinteger((long)base, &n, 1L, false); else stringinteger((long)base, &n, 2L, false); n.length++; n.letters[n.length - 1] = '{'; for (i = 0; i < s.length; i++) n.letters[i + n.length] = s.letters[i]; n.length += s.length + 1; /* for the above and the below */ n.letters[n.length - 1] = '}'; graphstring(f, &n, justification); } /* end module xyplo.loglabel */ /* begin module xyplo.logstring */ Static Void logstring(f, s, base) _TEXT *f; string s; double base; { /* write the string s to file f as the log to the base given in base */ fprintf(f->f, "log%ld(", (long)base); writestring(f, &s); putc(')', f->f); } /* end module xyplo.logstring */ /* begin module xyplo.comment */ Static Void comment(f) _TEXT *f; { /* put a PostScript comment start out to file f */ fprintf(f->f, "%% "); } /* end module xyplo.comment */ /* begin module xyplo.writeparam */ Static Void writeparam(f, p) _TEXT *f; param p; { /* write all the values in p out to file f */ symbols *us; /* a pointer to the user symbols */ lines *ul; /* a pointer to the user lines */ symbol *WITH; line *WITH1; /* writeln(f,'.sp 1'); (@ give room on output @) */ /* do with p */ comment(f); fprintf(f->f, "user specified parameters:\n"); comment(f); bar(f, '*'); /* ************************** */ comment(f); bar(f, '*'); /* ************************** */ comment(f); if (p.setx) putc('x', f->f); else putc('z', f->f); if (p.logxscale && !p.logxnormal) fprintf(f->f, " %*.*f %*.*f minimum and maximum for x axis (log scale)", (int)p.xwidth, (int)(p.xdecimal + 1), exp(p.logxbase * p.xmin), (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), exp(p.logxbase * p.xmax)); else { fprintf(f->f, " %*.*f %*.*f minimum and maximum for x axis", (int)p.xwidth, (int)(p.xdecimal + 1), p.xmin, (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), p.xmax); if (p.logxnormal) fprintf(f->f, " (log scale)"); } if (p.setx) fprintf(f->f, " set by user\n"); else fprintf(f->f, " determined from data\n"); comment(f); if (p.sety) putc('y', f->f); else putc('z', f->f); if (p.logyscale && !p.logynormal) fprintf(f->f, " %*.*f %*.*f minimum and maximum for y axis (log scale) ", (int)p.ywidth, (int)(p.ydecimal + 1), exp(p.logybase * p.ymin), (int)(p.ywidth + dsafety), (int)(p.ydecimal + dsafety + 1), exp(p.logybase * p.ymax)); else { fprintf(f->f, " %*.*f %*.*f minimum and maximum for y axis ", (int)p.ywidth, (int)(p.ydecimal + 1), p.ymin, (int)(p.ywidth + dsafety), (int)(p.ydecimal + dsafety + 1), p.ymax); if (p.logynormal) fprintf(f->f, "(log scale)"); } if (p.sety) fprintf(f->f, " set by user\n"); else fprintf(f->f, " determined from data\n"); comment(f); fprintf(f->f, "%10ld%10ld number of intervals on x and y to plot\n", p.xinterval, p.yinterval); comment(f); fprintf(f->f, "%10ld%10ld width of numbers on graph in characters\n", p.xwidth, p.ywidth); comment(f); fprintf(f->f, "%10ld%10ld number of decimal places for numbers\n", p.xdecimal, p.ydecimal); comment(f); fprintf(f->f, "%10.3f%10.3f size of axes in cm\n", p.xsize, p.ysize); comment(f); writestring(f, &p.xlabel); fprintf(f->f, " the x axis label\n"); comment(f); writestring(f, &p.ylabel); fprintf(f->f, " the y axis label\n"); comment(f); if (!p.crosshairs) fprintf(f->f, "no "); fprintf(f->f, "cross hairs put on zero of x and y\n"); comment(f); if (p.logxscale) { if (p.logxnormal) putc('L', f->f); else putc('l', f->f); fprintf(f->f, " %5.3f log scale on x axis", p.xbase); if (p.logxnormal) fprintf(f->f, " (normal numbers on scale)\n"); else fprintf(f->f, " (log of numbers on scale)\n"); } else fprintf(f->f, "no log scale on x axis\n"); comment(f); if (p.logyscale) { if (p.logynormal) putc('L', f->f); else putc('l', f->f); fprintf(f->f, " %5.3f log scale on y axis", p.ybase); if (p.logynormal) fprintf(f->f, " (normal numbers on scale)\n"); else fprintf(f->f, " (log of numbers on scale)\n"); } else fprintf(f->f, "no log scale on y axis\n"); /* comment(f); if logyscale then writeln(f,'l ',ybase:5:3, ' log scale on y axis') else writeln(f,'no log scale on y axis'); */ comment(f); fprintf(f->f, "* column choices: "); bar(f, '*'); /* ************************** */ comment(f); fprintf(f->f, "%5ld%5ld columns of input chosen for x and y respectively\n", p.xcolumn, p.ycolumn); comment(f); fprintf(f->f, "%5ld%5c column that determines symbols\n", p.scolumn, ' '); comment(f); fprintf(f->f, "%5ld%5ld columns that determine symbol size\n", p.xscolumn, p.yscolumn); comment(f); fprintf(f->f, "%5ld%5ld%5ld columns that determine color\n", p.hucolumn, p.sacolumn, p.brcolumn); comment(f); fprintf(f->f, "* user defined symbols: "); bar(f, '*'); /* ************************** */ us = p.usersymbols; while (us != NULL) { WITH = &us->s; WITH1 = &us->s.l; comment(f); fprintf(f->f, "%c%12c symbol-to-plot:c(circle)bd(dotted box)x+Ifgpr(rectangle)\n", WITH->symboltoplot, ' '); comment(f); writestring(f, &WITH->symbolflag); fprintf(f->f, "%12c character string in xyin to indicate this symbol\n", ' '); comment(f); fprintf(f->f, "%1.3f%8c symbol x size in cm\n", WITH->symbolxsize, ' '); comment(f); fprintf(f->f, "%1.3f%8c symbol y size in cm\n", WITH->symbolysize, ' '); comment(f); if (WITH->doconnection) fprintf(f->f, "connected %c %5.3f the symbols are connected by lines\n", WITH->connecttype, WITH->connectsize); else fprintf(f->f, "no connected lines\n"); comment(f); fprintf(f->f, " %c", WITH1->linetype); /* the space protects the character from troff */ if (WITH1->linetype == '-' || WITH1->linetype == '.') fprintf(f->f, " %5.3f", WITH1->linesize); fprintf(f->f, " l=line .=dotted -=dashed i=invisible n=no line"); if (WITH1->linetype == '-' || WITH1->linetype == '.') fprintf(f->f, "; spacing in cm"); putc('\n', f->f); comment(f); bar(f, '*'); /* ************************** */ us = us->next; } comment(f); fprintf(f->f, ".\n"); /* a period ends the section */ comment(f); fprintf(f->f, "* user defined lines: "); bar(f, '*'); /* ************************** */ ul = p.userlines; while (ul != NULL) { WITH1 = &ul->l; comment(f); fprintf(f->f, " %c", WITH1->linetype); /* the space protects the character from troff */ /* writeln(output,'reading userlines'); halt; {zzz} */ fprintf(f->f, " %*.*f", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->m); fprintf(f->f, " %*.*f", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->b); fprintf(f->f, " %1.3f", WITH1->linesize); fprintf(f->f, " user defined line: linetype, m, b, linesize\n"); ul = ul->next; } comment(f); if (p.userlines == NULL) fprintf(f->f, " (none)\n"); comment(f); bar(f, '*'); /* ************************** */ comment(f); bar(f, '*'); /* ************************** */ comment(f); fprintf(f->f, " %c", p.edgecontrol); fprintf(f->f, " %*.*f", pwid, pdec, p.edgeleft); fprintf(f->f, " %*.*f", pwid, pdec, p.edgeright); fprintf(f->f, " %*.*f", pwid, pdec, p.edgelow); fprintf(f->f, " %*.*f", pwid, pdec, p.edgehigh); fprintf(f->f, " edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm\n"); comment(f); fprintf(f->f, " %4.2f version of xyplop\n", p.parameterversion); /*zzz*/ comment(f); } /* writeparam */ Local double inverseFisher(z) double z; { /* compute the inverse Fisher function http://sportsci.org/resource/stats/sscorr.html#fisherz */ return ((exp(2 * z) - 1) / (exp(2 * z) + 1)); } /* inverseFisher */ /* end module xyplo.writeparam */ /* begin module xyplo.regressiondata */ Static Void regressiondata(f, p) _TEXT *f; param p; { /* give the data on the regression lines */ symbols *us; /* pointer to the user symbols */ double z; /* Fisher's z' */ symbol *WITH; line *WITH1; /* writeln(f,'.KS'); (@ start a keep, so that the lines stay together if there is a page break */ /* writeln(f,'.nf'); (@ stop filling */ /*writeln(output,'in regressiondata');*/ us = p.usersymbols; while (us != NULL) { WITH = &us->s; if (WITH->doline) { WITH1 = &WITH->l; /* writeln(f,'.sp 1'); (@ give room on output */ comment(f); putc('\n', f->f); comment(f); fprintf(f->f, "Data on the regression line for symbol \"%c\" ", WITH->symboltoplot); fprintf(f->f, "with flag \""); writestring(f, &WITH->symbolflag); fprintf(f->f, "\":\n"); comment(f); fprintf(f->f, "%ld data points\n", WITH1->n); comment(f); fprintf(f->f, "mean x = %*.*f and y = %*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->ex, (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->ey); comment(f); fprintf(f->f, "variance x = %*.*f and y = %*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->varx, (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->vary); comment(f); fprintf(f->f, " r = %*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->r); comment(f); fprintf(f->f, "r^2 = %*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->r * WITH1->r); /* new as of 2006 Sep 7: */ comment(f); fprintf(f->f, "Fisher's z' = "); if (WITH1->r > -1.0 && WITH1->r < 1.0) { z = 0.5 * (log(1 + WITH1->r) - log(1 - WITH1->r)); fprintf(f->f, "%*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), z); comment(f); if (WITH1->n > 3) { fprintf(f->f, "95%% confidence limits on correlation r:"); fprintf(f->f, " %*.*f", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), inverseFisher(z - 1.96 / sqrt(WITH1->n - 3.0))); fprintf(f->f, " to %*.*f", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), inverseFisher(z + 1.96 / sqrt(WITH1->n - 3.0))); } else fprintf(f->f, "(no confidence limits, n < 3)"); putc('\n', f->f); } else fprintf(f->f, " (undefined)\n"); comment(f); fprintf(f->f, "covariance = %*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->covxy); comment(f); fprintf(f->f, "regression: "); if (p.logyscale) logstring(f, p.ylabel, p.ybase); else writestring(f, &p.ylabel); fprintf(f->f, " = %*.*f * ", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->m); if (p.logxscale) { /* logstring(f,xlabel,xbase) */ logstring(f, p.xlabel, p.xbase); } else writestring(f, &p.xlabel); fprintf(f->f, " + %*.*f\n", (int)(p.xwidth + dsafety), (int)(p.xdecimal + dsafety + 1), WITH1->b); } us = us->next; } /* writeln(f,'.KE'); (@ end the keep @) writeln(f,'.fi'); (@ start filling again @) writeln(f,'.sp 1'); (@ give room on output @) */ } /* end module xyplo.regressiondata */ /* begin module xyplo.skipcopy */ Static Void skipcopy(infile, outfile, copy, linenumber) _TEXT *infile, *outfile; boolean copy; long *linenumber; { /* skip and copy from infile to outfile until no more asterisks found, if copy is true. if copy is false, just skip. return the current line number of the file */ boolean copying = true; /* continue copying */ *linenumber = 0; if (*infile->name != '\0') { if (infile->f != NULL) infile->f = freopen(infile->name, "r", infile->f); else infile->f = fopen(infile->name, "r"); } else rewind(infile->f); if (infile->f == NULL) _EscIO2(FileNotFound, infile->name); RESETBUF(infile->f, Char); if (BUFEOF(infile->f)) { printf("skipcopy: xyin file is empty\n"); halt(); } while (copying) { /*writeln(output,'skipcopy: while copying...');*/ if (BUFEOF(infile->f)) { copying = false; break; } if (P_eoln(infile->f)) { copying = false; break; /* p2c: xyplo.p: Note: Deleting unreachable code [255] */ } if (!((P_peek(infile->f) == '*') | (P_peek(infile->f) == '#'))) { copying = false; break; } if (copy) { fprintf(outfile->f, "%% "); /* PostScript Comment */ copyaline(infile, outfile); } else { fscanf(infile->f, "%*[^\n]"); getc(infile->f); } (*linenumber)++; } } /* Local variables for grabdata: */ struct LOC_grabdata { _TEXT *infile; param p; double *x, *y, *xs, *ys, *hue, *saturation, *brightness; Char *flag; string *flagstring; long *linenumber, column; /* the column of the datum */ boolean droppoint; /* mechanism for dropping non-positive points on log scale */ boolean gotx, goty; /* we have gotten the x and y coordinates */ boolean gotxs, gotys; /* we have gotten the x and y symbol sizes */ boolean gots; /* we got the symbol to plot */ boolean gothu, gotsa, gotbr; /* got the color columns */ boolean satisfied; /* true when we have data for all regressions on the current line */ double xrawdata, yrawdata; /* raw x and y values before conversion to logs */ } ; Local Void die(LINK) struct LOC_grabdata *LINK; { /* to die */ /* tell the user where we were and stop the program */ printf("at line %ld of data (INCLUDING * lines)\n", *LINK->linenumber); halt(); } /* die */ Local Void grab(LINK) struct LOC_grabdata *LINK; { long c; /* index to the flagstring for removing underscore characters */ string *WITH; long FORLIM; /*writeln(output,'in grabdata');*/ LINK->droppoint = false; *LINK->hue = 0.0; *LINK->saturation = 0.0; *LINK->brightness = 0.0; LINK->column = 0; LINK->satisfied = false; LINK->gots = !LINK->p.needscolumn; LINK->gotx = false; LINK->goty = false; LINK->gotxs = !LINK->p.needxscolumn; LINK->gotys = !LINK->p.needyscolumn; LINK->gothu = !LINK->p.needcocolumn; LINK->gotsa = !LINK->p.needcocolumn; LINK->gotbr = !LINK->p.needcocolumn; *LINK->flag = ' '; /* control the value of this */ /*writeln(output,'needxscolumn=',p.needxscolumn);*/ /*writeln(output,'needyscolumn=',p.needyscolumn);*/ clearstring(LINK->flagstring); /* read in the column data */ while (!LINK->satisfied) { LINK->column++; skipblanks(LINK->infile); /* always move to start of column */ if (P_eoln(LINK->infile->f)) { printf("found end of line before all data columns were found\n"); if (!LINK->gots) printf("missing symbol flag column\n"); if (!LINK->gotx) printf("missing x data column\n"); if (!LINK->goty) printf("missing y data column\n"); if (!LINK->gotxs) printf("missing x symbol size column\n"); if (!LINK->gotys) printf("missing y symbol size column\n"); if (!LINK->gothu) printf("missing hue column\n"); if (!LINK->gotsa) printf("missing saturation column\n"); if (!LINK->gotbr) printf("missing brightness column\n"); die(LINK); } /*writeln(output,'not satisfied next column = ',column:1);*/ /*writeln(output,'gots,gotx,goty,gotxs,gotys',gots,gotx,goty,gotxs,gotys);*/ /*writeln(output,'next char: ',infile^);*/ if (LINK->column == LINK->p.xcolumn) { fscanf(LINK->infile->f, "%lg", LINK->x); if (LINK->p.logxscale) { if (*LINK->x <= 0.0) { tellwarning(); fprintf(warnings.f, "WARNING: all x values must be positive for logxscale\n"); fprintf(warnings.f, "The value you have is %10.5f\n", *LINK->x); fprintf(warnings.f, "IT WAS DROPPED FROM THE DATA SET\n"); LINK->droppoint = true; } else { LINK->xrawdata = *LINK->x; *LINK->x = log(*LINK->x) / LINK->p.logxbase; LINK->droppoint = false; } } LINK->gotx = true; } else if (LINK->column == LINK->p.ycolumn) { fscanf(LINK->infile->f, "%lg", LINK->y); if (LINK->p.logyscale) { if (*LINK->y <= 0.0) { /* be more lenient about this problem!! */ tellwarning(); fprintf(warnings.f, "WARNING: all y values must be positive for logyscale\n"); fprintf(warnings.f, "At x = %10.5f", *LINK->x); fprintf(warnings.f, " the value you have is y = %10.5f\n", *LINK->y); fprintf(warnings.f, "IT WAS DROPPED FROM THE DATA SET\n"); LINK->droppoint = true; } else { LINK->yrawdata = *LINK->y; *LINK->y = log(*LINK->y) / LINK->p.logybase; LINK->droppoint = false; } } LINK->goty = true; } else if (LINK->column == LINK->p.xscolumn) { if (LINK->p.needxscolumn) { fscanf(LINK->infile->f, "%lg", LINK->xs); if (LINK->p.logxscale) { if (*LINK->xs <= 0.0) { printf("all x values for symbol size must be positive for logxscale\n"); printf("The value you have is %10.5f\n", *LINK->xs); die(LINK); } /*see notes below for ys xs := ln(xs)/p.logxbase; */ } LINK->gotxs = true; } else skipnonblanks(LINK->infile); } else if (LINK->column == LINK->p.yscolumn) { if (LINK->p.needyscolumn) { fscanf(LINK->infile->f, "%lg", LINK->ys); if (LINK->p.logyscale) { if (*LINK->ys <= 0.0) { printf("all y values for symbol size must be positive for logyscale\n"); printf("The value you have is %10.5f\n", *LINK->ys); die(LINK); } /*according to calc.p procedure logrange, loga.estimate := ln(a.estimate)/ln(base); but loga.error := a.error/ a.estimate; So this should be ys := ys/y. Unfortunately we need the original value of y and we don't have that yet. So we must pospone the calculation until the entire data line has been obtained. It's wrong to do this here: ys := ln(ys)/p.logybase; It's right to do this later: ys := ys/yrawdata; */ } LINK->gotys = true; } else skipnonblanks(LINK->infile); } /* color columns */ else if (LINK->column == LINK->p.hucolumn) { if (LINK->p.needcocolumn) { fscanf(LINK->infile->f, "%lg", LINK->hue); LINK->gothu = true; } else { *LINK->hue = 0.0; skipnonblanks(LINK->infile); } } else if (LINK->column == LINK->p.sacolumn) { if (LINK->p.needcocolumn) { fscanf(LINK->infile->f, "%lg", LINK->saturation); LINK->gotsa = true; } else { *LINK->saturation = 0.0; skipnonblanks(LINK->infile); } } else if (LINK->column == LINK->p.brcolumn) { if (LINK->p.needcocolumn) { fscanf(LINK->infile->f, "%lg", LINK->brightness); LINK->gotbr = true; } else { *LINK->brightness = 0.0; skipnonblanks(LINK->infile); } } else if (LINK->column == LINK->p.scolumn) { if (LINK->p.needscolumn) { /* write(output,'grabdata: BEFORE gettoken flagstring = "'); writestring(output,flagstring); writeln(output,'"'); */ gettoken(LINK->infile, LINK->flag, LINK->flagstring, &LINK->gots); /* write(output,'grabdata: AFTER gettoken flagstring = "'); writestring(output,flagstring); writeln(output,'"'); */ /* now convert the underscores into blank characters */ WITH = LINK->flagstring; FORLIM = WITH->length; for (c = 0; c < FORLIM; c++) { if (WITH->letters[c] == '_') WITH->letters[c] = ' '; } } else skipnonblanks(LINK->infile); } else skipnonblanks(LINK->infile); /* skip the column */ LINK->satisfied = (LINK->gotx && LINK->goty && LINK->gotxs && LINK->gotys && LINK->gots && LINK->gothu && LINK->gotsa && LINK->gotbr); } if (LINK->p.needxscolumn && LINK->p.logxscale) *LINK->xs /= LINK->xrawdata; if (LINK->p.needyscolumn && LINK->p.logyscale) *LINK->ys /= LINK->yrawdata; fscanf(LINK->infile->f, "%*[^\n]"); getc(LINK->infile->f); /*write(output,'x,y=',x:4:2,' ',y:4:2,' flag=',flag,' ');*/ /*writeln(output,'xs,ys=',xs:10:8,' ',ys:10:8);*/ } /* end module xyplo.skipcopy */ /* begin module xyplo.grabdata */ Static Void grabdata(infile_, p_, x_, y_, xs_, ys_, hue_, saturation_, brightness_, flag_, flagstring_, linenumber_, gotdata) _TEXT *infile_; param p_; double *x_, *y_, *xs_, *ys_, *hue_, *saturation_, *brightness_; Char *flag_; string *flagstring_; long *linenumber_; boolean *gotdata; { /* obtain the x and y data points, the x size and y size (xs, ys) of the symbol (if relevant) and the symbol s from one line of the infile. the flag for the kind of the symbol to plot is one character in flag, while the entire string is in flagstring. The color parameters are returned in hue, saturation and brightness. Keep track of the linenumber in case something goes wrong. The routine skips blank lines and lines that begin with an "*". If no data were found, gotdata is false. */ struct LOC_grabdata V; boolean done = false; /* done reading a data line (or eof) */ V.infile = infile_; V.p = p_; V.x = x_; V.y = y_; V.xs = xs_; V.ys = ys_; V.hue = hue_; V.saturation = saturation_; V.brightness = brightness_; V.flag = flag_; V.flagstring = flagstring_; V.linenumber = linenumber_; *gotdata = false; while (!done) { if (BUFEOF(V.infile->f)) { /* close shop on end of file */ done = true; break; } if (P_eoln(V.infile->f)) { /* skip blank lines */ fscanf(V.infile->f, "%*[^\n]"); getc(V.infile->f); (*V.linenumber)++; continue; } if ((P_peek(V.infile->f) == '*') | (P_peek(V.infile->f) == '#')) { /* skip comment lines */ fscanf(V.infile->f, "%*[^\n]"); getc(V.infile->f); (*V.linenumber)++; } else { grab(&V); *gotdata = true; done = true; /* handle actual data */ } } if (V.droppoint) *gotdata = false; /* write(output,'END grabdata: flagstring = "'); writestring(output,flagstring); writeln(output,'"'); */ } /* end module xyplo.grabdata */ /* begin module xyplo.bounds */ Static Void bounds(infile, outfile, p) _TEXT *infile, *outfile; param *p; { /* determine the bounds of the graph, and gather data and do the liner regressions. the procedure uses skipcopy to get to the data and copy it to the outfile. The procedure makes a pass through the data, and so does these three things all at once. */ boolean done; /* done with a loop */ long linenumber; /* the current line being read */ symbols *us; /* a pointer to the user symbols */ boolean noregressions; /* no regressions were done for the data read. that is, there was no symbol identified for the data. this means that we must check to see if there is a 'g' symbol */ /* some variables for reading */ double x, y; /* x and y coordinates */ double xs, ys; /* x and y sizes of the symbol */ double hu, sa, br; /* hue, saturation and brightness of the symbol */ Char flag; /* the flag for the symbol to use */ string flagstring; /* the entire flag string for the symbol to use */ boolean gotdata; /* data found */ symbol *WITH; line *WITH1; _TEXT TEMP; /*writeln(output,'in bounds');*/ skipcopy(infile, outfile, true, &linenumber); if (p->setx) { if (p->logxscale && !p->logxnormal) { if (p->xmin <= 0 || p->xmax <= 0) { printf("xmin and xmax must be positive for log scale\n"); halt(); } p->xmin = log(p->xmin) / p->logxbase; p->xmax = log(p->xmax) / p->logxbase; } } if (p->sety) { if (p->logyscale && !p->logynormal) { if (p->ymin <= 0 || p->ymax <= 0) { printf("ymin and ymax must be positive for log scale\n"); halt(); } p->ymin = log(p->ymin) / p->logybase; p->ymax = log(p->ymax) / p->logybase; } } /* if there was no request for setting the symbols, regression is done only on the first column. needscolumn determines whether or not there was a request, while doline of the first symbol tells if the line is to be regressed */ if (!p->needscolumn && p->usersymbols->s.doline) printf("regressing on first symbol only\n"); /* clear the regression variables */ us = p->usersymbols; while (us != NULL) { WITH = &us->s; if (WITH->doline) { WITH1 = &WITH->l; regress('c', x, y, &WITH1->sumx, &WITH1->sumy, &WITH1->sumxsqd, &WITH1->sumysqd, &WITH1->sumxy, &WITH1->ex, &WITH1->ey, &WITH1->varx, &WITH1->vary, &WITH1->covxy, &WITH1->r, &WITH1->m, &WITH1->b, &WITH1->n); } us = us->next; } /* read through the data to find bounds and tabulate regression */ while (!BUFEOF(infile->f)) { grabdata(infile, *p, &x, &y, &xs, &ys, &hu, &sa, &br, &flag, &flagstring, &linenumber, &gotdata); if (!gotdata) continue; /*writeln(output,'x,y=',x:4:2,' ',y:4:2,' flag=',flag);*/ if (!p->setx) { if (x < p->xmin) p->xmin = x; if (x > p->xmax) p->xmax = x; } if (!p->sety) { if (y < p->ymin) p->ymin = y; if (y > p->ymax) p->ymax = y; } if (!p->needscolumn) { /* do the regression into the first symbol only */ WITH1 = &p->usersymbols->s.l; regress('e', x, y, &WITH1->sumx, &WITH1->sumy, &WITH1->sumxsqd, &WITH1->sumysqd, &WITH1->sumxy, &WITH1->ex, &WITH1->ey, &WITH1->varx, &WITH1->vary, &WITH1->covxy, &WITH1->r, &WITH1->m, &WITH1->b, &WITH1->n); continue; } us = p->usersymbols; /* find the symbol */ while (us != NULL) { noregressions = true; WITH = &us->s; if (WITH->doline) { if (equalstring(flagstring, WITH->symbolflag)) { WITH1 = &WITH->l; regress('e', x, y, &WITH1->sumx, &WITH1->sumy, &WITH1->sumxsqd, &WITH1->sumysqd, &WITH1->sumxy, &WITH1->ex, &WITH1->ey, &WITH1->varx, &WITH1->vary, &WITH1->covxy, &WITH1->r, &WITH1->m, &WITH1->b, &WITH1->n); noregressions = false; } } us = us->next; } if (!noregressions) /* regress into the first 'g' symbol */ continue; /* look for a symbol that prints the flag itself as grabbag */ us = p->usersymbols; done = (us == NULL); while (!done) { done = (us->s.symboltoplot == 'g' || us->s.symboltoplot == 'G'); if (done) break; us = us->next; done = (us == NULL); } if (us != NULL) { WITH = &us->s; if (WITH->doline) { WITH1 = &WITH->l; regress('e', x, y, &WITH1->sumx, &WITH1->sumy, &WITH1->sumxsqd, &WITH1->sumysqd, &WITH1->sumxy, &WITH1->ex, &WITH1->ey, &WITH1->varx, &WITH1->vary, &WITH1->covxy, &WITH1->r, &WITH1->m, &WITH1->b, &WITH1->n); } } } /* regress into the appropriate symbol */ /* clear the regression variables */ us = p->usersymbols; while (us != NULL) { WITH = &us->s; if (WITH->doline) { WITH1 = &WITH->l; if (WITH1->n == 0) { printf("no data found for symbol %c", WITH->symboltoplot); printf(" (which has flag "); TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &WITH->symbolflag); printf("):"); printf(" no regression done\n"); WITH->doline = false; } else if (WITH1->n == 1) { printf("only one data point found for symbol %c", WITH->symboltoplot); printf(" (which has flag "); TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &WITH->symbolflag); printf("):"); printf(" no regression done\n"); WITH->doline = false; } else regress('r', x, y, &WITH1->sumx, &WITH1->sumy, &WITH1->sumxsqd, &WITH1->sumysqd, &WITH1->sumxy, &WITH1->ex, &WITH1->ey, &WITH1->varx, &WITH1->vary, &WITH1->covxy, &WITH1->r, &WITH1->m, &WITH1->b, &WITH1->n); } us = us->next; } /* given the bounds, we can now determine the scale factor */ if (p->xmax == p->xmin) { printf(" no variation to x range of graph\n"); p->xscale = 1.0; } else p->xscale = p->xsize / (p->xmax - p->xmin); if (p->ymax == p->ymin) { printf(" no variation to y range of graph\n"); p->yscale = 1.0; } else p->yscale = p->ysize / (p->ymax - p->ymin); } /* end module xyplo.bounds */ /* begin module xyplo.locate */ Static double locatex(p, x) param p; double x; { /* convert x to the correct plot location in cm */ return ((x - p.xmin) * p.xscale); /* +p.xzero */ } Static double locatey(p, y) param p; double y; { /* convert y to the correct plot location in cm */ return ((y - p.ymin) * p.yscale); /* +p.yzero */ } /* end module xyplo.locate */ /* begin module xyplo.crosshairs */ Static Void crosshairs(outfile, p) _TEXT *outfile; param p; { /* make the crosshairs of the graph */ /* put on the cross hairs */ if (!p.crosshairs) return; /* vertical crosshairs: */ if (p.xmin < 0.0 && p.xmax > 0.0) { movea(outfile, locatex(p, 0.0), locatey(p, p.ymin)); yaxis(outfile, p.doaxisline, locatey(p, p.ymax) - locatey(p, p.ymin), p.ymin, (p.ymax - p.ymin) / p.yinterval, p.ymax, (double)p.ysubintervals, -0.05, -0.2, 0.0, 0L, 0L, p.logynormal, p.logyscale, p.logybase); yaxis(outfile, p.doaxisline, p.ysize, p.ymin, (p.ymax - p.ymin) / p.yinterval, p.ymax, (double)p.ysubintervals, 0.05, -0.2, 0.0, 0L, 0L, p.logynormal, p.logyscale, p.logybase); } /* horizontal crosshairs: */ if (p.ymin >= 0.0 || p.ymax <= 0.0) return; movea(outfile, locatex(p, p.xmin), locatey(p, 0.0)); xaxis(outfile, p.doaxisline, locatex(p, p.xmax) - locatex(p, p.xmin), p.xmin, (p.xmax - p.xmin) / p.xinterval, p.xmax, (double)p.xsubintervals, -0.05, 0.0, -0.12, 0L, 0L, p.logxnormal, p.logxscale, p.logxbase); xaxis(outfile, p.doaxisline, p.xsize, p.xmin, (p.xmax - p.xmin) / p.xinterval, p.xmax, (double)p.xsubintervals, 0.05, 0.0, -0.12, 0L, 0L, p.logxnormal, p.logxscale, p.logxbase); } /* end module xyplo.crosshairs */ /* begin module xyplo.makexlable */ Static Void makexlabel(outfile, p) _TEXT *outfile; param p; { /* make the x label centered just below the x axis */ /* put the labels inside the picture: */ movea(outfile, locatex(p, (p.xmax - p.xmin) / 2.0 + p.xmin), locatey(p, p.ymin) - labelbelowx); if (!p.logxscale) { graphstring(outfile, &p.xlabel, 'c'); return; } if (p.logxnormal) { graphstring(outfile, &p.xlabel, 'l'); fprintf(outfile->f, "(, log scale) x\n"); } else loglabel(outfile, p.xlabel, p.xbase, 'c'); } /* end module xyplo.makexlable */ /* begin module xyplo.makeylable */ Static Void makeylabel(outfile, p) _TEXT *outfile; param p; { /* make the y label left justified above the y axis */ movea(outfile, locatex(p, p.xmin), locatey(p, p.ymax) + labelabovey); if (!p.logyscale) { graphstring(outfile, &p.ylabel, 'l'); return; } if (p.logynormal) { graphstring(outfile, &p.ylabel, 'l'); fprintf(outfile->f, "(, log scale) x\n"); } else loglabel(outfile, p.ylabel, p.ybase, 'l'); } /* end module xyplo.makeylable */ /* begin module xyplo.makeaxes */ Static Void makeaxes(outfile, p) _TEXT *outfile; param p; { /* make the axes of the graph */ movea(outfile, locatex(p, p.xmin), locatey(p, p.ymin)); if (p.doXaxis) /* names in xaxis: */ xaxis(outfile, p.doaxisline, locatex(p, p.xmax) - locatex(p, p.xmin), p.xmin, (p.xmax - p.xmin) / p.xinterval, p.xmax, (double)p.xsubintervals, Xticlength, XaxisXshift, XaxisYshift, p.xwidth, p.xdecimal, p.logxscale, p.logxnormal, p.logxbase); /* " */ /* axlength */ /* fromtic */ /* interval */ /* totic */ /* " */ /* length */ /* dx */ /* dy */ /* width */ /* decimal */ /* " */ /* " */ /* " */ if (p.doYaxis) yaxis(outfile, p.doaxisline, locatey(p, p.ymax) - locatey(p, p.ymin), p.ymin, (p.ymax - p.ymin) / p.yinterval, p.ymax, (double)p.ysubintervals, Yticlength, YaxisXshift, YaxisYshift, p.ywidth, p.ydecimal, p.logyscale, p.logynormal, p.logybase); } #define maxbad 10 /* maximum number of bad characters that can be handled */ /* Local variables for plotdata: */ struct LOC_plotdata { _TEXT *outfile, *warnings; param p; symbols *us; /* points to a user defined symbol */ /* variables for reading data from the file */ double x, y; /* x and y coordinates */ double xs, ys; /* x and y sizes of the symbol */ double hu, sa, br; /* hue, saturation and brightness of the symbol */ string flagstring; /* the entire flag string found in reading the data */ Char s; /* the symbol to use, converted from the flag */ } ; Local Void findsymbol(LINK) struct LOC_plotdata *LINK; { /* figure out which symbol to plot */ boolean done = false; /* done searching for grab bag */ symbol *WITH; _TEXT TEMP; /*writeln(output,'findsymbol');*/ /* we now have the flag, now find out which symbol it corresponds to */ LINK->us = LINK->p.usersymbols; WITH = &LINK->us->s; if (!LINK->p.needscolumn) return; /* debug us := usersymbols; while us <> nil do begin write(output,' symbolflag="'); writestring(output,us^.s.symbolflag); write(output,'"'); write(output,' | symbol="' ,us^.s.symboltoplot,'"'); writeln(output,'"'); us := us^.next; end; */ /* first look for a match between the flagstring and the symbolflags */ LINK->us = LINK->p.usersymbols; while (!equalstring(LINK->flagstring, LINK->us->s.symbolflag) && LINK->us->next != NULL) LINK->us = LINK->us->next; /* Note: if there is only one symbol, we can't advance. We also can't advance past the last symbol */ /* now, if the last one was the wrong one, kill it: */ if (!equalstring(LINK->flagstring, LINK->us->s.symbolflag)) LINK->us = NULL; /* look for a grabbag symbol */ if (LINK->us != NULL) /* if could not find the symbol */ return; /* writeln(output,'looking for the grabbag symbol'); */ LINK->us = LINK->p.usersymbols; while (!done) { /* if us <> nil then writeln(output,'looking at symbol "', us^.s.symboltoplot,'"'); */ if (LINK->us == NULL) { done = true; break; } if (LINK->us->s.symboltoplot == 'g' || LINK->us->s.symboltoplot == 'G') done = true; else LINK->us = LINK->us->next; } if (LINK->us != NULL) return; printf("Could not find a symbol for the flagstring and there is no grabbag.\n"); printf("The flagstring is: \""); TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &LINK->flagstring); printf("\"\n"); printf("The known symbols are: \n"); LINK->us = LINK->p.usersymbols; while (LINK->us != NULL) { printf(" symbolflag=\""); TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &LINK->us->s.symbolflag); putchar('"'); printf(" | symboltoplot=\"%c\"", LINK->us->s.symboltoplot); printf("\"\n"); LINK->us = LINK->us->next; } halt(); } /* findsymbol */ Local Void makesymbol(LINK) struct LOC_plotdata *LINK; { /* make the symbol */ boolean docolor; /* do the connection in color */ symbol *WITH; _TEXT TEMP; /* use the symbol defined by us */ LINK->s = LINK->us->s.symboltoplot; docolor = (LINK->s == 'C' || LINK->s == 'B' || LINK->s == 'M'); WITH = &LINK->us->s; /* decide if the point is within the field of the plot */ if (LINK->x >= LINK->p.xmin && LINK->x <= LINK->p.xmax && LINK->y >= LINK->p.ymin && LINK->y <= LINK->p.ymax) { /* writeln(outfile,'% x = ',x:5:2); writeln(outfile,'% y = ',y:5:2); writeln(outfile,'% locatex(p,x) = ',locatex(p,x):5:2); writeln(outfile,'% locatey(p,y) = ',locatey(p,x):5:2); */ if (WITH->doconnection) { /* writeln(outfile,'% doconnection'); */ if (WITH->didlastpoint) { if (docolor) setcolor(LINK->outfile, LINK->hu, LINK->sa, LINK->br); movea(LINK->outfile, locatex(LINK->p, WITH->oldx), locatey(LINK->p, WITH->oldy)); drawa(LINK->outfile, locatex(LINK->p, LINK->x), locatey(LINK->p, LINK->y), WITH->connecttype, WITH->connectsize); if (docolor) setgray(LINK->outfile, 0.0); } else movea(LINK->outfile, locatex(LINK->p, LINK->x), locatey(LINK->p, LINK->y)); /* prepare variables for next time */ WITH->didlastpoint = true; WITH->oldx = LINK->x; WITH->oldy = LINK->y; } else movea(LINK->outfile, locatex(LINK->p, LINK->x), locatey(LINK->p, LINK->y)); /* writeln(outfile,'% done locating '); */ if (WITH->symbolxsize <= 0.0) LINK->xs = LINK->p.xscale * LINK->xs; else LINK->xs = WITH->symbolxsize; if (WITH->symbolysize <= 0.0) LINK->ys = LINK->p.yscale * LINK->ys; else LINK->ys = WITH->symbolysize; if (LINK->s == 'd' || LINK->s == 'b') fprintf(LINK->outfile->f, "2 setlinecap\n"); /* make lines match on boxes */ if (LINK->s == 'b') cboxr(LINK->outfile, LINK->xs, LINK->ys); else if (LINK->s == 'B') { setcolor(LINK->outfile, LINK->hu, LINK->sa, LINK->br); cboxr(LINK->outfile, LINK->xs, LINK->ys); setgray(LINK->outfile, 0.0); } else if (LINK->s == 'c') { circler(LINK->outfile, LINK->xs / 2); } else if (LINK->s == 'C') { setcolor(LINK->outfile, LINK->hu, LINK->sa, LINK->br); circler(LINK->outfile, LINK->xs / 2); setgray(LINK->outfile, 0.0); } else if (LINK->s == 'd') { dotr(LINK->outfile); cboxr(LINK->outfile, LINK->xs, LINK->ys); } else if (LINK->s == 'p') dotr(LINK->outfile); else if (LINK->s == 'I') /* see documentation */ ibeam(LINK->outfile, LINK->xs, 2 * LINK->ys); else if (LINK->s == 'x') xr(LINK->outfile, LINK->xs, LINK->ys); else if (LINK->s == '+') { plusr(LINK->outfile, LINK->xs, LINK->ys); } else if (LINK->s == 'r') { setgray(LINK->outfile, LINK->br); rectsize(LINK->outfile, &LINK->p.xrect, &LINK->p.yrect, &LINK->xs, &LINK->ys); rectdo(LINK->outfile); setgray(LINK->outfile, 0.0); } else if (LINK->s == 'R') { setcolor(LINK->outfile, LINK->hu, LINK->sa, LINK->br); rectsize(LINK->outfile, &LINK->p.xrect, &LINK->p.yrect, &LINK->xs, &LINK->ys); rectdo(LINK->outfile); setgray(LINK->outfile, 0.0); } /* else if s='s' then skybox(outfile,x,y,xs,ys) */ else if (LINK->s == 's') { skybox(LINK->outfile, locatex(LINK->p, LINK->x), locatey(LINK->p, LINK->y), LINK->xs, LINK->ys); } else if (LINK->s == 'L') { setcolor(LINK->outfile, LINK->hu, LINK->sa, LINK->br); /*2.54 cm/inch / 72 points/inch = cm / point*/ fprintf(LINK->outfile->f, "%7.5f setlinewidth %% connectsize\n", LINK->xs / (2.54 / 72)); } else if (LINK->s == 'm' || LINK->s == 'M') { if (LINK->p.usermarks) { setcolor(LINK->outfile, LINK->hu, LINK->sa, LINK->br); if (!LINK->p.needscolumn) { printf( "user defined marks in xyplom require a (non-zero) symbol column to be defined in xyplop\n"); halt(); } marksdo(LINK->outfile, LINK->xs, LINK->ys, LINK->flagstring); setgray(LINK->outfile, 0.0); } else printf("WARNING: NO USER MARKS DEFINED\n"); } else if (LINK->s == 'f' || LINK->s == 'g' || LINK->s == 'F' || LINK->s == 'G') { if (LINK->s == 'f' || LINK->s == 'g') graphstring(LINK->outfile, &LINK->flagstring, 'c'); else graphstring(LINK->outfile, &LINK->flagstring, 'l'); } else if (!WITH->doconnection) { printf("unknown symbol \"%c\", with flag \"", LINK->s); TEMP.f = stdout; *TEMP.name = '\0'; writestring(&TEMP, &LINK->flagstring); printf("\": no symbol plotted and points not connected\n"); } if (LINK->s == 'd' || LINK->s == 'b') fprintf(LINK->outfile->f, "1 setlinecap\n"); /* make lines end flat again */ datacount++; return; } datacount++; tellwarning(); fprintf(LINK->warnings->f, "skipping point # %ld (", datacount); if (LINK->p.xdecimal > 0) fprintf(LINK->warnings->f, "%*.*f", (int)LINK->p.xwidth, (int)LINK->p.xdecimal, LINK->x); else fprintf(LINK->warnings->f, "%*ld", (int)LINK->p.xwidth, (long)floor(LINK->x + 0.5)); putc(',', LINK->warnings->f); if (LINK->p.ydecimal > 0) fprintf(LINK->warnings->f, "%*.*f", (int)LINK->p.ywidth, (int)LINK->p.ydecimal, LINK->y); else fprintf(LINK->warnings->f, "%*ld", (int)LINK->p.ywidth, (long)floor(LINK->y + 0.5)); fprintf(LINK->warnings->f, ") because it is out of the plotting window\n"); WITH->didlastpoint = false; } /* makesymbol */ /* end module xyplo.makeaxes */ /* begin module xyplo.plotdata */ Static Void plotdata(infile, outfile_, warnings_, p_) _TEXT *infile, *outfile_, *warnings_; param p_; { /* read from infile and plot the data on outfile using the parameters in p */ struct LOC_plotdata V; long b; /* index to badlist */ Char badlist[maxbad]; /* a list of flags that have been rejected for plotting */ long badnumber = 0; /* current count of the number of bad flags */ boolean foundbad; /* found the bad flag in our list */ long linenumber = 0; /* the current line being read */ Char flag; /* the flag found in reading the data */ boolean gotdata; /* data found */ /*writeln(output,'in plotdata');*/ V.outfile = outfile_; V.warnings = warnings_; V.p = p_; while (!BUFEOF(infile->f)) { grabdata(infile, V.p, &V.x, &V.y, &V.xs, &V.ys, &V.hu, &V.sa, &V.br, &flag, &V.flagstring, &linenumber, &gotdata); if (!gotdata) continue; /* writeln(output,'data grabbed'); writeln(output,' flag = "',flag,'"'); writeln(output,'make the symbol xs,xy=',xs:10:5,ys:10:5); writeln(output,'hu,sa,br',hu:10:5,sa:10:5,br:10:5); */ findsymbol(&V); if (V.us != NULL) { makesymbol(&V); continue; } /* first see if it is in the bad list already */ foundbad = false; b = 1; while (b <= badnumber && !foundbad) { if (badlist[b-1] == flag) foundbad = true; else b++; } if (foundbad) continue; if (badnumber < maxbad) badnumber++; badlist[badnumber-1] = flag; printf("flag \"%c\" has no symbol", flag); printf(" and there is no grab-bag:"); printf(" this datum will not be plotted\n"); } /* this used to be in makesymbol */ fprintf(V.outfile->f, "1 setlinewidth %% in makesymbol\n"); /* reset linewidth */ } #undef maxbad /* end module xyplo.plotdata */ /* begin module xyplo.plotuserlines */ Static Void plotuserlines(outfile, p) _TEXT *outfile; param p; { /* plot the user defined lines. 'n' means don't plot. */ lines *ul; /* a pointer to the user lines */ boolean intercept; /* whether or not the regression line intercepts the region displayed */ double x1, y1, x2, y2; line *WITH; /* interception points of the regression line on the display window */ /*writeln(output); */ /* create the user defined lines */ ul = p.userlines; while (ul != NULL) { WITH = &ul->l; /* writeln(output); writeln(output,'user line:', ' m = ', m:10:5, ' b = ', b:10:5); */ boxintercept(p.xmin, p.ymin, p.xmax, p.ymax, WITH->m, WITH->b, &intercept, &x1, &y1, &x2, &y2); /* writeln(output, ' intercept = ', intercept); if intercept then writeln(output,'TRUE INTERCEPT') else writeln(output,'FALSE INTERCEPT'); */ if (intercept) { /* writeln(output,'box:', ' xmin=', xmin:10:5, ' ymin=', ymin:10:5, ' xmax=', xmax:10:5, ' ymax=', ymax:10:5, ' x1=', x1:10:5, ' y1=', y1:10:5, ' x2=', x2:10:5, ' y2=', y2:10:5); */ if (WITH->linetype != 'i' && WITH->linetype != 'n') { if (WITH->linetype != 'n' && WITH->linetype != 'l' && WITH->linetype != '-' && WITH->linetype != '.') { printf("error in plotuserlines: \n"); printf("linetype (=%c) is not one of \"l.-in\"\n", WITH->linetype); /* uuu */ halt(); } movea(outfile, locatex(p, x1), locatey(p, y1)); drawa(outfile, locatex(p, x2), locatey(p, y2), WITH->linetype, WITH->linesize); } } ul = ul->next; } } /* end module xyplo.plotuserlines */ /* begin module xyplo.plotregressionlines */ Static Void plotregressionlines(outfile, p) _TEXT *outfile; param p; { /* plot the regression line for each symbol */ symbols *us; /* a pointer to the user symbols */ boolean intercept; /* whether or not the regression line intercepts the region displayed */ double x1, y1, x2, y2; symbol *WITH; line *WITH1; /* interception points of the regression line on the display window */ us = p.usersymbols; while (us != NULL) { WITH = &us->s; if (WITH->doline) { WITH1 = &WITH->l; boxintercept(p.xmin, p.ymin, p.xmax, p.ymax, WITH1->m, WITH1->b, &intercept, &x1, &y1, &x2, &y2); if (intercept) { movea(outfile, locatex(p, x1), locatey(p, y1)); drawa(outfile, locatex(p, x2), locatey(p, y2), WITH1->linetype, WITH1->linesize); } } us = us->next; } } /* end module xyplo.plotregressionlines */ /* begin module xyplo.telllines */ Static Void telllines(outfile, p) _TEXT *outfile; param p; { /* describe the line intercepts */ lines *ul; /* a pointer to the user lines */ symbols *us; /* a pointer to the user symbols */ boolean intercept; /* whether or not the regression line intercepts the region displayed */ double x1, y1, x2, y2; symbol *WITH; line *WITH1; /* interception points of the regression line on the display window */ /* writeln(outfile,'.fi'); (@ start filling text again @) writeln(outfile,'.sp 1'); (@ give room on output @) writeln(outfile,'.KS'); (@ start a keep, so that the lines stay together if there is a page break */ us = p.usersymbols; while (us != NULL) { WITH = &us->s; if (WITH->doline) { WITH1 = &WITH->l; /* writeln(outfile,'.sp'); (@ make space on the display */ boxintercept(p.xmin, p.ymin, p.xmax, p.ymax, WITH1->m, WITH1->b, &intercept, &x1, &y1, &x2, &y2); comment(outfile); fprintf(outfile->f, "The regression line for symbol \"%c", WITH->symboltoplot); fprintf(outfile->f, "\" with flag \""); writestring(outfile, &WITH->symbolflag); fprintf(outfile->f, "\"\n"); comment(outfile); if (intercept) { if (p.logxnormal) { x1 = exp(x1 * p.logxbase); x2 = exp(x2 * p.logxbase); } if (p.logynormal) { y1 = exp(y1 * p.logybase); y2 = exp(y2 * p.logybase); } fprintf(outfile->f, "intercepts the display at points (%*.*f, %*.*f) and (%*.*f, %*.*f)\n", (int)p.xwidth, (int)(p.xdecimal + 1), x1, (int)p.ywidth, (int)(p.ydecimal + 1), y1, (int)p.xwidth, (int)(p.xdecimal + 1), x2, (int)p.ywidth, (int)(p.ydecimal + 1), y2); } else { fprintf(outfile->f, " does not intercept the display\n"); comment(outfile); printf("the regression line does not intercept the display\n"); } } us = us->next; } /* now tell the user defined lines */ ul = p.userlines; while (ul != NULL) { /* writeln(outfile,'.sp'); (@ make space on the display */ WITH1 = &ul->l; boxintercept(p.xmin, p.ymin, p.xmax, p.ymax, WITH1->m, WITH1->b, &intercept, &x1, &y1, &x2, &y2); comment(outfile); fprintf(outfile->f, "the user defined line of slope = %10.5f and intercept = %10.5f\n", WITH1->m, WITH1->b); comment(outfile); if (intercept) { if (p.logxnormal) { x1 = exp(x1 * p.logxbase); x2 = exp(x2 * p.logxbase); } if (p.logynormal) { y1 = exp(y1 * p.logybase); y2 = exp(y2 * p.logybase); } fprintf(outfile->f, " intercepts the display at points (%*.*f, %*.*f) and (%*.*f, %*.*f)\n", (int)p.xwidth, (int)(p.xdecimal + 1), x1, (int)p.ywidth, (int)(p.ydecimal + 1), y1, (int)p.xwidth, (int)(p.xdecimal + 1), x2, (int)p.ywidth, (int)(p.ydecimal + 1), y2); } else fprintf(outfile->f, " does not intercept the display\n"); ul = ul->next; } /* writeln(outfile,'.KE'); (@ end the keep @) writeln(outfile,'.nf'); (@ return to no filling text @) writeln(outfile,'.sp 2'); (@ make space on the display */ } /* end module xyplo.telllines */ /* begin module xyplo.makeusermarks */ Static Void makeusermarks(xyplom, outfile, usermarks) _TEXT *xyplom, *outfile; boolean *usermarks; { /* make the user marks file by copying it to the outfile */ if (*xyplom->name != '\0') { if (xyplom->f != NULL) xyplom->f = freopen(xyplom->name, "r", xyplom->f); else xyplom->f = fopen(xyplom->name, "r"); } else rewind(xyplom->f); if (xyplom->f == NULL) _EscIO2(FileNotFound, xyplom->name); RESETBUF(xyplom->f, Char); if (BUFEOF(xyplom->f)) { *usermarks = false; return; } *usermarks = true; /* could check here that there is at least one defined mark This requires reading the PostScript file and figuring out what is in it. */ while (!BUFEOF(xyplom->f)) copyaline(xyplom, outfile); } /* end module xyplo.makeusermarks */ /* begin module xyplo.generategraph */ Static Void generategraph(infile, outfile, warnings, p) _TEXT *infile, *outfile, *warnings; param p; { /* generate the graph in the outfile using the data in infile and the parameters given in p */ long linenumber; /* the current linenumber, to keep skipcopy happy */ skipcopy(infile, outfile, false, &linenumber); /* writeln(outfile,'.bp'); */ startpic(outfile, defscale, p.xzero, p.yzero, 't'); if (p.startrectangles) rectinit(outfile); /* plot data first so that lines and so forth can go on top */ plotdata(infile, outfile, warnings, p); setgray(outfile, 0.0); /* make sure that the axes etc are black! */ makeaxes(outfile, p); makexlabel(outfile, p); makeylabel(outfile, p); crosshairs(outfile, p); plotuserlines(outfile, p); plotregressionlines(outfile, p); stoppic(outfile); } /* end module xyplo.generategraph */ /* begin module xyplo.themain */ Static Void themain(infile, outfile, xyplop, xyplom, warnings) _TEXT *infile, *outfile, *xyplop, *xyplom, *warnings; { /* the main */ /* the main procedure of the program, reading from infile for data and producing results to outfile. parameters obtained from xyplop */ param p; /* the parameters controlling the program */ _TEXT TEMP; printf("xyplo %4.2f\n", version); if (*infile->name != '\0') { if (infile->f != NULL) infile->f = freopen(infile->name, "r", infile->f); else infile->f = fopen(infile->name, "r"); } else rewind(infile->f); if (infile->f == NULL) _EscIO2(FileNotFound, infile->name); RESETBUF(infile->f, Char); fscanf(infile->f, "%*[^\n]"); getc(infile->f); /* required for gpcc compiler to detect eof! */ if (BUFEOF(infile->f)) { printf("xyin file is empty\n"); halt(); } if (*infile->name != '\0') { if (infile->f != NULL) infile->f = freopen(infile->name, "r", infile->f); else infile->f = fopen(infile->name, "r"); } else rewind(infile->f); if (infile->f == NULL) _EscIO2(FileNotFound, infile->name); RESETBUF(infile->f, Char); if (*outfile->name != '\0') { if (outfile->f != NULL) outfile->f = freopen(outfile->name, "w", outfile->f); else outfile->f = fopen(outfile->name, "w"); } else { if (outfile->f != NULL) rewind(outfile->f); else outfile->f = tmpfile(); } if (outfile->f == NULL) _EscIO2(FileNotFound, outfile->name); SETUPBUF(outfile->f, Char); warningcount = 0; datacount = 0; readparam(xyplop, &p); /* obtain the parameters */ fprintf(outfile->f, "%%!PS-Adobe-2.0 EPSF-2.0\n"); fprintf(outfile->f, "%%%%Title: xyplo %4.2f\n", version); fprintf(outfile->f, "%%%%Creator: Tom Schneider\n"); /* define bounding box. The postscript program ftp://ftp.ncifcrf.gov/pub/delila/printerarea.ps will give the values for your printer. */ fprintf(outfile->f, "%%%%BoundingBox: %5ld %5ld %5ld %5ld\n", (long)floor(p.llx + 0.5), (long)floor(p.lly + 0.5), (long)floor(p.urx + 0.5), (long)floor(p.ury + 0.5)); fprintf(outfile->f, "%%%%DocumentFonts:\n"); fprintf(outfile->f, "%%%%EndComments\n"); fprintf(outfile->f, "%%%%EndProlog\n\n"); /* this blank line makes sure that stupid printers think that this IS a real PostScript file, even though there are many comment lines following! */ fprintf(outfile->f, "/defaultllx %5.1f def\n", defaultllx); fprintf(outfile->f, "/defaultlly %5.1f def\n", defaultlly); fprintf(outfile->f, "/defaulturx %5.1f def\n", defaulturx); fprintf(outfile->f, "/defaultury %5.1f def\n", defaultury); fprintf(outfile->f, "/llx %5.1f def\n", p.llx); fprintf(outfile->f, "/lly %5.1f def\n", p.lly); fprintf(outfile->f, "/urx %5.1f def\n", p.urx); fprintf(outfile->f, "/ury %5.1f def\n", p.ury); fprintf(outfile->f, "/cmfactor 72 2.54 div def %% defines points -> centimeters\n"); fprintf(outfile->f, "/cm { cmfactor mul} def %% defines centimeters\n"); fprintf(outfile->f, "/edgecontrol (%c) def\n", p.edgecontrol); fprintf(outfile->f, "/edgeleft %*.*f cm def\n", pwid, pdec, p.edgeleft); fprintf(outfile->f, "/edgeright %*.*f cm def\n", pwid, pdec, p.edgeright); fprintf(outfile->f, "/edgelow %*.*f cm def\n", pwid, pdec, p.edgelow); fprintf(outfile->f, "/edgehigh %*.*f cm def\n", pwid, pdec, p.edgehigh); /* determine the bounds of the plot, run the regressions and calculate a few more things to keep around in p */ bounds(infile, outfile, &p); writeparam(outfile, p); /* print the parameters */ /* writeln(output,'after writeparam'); halt; {zzz} */ regressiondata(outfile, p); /* print the regression data */ TEMP.f = stdout; *TEMP.name = '\0'; regressiondata(&TEMP, p); /* print the regression data */ telllines(outfile, p); /* describe the line intercepts */ TEMP.f = stdout; *TEMP.name = '\0'; telllines(&TEMP, p); /* describe the line intercepts */ makeusermarks(xyplom, outfile, &p.usermarks); /* The bounds calls create warnings because the xyin file is read with grabdata. The same set of warnings is generated in generategraph, which means that there would be two for each warning. To avoid this, reset warningcount to zero. This forces the file to be cleared and only one warning given per case. */ warningcount = 0; datacount = 0; generategraph(infile, outfile, warnings, p); /* create the graph */ if (warningcount > 0) printf("\nThere are %ld WARNINGS in file warnings\n", warningcount); fprintf(outfile->f, "%%%%Trailer\n"); fprintf(outfile->f, "%%%%Pages: 1\n"); /* writeln(outfile,'.fi'); (% start filling text again */ } /* end module xyplo.themain */ main(argc, argv) int argc; Char *argv[]; { PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; warnings.f = NULL; strcpy(warnings.name, "warnings"); xyplop.f = NULL; strcpy(xyplop.name, "xyplop"); xyplom.f = NULL; strcpy(xyplom.name, "xyplom"); xyout.f = NULL; strcpy(xyout.name, "xyout"); xyin.f = NULL; strcpy(xyin.name, "xyin"); themain(&xyin, &xyout, &xyplop, &xyplom, &warnings); _L1: if (xyin.f != NULL) fclose(xyin.f); if (xyout.f != NULL) fclose(xyout.f); if (xyplom.f != NULL) fclose(xyplom.f); if (xyplop.f != NULL) fclose(xyplop.f); if (warnings.f != NULL) fclose(warnings.f); exit(EXIT_SUCCESS); } /* End. */