summaryrefslogtreecommitdiff
path: root/dviware/psprint/vms/psdvi.mod
diff options
context:
space:
mode:
Diffstat (limited to 'dviware/psprint/vms/psdvi.mod')
-rw-r--r--dviware/psprint/vms/psdvi.mod1207
1 files changed, 1207 insertions, 0 deletions
diff --git a/dviware/psprint/vms/psdvi.mod b/dviware/psprint/vms/psdvi.mod
new file mode 100644
index 0000000000..79c664ab3c
--- /dev/null
+++ b/dviware/psprint/vms/psdvi.mod
@@ -0,0 +1,1207 @@
+MODULE PSDVI;
+
+(* Author: Andrew Trevorrow
+ Implementation: University of Hamburg Modula-2 under VAX/VMS version 4
+ Date Started: August, 1986
+ Released: September, 1986 (version 1.0)
+
+ Description:
+ PSDVI reads a TeX DVI file and creates a corresponding PostScript file.
+ This output file needs to be prefixed with some PostScript code.
+ The /HEADER option can be used to include any desired file.
+ PSDVI can be used by itself (see PSDVI.HLP) or as part of the
+ PSPRINT system (see the PSPRINT User Guide and System Guide).
+ Much of the code has been borrowed from DVItoVDU.
+
+ Notes:
+ - Debugging code is bracketed by (* DEBUG *) ... (* GUBED *).
+ This code will be disabled in the final working version.
+ - System-dependent code is indicated by the string "SYSDEP".
+ - Uncertain or unfinished code is indicated by the strings "???" and "!!!".
+ - Procedures are defined in a top-down manner: each procedure is usually
+ defined as soon as possible after its first use.
+ - The above notes also apply to the local modules used by PSDVI.
+
+ Revised:
+ December, 1986
+ - PXLReader has become FontReader and can handle other font formats.
+ All font-dependent code has been moved into FontReader.
+ - Use LoadBitmap from FontReader instead of LoadPSChar from PSWriter
+ to output PostScript code for each character bitmap.
+ Unlike DVItoVDU, PSDVI does not need to store each bitmap for later use.
+ - Released version 1.1 in January, 1987
+
+ November, 1987 (while at The Open University)
+ - Import tfmdir (for display in ShowOptions) and conserveVM from Options.
+ - Import SaveVM and RestoreVM from PSWriter.
+ - Import SetPostScriptChar from PSWriter; it is used (instead of
+ SetBitmapChar) to typeset characters from a resident PostScript font.
+ - Use conserveVM flag to call a different sequence of PSWriter
+ routines if the user wants to conserve virtual memory.
+ - Use psfont flag (set in BuildFontSpec in FontReader) to control the
+ sequence of PSWriter routines for resident PostScript fonts.
+ - Added ShowPtSize routine to show requested pt size for PostScript fonts.
+ - Added PSDVI banner line to start of ShowOptions showing version number.
+ - Released version 2.0 in December, 1987
+
+ June--August, 1988 (while at Aston University)
+ - Added /psprefix qualifier so that sites have some flexibility in choosing
+ the prefix that indicates a PostScript font.
+ - Added /increment qualifier to enhance page selection for duplex printing.
+ - Added /hoffset and /voffset qualifiers to allow shifting of page.
+ - Removed "Creating ..." message due to changes in *_PRINT.COM files.
+ - No longer use StartLn/WriteBuffer/pagesperline.
+ Page numbers now appear on separate lines.
+ - Released version 3.0 in August, 1988
+
+ September--October, 1989 (while at Aston University, 2nd time)
+ - \special info now added to tail of speciallist.
+ - Released version 3.1 in October, 1989
+*)
+
+
+FROM Storage IMPORT
+ ALLOCATE, DEALLOCATE; (* for NEW and DISPOSE *)
+
+
+(* SYSDEP: Modula-2 avoids the problem of system dependence by simply
+ not providing any input/output routines etc. The above importations
+ are highly system-dependent.
+
+ The following modules are kept with the file you are now reading.
+ See the .DEF files for details on how the imported identifiers should be
+ used; implementation details can be found in the corresponding .MOD files.
+*)
+
+
+(* The TermOut module is used to do all terminal output. *)
+FROM TermOut IMPORT
+ Write, WriteString, WriteInt, WriteCard, WriteLn, Halt;
+
+
+(* The Options module carries out the task of reading the DCL command
+ line and extracting the DVI file parameter and qualifiers.
+*)
+FROM Options IMPORT
+ validunits, units,
+ reverse, stats, conserveVM,
+ subrange, firstTeXpage, finalTeXpage, firstDVIpage, finalDVIpage,
+ increment, resolution, mag, paperwd, paperht, hoffset, voffset,
+ psprefix, tfmdir, fontdir, dummyfont, header, PSname, DVIname;
+
+
+(* PSDVI uses the routines and data structures defined in DVIReader to move
+ about randomly in the DVI file and to interpret pages.
+ The reference points of characters and rules on a page are stored as
+ pairs of horizontal and vertical pixel coordinates.
+ The coordinate scheme is described in detail in DVIREADER.DEF.
+*)
+FROM DVIReader IMPORT
+ ruletablesize, chartablesize, maxfontspec, maxTeXchar,
+ ruleinfo, ruleinfoptr,
+ fontstring, fontinfo, fontinfoptr,
+ charinfo, charinfoptr, pixeltable, pixeltableptr,
+ TeXcounters, TeXpageinfo,
+ DVIerrorcodes, GetByteFunction,
+ DVImag, totalpages, totalfonts,
+ currDVIpage, currTeXpage,
+ rulelist, totalrules, fontlist, currfont,
+ minhp, minvp, maxhp, maxvp, pageempty,
+ DVIErrorRoutine, SpecialRoutine, PixelTableRoutine,
+ OpenDVIFile, SetConversionFactor, MoveToDVIPage, CurrMatchesNew,
+ PixelRound, InterpretPage, SortFonts, CloseDVIFile;
+
+
+(* PSDVI gets character metrics and bitmaps from font files.
+ The FontReader module can handle a variety of different font formats.
+ No more than one font file will be open at any given time.
+*)
+FROM FontReader IMPORT
+ FillPixelTable, LoadBitmap,
+ InitFontReader, BuildFontSpec,
+ OpenFontFile, CloseFontFile;
+
+
+(* The PSWriter routines are used to create an output file containing
+ the appropriate PostScript code.
+*)
+FROM PSWriter IMPORT
+ OpenOutput, OutputHeader, BeginPage, NewBitmapFont,
+ OutputPage, specialstring, OutputSpecial,
+ SaveVM, BeginPostScriptFont, SetPostScriptChar,
+ BeginBitmapFont, SetBitmapChar, EndFont, RestoreVM,
+ SetRule, EndPage, CloseOutput;
+
+
+(*******************************************************************************
+ GLOBAL DECLARATIONS
+*)
+
+CONST
+ NULL = 0C; (* SYSDEP: NULL terminates a string, unless full *)
+ warning = 0; (* SYSDEP: Halt parameter to set VMS $SEVERITY *)
+ success = 1; (* ditto *)
+ error = 2; (* ditto *)
+
+TYPE
+ specialinfoptr = POINTER TO specialinfo;
+ specialinfo = RECORD
+ special : specialstring;
+ hp, vp : INTEGER;
+ nextspecial : specialinfoptr;
+ END;
+
+VAR
+ speciallist : specialinfoptr; (* for storing \special info *)
+ specialtail : specialinfoptr; (* tail of speciallist *)
+ papertop,
+ paperleft,
+ paperbottom,
+ paperright : INTEGER; (* these define the edges of the paper *)
+ warncount, (* count of problems detected *)
+ pagecount : CARDINAL; (* count of pages actually output *)
+ unusedfont : fontinfoptr; (* first unused font in sorted fontlist *)
+
+
+(******************************************************************************)
+
+PROCEDURE TopLevel;
+
+(* Note that the implementation blocks of all imported modules have already
+ been executed. In particular, the Options module has read the DCL command
+ line and initialized the DVI file parameter and qualifier values.
+*)
+
+VAR i : CARDINAL;
+
+BEGIN
+Initialize;
+DVIErrorRoutine := MyDVIErrorRoutine; (* called by DVIReader *)
+OpenDVIFile(DVIname); (* and read DVImag etc. *)
+IF mag = 0 THEN mag := DVImag END; (* no /MAG value so use DVImag *)
+SetConversionFactor(resolution,mag); (* for DVIReader *)
+SpecialRoutine := MySpecialRoutine; (* called by InterpretPage *)
+PixelTableRoutine := MyPixelTableRoutine; (* called by InterpretPage *)
+InitFontReader; (* assign font-dependent routines *)
+IF stats THEN ShowOptions END;
+CheckPageRange; (* set firstDVIpage, finalDVIpage *)
+IF OpenOutput(PSname) THEN
+ (* DEBUG
+ WriteString('Creating ');
+ WriteString(PSname);
+ WriteLn;
+ GUBED *)
+ELSE
+ WriteString("Couldn't open output file: ");
+ WriteString(PSname);
+ WriteLn;
+ Halt(error);
+END;
+IF LEN(header) > 0 THEN (* output header file first *)
+ IF NOT OutputHeader(header) THEN
+ WriteString("Couldn't open header file: ");
+ WriteString(header);
+ WriteLn;
+ Halt(error);
+ END;
+END;
+IF increment > 1 THEN (* finalDVIpage may need reducing *)
+ WHILE (finalDVIpage - firstDVIpage) MOD increment > 0 DO
+ DEC(finalDVIpage);
+ END;
+END;
+IF reverse THEN
+ MoveToDVIPage(finalDVIpage); (* start with finalDVIpage *)
+ finalDVIpage := firstDVIpage; (* and end with firstDVIpage *)
+ELSE
+ MoveToDVIPage(firstDVIpage); (* start with firstDVIpage *)
+END;
+LOOP
+ DoPage; (* do at least one page *)
+ IF stats THEN ShowPageStats END;
+ IF currDVIpage = finalDVIpage THEN EXIT END;
+ IF reverse THEN
+ MoveToDVIPage(currDVIpage - increment);
+ ELSE
+ MoveToDVIPage(currDVIpage + increment);
+ END;
+END;
+IF stats THEN ShowFinalStats END;
+CloseDVIFile;
+CloseOutput;
+IF warncount > 0 THEN
+ Halt(warning);
+ELSE
+ Halt(success);
+END;
+END TopLevel;
+
+(******************************************************************************)
+
+PROCEDURE Initialize;
+
+BEGIN
+(* we don't bother checking for crazy resolution/paperht/paperwd values *)
+(* top left corner of paper is fixed at (-1",-1") *)
+papertop := -INTEGER(resolution);
+paperleft := -INTEGER(resolution);
+paperbottom := papertop + INTEGER(paperht) - 1;
+paperright := paperleft + INTEGER(paperwd) - 1;
+warncount := 0;
+pagecount := 0;
+speciallist := NIL; (* for first MySpecialRoutine *)
+END Initialize;
+
+(******************************************************************************)
+
+PROCEDURE MyDVIErrorRoutine (DVIerror : DVIerrorcodes);
+
+(* DVIErrorRoutine for DVIReader; see DVIREADER.DEF. *)
+
+BEGIN
+CASE DVIerror OF
+(* these errors are detected in OpenDVIFile; they are considered fatal *)
+ DVIunopened :
+ WriteString("Couldn't open DVI file: ");
+ WriteString(DVIname); WriteLn;
+ Halt(error); |
+ DVIempty :
+ WriteString(DVIname);
+ WriteString(' is empty!'); WriteLn;
+ Halt(error); |
+ DVIbadid :
+ WriteString(DVIname);
+ WriteString(' is not a valid DVI file!'); WriteLn;
+ Halt(error); |
+ DVIstackoverflow :
+ WriteString('Stack capacity exceeded!'); WriteLn;
+ PleaseReport;
+ Halt(error); |
+(* this error is detected in InterpretPage; we warn user but continue *)
+ DVIbadchar :
+ WITH currfont^ DO
+ WriteString('Ignoring unknown character from ');
+ WriteString(fontspec); Write('!');
+ WriteLn;
+ END; |
+(* this error should never happen *)
+ DVIcatastrophe :
+ WriteLn;
+ WriteString('Something awful has happened!'); WriteLn;
+ PleaseReport;
+ Halt(error);
+ELSE
+ (* this will only happen if we've missed a DVI error *)
+ WriteLn;
+ WriteString('Bug in MyDVIErrorRoutine!'); WriteLn;
+ PleaseReport;
+ Halt(error);
+END;
+END MyDVIErrorRoutine;
+
+(******************************************************************************)
+
+PROCEDURE PleaseReport;
+
+BEGIN
+WriteString('Please tell your local TeXnician.'); WriteLn;
+END PleaseReport;
+
+(******************************************************************************)
+
+PROCEDURE MySpecialRoutine (hpos, vpos,
+ totalbytes : INTEGER;
+ NextDVIByte : GetByteFunction);
+
+(* DVIReader has seen a \special command while interpreting the current page.
+ It will call this routine and pass the current page position, the number
+ of bytes in the command and a function to return their values one at a time.
+ Instead of calling OutputSpecial directly, we have to save the necessary
+ info away for later use (see DoPage).
+*)
+
+VAR i, flush : INTEGER; temp : specialinfoptr;
+
+BEGIN
+NEW(temp);
+WITH temp^ DO
+ special := ''; (* SYSDEP: fill with NULLs *)
+ FOR i := 0 TO totalbytes-1 DO
+ IF i <= HIGH(special) THEN
+ special[i] := CHR(NextDVIByte());
+ END;
+ END;
+ (* DVIReader demands that we read ALL the \special bytes *)
+ IF totalbytes > HIGH(special) + 1 THEN
+ INC(warncount);
+ WriteString('\special command is too long: ');
+ WriteString(special);
+ WriteLn;
+ WriteString('Truncating: ');
+ FOR i := 1 TO totalbytes - (HIGH(special) + 1) DO
+ Write(CHR(NextDVIByte())); (* display the truncated bytes *)
+ END;
+ WriteLn;
+ END;
+ hp := hpos;
+ vp := vpos;
+ nextspecial := NIL;
+END;
+(* add new node to tail of list *)
+IF speciallist = NIL THEN
+ speciallist := temp;
+ELSE
+ specialtail^.nextspecial := temp;
+END;
+specialtail := temp;
+END MySpecialRoutine;
+
+(******************************************************************************)
+
+PROCEDURE ShowDimension (pixels : INTEGER);
+
+(* Show the given pixel dimension in terms of units. *)
+
+VAR realdim : REAL; fracpart : CARDINAL;
+
+BEGIN
+CASE units OF
+ in : realdim := FLOAT(pixels) / FLOAT(resolution) |
+ cm : realdim := FLOAT(pixels) / FLOAT(resolution) * 2.54 |
+ mm : realdim := FLOAT(pixels) / FLOAT(resolution) * 25.4 |
+ pc : realdim := FLOAT(pixels) / FLOAT(resolution) * 72.27 / 12.0 |
+ pt : realdim := FLOAT(pixels) / FLOAT(resolution) * 72.27 |
+ bp : realdim := FLOAT(pixels) / FLOAT(resolution) * 72.0 |
+ px : WriteInt(pixels); WriteString('px'); RETURN;
+END;
+(* show realdim to an accuracy of 1 decimal place *)
+IF ABS(realdim) < 0.05 THEN
+ WriteString('0.0');
+ELSE
+ IF realdim < 0.0 THEN
+ Write('-');
+ realdim := ABS(realdim);
+ END;
+ realdim := realdim + 0.05; (* round up to 1 decimal place *)
+ WriteCard(TRUNC(realdim)); (* whole part *)
+ Write('.');
+ fracpart := TRUNC((realdim - FLOAT(TRUNC(realdim))) * 10.0);
+ (* fracpart is now 0..9 *)
+ WriteCard(fracpart);
+END;
+ShowUnits;
+END ShowDimension;
+
+(**********************************************************************)
+
+PROCEDURE ShowUnits;
+
+BEGIN
+CASE units OF
+ in : WriteString('in') |
+ cm : WriteString('cm') |
+ mm : WriteString('mm') |
+ pc : WriteString('pc') |
+ pt : WriteString('pt') |
+ bp : WriteString('bp') |
+ px : WriteString('px') |
+END;
+END ShowUnits;
+
+(******************************************************************************)
+
+PROCEDURE MyPixelTableRoutine;
+
+(* PixelTableRoutine for DVIReader which has just allocated a new pixeltable
+ for currfont^. DVIReader calls this routine from InterpretPage only
+ ONCE per font (the first time the font is used).
+ We get the pixeltable information from the font file given by fontspec.
+ If fontspec does not exist then dummyfont is used and fontid is undefined.
+ We don't output any PostScript for non-existent fonts.
+*)
+
+VAR i, fontsizelen, firstn, lastn : CARDINAL;
+
+BEGIN
+(* Initialize currfont^.fontspec and return start and end of fontsize
+ (unless psfont flag is set to TRUE).
+ currfont^.fontexists may also become TRUE.
+*)
+BuildFontSpec(currfont,firstn,lastn);
+WITH currfont^ DO
+ IF OpenFontFile(fontspec) THEN
+ (* only need fontid for a bitmapped font *)
+ IF NOT psfont THEN
+ fontid := fontname;
+ fontsizelen := lastn - firstn + 1;
+ IF fontnamelen + fontsizelen < maxfontspec THEN
+ (* append ".fontsize" to fontid *)
+ fontid[fontnamelen] := '.';
+ FOR i := 1 TO fontsizelen DO
+ fontid[fontnamelen + i] := fontspec[firstn + i - 1];
+ END;
+ IF fontnamelen + fontsizelen + 1 < maxfontspec THEN
+ fontid[fontnamelen + fontsizelen + 1] := NULL;
+ END;
+ ELSE
+ (* in the unlikely event that there is no room to append ".fontsize"
+ we simply leave fontid = fontname and hope it's unique *)
+ WriteString("fontname too long: "); WriteString(fontname); WriteLn;
+ WriteString("Increase maxfontspec in DVIReader."); WriteLn;
+ END;
+ IF NOT conserveVM THEN
+ NewBitmapFont(fontid);
+ END;
+ END;
+ (* DEBUG
+ WriteString('Reading font data from '); WriteString(fontspec); WriteLn;
+ GUBED *)
+ ELSIF OpenFontFile(dummyfont) THEN
+ (* fontid is left undefined; it will not be used *)
+ INC(warncount);
+ WriteString("Couldn't open font file: "); WriteString(fontspec); WriteLn;
+ (* use dummy font info instead *)
+ ELSE
+ WriteString("Couldn't open dummy font: "); WriteString(dummyfont);
+ WriteLn; Halt(error);
+ END;
+ FillPixelTable;
+ CloseFontFile;
+END;
+END MyPixelTableRoutine;
+
+(******************************************************************************)
+
+PROCEDURE ShowOptions;
+
+(* Show DVI file name and qualifier values set in Options module. *)
+
+BEGIN
+WriteString('This is PSDVI, version 3.1');
+WriteLn; WriteLn;
+WriteString('DVI file = '); WriteString(DVIname);
+WriteLn;
+WriteString('PostScript file = '); WriteString(PSname);
+WriteLn;
+WriteString('Header file = '); WriteString(header);
+WriteLn;
+WriteString('Resolution = '); WriteCard(resolution);
+WriteString(' pixels per inch');
+WriteLn;
+WriteString('Magnification = '); WriteCard(mag);
+IF mag <> DVImag THEN
+ WriteString(' (DVI mag of '); WriteCard(DVImag);
+ WriteString(' was overridden)');
+ELSE
+ WriteString(' (DVI mag)');
+END;
+WriteLn;
+WriteString('TFM directory = '); WriteString(tfmdir);
+WriteLn;
+WriteString('PS font prefix = '); WriteString(psprefix);
+WriteLn;
+WriteString('Font directory = '); WriteString(fontdir);
+WriteLn;
+WriteString('Dummy font = '); WriteString(dummyfont);
+WriteLn;
+WriteString('Horizontal offset = '); ShowDimension(hoffset);
+WriteLn;
+WriteString('Vertical offset = '); ShowDimension(voffset);
+WriteLn;
+WriteString('Paper width = '); ShowDimension(paperwd);
+WriteLn;
+WriteString('Paper height = '); ShowDimension(paperht);
+WriteLn;
+WriteString('Units = '); ShowUnits;
+WriteLn;
+WriteString('Reverse = ');
+IF reverse THEN WriteString('true') ELSE WriteString('false') END;
+WriteLn;
+WriteString('Stats = ');
+IF stats THEN WriteString('true') ELSE WriteString('false') END;
+WriteLn;
+WriteString('Conserve VM = ');
+IF conserveVM THEN WriteString('true') ELSE WriteString('false') END;
+WriteLn;
+WriteString('Pages = ');
+IF subrange THEN
+ IF firstDVIpage = 0 THEN
+ WriteString(firstTeXpage);
+ ELSE
+ WriteCard(firstDVIpage);
+ END;
+ Write(':');
+ IF finalDVIpage = 0 THEN
+ WriteString(finalTeXpage);
+ ELSE
+ WriteCard(finalDVIpage);
+ END;
+ELSE
+ WriteString('all pages');
+END;
+IF increment > 1 THEN
+ WriteString(', but with an increment of ');
+ WriteCard(increment);
+END;
+WriteLn;
+WriteLn;
+END ShowOptions;
+
+(******************************************************************************)
+
+PROCEDURE CheckPageRange;
+
+(* If user requested a page subrange then we make sure it is valid. *)
+
+VAR newTeXpage : TeXpageinfo;
+
+BEGIN
+IF NOT subrange THEN (* translate all pages *)
+ firstDVIpage := 1;
+ finalDVIpage := totalpages;
+ELSE
+ IF firstDVIpage = 0 THEN (* parse and locate firstTeXpage *)
+ IF ParseTeXPage(firstTeXpage,newTeXpage) THEN
+ MoveToDVIPage(1);
+ (* go forwards until newTeXpage matches currTeXpage *)
+ LOOP
+ IF CurrMatchesNew(newTeXpage) THEN
+ firstDVIpage := currDVIpage;
+ EXIT;
+ ELSIF currDVIpage = totalpages THEN
+ WriteString('First TeX page does not exist!'); WriteLn;
+ Halt(error);
+ ELSE
+ MoveToDVIPage(currDVIpage + 1);
+ END;
+ END;
+ ELSE
+ WriteString('Error in first TeX page!'); WriteLn;
+ Halt(error);
+ END;
+ END;
+ IF finalDVIpage = 0 THEN (* parse and locate finalTeXpage *)
+ IF ParseTeXPage(finalTeXpage,newTeXpage) THEN
+ MoveToDVIPage(totalpages);
+ (* go backwards until newTeXpage matches currTeXpage *)
+ LOOP
+ IF CurrMatchesNew(newTeXpage) THEN
+ finalDVIpage := currDVIpage;
+ EXIT;
+ ELSIF currDVIpage = 1 THEN
+ WriteString('Final TeX page does not exist!'); WriteLn;
+ Halt(error);
+ ELSE
+ MoveToDVIPage(currDVIpage - 1);
+ END;
+ END;
+ ELSE
+ WriteString('Error in final TeX page!'); WriteLn;
+ Halt(error);
+ END;
+ END;
+ IF firstDVIpage > finalDVIpage THEN
+ WriteString('First page > final page!'); WriteLn; Halt(error);
+ ELSIF firstDVIpage > totalpages THEN
+ WriteString('First page > total number of pages!'); WriteLn; Halt(error);
+ END;
+ (* allow user to give a final page > totalpages *)
+ IF finalDVIpage > totalpages THEN finalDVIpage := totalpages END;
+END;
+END CheckPageRange;
+
+(******************************************************************************)
+
+PROCEDURE ParseTeXPage (VAR pagestring : ARRAY OF CHAR;
+ VAR newTeXpage : TeXpageinfo)
+ : BOOLEAN;
+
+(* Return TRUE if TeX page specification in pagestring is valid. If so then
+ newTeXpage will contain the appropriate information for CurrMatchesNew.
+ The syntax of a TeX page specification is [n{.n}] where n is any integer as
+ defined by GetInteger. Up to 10 integers may be given and are separated by
+ periods, even if absent. Trailing periods may be omitted. Spaces before
+ and after integers and periods are skipped. The 10 positions correspond to
+ the \count0, \count1, ... ,\count9 values that TeX stores with every page.
+*)
+
+VAR pos, len : CARDINAL;
+
+BEGIN
+WITH newTeXpage DO
+ pos := 0;
+ IF pagestring[pos] <> '[' THEN
+ WriteString('[ expected!'); WriteLn;
+ RETURN FALSE;
+ END;
+ lastvalue := 0;
+ len := LEN(pagestring);
+ LOOP
+ INC(pos);
+ present[lastvalue] := GetInteger(pagestring, len, pos, value[lastvalue]);
+ (* pos now at len, space, period, non-digit or ']' *)
+ WHILE (pos < len) AND (pagestring[pos] = ' ') DO
+ INC(pos); (* skip any spaces *)
+ END;
+ IF pos = len THEN (* check this first! *)
+ WriteString('] expected!'); WriteLn;
+ RETURN FALSE;
+ END;
+ IF pagestring[pos] = ']' THEN (* end of TeX page specification *)
+ EXIT;
+ END;
+ IF lastvalue < 9 THEN
+ INC(lastvalue);
+ ELSE
+ WriteString("] expected after 10 integers!"); WriteLn;
+ RETURN FALSE;
+ END;
+ IF pagestring[pos] <> '.' THEN
+ WriteString('Period, integer or ] expected!'); WriteLn;
+ RETURN FALSE;
+ END;
+ END;
+ WHILE (lastvalue > 0) AND (NOT present[lastvalue]) DO
+ DEC(lastvalue);
+ END;
+END;
+RETURN TRUE;
+END ParseTeXPage;
+
+(******************************************************************************)
+
+PROCEDURE GetInteger (VAR str : ARRAY OF CHAR; (* in *)
+ strlen : CARDINAL; (* in *)
+ VAR pos : CARDINAL; (* in/out *)
+ VAR n : INTEGER (* out *)
+ ) : BOOLEAN;
+
+(* Extract an integer from given str starting at given pos.
+ pos is also used to return the position after the integer.
+ If no integer is found then set n to 0 and return FALSE (pos will only
+ change if leading spaces were skipped).
+ If ABS(n) > limit then set n to sign * limit.
+ Valid syntax is +{digit} or -{digit} or digit{digit}.
+ Note that a + or - by itself is valid and sets n to 0.
+*)
+
+CONST limit = 2147483647; (* 2^31 - 1 *)
+ threshold = limit DIV 10; (* nearing overflow *)
+
+VAR absval, last : CARDINAL;
+ sign : INTEGER;
+ inttoobig : BOOLEAN;
+
+BEGIN
+WHILE (pos < strlen) AND (str[pos] = ' ') DO (* skip any spaces *)
+ INC(pos);
+END;
+absval := 0; sign := 1; last := pos;
+inttoobig := FALSE;
+IF pos < strlen THEN
+ IF str[pos] = '-' THEN
+ sign := -1; INC(last);
+ ELSIF str[pos] = '+' THEN
+ INC(last);
+ END;
+ WHILE (last < strlen) AND
+ (str[last] >= '0') AND (str[last] <= '9') DO
+ IF (absval > threshold) OR ((absval = threshold) AND (str[last] > '7'))
+ THEN
+ inttoobig := TRUE;
+ ELSE
+ absval := absval * 10 + (ORD(str[last]) - ORD('0'));
+ END;
+ INC(last);
+ END;
+END;
+IF pos = last THEN
+ n := 0;
+ RETURN FALSE;
+ELSE
+ pos := last;
+ IF inttoobig THEN absval := limit END;
+ n := sign * INTEGER(absval);
+ RETURN TRUE;
+END;
+END GetInteger;
+
+(******************************************************************************)
+
+PROCEDURE DoPage;
+
+(* Interpret the current DVI page and fill in DVIReader's data structures.
+ PSWriter routines are called at appropriate times to output
+ the PostScript description of the current page.
+*)
+
+BEGIN
+INC(pagecount);
+WriteCard(currDVIpage); (* show the current DVI page *)
+Write('/'); ShowTeXPage; (* and TeX page *)
+WriteLn;
+
+BeginPage(currDVIpage);
+InterpretPage; (* MyPixelTableRoutine calls NewBitmapFont *)
+IF pageempty THEN
+ OutputPage(currDVIpage); (* must be called even if no chars/rules *)
+ DoSpecials;
+ELSE
+ (* check that the page edges are within the paper edges *)
+ IF (minhp < paperleft) OR (minvp < papertop) OR
+ (maxhp > paperright) OR (maxvp > paperbottom) THEN
+ PageOffPaper;
+ END;
+ (* Sort fonts in order of increasing totalchars and
+ return pointer to first unused font (for LoadFonts and DoFonts).
+ *)
+ SortFonts(unusedfont);
+ IF NOT conserveVM THEN
+ LoadFonts;
+ END;
+ OutputPage(currDVIpage);
+ DoSpecials;
+ DoFonts;
+ DoRules;
+END;
+EndPage(currDVIpage); (* final PostScript for current page *)
+END DoPage;
+
+(******************************************************************************)
+
+PROCEDURE ShowTeXPage;
+
+(* Show current TeX page counter(s). *)
+
+VAR i, lastnonzero : CARDINAL;
+
+BEGIN
+Write('[');
+lastnonzero := 9;
+WHILE (lastnonzero > 0) AND (currTeXpage[lastnonzero] = 0) DO
+ DEC(lastnonzero); (* find last counter with non-zero value *)
+END;
+(* always show \count0 but don't show trailing 0 counters *)
+FOR i := 0 TO lastnonzero DO
+ WriteInt(currTeXpage[i]);
+ IF i <> lastnonzero THEN
+ Write('.');
+ END;
+END;
+Write(']');
+END ShowTeXPage;
+
+(******************************************************************************)
+
+PROCEDURE PageOffPaper;
+
+(* One or more page edges do not fall within the paper edges.
+ We show user just how bad the problem is.
+*)
+
+BEGIN
+INC(warncount);
+WriteString('Page off paper (paper is ');
+ShowDimension(paperwd); WriteString(' wide by ');
+ShowDimension(paperht); WriteString(' high)');
+WriteLn;
+IF minhp < paperleft THEN
+ WriteString('Beyond left edge by ');
+ ShowDimension(paperleft - minhp);
+ WriteLn;
+END;
+IF maxhp > paperright THEN
+ WriteString('Beyond right edge by ');
+ ShowDimension(maxhp - paperright);
+ WriteLn;
+END;
+IF minvp < papertop THEN
+ WriteString('Above top edge by ');
+ ShowDimension(papertop - minvp);
+ WriteLn;
+END;
+IF maxvp > paperbottom THEN
+ WriteString('Below bottom edge by ');
+ ShowDimension(maxvp - paperbottom);
+ WriteLn;
+END;
+END PageOffPaper;
+
+(******************************************************************************)
+
+PROCEDURE LoadFonts;
+
+(* For each bitmapped font that is used (and exists) on the current page,
+ go thru charlist and call LoadBitmap for each character that hasn't yet
+ been downloaded. BeginBitmapFont will only be called if necessary.
+*)
+
+VAR
+ thisfontinfo : fontinfoptr; (* current font info in fontlist *)
+ thischarinfo : charinfoptr; (* current char info in charlist *)
+ thischar : CARDINAL; (* current index into current chartable *)
+ fontopen : BOOLEAN; (* is thisfontinfo^.fontspec open? *)
+
+BEGIN
+thisfontinfo := fontlist;
+WHILE thisfontinfo <> unusedfont DO
+(* SortFonts makes sure we only consider used fonts *)
+WITH thisfontinfo^ DO
+ (* do nothing if resident PostScript font or bitmapped font doesn't exist *)
+ IF (NOT psfont) AND fontexists THEN
+ fontopen := FALSE; (* avoid opening font unnecessarily *)
+ thischarinfo := charlist;
+ WHILE thischarinfo <> NIL DO (* process unloaded chars in chartable *)
+ WITH thischarinfo^ DO
+ thischar := 0;
+ WHILE thischar < charcount DO
+ WITH chartable[thischar] DO
+ WITH pixelptr^[code] DO
+ IF (NOT loaded) AND (mapadr > 0) THEN (* load bitmap *)
+ IF NOT fontopen THEN
+ OpenFont(thisfontinfo);
+ BeginBitmapFont(fontid);
+ fontopen := TRUE; (* only open once *)
+ END;
+ LoadBitmap(thisfontinfo,code);
+ loaded := TRUE; (* only load once *)
+ END;
+ END;
+ END;
+ INC(thischar);
+ END;
+ thischarinfo := nextchar;
+ END;
+ END;
+ IF fontopen THEN CloseFontFile END;
+ END;
+ thisfontinfo := nextfont;
+END; (* WITH *)
+END; (* WHILE *)
+END LoadFonts;
+
+(******************************************************************************)
+
+PROCEDURE OpenFont (thisfontinfo : fontinfoptr);
+
+BEGIN
+WITH thisfontinfo^ DO
+ IF OpenFontFile(fontspec) THEN
+ (* DEBUG
+ WriteString("Loading characters for ");
+ WriteString(fontspec);
+ WriteLn;
+ GUBED *)
+ ELSE
+ (* this should never happen since we avoid loading dummy font chars *)
+ WriteLn;
+ WriteString('Bug in OpenFont! Could not open: ');
+ WriteString(fontspec);
+ WriteLn; Halt(error);
+ END;
+END;
+END OpenFont;
+
+(******************************************************************************)
+
+PROCEDURE DoSpecials;
+
+(* Call OutputSpecial for each \special command on the current page.
+ (The speciallist is built by MySpecialRoutine during InterpretPage.)
+*)
+
+VAR temp : specialinfoptr;
+
+BEGIN
+WHILE speciallist <> NIL DO
+ WITH speciallist^ DO
+ (* The \special bytes are treated as a file name, possibly followed by
+ a space and additional PostScript text.
+ PSWriter will read this file and copy it verbatim to the output file.
+ The optional text is prefixed to the file as a separate line.
+ *)
+ IF NOT OutputSpecial(special,hp,vp) THEN
+ INC(warncount);
+ WriteString("Couldn't open \special file: ");
+ WriteString(special); (* includes optional text *)
+ WriteLn;
+ ELSIF stats THEN
+ WriteString('\special command at (');
+ ShowDimension(hp); Write(',');
+ ShowDimension(vp); WriteString('): ');
+ WriteString(special); WriteLn;
+ END;
+ temp := speciallist;
+ speciallist := nextspecial;
+ DISPOSE(temp); (* speciallist must be NIL for next page *)
+ END;
+END;
+END DoSpecials;
+
+(******************************************************************************)
+
+PROCEDURE DoFonts;
+
+(* For each font that is used (and exists) on the current page,
+ call the appropriate sequence of PSWriter routines depending on
+ the conserveVM flag and whether the font is bitmapped or resident.
+ See PSWRITER.DEF for details.
+*)
+
+VAR
+ thisfontinfo : fontinfoptr; (* current font info in fontlist *)
+ thischarinfo : charinfoptr; (* current char info in charlist *)
+ thischar : CARDINAL; (* current index into current chartable *)
+
+BEGIN
+thisfontinfo := fontlist;
+WHILE thisfontinfo <> unusedfont DO
+(* SortFonts makes sure we only consider used fonts! *)
+WITH thisfontinfo^ DO
+ IF fontexists THEN (* won't be dummy font info *)
+ IF psfont THEN
+ BeginPostScriptFont(fontname,scaledsize,mag);
+ ELSE
+ IF conserveVM THEN SaveVM(fontid) END;
+ BeginBitmapFont(fontid);
+ END;
+
+ IF conserveVM AND (NOT psfont) THEN (* download bitmaps *)
+ OpenFont(thisfontinfo);
+ thischarinfo := charlist;
+ WHILE thischarinfo <> NIL DO (* process unique chars *)
+ WITH thischarinfo^ DO
+ thischar := 0;
+ WHILE thischar < charcount DO
+ WITH chartable[thischar] DO
+ WITH pixelptr^[code] DO
+ IF (NOT loaded) AND (mapadr > 0) THEN (* load bitmap *)
+ LoadBitmap(thisfontinfo,code);
+ loaded := TRUE; (* but only once *)
+ END;
+ END;
+ END;
+ INC(thischar);
+ END;
+ thischarinfo := nextchar;
+ END;
+ END;
+ CloseFontFile;
+ (* reset loaded flags to FALSE for next page *)
+ FOR thischar := 0 TO maxTeXchar DO
+ pixelptr^[thischar].loaded := FALSE;
+ END;
+ END;
+
+ IF psfont THEN
+ thischarinfo := charlist;
+ WHILE thischarinfo <> NIL DO
+ WITH thischarinfo^ DO
+ thischar := 0;
+ WHILE thischar < charcount DO
+ WITH chartable[thischar] DO
+ WITH pixelptr^[code] DO
+ IF mapadr > 0 THEN (* char exists *)
+ SetPostScriptChar(CHR(code),
+ hp,vp, (* reference point *)
+ pwidth); (* advance width *)
+ END;
+ END;
+ END;
+ INC(thischar);
+ END;
+ thischarinfo := nextchar;
+ END;
+ END;
+ ELSE
+ thischarinfo := charlist;
+ WHILE thischarinfo <> NIL DO
+ WITH thischarinfo^ DO
+ thischar := 0;
+ WHILE thischar < charcount DO
+ WITH chartable[thischar] DO
+ WITH pixelptr^[code] DO
+ IF mapadr > 0 THEN (* char exists *)
+ SetBitmapChar(CHR(code),
+ hp,vp, (* reference point *)
+ pwidth); (* advance width *)
+ END;
+ END;
+ END;
+ INC(thischar);
+ END;
+ thischarinfo := nextchar;
+ END;
+ END;
+ END;
+ EndFont;
+
+ IF conserveVM AND (NOT psfont) THEN RestoreVM END;
+ END;
+ thisfontinfo := nextfont;
+END; (* WITH *)
+END; (* WHILE *)
+END DoFonts;
+
+(******************************************************************************)
+
+PROCEDURE DoRules;
+
+(* Call SetRule for each rule on the current page. *)
+
+VAR thisrule : CARDINAL;
+ thisruleinfo : ruleinfoptr;
+
+BEGIN
+thisruleinfo := rulelist;
+WHILE thisruleinfo <> NIL DO
+ WITH thisruleinfo^ DO
+ thisrule := 0;
+ WHILE thisrule < rulecount DO
+ WITH ruletable[thisrule] DO
+ SetRule(wd,ht, (* width and height of rule *)
+ hp,vp); (* bottom left corner of rule *)
+ END;
+ INC(thisrule);
+ END;
+ thisruleinfo := nextrule;
+ END;
+END;
+END DoRules;
+
+(******************************************************************************)
+
+PROCEDURE ShowPageStats;
+
+(* Show rule/font/character statistics for current page. *)
+
+VAR fontcount : CARDINAL;
+ thisfontinfo : fontinfoptr;
+
+BEGIN
+WriteString('Total rules on current page = '); WriteCard(totalrules);
+WriteLn;
+WriteString('Fonts on current page:');
+WriteLn;
+fontcount := 0;
+thisfontinfo := fontlist;
+WHILE thisfontinfo <> NIL DO
+ WITH thisfontinfo^ DO
+ IF fontused THEN
+ WriteString(fontspec);
+ IF psfont THEN ShowPtSize(scaledsize) END;
+ IF NOT fontexists THEN WriteString(' DOES NOT EXIST!') END;
+ INC(fontcount);
+ WriteString(' total chars = '); WriteCard(totalchars); WriteLn;
+ END;
+ thisfontinfo := nextfont;
+ END;
+END;
+WriteString('Total fonts on current page = '); WriteCard(fontcount);
+WriteLn;
+WriteLn;
+END ShowPageStats;
+
+(******************************************************************************)
+
+PROCEDURE ShowFinalStats;
+
+(* Show some overall statistics. *)
+
+VAR fontsused, c, loadcount, loadtotal, bitmapbytes : CARDINAL;
+ thisfontinfo : fontinfoptr;
+
+BEGIN
+WriteString('Summary'); WriteLn;
+WriteString('======='); WriteLn;
+WriteLn;
+WriteString('Total pages output = '); WriteCard(pagecount);
+WriteLn;
+WriteString('Total pages in DVI file = '); WriteCard(totalpages);
+WriteLn;
+WriteString('Total fonts in DVI file = '); WriteCard(totalfonts);
+WriteLn;
+(* go thru fontlist showing info for EVERY font *)
+fontsused := 0;
+loadtotal := 0;
+bitmapbytes := 0;
+thisfontinfo := fontlist;
+WHILE thisfontinfo <> NIL DO
+ WITH thisfontinfo^ DO
+ IF fontspeclen > 0 THEN
+ WriteString(fontspec);
+ IF psfont THEN ShowPtSize(scaledsize) END;
+ IF fontexists THEN
+ INC(fontsused);
+ IF (NOT conserveVM) AND (NOT psfont) THEN
+ loadcount := 0;
+ FOR c := 0 TO maxTeXchar DO
+ WITH pixelptr^[c] DO
+ IF loaded AND (mapadr > 0) THEN
+ INC(loadcount);
+ INC(bitmapbytes, ht * ((wd + 7) DIV 8) );
+ END;
+ END;
+ END;
+ WriteString(' loaded chars = '); WriteCard(loadcount);
+ INC(loadtotal,loadcount);
+ END;
+ ELSE
+ WriteString(' DOES NOT EXIST!');
+ END;
+ ELSE
+ WriteString(fontname);
+ WriteString(' scaled ');
+ WriteCard(TRUNC( FLOAT(mag) *
+ FLOAT(scaledsize)/FLOAT(designsize) + 0.5 ));
+ WriteString(' not used');
+ END;
+ WriteLn;
+ thisfontinfo := nextfont;
+ END;
+END;
+WriteString('Total fonts actually used = '); WriteCard(fontsused);
+WriteLn;
+IF NOT conserveVM THEN
+ WriteString('Total characters loaded = '); WriteCard(loadtotal);
+ WriteLn;
+ WriteString('Hex digits in loaded bitmaps = 2 * '); WriteCard(bitmapbytes);
+ WriteLn;
+END;
+END ShowFinalStats;
+
+(******************************************************************************)
+
+PROCEDURE ShowPtSize (scaledsize : INTEGER);
+
+(* Show given font size (in DVI units) in terms of (possibly magnified) pts. *)
+
+VAR realdim : REAL; fracpart : CARDINAL;
+
+BEGIN
+WriteString(' at ');
+realdim := (FLOAT(scaledsize) / FLOAT(10000H)) * (FLOAT(mag) / 1000.0);
+(* show realdim to an accuracy of 1 decimal place *)
+IF ABS(realdim) < 0.05 THEN
+ WriteString('0');
+ELSE
+ IF realdim < 0.0 THEN
+ Write('-');
+ realdim := ABS(realdim);
+ END;
+ realdim := realdim + 0.05; (* round up to 1 decimal place *)
+ WriteCard(TRUNC(realdim)); (* whole part *)
+ fracpart := TRUNC((realdim - FLOAT(TRUNC(realdim))) * 10.0); (* 0..9 *)
+ IF fracpart > 0 THEN
+ Write('.');
+ WriteCard(fracpart);
+ END;
+END;
+WriteString('pt');
+END ShowPtSize;
+
+(******************************************************************************)
+
+BEGIN
+TopLevel;
+END PSDVI.