/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "domod.p" */ #include /* domod: doodle modules by thomas schneider, copyright (c) 1989 module libraries required: delman, prgmods */ /* end of program */ /* begin module version */ #define version 1.41 /* of domod.p 1994 sep 5 origin 1988 jan 12 from dosun */ /* end module version */ /* begin module describe.domod */ /* name domod: doodle modules synopsis domod(input: in, output: out) files input: text. portions surrounded by .PS and .PE are searched for function names. when a function name is found, the parameters on the same line are read. output: copy of input text except that the functions detected during reading are translated into doodle commands. description Domod contains the doodle modules. Calls to the procedures cause the corresponding doodle command to be written to the output file. Since this is the same as the input, the program only reformats the input. That is, in UNIXease, domodb domodc diff b c shows no difference between b and c. The program serves as a module library for the procedures that generate doodle commands. see also doodle.p dosun.p author Thomas D. Schneider bugs domod does not copy correctly outside of pictures. Inside of pictures it appears to read the entire demo and copy it to output correctly, such that domoda;domodb;diff a b gives no differences. technical note The globals picxglobal and picyglobal are updated, so a program that does graphics using these calls can use these variables to find out where it is. */ /* end module describe.domod */ /* begin module interact.const */ #define maxstring 150 /* the maximum string */ /* end module interact.const version = 'prgmod 3.97 85 may 5 tds'; */ /* begin module domod.filler.const */ #define fillermax 20 /* the size of the filler array for a string */ /* end module domod.filler.const */ /* begin module pic.const */ #define pi 3.14159265354 /* circumference divided by diameter of circle */ #define picfield 12 /* width of numbers printed to the file */ #define picwidth 9 /* number of decimal places for numbers */ #define charwidth 0.05 /* the width of characters in the graphic space. this allows centering of strings. */ #define defscale 81 /* default scale factor. coordinate units per inch */ /* scale = 1.252;*/ /* scale factor. 81 pixles per inch. the routines use inches and this factor converts for the sun pixle size (i think) */ /* end module pic.const version = 3.08; (@ of xyplo 1986 nov 6 */ /* 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 */ /* p2c: domod.p, line 89: Warning: Expected END, found a semicolon [227] */ /* define a screen for viewing a 3d object */ /* center of screen */ /* screen x coordinate direction */ /* screen y coordinate direction */ /* the position of the viewer */ /* gaze: viewing direction */ /* the magnification factor for the screen */ /* 1/smag; the half width of the screen */ typedef struct screen { int empty_struct; /* Pascal record was empty */ } screen; /* end module pic.3d.type */ /* begin module interact.type */ 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 */ } string; /* end module interact.type version = 'prgmod 3.97 85 may 5 tds'; */ /* 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 = 'prgmod 3.97 85 may 5 tds'; */ /* 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 = 'prgmod 3.97 85 may 5 tds'; */ /* 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 inch */ 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 = 'prgmod 3.97 85 may 5 tds'; */ /* begin module interact.clearstring */ Static Void clearstring(ribbon) string *ribbon; { /* empty the string */ long index; /* to the ribbon */ for (index = 0; index < maxstring; index++) ribbon->letters[index] = ' '; ribbon->length = 0; ribbon->current = 0; } /* clearstring */ /* end module interact.clearstring version = 'prgmod 3.97 85 may 5 tds'; */ /* begin module interact.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 interact.writestring version = 'prgmod 3.97 85 may 5 tds'; */ /* 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. */ t->state++; /* if debugging then begin writestring(list,seek); writeln(list,'testfortrigger seek.letters[',state:1,']:', seek.letters[state],' ch:',ch); end;*/ 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; } t->state = 0; t->skip = true; t->found = false; /* reset trigger */ } /* testfortrigger */ /* end module trigger.proc version = 'prgmod 3.97 85 may 5 tds'; */ /* 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 = 'prgmod 3.97 85 may 5 tds'; */ /* 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 = 'prgmod 3.97 85 may 5 tds'; */ /* 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 = 'prgmod 3.97 85 may 5 tds'; */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* 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.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) _TEXT *afile; double setscale, x, y; { /* open the graphics field, with the given scale, and at (x,y) in that scale. scale is in device coordinates per inch. */ /* open the graphics field */ /* start pic output to file afile, set the globals */ fprintf(afile->f, ".PS %*.*f %*.*f %*.*f\n", picfield, picwidth, setscale, picfield, picwidth, x, picfield, picwidth, y); scale = setscale; /* set the global scale */ inpicture = true; picxglobal = 0.0; picyglobal = 0.0; pictolerance = (long)(exp(picwidth * log(10.0)) + 0.5); /*;writeln(output,'pictolerance = ',pictolerance:picfield:picwidth);*/ } /* end module pic.startpic */ /* begin module pic.await */ Static Void await() { /* gutted procedure for now */ /* Wait for user to type a carriage return. the routine assumes that there is a global file called input. */ /* the old way: writeln(output,'awaiting for a Return to continue'); while not eoln(input) do begin get(input) end; */ /* read past the input */ /* readln(input) */ } /* end module pic.await */ /* begin module pic.stoppic */ Static Void stoppic(afile) _TEXT *afile; { /* stop pic output to file afile */ fprintf(afile->f, ".PE\n"); inpicture = false; } /* end module pic.stoppic */ /* 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). */ fprintf(afile->f, "drawr %*.*f %*.*f %c %*.*f\n", picfield, picwidth, dx, picfield, picwidth, dy, visibility, picfield, picwidth, spacing); picxglobal += dx; picyglobal += dy; } /* end module pic.drawr */ /* begin module pic.mover */ Static Void mover(afile, dx, dy) _TEXT *afile; double dx, dy; { /* move relative the amount (dx, dy). */ fprintf(afile->f, "mover %*.*f %*.*f\n", picfield, picwidth, dx, picfield, picwidth, dy); picxglobal += dx; picyglobal += dy; } /* end module pic.mover */ /* begin module pic.liner */ Static Void liner(afile, dx, dy) _TEXT *afile; double dx, dy; { /* draw a line the relative amount (dx, dy). */ fprintf(afile->f, "liner %*.*f %*.*f\n", picfield, picwidth, dx, picfield, picwidth, dy); picxglobal += dx; picyglobal += dy; } /* end module pic.liner */ /* 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). */ fprintf(afile->f, "drawa %*.*f %*.*f %c %*.*f\n", picfield, picwidth, x, picfield, picwidth, y, visibility, picfield, picwidth, spacing); picxglobal = x; picyglobal = y; } /* end module pic.drawa */ /* begin module pic.movea */ Static Void movea(afile, x, y) _TEXT *afile; double x, y; { /* move to absolute x and y */ fprintf(afile->f, "movea %*.*f %*.*f\n", picfield, picwidth, x, picfield, picwidth, y); picxglobal = x; picyglobal = y; } /* end module pic.movea */ /* 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 */ fprintf(afile->f, "linea %*.*f %*.*f\n", picfield, picwidth, x, picfield, picwidth, y); picxglobal = x; picyglobal = y; } /* end module pic.linea */ /* begin module pic.graphstring */ Static Void graphstring(tofile, s, centered) _TEXT *tofile; string *s; boolean centered; { /* graph the string s. If it is recognized as a quoted string (surrounded by double quotes), graph it without the quotes and center it. Always center if centered is true. Otherwise simply graph it. if not in picture, just write it to output */ long i; /* index to s */ boolean quoted; /* true if the string is quoted */ string sq; /* s, with quotes around it to indicate centering */ long FORLIM; if (s->length > 2) { if (s->letters[0] == '"' && s->letters[s->length - 1] == '"') quoted = true; else quoted = false; } else quoted = false; if (!quoted && centered) { clearstring(&sq); sq.length = s->length + 2; sq.letters[0] = '"'; FORLIM = s->length; for (i = 1; i <= FORLIM; i++) sq.letters[i] = s->letters[i-1]; sq.letters[sq.length - 1] = '"'; writestring(tofile, &sq); } else writestring(tofile, s); /* just echo it */ putc('\n', tofile->f); /* complete the line */ } /* end module pic.graphstring version = 'prgmod 3.97 85 may 5 tds'; */ /* 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: domod.p, line 580: * 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 = 1.69; (@ of dops, 1988 mar 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. */ 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 */ 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; /* create the actual real number */ /* before decimal point */ stringinteger(sign * theupper, name, width - decimal - 1, false); /* put in the decimal point */ name->length++; name->letters[name->length - 1] = '.'; stringinteger(thedecimal, name, decimal, true); /* after decimal point */ } /* end module pic.stringreal */ /* begin module pic.picnumber */ Static Void picnumber(afile, dx, dy, number, width, decimal, centered) _TEXT *afile; double dx, dy, number; long width, decimal; boolean centered; { /* 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 centered */ fprintf(afile->f, "picnumber %*.*f %*.*f %*.*f %2ld %2ld", picfield, picwidth, dx, picfield, picwidth, dy, picfield, picwidth, number, width, decimal); if (centered) fprintf(afile->f, " true"); else fprintf(afile->f, " false"); putc('\n', afile->f); } /* end module pic.picnumber */ /* begin module pic.xtic */ Static Void xtic(afile, length, dx, dy, number, width, decimal) _TEXT *afile; double length, dx, dy, number; long width, decimal; { /* 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. */ fprintf(afile->f, "xtic %*.*f %*.*f %*.*f %*.*f %*ld %*ld\n", picfield, picwidth, length, picfield, picwidth, dx, picfield, picwidth, dy, picfield, picwidth, number, picfield, width, picfield, decimal); } /* end module pic.xtic */ /* begin module pic.ytic */ Static Void ytic(afile, length, dx, dy, number, width, decimal) _TEXT *afile; double length, dx, dy, number; long width, decimal; { /* produce a tic mark for the y 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. */ fprintf(afile->f, "ytic %*.*f %*.*f %*.*f %*.*f %*ld %*ld\n", picfield, picwidth, length, picfield, picwidth, dx, picfield, picwidth, dy, picfield, picwidth, number, picfield, width, picfield, decimal); } /* end module pic.ytic */ /* begin module pic.xaxis */ Static Void xaxis(afile, axlength, fromtic, interval, totic, length, dx, dy, width, decimal) _TEXT *afile; double axlength, fromtic, interval, totic, length, dx, dy; long width, decimal; { /* draw an x axis starting from the current position. the length of the xaxis is axlength. 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 xtic. If the width is zero, no number is produced. the location after the call is the same as before the call. */ fprintf(afile->f, "xaxis %*.*f %*.*f %*.*f %*.*f %*.*f %*.*f %*.*f %*ld %*ld\n", picfield, picwidth, axlength, picfield, picwidth, fromtic, picfield, picwidth, interval, picfield, picwidth, totic, picfield, picwidth, length, picfield, picwidth, dx, picfield, picwidth, dy, picfield, width, picfield, decimal); } /* end module pic.xaxis */ /* begin module pic.yaxis */ Static Void yaxis(afile, aylength, fromtic, interval, totic, length, dx, dy, width, decimal) _TEXT *afile; double aylength, fromtic, interval, totic, length, dx, dy; long width, decimal; { /* draw a y axis starting from the current position. the length of the yaxis is aylength. 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. */ fprintf(afile->f, "yaxis %*.*f %*.*f %*.*f %*.*f %*.*f %*.*f %*.*f %*ld %*ld\n", picfield, picwidth, aylength, picfield, picwidth, fromtic, picfield, picwidth, interval, picfield, picwidth, totic, picfield, picwidth, length, picfield, picwidth, dx, picfield, picwidth, dy, picfield, width, picfield, decimal); } /* end module pic.yaxis */ /* ********************************************************************** */ /* begin module pic.dotr */ Static Void dotr(afile) _TEXT *afile; { /* draw a dot at the current position */ fprintf(afile->f, "dotr\n"); } /* 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 */ fprintf(afile->f, "boxr %*.*f %*.*f\n", picfield, picwidth, width, picfield, picwidth, height); } /* 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 */ fprintf(afile->f, "cboxr %*.*f %*.*f\n", picfield, picwidth, width, picfield, picwidth, height); } /* 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. */ fprintf(afile->f, "spiral %*.*f %*ld %*.*f\n", picfield, picwidth, thickness, picfield, steps, picfield, picwidth, radius); } /* 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 inches.*/ double x, y; /* amounts to move */ fprintf(afile->f, "movepolar %*.*f %*.*f\n", picfield, picwidth, angle, picfield, picwidth, distance); polrec(distance, angle, &x, &y); picxglobal += x; picyglobal += y; } /* Local variables for boxintercept: */ struct LOC_boxintercept { double xmin, ymin, xmax, ymax, m, b; boolean *intercept; double *x1, *y1, *x2, *y2; 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? Do count the end points of the segment */ return (a <= b && b <= c); } Local boolean inside(a, b, c, LINK) double a, b, c; struct LOC_boxintercept *LINK; { /* is b inside a and c? Don't count the end points of the segment */ 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 */ /* make the x segments include their end points, and the y segments be without the end points. This way we cannot get an ambiguous result if the line passes through the corner! That is, only two intercepts are possible and the logic below DEPENDS on this. Note that the horizontal case (m=0) has already been excluded, and that the vertical case is not possible. (It may blow up if m is really huge, I suppose. But that would show up). */ 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 = inside(LINK->xmin, fnx(LINK->ymin, LINK), LINK->xmax, LINK); LINK->yhi = inside(LINK->xmin, fnx(LINK->ymax, LINK), LINK->xmax, LINK); /* writeln(output, ' xlo = ',xlo, ', xhi = ',xhi, ', ylo = ',ylo, ', yhi = ',yhi); */ *LINK->intercept = true; /* optimistic */ /* There are six simple cases */ 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; } /* Handle horizontal line. Note that vertical line is impossible, since m would be infinite then. */ *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 = 6.75; (@ of xyplo 1989 January 7 */ /* 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 */ fprintf(afile->f, "plusr %*.*f %*.*f\n", picfield, picwidth, width, picfield, picwidth, height); } /* 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 */ fprintf(afile->f, "xr %*.*f %*.*f\n", picfield, picwidth, width, picfield, picwidth, height); } /* end module pic.xr version = 3.08; (@ of xyplo 1986 nov 6 */ /* begin module pic.arc */ Static Void arc(afile, angle1, angle2, radius, steps) _TEXT *afile; 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. */ fprintf(afile->f, "arc %*.*f %*.*f %*.*f %*ld\n", picfield, picwidth, angle1, picfield, picwidth, angle2, picfield, picwidth, radius, picfield, steps); } /* 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. */ fprintf(afile->f, "circler %*.*f\n", picfield, picwidth, radius); } /* 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 (but never smaller than 0.025 inches) Return to original position afterwards. */ fprintf(afile->f, "ibeam %*.*f %*.*f\n", picfield, picwidth, width, picfield, picwidth, height); } /* end module pic.ibeam */ /* begin module pic.rectinit */ Static Void rectinit(afile) _TEXT *afile; { /* create the definition of a color rectangle. */ fprintf(afile->f, "rectinit\n"); } /* end module pic.rectinit */ /* 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. */ fprintf(afile->f, "rectsize %*.*f %*.*f %*.*f %*.*f\n", picfield, picwidth, *xsideold, picfield, picwidth, *ysideold, picfield, picwidth, *xside, picfield, picwidth, *yside); } /* end module pic.rectsize */ /* begin module pic.rectdo */ Static Void rectdo(afile) _TEXT *afile; { /* Make a rectangle. Size is determined previously by rectsize, as is gray or coloring. Return to original position afterwards. */ fprintf(afile->f, "rectdo\n"); } /* end module pic.rectdo */ /* begin module pic.setgray */ Static Void setgray(afile, brightness) _TEXT *afile; double brightness; { /* set the gray */ fprintf(afile->f, "setgray %*.*f\n", picfield, picwidth, brightness); } /* end module pic.setgray */ /* begin module pic.setcolor */ Static Void setcolor(afile, hue, saturation, brightness) _TEXT *afile; double hue, saturation, brightness; { /* set the color */ fprintf(afile->f, "setcolor %*.*f %*.*f %*.*f\n", picfield, picwidth, hue, picfield, picwidth, saturation, picfield, picwidth, brightness); } /* end module pic.setcolor */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* 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. */ threevector TEMP, TEMP1, TEMP2; s->v[1] = vx; /* p2c: domod.p, line 1182: * Warning: No field called V in that record [288] */ /* p2c: domod.p, line 1182: Warning: Index on a non-array variable [287] */ s->v[2] = vy; /* p2c: domod.p, line 1183: * Warning: No field called V in that record [288] */ /* p2c: domod.p, line 1183: Warning: Index on a non-array variable [287] */ s->v[3] = vz; /* p2c: domod.p, line 1184: * Warning: No field called V in that record [288] */ /* p2c: domod.p, line 1184: Warning: Index on a non-array variable [287] */ s->g[1] = gx; /* p2c: domod.p, line 1185: * Warning: No field called G in that record [288] */ /* p2c: domod.p, line 1185: Warning: Index on a non-array variable [287] */ s->g[2] = gy; /* p2c: domod.p, line 1186: * Warning: No field called G in that record [288] */ /* p2c: domod.p, line 1186: Warning: Index on a non-array variable [287] */ s->g[3] = gz; memcpy(TEMP, &0, sizeof(threevector)); memcpy(TEMP1, &0, sizeof(threevector)); memcpy(TEMP2, &0, sizeof(threevector)); /* p2c: domod.p, line 1187: * Warning: No field called G in that record [288] */ /* p2c: domod.p, line 1187: Warning: Index on a non-array variable [287] */ /* p2c: domod.p, line 1188: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1188: * Warning: Expected an expression, found a comma [227] */ /* p2c: domod.p, line 1188: Warning: Symbol 'G' is not defined [221] */ /* p2c: domod.p, line 1188: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1188: * Warning: Expected an expression, found a comma [227] */ /* p2c: domod.p, line 1188: * Warning: Type mismatch in VAR parameter a [295] */ /* p2c: domod.p, line 1188: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1188: * Warning: Expected an expression, found a comma [227] */ /* p2c: domod.p, line 1188: * Warning: Type mismatch in VAR parameter b [295] */ /* p2c: domod.p, line 1188: Warning: Expected a ':=', found a ')' [227] */ /* p2c: domod.p, line 1188: * Warning: Expected an expression, found a ')' [227] */ /* p2c: domod.p, line 1188: * Warning: Type mismatch in VAR parameter c [295] */ view(0, g, smagnitude, TEMP, TEMP1, TEMP2); s->smag = smagnitude; /* p2c: domod.p, line 1189: * Warning: No field called SMAG in that record [288] */ s->range = 1 / smagnitude; /* p2c: domod.p, line 1190: * Warning: No field called RANGE in that record [288] */ } /* 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; /* p2c: domod.p, line 1206: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1206: * Warning: Expected an expression, found a comma [227] */ /* p2c: domod.p, line 1206: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1206: * Warning: Expected an expression, found a comma [227] */ /* p2c: domod.p, line 1206: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1206: * Warning: Expected an expression, found a comma [227] */ /* p2c: domod.p, line 1206: Warning: Expected a ':=', found a comma [227] */ /* p2c: domod.p, line 1206: * Warning: Expected an expression, found a comma [227] */ d32(o, 0, 0, 0, 0, *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 */ fprintf(afile->f, "test3d\n"); } /* end module pic.3d.test.test3d */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* begin module skipblanks */ Static Void skipblanks(thefile) _TEXT *thefile; { /* skip over blanks until a non-blank, or end of line, is found */ while ((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 ((P_peek(thefile->f) != ' ') & (!P_eoln(thefile->f))) getc(thefile->f); } /* end module skipblanks version = 'prgmod 3.97 85 may 5 tds'; */ /* ********************************************************************** */ /* begin module domod.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 domod.readchar */ /* ********************************************************************** */ /* begin module domod.mkhalt */ Static Void mkhalt(outfile) _TEXT *outfile; { /* generate the call to halt */ fprintf(outfile->f, "domod "); halt(); } /* Local variables for testblank: */ struct LOC_testblank { _TEXT *outfile; } ; Local Void die(LINK) struct LOC_testblank *LINK; { stoppic(LINK->outfile); /* close what we have */ fprintf(LINK->outfile->f, "badly formed instruction\n"); mkhalt(LINK->outfile); } /* die */ /* end module domod.mkhalt */ /* begin module domod.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 domod.testblank */ /* begin module domod.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); } /* end module domod.mkstartpic */ /* begin module domod.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 domod.mkstoppic */ /* begin module domod.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 domod.mkdrawr */ /* begin module domod.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 domod.mkmover */ /* begin module domod.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 domod.mkliner */ /* begin module domod.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 domod.mkdrawa */ /* begin module domod.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 domod.mkmovea */ /* begin module domod.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 domod.mklinea */ /* begin module domod.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 domod.mkdotr */ /* begin module domod.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: domod.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, true); } /* end module domod.mkpicnumber */ /* begin module domod.mkxtic */ Static Void mkxtic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to xtic */ double length, dx, dy, number; long width, decimal; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%ld%ld%*[^\n]", &length, &dx, &dy, &number, &width, &decimal); getc(infile->f); xtic(outfile, length, dx, dy, number, width, decimal); } /* end module domod.mkxtic */ /* begin module domod.mkytic */ Static Void mkytic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to ytic */ double length, dx, dy, number; long width, decimal; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%ld%ld%*[^\n]", &length, &dx, &dy, &number, &width, &decimal); getc(infile->f); ytic(outfile, length, dx, dy, number, width, decimal); } /* end module domod.mkytic */ /* begin module domod.mkxaxis */ Static Void mkxaxis(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to xaxis */ double axlength, fromtic, interval, totic, length, dx, dy; long width, decimal; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%lg%lg%lg%ld%ld%*[^\n]", &axlength, &fromtic, &interval, &totic, &length, &dx, &dy, &width, &decimal); getc(infile->f); xaxis(outfile, axlength, fromtic, interval, totic, length, dx, dy, width, decimal); } /* end module domod.mkxaxis */ /* begin module domod.mkyaxis */ Static Void mkyaxis(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to yaxis */ double aylength, fromtic, interval, totic, length, dx, dy; long width, decimal; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%lg%lg%lg%lg%lg%ld%ld%*[^\n]", &aylength, &fromtic, &interval, &totic, &length, &dx, &dy, &width, &decimal); getc(infile->f); yaxis(outfile, aylength, fromtic, interval, totic, length, dx, dy, width, decimal); } /* end module domod.mkyaxis */ /* begin module domod.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 domod.mkboxr */ /* begin module domod.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 domod.mkcboxr */ /* begin module domod.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 domod.mkibeam */ /* begin module domod.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 domod.mkcircler */ /* begin module domod.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 domod.mkspiral */ /* begin module domod.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 domod.mkmovepolar */ /* begin module domod.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 domod.mkarc */ /* begin module domod.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 domod.mkplusr */ /* begin module domod.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 domod.mkxr */ /* begin module domod.mkrectinit */ Static Void mkrectinit(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to rectinit */ /* note that no testblank is needed because there are no arguments */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); /* needed to get to the next line */ rectinit(outfile); } /* end module domod.mkrectinit */ /* begin module pic.mkrectsize */ Static Void mkrectsize(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to rectsize */ double xside, yside; testblank(infile, outfile); fscanf(infile->f, "%lg%lg%*[^\n]", &xside, &yside); getc(infile->f); fprintf(outfile->f, "mkrectsize %*.*f %*.*f\n", picfield, picwidth, xside, picfield, picwidth, yside); } /* end module pic.mkrectsize */ /* begin module domod.mkrectdo */ Static Void mkrectdo(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to rectdo */ /* note that no testblank is needed because there are no arguments */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); /* needed to get to the next line */ rectdo(outfile); } /* end module domod.mkrectdo */ /* begin module domod.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 domod.mksetgray */ /* begin module domod.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 domod.mksetcolor */ /* begin module domod.mktest3d */ Static Void mktest3d(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to test3d */ /* note that no testblank is needed because there are no arguments */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); /* needed to get to the next line */ test3d(outfile); } /* Local variables for translate: */ struct LOC_translate { _TEXT *infile, *outfile; 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, rectinit, rectsize, rectdo, setgray, setcolor, test3d; } ; 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->rectinit, "rectinit "); filltrigger(&LINK->rectsize, "rectsize "); filltrigger(&LINK->rectdo, "rectdo "); filltrigger(&LINK->setgray, "setgray "); filltrigger(&LINK->setcolor, "setcolor "); filltrigger(&LINK->test3d, "test3d "); } 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->rectinit); resettrigger(&LINK->rectsize); resettrigger(&LINK->rectdo); resettrigger(&LINK->setgray); resettrigger(&LINK->setcolor); resettrigger(&LINK->test3d); } 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 */ /* write(outfile,'*',ch); if inpicture then write(outfile,'p') else write(outfile,'t');*/ if (inpicture) { if (LINK->go) { testfortrigger(LINK->ch, &LINK->pe); if (LINK->pe.found) { 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) { printf("demo\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->rectinit); if (LINK->rectinit.found) { mkrectinit(LINK->infile, LINK->outfile); LINK->go = false; } } if (LINK->go) { testfortrigger(LINK->ch, &LINK->rectdo); if (LINK->rectdo.found) { mkrectdo(LINK->infile, 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->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->test3d); if (LINK->test3d.found) { mktest3d(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; } } } /* corresponds to: if inpicture then begin */ else { testfortrigger(LINK->ch, &LINK->ps); if (LINK->ps.found) { mkstartpic(LINK->infile, LINK->outfile); LINK->go = false; } } /* not in a picture yet */ if (!LINK->go) return; if (LINK->ch != ' ') return; graphstring(LINK->outfile, &LINK->buffer, false); copyaline(LINK->infile, LINK->outfile); LINK->go = false; } /* end module domod.mktest3d */ /* begin module domod.translate */ Static Void translate(infile_, outfile_) _TEXT *infile_, *outfile_; { /* transparently read infile, process each token and generate the same result on outfile. */ struct LOC_translate V; long index; /* a position in buffer */ V.infile = infile_; V.outfile = outfile_; 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, false); else { writestring(V.outfile, &V.buffer); putc('\n', V.outfile->f); } 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 domod.translate */ /* begin module domod.themain */ Static Void themain(fromfile, tofile) _TEXT *fromfile, *tofile; { /* the main procedure of the program */ translate(fromfile, tofile); } /* end module domod.themain */ main(argc, argv) int argc; Char *argv[]; { _TEXT TEMP, TEMP1; PASCAL_MAIN(argc, argv); if (setjmp(_JL1)) goto _L1; TEMP.f = stdin; *TEMP.name = '\0'; TEMP1.f = stdout; *TEMP1.name = '\0'; themain(&TEMP, &TEMP1); _L1: exit(EXIT_SUCCESS); } /* End. */