/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "genpic.p" */ #include /* convert genhis output to pic input 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/ module libraries required: delman, prgmods, dops */ /* end of program */ /* begin module version */ #define version 2.61 /* of genpic.p 2007 Nov 28 2007 Nov 28, 2.61: bug? x axis is fixed? 2007 Aug 31, 2.60: clean up 2007 Aug 31, 2.59: control total height of graph, not just boxes 2007 Aug 30, 2.58: fix doaxis (continued) 2007 Aug 30, 2.57: fix doaxis 2007 Aug 30, 2.56: add tic marks at end of x axis 2007 Aug 30, 2.55: add parameters for x axis number positions 2007 Aug 30, 2.54: upgrade from dops modules 2007 Aug 30, 2.53: add parameters for y axis number positions, x axis bug fix in doaxis 2007 Aug 29, 2.52: more clean up and remove fixed parameters 2007 Aug 29, 2.51: clean up and remove fixed parameters 2007 Aug 29, 2.50: refine y axis 2007 Aug 29, 2.49: develop y axis parameter control 2007 Aug 29, 2.48: add y axis - functional!! 2007 Aug 03, 2.47: cleanup 2007 Aug 03, 2.46: bug crash error in exponentiation (Result too large) (error #700 at 18d2b) Plotting the gaussian for large standard deviations gives exponentiation of an extremely small number. Put a tolerance in instead. 2007 Jun 14, 2.45: modulo failed 2006 Dec 04, 2.44: modulo multiplier - fix readln bug 2006 Nov 15, 2.43: modulo multiplier 2005 Aug 7, 2.42: need to reset picout after progmod upgrade 2005 Aug 6, 2.41: PageOrientation fails. Use 45 rotate 45 rotate to fool acrobat into not rotating the page ... 2005 Aug 6, 2.40: use: PageOrientation to force page orientation! 2005 Aug 6, 2.39: consider drawing the display differently. (failed) 2005 Aug 6, 2.38: display in acrobat from pdf rotates image! If one rotates an image by 90 degrees, then acrobat rotates it back!! STOOPID! 2005 Jan 11, 2.37: GPCC won't allow real without decimals in rotate. 2005 Jan 7, 2.36: fix output for ymaximum 2004 Feb 6, 2.35: clean up 2004 Feb 6, 2.34: segmentation fault for 2 other titles - not read in properly 2003 Aug 22, 2.32: overlay curve must be fixed too 2003 Aug 22, 2.31: use version number to retain old behavior! 2003 Aug 21, 2.31: document the graph shift bug in main documentation. 2003 Aug 21, 2.30: bug: graph shifts right depending on number of '*' comment lines! This bug was removed. This will ALTER the required x coordinate of ALL GRAPHS!!! 2002 Feb 21, 2.28: make additional titles work 2002 Feb 21, 2.27: cleanup documentation 2002 Feb 21, 2.26: program upgrades old parameter files correctly 2002 Feb 21, 2.22: encapsulated postscript and bounding box controls second title has size control independent of first vertical bar at zero coordinate: 1996 Oct 8 any number of other titles: 1996 Oct 1 rebuilt to give titles and more parameter control: 1996 August 12 rebuilt parameter file, x, y, rotation: 1995 October 25 previous changes: 1992 November 16 origin 1985 July 21 */ #define updateversion 2.50 /* defines lowest acceptable current parameter file */ #define bugversion226 2.26 /* parameters with versions at or lower than this will function the same as with the bug reported on 2003 aug 21 for version 2.30. You need not do anything with old parameter files. */ /* end module version */ /* begin module describe.genpic */ /* name genpic: convert genhis output to pic input synopsis genpic(histog: in, genpicp: in, picout: out, output: out) files histog: the output of the genhis program genpicp: parameters to control the histogram are one per line. The first line must be the version number of the this program. This allows the program to recognize when the parameter file is old. If the version is less than 2.26, genpic will upgrade the genpicp file. x: x coordinate of graph start on the page (cm) y: y coordinate of graph start on the page (cm) rotation: angle to rotate the graph graphheight: height of the core graph (cm). When there is no y axis (original design of the program) this number determines the height of the highest histogram box ("boxheight"). When there is a y axis, it is the length of the y axis. boxwidth: width of the histogram boxes. (cm) intervalsize: the space for the interval number. (cm) histogramvalue: the space for the histogram value. (cm) boxshift: how much to shift the boxes up relative to the numbers. (cm) ifield: number of characters devoted to the interval idecimal: number of characters devoted to the interval's decimal places nfield: number of characters devoted to the number of numbers modulo: an integer that determines which interval numbers are shown. Modulo = 1 gives all numbers, modulo = 2 gives every even number, etc. If there is a second real number on the line, the modulomultiplier, then the interval numbers are first multiplied by this number. This allows one to control intervals below 1. (This doesn't work quite right yet.) FIRST COLUMN TITLE column name size (integer): the size in points of the column names relative column 1 name x coordinate adjustment (cm): real number relative column 1 name y coordinate adjustment (cm): real number first column name: the entire line defines the name SECOND COLUMN TITLE NEW PARAMETER as of 2002 Feb 21: column name size (integer): the size in points of the column names relative column 1 name x coordinate adjustment (cm): real number relative column 1 name y coordinate adjustment (cm): real number second column name: the entire line defines the name OTHER TITLES previously undocumented PARAMETER as of 2002 Feb 21: othertitles (integer): How many more titles to do title name size (integer): the size in points of the title title x coordinate relative adjustment (cm): real number title y coordinate relative adjustment (cm): real number title name: the entire line defines the title EDGE CONTROLS, on one line: 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 initial 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). Otherwise the program will attempt to determine a good starting bounding box. The next 4 parameters are four real numbers that define the edges around the figure in cm. To allow a graph 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; this will move the edges *inward*. NEW PARAMETERS as of 2007 Aug 30: X-AXIS CONTROLS, on one line: xaxiscontrol: char; x means to plot an X axis xaxismax: integer; maximum count to plot x axis interval control: xaxisintervals: integer; interval size, counts xaxissubintervals: integer; number of sub-intervals x axis tic mark controls: xaxisticlength: real; length of tic mark xaxisticdx: real; x position of number relative to tic mark xaxisticdy: real; y position of number relative to tic mark Y-AXIS CONTROLS, on one line: yaxiscontrol: char; y means to plot a Y axis yaxismax: integer; maximum count to plot y axis interval control: yaxisintervals: integer; interval size, counts yaxissubintervals: integer; number of sub-intervals y axis tic mark controls: yaxisticlength: real; length of tic mark yaxisticdx: real; x position of number relative to tic mark yaxisticdy: real; y position of number relative to tic mark picout: the data in histog are converted to PostScript All lines describing the data are comments. output: messages to the user. description The genhis program generates a histogram in simple character format. The program genpic converts this simple histogram into PostScript commands. Therefore, one can imbed output from genhis in the text of a paper. A vertical line is given at coordinate zero. examples an example genpicp: 2.26 version of genpicp that this parameter file is designed for. 1.0 x cm 10.0 y cm 0 rotation 4 graphheight, height of the graph, cm 0.3 boxwidth, width of the histogram boxes, cm 0.6 intervalsize, space for interval number, cm 0.6 histogramvalue, space for histogram value, cm 0 boxshift, shift boxes up relative to numbers, cm 5 field: number of characters devoted to the interval 1 decimal: number of characters devoted to the interval's decimal places 5 field: number of characters devoted to the number of numbers 1 modulo: multiples of this number are shown 0 barlocation: where to put a vertical bar 12 column name size (points) 0 relative column 1 name x coordinate adjustment (cm) 0.20 relative column 1 name y coordinate adjustment (cm) second column name (values) 12 column name size (points) 0 relative column 2 name x coordinate adjustment (cm) 0.40 relative column 2 name y coordinate adjustment (cm) first column name (number) 14 title name size (points) -5.2 relative title x coordinate adjustment (cm) 0.0 relative title y coordinate adjustment (cm) overall title 1 How many more titles to do 12 other title name size (points) 0.0 relative title x coordinate adjustment (cm) -0.8 relative title y coordinate adjustment (cm) This is an additional title n 0 0 0 0 edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm x 17 5 5 0.1 -0.00 -0.35 xaxis: control max int subint ticlength ticdx ticdy y 15 5 5 0.1 -0.12 -0.12 yaxis: control max int subint ticlength ticdx ticdy see also {program that produces input to this program:} genhis.p {example parameter file:} genpicp author Thomas D. Schneider bugs 2003 Aug 21, 2.30: WARNING: ALL PARAMETER FILES WILL HAVE TO BE ADJUSTED. I discovered a bug in which the graph shifts right depending on number of '*' comment lines in the histog file. This bug was removed. This will ALTER the required x coordinate of ALL GRAPHS!!! It is a nasty bug because all parameter files depended on this and each one was adjusted (unintentionally) by hand to account for it. It is a holdover from some time (perhaps) when the comment lines were printed on the output. Since we don't do that anymore, it is not needed. The effect of having the bug was that if one generated graphs with different numbers of header line comments, the graphs would shift depending on the number of header lines and so the graphs would be different. technical note defaults for the page parameters are in module genpic.const. NEW PARAMETERs as of 2002 Feb 21: edgecontrol edgeleft, edgeright, edgelow, edgehigh */ /* end module describe.genpic */ /* begin module genpic.const */ /* defaults: */ #define dx 1.0 /* x coordinate of graph start */ #define dy 3.0 /* y coordinate of graph start */ #define drotation 0 /* angle to rotate the graph */ #define dgraphheight 5.0 /* height of the graph */ #define dboxwidth 0.15 /* width of the histogram boxes */ #define dintervalsize 1.25 /* the space for the interval in cm */ #define dhistogramvalue 1.25 /* the space for the histogram value in cm */ #define dboxshift (-0.15) /* how much to shift the boxes up relative to the numbers */ #define difield 8 /* field width of interval numbers */ #define didecimal 2 /* decimal places of interval numbers */ #define dnfield 5 /* field width of number numbers */ #define dmodulo 1 /* modulo */ #define dmodulomultiplier 1.0 /* default modulo multiplier*/ /* The following bounding box is for the Canon Color Laser Copier 800S. */ #define defaultllx 10.08 /* lower left x */ #define defaultlly 8.91 /* lower left y */ #define defaulturx 588.06 /* upper left x */ #define defaultury 779.85 /* upper left y */ /* end module genpic.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.76; (@ of dops.p 2007 Aug 30 */ /* begin module interact.const */ /* begin module string.const */ #define maxstring 2000 /* the maximum string */ /* end module string.const version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* end module interact.const version = 2.76; (@ of dops.p 2007 Aug 30 */ /* begin module filler.const */ #define fillermax 50 /* the size of the filler array for a string */ /* end module filler.const version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module histogram.const */ #define maxslots 1000 /* maximum number of slots in the histogram */ #define defslots 100 /* the default number of slots */ #define pageheight 105 /* room on page for plotting; used to set scaling */ #define dch '+' /* character for plotting data */ #define sch ':' /* character for plotting standard */ #define bch '*' /* character for plotting coincidence of standard and data */ /* end module histogram.const version = 1.33; (@ of genhis, 1985 dec 19 */ /* begin module genpic.histogram.type */ typedef enum { none, gaussian, poisson } plots; /* the types of standard plots that can be done */ typedef enum { start, stop } endpoints; /* defines the range for plotting */ typedef struct rhistarray { /* numbers: array[1..maxslots] of integer; (* histogram arrays *) */ /* for THIS program, use real numbers! */ double numbers[maxslots]; /* histogram arrays */ double range[2]; /* range of the data recorded */ double interval; /* the size of the histogram slots */ long slots; /* the number of slots */ } rhistarray; /* origin from version = 1.33; (@ of genhis, 1985 dec 19 */ /* end module genpic.histogram.type */ /* begin module genpic.histdata */ typedef struct histdata { /* the data about a histogram in the histog file from the genhis program */ long column; /* the data column used */ long entries; /* numbers are in the file */ double minimum; /* the minimum number */ double maximum; /* the maximum number */ double mean; /* the MEA */ double stdev; /* the STANDARD DEVIATIO */ double sem; /* the STANDARD ERROR OF THE MEAN (SEM) */ double variance; /* the variance */ double uncertainty; /* the uncertainty in bits */ double computeduncertainty; /* the computed uncertainty in bits (Shannon p.57) */ double start_; /* start of the range of data plotted */ double stop_; /* stop of the range of data plotted */ double xinterval; /* x-axis interval */ long slots; /* the number of intervals */ long ymaximum; /* highest count in the graph */ double yaxisscale; /* the y-axis scale */ Char plot; /* type of graph, g = gaussian, p = poisson */ } histdata; /* end module genpic.histdata */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* begin module trigger.type */ typedef struct trigger { /* an object to be searched for */ string seek; /* the characters looked for */ long state; /* how close to triggering we are */ boolean skip; /* trigger not found- skip the line */ /* the trigger was found */ boolean found; } trigger; /* end module trigger.type version = 2.76; (@ of dops.p 2007 Aug 30 */ /* begin module filler.type */ /* the following is an array used to fill a string. it is convenient to have it much shorter than the maxstring, so that it is easy to fill the string using procedure fillstring. the user must declare the value of constant fillermax. */ typedef Char filler[fillermax]; /* end module filler.type version = 2.76; (@ of dops.p 2007 Aug 30 */ /* begin module genpic.title */ /* pointer to a title */ typedef struct title { long titlenamesize; /* the title name size in points */ double titlex; /* the title x coordinate adjustment (cm) */ double titley; /* the title y coordinate adjustment (cm) */ string letters; /* the title */ struct title *next; /* the next title */ } title; /* end module genpic.title */ /* ********************************************************************** */ /* begin module genpic.var */ Static _TEXT histog; /* output of genhis program */ Static _TEXT genpicp; /* control parameters for genpic */ Static _TEXT picout; /* output of this program, graph in pic language */ /* see notes for version 2.30 for why this is here */ Static double parameterversion; /* parameter version number */ /* end module genpic.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.76; (@ of dops.p 2007 Aug 30 */ /* 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); } /* end module halt version = 2.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* begin module trigger.proc */ /* this module allows one to scan a series of characters, as from an array or a file, and to "trigger" or detect a simple string in the series. the advantage of the trigger is that several triggers can "observe" a stream of characters at once, each looking for a different thing. some other modules required: interact.const, interact.type */ Static Void resettrigger(t) trigger *t; { /* reset the trigger to ground state */ t->state = 0; t->skip = false; t->found = false; } /* resettrigger */ Static Void testfortrigger(ch, t) Char ch; trigger *t; { /* look at the character ch. if it is part of the trigger (at the current trigger state), then the trigger state goes higher. if it is not part of the trigger then the trigger state is reset, skip is true and one should skip onward to find the trigger. if the trigger is found, found is true. 1996 Sep 12: Bug found! In the case of a trigger "ab", the program used to miss it for situations like "aab". This was because at the first a it would step up. Then it would see the second a and recognize that was not part of ab. It would fail to realize that it could be the start of a new one. The code now accounts for that possibility. */ t->state++; /* writestring(list,seek); writeln(list,'testfortrigger seek.letters[',state:1,']:', seek.letters[state],' ch:',ch); */ if (t->seek.letters[t->state - 1] == ch) { t->skip = false; if (t->state == t->seek.length) t->found = true; else t->found = false; return; } /* it failed. But wait! It could be the beginning of a NEW trigger string! */ if (t->seek.letters[0] == ch) { t->state = 1; t->skip = false; t->found = false; return; } t->state = 0; t->skip = true; t->found = false; /* reset trigger */ } /* testfortrigger */ /* end module trigger.proc version = 2.76; (@ of dops.p 2007 Aug 30 */ /* begin module filler.fillstring */ Static Void fillstring(s, a) string *s; Char *a; { /* this procedure makes it reasonably easy to fill the string s with characters. one calls the procedure as: */ /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ /* fillstring(s, 'this-is-the-string '); the two comments make it easy to line the characters up. also, for this example, it was assumed that the length of filler as defined by the constant fillermax was 50. */ long length = fillermax; /* of the string without trailing blanks */ long index; /* of s */ clearstring(s); while (length > 1 && a[length-1] == ' ') length--; if (length == 1 && a[length-1] == ' ') { printf("fillstring: the string is empty\n"); halt(); } for (index = 0; index < length; index++) s->letters[index] = a[index]; s->length = length; s->current = 1; } /* fillstring */ /* end module filler.fillstring version = 2.76; (@ of dops.p 2007 Aug 30 */ /* begin module filler.filltrigger */ Static Void filltrigger(t, a) trigger *t; Char *a; { /* fill the trigger t */ fillstring(&t->seek, a); } /* fillstring */ /* end module filler.filltrigger version = 2.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* begin module copyline */ Static Void copyline(fin, fout) _TEXT *fin, *fout; { /* copy a line from file fin to file fout but DO NOT CARRIAGE RETURN on the fout. Carriage return on the fin. */ while (!P_eoln(fin->f)) { putc(P_peek(fin->f), fout->f); getc(fin->f); } fscanf(fin->f, "%*[^\n]"); getc(fin->f); } /* copyline */ #define pi_ 3.14159265 /* used in calculating the curve */ #define Zmax 10 /* end module copyline version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* ********************************************************************** */ /* begin module genpic.gaushist */ Static Void gaushist(entries, ave, vari, stanarray) long entries; double ave, vari; rhistarray *stanarray; { /* fill the stanarray with values assuming the data fits a gaussian distribution. the equation used is from bevington, p.r., 'data reduction and error analysis for the physical sciences', p. 44: prob(x) = exp[-1/2((x-ave)/sd)**2]/sd*sqrt(2*pi). where prob(x) is the probability of getting the value x. to determine the expected number of values inside a given interval, we calculate prob(x) for the mid-point of the interval, multiply by the width of the interval and then multiply this total probability by the number of entries in the data. */ /* modified from version = 1.33; (@ of genhis, 1985 dec 19 so that it does REAL values rather than integer ones!!! */ /* Number of standard deviations above which we just set the gaussian to zero. */ double sd; /* standard deviation */ double d1; /* first denominator, = 2*sd**2 */ double d2; /* second denominator, = sd*sqrt(2*pi) */ double x; /* the position for which the expectation is calculated */ double ex; /* probability of getting a value in the interval */ long i; /* index */ double Z; /* number of standard deviations from the mean */ long FORLIM; sd = sqrt(vari); d1 = 2 * vari; d2 = sd * sqrt(2 * pi_); FORLIM = stanarray->slots; for (i = 0; i < FORLIM; i++) { x = stanarray->range[(long)start] + (i + 0.5) * stanarray->interval; /* ex := exp(-(x - ave) * (x - ave)/d1) / d2 * interval; This formula can't handle really large deviations, so break it into parts: */ Z = (ave - x) * (x - ave) / d1; if (-Z < Zmax) ex = exp(Z) / d2 * stanarray->interval; else ex = 0.0; /* numbers[i+1] := round(ex * entries); */ /* for THIS program, we don't round! */ stanarray->numbers[i] = ex * entries; } } #undef pi_ #undef Zmax #define pi_ 3.14159265 /* used in calculating the curve */ /* end module genpic.gaushist */ /* begin module histogram.poishist */ Static Void poishist(entries, ave, stanarray) long entries; double ave; rhistarray *stanarray; { /* fill the stanarray with values assuming the data fits a poisson distribution. the probability distribution is defined as: prob(x) = ave**x * exp(-ave) / 'x-factorial' . note several things: the variance of a poisson distribution is the same as the average; the poisson distribution is only defined for ave > 0 and for x >= 0; the distribution is only really defined for integer x, but we can also calculate it for reals. since for large values of x 'x-factorial' is hard to calculate we use the following approximation based on sterling"s approximation for 'x-factorial': ln(prob(x)) = x - ave + x * ln(ave/x) - ln(2*pi*x)/2 . for x = 1 this approximation is only off by the factor 1.08, and allows us to calculate the prob(x) for all real x > 1. for x between 0 and 1 we use the approximation prob(x) = exp(-ave). if ave <= 0 we skip out of the procedure. */ double x; /* the position for which the expectation is calculated */ double lnex; /* the natural log of ex */ double ex; /* probability of getting a value in the interval around x */ long i; /* index */ long FORLIM; if (ave <= 0) { printf( " warning: poisson not defined for ave <= 0, procedure poishist called but not used\n"); return; } FORLIM = stanarray->slots; for (i = 0; i < FORLIM; i++) { /* get the midpoint of the interval */ x = stanarray->range[(long)start] + (i + 0.5) * stanarray->interval; /* the poisson is not defined for x < 0, so we set the array to 0 */ if (x < 0) { ex = 0.0; /* for x between 0 and 1 use ex = exp(-ave) */ } else if (x <= 1) ex = exp(-ave); else { lnex = x - ave + x * log(ave / x) - log(2 * pi_ * x) / 2; ex = exp(lnex) * stanarray->interval; } stanarray->numbers[i] = (long)floor(ex * entries + 0.5); } } #undef pi_ /* end module histogram.poishist version = 1.33; (@ of genhis, 1985 dec 19 */ /* ********************************************************************** */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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); } /* end module pic.linea version = 2.76; (@ of dops.p 2007 Aug 30 */ /* 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 */ /* 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++) 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; putc(s->letters[i], tofile->f); } /* else skip the blank by not writing it */ } else 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.76; (@ of dops.p 2007 Aug 30 */ /* 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: genpic.p, line 1209: * 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* 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.76; (@ of dops.p 2007 Aug 30 */ /* ********************************************************************** */ /* end module pic.functions version = 2.76; (@ of dops.p 2007 Aug 30 */ /* begin module pic.boxr */ Static Void boxr(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 goes toward the positive x and y directions. the box is relative to the current position, so it returns to original position afterwards */ liner(afile, 0.0, height); liner(afile, width, 0.0); liner(afile, 0.0, -height); liner(afile, -width, 0.0); } /* end module pic.boxr version = 2.76; (@ of dops.p 2007 Aug 30 */ /* 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 */ #define tab 9 /* tab character */ /* end module interact.getstring version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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); } /* 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 skipblanks version = 2.76; (@ of dops.p 2007 Aug 30 */ /* 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; } /* Local variables for getdata: */ struct LOC_getdata { _TEXT *histog; } ; Local Void t(LINK) struct LOC_getdata *LINK; { /* test that there is something to read */ if (BUFEOF(LINK->histog->f)) { printf("missing lines of histog\n"); halt(); } } /* end module checknumber version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* ********************************************************************** */ /* begin module genpic.getdata */ Static Void getdata(histog_, data) _TEXT *histog_; histdata *data; { /* scan into histog to find the y scale */ struct LOC_getdata V; Char ch; /* used to skip asterisks */ boolean done = false; /* true when no more comment lines are found */ trigger s; /* the search string where the parameters start */ V.histog = histog_; if (*V.histog->name != '\0') { if (V.histog->f != NULL) V.histog->f = freopen(V.histog->name, "r", V.histog->f); else V.histog->f = fopen(V.histog->name, "r"); } else rewind(V.histog->f); if (V.histog->f == NULL) _EscIO2(FileNotFound, V.histog->name); RESETBUF(V.histog->f, Char); /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ filltrigger(&s, "parameters: "); resettrigger(&s); /* skip lines until we find one that begins with '* pa' */ while (!done) { if (BUFEOF(V.histog->f)) t(&V); testfortrigger(P_peek(V.histog->f), &s); if (P_eoln(V.histog->f)) { fscanf(V.histog->f, "%*[^\n]"); getc(V.histog->f); } else getc(V.histog->f); if (s.found) done = true; } fscanf(V.histog->f, "%*[^\n]"); getc(V.histog->f); /* read in all the data */ t(&V); fscanf(V.histog->f, "%c%ld%*[^\n]", &ch, &data->column); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%ld%*[^\n]", &ch, &data->entries); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->minimum); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->maximum); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->mean); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->stdev); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->sem); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->variance); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->uncertainty); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->computeduncertainty); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%*[^\n]"); getc(V.histog->f); /* a blank line */ t(&V); fscanf(V.histog->f, "%c%lg", &ch, &data->start_); if (ch == '\n') ch = ' '; skipblanks(V.histog); skipnonblanks(V.histog); /* the word 'to' */ t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->stop_); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->xinterval); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%ld%*[^\n]", &ch, &data->slots); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%ld%*[^\n]", &ch, &data->ymaximum); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%c%lg%*[^\n]", &ch, &data->yaxisscale); getc(V.histog->f); if (ch == '\n') ch = ' '; t(&V); fscanf(V.histog->f, "%*[^\n]"); getc(V.histog->f); /* a blank line */ t(&V); fscanf(V.histog->f, "%c%c%c%*[^\n]", &ch, &ch, &data->plot); getc(V.histog->f); if (ch == '\n') ch = ' '; if (ch == '\n') ch = ' '; if (data->plot == '\n') data->plot = ' '; } /* end module genpic.getdata */ /* begin module genpic.putdata */ Static Void putdata(f, data) _TEXT *f; histdata *data; { /* write the data to file f */ /* write out all the data */ fprintf(f->f, "%% %10ld column\n", data->column); fprintf(f->f, "%% %10ld entries\n", data->entries); fprintf(f->f, "%% %10.5f minimum\n", data->minimum); fprintf(f->f, "%% %10.5f maximum\n", data->maximum); fprintf(f->f, "%% %10.5f mean\n", data->mean); fprintf(f->f, "%% %10.5f st dev\n", data->stdev); fprintf(f->f, "%% %10.5f SEM\n", data->sem); fprintf(f->f, "%% %10.5f variance\n", data->variance); fprintf(f->f, "%% %10.5f uncertainty\n", data->uncertainty); fprintf(f->f, "%% %10.5f computeduncertainty\n\n", data->computeduncertainty); /* a blank line */ fprintf(f->f, "%% %10.5f start\n", data->start_); fprintf(f->f, "%% %10.5f stop\n", data->stop_); fprintf(f->f, "%% %10.5f x interval\n", data->xinterval); fprintf(f->f, "%% %10ld slots\n", data->slots); fprintf(f->f, "%% %10ld y maximum\n", data->ymaximum); fprintf(f->f, "%% %10.5f y axis scale\n\n", data->yaxisscale); /* a blank line */ fprintf(f->f, "%% %c%c plot\n", data->plot, data->plot); /* column: integer; entries: integer; minimum: real; maximum: real; mean: real; stdev: real; variance: real; uncertainty: real; computeduncertainty: real; start: real; stop: real; xinterval: real; slots: integer; ymaximum: integer; yaxisscale: real; plot: char */ } /* end module genpic.putdata */ /* 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 genpic.copystart */ Static Void copystart(histog, picout, boxwidth, downshift) _TEXT *histog, *picout; double boxwidth, *downshift; { /* copy the header lines from histog to picout. boxwidth is the height to move down for each line. Downshift is the total amount of moving down that was done (it's the number of lines time boxwidth). */ boolean done = false; /* true when the end of the histog header is found */ boolean gotten = true; /* a line was obtained */ string line; /* a line of text */ long lines; /* number of lines done */ trigger t; /* a trigger to find the beginning of the data */ if (*histog->name != '\0') { if (histog->f != NULL) histog->f = freopen(histog->name, "r", histog->f); else histog->f = fopen(histog->name, "r"); } else rewind(histog->f); if (histog->f == NULL) _EscIO2(FileNotFound, histog->name); RESETBUF(histog->f, Char); /* 1 2 3 4 5 */ /* 12345678901234567890123456789012345678901234567890 */ filltrigger(&t, "beginning value "); resettrigger(&t); if (parameterversion <= bugversion226) lines = 4; else lines = 0; mover(picout, 0.0, -lines * boxwidth); /* move from top of page */ while (gotten && !done) { getstring(histog, &line, &gotten); if (!gotten) break; /* debug line: writestring(output,line);writeln(output); */ /* 2003 Aug 21, version 2.30: Why are we doing the following mover???????? This is now removed if the version number is more recent. It is a nasty bug because all parameter files depended on this. It is a holdover from some time (perhaps) when the comment lines were printed on the output. Since we don't do that anymore, it is not needed. zzz */ if (parameterversion <= bugversion226) /* and move down */ mover(picout, 0.0, -boxwidth); while (line.current <= line.length && !done) { testfortrigger(line.letters[line.current - 1], &t); if (t.found) done = true; line.current++; } lines++; } if (parameterversion <= bugversion226) *downshift = lines * boxwidth; else *downshift = 0 * boxwidth; /*zzz writeln(output,'at compute: lines: ',lines:8); writeln(output,'at compute: * boxwidth: ',boxwidth:8:2); writeln(output,'at compute: = downshift: ',downshift:8:2); */ /* skip the blank line */ if (!BUFEOF(histog->f)) { fscanf(histog->f, "%*[^\n]"); getc(histog->f); } else { printf("missing data in histog file\n"); halt(); } } /* end module genpic.copystart */ /* begin module genpic.readvalue */ Static Void readvalue(histog, b, v) _TEXT *histog; double *b, *v; { /* read the interval begin (b) and histogram value (v) from histog */ fscanf(histog->f, "%lg%lg%*[^\n]", b, v); getc(histog->f); } /* end module genpic.readvalue */ /* 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); } #define copylines 14 /* the line number of copied lines */ /* end module copyfile version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module genpic.upgradeto226 */ Static Void upgradeto226(genpicp) _TEXT *genpicp; { /* upgrade the genpicp file to version 2.26: allow control of all bounding box edges with pageedges etc. on new line 19. n 0 0 0 0 edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm */ _TEXT internal; /* a place to hold the old genpicp */ _TEXT titlesize; /* a place to hold the new parameter line */ long line; /* a line to be worked with */ double parameterversion = 2.26; /* parameter version number */ titlesize.f = NULL; *titlesize.name = '\0'; internal.f = NULL; *internal.name = '\0'; printf("upgrading to version %4.2f ...\n", parameterversion); /* Read through and insert a new parameter for the second title size: COPY 2.20 version of genpicp that this parameter file is designed for. 1.0 x cm 10.0 y cm 0 rotation 4 graphheight, height of the graph, cm 0.3 boxwidth, width of the histogram boxes, cm 0.6 intervalsize, space for interval number, cm 0.6 histogramvalue, space for histogram value, cm 0 boxshift, shift boxes up relative to numbers, cm 5 field: number of characters devoted to the interval 1 decimal: number of characters devoted to the interval's decimal places 5 field: number of characters devoted to the number of numbers 1 modulo: multiples of this number are shown 0 barlocation: where to put a vertical bar COPY TO HERE (ie lines 2 to 14 since the first line is already read) CAPTURE THIS SEPARATELY: 12 column name size (points) COPY THREE LINES (16 to 18): 0 relative column 1 name x coordinate adjustment (cm) 0.20 relative column 1 name y coordinate adjustment (cm) Rsequence (bits) INSERT THE CAPTURED LINE HERE THEN COPY TO END 0 relative column 2 name x coordinate adjustment (cm) 0.40 relative column 2 name y coordinate adjustment (cm) number 14 title name size (points) -5.2 relative title x coordinate adjustment (cm) 0.0 relative title y coordinate adjustment (cm) Final Rsequence at generation 2000 1 How many more titles to do 12 other title name size (points) 0.0 relative title x coordinate adjustment (cm) -0.8 relative title y coordinate adjustment (cm) using 100 seeds ranging from 0.00 to 0.99 */ /* copy parameter file to internal */ if (*genpicp->name != '\0') { if (genpicp->f != NULL) genpicp->f = freopen(genpicp->name, "r", genpicp->f); else genpicp->f = fopen(genpicp->name, "r"); } else rewind(genpicp->f); if (genpicp->f == NULL) _EscIO2(FileNotFound, genpicp->name); RESETBUF(genpicp->f, Char); fscanf(genpicp->f, "%*[^\n]"); getc(genpicp->f); /* skip old parameter version line */ 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); for (line = 2; line <= copylines; line++) copyaline(genpicp, &internal); /* capture the main titlesize */ if (*titlesize.name != '\0') { if (titlesize.f != NULL) titlesize.f = freopen(titlesize.name, "w", titlesize.f); else titlesize.f = fopen(titlesize.name, "w"); } else { if (titlesize.f != NULL) rewind(titlesize.f); else titlesize.f = tmpfile(); } if (titlesize.f == NULL) _EscIO2(FileNotFound, titlesize.name); SETUPBUF(titlesize.f, Char); copyaline(genpicp, &titlesize); /* put the titlesize into internal */ if (*titlesize.name != '\0') { if (titlesize.f != NULL) titlesize.f = freopen(titlesize.name, "r", titlesize.f); else titlesize.f = fopen(titlesize.name, "r"); } else rewind(titlesize.f); if (titlesize.f == NULL) _EscIO2(FileNotFound, titlesize.name); RESETBUF(titlesize.f, Char); copyaline(&titlesize, &internal); /* copy the three title1 lines: */ for (line = 16; line <= 18; line++) copyaline(genpicp, &internal); /* put the titlesize into internal NEW PARAMETER */ if (*titlesize.name != '\0') { if (titlesize.f != NULL) titlesize.f = freopen(titlesize.name, "r", titlesize.f); else titlesize.f = fopen(titlesize.name, "r"); } else rewind(titlesize.f); if (titlesize.f == NULL) _EscIO2(FileNotFound, titlesize.name); RESETBUF(titlesize.f, Char); copyaline(&titlesize, &internal); /* finish the copy of parameter file to internal */ copyfile(genpicp, &internal); /* write the NEW PARAMETER LINE */ fprintf(internal.f, "n 0 0 0 0 edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm\n"); /* copy internal to parameter file */ 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 (*genpicp->name != '\0') { if (genpicp->f != NULL) genpicp->f = freopen(genpicp->name, "w", genpicp->f); else genpicp->f = fopen(genpicp->name, "w"); } else { if (genpicp->f != NULL) rewind(genpicp->f); else genpicp->f = tmpfile(); } if (genpicp->f == NULL) _EscIO2(FileNotFound, genpicp->name); SETUPBUF(genpicp->f, Char); fprintf(genpicp->f, "%4.2f version of genpicp that this parameter file is designed for.\n", parameterversion); copyfile(&internal, genpicp); /* add the new material at the end: */ /* none to add */ if (*genpicp->name != '\0') { if (genpicp->f != NULL) genpicp->f = freopen(genpicp->name, "r", genpicp->f); else genpicp->f = fopen(genpicp->name, "r"); } else rewind(genpicp->f); if (genpicp->f == NULL) _EscIO2(FileNotFound, genpicp->name); RESETBUF(genpicp->f, Char); /* ready to start reading again */ if (internal.f != NULL) fclose(internal.f); if (titlesize.f != NULL) fclose(titlesize.f); } #undef copylines #define copylines 14 /* the line number of copied lines - before titles */ /* end module genpic.upgradeto226 */ /* begin module genpic.upgradeto250 */ Static Void upgradeto250(genpicp) _TEXT *genpicp; { /* upgrade the genpicp file to version 2.50: y axis controls */ _TEXT internal; /* a place to hold the old genpicp */ _TEXT titlesize; /* a place to hold the new parameter line */ long line; /* a line to be worked with */ double parameterversion = 2.50; /* parameter version number */ titlesize.f = NULL; *titlesize.name = '\0'; internal.f = NULL; *internal.name = '\0'; printf("upgrading to version %4.2f ...\n", parameterversion); /* Read through and insert a new parameter for the second title size: COPY 2.20 version of genpicp that this parameter file is designed for. 1.0 x cm 10.0 y cm 0 rotation 4 graphheight, height of the graph, cm 0.3 boxwidth, width of the histogram boxes, cm 0.6 intervalsize, space for interval number, cm 0.6 histogramvalue, space for histogram value, cm 0 boxshift, shift boxes up relative to numbers, cm 5 field: number of characters devoted to the interval 1 decimal: number of characters devoted to the interval's decimal places 5 field: number of characters devoted to the number of numbers 1 modulo: multiples of this number are shown 0 barlocation: where to put a vertical bar COPY TO HERE (ie lines 2 to 14 since the first line is already read) CAPTURE THIS SEPARATELY: 12 column name size (points) COPY THREE LINES (16 to 18): 0 relative column 1 name x coordinate adjustment (cm) 0.20 relative column 1 name y coordinate adjustment (cm) Rsequence (bits) INSERT THE CAPTURED LINE HERE THEN COPY TO END 0 relative column 2 name x coordinate adjustment (cm) 0.40 relative column 2 name y coordinate adjustment (cm) number 14 title name size (points) -5.2 relative title x coordinate adjustment (cm) 0.0 relative title y coordinate adjustment (cm) Final Rsequence at generation 2000 1 How many more titles to do 12 other title name size (points) 0.0 relative title x coordinate adjustment (cm) -0.8 relative title y coordinate adjustment (cm) using 100 seeds ranging from 0.00 to 0.99 */ /* copy parameter file to internal */ if (*genpicp->name != '\0') { if (genpicp->f != NULL) genpicp->f = freopen(genpicp->name, "r", genpicp->f); else genpicp->f = fopen(genpicp->name, "r"); } else rewind(genpicp->f); if (genpicp->f == NULL) _EscIO2(FileNotFound, genpicp->name); RESETBUF(genpicp->f, Char); fscanf(genpicp->f, "%*[^\n]"); getc(genpicp->f); /* skip old parameter version line */ 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); for (line = 2; line <= copylines; line++) copyaline(genpicp, &internal); /* capture the main titlesize */ if (*titlesize.name != '\0') { if (titlesize.f != NULL) titlesize.f = freopen(titlesize.name, "w", titlesize.f); else titlesize.f = fopen(titlesize.name, "w"); } else { if (titlesize.f != NULL) rewind(titlesize.f); else titlesize.f = tmpfile(); } if (titlesize.f == NULL) _EscIO2(FileNotFound, titlesize.name); SETUPBUF(titlesize.f, Char); copyaline(genpicp, &titlesize); /* put the titlesize into internal */ if (*titlesize.name != '\0') { if (titlesize.f != NULL) titlesize.f = freopen(titlesize.name, "r", titlesize.f); else titlesize.f = fopen(titlesize.name, "r"); } else rewind(titlesize.f); if (titlesize.f == NULL) _EscIO2(FileNotFound, titlesize.name); RESETBUF(titlesize.f, Char); copyaline(&titlesize, &internal); /* copy the three title1 lines: */ for (line = 16; line <= 18; line++) copyaline(genpicp, &internal); /* finish the copy of parameter file to internal */ copyfile(genpicp, &internal); /* write the NEW PARAMETER LINES */ fprintf(internal.f, "x 17 5 5 0.1 -0.00 -0.35 xaxis: control max int subint ticlength ticdx ticdy\n"); fprintf(internal.f, "y 15 5 5 0.1 -0.12 -0.12 yaxis: control max int subint ticlength ticdx ticdy\n"); /* copy internal to parameter file */ 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 (*genpicp->name != '\0') { if (genpicp->f != NULL) genpicp->f = freopen(genpicp->name, "w", genpicp->f); else genpicp->f = fopen(genpicp->name, "w"); } else { if (genpicp->f != NULL) rewind(genpicp->f); else genpicp->f = tmpfile(); } if (genpicp->f == NULL) _EscIO2(FileNotFound, genpicp->name); SETUPBUF(genpicp->f, Char); fprintf(genpicp->f, "%4.2f version of genpicp that this parameter file is designed for.\n", parameterversion); copyfile(&internal, genpicp); /* add the new material at the end: */ /* none to add */ if (*genpicp->name != '\0') { if (genpicp->f != NULL) genpicp->f = freopen(genpicp->name, "r", genpicp->f); else genpicp->f = fopen(genpicp->name, "r"); } else rewind(genpicp->f); if (genpicp->f == NULL) _EscIO2(FileNotFound, genpicp->name); RESETBUF(genpicp->f, Char); /* ready to start reading again */ if (internal.f != NULL) fclose(internal.f); if (titlesize.f != NULL) fclose(titlesize.f); } #undef copylines /* end module genpic.upgradeto250 */ /* begin module genpic.writetitle */ Static Void writetitle(afile, t) _TEXT *afile; title *t; { /* write title information to file afile */ if (t == NULL) return; fprintf(afile->f, "%% %ld size in points\n", t->titlenamesize); fprintf(afile->f, "%% %*.*f relative x adjustment\n", difield, didecimal, t->titlex); fprintf(afile->f, "%% %*.*f relative y adjustment\n", difield, didecimal, t->titley); fprintf(afile->f, "%% \""); writestring(afile, &t->letters); fprintf(afile->f, "\"\n"); } /* end module genpic.writetitle */ /* begin module genpic.readtitle */ Static Void readtitle(genpicp, t) _TEXT *genpicp; title **t; { /* read title information from file genpicp */ boolean gotten; /* a line was gotten from genpicp */ title *WITH; WITH = *t; /* writeln(output); writetitle(output, t); */ fscanf(genpicp->f, "%ld%*[^\n]", &WITH->titlenamesize); getc(genpicp->f); fscanf(genpicp->f, "%lg%*[^\n]", &WITH->titlex); getc(genpicp->f); fscanf(genpicp->f, "%lg%*[^\n]", &WITH->titley); getc(genpicp->f); getstring(genpicp, &WITH->letters, &gotten); if (!gotten) { printf("could not find title while reading genpicp\n"); halt(); } } /* Local variables for readparam: */ struct LOC_readparam { _TEXT *afile; boolean checkout; /* if true, all variable values are ok */ /* parameterversion: real; (* parameter version number *) */ long paramnumber; /* the number of the parameter about to be read */ } ; Local Void cn(LINK) struct LOC_readparam *LINK; { /* short version of call to check number */ LINK->checkout = checknumber(LINK->afile); if (!LINK->checkout) /* avoid snowballing */ halt(); } Local Void bomb(LINK) struct LOC_readparam *LINK; { /* what to do if a parameter is missing */ LINK->paramnumber++; if (BUFEOF(LINK->afile->f)) { printf("genpic: readparam: missing parameter number%ld\n", LINK->paramnumber); halt(); } } /* end module genpic.readtitle */ /* begin module genpic.readparam */ Static Void readparam(afile_, x, y, rotation, graphheight, boxwidth, intervalsize, histogramvalue, boxshift, ifield, idecimal, nfield, modulo, modulomultiplier, barlocation, title1, title2, title3, othertitles, titles, edgecontrol, edgeleft, edgeright, edgelow, edgehigh, xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals, xaxisticlength, xaxisticdx, xaxisticdy, yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals, yaxisticlength, yaxisticdx, yaxisticdy, dobugreport) /* p2c: genpic.p, line 2453: * Note: Line breaker spent 0.0 seconds, 5000 tries on line 2930 [251] */ _TEXT *afile_; double *x, *y, *rotation, *graphheight, *boxwidth, *intervalsize, *histogramvalue, *boxshift; long *ifield, *idecimal, *nfield, *modulo; double *modulomultiplier; long *barlocation; title **title1, **title2, **title3; long *othertitles; title **titles; Char *edgecontrol; double *edgeleft, *edgeright, *edgelow, *edgehigh; Char *xaxiscontrol; long *xaxismax, *xaxisintervals, *xaxissubintervals; double *xaxisticlength, *xaxisticdx, *xaxisticdy; Char *yaxiscontrol; long *yaxismax, *yaxisintervals, *yaxissubintervals; double *yaxisticlength, *yaxisticdx, *yaxisticdy; boolean *dobugreport; { /* the main three titles */ /* number of other titles */ /* the other titles */ /* if 'p' then use page instead of edges */ /* added edges around the graph in cm */ /* x axis controls: */ /* x = plot x axis */ /* maximum, intervals, sub-intervals for x axis */ /* y axis controls: */ /* y = plot y axis */ /* maximum, intervals, sub-intervals for y axis */ /* whether to tell the user how to fix the 2.26 bug */ /* read the parameters as described in the manual */ struct LOC_readparam V; long o; /* index to othertitles */ title *t; /* pointer to titles */ long FORLIM; V.afile = afile_; if (*V.afile->name != '\0') { if (V.afile->f != NULL) V.afile->f = freopen(V.afile->name, "r", V.afile->f); else V.afile->f = fopen(V.afile->name, "r"); } else rewind(V.afile->f); if (V.afile->f == NULL) _EscIO2(FileNotFound, V.afile->name); RESETBUF(V.afile->f, Char); *dobugreport = false; if (BUFEOF(V.afile->f)) { *x = dx; *y = dy; *rotation = drotation; *graphheight = dgraphheight; *boxwidth = dboxwidth; *intervalsize = dintervalsize; *histogramvalue = dhistogramvalue; *boxshift = dboxshift; *ifield = difield; *idecimal = didecimal; *nfield = dnfield; *modulo = dmodulo; *modulomultiplier = dmodulomultiplier; *barlocation = 0; return; } fscanf(V.afile->f, "%lg%*[^\n]", ¶meterversion); getc(V.afile->f); if ((long)floor(100 * parameterversion + 0.5) < (long)floor(100 * updateversion + 0.5)) { printf("You have an old parameter file!\n"); printf("parameterversion is %4.2f\n", parameterversion); printf(" updateversion is %4.2f\n", updateversion); if ((long)floor(100 * parameterversion + 0.5) < (long)floor(100 * 2.26 + 0.5)) upgradeto226(&genpicp); else { if (*V.afile->name != '\0') { if (V.afile->f != NULL) V.afile->f = freopen(V.afile->name, "r", V.afile->f); else V.afile->f = fopen(V.afile->name, "r"); } else rewind(V.afile->f); if (V.afile->f == NULL) _EscIO2(FileNotFound, V.afile->name); RESETBUF(V.afile->f, Char); } if ((long)floor(100 * parameterversion + 0.5) <= (long)floor(100 * bugversion226 + 0.5)) { printf("******************************************\n"); printf("*********** WARNING **********************\n"); printf("******************************************\n"); printf("* You have an old parameter file, with a *\n"); printf("* version <= 2.26, that has a bug in it. *\n"); printf("* To fix the bug, *\n"); printf("* update the version number to: *\n"); printf("* 2.32 *\n"); printf("* Then you will find that your graph *\n"); printf("* shifts to the left (negative x value). *\n"); printf("* Correct this by hand. *\n"); /* writeln(output,'* zzz *'); */ printf("******************************************\n"); *dobugreport = true; } if ((long)floor(100 * parameterversion + 0.5) < (long)floor(100 * 2.50 + 0.5)) upgradeto250(&genpicp); else { if (*V.afile->name != '\0') { if (V.afile->f != NULL) V.afile->f = freopen(V.afile->name, "r", V.afile->f); else V.afile->f = fopen(V.afile->name, "r"); } else rewind(V.afile->f); if (V.afile->f == NULL) _EscIO2(FileNotFound, V.afile->name); RESETBUF(V.afile->f, Char); } fscanf(V.afile->f, "%lg%*[^\n]", ¶meterversion); getc(V.afile->f); } V.paramnumber = 1; bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", x); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", y); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", rotation); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", graphheight); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", boxwidth); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", intervalsize); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", histogramvalue); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%lg%*[^\n]", boxshift); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%ld%*[^\n]", ifield); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%ld%*[^\n]", idecimal); getc(V.afile->f); bomb(&V); fscanf(V.afile->f, "%ld%*[^\n]", nfield); getc(V.afile->f); bomb(&V); /* readln(afile,modulo); */ fscanf(V.afile->f, "%ld", modulo); skipblanks(V.afile); if (!P_eoln(V.afile->f)) { if (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') fscanf(V.afile->f, "%lg", modulomultiplier); else *modulomultiplier = dmodulomultiplier; } else { /* default value */ *modulomultiplier = dmodulomultiplier; /* default value */ } fscanf(V.afile->f, "%*[^\n]"); getc(V.afile->f); /* skip the reset of the line */ /* writeln(output,'modulomultiplier = ', modulomultiplier:2); */ bomb(&V); fscanf(V.afile->f, "%ld%*[^\n]", barlocation); getc(V.afile->f); *title1 = (title *)Malloc(sizeof(title)); readtitle(&genpicp, title1); (*title1)->next = NULL; *title2 = (title *)Malloc(sizeof(title)); readtitle(&genpicp, title2); (*title2)->next = NULL; *title3 = (title *)Malloc(sizeof(title)); readtitle(&genpicp, title3); (*title3)->next = NULL; /* read in additional titles */ fscanf(genpicp.f, "%ld%*[^\n]", othertitles); getc(genpicp.f); printf("reading in %ld other titles\n", *othertitles); if (*othertitles > 0) { *titles = (title *)Malloc(sizeof(title)); t = *titles; FORLIM = *othertitles; for (o = 1; o <= FORLIM; o++) { if (BUFEOF(V.afile->f)) { printf("found end of genpicp when reading in titles\n"); halt(); } if (o > 1) { t->next = (title *)Malloc(sizeof(title)); t = t->next; t->next = NULL; } readtitle(&genpicp, &t); } } else *titles = NULL; *edgecontrol = getc(genpicp.f); if (*edgecontrol == '\n') { *edgecontrol = ' '; } bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", edgeleft); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", edgeright); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", edgelow); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", edgehigh); fscanf(genpicp.f, "%*[^\n]"); getc(genpicp.f); *xaxiscontrol = getc(genpicp.f); if (*xaxiscontrol == '\n') *xaxiscontrol = ' '; bomb(&V); cn(&V); fscanf(genpicp.f, "%ld", xaxismax); bomb(&V); cn(&V); fscanf(genpicp.f, "%ld", xaxisintervals); bomb(&V); cn(&V); fscanf(genpicp.f, "%ld", xaxissubintervals); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", xaxisticlength); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", xaxisticdx); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", xaxisticdy); fscanf(genpicp.f, "%*[^\n]"); getc(genpicp.f); *yaxiscontrol = getc(genpicp.f); if (*yaxiscontrol == '\n') *yaxiscontrol = ' '; bomb(&V); cn(&V); fscanf(genpicp.f, "%ld", yaxismax); bomb(&V); cn(&V); fscanf(genpicp.f, "%ld", yaxisintervals); bomb(&V); cn(&V); fscanf(genpicp.f, "%ld", yaxissubintervals); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", yaxisticlength); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", yaxisticdx); bomb(&V); cn(&V); fscanf(genpicp.f, "%lg", yaxisticdy); fscanf(genpicp.f, "%*[^\n]"); getc(genpicp.f); if (*yaxismax <= 0) { printf("yaxismax must be positive\n"); halt(); } } /* end module genpic.readparam */ /* begin module genpic.writeparam */ Static Void writeparam(afile, fc, x, y, rotation, graphheight, boxwidth, intervalsize, histogramvalue, boxshift, ifield, idecimal, nfield, modulo, modulomultiplier, barlocation, title1, title2, title3, othertitles, titles, edgecontrol, edgeleft, edgeright, edgelow, edgehigh, xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals, xaxisticlength, xaxisticdx, xaxisticdy, yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals, yaxisticlength, yaxisticdx, yaxisticdy) /* p2c: genpic.p, line 2536: * Note: Line breaker spent 0.0 seconds, 5000 tries on line 3255 [251] */ _TEXT *afile; Char fc; double x, y, rotation, graphheight, boxwidth, intervalsize, histogramvalue, boxshift; long ifield, idecimal, nfield, modulo; double modulomultiplier; long barlocation; title *title1, *title2, *title3; long othertitles; title *titles; Char edgecontrol; double edgeleft, edgeright, edgelow, edgehigh; Char xaxiscontrol; long xaxismax, xaxisintervals, xaxissubintervals; double *xaxisticlength, *xaxisticdx, *xaxisticdy; Char yaxiscontrol; long yaxismax, yaxisintervals, yaxissubintervals; double *yaxisticlength, *yaxisticdx, *yaxisticdy; { /* the main titles */ /* number of other titles */ /* the other titles */ /* if 'p' then use page instead of edges */ /* edges around */ /* x = plot x axis */ /* maximum and intervals for x axis */ /* x axis tic controls: length and positioning of the tic mark */ /* y = plot y axis */ /* maximum and intervals for y axis */ /* y axis tic controls: length and positioning of the tic mark */ /* write the parameters. If fc - first character - is '%' the parameters can be used for the postscript output. */ long o; /* index to othertitles */ title *t; /* pointer to titles */ fprintf(afile->f, "%c the parameters used are:\n", fc); fprintf(afile->f, "%c%10.5f x\n", fc, x); fprintf(afile->f, "%c%10.5f y\n", fc, y); fprintf(afile->f, "%c%10.5f rotation\n", fc, rotation); fprintf(afile->f, "%c%10.5f graphheight\n", fc, graphheight); fprintf(afile->f, "%c%10.5f boxwidth\n", fc, boxwidth); fprintf(afile->f, "%c%10.5f interval size\n", fc, intervalsize); fprintf(afile->f, "%c%10.5f histogram value\n", fc, histogramvalue); fprintf(afile->f, "%c%10.5f box shift\n", fc, boxshift); fprintf(afile->f, "%c%5ld field width of interval numbers\n", fc, ifield); fprintf(afile->f, "%c%5ld decimals of interval numbers\n", fc, idecimal); fprintf(afile->f, "%c%5ld field width of number data column\n", fc, nfield); fprintf(afile->f, "%c%5ld %5.1f numbers modulo this are plotted and multiplier\n", fc, modulo, modulomultiplier); fprintf(afile->f, "%c%5ld barlocation: where to put a vertical bar\n", fc, barlocation); fprintf(afile->f, "%c%5ld number of other titles\n", fc, othertitles); /* write out the other titles */ writetitle(afile, title1); writetitle(afile, title2); writetitle(afile, title3); t = titles; for (o = 1; o <= othertitles; o++) { writetitle(afile, t); t = t->next; } fprintf(afile->f, "%c %c %1.3f %1.3f %1.3f %1.3f edgecontrol (p=page), edgeleft, edgeright, edgelow, edgehigh in cm\n", fc, edgecontrol, edgeleft, edgeright, edgelow, edgehigh); fprintf(afile->f, "%c %c %ld %ld %ld xaxiscontrol (x=axis), xaxismax, xaxisintervals\n", fc, xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals); fprintf(afile->f, "%c %c %ld %ld %ld yaxiscontrol (y=axis), yaxismax, yaxisintervals\n", fc, yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals); } /* Local variables for buildpic: */ struct LOC_buildpic { _TEXT *picout; double halfsmallbox; /* half of the size of a small box */ /* a factor to convert between numbers and graphical distances in cm */ double smallbox; /* size of small boxes to plot */ } ; Local Void dosmallbox(LINK) struct LOC_buildpic *LINK; { /* make a small box at the current position */ mover(LINK->picout, -LINK->halfsmallbox, -LINK->halfsmallbox); boxr(LINK->picout, LINK->smallbox, LINK->smallbox); mover(LINK->picout, LINK->halfsmallbox, LINK->halfsmallbox); } /* end module genpic.writeparam */ /* begin module genpic.buildpic */ Static Void buildpic(hdata, histog, picout_, graphheight, boxwidth, intervalsize, histogramvalue, boxshift, ifield, idecimal, nfield, modulo, modulomultiplier, barlocation, downshift, title1, title2, title3, othertitles, titles, xaxiscontrol, yaxiscontrol) histdata hdata; _TEXT *histog, *picout_; double graphheight, boxwidth, intervalsize, histogramvalue, boxshift; long ifield, idecimal, nfield, modulo; double modulomultiplier; long barlocation; double downshift; title *title1, *title2, *title3; long othertitles; title *titles; Char xaxiscontrol, yaxiscontrol; { /* the first title */ /* the second title */ /* the third title */ /* the number of other titles */ /* the other titles */ /* construct the picture of histog into picout use ymaximum to adjust the size of the plot */ struct LOC_buildpic V; double b; /* the interval beginning */ long index = 0; /* an index for plotting the standard curve */ long o; /* index to other titles */ double returnx; /* how far to move back on x axis to get to the next line */ double returny; /* how far to move back on y axis to get to the next line */ double scale; rhistarray stanarray; /* an array to store the standard curve in */ double v; /* the histogram value */ double scalev; /* scale * v, the height of the box in points */ double shiftup; /* how much to move the bottom of the vertical bar up to avoid touching the prediction curve */ title *t; /* pointer into other titles */ title *WITH; V.picout = picout_; /* compute the plot */ if (hdata.plot != 'n') { /* set up the stanarray */ stanarray.range[(long)start] = hdata.start_; stanarray.range[(long)stop] = hdata.stop_; stanarray.interval = hdata.xinterval; stanarray.slots = hdata.slots; /* calculate the curve */ if (hdata.plot == 'g') gaushist(hdata.entries, hdata.mean, hdata.variance, &stanarray); else if (hdata.plot == 'p') poishist(hdata.entries, hdata.mean, &stanarray); else { printf("pic: build: unknown plot type ,%c\n", hdata.plot); halt(); } } returnx = -intervalsize - histogramvalue; returny = -boxwidth - boxshift; scale = graphheight / hdata.ymaximum; V.smallbox = boxwidth / 4; V.halfsmallbox = V.smallbox / 2; /* writeln(output, ' modulomultiplier=', modulomultiplier:2); */ while (!BUFEOF(histog->f)) { /* generate the histogram */ readvalue(histog, &b, &v); index++; /* turn off normal axis if the xaxis control is on */ if (xaxiscontrol != 'x') { /* the spacings for b and v come from genhis */ if ((long)floor(modulomultiplier * b + 0.5) % modulo == 0) { /* p2c: genpic.p, line 2619: * Note: Using % for possibly-negative arguments [317] */ picnumber(V.picout, 0.0, 0.0, b, ifield, idecimal, 'r'); } /* write (output, 'b=',b:5:1); write (output, ' round(modulomultiplier*b)=', round(modulomultiplier*b):2); write (output, ' (round(modulomultiplier*b) mod modulo)=', (round(modulomultiplier*b) mod modulo):2); writeln(output); */ mover(V.picout, intervalsize, 0.0); if ((long)floor(modulomultiplier * b + 0.5) % modulo == 0) { /* p2c: genpic.p, line 2631: * Note: Using % for possibly-negative arguments [317] */ picnumber(V.picout, 0.0, 0.0, (double)((long)floor(v + 0.5)), nfield, 0L, 'r'); } } else mover(V.picout, intervalsize, 0.0); mover(V.picout, histogramvalue, boxshift); scalev = scale * v; if (b == barlocation) { /* vertical bar */ if (hdata.plot != 'n') { if (stanarray.numbers[index-1] > v) shiftup = scale * stanarray.numbers[index-1]; else { shiftup = scalev; /* ;if stanarray.numbers[index] > v then writeln(output,'> using stanarray',stanarray.numbers[index]:10:5) else writeln(output,'<= using box',v:10:5) */ } } else shiftup = scalev; shiftup += 4 * V.smallbox; mover(V.picout, shiftup, boxwidth / 2); liner(V.picout, graphheight - shiftup, 0.0); mover(V.picout, shiftup - graphheight, 0.0); /* undo liner */ mover(V.picout, -shiftup, boxwidth / -2); /* old box method: mover(picout,+shiftup,+boxwidth/2); boxr(picout, graphheight - shiftup, halfsmallbox); mover(picout,-shiftup,-boxwidth/2); */ } boxr(V.picout, scalev, boxwidth); mover(V.picout, returnx, returny); } /* move to position ready to write next number */ mover(V.picout, returnx, returny); fprintf(V.picout->f, "%% now create the names\n"); /* the FIRST title */ fprintf(V.picout->f, "gsave\n"); fprintf(V.picout->f, " currentpoint translate\n"); fprintf(V.picout->f, " -90 rotate\n"); fprintf(V.picout->f, " gsave\n"); fprintf(V.picout->f, " /columnnamesize %ld def\n", title1->titlenamesize); fprintf(V.picout->f, " /Courier-Bold findfont columnnamesize scalefont setfont\n"); fprintf(V.picout->f, " 0 %*.*f cm rmoveto\n", picwidth, picdecim, intervalsize); fprintf(V.picout->f, " /col1x %*.*f def\n", picwidth, picdecim, title1->titlex); fprintf(V.picout->f, " /col1y %*.*f def\n", picwidth, picdecim, title1->titley); fprintf(V.picout->f, " col1x cm col1y cm rmoveto\n"); fprintf(V.picout->f, " ("); writestring(V.picout, &title1->letters); fprintf(V.picout->f, ") show\n"); fprintf(V.picout->f, " grestore\n"); /* the SECOND title */ fprintf(V.picout->f, " gsave\n"); fprintf(V.picout->f, " /columnnamesize %ld def\n", title2->titlenamesize); fprintf(V.picout->f, " /Courier-Bold findfont columnnamesize scalefont setfont\n"); fprintf(V.picout->f, " 0 %*.*f cm rmoveto\n", picwidth, picdecim, intervalsize); fprintf(V.picout->f, " 0 %*.*f cm rmoveto\n", picwidth, picdecim, histogramvalue); fprintf(V.picout->f, " /col2x %*.*f def\n", picwidth, picdecim, title2->titlex); fprintf(V.picout->f, " /col2y %*.*f def\n", picwidth, picdecim, title2->titley); fprintf(V.picout->f, " col2x cm col2y cm rmoveto\n"); fprintf(V.picout->f, " ("); writestring(V.picout, &title2->letters); fprintf(V.picout->f, ") show\n"); fprintf(V.picout->f, " grestore\n"); fprintf(V.picout->f, "grestore\n"); fprintf(V.picout->f, "gsave\n"); /* the THIRD title */ fprintf(V.picout->f, " currentpoint translate\n"); fprintf(V.picout->f, " -90 rotate\n"); fprintf(V.picout->f, "%*.*f cm 0 cm rmoveto\n", picwidth, picdecim, hdata.slots * boxwidth / -2); fprintf(V.picout->f, " /titlenamesize %3ld def\n", title3->titlenamesize); fprintf(V.picout->f, " /titlex %*.*f def\n", picwidth, picdecim, title3->titlex); fprintf(V.picout->f, " /titley %*.*f def\n", picwidth, picdecim, title3->titley); fprintf(V.picout->f, " titlex cm titley cm rmoveto\n"); fprintf(V.picout->f, " /Courier-Bold findfont titlenamesize scalefont setfont\n"); fprintf(V.picout->f, " ("); writestring(V.picout, &title3->letters); fprintf(V.picout->f, ") show\n"); fprintf(V.picout->f, "grestore\n"); if (othertitles > 0) { t = titles; for (o = 1; o <= othertitles; o++) { WITH = t; fprintf(V.picout->f, "gsave\n"); fprintf(V.picout->f, " currentpoint translate\n"); fprintf(V.picout->f, " -90 rotate\n"); fprintf(V.picout->f, "%*.*f cm 0 cm rmoveto\n", picwidth, picdecim, -(hdata.slots + 2) * boxwidth); fprintf(V.picout->f, " /titlenamesize %ld def\n", t->titlenamesize); fprintf(V.picout->f, " /titlex %*.*f def\n", picwidth, picdecim, t->titlex); fprintf(V.picout->f, " /titley %*.*f def\n", picwidth, picdecim, t->titley); fprintf(V.picout->f, " titlex cm titley cm rmoveto\n"); fprintf(V.picout->f, " /Courier-Bold findfont titlenamesize scalefont setfont\n"); fprintf(V.picout->f, " ("); writestring(V.picout, &t->letters); fprintf(V.picout->f, ") show\n"); fprintf(V.picout->f, "grestore\n"); t = t->next; } if (t != NULL) { printf("buildpic: extra titles on list not accounted for\n"); halt(); } } /* put overlay plot onto the graph */ if (hdata.plot != 'n') { /* this is the edge of the box */ movea(V.picout, scale * stanarray.numbers[0] - returnx, boxshift - downshift + boxwidth / 2); /*zzz */ /*Why downshift here? 2003 aug 22 - this is the overlay plot - downshift is set to zero earlier if we have new parameters. */ dosmallbox(&V); for (index = 2; index <= hdata.slots; index++) { liner(V.picout, scale * (stanarray.numbers[index-1] - stanarray.numbers[index-2]), -boxwidth); dosmallbox(&V); } } /* plot the curve */ /* move to the first point on the first box: */ stoppic(V.picout); } /* end module genpic.buildpic */ /* begin module postscriptheader */ Static Void postscriptheader(a, title_, creator, llx, lly, urx, ury) _TEXT *a; string title_, creator; double llx, lly, urx, ury; { /* lower left x */ /* lower left y */ /* upper left x */ /* upper left y */ /* Start writing postscript to file a. This can be used to in conjunction with makepageedges. REQUIRES: postscript.const */ fprintf(a->f, "%%!PS-Adobe-2.0 EPSF-2.0\n"); fprintf(a->f, "%%%%Title: "); writestring(a, &title_); fprintf(a->f, " %4.2f\n", version); fprintf(a->f, "%%%%Creator: "); writestring(a, &creator); fprintf(a->f, "\n%%%%BoundingBox: %5ld %5ld %5ld %5ld\n", (long)floor(llx + 0.5), (long)floor(lly + 0.5), (long)floor(urx + 0.5), (long)floor(ury + 0.5)); /* BoundingBox values must be integer according to the Red book, page 234 ' ',llx:5:1, ' ',lly:5:1, ' ',urx:5:1, ' ',ury:5:1); */ fprintf(a->f, "%%%%DocumentFonts:\n"); fprintf(a->f, "%%%%EndComments\n"); /* 2005 Aug 6 Try to fool acrobat. when an image is rotated 90 degrees, Acrobat will reorient it. STOOOOPPPPPIIIIDDD. So use two 45 degree rotations to avoid the problem. Maybe some day this bug in Acrobat will be fixed tna the following will help. For now it just provides a tad more control but does not solve the problem. */ fprintf(a->f, "%%%%BeginDefaults\n"); fprintf(a->f, "%%%%PageOrientation: Portrait\n"); fprintf(a->f, "%%%%EndDefaults\n"); fprintf(a->f, "%%%%Orientation: Portrait\n"); fprintf(a->f, "/defaultllx %5.1f def\n", defaultllx); fprintf(a->f, "/defaultlly %5.1f def\n", defaultlly); fprintf(a->f, "/defaulturx %5.1f def\n", defaulturx); fprintf(a->f, "/defaultury %5.1f def\n", defaultury); fprintf(a->f, "/llx %5.1f def\n", llx); fprintf(a->f, "/lly %5.1f def\n", lly); fprintf(a->f, "/urx %5.1f def\n", urx); fprintf(a->f, "/ury %5.1f def\n", ury); } /* end module postscriptheader version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module initpostscript */ Static Void initpostscript(title_, creator, x, y, graphheight, boxwidth, title1, title2, title3, llx, lly, urx, ury, edgecontrol, edgeleft, edgeright, edgelow, edgehigh) string *title_, *creator; double x, y, graphheight, boxwidth; title *title1, *title2, *title3; double *llx, *lly, *urx, *ury; Char edgecontrol; double edgeleft, edgeright, edgelow, edgehigh; { /* parameter: lower left x */ /* parameter: lower left y */ /* parameter: graphheight */ /* parameter: width */ /* titles */ /* lower left x */ /* lower left y */ /* upper left x */ /* upper left y */ /* if 'p' then use page instead of edges */ /* edges around the fig */ /* initialize some postscript variables code taken from lister.p */ double cmfactor = 72 / 2.54; /* convert from cm to points */ /* conversion factor from cm to points */ /* (72 points / inch) / (2.54 cm per inch) */ clearstring(title_); title_->letters[0] = 'g'; title_->letters[1] = 'e'; title_->letters[2] = 'n'; title_->letters[3] = 'p'; title_->letters[4] = 'i'; title_->letters[5] = 'c'; title_->length = 6; clearstring(creator); creator->letters[0] = 'T'; creator->letters[1] = 'o'; creator->letters[2] = 'm'; creator->letters[3] = ' '; creator->letters[4] = 'S'; creator->letters[5] = 'c'; creator->letters[6] = 'h'; creator->letters[7] = 'n'; creator->letters[8] = 'e'; creator->letters[9] = 'i'; creator->letters[10] = 'd'; creator->letters[11] = 'e'; creator->letters[12] = 'r'; creator->length = 13; /* compute the bounds of the figure */ if (edgecontrol == 'p') { /* default page edges */ /* Note: deltaXcm and deltaYcm are applied in the PostScript startpage routine in this mode. */ *llx = defaultllx; *ury = defaultury; *urx = defaulturx; *lly = defaultlly; } else { *llx = defaultllx; *ury = defaultury; *urx = defaulturx; *lly = defaultlly; /* llx := defaultllx + (x -0 (* fudge factor to give initially extra space *) )*cmfactor; */ *llx = defaultllx; /* poo. give page width */ *lly = defaultlly + (y - title1->titley - title2->titley - title3->titley - 2) * cmfactor; /* fudge factor to give initially extra space */ /* urx := defaultllx + (x+boxwidth*30 +1 (* fudge factor to give initially extra space *) )*cmfactor; */ *urx = defaulturx; /* poo. give page width */ *ury = defaultlly + (y + graphheight + 2) * cmfactor; /* fudge factor to give initially extra space */ } /* page edges shrink wrap to the figure */ /* extra edge control */ *llx -= edgeleft * cmfactor; /* C1 */ *urx += edgeright * cmfactor; *lly -= edgelow * cmfactor; *ury += edgehigh * cmfactor; /* C2 */ } /* Local variables for themain: */ struct LOC_themain { double boxwidth; /* width of boxes */ double downshift, x; /* x coordinate of graph start, cm */ } ; /* whether to tell the user how to fix the version 2.26 bug */ Local Void bugreport(LINK) struct LOC_themain *LINK; { /* tell the user exactly how to fix the bug */ printf("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"); printf("@ Here is how to fix the bug: @\n"); printf("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n"); printf("change your x coordinate from %1.4f cm", LINK->x); printf(" to %1.4f cm\n", LINK->x - LINK->downshift); printf("downshift: %8.2f\n", LINK->downshift); printf("boxwidth: %8.2f\n", LINK->boxwidth); printf("lines = downshift/boxwidth: %8.2f\n", LINK->downshift / LINK->boxwidth); } /* end module initpostscript */ /* begin module themain */ Static Void themain(histog, genpicp, picout) _TEXT *histog, *genpicp, *picout; { /* the main procedure of the program */ struct LOC_themain V; histdata data; /* data about the histogram */ /* control parameters: */ long barlocation; /* where to put a vertical bar */ double graphheight; /* height of the y axis of maximum box height */ double boxheight; /* maximum height of boxes */ double intervalsize, histogramvalue, boxshift; /* amount that the graph is shifted down to make space for the header information */ long ifield, idecimal, nfield, modulo; /* modulo for which numbers are shown */ double modulomultiplier; /* modulo multiplier */ double rotation; /* angle to rotate the graph */ string title_; /* program name for postscript */ string creator; /* creator name for postscript */ double y; /* y coordinate of graph start, cm */ title *title1; /* the first title */ title *title2; /* the second title */ title *title3; /* the third title */ long othertitles; /* number additional titles */ title *titles; /* additional titles */ /* bounding box definitions: */ double llx; /* lower left x */ double lly; /* lower left y */ double urx; /* upper left x */ double ury; /* upper left y */ Char edgecontrol; /* if 'p' then use page instead of edges */ double edgeleft, edgeright, edgelow, edgehigh; /* edges around the fig */ Char yaxiscontrol; /* if 'y' then give y axis */ long yaxismax; /* maximum size of y axis, counts */ long yaxisintervals; /* interval sizes for y axis */ long yaxissubintervals; /* number of intervals for y axis */ double yaxisticlength, yaxisticdx, yaxisticdy; /* y axis tic controls: length and positioning of the tic mark */ Char xaxiscontrol; /* if 'x' then give x axis */ long xaxismax; /* maximum size of x axis, counts */ long xaxisintervals; /* interval sizes for x axis */ long xaxissubintervals; /* number of intervals for x axis */ double xaxisticlength, xaxisticdx, xaxisticdy; /* x axis tic controls: length and positioning of the tic mark */ boolean dobugreport; _TEXT TEMP; printf(" genpic %4.2f\n", version); getdata(histog, &data); readparam(genpicp, &V.x, &y, &rotation, &graphheight, &V.boxwidth, &intervalsize, &histogramvalue, &boxshift, &ifield, &idecimal, &nfield, &modulo, &modulomultiplier, &barlocation, &title1, &title2, &title3, &othertitles, &titles, &edgecontrol, &edgeleft, &edgeright, &edgelow, &edgehigh, &xaxiscontrol, &xaxismax, &xaxisintervals, &xaxissubintervals, &xaxisticlength, &xaxisticdx, &xaxisticdy, &yaxiscontrol, &yaxismax, &yaxisintervals, &yaxissubintervals, &yaxisticlength, &yaxisticdx, &yaxisticdy, &dobugreport); /* p2c: genpic.p, line 3222: * Note: Line breaker spent 0.0 seconds, 5000 tries on line 3879 [251] */ initpostscript(&title_, &creator, V.x, y, graphheight, V.boxwidth, title1, title2, title3, &llx, &lly, &urx, &ury, edgecontrol, edgeleft, edgeright, edgelow, edgehigh); if (*picout->name != '\0') { if (picout->f != NULL) picout->f = freopen(picout->name, "w", picout->f); else picout->f = fopen(picout->name, "w"); } else { if (picout->f != NULL) rewind(picout->f); else picout->f = tmpfile(); } if (picout->f == NULL) _EscIO2(FileNotFound, picout->name); SETUPBUF(picout->f, Char); postscriptheader(picout, title_, creator, llx, lly, urx, ury); writeparam(picout, '%', V.x, y, rotation, graphheight, V.boxwidth, intervalsize, histogramvalue, boxshift, ifield, idecimal, nfield, modulo, modulomultiplier, barlocation, title1, title2, title3, othertitles, titles, edgecontrol, edgeleft, edgeright, edgelow, edgehigh, xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals, &xaxisticlength, &xaxisticdx, &xaxisticdy, yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals, &yaxisticlength, &yaxisticdx, &yaxisticdy); /* p2c: genpic.p, line 3222: * Note: Line breaker spent 0.0 seconds, 5000 tries on line 3910 [251] */ startpic(picout, defscale, V.x, y, 'c'); fprintf(picout->f, "/cmfactor 72 2.54 div def %% defines points -> centimeters\n"); fprintf(picout->f, "/cm { cmfactor mul} def %% defines centimeters\n"); fprintf(picout->f, "2 setlinecap\n"); /* 2005 Aug 6. Acrobat will re-rotate the image when it has been rotated exactly 90 degrees. Other angles are not affected. STOOOOOOOPPPPPIIIIIDDDDD!! To avoid this problem, fool acrobat by doing two 45 degree rotations! */ if (idecimal == 0) fprintf(picout->f, "%*ld", (int)ifield, (long)floor(45 + rotation + 0.5)); else fprintf(picout->f, "%*.*f", (int)ifield, (int)idecimal, 45 + rotation); fprintf(picout->f, " rotate\n"); fprintf(picout->f, "45 rotate\n\n"); fprintf(picout->f, "%%%%EndProlog\n"); fprintf(picout->f, "%%%%Page: 1\n"); putdata(picout, &data); TEMP.f = stdout; *TEMP.name = '\0'; putdata(&TEMP, &data); copystart(histog, picout, V.boxwidth, &V.downshift); /* xaxiscontrol := 'x'; xaxismax := 17; (* maximum size of x axis, counts *) xaxisintervals := 5; (* interval sizes for x axis *) xaxissubintervals := 5; (* number of intervals for x axis *) xaxisticlength := 0.1; xaxisticdx := 0.00; xaxisticdy := -1.0; */ if (xaxiscontrol == 'x') { fprintf(picout->f, "gsave\n"); fprintf(picout->f, "-90 rotate\n"); /* move the x axis into the right location: */ fprintf(picout->f, "%*.*f cm %*.*f cm translate\n", picwidth, picdecim, V.boxwidth / -2, picwidth, picdecim, intervalsize + histogramvalue); fprintf(picout->f, "0 0 moveto\n"); /*afile*/ /* writeln(output,'boxwidth ',boxwidth:10:2); writeln(output,'start ',data.start :10:2); writeln(output,'stop ',data.stop :10:2); writeln(output,'xaxismax ',xaxismax:10); */ /* 2007 Nov 28: somethin's wrong here: xaxis(picout, {afile} true, { doaxisline: boolean; line on axis is plotted } (xaxismax-data.start)*boxwidth, data.start, xaxisintervals, xaxismax, { aylength,fromtic,interval,totic: real;} xaxissubintervals, { xsubintervals: real;} xaxisticlength, xaxisticdx, xaxisticdy, { length, dx, dy: real;} 20, 0, { width, decimal: integer;} false, false, { logyscale, logynormal: boolean;} 2); { logybase: real;} */ /* procedure xaxis(var afile: text; doaxisline: boolean; (* line on axis is plotted *) axlength,fromtic,interval,totic: real; xsubintervals: real; length, dx, dy: real; width, decimal: integer; logxscale, logxnormal: boolean; logxbase: real); faiiled tries: (xaxismax-data.start)*boxwidth, fails (xaxismax-data.start)/(xaxisintervals/xaxissubintervals)*boxwidth, (xaxismax-data.start)/(xaxisintervals/2)*boxwidth, works-but why? 2? (xaxismax-data.start)/(xaxisintervals)*boxwidth, qqq writeln(output, 'xaxismax: ', xaxismax:10); writeln(output, 'data.start: ', data.start:10:8); writeln(output, 'boxwidth: ', boxwidth:10:8); writeln(output, '(xaxismax-data.start)*boxwidth: ', (xaxismax-data.start)*boxwidth:10:8); writeln(output, 'xaxissubintervals: ', xaxissubintervals:10); writeln(output, 'xaxisintervals: ', xaxisintervals:10); writeparam(output, '%', x, y, rotation, graphheight,boxwidth,intervalsize,histogramvalue,boxshift, ifield,idecimal,nfield,modulo,modulomultiplier,barlocation, title1, title2, title3, othertitles, titles, edgecontrol, edgeleft, edgeright, edgelow, edgehigh, xaxiscontrol, xaxismax, xaxisintervals, xaxissubintervals, xaxisticlength, xaxisticdx, xaxisticdy, yaxiscontrol, yaxismax, yaxisintervals, yaxissubintervals, yaxisticlength, yaxisticdx, yaxisticdy); */ /* doaxisline: boolean; line on axis is plotted */ /*aylength*/ /*fromtic,interval,totic: real;*/ /* xsubintervals: real;*/ /* tic length, dx, dy: real;*/ /* width, decimal: integer;*/ /* logyscale, logynormal: boolean;*/ xaxis(picout, true, (xaxismax - data.start_) / data.xinterval * V.boxwidth, data.start_, (double)xaxisintervals, (double)xaxismax, (double)xaxissubintervals, xaxisticlength, xaxisticdx, xaxisticdy, 20L, 0L, false, false, 2.0); /* logybase: real;*/ fprintf(picout->f, "grestore\n"); } /* draw an x axis starting from the current position. */ if (yaxiscontrol == 'y') { fprintf(picout->f, "gsave\n"); fprintf(picout->f, "-90 rotate\n"); /* move the y axis into the right location: */ fprintf(picout->f, "%*.*f cm %*.*f cm translate\n", picwidth, picdecim, -V.boxwidth, picwidth, picdecim, intervalsize + histogramvalue); fprintf(picout->f, "0 0 moveto\n"); /*afile*/ /* doaxisline: boolean; line on axis is plotted */ /* aylength,fromtic,interval,totic: real;*/ /* ysubintervals: real;*/ /* length, dx, dy: real;*/ /* width, decimal: integer;*/ /* logyscale, logynormal: boolean;*/ yaxis(picout, true, graphheight, 0.0, (double)yaxisintervals, (double)yaxismax, (double)yaxissubintervals, yaxisticlength, yaxisticdx, yaxisticdy, 20L, 0L, false, false, 2.0); /* logybase: real;*/ fprintf(picout->f, "grestore\n"); boxheight = graphheight * ((double)data.ymaximum / yaxismax); } /* draw a y axis starting from the current position. */ /* Test code for locating where the drawing point is. writeln(picout, 'gsave'); writeln(picout, '-90 rotate'); writeln(picout, '0 0 moveto'); writeln(picout, ' gsave'); writeln(picout, ' 1 cm 1 cm lineto'); writeln(picout, ' 0 1 0 setrgbcolor'); writeln(picout, ' stroke'); writeln(picout, ' grestore'); writeln(picout, ' gsave'); writeln(picout, (-boxwidth):picwidth:picdecim, ' cm 0 cm rmoveto'); writeln(picout, ' 1 cm 1 cm rlineto'); writeln(picout, ' 1 0 0 setrgbcolor'); writeln(picout, ' stroke'); writeln(picout, ' grestore'); writeln(picout, 'grestore'); writeln(output, (boxwidth):picwidth:picdecim, ' boxwidth'); writeln(output, (intervalsize):picwidth:picdecim, ' intervalsize'); */ else boxheight = graphheight; /* I don't know exactly how to compute this yet if dobugreport then bugreport; In theory the exact number can be found, and then the parameter file corrected. Maybe. */ buildpic(data, histog, picout, boxheight, V.boxwidth, intervalsize, histogramvalue, boxshift, ifield, idecimal, nfield, modulo, modulomultiplier, barlocation, V.downshift, title1, title2, title3, othertitles, titles, xaxiscontrol, yaxiscontrol); fprintf(picout->f, "%%%%Trailer\n"); fprintf(picout->f, "%%%%Pages: 1\n"); } /* end module themain */ main(argc, argv) int argc; Char *argv[]; { PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; picout.f = NULL; strcpy(picout.name, "picout"); genpicp.f = NULL; strcpy(genpicp.name, "genpicp"); histog.f = NULL; strcpy(histog.name, "histog"); themain(&histog, &genpicp, &picout); _L1: if (histog.f != NULL) fclose(histog.f); if (genpicp.f != NULL) fclose(genpicp.f); if (picout.f != NULL) fclose(picout.f); exit(EXIT_SUCCESS); } /* End. */