/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "dops.p" */ #include /* dops: pascal graphics library and preprocessor for PostScript 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 */ /* end of program */ /* begin module version */ #define version 2.77 /* of dops.p 2008 Aug 05 2008 Aug 05, 2.77: protect postscript from () by using \ before them 2007 Aug 30, 2.76: doaxis: subtic marks beyond last tic mark! fix 2007 Aug 30, 2.75: doaxis: subtic marks beyond last tic mark! 2005 Aug 6, 2.74: cleanup 2003 Aug 28, 2.73: important upgrade to stringreal 2000 Apr 19, 2.72: alter axes routines to remove line origin 1988 jan 28 from dosun */ /* end module version */ /* begin module describe.dops */ /* name dops: pascal graphics library and preprocessor for postscript synopsis dops(demo: in, input: in, output: out) files demo: a file for demonstration of the program. Start dops interactively. Start a picture with .PS 81 2 2 then type demo Graphics instructions will be read from the file 'demo', and the corresponding postscript will appear on the output. You can try instructions by hand. Then type .PE ^d (control-d) to conclude. input: Graphics instructions. Portions surrounded by .PS (with the appropriate parameters) and .PE (.PS =picture start and .PE = picture end) are searched for function names. When a function name is found, the parameters on the same line are read. output: the functions detected within .PS to .PE are translated into PostScript graphics description Dops converts the graphical instructions made by modules from domod.p and produces graphics in the language PostScript. examples To demonstrate the 3-D graphics, use .PS 81 2 2 test3d .PE (control-d to leave the program) A complete test file is called 'demo', which should be run non-interactively. documentation @article{Schneider1982, author = "T. D. Schneider and G. D. Stormo and J. S. Haemer and L. Gold", title = "A design for computer nucleic-acid sequence storage, retrieval and manipulation", year = "1982", journal = "Nucleic Acids Research", volume = "10", pages = "3013-3024"} @article{Schneider1984, author = "T. D. Schneider and G. D. Stormo and M. A. Yarus and L. Gold", title = "Delila system tools", year = "1984", journal = "Nucleic Acids Research", volume = "12", pages = "129-140"} see also doodle.p, domod.p, dosun.p PostScript Language Tutorial and Cookbook, PostScript Language Language Reference Manual both from Addison Wesley, 1985 dops.demo - file that demonstrates all functions xyplo.p - uses colors in plots. author Dr. Thomas D. Schneider National Cancer Institute Laboratory of Experimental and Computational Biology Frederick, Maryland 21702-1201 toms@ncifcrf.gov permanent email: toms@alum.mit.edu http://www.lecb.ncifcrf.gov/~toms/ bugs none known technical notes NONSTANDARD is a comment that means that this portion of the code is dependent on non-standard pascal (or graphics) for its function. See routine setcolor for a discussion of how colors are converted to a spectrum. */ /* end module describe.dops */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module dops.filler.const */ #define fillermax 20 /* the size of the filler array for a string */ /* end module dops.filler.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 */ /* begin module pic.3d.type */ /* these types are used by the three dimensional graphics routines */ typedef double threevector[3]; /* a point in 3 space */ typedef double tbtarray[3][3]; /* a three by three array */ typedef struct screen { /* define a screen for viewing a 3d object */ threevector a; /* center of screen */ threevector b; /* screen x coordinate direction */ threevector c; /* screen y coordinate direction */ threevector v; /* the position of the viewer */ threevector g; /* gaze: viewing direction */ double smag; /* the magnification factor for the screen */ double range; /* 1/smag; the half width of the screen */ } screen; /* end module pic.3d.type */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* begin module doodle.var */ Static _TEXT demo; /* demonstration file */ /* end module doodle.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 = 3.08; (@ of xyplo 1986 nov 6 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* 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 = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* begin module pic.functions */ /* ********************************************************************** */ /* begin module pic.await */ /* end module pic.await */ /* begin module pic.startpic */ /* end module pic.startpic */ /* begin module pic.stoppic */ /* end module pic.stoppic */ /* begin module pic.drawr */ /* end module pic.drawr */ /* begin module pic.mover */ /* end module pic.mover */ /* begin module pic.liner */ /* end module pic.liner */ /* begin module pic.drawa */ /* end module pic.drawa */ /* begin module pic.movea */ /* end module pic.movea */ /* begin module pic.linea */ /* end module pic.linea */ /* begin module pic.graphstring */ /* end module pic.graphstring */ /* begin module pic.stringinteger */ /* end module pic.stringinteger */ /* begin module pic.stringreal */ /* end module pic.stringreal */ /* begin module pic.picnumber */ /* end module pic.picnumber */ /* begin module pic.xtic */ /* end module pic.xtic */ /* begin module pic.ytic */ /* end module pic.ytic */ /* begin module pic.doaxis */ /* end module pic.doaxis */ /* begin module pic.xaxis */ /* end module pic.xaxis */ /* begin module pic.yaxis */ /* end module pic.yaxis */ /* ********************************************************************** */ /* end module pic.functions */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* begin module pic.3d.package */ /* ********************************************************************** */ /* begin module pic.3d.determinant */ /* end module pic.3d.determinant */ /* begin module pic.3d.d32 */ /* end module pic.3d.d32 */ /* begin module pic.3d.view */ /* end module pic.3d.view */ /* begin module pic.3d.makescreen */ /* end module pic.3d.makescreen */ /* begin module pic.3d.project3d */ /* end module pic.3d.project3d */ /* ********************************************************************** */ /* end module pic.3d.package */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* begin module pic.linea */ Static Void linea(afile, x, y) _TEXT *afile; double x, y; { /* draw a line from current position to absolute x and y */ drawa(afile, x, y, 'l', 0.0); } Local Void postscriptprotect(afile, c) _TEXT *afile; Char c; { /* 2008 Aug 05: protect parenthesis */ if (c == '(' || c == ')') putc('\\', afile->f); } /* end module pic.linea version = 2.63; (@ of dops.p 1991 November 2 */ /* begin module pic.graphstring */ Static Void graphstring(tofile, s, justification) _TEXT *tofile; string *s; Char justification; { /* graph the string s. If it is recognized as a quoted string (surrounded by double quotes), graph it without the quotes and center it. Otherwise justify it based on the justification character: 'l' left, 'c' centered, 'r' right. For right and centered justification, the drawing point is the same as before the string was done. For left justification it is at the right of the string to allow more to be added on there. If not in picture (global variable inpicture), there is no output. 2008 Aug 05. '(' and ')' need to be protected by putting '\' in front of them. */ /* NONSTANDARD: PostScript dependent code. Since different fonts have different sized characters, one must rely on the PostScript to handle the justification of the string. */ long i; /* index to s, and temporary storage */ boolean quoted; /* true if the string is quoted */ boolean skipping; /* true if skipping leading blanks */ long FORLIM; if (!(inpicture && s->length > 0)) return; /* There is no output if not in picture else begin writestring(tofile,s); writeln(tofile) end */ if (s->length > 2) { if (s->letters[0] == '"' && s->letters[s->length - 1] == '"') quoted = true; else quoted = false; } else quoted = false; /* override so quoted strings are always centered */ if (quoted) justification = 'c'; /* do the non-standard postscript: */ if (justification != 'l') fprintf(tofile->f, "gsave "); /* do postscript to complete pervious path */ /* set current point: writeln(tofile,'stroke 0 0 moveto'); */ fprintf(tofile->f, "c\n"); if (justification == 'c') { /* when centering, skip leading blanks */ if (s->letters[0] == ' ') skipping = true; else skipping = false; } else skipping = false; putc('(', tofile->f); /* begin postscript literal */ if (quoted) { /* take it literally */ FORLIM = s->length - 2; for (i = 1; i <= FORLIM; i++) { postscriptprotect(tofile, s->letters[i]); putc(s->letters[i], tofile->f); } } else { FORLIM = s->length; for (i = 0; i < FORLIM; i++) { if (skipping) { /* skip leading blanks */ if (s->letters[i] != ' ') { skipping = false; postscriptprotect(tofile, s->letters[i]); putc(s->letters[i], tofile->f); } /* else skip the blank by not writing it */ } else { postscriptprotect(tofile, s->letters[i]); putc(s->letters[i], tofile->f); } } } putc(')', tofile->f); /* end postscript literal */ if (justification == 'c') /* center the string */ fprintf(tofile->f, " dup stringwidth pop neg 2 div 0 rmoveto"); else if (justification == 'r') /* rigth justify the string */ fprintf(tofile->f, " dup stringwidth pop neg 0 rmoveto"); fprintf(tofile->f, " x\n"); /* show the literal */ inpath = false; /* force new path from here */ if (justification != 'l') fprintf(tofile->f, "grestore "); } /* end module pic.graphstring version = 2.63; (@ of dops.p 1991 November 2 */ /* 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: dops.p, line 970: * 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.63; (@ of dops.p 1991 November 2 */ /* 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 clean.stringreal.p 2003 Aug 28 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.63; (@ of dops.p 1991 November 2 */ /* 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.75; (@ 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.70; (@ of dops.p 1996 March 21 */ /* 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.70; (@ of dops.p 1996 March 21 */ /* ********************************************************************** */ /* begin module pic.dotr */ Static Void dotr(afile) _TEXT *afile; { /* draw a dot at the current position */ /* a zero length line won't work here, since some systems really believe it and draw nothing. (eg. PostScript on the Applewriter draws nothing, but PostScript on the Sun puts one pixle */ drawr(afile, dotfactor, 0.0, 'l', 0.0); } /* end module pic.dotr */ /* 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 = 4.80; (@ of piclib 1985 dec 26 */ /* begin module pic.cboxr */ Static Void cboxr(afile, width, height) _TEXT *afile; double width, height; { /* make a box to file afile with width in the x direction and height in the y direction as given. the box is centered at the current position. the box is relative to the current position, so it returns to original position afterwards */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, -h2); liner(afile, 0.0, height); liner(afile, width, 0.0); liner(afile, 0.0, -height); liner(afile, -width, 0.0); mover(afile, w2, h2); } /* end module pic.cboxr version = 3.08; (@ of xyplo 1986 nov 6 */ /* begin module pic.polrec */ Static Void polrec(r, theta, x, y) double r, theta, *x, *y; { /* convert polar to rectangular coordinates, theta is in radians */ *x = r * cos(theta); *y = r * sin(theta); } /* end module pic.polrec */ /* begin module pic.degtorad */ Static double degtorad(angle) double angle; { /* convert angle in degrees to radians */ return (angle / 360 * 2 * pi); } /* end module pic.degtorad */ /* begin module pic.spiral */ Static Void spiral(afile, thickness, steps, radius) _TEXT *afile; double thickness; long steps; double radius; { /* make a spiral into file afile, at the current position, with a certain thickness and using a certain number of steps at whose largest radius is 'radius'. return to same position afterward. If steps has a negative value, then the spiral is drawn clockwise, otherwise it is drawn counterclockwise. */ double dr; /* change in r */ double dtheta; /* change in theta */ double r = 0.0; /* radius of the current position */ double theta = 0.0; /* angle of the current position */ double x; /* the x coordinate */ double xpos; /* to remember the center of the spiral */ double y; /* the y coordinate */ double ypos; /* to remember the center of the spiral */ if (steps == 0) /* avoid explosion */ return; xpos = picxglobal; ypos = picyglobal; dr = fabs(thickness / steps); dtheta = 2 * pi / steps; while (r < fabs(radius)) { r += dr; theta += dtheta; polrec(r, theta, &x, &y); linea(afile, x + xpos, y + ypos); } movea(afile, xpos, ypos); } /* end module pic.spiral version = 4.80; (@ of piclib 1985 dec 26 */ /* begin module pic.movepolar */ Static Void movepolar(afile, angle, distance) _TEXT *afile; double angle, distance; { /* move relative to the current position by placing the appropriate pic commands into afile. the angle is in degrees, the distance is in cm.*/ double dx; /* change in x */ double dy; /* change in y */ polrec(distance, degtorad(angle), &dx, &dy); mover(afile, dx, dy); } /* Local variables for boxintercept: */ struct LOC_boxintercept { double xmin, ymin, xmax, ymax, m, b; boolean *intercept; double *x1, *y1, *x2, *y2; long count; /* number of sides the line intersects */ boolean xlo, xhi, ylo, yhi; } ; /* whether the line intersects the box at the low value of x, etc */ Local double fny(x, LINK) double x; struct LOC_boxintercept *LINK; { /* calculate the y value given the x */ return (LINK->m * x + LINK->b); } Local double fnx(y, LINK) double y; struct LOC_boxintercept *LINK; { /* calculate the x value given the y */ return ((y - LINK->b) / LINK->m); } Local boolean between(a, b, c, LINK) double a, b, c; struct LOC_boxintercept *LINK; { /* is b between a and c? */ return (a <= b && b <= c); } Local Void normalcases(LINK) struct LOC_boxintercept *LINK; { /* analyze for the usual cases when the slope m is not zero */ /* writeln(output,'m=',m:5:4,' b=',b:5:4,' in normalcases');*/ /* ymin, ymax, xmin and xmax are the coordinates of the box; xlo, yhi, xhi, and ylo are which sides are intersected | ymax +----yhi----+ | | | | xlo xhi | | | | ymin +----ylo----+ | xmin xmax | | */ LINK->xlo = between(LINK->ymin, fny(LINK->xmin, LINK), LINK->ymax, LINK); LINK->xhi = between(LINK->ymin, fny(LINK->xmax, LINK), LINK->ymax, LINK); LINK->ylo = between(LINK->xmin, fnx(LINK->ymin, LINK), LINK->xmax, LINK); LINK->yhi = between(LINK->xmin, fnx(LINK->ymax, LINK), LINK->xmax, LINK); /* writeln(output,'xlo = ',xlo); writeln(output,'xhi = ',xhi); writeln(output,'ylo = ',ylo); writeln(output,'yhi = ',yhi); */ *LINK->intercept = true; /* optimistic */ /* simplify cases which intersect corners. These are the ones where more than two side intersections are true. */ LINK->count = 0; if (LINK->xlo) LINK->count++; if (LINK->xhi) LINK->count++; if (LINK->ylo) LINK->count++; if (LINK->yhi) LINK->count++; if (LINK->count > 2) { /* one corner must be intersected. Simplify by preserving the opposing intersections. When there are 4 intersections, only one pair is preserved. The calculations will be correct either way. */ if (LINK->xlo && LINK->xhi) { LINK->yhi = false; LINK->ylo = false; } else if (LINK->ylo && LINK->yhi) { LINK->xhi = false; LINK->xlo = false; } else { printf("error in between count!\n"); halt(); } } if (LINK->xlo && LINK->xhi) { *LINK->x1 = LINK->xmin; *LINK->x2 = LINK->xmax; } else if (LINK->xlo && LINK->ylo) { *LINK->x1 = LINK->xmin; *LINK->x2 = fnx(LINK->ymin, LINK); } else if (LINK->xlo && LINK->yhi) { *LINK->x1 = LINK->xmin; *LINK->x2 = fnx(LINK->ymax, LINK); } else if (LINK->xhi && LINK->ylo) { *LINK->x1 = LINK->xmax; *LINK->x2 = fnx(LINK->ymin, LINK); } else if (LINK->xhi && LINK->yhi) { *LINK->x1 = LINK->xmax; *LINK->x2 = fnx(LINK->ymax, LINK); } else if (LINK->ylo && LINK->yhi) { *LINK->x1 = fnx(LINK->ymin, LINK); *LINK->x2 = fnx(LINK->ymax, LINK); } else *LINK->intercept = false; if (*LINK->intercept) { *LINK->y1 = fny(*LINK->x1, LINK); *LINK->y2 = fny(*LINK->x2, LINK); } } /* normalcases */ /* end module pic.movepolar version = 4.80; (@ of piclib 1985 dec 26 */ /* begin module pic.boxintercept */ Static Void boxintercept(xmin_, ymin_, xmax_, ymax_, m_, b_, intercept_, x1_, y1_, x2_, y2_) double xmin_, ymin_, xmax_, ymax_, m_, b_; boolean *intercept_; double *x1_, *y1_, *x2_, *y2_; { /* does the line y=m*x+b intercept the box defined by the points (xmin,ymin) and (xmax,ymax)? if so, intercept is true and the intercept points are given by (x1,y1) and (x2,y2) */ struct LOC_boxintercept V; V.xmin = xmin_; V.ymin = ymin_; V.xmax = xmax_; V.ymax = ymax_; V.m = m_; V.b = b_; V.intercept = intercept_; V.x1 = x1_; V.y1 = y1_; V.x2 = x2_; V.y2 = y2_; /* note: abs(m) is required to protect against negative zero... */ if (fabs(V.m) != 0.0) { normalcases(&V); return; } *V.intercept = between(V.ymin, V.b, V.ymax, &V); if (!*V.intercept) return; *V.x1 = V.xmin; *V.y1 = V.b; *V.x2 = V.xmax; *V.y2 = V.b; } /* boxintercept */ /* end module pic.boxintercept version = 7.61; (@ of xyplo.p 1991 November 2 */ /* begin module pic.plusr */ Static Void plusr(afile, width, height) _TEXT *afile; double width, height; { /* make a plus sign to file afile with width in the x direction and height in the y direction as given. the box is centered at the current position. the box is relative to the current position, so it returns to original position afterwards */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, 0.0); liner(afile, width, 0.0); mover(afile, -w2, h2); liner(afile, 0.0, -height); mover(afile, 0.0, h2); } /* end module pic.plusr version = 3.08; (@ of xyplo 1986 nov 6 */ /* begin module pic.xr */ Static Void xr(afile, width, height) _TEXT *afile; double width, height; { /* make an x to file afile with width in the x direction and height in the y direction as given. the box is centered at the current position. the box is relative to the current position, so it returns to original position afterwards */ double h2, w2; /* height and width over 2 */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, -h2); liner(afile, width, height); mover(afile, 0.0, -height); liner(afile, -width, height); mover(afile, w2, -h2); } /* end module pic.xr version = 3.08; (@ of xyplo 1986 nov 6 */ /* begin module pic.arc */ Static Void arc(thefile, angle1, angle2, radius, steps) _TEXT *thefile; double angle1, angle2, radius; long steps; { /* create an arc in thefile going from angle1 to angle2 (degrees) in the positive direction of angle, with the given radius. use the given number of steps to make it. return to the same position as before the arc was drawn. */ double dtheta; /* change in theta */ /* s: integer; (@ index to the steps */ double theta; /* current angle */ double x, y; /* coordinates around starting point */ /* zerox,zeroy: real; (@ starting location, center of curve */ /* zerox := picxglobal; zeroy := picyglobal; */ theta = degtorad(angle1); dtheta = degtorad(fabs(angle2 - angle1) / steps); polrec(radius, theta, &x, &y); /* can't do this for postscript arc: movea(thefile,zerox+x,zeroy+y); ' ',scale*zerox: picwidth:picdecim, ' ',scale*zeroy: picwidth:picdecim, */ /* NONSTANDARD postscript, much faster */ /* 'stroke newpath', */ /* force there to be no current point */ /* ' 0 0', */ fprintf(thefile->f, "a %*.*f %*.*f %*.*f\n", picwidth, picdecim, scale * radius, picwidth, picdecim, angle1, picwidth, picdecim, angle2); fprintf(thefile->f, "arc"); if (angle2 < angle1) /* for negative draws */ putc('n', thefile->f); /* origin move: writeln(thefile,' stroke newpath 0 0 moveto'); */ fprintf(thefile->f, " n\n"); /* the moveto puts us back to the origin */ /* for s := 1 to steps do begin theta := theta + dtheta; polrec(radius,theta, x,y); linea(thefile,zerox+x,zeroy+y); end; movea(thefile,zerox,zeroy) */ } /* end module pic.arc version = 1.65; (@ of pictog 1986 nov 6 */ /* begin module pic.circler */ Static Void circler(afile, radius) _TEXT *afile; double radius; { /* make a circle at the current position of some radius. */ long steps; /* number of steps to make the circle */ /* number of segments increases with diameter, but the constant still should be a function of how good it looks on a particular graphic system, I'm afraid. However, there should be a lower bound on the number of steps, so even small circles look good */ if (radius < 1.0) steps = 25; else steps = (long)floor(radius * 25 + 0.5); arc(afile, 0.0, 360.0, radius, steps); } /* end module pic.circler */ /* begin module pic.ibeam */ Static Void ibeam(afile, width, height) _TEXT *afile; double width, height; { /* Make an ibeam shaped symbol to file afile with width in the x direction and height in the y direction. Center it at the current position. Put a circle at the center, with radius 1/4th the width Return to original position afterwards. */ double h2, w2; /* height and width over 2 */ double r; /* the radius of the circle */ h2 = height / 2; w2 = width / 2; mover(afile, -w2, -h2); liner(afile, width, 0.0); mover(afile, -width, height); liner(afile, width, 0.0); mover(afile, -w2, 0.0); liner(afile, 0.0, -height); mover(afile, 0.0, h2); r = width / 8; /* this is silly for the new printers if r < 0.025 then r := 0.025; (* small circles do not come out well *) */ circler(afile, r); } #define colfield 8 /* width of numbers printed to the file */ #define colwidth 4 /* number of decimal places for numbers */ /* end module pic.ibeam */ /* begin module pic.setgray */ Static Void setgray(afile, brightness) _TEXT *afile; double brightness; { /* set the gray scale to the requested one. Range of the variables is 0 to 1. */ /* PostScript on a Sun 4 cannot handle 5 decimal places! Use 4 or less */ putc('n', afile->f); /* be sure it's started cleanly */ fprintf(afile->f, " %*.*f", colfield, colwidth, brightness); fprintf(afile->f, " setgray\n"); } #undef colfield #undef colwidth #define colfield 8 /* width of numbers printed to the file */ #define colwidth 4 /* number of decimal places for numbers */ /* PostScript on a Sun 4 cannot handle 5 decimal places! Use 4 or less */ #define huefactor 0.85 /* number of decimal places for numbers */ /* end module pic.setgray */ /* begin module pic.setcolor */ Static Void setcolor(afile, hue, saturation, brightness) _TEXT *afile; double hue, saturation, brightness; { /* Set the color to the requested one. Range of the variables is 0 to 1. Colors in PostScript are defined with hue, saturation and brightness with the sethsbcolor function. The standard hue runs from red at 0 to red at 1 with the Roy G. Biv in between. The famous physicist Roy G. Biv stands for: red, orange, yellow, green, blue, indigo, violet, the colors of the spectrum. On 1992 September 16 I realized that, amazingly, the wavelength in nm match quite nicely! 700 red 750 orange 600 yellow 650 green 500 blue 550 indego 400 violet Since the hue runs in a circle, the spectrum is not generated from the hue range 0 to 1. The routine setcolor therefore converts the input numbers by multiplying by 0.85. This gives the color range from red through violet corresponding to values 0 to 1. (Note: adding 0.15 would give the range from yellow through red, but that is not a spectrum.) */ putc('n', afile->f); /* be sure it's started cleanly */ fprintf(afile->f, " %*.*f", colfield, colwidth, hue * huefactor); fprintf(afile->f, " %*.*f", colfield, colwidth, saturation); fprintf(afile->f, " %*.*f", colfield, colwidth, brightness); fprintf(afile->f, " sethsbcolor\n"); } #undef colfield #undef colwidth #undef huefactor /* end module pic.setcolor */ /* begin module pic.rectinit */ Static Void rectinit(outfile) _TEXT *outfile; { /* create the definition of a rectangle. Rectsize must be called to initialize and to change the size of the rectangle. */ fprintf(outfile->f, "/rct\n"); fprintf(outfile->f, "{gsave\n"); fprintf(outfile->f, " newpath\n"); fprintf(outfile->f, " 0 0 moveto\n"); fprintf(outfile->f, " xs 0 lineto\n"); /* xs is the x side length */ fprintf(outfile->f, " xs ys lineto\n"); /* ys is the x side length */ fprintf(outfile->f, " 0 ys lineto\n"); fprintf(outfile->f, " closepath fill\n"); fprintf(outfile->f, "grestore} def\n"); } /* end module pic.rectinit */ /* begin module pic.rectdo */ Static Void rectdo(afile) _TEXT *afile; { /* Make a rectangle with lower right hand corner at (x,y) and the given side (position and color are determined by earlier calls to setcolor and move). Return to original position afterwards. */ fprintf(afile->f, " rct\n"); } /* end module pic.rectdo */ /* begin module pic.rectsize */ Static Void rectsize(afile, xsideold, ysideold, xside, yside) _TEXT *afile; double *xsideold, *ysideold, *xside, *yside; { /* determine if the values of xside and yside have changed from xsideold and ysideold. If either has changed, write the instructions to change the size of the rectangle into afile. */ if (*xside != *xsideold) { fprintf(afile->f, "/xs %*.*f def\n", picwidth, picdecim, *xside * scale); /* xs is the x side length used in rectinit */ *xsideold = *xside; } if (*yside != *ysideold) { fprintf(afile->f, "/ys %*.*f def\n", picwidth, picdecim, *yside * scale); /* ys is the y side length used in rectinit */ *ysideold = *yside; } } /* end module pic.rectsize */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* begin module pic.3d.determinant */ Static double determinant(a) double (*a)[3]; { /* compute the determinant of a */ return (a[0][0] * (a[1][1] * a[2][2] - a[2][1] * a[1][2]) + a[0] [1] * (a[2][0] * a[1][2] - a[1][0] * a[2][2]) + a[0] [2] * (a[1][0] * a[2][1] - a[2][0] * a[1][1])); } /* end module pic.3d.determinant */ /* begin module pic.3d.d32 */ Static Void d32(o, a, b, c, v, xloc, yloc) double *o, *a, *b, *c, *v; double *xloc, *yloc; { /* convert from 3d to 2d. the players are: o: the coordinate of the object point to be converted to 2d a,b,c: define the position of the window (screen): a: center of screen b: screen x coordinate direction c: screen y coordinate direction v: the position of the viewer xloc,yloc: the resulting image vector in screen coordinates. The method of graphics is to project the object (o) toward the viewer (v) and to determine the interception of this line with the screen as defined by a,b and c. the result is expressed in the coordinate system of the screen, and so can be plotted on a 2d plotting device. When one works through the vector math, it turns out that to find the screen coordinates requires solving a set of linear equations. This is done using Cramer's rule and determinants. */ double ov, oa; /* for partial calculation */ long j; /* index to the arrays */ tbtarray d, x, y; /* define the coefficients of the equations in d,x and y */ for (j = 0; j <= 2; j++) { ov = o[j] - v[j]; d[j][0] = b[j]; d[j][1] = c[j]; d[j][2] = ov; oa = o[j] - a[j]; x[j][0] = oa; x[j][1] = c[j]; x[j][2] = ov; y[j][0] = b[j]; y[j][1] = oa; y[j][2] = ov; } /* use cramer's rule to find the solution */ *xloc = determinant(x) / determinant(d); *yloc = determinant(y) / determinant(d); } /* end module pic.3d.d32 */ /* begin module pic.3d.view */ Static Void view(v, gaze, smag, a, b, c) double *v, *gaze; double smag; double *a, *b, *c; { /* this routine converts a viewing position (v) and a viewing direction (gaze), into the a,b,c values of a vertically oriented screen (ie, the screen is right side up). a is the center of the screen, b is the x axis, c is the y axis on the screen. This saves the user the trouble to make sure that b, c and the direction of viewing are orthogonal. one may magnify the view by making smag greater than one, or one may shrink the view by making smag less than one. if the viewing direction vector is not large enough, then the program halts. note: gaze is automatically converted to a unit vector. */ double db; /* magnitude of db */ double dgaze; /* magnitude of gaze */ long j; /* index to the arrays */ /* first check out the gaze direction */ dgaze = sqrt(gaze[0] * gaze[0] + gaze[1] * gaze[1] + gaze[2] * gaze[2]); if (smag == 0.0) { printf("screen magnitude cannot be zero\n"); halt(); } if (dgaze <= 0.001) { printf("gaze magnitude (%5.3f) is too small\n", dgaze); halt(); } /* make gaze a unit vector and set up the a vector as the viewing point plus the gaze vector */ for (j = 0; j <= 2; j++) { gaze[j] /= dgaze; a[j] = v[j] + gaze[j]; } /* the x axis of the screen, the b vector, is horizontal and orthogonal to the gaze */ b[0] = gaze[1]; b[1] = -gaze[0]; b[2] = 0.0; db = sqrt(b[0] * b[0] + b[1] * b[1] + b[2] * b[2]); /* check for top view case and correct if so: */ if (db == 0.0) { db = 1.0; b[0] = 1.0; b[1] = 0.0; /* b[3] := 0; already from above */ } else { for (j = 0; j <= 2; j++) b[j] /= db; } /* make b a unit vector */ /* now that the gaze is a unit vector, and we have constructed the x axis in the b vector also as a unit vector, the cross product of these two will generate the y axis as a unit vector, c: */ c[0] = b[1] * gaze[2] - gaze[1] * b[2]; c[1] = gaze[0] * b[2] - b[0] * gaze[2]; c[2] = b[0] * gaze[1] - gaze[0] * b[1]; /* now normalize both b and c vectors to be of size 1/smag */ for (j = 0; j <= 2; j++) { b[j] /= smag; c[j] /= smag; } } /* end module pic.3d.view */ /* begin module pic.3d.makescreen */ Static Void makescreen(vx, vy, vz, gx, gy, gz, smagnitude, s) double vx, vy, vz, gx, gy, gz, smagnitude; screen *s; { /* create the screen s based on the viewing location (vx,vy,vz) and the direction of gaze (gz,gy,gz). The screen size is scaled by smagnitude; doubling smagnitude should double the size of the scene. */ /* This routine makes creation of the screen very simple for the user. One need not look at the view routine. */ s->v[0] = vx; s->v[1] = vy; s->v[2] = vz; s->g[0] = gx; s->g[1] = gy; s->g[2] = gz; view(s->v, s->g, smagnitude, s->a, s->b, s->c); s->smag = smagnitude; s->range = 1 / smagnitude; } /* end module pic.3d.makescreen */ /* begin module pic.3d.project3d */ Static Void project3d(x, y, z, s, xscreen, yscreen) double x, y, z; screen s; double *xscreen, *yscreen; { /* project the point (x,y,z) onto the screen s, to find the screen coordinates (xscreen and yscreen). */ /* This routine simplifies the projection function for the user. */ threevector o; /* for passing the values to d32 */ o[0] = x; o[1] = y; o[2] = z; d32(o, s.a, s.b, s.c, s.v, xscreen, yscreen); } /* end module pic.3d.project3d */ /* begin module pic.3d.test.fun */ Static double fun(r) double r; { /* a function to plot */ return (3 / (1 + r * r / 2)); } /* end module pic.3d.test.fun */ /* begin module pic.3d.test.test3d */ Static Void test3d(afile) _TEXT *afile; { /* test three dimensional graphics */ screen s; /* the screen on which to project the 3d image */ double xscreen, yscreen; /* location on the screen corresponding to the projection of o onto the screen defined by v,a,b,c */ double xold, yold; /* the previous valuse of xscreen and yscreen */ /* definition of a spiral */ double dr; /* change in r */ double dtheta; /* change in theta */ double r = 0.0; /* radius of the current position */ double radius = 2.0; /* the radius of the spiral */ double theta = 0.0; /* angle of the current position */ double thickness = 0.1; /* spacing between spiral arms */ double steps = 15.0; /* number of steps around a circle of the spiral */ double x = 0.0, y = 0.0; double z; /* the location in three space */ makescreen(5.0, 5.0, 5.0, -1.0, -1.0, -1.0, 5.0, &s); dr = thickness / steps; dtheta = 2 * pi / steps; z = fun(r); project3d(x, y, z, s, &xold, &yold); mover(afile, xold, yold); /* premove to the startpoint of the graph */ while (r < radius) { r += dr; theta += dtheta; polrec(r, theta, &x, &y); z = fun(r); project3d(x, y, z, s, &xscreen, &yscreen); /* draw a line from where we where to the new place */ liner(afile, xscreen - xold, yscreen - yold); xold = xscreen; yold = yscreen; } } #define tab 9 /* tab character */ /* end module pic.3d.test.test3d */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* begin module skipblanks */ /* 2003 July 31: tab is considered a blank character */ Static boolean isblank(c) Char c; { /* is the character c blank or tab? */ return (c == ' ' || c == tab); } #undef tab Static Void skipblanks(thefile) _TEXT *thefile; { /* skip over blanks until a non-blank, or end of line, is found */ while (isblank(P_peek(thefile->f)) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipnonblanks(thefile) _TEXT *thefile; { /* skip over nonblanks until a blank, or end of line, is found */ while ((!isblank(P_peek(thefile->f))) & (!P_eoln(thefile->f))) getc(thefile->f); } Static Void skipcolumn(thefile) _TEXT *thefile; { /* skip over a data column */ skipblanks(thefile); skipnonblanks(thefile); } /* end module skipblanks version = 5.27; (@ of prgmod.p 2005 Aug 06 */ /* ********************************************************************** */ /* begin module dops.readchar */ Static Void readchar(a, c) _TEXT *a; Char *c; { /* read from file a the character c by first skipping preceding blanks and then skipping other non-blanks after */ skipblanks(a); *c = getc(a->f); if (*c == '\n') *c = ' '; skipnonblanks(a); } /* end module dops.readchar */ /* ********************************************************************** */ /* begin module dops.mkhalt */ Static Void mkhalt(outfile) _TEXT *outfile; { /* generate the call to halt */ fprintf(outfile->f, "dops "); halt(); } /* Local variables for testblank: */ struct LOC_testblank { _TEXT *outfile; } ; Local Void die(LINK) struct LOC_testblank *LINK; { fprintf(LINK->outfile->f, "(badly formed graphics instruction) show\n"); stoppic(LINK->outfile); /* close what we have */ mkhalt(LINK->outfile); } /* die */ /* end module dops.mkhalt */ /* begin module dops.testblank */ Static Void testblank(infile, outfile_) _TEXT *infile, *outfile_; { /* Test for blank as the next character. If it is not, terminate the program. If this is not done, reads may bomb on badly formed input. Example: boxrz will bomb on the attempt to read the number because it turns out to be a z */ struct LOC_testblank V; V.outfile = outfile_; if (P_eoln(infile->f)) die(&V); else if (P_peek(infile->f) != ' ') die(&V); } /* end module dops.testblank */ /* begin module dops.mkstartpic */ Static Void mkstartpic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to startpic */ double scale, x, y; /* scale factor, and coordinate to start with */ fscanf(infile->f, "%lg%lg%lg%*[^\n]", &scale, &x, &y); getc(infile->f); startpic(outfile, scale, x, y, 't'); } /* end module dops.mkstartpic */ /* begin module dops.mkstoppic */ Static Void mkstoppic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to stoppic */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); stoppic(outfile); } /* end module dops.mkstoppic */ /* begin module dops.mkdrawr */ Static Void mkdrawr(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to drawr */ double dx, dy; Char visibility; double spacing; testblank(infile, outfile); fscanf(infile->f, "%lg%lg", &dx, &dy); readchar(infile, &visibility); fscanf(infile->f, "%lg%*[^\n]", &spacing); getc(infile->f); drawr(outfile, dx, dy, visibility, spacing); } /* end module dops.mkdrawr */ /* begin module dops.mkmover */ Static Void mkmover(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to mover */ double dx, dy; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &dx, &dy); getc(infile->f); mover(outfile, dx, dy); } /* end module dops.mkmover */ /* begin module dops.mkliner */ Static Void mkliner(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to liner */ double dx, dy; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &dx, &dy); getc(infile->f); liner(outfile, dx, dy); } /* end module dops.mkliner */ /* begin module dops.mkdrawa */ Static Void mkdrawa(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to drawa */ double x, y; Char visibility; double spacing; testblank(infile, outfile); fscanf(infile->f, "%lg%lg", &x, &y); readchar(infile, &visibility); fscanf(infile->f, "%lg%*[^\n]", &spacing); getc(infile->f); drawa(outfile, x, y, visibility, spacing); } /* end module dops.mkdrawa */ /* begin module dops.mkmovea */ Static Void mkmovea(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to movea */ double x, y; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &x, &y); getc(infile->f); movea(outfile, x, y); } /* end module dops.mkmovea */ /* begin module dops.mklinea */ Static Void mklinea(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to linea */ double x, y; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &x, &y); getc(infile->f); linea(outfile, x, y); } /* end module dops.mklinea */ /* begin module dops.mkdotr */ Static Void mkdotr(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to dotr */ /* note that no testblank is needed because there are no arguments */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); dotr(outfile); } /* end module dops.mkdotr */ /* begin module dops.mkpicnumber */ Static Void mkpicnumber(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to picnumber */ double dx, dy, number; long width, decimal; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%ld%ld", &dx, &dy, &number, &width, &decimal); skipblanks(infile); P_peek(infile->f); /* a t means true */ /* p2c: dops.p: Note: Eliminated unused assignment statement [338] */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); /* skip past the line */ picnumber(outfile, dx, dy, number, width, decimal, 'c'); } /* end module dops.mkpicnumber */ /* begin module dops.mkxtic */ Static Void mkxtic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to xtic */ double length, dx, dy, number; long width, decimal; boolean logxnormal; Char clogxnormal; double logxbase; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%ld%ld%c%lg%*[^\n]", &length, &dx, &dy, &number, &width, &decimal, &clogxnormal, &logxbase); getc(infile->f); if (clogxnormal == '\n') clogxnormal = ' '; logxnormal = (clogxnormal == 't'); xtic(outfile, length, dx, dy, number, width, decimal, logxnormal, logxbase); /* procedure xtic(var afile: text; length, dx, dy, number: real; width, decimal: integer; logxnormal: boolean; logxbase: real); */ } /* end module dops.mkxtic */ /* begin module dops.mkytic */ Static Void mkytic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to ytic */ double length, dx, dy, number; long width, decimal; boolean logynormal; Char clogynormal; double logybase; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%ld%ld%c%lg%*[^\n]", &length, &dx, &dy, &number, &width, &decimal, &clogynormal, &logybase); getc(infile->f); if (clogynormal == '\n') clogynormal = ' '; logynormal = (clogynormal == 't'); ytic(outfile, length, dx, dy, number, width, decimal, logynormal, logybase); } /* end module dops.mkytic */ /* begin module dops.mkxaxis */ Static Void mkxaxis(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to xaxis */ boolean doaxisline; /* line on axis is plotted */ double axlength, fromtic, interval, totic, xsubintervals, length, dx, dy; long width, decimal; boolean logxscale, logxnormal; Char clogxscale, clogxnormal; double logxbase; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%lg%lg%lg%lg%ld%ld%c%c%lg%*[^\n]", &axlength, &fromtic, &interval, &totic, &xsubintervals, &length, &dx, &dy, &width, &decimal, &clogxscale, &clogxnormal, &logxbase); getc(infile->f); if (clogxscale == '\n') clogxscale = ' '; if (clogxnormal == '\n') clogxnormal = ' '; logxnormal = (clogxnormal == 't'); logxscale = (clogxscale == 't'); /* p2c: dops.p: Note: Eliminated unused assignment statement [338] */ xaxis(outfile, true, axlength, fromtic, interval, totic, xsubintervals, length, dx, dy, width, decimal, logxscale, logxnormal, logxbase); } /* end module dops.mkxaxis */ /* begin module dops.mkyaxis */ Static Void mkyaxis(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to yaxis */ boolean doaxisline; /* line on axis is plotted */ double aylength, fromtic, interval, totic, ysubintervals, length, dx, dy; long width, decimal; boolean logyscale, logynormal; Char clogyscale, clogynormal; double logybase; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%lg%lg%lg%lg%ld%ld%c%c%lg%*[^\n]", &aylength, &fromtic, &interval, &totic, &ysubintervals, &length, &dx, &dy, &width, &decimal, &clogyscale, &clogynormal, &logybase); getc(infile->f); if (clogyscale == '\n') clogyscale = ' '; if (clogynormal == '\n') clogynormal = ' '; logynormal = (clogynormal == 't'); logyscale = (clogyscale == 't'); /* p2c: dops.p: Note: Eliminated unused assignment statement [338] */ yaxis(outfile, true, aylength, fromtic, interval, totic, ysubintervals, length, dx, dy, width, decimal, logyscale, logynormal, logybase); } /* end module dops.mkyaxis */ /* begin module dops.mkboxr */ Static Void mkboxr(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to the boxr routine */ double width, height; testblank(infile, outfile); /*debug writeln(outfile,'in boxr!');*/ fscanf(infile->f, "%lg%lg%*[^\n]", &width, &height); getc(infile->f); boxr(outfile, width, height); } /* end module dops.mkboxr */ /* begin module dops.mkcboxr */ Static Void mkcboxr(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to the cboxr routine */ double width, height; testblank(infile, outfile); /*writeln(outfile,'in cboxr');debug*/ fscanf(infile->f, "%lg%lg%*[^\n]", &width, &height); getc(infile->f); /*writeln(outfile,'width height=',width:4:2,height:4:2);debug*/ cboxr(outfile, width, height); } /* end module dops.mkcboxr */ /* begin module dops.mkibeam */ Static Void mkibeam(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to the ibeam routine */ double width, height; testblank(infile, outfile); /*writeln(outfile,'in ibeam');debug*/ fscanf(infile->f, "%lg%lg%*[^\n]", &width, &height); getc(infile->f); /*writeln(outfile,'width height=',width:4:2,height:4:2);debug*/ ibeam(outfile, width, height); } /* end module dops.mkibeam */ /* begin module dops.mkcircler */ Static Void mkcircler(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to the circler routine */ double radius; testblank(infile, outfile); fscanf(infile->f, "%lg%*[^\n]", &radius); getc(infile->f); circler(outfile, radius); } /* end module dops.mkcircler */ /* begin module dops.mkspiral */ Static Void mkspiral(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to spiral */ double thickness; long steps; double radius; testblank(infile, outfile); fscanf(infile->f, "%lg%ld%lg%*[^\n]", &thickness, &steps, &radius); getc(infile->f); spiral(outfile, thickness, steps, radius); } /* end module dops.mkspiral */ /* begin module dops.mkmovepolar */ Static Void mkmovepolar(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to movepolar */ double angle, distance; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &angle, &distance); getc(infile->f); movepolar(outfile, angle, distance); } /* end module dops.mkmovepolar */ /* begin module dops.mkarc */ Static Void mkarc(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to arc */ double angle1, angle2, radius; long steps; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%ld%*[^\n]", &angle1, &angle2, &radius, &steps); getc(infile->f); arc(outfile, angle1, angle2, radius, steps); } /* end module dops.mkarc */ /* begin module dops.mkplusr */ Static Void mkplusr(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to plusr */ double width, height; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &width, &height); getc(infile->f); plusr(outfile, width, height); } /* end module dops.mkplusr */ /* begin module dops.mkxr */ Static Void mkxr(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to xr */ double width, height; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &width, &height); getc(infile->f); xr(outfile, width, height); } /* end module dops.mkxr */ /* begin module dops.mktest3d */ Static Void mktest3d(outfile) _TEXT *outfile; { /* generate the call to test3d */ /* note that no testblank is needed because there are no arguments */ test3d(outfile); } /* end module dops.mktest3d */ /* begin module dops.mksetgray */ Static Void mksetgray(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to setgray */ double brightness; testblank(infile, outfile); fscanf(infile->f, "%lg%*[^\n]", &brightness); getc(infile->f); setgray(outfile, brightness); } /* end module dops.mksetgray */ /* begin module dops.mksetcolor */ Static Void mksetcolor(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to setcolor */ double hue, saturation, brightness; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%*[^\n]", &hue, &saturation, &brightness); getc(infile->f); setcolor(outfile, hue, saturation, brightness); } /* end module dops.mksetcolor */ /* begin module dops.mkrectinit */ Static Void mkrectinit(outfile) _TEXT *outfile; { /* generate the call to rectinit */ /* NOTE: xsideold and ysideold are GLOBALS */ /* note that no testblank is needed because there are no arguments */ xsideold = 0.0; ysideold = 0.0; rectinit(outfile); } /* end module dops.mkrectinit */ /* begin module dops.mkrectdo */ Static Void mkrectdo(outfile) _TEXT *outfile; { /* generate the call to rectdo */ rectdo(outfile); } /* end module dops.mkrectdo */ /* begin module dops.mkrectsize */ Static Void mkrectsize(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to rectsize */ /* NOTE: xsideold and ysideold are GLOBALS */ double xside, yside; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &xside, &yside); getc(infile->f); rectsize(outfile, &xsideold, &ysideold, &xside, &yside); } Static Void translate PP((_TEXT *demofile, _TEXT *infile, _TEXT *outfile, long depth)); /* Local variables for translate: */ struct LOC_translate { _TEXT *demofile, *infile, *outfile; long depth; string buffer; /* part of a line of text from the source */ Char ch; /* a character read from infile */ boolean go; /* continue testing characters on this line */ trigger pe; /* a trigger for the picture end */ trigger ps; /* a trigger for the picture start */ /* functions which are looked for: */ trigger halt, demo, drawr, mover, liner, drawa, movea, linea, picnumber, xtic, ytic, xaxis, yaxis, dotr, boxr, cboxr, ibeam, circler, spiral, movepolar, arc, plusr, xr, test3d, setgray, setcolor, rectinit, rectsize, rectdo; } ; /* NOTE ON MAKING NEW NAMES: A pair of names, were one name is a subset of the other name, like "rect" and "rectsize", will cause trouble with the trigger mechanism because the trigger for the subset ("rect") will fire first. Then the testblank procedure will be called when arguments are read, and the program will halt. To prevent this, do not allow any of the names to be subsets. The solution in the case of "rect" was to rename it "rectdo". */ Local Void fill(LINK) struct LOC_translate *LINK; { /* fill up all the triggers */ /* 1 2 */ /* 12345678901234567890 */ filltrigger(&LINK->ps, ".PS "); filltrigger(&LINK->pe, ".PE "); filltrigger(&LINK->halt, "halt "); filltrigger(&LINK->demo, "demo "); filltrigger(&LINK->drawr, "drawr "); filltrigger(&LINK->mover, "mover "); filltrigger(&LINK->liner, "liner "); filltrigger(&LINK->drawa, "drawa "); filltrigger(&LINK->movea, "movea "); filltrigger(&LINK->linea, "linea "); filltrigger(&LINK->dotr, "dotr "); filltrigger(&LINK->picnumber, "picnumber "); filltrigger(&LINK->xtic, "xtic "); filltrigger(&LINK->ytic, "ytic "); filltrigger(&LINK->xaxis, "xaxis "); filltrigger(&LINK->yaxis, "yaxis "); filltrigger(&LINK->boxr, "boxr "); filltrigger(&LINK->cboxr, "cboxr "); filltrigger(&LINK->ibeam, "ibeam "); filltrigger(&LINK->circler, "circler "); filltrigger(&LINK->spiral, "spiral "); filltrigger(&LINK->movepolar, "movepolar "); filltrigger(&LINK->arc, "arc "); filltrigger(&LINK->plusr, "plusr "); filltrigger(&LINK->xr, "xr "); filltrigger(&LINK->test3d, "test3d "); filltrigger(&LINK->setgray, "setgray "); filltrigger(&LINK->setcolor, "setcolor "); filltrigger(&LINK->rectinit, "rectinit "); filltrigger(&LINK->rectsize, "rectsize "); filltrigger(&LINK->rectdo, "rectdo "); } Local Void resetall(LINK) struct LOC_translate *LINK; { /* reset all the triggers searched for */ resettrigger(&LINK->ps); resettrigger(&LINK->pe); resettrigger(&LINK->halt); resettrigger(&LINK->demo); resettrigger(&LINK->drawr); resettrigger(&LINK->mover); resettrigger(&LINK->liner); resettrigger(&LINK->drawa); resettrigger(&LINK->movea); resettrigger(&LINK->linea); resettrigger(&LINK->dotr); resettrigger(&LINK->picnumber); resettrigger(&LINK->xtic); resettrigger(&LINK->ytic); resettrigger(&LINK->xaxis); resettrigger(&LINK->yaxis); resettrigger(&LINK->boxr); resettrigger(&LINK->cboxr); resettrigger(&LINK->ibeam); resettrigger(&LINK->circler); resettrigger(&LINK->spiral); resettrigger(&LINK->movepolar); resettrigger(&LINK->arc); resettrigger(&LINK->plusr); resettrigger(&LINK->xr); resettrigger(&LINK->test3d); resettrigger(&LINK->setgray); resettrigger(&LINK->setcolor); resettrigger(&LINK->rectinit); resettrigger(&LINK->rectsize); resettrigger(&LINK->rectdo); } Local Void tests(LINK) struct LOC_translate *LINK; { /* test for the functions. if any function finds out what the line is, it is responsible for completing the line by doing the appropriate reading and readln'ing */ if (inpicture) { if (LINK->go) { testfortrigger(LINK->ch, &LINK->pe); if (LINK->pe.found) { if (LINK->depth > 0) { printf("%% .PE ignored in demo file\n"); while (!BUFEOF(LINK->demofile->f)) { /* skip remaining lines */ fscanf(LINK->demofile->f, "%*[^\n]"); getc(LINK->demofile->f); } } else if (!inpicture) printf("%% .PE ignored: not in picture\n"); else mkstoppic(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->halt); if (LINK->halt.found) { mkhalt(LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->demo); if (LINK->demo.found) { if (LINK->depth >= 1) printf("%% RECURSIVE DEMONSTRATION REFUSED\n"); else { printf("%% DEMONSTRATION BEGINS\n"); if (*LINK->demofile->name != '\0') { if (LINK->demofile->f != NULL) LINK->demofile->f = freopen(LINK->demofile->name, "r", LINK->demofile->f); else LINK->demofile->f = fopen(LINK->demofile->name, "r"); } else rewind(LINK->demofile->f); if (LINK->demofile->f == NULL) _EscIO2(FileNotFound, LINK->demofile->name); RESETBUF(LINK->demofile->f, Char); if (inpicture) { /* skip to ps in demo */ /* this avoids use of pe. if i called stoppic, it would stops program (current incarnation with no mouse response in await) */ resettrigger(&LINK->ps); while ((!LINK->ps.found) & (!BUFEOF(LINK->demofile->f))) { LINK->ch = getc(LINK->demofile->f); if (LINK->ch == '\n') LINK->ch = ' '; testfortrigger(LINK->ch, &LINK->ps); while (P_eoln(LINK->demofile->f) & (!BUFEOF(LINK->demofile->f))) { fscanf(LINK->demofile->f, "%*[^\n]"); getc(LINK->demofile->f); } } } translate(LINK->demofile, LINK->demofile, LINK->outfile, LINK->depth + 1); if (!inpicture) mkstartpic(LINK->infile, LINK->outfile); printf("%% DEMONSTRATION ENDS\n"); } LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->drawr); if (LINK->drawr.found) { mkdrawr(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->mover); if (LINK->mover.found) { mkmover(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->liner); if (LINK->liner.found) { mkliner(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->drawa); if (LINK->drawa.found) { mkdrawa(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->movea); if (LINK->movea.found) { mkmovea(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->linea); if (LINK->linea.found) { mklinea(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->dotr); if (LINK->dotr.found) { mkdotr(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->picnumber); if (LINK->picnumber.found) { mkpicnumber(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->xtic); if (LINK->xtic.found) { mkxtic(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->ytic); if (LINK->ytic.found) { mkytic(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->xaxis); if (LINK->xaxis.found) { mkxaxis(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->yaxis); if (LINK->yaxis.found) { mkyaxis(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->cboxr); if (LINK->cboxr.found) { mkcboxr(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->ibeam); if (LINK->ibeam.found) { mkibeam(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { /* note that boxr will compete with cboxr for triggering since they will both trigger at the same time. we want cboxr to win and suppress boxr, so the test for boxr must follow that of cboxr */ testfortrigger(LINK->ch, &LINK->boxr); if (LINK->boxr.found) { mkboxr(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->circler); if (LINK->circler.found) { mkcircler(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->spiral); if (LINK->spiral.found) { mkspiral(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->movepolar); if (LINK->movepolar.found) { mkmovepolar(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->arc); if (LINK->arc.found) { mkarc(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->plusr); if (LINK->plusr.found) { mkplusr(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->xr); if (LINK->xr.found) { mkxr(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->test3d); if (LINK->test3d.found) { mktest3d(LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->setgray); if (LINK->setgray.found) { mksetgray(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->setcolor); if (LINK->setcolor.found) { mksetcolor(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->rectinit); if (LINK->rectinit.found) { mkrectinit(LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->rectdo); if (LINK->rectdo.found) { mkrectdo(LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->rectsize); if (LINK->rectsize.found) { mkrectsize(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->ps); if (LINK->ps.found) { printf("%% .PS ignored: already in picture\n"); LINK->go = false; } } if (!LINK->go) return; if (LINK->ch != ' ') return; if (!P_eoln(LINK->infile->f)) { while (!P_eoln(LINK->infile->f) && LINK->buffer.length < maxstring) { LINK->buffer.length++; LINK->buffer.letters[LINK->buffer.length - 1] = getc(LINK->infile->f); if (LINK->buffer.letters[LINK->buffer.length - 1] == '\n') LINK->buffer.letters[LINK->buffer.length - 1] = ' '; } graphstring(LINK->outfile, &LINK->buffer, 'l'); } LINK->go = false; return; } /* corresponds to: if inpicture then begin */ testfortrigger(LINK->ch, &LINK->ps); if (LINK->ps.found) { mkstartpic(LINK->infile, LINK->outfile); LINK->go = false; /* not in a picture yet */ } } /* end module dops.mkrectsize */ /* begin module dops.translate */ Static Void translate(demofile_, infile_, outfile_, depth_) _TEXT *demofile_, *infile_, *outfile_; long depth_; { /* translate functions found in infile to pure pic input at outfile, up to the picture end. use the file demo rather than input if the command 'demo' is in infile. depth keeps track of how deeply the procedure has recursed in demonstration. */ struct LOC_translate V; long index; /* a position in buffer */ V.demofile = demofile_; V.infile = infile_; V.outfile = outfile_; V.depth = depth_; fill(&V); /* look at each line at a time: */ while (!BUFEOF(V.infile->f)) { resetall(&V); clearstring(&V.buffer); index = 0; V.go = true; while (V.go) { if (P_eoln(V.infile->f)) { fscanf(V.infile->f, "%*[^\n]"); getc(V.infile->f); if (inpicture) graphstring(V.outfile, &V.buffer, 'l'); else { putc('%', V.outfile->f); writestring(V.outfile, &V.buffer); putc('\n', V.outfile->f); } /* NONSTANDARD postscript comment */ V.go = false; continue; } /* nothing was recognized in the tests, so just dump: */ if (index >= maxstring) { fprintf(V.outfile->f, "\ntranslate: line too long\n"); mkhalt(V.outfile); continue; } V.ch = getc(V.infile->f); if (V.ch == '\n') V.ch = ' '; index++; V.buffer.letters[index-1] = V.ch; V.buffer.length = index; tests(&V); } } } /* end module dops.translate */ /* begin module dops.themain */ Static Void themain(demo, fromfile, tofile) _TEXT *demo, *fromfile, *tofile; { /* the main procedure of the program */ printf("%%!\n"); /* this allows use of psview */ printf("%% dops %4.2f\n", version); /* prestart as a convenience */ /* startpic(tofile,defscale,5,5); writeln(tofile,'% picture has been started'); */ translate(demo, fromfile, tofile, 0L); } /* end module dops.themain */ main(argc, argv) int argc; Char *argv[]; { _TEXT TEMP, TEMP1; PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; demo.f = NULL; strcpy(demo.name, "demo"); TEMP.f = stdin; *TEMP.name = '\0'; TEMP1.f = stdout; *TEMP1.name = '\0'; themain(&demo, &TEMP, &TEMP1); _L1: if (demo.f != NULL) fclose(demo.f); exit(EXIT_SUCCESS); } /* End. */