diff options
Diffstat (limited to 'dviware/psprint/vms/psdvi.mod')
-rw-r--r-- | dviware/psprint/vms/psdvi.mod | 1207 |
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. |