/* Output from p2c 1.21alpha-07.Dec.93, the Pascal-to-C translator */ /* From input file "dosun.p" */ #include /* dosun: pascal graphics library and preprocessor for Sun graphics by thomas schneider, copyright (c) 1988 module libraries required: delman, prgmods */ /* end of program */ /* begin module version */ #define version 2.17 /* of dosun, 1988 jan 13 origin 1988 jan 7 from doodle */ /* end module version */ /* begin module describe.dosun */ /* name dosun: pascal graphics library and preprocessor for Sun graphics synopsis dosun(demo: in, input: in, output: out) files demo: a file for demonstration of the program. type 'demo' to run it. 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 Sun graphics. description Dosun is equivalent to doodle (see doodle.p) but produces output directly to the screen using Suncore graphics. see also doodle.p, suncore graphics manual, domod.p author Thomas D. Schneider bugs none known technical note NONSTANDARD is a comment that means that this portion of the code is dependent on non-standard pascal for its function. */ /* end module describe.dosun */ /* begin module interact.const */ #define maxstring 150 /* the maximum string */ /* end module interact.const version = 'prgmod 3.97 85 may 5 tds'; */ /* begin module dosun.filler.const */ #define fillermax 20 /* the size of the filler array for a string */ /* end module dosun.filler.const */ /* begin module pic.const */ #define pi 3.14159265354 /* circumference divided by diameter of circle */ #define picfield 8 /* width of numbers printed to the file */ #define picwidth 5 /* number of decimal places for numbers */ #define charwidth 0.08 /* the width of characters in inches this allows centering of strings. */ #define scale 1.252 /* scale factor. converts graphic coordinates to inches */ /* p2c: dosun.p, line 69: Warning: * Could not open include file /usr/include/pascal/usercorepas.h [230] */ /* p2c: dosun.p, line 70: Warning: * Could not open include file /usr/include/pascal/typedefspas.h [230] */ /* p2c: dosun.p, line 72: Warning: * Could not open include file /usr/include/pascal/sunpas.h [230] */ /* p2c: dosun.p, line 73: Warning: * Could not open include file /usr/include/pascal/devincpas.h [230] */ /* suncore graphics definitions: */ /* NONSTANDARD */ /* 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: dosun.p, line 84: 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 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 */ /* NONSTANDARD */ /* suncore definitions: */ /* p2c: dosun.p, line 134: Warning: Symbol 'VWSURF' is not defined [221] */ extern long dsurf; /* viewing window surface */ Static long r; /* result of a function */ 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 */ /* Local variables for startpic: */ struct LOC_startpic { _TEXT *afile; long stage; /* how far we got initializing */ } ; Local Void ns(LINK) struct LOC_startpic *LINK; { /* next stage increment */ LINK->stage++; } Local Void die(LINK) struct LOC_startpic *LINK; { fprintf(LINK->afile->f, "picstart at stage %ld\n", LINK->stage); halt(); } /* 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_) _TEXT *afile_; { /* open the graphics field */ /* start pic output to file afile, set the globals */ /* NONSTANDARD */ struct LOC_startpic V; long segment = 1; /* the name of the retained segment */ /* p2c: dosun.p, line 369: Warning: Symbol 'VSURFST' is not defined [221] */ extern long tstr; /* who knows? */ V.afile = afile_; V.stage = 0; /* 12345678901234567890 */ /* tstr := 'Why Hellloooo There!'; */ tstr = " "; /* p2c: dosun.p, line 387: * Warning: Argument of WITH is not a RECORD [264] */ screenname = tstr; /* p2c: dosun.p, line 388: * Warning: Symbol 'SCREENNAME' is not defined [221] */ windowname = tstr; /* p2c: dosun.p, line 389: * Warning: Symbol 'WINDOWNAME' is not defined [221] */ /* p2c: dosun.p, line 390: * Warning: Symbol 'WINDOWFD' is not defined [221] */ dd = pasloc(pixwindd); /* p2c: dosun.p, line 391: * Warning: Symbol 'PIXWINDD' is not defined [221] */ /* p2c: dosun.p, line 391: Warning: Symbol 'PASLOC' is not defined [221] */ /* p2c: dosun.p, line 391: Warning: Symbol 'DD' is not defined [221] */ /* p2c: dosun.p, line 392: * Warning: Symbol 'INSTANCE' is not defined [221] */ /* p2c: dosun.p, line 393: * Warning: Symbol 'CMAPSIZE' is not defined [221] */ cmapname = tstr; /* p2c: dosun.p, line 394: * Warning: Symbol 'CMAPNAME' is not defined [221] */ /* p2c: dosun.p, line 395: Warning: Symbol 'FLAGS' is not defined [221] */ ns(&V); if (initializecore(BUFFERED, SYNCHRONOUS, TWOD) != 0) { /* p2c: dosun.p, line 398: * Warning: Symbol 'BUFFERED' is not defined [221] */ /* p2c: dosun.p, line 398: * Warning: Symbol 'SYNCHRONOUS' is not defined [221] */ /* p2c: dosun.p, line 398: Warning: Symbol 'TWOD' is not defined [221] */ /* p2c: dosun.p, line 398: * Warning: Symbol 'INITIALIZECORE' is not defined [221] */ die(&V); } ns(&V); if (initializevwsurf(dsurf, false) != 0) { /* p2c: dosun.p, line 399: * Warning: Symbol 'INITIALIZEVWSURF' is not defined [221] */ die(&V); } ns(&V); if (selectvwsurf(dsurf) != 0) { /* p2c: dosun.p, line 400: * Warning: Symbol 'SELECTVWSURF' is not defined [221] */ die(&V); } ns(&V); if (setviewport2(0.000, 0.75, 0.000, 0.75) != 0) { /* p2c: dosun.p, line 401: * Warning: Symbol 'SETVIEWPORT2' is not defined [221] */ die(&V); } /* xmin, xmax, ymin, ymax */ /* this is the actual "world" coordinates used: */ /* xmin, xmax, ymin, ymax */ ns(&V); if (setwindow(-5.0 / scale, 5.0 / scale, -5.0 / scale, 5.0 / scale) != 0) { /* p2c: dosun.p, line 407: * Warning: Symbol 'SETWINDOW' is not defined [221] */ die(&V); } ns(&V); if (createretainseg(segment) != 0) { /* p2c: dosun.p, line 409: * Warning: Symbol 'CREATERETAINSEG' is not defined [221] */ die(&V); } ns(&V); if (initializedevice(BUTTON, 1) != 0) { /* p2c: dosun.p, line 410: Warning: Symbol 'BUTTON' is not defined [221] */ /* p2c: dosun.p, line 410: * Warning: Symbol 'INITIALIZEDEVICE' is not defined [221] */ die(&V); } ns(&V); if (initializedevice(BUTTON, 2) != 0) { /* p2c: dosun.p, line 411: Warning: Symbol 'BUTTON' is not defined [221] */ /* p2c: dosun.p, line 411: * Warning: Symbol 'INITIALIZEDEVICE' is not defined [221] */ die(&V); } ns(&V); if (initializedevice(BUTTON, 3) != 0) { /* p2c: dosun.p, line 412: Warning: Symbol 'BUTTON' is not defined [221] */ /* p2c: dosun.p, line 412: * Warning: Symbol 'INITIALIZEDEVICE' is not defined [221] */ die(&V); } /* make characters scalable, but makes them slower to draw */ ns(&V); if (setcharprecision(CHARACTER) != 0) { /* p2c: dosun.p, line 415: * Warning: Symbol 'CHARACTER' is not defined [221] */ /* p2c: dosun.p, line 415: * Warning: Symbol 'SETCHARPRECISION' is not defined [221] */ die(&V); } ns(&V); if (setcharsize(charwidth / scale, charwidth * 1.6 / scale) != 0) { /* p2c: dosun.p, line 416: * Warning: Symbol 'SETCHARSIZE' is not defined [221] */ die(&V); } /* ns; if (setfont(GREEK) <> 0 ) then die; */ /* 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:picfield:picwidth);*/ } #define time 1000000L /* time in micro seconds to wait */ /* end module pic.startpic */ /* begin module pic.await */ Static Void await() { /* wait for the user to click the mouse */ /* the old way: */ /* Wait for user to type a carriage return. the routine assumes that there is a global file called input. NOTE: this only works in a gfxtool!! otherwise it essentialy hangs because the the associated console is not active */ /* 123 is left, mid, right, with buttons facing away from the user */ double x; /* the mouse way: */ /* writeln(output,'click any mouse button to continue'); repeat r := getmousestate(BUTTON,1,x,y,buttons); writeln(output,'(',x:10:5,',',y:10:5,') ',buttons:1); r := awaitanybutton(time, buttonnumber); until buttonnumber > 0; writeln(output,'button ',buttonnumber:1); */ /* the input way: */ /* writeln(output,'awaiting for a Return to continue'); while not eoln(input) do begin get(input) end; */ /* read past the input */ /* readln(input) */ /* the infinite way: */ printf("\n*********************************\n"); printf("* Use control-c to kill program *\n"); printf("*********************************\n"); while (true) ; } #undef time /* end module pic.await */ /* begin module pic.stoppic */ Static Void stoppic(afile) _TEXT *afile; { /* stop pic output to file afile */ /* NONSTANDARD */ long r; /* return value */ await(); r = terminatedevice(BUTTON, 1); /* p2c: dosun.p, line 484: Warning: Symbol 'BUTTON' is not defined [221] */ /* p2c: dosun.p, line 484: * Warning: Symbol 'TERMINATEDEVICE' is not defined [221] */ r = terminatedevice(BUTTON, 2); /* p2c: dosun.p, line 485: Warning: Symbol 'BUTTON' is not defined [221] */ /* p2c: dosun.p, line 485: * Warning: Symbol 'TERMINATEDEVICE' is not defined [221] */ r = terminatedevice(BUTTON, 3); /* p2c: dosun.p, line 486: Warning: Symbol 'BUTTON' is not defined [221] */ /* p2c: dosun.p, line 486: * Warning: Symbol 'TERMINATEDEVICE' is not defined [221] */ r = delallretainsegs; /* p2c: dosun.p, line 487: * Warning: Symbol 'DELALLRETAINSEGS' is not defined [221] */ r = deselectvwsurf(dsurf); /* p2c: dosun.p, line 488: * Warning: Symbol 'DESELECTVWSURF' is not defined [221] */ r = terminatecore; /* p2c: dosun.p, line 489: * Warning: Symbol 'TERMINATECORE' is not defined [221] */ inpicture = false; fprintf(afile->f, "(type control-d to terminate the program)\n"); } /* 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). */ /* NONSTANDARD */ if (visibility == 'i') { r = moverel2(dx, dy); /* p2c: dosun.p, line 508: * Warning: Symbol 'MOVEREL2' is not defined [221] */ } else { switch (visibility) { case '-': r = setlinestyle(DASHED); /* p2c: dosun.p, line 512: Warning: Symbol 'DASHED' is not defined [221] */ /* p2c: dosun.p, line 512: * Warning: Symbol 'SETLINESTYLE' is not defined [221] */ break; case '.': r = setlinestyle(DOTTED); /* p2c: dosun.p, line 513: Warning: Symbol 'DOTTED' is not defined [221] */ /* p2c: dosun.p, line 513: * Warning: Symbol 'SETLINESTYLE' is not defined [221] */ break; case 'l': r = setlinestyle(SOLID); /* p2c: dosun.p, line 514: Warning: Symbol 'SOLID' is not defined [221] */ /* p2c: dosun.p, line 514: * Warning: Symbol 'SETLINESTYLE' is not defined [221] */ break; } r = linerel2(dx, dy); /* p2c: dosun.p, line 516: * Warning: Symbol 'LINEREL2' is not defined [221] */ } 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). */ drawr(afile, dx, dy, 'i', 0.0); } /* 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). */ drawr(afile, dx, dy, 'l', 0.0); } /* 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). */ 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 */ /* 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 */ /* begin module pic.linea */ Static Void linea(afile, x, y) _TEXT *afile; double x, y; { /* draw a line from current position to absolute x and y */ drawa(afile, x, y, 'l', 0.0); } /* end module pic.linea */ /* 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 */ /* NONSTANDARD */ long i; /* index to s, and temporary storage */ double mv; /* holds amount to move, in plotting coordinates */ boolean quoted; /* true if the string is quoted */ /* p2c: dosun.p, line 588: Warning: Symbol 'CCT' is not defined [221] */ extern long stuff; /* an array 1..257 wide of char */ long FORLIM; if (!inpicture) { writestring(tofile, s); putc('\n', tofile->f); return; } 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) centered = true; if (centered) { /* generate the calls to center the string. Note: this must not be done for the pic program, which already centers */ if (quoted) i = s->length - 2; else i = s->length; mv = i * charwidth / (2.0 * scale); mover(tofile, -mv, 0.0); } if (quoted) { FORLIM = s->length - 2; /* remove quotes from string */ for (i = 1; i <= FORLIM; i++) { stuff[i] = s->letters[i]; /* p2c: dosun.p, line 613: Warning: Index on a non-array variable [287] */ } stuff[s->length - 1] = '\0'; /* end on null byte */ /* p2c: dosun.p, line 614: Warning: Index on a non-array variable [287] */ } else { FORLIM = s->length; for (i = 1; i <= FORLIM; i++) { stuff[i] = s->letters[i-1]; /* p2c: dosun.p, line 617: Warning: Index on a non-array variable [287] */ } stuff[s->length + 1] = '\0'; /* end on null byte */ /* p2c: dosun.p, line 618: Warning: Index on a non-array variable [287] */ } r = puttext(stuff); /* nonstandard suncore call */ /* p2c: dosun.p, line 621: Warning: Symbol 'PUTTEXT' is not defined [221] */ if (centered) { /* restore to previous location */ mover(tofile, mv, 0.0); } } /* 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; 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(); } /* put the sign in only if needed */ if (sign < 0) name->letters[bigdigit-2] = '-'; } for (place = name->length + width - 1; place >= bigdigit - 1; place--) { /* p2c: dosun.p, line 688: * 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 */ /* 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 */ 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, centered); mover(afile, -dx, -dy); } /* 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. */ liner(afile, 0.0, -length); picnumber(afile, dx, dy, number, width, decimal, true); mover(afile, 0.0, length); } /* 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. */ liner(afile, -length, 0.0); picnumber(afile, dx, dy, number, width, decimal, true); mover(afile, length, 0.0); } /* 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. */ 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 */ liner(afile, axlength, 0.0); mover(afile, -axlength, 0.0); if (totic == fromtic) { printf("xaxis: fromtic and totic cannot be equal\n"); halt(); } if (axlength == 0.0 || interval == 0.0) { printf("xaxis: neither axlength nor interval can be zero\n"); halt(); } jump = axlength * interval / (totic - fromtic); tic = fromtic; if (interval > 0.0) { while (tic <= totic) { xtic(afile, length, dx, dy, tic, width, decimal); tic += interval; if (tic > totic) break; mover(afile, jump, 0.0); jumpdistance += jump; } } else if (interval < 0.0) { while (tic >= totic) { xtic(afile, length, dx, dy, tic, width, decimal); tic += interval; if (tic < totic) break; mover(afile, jump, 0.0); jumpdistance += jump; } } mover(afile, -jumpdistance, 0.0); } /* 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. */ 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 */ liner(afile, 0.0, aylength); mover(afile, 0.0, -aylength); if (totic == fromtic) { printf("yaxis: fromtic and totic cannot be equal\n"); halt(); } if (aylength == 0.0 || interval == 0.0) { printf("yaxis: neither aylength nor interval can be zero\n"); halt(); } jump = aylength * interval / (totic - fromtic); tic = fromtic; if (interval > 0.0) { while (tic <= totic) { ytic(afile, length, dx, dy, tic, width, decimal); tic += interval; if (tic > totic) break; mover(afile, 0.0, jump); jumpdistance += jump; } } else if (interval < 0.0) { while (tic >= totic) { ytic(afile, length, dx, dy, tic, width, decimal); tic += interval; if (tic < totic) break; mover(afile, 0.0, jump); jumpdistance += jump; } } mover(afile, 0.0, -jumpdistance); } /* end module pic.yaxis */ /* ********************************************************************** */ /* begin module pic.dotr */ Static Void dotr(afile) _TEXT *afile; { /* draw a dot at the current position */ drawr(afile, 0.0, 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 inches.*/ 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; 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:20:19,'in normalcases');*/ 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); *LINK->intercept = true; /* optimistic */ 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 = 3.08; (@ of xyplo 1986 nov 6 */ /* 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 */ long s; /* index to the steps */ double theta; /* current angle */ double x, y; /* coordinates around starting point */ double zerox, zeroy; /* starting location, center of curve */ zerox = picxglobal; zeroy = picyglobal; theta = degtorad(angle1); dtheta = degtorad(fabs(angle2 - angle1) / steps); polrec(radius, theta, &x, &y); movea(thefile, zerox + x, zeroy + y); for (s = 1; s <= steps; s++) { theta += dtheta; polrec(radius, theta, &x, &y); linea(thefile, zerox + x, zeroy + y); } 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 (but never smaller than 0.025 inches) 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; if (r < 0.025) /* small circles do not come out well */ r = 0.025; circler(afile, r); } /* end module pic.ibeam */ /* ********************************************************************** */ /* ********************************************************************** */ /* ********************************************************************** */ /* 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: dosun.p, line 1342: * Warning: No field called V in that record [288] */ /* p2c: dosun.p, line 1342: Warning: Index on a non-array variable [287] */ s->v[2] = vy; /* p2c: dosun.p, line 1343: * Warning: No field called V in that record [288] */ /* p2c: dosun.p, line 1343: Warning: Index on a non-array variable [287] */ s->v[3] = vz; /* p2c: dosun.p, line 1344: * Warning: No field called V in that record [288] */ /* p2c: dosun.p, line 1344: Warning: Index on a non-array variable [287] */ s->g[1] = gx; /* p2c: dosun.p, line 1345: * Warning: No field called G in that record [288] */ /* p2c: dosun.p, line 1345: Warning: Index on a non-array variable [287] */ s->g[2] = gy; /* p2c: dosun.p, line 1346: * Warning: No field called G in that record [288] */ /* p2c: dosun.p, line 1346: 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: dosun.p, line 1347: * Warning: No field called G in that record [288] */ /* p2c: dosun.p, line 1347: Warning: Index on a non-array variable [287] */ /* p2c: dosun.p, line 1348: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1348: * Warning: Expected an expression, found a comma [227] */ /* p2c: dosun.p, line 1348: Warning: Symbol 'G' is not defined [221] */ /* p2c: dosun.p, line 1348: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1348: * Warning: Expected an expression, found a comma [227] */ /* p2c: dosun.p, line 1348: * Warning: Type mismatch in VAR parameter a [295] */ /* p2c: dosun.p, line 1348: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1348: * Warning: Expected an expression, found a comma [227] */ /* p2c: dosun.p, line 1348: * Warning: Type mismatch in VAR parameter b [295] */ /* p2c: dosun.p, line 1348: Warning: Expected a ':=', found a ')' [227] */ /* p2c: dosun.p, line 1348: * Warning: Expected an expression, found a ')' [227] */ /* p2c: dosun.p, line 1348: * Warning: Type mismatch in VAR parameter c [295] */ view(0, g, smagnitude, TEMP, TEMP1, TEMP2); s->smag = smagnitude; /* p2c: dosun.p, line 1349: * Warning: No field called SMAG in that record [288] */ s->range = 1 / smagnitude; /* p2c: dosun.p, line 1350: * 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: dosun.p, line 1366: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1366: * Warning: Expected an expression, found a comma [227] */ /* p2c: dosun.p, line 1366: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1366: * Warning: Expected an expression, found a comma [227] */ /* p2c: dosun.p, line 1366: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1366: * Warning: Expected an expression, found a comma [227] */ /* p2c: dosun.p, line 1366: Warning: Expected a ':=', found a comma [227] */ /* p2c: dosun.p, line 1366: * 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 */ 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; } } /* 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 dosun.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 dosun.readchar */ /* ********************************************************************** */ /* begin module dosun.mkhalt */ Static Void mkhalt(outfile) _TEXT *outfile; { /* generate the call to halt */ fprintf(outfile->f, "dosun "); 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 dosun.mkhalt */ /* begin module dosun.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 dosun.testblank */ /* begin module dosun.mkstartpic */ Static Void mkstartpic(infile, outfile) _TEXT *infile, *outfile; { /* generate the call to startpic */ fscanf(infile->f, "%*[^\n]"); getc(infile->f); startpic(outfile); } /* end module dosun.mkstartpic */ /* begin module dosun.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 dosun.mkstoppic */ /* begin module dosun.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 dosun.mkdrawr */ /* begin module dosun.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 dosun.mkmover */ /* begin module dosun.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 dosun.mkliner */ /* begin module dosun.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 dosun.mkdrawa */ /* begin module dosun.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 dosun.mkmovea */ /* begin module dosun.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 dosun.mklinea */ /* begin module dosun.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 dosun.mkdotr */ /* begin module dosun.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: dosun.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 dosun.mkpicnumber */ /* begin module dosun.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 dosun.mkxtic */ /* begin module dosun.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 dosun.mkytic */ /* begin module dosun.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 dosun.mkxaxis */ /* begin module dosun.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 dosun.mkyaxis */ /* begin module dosun.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 dosun.mkboxr */ /* begin module dosun.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 dosun.mkcboxr */ /* begin module dosun.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 dosun.mkibeam */ /* begin module dosun.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 dosun.mkcircler */ /* begin module dosun.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 dosun.mkspiral */ /* begin module dosun.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 dosun.mkmovepolar */ /* begin module dosun.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 dosun.mkarc */ /* begin module dosun.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 dosun.mkplusr */ /* begin module dosun.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 dosun.mkxr */ /* begin module dosun.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); } 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; } ; 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 "); } 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); } 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) startpic(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->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, false); } 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 dosun.mktest3d */ /* begin module dosun.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, 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 dosun.translate */ /* begin module dosun.themain */ Static Void themain(demo, fromfile, tofile) _TEXT *demo, *fromfile, *tofile; { /* the main procedure of the program */ printf("dosun %4.2f\n", version); /* prestart as a convenience */ /* startpic(tofile); writeln(tofile,'picture has been started'); */ translate(demo, fromfile, tofile, 0L); } /* end module dosun.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. */