|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T d
Length: 93685 (0x16df5)
Types: TextFile
Names: »dvitovdu.mod«
└─⟦060c9c824⟧ Bits:30007080 DKUUG TeX 2/12/89
└─⟦this⟧ »./DVIware/crt-viewers/others/dvitovdu/src/dvitovdu.mod«
└─⟦52210d11f⟧ Bits:30007239 EUUGD2: TeX 3 1992-12
└─⟦af5ba6c8e⟧ »unix3.0/DVIWARE.tar.Z«
└─⟦ca79c7339⟧
└─⟦this⟧ »DVIware/crt-viewers/others/dvitovdu/src/dvitovdu.mod«
MODULE dvitovdu;
(* Author: Andrew Trevorrow
Implementation: Modula-2 under VAX/UNIX 4.2 BSD
Date Started: June, 1986 (based on version 1.5 under VAX/VMS 4.2)
Description:
DVItoVDU allows pages from a DVI file produced by TeX82 to be viewed on a
variety of VDU screens.
See the DVItoVDU USER GUIDE for details on the user interface.
See the DVItoVDU SYSTEM GUIDE if you wish to install or modify the program.
Notes:
- Debugging code is bracketed by (* DEBUG *) ... (* GUBED *).
Most of this code will be commented out in the final working version.
- System-dependent code is indicated by (* SYSDEP ... *).
- Uncertain, unfinished or kludgey code is indicated by the string "???".
- Procedures are defined in a top-down manner. That is, each procedure is
usually defined as soon as possible after its first use.
- The above notes are also true for all the imported modules used by DVItoVDU.
*)
(* SYSDEP: Since Modula-2 avoids the problem of system dependence by simply
not providing any input/output routines etc., the following
importations are highly VAX/UNIX dependent.
*)
FROM io IMPORT
File, Open, Close, Readc;
(* The above module is part of the VAX/UNIX Modula-2 system library.
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.
*)
(* DVItoVDU uses the ScreenIO routines to do all terminal i/o. *)
FROM screenio IMPORT
Read, ReadString, BusyRead,
Write, WriteString, WriteInt, WriteCard, WriteLn, WriteBuffer,
RestoreTerminal;
(* InitSysInterface carries out the task of reading the command line
and extracting the DVI file name, along with any command options.
*)
FROM sysinterface IMPORT
InitSysInterface,
stringvalue,
resolution, mag, paperwd, paperht,
fontdir, dummyfont, helpname, vdu, DVIname;
(* DVItoVDU uses the routines and data structures defined in DVIReader to move
about randomly in the DVI file and to interpret pages.
*)
FROM dvireader IMPORT
(* CONST *)
ruletablesize, chartablesize, maxfontspec, maxTeXchar,
(* TYPE *)
ruleinfo, ruleinfoptr,
fontstring, fontinfo, fontinfoptr,
charinfo, charinfoptr, pixeltable, pixeltableptr,
TeXcounters, TeXpageinfo,
DVIerrorcodes, GetByteFunction,
(* VAR *)
DVImag, totalpages, totalfonts,
currDVIpage, currTeXpage,
rulelist, ruletail, totalrules, fontlist, currfont,
minhp, minvp, maxhp, maxvp, pageempty,
DVIErrorRoutine, SpecialRoutine, PixelTableRoutine,
(* PROCEDURE *)
OpenDVIFile, SetConversionFactor,
MoveToNextPage, MoveToDVIPage, MoveToTeXPage,
PixelRound, InterpretPage, SortFonts,
CloseDVIFile;
(* DVItoVDU needs to move about randomly in PXL files when getting information
on the character widths and glyph shapes in a particular font.
Only one PXL file will be open at any one time.
*)
FROM pxlreader IMPORT
OpenPXLFile,
MoveToPXLDirectory, MoveToPXLByte,
GetPXLByte, GetTwoPXLBytes, SignedPXLPair, SignedPXLQuad,
ClosePXLFile;
(* DVItoVDU can work efficiently on a variety of VDUs without having to
know all the nitty gritty details required to drive them.
Modula-2's procedure variables and separate compilation facilities provide
a very nice mechanism for achieving the desired terminal independence.
The generic VDU parameters and routines are initialized in InitVDUInterface.
*)
FROM vduinterface IMPORT
InitVDUInterface,
DVIstatusl, windowstatusl, messagel, commandl, bottoml,
windowh, windowv, windowwd, windowht,
StartText, MoveToTextLine, ClearTextLine, ClearScreen,
StartGraphics, LoadFont, ShowChar, ShowRectangle,
ResetVDU;
(*******************************************************************************
DECLARATIONS FOR PROCESSING USER COMMANDS
Most commands consist of one or two characters and can be entered
in upper or lowercase. Multiple commands are processed in the order
given but we only update the window, if necessary, at the end.
If a bad command is encountered, any further commands are ignored.
Some commands can have parameters; they are all dimensions in terms of the
current units. Spaces before and after commands and parameters are ignored.
*)
CONST
(* Possible commands are: *)
(* i a positive integer; display ith DVI page *)
TeXpage = '['; (* start of a TeX page specification: [i0. ... .i9] *)
Next = 'N'; (* display next DVI page, depending on direction *)
Forwards = '>'; (* process DVI pages in ascending order *)
Backwards = '<'; (* process DVI pages in descending order *)
Window = 'W'; (* move window's top left corner to given position *)
Up = 'U'; (* move window up a given amount *)
Down = 'D'; (* move window down a given amount *)
Left = 'L'; (* move window left a given amount *)
Right = 'R'; (* move window right a given amount *)
Hsize = 'H'; (* set scaledwd: window's horizontal size *)
Vsize = 'V'; (* set scaledht: window's vertical size *)
Terse = 'T'; (* display quick and nasty chars at reference points *)
Box = 'B'; (* display box outlines of glyphs *)
Full = 'F'; (* display all pixels in glyphs *)
Inch = 'I'; (* get/show dimensions in inches *)
(* SYSDEP: changed In to Inch because compiler got In confused with IN !!! *)
Cm = 'C'; (* get/show dimensions in centimetres *)
Mm = 'M'; (* get/show dimensions in millimetres *)
PcPtPx = 'P'; (* get/show dimensions in picas/points/pixels *)
Help = '?'; (* display help on available commands *)
Show = 'S'; (* display useful statistics *)
Quit = 'Q'; (* have a guess *)
maxcommstring = 80;
commprompt = 'Command:';
NULL = 0C; (* SYSDEP: used to terminate strings *)
EOL = 12C; (* SYSDEP: newline character *)
VAR
commstring (* holds user responses *)
: ARRAY [0..maxcommstring-1] OF CHAR;
commpos : CARDINAL; (* current position in commstring *)
commlen : CARDINAL; (* length of commstring *)
command : CHAR; (* starting character of command *)
ascending : BOOLEAN; (* initially TRUE; changed by the
Forwards/Backwards commands to control
how to get the next DVI page *)
maxpix : INTEGER; (* maximum absolute pixel value;
depends on resolution *)
(* These flags are used to handle multiple commands: *)
screenjustcleared, (* has screen just been cleared? *)
paintDVIStatus, (* does DVI status line need updating? *)
paintWindowStatus, (* does window status line need updating? *)
paintwindow, (* does window region need updating? *)
pageoffpaper, (* is page off paper? *)
badcommand : BOOLEAN; (* was there a bad command? *)
(*******************************************************************************
DECLARATIONS FOR DISPLAYING A PAGE
The reference points of characters and rules on a page are stored as
pairs of horizontal and vertical paper pixel coordinates.
The paper coordinate scheme is described in detail in DVIReader.
The screen coordinate scheme is described in detail in VDUInterface.
To update the window region, DVItoVDU maps visible paper pixels
to screen pixels using windowh and windowv to help with translation,
and windowwd and windowht to help with scaling.
What the user sees depends on the current displaymode, the current size
of the window region (scaledwd by scaledht are in paper pixels and determine
the horizontal and vertical scaling factors), and the current paper position
of the window region's top left corner; i.e., (windowleft,windowtop).
A NOTE ON THE SCALING METHOD USED BY DVItoVDU:
We desire the following conditions when scaling paper pixels to
screen pixels:
1. Rules/glyphs having the same top/bottom/left/right paper coordinates also
have the same screen coordinates (e.g., to ensure baselines line up).
This condition is incompatible with a rule/glyph staying the same
width and height as the window position changes! Too bad.
2. After being scaled, visible pixel positions must not exceed the
window region's edges. In our case, only the bottom and right edges are
a problem because scaling starts at the top left corner of the window.
For efficiency, we use two different scaling functions depending on
whether the h/vscalefactors are < 1.0 or not.
3. Scaled heights and widths must be > 0 even when h/vscalefactors
approach 0. If h/vscalefactors are > 1.0 then the width/height of
paper pixels increase accordingly.
*)
CONST
abortkey = EOL; (* user aborts display by hitting RETURN *)
VAR
displaymode : (tersemode (* show quick and nasty chars at ref pts *)
,boxmode (* show box outlines of glyphs *)
,fullmode (* show all pixels in glyphs *)
);
currentunits : (inunits (* get/show dimensions in inches *)
,cmunits (* get/show dimensions in centimetres *)
,mmunits (* get/show dimensions in millimetres *)
,pcunits (* get/show dimensions in picas *)
,ptunits (* get/show dimensions in points *)
,pxunits (* get/show dimensions in pixels *)
);
papertop,
paperleft,
paperbottom,
paperright : INTEGER; (* these define the edges of the paper *)
windowtop,
windowleft,
windowbottom,
windowright : INTEGER; (* these define the current window edges *)
allpagevisible : BOOLEAN; (* is all of page visible in window? *)
outsidepage : BOOLEAN; (* is entire window outside page? *)
scaledht : INTEGER; (* current window height in paper pixels *)
scaledwd : INTEGER; (* current window width in paper pixels *)
vscalefactor : REAL; (* windowht / scaledht *)
hscalefactor : REAL; (* windowwd / scaledwd *)
(* Expand/ShrinkHpos and Expand/ShrinkVpos are assigned to these
procedure variables depending on the values of h/vscalefactor. *)
ScaleVpos,
ScaleHpos : PROCEDURE (INTEGER) : INTEGER;
(* TerseChar, BoxChar or FullChar1/2 are assigned to DisplayOneChar
depending on the current displaymode (which the user can change by
hitting the Terse/Box/Full commands while DisplayChars is executing). *)
DisplayOneChar : PROC;
thisruleinfo : ruleinfoptr; (* current rule info in rulelist *)
unusedfont : fontinfoptr; (* first unused font in sorted fontlist *)
thisfontinfo : fontinfoptr; (* current font info in sorted fontlist *)
thischarinfo : charinfoptr; (* current char info in charlist *)
thischar : CARDINAL; (* current index into current chartable *)
fontopen : BOOLEAN; (* is thisfontinfo^.fontspec open? *)
useraborted : BOOLEAN; (* did user abort page display? *)
charvisible : BOOLEAN; (* was character actually displayed? *)
(******************************************************************************)
PROCEDURE TopLevel;
(* Note that the implementation blocks of all imported modules have already
been executed by this stage.
*)
BEGIN
InitSysInterface; (* initialize DVIname, resolution, vdu, mag, etc. *)
InitVDUInterface; (* initialize generic VDU routines and parameters *)
Initialize; (* uses some of the above parameters *)
DVIErrorRoutine := MyDVIErrorRoutine; (* called by DVIReader upon an error *)
OpenDVIFile(DVIname); (* initialize DVImag, etc. *)
IF mag = 0 THEN (* no override given, so use DVImag *)
mag := DVImag;
END;
(* Having decided on what magnification value to use, we can now help
DVIReader calculate the number of pixels per DVI unit.
*)
SetConversionFactor(resolution,mag);
SpecialRoutine := MySpecialRoutine; (* called by InterpretPage *)
PixelTableRoutine := MyPixelTableRoutine; (* called by InterpretPage *)
StartText;
ClearScreen;
UpdateDVIStatusLine;
UpdateWindowStatusLine;
REPEAT
NextCommandLine;
UNTIL command = Quit;
Finish;
END TopLevel;
(******************************************************************************)
PROCEDURE Initialize;
BEGIN
(* TeX will not generate dimensions > than about 38 feet, so we
choose an absolute limit on our dimensions to be 40 feet.
Should we check for stupid resolution, mag, paperht, paperwd values???
*)
maxpix := 40 * 12 * resolution;
(* 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;
(* User sees the following status values before requesting the first page.
Note that DVIReader has already initialized currDVIpage and currTeXpage.
*)
ascending := TRUE; (* process DVI pages in ascending order *)
displaymode := tersemode;
windowtop := 0; (* window location *)
windowleft := 0;
scaledht := windowht; (* window size is initially unscaled *)
scaledwd := windowwd;
minhp := 0; minvp := 0; (* page location *)
maxhp := 0; maxvp := 0;
currentunits := inunits; (* units are initially inches *)
(* initialize the scaling routines *)
vscalefactor := 1.0;
hscalefactor := 1.0;
ScaleVpos := ShrinkVpos; (* use when vscalefactor <= 1.0 *)
ScaleHpos := ShrinkHpos; (* use when hscalefactor <= 1.0 *)
END Initialize;
(******************************************************************************)
PROCEDURE MyDVIErrorRoutine (DVIerror : DVIerrorcodes);
(* DVIErrorRoutine for DVIReader which has just detected one of the errors
described in DVIReader's definition module.
*)
PROCEDURE PleaseReport;
BEGIN
WriteString(' Please tell your local TeXnician.');
END PleaseReport;
BEGIN
CASE DVIerror OF
(* these errors are detected in OpenDVIFile; they are considered fatal *)
DVIunopened :
ResetVDU; (* do before message since it might erase screen! *)
WriteString("Couldn't open ");
WriteString(DVIname); Write('!'); WriteLn;
RestoreTerminal; HALT;
| DVIempty :
ResetVDU;
WriteString(DVIname);
WriteString(' is empty!'); WriteLn;
RestoreTerminal; HALT;
| DVIbadid :
ResetVDU;
WriteString(DVIname);
WriteString(' is not a valid DVI file!'); WriteLn;
RestoreTerminal; HALT;
| DVIstackoverflow :
ResetVDU;
WriteString('Stack capacity exceeded!'); PleaseReport; WriteLn;
RestoreTerminal; HALT;
(* this error is detected in InterpretPage; we warn user but continue *)
| DVIbadchar :
WITH currfont^ DO
ClearMessageLine;
WriteString('Ignoring unknown character from ');
WriteString(fontspec); Write('!');
WaitForReturn;
END;
(* this error should never happen *)
| DVIcatastrophe :
ResetVDU; WriteLn;
WriteString('Something awful has happened!'); PleaseReport; WriteLn;
RestoreTerminal; HALT;
ELSE
(* DEBUG
ResetVDU; WriteLn;
WriteString('Bug in MyDVIErrorRoutine!'); PleaseReport; WriteLn;
RestoreTerminal; HALT;
GUBED *)
END;
END MyDVIErrorRoutine;
(******************************************************************************)
PROCEDURE ClearMessageLine;
(* Clear message line and move cursor to start of line.
We don't show any message here; that will usually be done
immediately after calling this routine.
*)
BEGIN
ClearTextLine(messagel);
MoveToTextLine(messagel);
END ClearMessageLine;
(******************************************************************************)
PROCEDURE WaitForReturn;
(* DVItoVDU has just displayed an important message.
To ensure message is seen we wait for user to hit the RETURN key.
*)
VAR ch : CHAR;
BEGIN
WriteString(' RETURN:');
WriteBuffer;
REPEAT Read(ch) UNTIL ch = EOL;
END WaitForReturn;
(******************************************************************************)
PROCEDURE MySpecialRoutine (totalbytes : INTEGER;
NextDVIByte : GetByteFunction);
(* SpecialRoutine for DVIReader which has just seen a \special command while
interpreting a page. It passes the number of bytes in the command and a
function to return their values one at a time.
*)
VAR i, next : INTEGER;
BEGIN
ClearMessageLine;
(* SYSDEP: compiler treats \ in a string as special; need \\ to write \ *)
WriteString('Ignoring \\special command: ');
FOR i := 1 TO totalbytes DO
next := NextDVIByte(); (* get next byte *)
IF i <= 20 THEN (* display up to 1st 20 bytes *)
IF (next >= ORD(' ')) AND (next <= ORD('~')) THEN
Write(CHR(next));
ELSE
Write('^');
IF next < ORD(' ') THEN Write(CHR(next+64)) ELSE Write('?') END;
END;
END;
END;
IF totalbytes > 20 THEN WriteString('...') END;
WaitForReturn;
END MySpecialRoutine;
(******************************************************************************)
PROCEDURE MyPixelTableRoutine;
(* SYSDEP: 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 this is the first time we've seen the font then we build fontspec first.
Note that the Show command also requires fontspec to be built.)
If we can't open the PXL file, we return dummyfont values but using the
current font's scaledsize.
*)
VAR i : CARDINAL;
alpha, beta,
b0, b1, b2, b3 : INTEGER; (* 4 bytes in fix width *)
BEGIN
WITH currfont^ DO
IF fontspeclen = 0 THEN (* need to build fontspec *)
BuildFontSpec(currfont);
END;
ClearMessageLine;
IF OpenPXLFile(fontspec) THEN
WriteString('Loading font data from ');
WriteString(fontspec);
WriteLn;
ELSIF OpenPXLFile(dummyfont) THEN
(* we return a pixeltable with dummyfont values *)
WriteString("Couldn't open "); WriteString(fontspec);
WriteString("! Loading dummy font.");
WaitForReturn;
ClearMessageLine;
WriteBuffer; (* user RETURN clears message line immediately *)
ELSE
ResetVDU; WriteLn;
WriteString("Couldn't open dummy font "); WriteString(dummyfont);
Write('!'); WriteLn;
RestoreTerminal; HALT;
END;
(* move to first byte of font directory *)
MoveToPXLDirectory;
FOR i := 0 TO maxTeXchar DO
WITH pixelptr^[i] DO
wd := GetTwoPXLBytes();
ht := GetTwoPXLBytes();
xo := SignedPXLPair();
yo := SignedPXLPair();
mapadr := SignedPXLQuad(); (* word (not byte!) offset in PXL file *)
b0 := GetPXLByte(); (* should be 0 or 255 *)
b1 := GetPXLByte();
b2 := GetPXLByte();
b3 := GetPXLByte();
(* Convert the fix width into the corresponding dwidth and pwidth
values using the method recommended in DVITYPE.
WARNING: DVI translators that read RST files will have to use
a different method because the widths in such files are NOT
equivalent to those in a TFM file.
*)
alpha := 16 * scaledsize; beta := 16;
WHILE scaledsize >= 40000000B DO (* 2^23 *)
scaledsize := scaledsize DIV 2;
beta := beta DIV 2;
END;
dwidth := (((((b3 * INTEGER(scaledsize)) DIV 400B) +
(b2 * INTEGER(scaledsize))) DIV 400B) +
(b1 * INTEGER(scaledsize))) DIV beta;
IF b0 > 0 THEN
IF b0 = 255 THEN
dwidth := dwidth - alpha;
ELSE
(* DEBUG
ResetVDU;
WriteLn;
WriteString('Bad fix width! 1st byte='); WriteInt(b0);
WriteLn;
RestoreTerminal; HALT;
GUBED *)
END;
END;
pwidth := PixelRound(dwidth); (* convert DVI units to pixels *)
END;
END;
ClosePXLFile;
END;
END MyPixelTableRoutine;
(******************************************************************************)
PROCEDURE BuildFontSpec (fontptr : fontinfoptr);
(* SYSDEP: Build a complete PXL file specification for the given font.
This will only be done once per font; fontspeclen will no longer be 0.
The PXL file resides in fontarea if not empty,
otherwise within fontdir (set by InitSysInterface).
WARNING: This routine is also called by ShowStatistics.
*)
VAR pxlfile : File;
i, next, pxlsize, temp : CARDINAL;
BEGIN
WITH fontptr^ DO
IF fontarealen > 0 THEN (* use explicit directory *)
fontspec := fontarea;
(* SYSDEP: what if fontarea is an environment variable??? *)
next := fontarealen;
ELSE (* fontarealen = 0, so use fontdir *)
i := 0;
next := Length(fontdir);
REPEAT
fontspec[i] := fontdir[i];
INC(i);
UNTIL (i = next) OR (i > maxfontspec);
END;
IF next >= maxfontspec THEN
fontspeclen := maxfontspec; (* fontspec truncated *)
RETURN;
ELSE
fontspec[next] := '/';
INC(next);
END;
(* fontspec contains fontarea/ or fontdir/, and next is current length.
Append "fontname.nnnnpxl" to fontspec where nnnn are 4 digits
representing the pxlsize.
*)
i := 0;
WHILE (i < fontnamelen) AND (next < maxfontspec) DO
fontspec[next] := fontname[i]; (* append fontname *)
INC(i);
INC(next);
END;
IF next+7 < maxfontspec THEN (* append .nnnnpxl *)
fontspec[next] := '.';
fontspec[next+5] := 'p';
fontspec[next+6] := 'x';
fontspec[next+7] := 'l';
fontspeclen := next+8;
(* SYSDEP: terminate fontspec with NULL *)
IF fontspeclen < maxfontspec THEN fontspec[fontspeclen] := NULL END;
ELSE
fontspeclen := maxfontspec; (* fontspec truncated *)
RETURN;
END;
INC(next);
(* next now points to 1st n in "dir/fontname.nnnnpxl" *)
(* SYSDEP: Calculate pxlsize (nnnn) and insert into fontspec. If fontspec
does not exist, we try pxlsize+1 and pxlsize-1 before giving up.
This overcomes rounding problems that can occur with magnified fonts.
e.g., if TeX source contains
\magnification=\magstep1 % mag = 1200
\font\abc=cmr10 scaled\magstep4 % s/d = 2.074
and resolution = 240 then pxlsize = 2987, NOT 2986.
Is there a better method to avoid all the file open overheads???
*)
pxlsize := TRUNC( FLOAT(mag) * (FLOAT(scaledsize) / FLOAT(designsize))
* (FLOAT(resolution) / 200.0) + 0.5 );
IF pxlsize > 9999 THEN
pxlsize := 9998; (* allow for adding 1 *)
ELSIF pxlsize = 0 THEN
pxlsize := 1; (* allow for subtracting 1 *)
END;
i := 1;
temp := pxlsize;
LOOP
fontspec[next] := CHR(ORD('0') + (temp DIV 1000));
temp := temp MOD 1000;
fontspec[next+1] := CHR(ORD('0') + (temp DIV 100));
temp := temp MOD 100;
fontspec[next+2] := CHR(ORD('0') + (temp DIV 10));
temp := temp MOD 10;
fontspec[next+3] := CHR(ORD('0') + temp);
IF i > 3 THEN (* pxlsize has been restored *)
RETURN; (* could not open fontspec *)
END;
pxlfile := Open(fontspec,"r"); (* SYSDEP: try to open for reading *)
IF pxlfile <> NIL THEN
Close(pxlfile);
RETURN; (* fontspec exists *)
ELSIF i = 1 THEN
temp := pxlsize - 1; (* try pxlsize-1 *)
ELSIF i = 2 THEN
temp := pxlsize + 1; (* try pxlsize+1 *)
ELSE
temp := pxlsize; (* restore original pxlsize *)
END;
INC(i);
END;
END;
END BuildFontSpec;
(******************************************************************************)
PROCEDURE Length (s : ARRAY OF CHAR) : CARDINAL;
(* SYSDEP: Returns the number of characters in given string, where NULL
is assumed to terminate the string (if not full).
*)
VAR i : CARDINAL;
BEGIN
i := 0;
WHILE (i <= HIGH(s)) AND (s[i] <> NULL) DO
INC(i);
END;
RETURN i;
END Length;
(******************************************************************************)
PROCEDURE UpdateDVIStatusLine;
(* Show totalpages, currDVIpage, currTeXpage, direction and displaymode. *)
VAR i, lastnonzero : CARDINAL;
BEGIN
ClearTextLine(DVIstatusl);
MoveToTextLine(DVIstatusl);
WriteString('Total pages='); WriteCard(totalpages);
WriteString(' DVI page='); WriteCard(currDVIpage);
WriteString(' TeX page='); 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(']');
WriteString(' Next=');
IF ascending THEN
Write('>');
ELSE
Write('<');
END;
WriteString(' ');
CASE displaymode OF
tersemode : WriteString('Terse') |
boxmode : WriteString('Box') |
fullmode : WriteString('Full')
END;
WriteLn;
END UpdateDVIStatusLine;
(******************************************************************************)
PROCEDURE UpdateWindowStatusLine;
(* Show current window location and size, page location and size, and units. *)
BEGIN
ClearTextLine(windowstatusl);
MoveToTextLine(windowstatusl);
WriteString('Window at ('); WriteDimension(windowleft);
Write(','); WriteDimension(windowtop);
WriteString(') '); WriteDimension(scaledwd);
WriteString(' by '); WriteDimension(scaledht);
WriteString(' Page at ('); WriteDimension(minhp);
Write(','); WriteDimension(minvp);
WriteString(') '); WriteDimension(maxhp-minhp+1);
WriteString(' by '); WriteDimension(maxvp-minvp+1);
WriteString(' ');
CASE currentunits OF
inunits : WriteString('IN') |
cmunits : WriteString('CM') |
mmunits : WriteString('MM') |
pcunits : WriteString('PC') |
ptunits : WriteString('PT') |
pxunits : WriteString('PX')
END;
WriteLn;
END UpdateWindowStatusLine;
(******************************************************************************)
PROCEDURE WriteDimension (pixels : INTEGER);
(* Show the given pixel dimension in terms of currentunits. *)
VAR realdim : REAL; fracpart : CARDINAL;
BEGIN
CASE currentunits OF
inunits : realdim := FLOAT(pixels) / FLOAT(resolution) |
cmunits : realdim := FLOAT(pixels) / FLOAT(resolution) * 2.54 |
mmunits : realdim := FLOAT(pixels) / FLOAT(resolution) * 25.4 |
pcunits : realdim := FLOAT(pixels) / FLOAT(resolution) * 72.27 / 12.0 |
ptunits : realdim := FLOAT(pixels) / FLOAT(resolution) * 72.27 |
pxunits : WriteInt(pixels); 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); (* 0..9 *)
WriteCard(fracpart);
END;
END WriteDimension;
(******************************************************************************)
PROCEDURE NextCommandLine;
(* Prompt user for next command line, parse response and call the
appropriate command handler for each command in the line.
*)
VAR n : INTEGER; (* returned by GetInteger call *)
BEGIN
ClearTextLine(commandl);
MoveToTextLine(commandl);
WriteString(commprompt);
WriteBuffer;
ReadString(commstring); (* read new command line *)
ClearMessageLine; (* erase message line at this stage *)
commlen := Length(commstring);
commpos := 0;
WHILE (commlen > 0) AND (commstring[commlen-1] = ' ') DO
DEC(commlen); (* ignore any trailing spaces *)
END;
(* initialize flags for multiple command processing *)
badcommand := FALSE;
paintWindowStatus := FALSE;
paintDVIStatus := FALSE;
paintwindow := FALSE;
screenjustcleared := FALSE;
pageoffpaper := FALSE;
WHILE (commpos < commlen) AND (NOT badcommand) DO
(* next command is defined by the next non-space character in commstring *)
WHILE commstring[commpos] = ' ' DO
INC(commpos); (* ignore any spaces *)
END;
command := CAP(commstring[commpos]);
CASE command OF
Window : INC(commpos);
WindowMove;
IF (currDVIpage <> 0) AND (NOT badcommand)
THEN paintWindowStatus := TRUE END;
|
Up,
Down : INC(commpos);
WindowUpDown;
IF currDVIpage <> 0 THEN paintWindowStatus := TRUE END;
|
Left,
Right : INC(commpos);
WindowLeftRight;
IF currDVIpage <> 0 THEN paintWindowStatus := TRUE END;
|
Hsize : INC(commpos);
SetWindowWidth;
IF currDVIpage <> 0 THEN
NewLocation(windowleft,windowtop);
END;
paintWindowStatus := TRUE;
|
Vsize : INC(commpos);
SetWindowHeight;
IF currDVIpage <> 0 THEN
NewLocation(windowleft,windowtop);
END;
paintWindowStatus := TRUE;
|
Next : INC(commpos);
IF NextPageFound() THEN
ProcessPage;
END;
|
'0'..'9' : IF GetInteger(commstring,commlen,commpos,n)
(* must be true, and commpos now after last digit *)
AND DVIPageFound(n) THEN
ProcessPage;
END;
|
TeXpage : IF TeXPageFound() THEN
(* commpos incremented in ParseTeXpage *)
ProcessPage;
END;
|
Forwards : INC(commpos);
ascending := TRUE;
paintDVIStatus := TRUE;
|
Backwards : INC(commpos);
ascending := FALSE;
paintDVIStatus := TRUE;
|
Terse : INC(commpos);
displaymode := tersemode;
paintDVIStatus := TRUE;
IF currDVIpage <> 0 THEN paintwindow := TRUE END;
|
Box : INC(commpos);
displaymode := boxmode;
paintDVIStatus := TRUE;
IF currDVIpage <> 0 THEN paintwindow := TRUE END;
|
Full : INC(commpos);
displaymode := fullmode;
paintDVIStatus := TRUE;
IF currDVIpage <> 0 THEN paintwindow := TRUE END;
|
Inch, Cm, Mm,
PcPtPx : INC(commpos);
ChangeUnits;
IF NOT badcommand THEN paintWindowStatus := TRUE END;
|
Help : INC(commpos);
ShowHelp;
|
Show : INC(commpos);
ShowStatistics;
ClearScreen;
screenjustcleared := TRUE;
paintDVIStatus := TRUE;
paintWindowStatus := TRUE;
IF currDVIpage <> 0 THEN paintwindow := TRUE END;
|
Quit : RETURN;
ELSE
INC(commpos);
ClearMessageLine;
WriteString('Unknown command! Type ');
Write(Help); WriteString(' for help.');
BadCommandMessage;
END;
END;
IF paintwindow THEN
DisplayPage; (* only update window after processing all commands *)
ELSE
IF paintDVIStatus THEN UpdateDVIStatusLine END;
IF paintWindowStatus THEN UpdateWindowStatusLine END;
END;
END NextCommandLine;
(******************************************************************************)
PROCEDURE WindowMove;
(* Syntax of Window command is W hpos,vpos where hpos and vpos are
dimensions with leading and/or trailing spaces. If hpos,vpos absent then
we move to minhp,minvp (top left corner of page rectangle).
*)
VAR hpos, vpos : INTEGER; (* move window to this new position *)
BEGIN
(* commpos is positioned after W *)
IF GetDimension(commstring,commlen,commpos,hpos) THEN
WHILE (commpos < commlen) AND (commstring[commpos] = ' ') DO
INC(commpos); (* skip any spaces before comma *)
END;
IF (commpos = commlen) OR (* , vpos is missing *)
(commstring[commpos] <> ',') THEN (* , is missing *)
ClearMessageLine;
WriteString('Comma expected!');
IF commpos < commlen THEN INC(commpos) END;
BadCommandMessage;
ELSE
INC(commpos); (* skip over comma *)
IF GetDimension(commstring,commlen,commpos,vpos) THEN
NewLocation(hpos,vpos);
ELSE
ClearMessageLine;
WriteString('Vertical coordinate expected!');
IF commpos < commlen THEN INC(commpos) END;
BadCommandMessage;
END;
END;
ELSE
NewLocation(minhp,minvp); (* hpos,vpos absent *)
END;
END WindowMove;
(******************************************************************************)
PROCEDURE GetDimension (str : ARRAY OF CHAR; (* in *)
strlen : CARDINAL; (* in *)
VAR pos : CARDINAL; (* in/out *)
VAR n : INTEGER (* out *)
) : BOOLEAN;
(* Extract a dimension from given str starting at given pos.
n returns the corresponding number of pixels in the dimension
(which is an integer or real value in terms of currentunits);
pos is also used to return the position after the dimension.
If no dimension is found then set n to 0 and return FALSE (pos will only
change if leading spaces were skipped).
If ABS(n) > maxpix then set n to sign * maxpix.
Valid syntax of a dimension is integer[.{digit}] or .{digit} where
an integer is defined by GetInteger.
Real dimensions are truncated to 4 decimal places.
Note that a sign or decimal point by itself is valid and sets n to 0.
*)
VAR sign, intdim : INTEGER;
fracpart, divisor : CARDINAL;
absrealdim : REAL;
intpresent, dimtoobig : BOOLEAN;
BEGIN
(* GetInteger does not remember a sign by itself, so we need to check
for -ve dimensions like -.5 first.
*)
WHILE (pos < strlen) AND (str[pos] = ' ') DO (* skip any spaces *)
INC(pos);
END;
sign := 1;
IF (pos < strlen) AND (str[pos] = '-') THEN
sign := -1;
END;
intpresent := GetInteger(str,strlen,pos,intdim);
IF (NOT intpresent) AND ((pos = strlen) OR (str[pos] <> '.')) THEN
n := 0;
RETURN FALSE;
END;
(* dimension is valid; if no integer part then intdim will be 0; sign = +|-1 *)
IF (pos = strlen) OR (str[pos] <> '.') THEN
(* no fractional part *)
absrealdim := FLOAT(ABS(intdim));
ELSE
(* extract fractional part *)
INC(pos); (* skip over decimal point *)
divisor := 1;
fracpart := 0;
WHILE (pos < strlen) AND (str[pos] >= '0') AND (str[pos] <= '9') DO
(* only consider up to 4 decimal places *)
IF divisor < 10000 THEN
divisor := divisor * 10;
fracpart := fracpart * 10 + (ORD(str[pos]) - ORD('0'));
END;
INC(pos);
END;
absrealdim := FLOAT(ABS(intdim)) + (FLOAT(fracpart) / FLOAT (divisor));
END;
(* calculate n based on absrealdim, sign and currentunits *)
dimtoobig := FALSE;
CASE currentunits OF
inunits :
IF absrealdim > FLOAT(maxpix) / FLOAT(resolution) THEN
dimtoobig := TRUE;
ELSE
n := sign * TRUNC(absrealdim * FLOAT(resolution) + 0.5);
END; |
cmunits :
IF absrealdim > (FLOAT(maxpix) / FLOAT(resolution)) * 2.54 THEN
dimtoobig := TRUE;
ELSE
n := sign * TRUNC((absrealdim / 2.54) * FLOAT(resolution) + 0.5);
END; |
mmunits :
IF absrealdim > (FLOAT(maxpix) / FLOAT(resolution)) * 25.4 THEN
dimtoobig := TRUE;
ELSE
n := sign * TRUNC((absrealdim / 25.4) * FLOAT(resolution) + 0.5);
END; |
pcunits :
IF absrealdim > (FLOAT(maxpix) / FLOAT(resolution)) * (72.27 / 12.0) THEN
dimtoobig := TRUE;
ELSE
n := sign * TRUNC((absrealdim / 72.27) * 12.0 * FLOAT(resolution) +
0.5);
END; |
ptunits :
IF absrealdim > (FLOAT(maxpix) / FLOAT(resolution)) * 72.27 THEN
dimtoobig := TRUE;
ELSE
n := sign * TRUNC((absrealdim / 72.27) * FLOAT(resolution) + 0.5);
END; |
pxunits :
IF absrealdim > FLOAT(maxpix) THEN
dimtoobig := TRUE;
ELSE
n := sign * TRUNC(absrealdim + 0.5);
END;
END;
IF dimtoobig THEN n := sign * maxpix END;
RETURN TRUE;
END GetDimension;
(******************************************************************************)
PROCEDURE GetInteger (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; (* SYSDEP: TeX's limit = 2^31 - 1.
Should also be >= maxpix.
Note that this also defines the range of
page numbers the user can ask for! *)
threshhold = 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 > threshhold) OR ((absval = threshhold) 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 BadCommandMessage;
(* A bad command has just been detected and some sort of message displayed.
Note that commpos is pointing to just after the problem character.
If there are further commands then we show user what will be ignored.
*)
VAR i : CARDINAL;
BEGIN
badcommand := TRUE;
ClearTextLine(commandl);
MoveToTextLine(commandl);
WriteString(commprompt);
FOR i := 0 TO commpos-1 DO Write(commstring[i]) END;
Write('!'); (* put ! after the problem character *)
IF commpos < commlen THEN
WriteString(' Ignoring:');
FOR i := commpos TO commlen-1 DO Write(commstring[i]) END;
END;
WaitForReturn;
ClearMessageLine;
ClearTextLine(commandl);
END BadCommandMessage;
(******************************************************************************)
PROCEDURE NewLocation (newhp, newvp : INTEGER);
(* Change window location to given position and update window edges.
If pageempty is TRUE then window moves to (paperleft,papertop).
If the entire window moves outside the page rectangle then outsidepage
becomes TRUE and we restrict movement to just beyond the edge(s) so that
user can easily move window (via Up,Down,Left,Right) to positions
in which one or more window and page edges coincide.
Note that allpagevisible is also updated.
*)
BEGIN
IF currDVIpage = 0 THEN (* message only seen after W,U,D,L,R commands *)
ClearMessageLine;
WriteString("You haven't selected a page yet!");
BadCommandMessage;
RETURN;
END;
IF pageempty THEN
newvp := papertop;
newhp := paperleft;
ELSE
(* check if new position puts window entirely outside edges;
if so then minimize the movement needed to keep this true *)
outsidepage := FALSE;
IF newvp > maxvp THEN
outsidepage := TRUE;
newvp := maxvp + 1;
ELSIF newvp < (minvp - scaledht + 1) THEN
outsidepage := TRUE;
newvp := minvp - scaledht;
END;
IF newhp > maxhp THEN
outsidepage := TRUE;
newhp := maxhp + 1;
ELSIF newhp < (minhp - scaledwd + 1) THEN
outsidepage := TRUE;
newhp := minhp - scaledwd;
END;
END;
windowtop := newvp;
windowleft := newhp;
windowbottom := windowtop + scaledht - 1;
windowright := windowleft + scaledwd - 1;
(* allpagevisible will only be sensible if not pageempty *)
allpagevisible := (minvp >= windowtop) AND (maxvp <= windowbottom) AND
(minhp >= windowleft) AND (maxhp <= windowright);
(* even if pageempty or window hasn't moved we must still call DisplayPage *)
paintwindow := TRUE;
END NewLocation;
(******************************************************************************)
PROCEDURE WindowUpDown;
VAR amount : INTEGER; (* move window up/down this many pixels *)
BEGIN
(* commpos is positioned after U or D *)
IF GetDimension(commstring,commlen,commpos,amount) THEN
(* do nothing *)
ELSE
amount := scaledht; (* if amount absent, set to window height *)
END;
IF command = Up THEN
amount := -amount;
END;
NewLocation(windowleft,windowtop+amount);
END WindowUpDown;
(******************************************************************************)
PROCEDURE WindowLeftRight;
VAR amount : INTEGER; (* move window left/right this many pixels *)
BEGIN
(* commpos is positioned after L or R *)
IF GetDimension(commstring,commlen,commpos,amount) THEN
(* do nothing *)
ELSE
amount := scaledwd; (* if amount absent, set to window width *)
END;
IF command = Left THEN
amount := -amount;
END;
NewLocation(windowleft+amount,windowtop);
END WindowLeftRight;
(******************************************************************************)
PROCEDURE SetWindowWidth;
(* Set horizontal size of window region to given dimension; if <= 0 then set
horizontal size to 1 pixel.
If no parameter then use the unscaled width represented by windowwd.
*)
VAR wd : INTEGER;
BEGIN
(* commpos is positioned after H *)
IF GetDimension(commstring,commlen,commpos,wd) THEN
(* note that maximum value of wd is restricted to maxpix *)
IF wd <= 0 THEN wd := 1 END;
NewWindowWidth(wd);
ELSE
NewWindowWidth(windowwd); (* parameter absent *)
END;
END SetWindowWidth;
(******************************************************************************)
PROCEDURE NewWindowWidth (wd : INTEGER);
(* Set window width to given value (> 0 and <= max dimension). *)
BEGIN
scaledwd := wd;
hscalefactor := FLOAT(windowwd) / FLOAT(scaledwd);
(* following method avoids testing hscalefactor each time in ScaleHpos *)
IF hscalefactor > 1.0 THEN
ScaleHpos := ExpandHpos;
ELSE
ScaleHpos := ShrinkHpos;
END;
END NewWindowWidth;
(******************************************************************************)
PROCEDURE ExpandHpos (h : INTEGER) : INTEGER;
(* Return a scaled value for the given horizontal window coordinate. *)
BEGIN
RETURN TRUNC ( FLOAT(h) * hscalefactor + 0.5 ); (* hscalefactor > 1.0 *)
END ExpandHpos;
(******************************************************************************)
PROCEDURE ShrinkHpos (h : INTEGER) : INTEGER;
(* Return a scaled value for the given horizontal window coordinate. *)
BEGIN
RETURN TRUNC ( (FLOAT(h) + 0.5) * hscalefactor ); (* hscalefactor <= 1.0 *)
END ShrinkHpos;
(******************************************************************************)
PROCEDURE SetWindowHeight;
(* Set vertical size of window region to given dimension; if <= 0 then set
vertical size to 1 pixel.
If no parameter then use the unscaled height represented by windowht.
*)
VAR ht : INTEGER;
BEGIN
(* commpos is positioned after V *)
IF GetDimension(commstring,commlen,commpos,ht) THEN
(* note that maximum value of ht is restricted to maxpix *)
IF ht <= 0 THEN ht := 1 END;
NewWindowHeight(ht);
ELSE
NewWindowHeight(windowht); (* parameter absent *)
END;
END SetWindowHeight;
(******************************************************************************)
PROCEDURE NewWindowHeight (ht : INTEGER);
(* Set window height to given value (> 0 and <= max dimension). *)
BEGIN
scaledht := ht;
vscalefactor := FLOAT(windowht) / FLOAT(scaledht);
(* following method avoids testing vscalefactor each time in ScaleVpos *)
IF vscalefactor > 1.0 THEN
ScaleVpos := ExpandVpos;
ELSE
ScaleVpos := ShrinkVpos;
END;
END NewWindowHeight;
(******************************************************************************)
PROCEDURE ExpandVpos (v : INTEGER) : INTEGER;
(* Return a scaled value for the given vertical window coordinate. *)
BEGIN
RETURN TRUNC ( FLOAT(v) * vscalefactor + 0.5 ); (* vscalefactor > 1.0 *)
END ExpandVpos;
(******************************************************************************)
PROCEDURE ShrinkVpos (v : INTEGER) : INTEGER;
(* Return a scaled value for the given vertical window coordinate. *)
BEGIN
RETURN TRUNC ( (FLOAT(v) + 0.5) * vscalefactor ); (* vscalefactor <= 1.0 *)
END ShrinkVpos;
(******************************************************************************)
PROCEDURE NextPageFound () : BOOLEAN;
(* User has selected next page in DVI file; what they get will depend on
the current DVI page and whether we are ascending or not.
Return TRUE iff we can move to next page.
*)
BEGIN
IF (currDVIpage = 1) AND (NOT ascending) THEN
ClearMessageLine;
WriteString('You are looking at first DVI page!');
BadCommandMessage;
RETURN FALSE;
ELSIF (currDVIpage = totalpages) AND ascending THEN
ClearMessageLine;
WriteString('You are looking at last DVI page!');
BadCommandMessage;
RETURN FALSE;
ELSE
MoveToNextPage(ascending); (* position to next DVI page *)
RETURN TRUE;
END;
END NextPageFound;
(******************************************************************************)
PROCEDURE DVIPageFound (n : CARDINAL) : BOOLEAN;
(* User has selected a particular DVI page number.
Move to page n and return TRUE iff n is in 1..totalpages.
*)
BEGIN
IF (n < 1) OR (n > totalpages) THEN
ClearMessageLine;
IF totalpages > 1 THEN
WriteString('You can only request DVI pages 1 to ');
WriteCard(totalpages); Write('!');
ELSE
WriteString('You can only request DVI page 1!');
END;
BadCommandMessage;
RETURN FALSE;
ELSE
MoveToDVIPage(n); (* position to given DVI page *)
RETURN TRUE;
END;
END DVIPageFound;
(******************************************************************************)
PROCEDURE TeXPageFound () : BOOLEAN;
(* Return TRUE iff TeX page specification is valid and exists.
If so then position to lowest matching page.
*)
VAR newTeXpage : TeXpageinfo;
BEGIN
IF ParseTeXpage(newTeXpage) THEN
IF MoveToTeXPage(newTeXpage) THEN
RETURN TRUE; (* we found lowest matching page *)
ELSE
ClearMessageLine;
WriteString('No TeX page matches your request!');
BadCommandMessage;
RETURN FALSE;
END;
ELSE
RETURN FALSE; (* invalid TeX page specification *)
END;
END TeXPageFound;
(******************************************************************************)
PROCEDURE ParseTeXpage (VAR newTeXpage : TeXpageinfo) (* out *)
: BOOLEAN;
(* Return TRUE iff TeX page specification in commstring is valid. If so then
newTeXpage will contain the appropriate information for MoveToTeXPage.
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.
commpos is initially pointing at [.
*)
BEGIN
WITH newTeXpage DO
lastvalue := 0;
LOOP
INC(commpos);
present[lastvalue] := GetInteger(commstring, commlen, commpos,
value[lastvalue]);
(* commpos now at commlen, space, period, non-digit or ']' *)
WHILE (commpos < commlen) AND (commstring[commpos] = ' ') DO
INC(commpos); (* skip any spaces *)
END;
IF commpos = commlen THEN (* check this first! *)
ClearMessageLine;
WriteString('] expected!');
BadCommandMessage; (* commpos at commlen *)
RETURN FALSE;
END;
IF commstring[commpos] = ']' THEN (* end of TeX page specification *)
INC(commpos); (* possibly further commands *)
EXIT;
END;
IF lastvalue < 9 THEN
INC(lastvalue);
ELSE
ClearMessageLine;
WriteString("] expected after 10 integers!");
INC(commpos);
BadCommandMessage;
RETURN FALSE;
END;
IF commstring[commpos] <> '.' THEN
ClearMessageLine;
WriteString('Period, integer or ] expected!');
INC(commpos);
BadCommandMessage;
RETURN FALSE;
END;
END;
WHILE (lastvalue > 0) AND (NOT present[lastvalue]) DO
DEC(lastvalue);
END;
END;
RETURN TRUE;
END ParseTeXpage;
(******************************************************************************)
PROCEDURE ProcessPage;
(* We are ready to interpret the current DVI page and fill in the various data
structures imported from DVIReader.
This routine will also:
set the window size and location to useful values (depending on the relative
sizes of the paper and unscaled window region, as well as the page location),
update pageoffpaper (after checking to see if it was TRUE for the previous
page processed as part of a multiple command string),
set screenjustcleared, paintwindow and paintWindowStatus to TRUE,
set paintDVIStatus to FALSE.
*)
VAR halfht, halfwd : INTEGER;
BEGIN
(* We check pageoffpaper here so user can type "NNNNNNNNNNNNN..." and note ALL
the pages that are off the paper, not just the last one processed.
*)
IF pageoffpaper THEN
ClearMessageLine;
WriteString('Page off paper!'); (* the previous page *)
WaitForReturn;
END;
ClearScreen;
screenjustcleared := TRUE;
UpdateDVIStatusLine; (* a MoveTo... routine has updated currDVI/TeXpage *)
paintDVIStatus := FALSE;
InterpretPage; (* fill in DVIReader's page data structures *)
SortFonts(unusedfont); (* sort fonts in order of least chars and return
pointer to first unused font *)
ClearMessageLine; (* clear any message *)
IF pageempty THEN
minhp := 0; maxhp := 0; minvp := 0; maxvp := 0; (* for window status *)
END;
(* Try viewing as much of paper as possible and without too much distortion: *)
IF ((paperwd < paperht) AND (windowwd >= windowht)) OR
((paperwd = paperht) AND (windowwd > windowht)) THEN
halfht := paperht DIV 2;
IF ODD(paperht) THEN INC(halfht) END; (* ensure bottom outline visible *)
NewWindowHeight(halfht); (* try top half of paper *)
NewWindowWidth(paperwd);
NewLocation(paperleft,papertop); (* top left corner of paper *)
IF (NOT pageempty) AND outsidepage THEN
NewLocation(paperleft,papertop+halfht); (* try moving down *)
END;
ELSIF ((paperwd > paperht) AND (windowwd <= windowht)) OR
((paperwd = paperht) AND (windowwd < windowht)) THEN
halfwd := paperwd DIV 2;
IF ODD(paperwd) THEN INC(halfwd) END; (* ensure right outline visible *)
NewWindowHeight(paperht);
NewWindowWidth(halfwd); (* try left half of paper *)
NewLocation(paperleft,papertop); (* top left corner of paper *)
IF (NOT pageempty) AND outsidepage THEN
NewLocation(paperleft+halfwd,papertop); (* try moving right *)
END;
ELSE
(* paper shape matches unscaled window shape *)
NewWindowHeight(paperht); (* try all of paper *)
NewWindowWidth(paperwd);
NewLocation(paperleft,papertop); (* top left corner of paper *)
END;
(* If part/all of page is off paper then we set window size and location so
user can just see ALL of paper AND ALL of page.
*)
IF (NOT pageempty) AND
((minhp < paperleft) OR (minvp < papertop) OR
(maxhp > paperright) OR (maxvp > paperbottom)) THEN
NewWindowHeight(Max(maxvp,paperbottom) - Min(minvp,papertop) + 1);
NewWindowWidth (Max(maxhp,paperright) - Min(minhp,paperleft) + 1);
NewLocation (Min(minhp,paperleft),Min(minvp,papertop));
pageoffpaper := TRUE;
ELSE
pageoffpaper := FALSE; (* page is empty or fits on paper *)
END;
paintWindowStatus := TRUE;
paintwindow := TRUE;
END ProcessPage;
(******************************************************************************)
PROCEDURE Min (a,b : INTEGER) : INTEGER;
(* Return the minimum value of a and b. *)
BEGIN
IF a < b THEN RETURN a ELSE RETURN b END;
END Min;
(******************************************************************************)
PROCEDURE Max (a,b : INTEGER) : INTEGER;
(* Return the maximum value of a and b. *)
BEGIN
IF a > b THEN RETURN a ELSE RETURN b END;
END Max;
(******************************************************************************)
PROCEDURE ChangeUnits;
(* Parse the rest of an Inch, Cm, Mm or PcPtPx command.
commpos is pointing to next position in commandstr.
*)
VAR nextch : CHAR;
BEGIN
IF commpos < commlen THEN
nextch := CAP(commstring[commpos]);
INC(commpos);
ELSE
nextch := ' ';
END;
IF (command = Inch) AND (nextch = 'N') THEN currentunits := inunits;
ELSIF (command = Cm) AND (nextch = 'M') THEN currentunits := cmunits;
ELSIF (command = Mm) AND (nextch = 'M') THEN currentunits := mmunits;
ELSIF (command = PcPtPx) AND (nextch = 'C') THEN currentunits := pcunits;
ELSIF (command = PcPtPx) AND (nextch = 'T') THEN currentunits := ptunits;
ELSIF (command = PcPtPx) AND (nextch = 'X') THEN currentunits := pxunits;
ELSE
ClearMessageLine;
WriteString('Unknown units! ');
CASE command OF
Inch : WriteString('IN') |
Cm : WriteString('CM') |
Mm : WriteString('MM') |
PcPtPx : WriteString('PC, PT or PX')
END;
WriteString(' expected.');
BadCommandMessage;
END;
END ChangeUnits;
(******************************************************************************)
PROCEDURE ShowHelp;
(* Help information is displayed in lines 1 to bottoml-2.
We assume that bottoml is at least 3 and that VDU screen is at least
maxline characters wide.
*)
CONST maxline = 80; (* SYSDEP: helpname should have <= maxline chars/line *)
VAR helpfile : File;
outline : ARRAY [0..maxline-1] OF CHAR;
i : CARDINAL;
lines : INTEGER;
ch, answer : CHAR;
BEGIN
helpfile := Open(helpname,"r"); (* SYSDEP: read only *)
IF helpfile = NIL THEN
ClearMessageLine;
WriteString("Couldn't open help file ");
WriteString(helpname); Write('!');
WaitForReturn;
ClearMessageLine;
ELSE
ClearScreen;
MoveToTextLine(1);
lines := 0;
LOOP
IF Readc(helpfile,ch) < 0 THEN (* SYSDEP: end of file *)
ClearTextLine(bottoml);
MoveToTextLine(bottoml);
WriteString('Hit RETURN key to resume page display:');
WriteBuffer;
REPEAT Read(answer) UNTIL answer = EOL;
EXIT;
ELSIF lines >= (bottoml-2) THEN (* blank line before prompt *)
ClearTextLine(bottoml);
MoveToTextLine(bottoml);
WriteString('Hit RETURN key to resume page display,');
WriteString(' or any other key for more help:');
WriteBuffer;
Read(answer);
IF answer = EOL THEN EXIT END;
ClearScreen;
MoveToTextLine(1);
lines := 0; (* reset line count *)
END;
outline := '';
i := 0;
WHILE ch <> EOL DO
IF i < maxline THEN outline[i] := ch END;
IF Readc(helpfile,ch) < 0 THEN
ch := EOL;
(* SYSDEP: this should only happen if EOF occurs before EOL *)
END;
INC(i);
END;
WriteString(outline); WriteLn;
INC(lines);
END;
Close(helpfile);
ClearScreen;
screenjustcleared := TRUE;
paintDVIStatus := TRUE;
paintWindowStatus := TRUE;
IF currDVIpage <> 0 THEN paintwindow := TRUE END;
END;
END ShowHelp;
(******************************************************************************)
PROCEDURE ShowStatistics;
(* Show command options and rule/font/character statistics.
Note that UserHitsReturn controls pagination and takes the place of WriteLn.
*)
VAR linecount, fontcount : INTEGER;
ch : CHAR;
BEGIN
ClearScreen;
MoveToTextLine(1);
linecount := 1;
WriteString('DVI file = '); WriteString(DVIname);
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('VDU = '); WriteString(vdu);
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Resolution = '); WriteCard(resolution);
WriteString(' pixels per inch');
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Magnification = '); WriteCard(mag);
IF mag <> DVImag THEN
WriteString(' (DVI mag of '); WriteCard(DVImag);
WriteString(' was overridden)');
ELSE
WriteString(' (DVI mag)');
END;
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Font directories = '); WriteString(fontdir);
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Dummy font = '); WriteString(dummyfont);
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Help file = '); WriteString(helpname);
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Paper wd by ht = ');
WriteDimension(paperwd); WriteString(' by '); WriteDimension(paperht);
CASE currentunits OF
inunits : WriteString(' IN') |
cmunits : WriteString(' CM') |
mmunits : WriteString(' MM') |
pcunits : WriteString(' PC') |
ptunits : WriteString(' PT') |
pxunits : WriteString(' PX')
END;
IF UserHitsReturn(linecount) THEN RETURN END;
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Total rules on current page = ');
WriteCard(totalrules);
IF UserHitsReturn(linecount) THEN RETURN END;
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Total fonts on ALL pages = ');
WriteCard(totalfonts);
IF UserHitsReturn(linecount) THEN RETURN END;
IF UserHitsReturn(linecount) THEN RETURN END;
WriteString('Fonts: (if used on current page then total chars given)');
IF UserHitsReturn(linecount) THEN RETURN END;
fontcount := 0;
thisfontinfo := fontlist;
WHILE thisfontinfo <> NIL DO
WITH thisfontinfo^ DO
IF fontspeclen = 0 THEN (* need to build fontspec *)
BuildFontSpec(thisfontinfo);
END;
WriteString(fontspec);
IF OpenPXLFile(fontspec) THEN
ClosePXLFile;
ELSE
WriteString(' does not exist!'); (* will use dummyfont *)
END;
IF fontused THEN
INC(fontcount);
WriteString(' (total chars = ');
WriteCard(totalchars); Write(')');
END;
IF UserHitsReturn(linecount) THEN RETURN END;
thisfontinfo := nextfont;
END;
END;
IF currDVIpage = 0 THEN
WriteString("You haven't selected a page yet.");
ELSE
WriteString('Total fonts on current page = ');
WriteInt(fontcount);
END;
IF UserHitsReturn(linecount) THEN RETURN END;
WriteLn;
MoveToTextLine(bottoml);
WriteString('Hit RETURN key to resume page display:');
WriteBuffer;
REPEAT Read(ch) UNTIL ch = EOL;
END ShowStatistics;
(******************************************************************************)
PROCEDURE UserHitsReturn (VAR linecount : INTEGER) : BOOLEAN;
(* Do a WriteLn and return TRUE iff linecount = bottoml-2 AND user hits EOL.
If linecount < bottoml-2 then return FALSE; if not, and user hits
something other than EOL, then prepare a new screen before returning FALSE.
*)
VAR ch : CHAR;
BEGIN
WriteLn;
IF linecount = bottoml-2 THEN (* prompt for next screen *)
MoveToTextLine(bottoml);
WriteString('Hit RETURN key to resume page display,');
WriteString(' or any other key for more:');
WriteBuffer;
Read(ch);
IF ch = EOL THEN RETURN TRUE END;
ClearScreen;
MoveToTextLine(1);
linecount := 1;
ELSE
INC(linecount);
END;
RETURN FALSE;
END UserHitsReturn;
(******************************************************************************)
PROCEDURE DisplayPage;
(* Display page in window region based on window location and size,
and displaymode. This routine is only called if paintwindow is TRUE
after all commands have been processed.
*)
VAR vispage : REAL; (* fraction of page rectangle currently visible *)
left, right, (* visible edges of page rectangle *)
top, bottom : INTEGER;
BEGIN
IF screenjustcleared THEN (* avoid doing it again *)
IF paintDVIStatus THEN UpdateDVIStatusLine END;
IF paintWindowStatus THEN UpdateWindowStatusLine END;
ELSE
ClearScreen; (* would prefer ClearWindow but some VDUs have trouble *)
UpdateDVIStatusLine;
UpdateWindowStatusLine;
END;
StartGraphics;
DisplayPaperEdges;
StartText;
IF pageempty THEN
ClearMessageLine;
WriteString('Page is empty.');
ELSIF outsidepage THEN
IF pageoffpaper THEN CheckPageEdges END;
ClearMessageLine;
WriteString('Window is ');
IF windowtop > maxvp THEN
WriteString('below ');
IF (windowleft > maxhp) OR (windowleft < minhp - scaledwd + 1) THEN
WriteString('and ');
END;
ELSIF windowtop < minvp - scaledht + 1 THEN
WriteString('above ');
IF (windowleft > maxhp) OR (windowleft < minhp - scaledwd + 1) THEN
WriteString('and ');
END;
END;
IF windowleft > maxhp THEN
WriteString('to the right of ');
ELSIF windowleft < minhp - scaledwd + 1 THEN
WriteString('to the left of ');
END;
WriteString('page.');
ELSE
(* Page is not empty and part or all of it is visible. *)
StartGraphics;
useraborted := FALSE;
DisplayRules;
IF NOT useraborted THEN
DisplayChars;
END;
StartText;
IF pageoffpaper THEN CheckPageEdges END;
IF allpagevisible THEN
ClearMessageLine;
WriteString('Entire page is visible.');
END;
END;
END DisplayPage;
(******************************************************************************)
PROCEDURE DisplayPaperEdges;
(* Display visible outlines of the imaginary sheet of paper.
Thickness of outlines = 1 screen pixel no matter what the h and v scaling.
*)
CONST
edgepixel = '.'; (* black pixel for outlines on non-graphic VDUs;
note that VDUInterface sets
TeXtoASCII['.'] := '.' *)
VAR
top, bot, left, right, (* visible edges of paper in paper pixels *)
scaledtop, scaledleft, (* scaled visible edges in screen pixels *)
scaledbot, scaledright,
scaledheight, scaledwidth (* scaled width and height *)
: INTEGER;
BEGIN
(* first check if any part of paper is visible *)
IF papertop > windowbottom THEN RETURN END;
IF paperbottom < windowtop THEN RETURN END;
IF paperleft > windowright THEN RETURN END;
IF paperright < windowleft THEN RETURN END;
(* part or all of paper is visible, so return visible region *)
top := Max(papertop,windowtop);
bot := Min(paperbottom,windowbottom);
left := Max(paperleft,windowleft);
right := Min(paperright,windowright);
scaledtop := ScaleVpos(top - windowtop) + windowv;
scaledleft := ScaleHpos(left - windowleft) + windowh;
IF vscalefactor > 1.0 THEN
scaledbot := ScaleVpos(bot + 1 - windowtop) - 1 + windowv;
ELSE
scaledbot := ScaleVpos(bot - windowtop) + windowv;
END;
IF hscalefactor > 1.0 THEN
scaledright := ScaleHpos(right + 1 - windowleft) - 1 + windowh;
ELSE
scaledright := ScaleHpos(right - windowleft) + windowh;
END;
scaledheight := scaledbot - scaledtop + 1;
scaledwidth := scaledright - scaledleft + 1;
(* Only show visible edges if they are also paper outlines! *)
IF left = paperleft THEN (* left outline visible *)
ShowRectangle(scaledleft, scaledtop, 1, scaledheight, edgepixel);
END;
IF bot = paperbottom THEN (* bottom outline visible *)
ShowRectangle(scaledleft, scaledbot, scaledwidth, 1, edgepixel);
END;
IF top = papertop THEN (* top outline visible *)
ShowRectangle(scaledleft, scaledtop, scaledwidth, 1, edgepixel);
END;
IF right = paperright THEN (* right outline visible *)
ShowRectangle(scaledright, scaledtop, 1, scaledheight, edgepixel);
END;
END DisplayPaperEdges;
(******************************************************************************)
PROCEDURE DisplayRules;
(* Display all pixels in rules, regardless of current displaymode.
Rules will be displayed in the same order as in the DVI page (essentially
top-down and left-right) because of the way DVIReader builds a rulelist.
*)
CONST
rulepixel = '*'; (* black pixel for rules on non-graphic VDUs;
note that VDUInterface sets
TeXtoASCII['*'] := '*' *)
VAR
top, bottom, left, right, (* visible edges of rule *)
scaledtop, scaledleft, (* scaled visible edges *)
scaledbot, scaledright,
scaledwidth, scaledheight (* scaled width and height *)
: INTEGER;
thisrule : CARDINAL;
keyhit : CHAR; (* returned by BusyRead if TRUE *)
BEGIN
thisruleinfo := rulelist;
WHILE thisruleinfo <> NIL DO
WITH thisruleinfo^ DO
thisrule := 0;
WHILE thisrule < rulecount DO
WITH ruletable[thisrule] DO
(* check if any part of rule is visible *)
(* vp,hp is bottom left corner of rule on page *)
IF RectangleVisible
(vp-ht+1,vp,hp,hp+wd-1, (* rule edges *)
top,bottom,left,right) (* visible rectangle *)
THEN
(* show all pixels in this rectangle *)
scaledtop := ScaleVpos(top - windowtop) + windowv;
scaledleft := ScaleHpos(left - windowleft) + windowh;
IF vscalefactor > 1.0 THEN
scaledbot := ScaleVpos(bottom+1-windowtop) - 1 + windowv;
ELSE
scaledbot := ScaleVpos(bottom-windowtop) + windowv;
END;
IF hscalefactor > 1.0 THEN
scaledright := ScaleHpos(right+1-windowleft) - 1 + windowh;
ELSE
scaledright := ScaleHpos(right-windowleft) + windowh;
END;
scaledheight := scaledbot - scaledtop + 1;
scaledwidth := scaledright - scaledleft + 1;
ShowRectangle
(scaledleft, (* h coord of top left cnr *)
scaledtop, (* v coord of top left cnr *)
scaledwidth,
scaledheight,
rulepixel);
(* SYSDEP: we check keyboard after every visible rule *)
IF BusyRead(keyhit) THEN
keyhit := CAP(keyhit);
IF (keyhit = Terse) AND (displaymode <> tersemode) THEN
displaymode := tersemode;
StartText;
UpdateDVIStatusLine;
StartGraphics;
ELSIF (keyhit = Box) AND (displaymode <> boxmode) THEN
displaymode := boxmode;
StartText;
UpdateDVIStatusLine;
StartGraphics;
ELSIF (keyhit = Full) AND (displaymode <> fullmode) THEN
displaymode := fullmode;
StartText;
UpdateDVIStatusLine;
StartGraphics;
ELSIF keyhit = abortkey THEN
useraborted := TRUE; (* checked in DisplayPage *)
RETURN;
END;
END;
END;
END;
INC(thisrule);
END;
thisruleinfo := nextrule;
END;
END;
END DisplayRules;
(******************************************************************************)
PROCEDURE RectangleVisible (intop, inbot, inleft, inright : INTEGER;
VAR outtop, outbot, outleft, outright : INTEGER
) : BOOLEAN;
(* Return TRUE iff part or all of given rectangle would be visible
in the current window. Iff so, then we also return the visible
region; the input and possible output rectangles are defined by their
top, bottom, left and right edges in paper pixel coordinates.
*)
BEGIN
IF allpagevisible THEN (* all of rectangle must be visible *)
outtop := intop; outbot := inbot; outleft := inleft; outright := inright;
RETURN TRUE;
END;
IF intop > windowbottom THEN RETURN FALSE END;
IF inbot < windowtop THEN RETURN FALSE END;
IF inleft > windowright THEN RETURN FALSE END;
IF inright < windowleft THEN RETURN FALSE END;
(* part or all of rectangle is visible, so return visible region *)
outtop := Max(intop,windowtop);
outbot := Min(inbot,windowbottom);
outleft := Max(inleft,windowleft);
outright := Min(inright,windowright);
RETURN TRUE;
END RectangleVisible;
(******************************************************************************)
PROCEDURE DisplayChars;
(* Display all characters on a font by font basis. How characters will be
represented depends on the current displaymode (which the user can change
while the window is being updated by typing the Terse/Box/Full commands).
Fonts will be displayed in order of ascending totalchars (due to SortFonts).
Characters in a font will be displayed in a top-down, left-right manner
because of the way DVIReader builds a charlist.
*)
VAR keyhit : CHAR; (* check for abort or mode change *)
BEGIN
CASE displaymode OF
tersemode : DisplayOneChar := TerseChar |
boxmode : DisplayOneChar := BoxChar |
fullmode : IF (vscalefactor < 1.0) OR (hscalefactor < 1.0) THEN
DisplayOneChar := FullChar2;
ELSE
DisplayOneChar := FullChar1;
END
END;
thisfontinfo := fontlist;
WHILE thisfontinfo <> unusedfont DO
(* SortFont makes sure we only consider used fonts *)
WITH thisfontinfo^ DO
fontopen := FALSE; (* needed for FullChar *)
(* Some VDUs may be able to simulate the given font, or even
better, be able to download the glyph maps from the PXL file.
To help the VDU select appropriately sized characters, we need to
pass the scaledsize of the font (converted to unscaled paper pixels),
the overall mag, and the current h/vscalefactors.
*)
LoadFont(fontspec,
PixelRound(scaledsize),
FLOAT(mag)/1000.0,
hscalefactor,
vscalefactor);
thischarinfo := charlist;
WHILE thischarinfo <> NIL DO (* display chars in chartable *)
WITH thischarinfo^ DO
thischar := 0;
WHILE thischar < charcount DO
DisplayOneChar;
(* SYSDEP:
We can check for abort or mode change after every visible char
because BusyRead overheads are not too high under VAX/UNIX.
*)
IF charvisible AND BusyRead(keyhit) THEN
keyhit := CAP(keyhit);
IF (keyhit = Terse) AND (displaymode <> tersemode) THEN
DisplayOneChar := TerseChar;
displaymode := tersemode;
StartText;
UpdateDVIStatusLine;
StartGraphics;
ELSIF (keyhit = Box) AND (displaymode <> boxmode) THEN
DisplayOneChar := BoxChar;
displaymode := boxmode;
StartText;
UpdateDVIStatusLine;
StartGraphics;
ELSIF (keyhit = Full) AND (displaymode <> fullmode) THEN
IF (vscalefactor < 1.0) OR (hscalefactor < 1.0) THEN
DisplayOneChar := FullChar2;
ELSE
DisplayOneChar := FullChar1;
END;
displaymode := fullmode;
StartText;
UpdateDVIStatusLine;
StartGraphics;
ELSIF keyhit = abortkey THEN
IF fontopen THEN (* must have been in FullChar *)
ClosePXLFile;
StartText;
ClearMessageLine; (* clear font opening message *)
END;
(* no need to set useraborted; DisplayRules done first *)
RETURN;
END;
END;
INC(thischar);
END;
thischarinfo := nextchar;
END;
END;
IF fontopen THEN (* must have been in FullChar *)
ClosePXLFile;
StartText;
ClearMessageLine; (* clear font opening message *)
StartGraphics; (* might be more fonts *)
END;
thisfontinfo := nextfont;
END;
END;
END DisplayChars;
(******************************************************************************)
PROCEDURE TerseChar;
(* Display a quick and nasty representation of character only if ref pt visible.
Just how good the representation is depends on the capabilities of the VDU.
Some VDUs may be able to download a font (via previous LoadFont call)
and produce similar results to a FullChar (but much faster!).
We don't bother checking if glyph is actually all white or non-existent.
*)
BEGIN
WITH thisfontinfo^ DO
WITH thischarinfo^.chartable[thischar] DO
IF PixelVisible(hp,vp) THEN (* ref pt of char is visible *)
ShowChar(ScaleHpos(hp - windowleft) + windowh,
ScaleVpos(vp - windowtop) + windowv,
CHR(code));
charvisible := TRUE;
ELSE
charvisible := FALSE; (* checked in DisplayChars *)
END;
END;
END;
END TerseChar;
(******************************************************************************)
PROCEDURE PixelVisible (hpos, vpos : INTEGER) : BOOLEAN;
(* Return TRUE iff given paper pixel would be visible in current window. *)
BEGIN
IF allpagevisible THEN RETURN TRUE END;
IF vpos < windowtop THEN RETURN FALSE END;
IF vpos > windowbottom THEN RETURN FALSE END;
IF hpos < windowleft THEN RETURN FALSE END;
IF hpos > windowright THEN RETURN FALSE END;
RETURN TRUE;
END PixelVisible;
(******************************************************************************)
PROCEDURE BoxChar;
(* Display visible box outlines of glyph.
Thickness of outlines = 1 screen pixel no matter what the h and v scaling.
*)
VAR
vpmyo, hpmxo, (* vp-yo, hp-xo: glyph's top and left edges *)
top, bottom, left, right, (* visible edges of glyph *)
scaledtop, scaledleft, (* scaled visible edges *)
scaledbot, scaledright,
scaledheight, scaledwidth (* scaled width and height *)
: INTEGER;
ch : CHAR;
BEGIN
WITH thisfontinfo^ DO
WITH thischarinfo^.chartable[thischar] DO
WITH pixelptr^[code] DO
IF mapadr = 0 THEN RETURN END; (* glyph all white or absent *)
(* check if any part of glyph is visible *)
vpmyo := vp-yo;
hpmxo := hp-xo;
IF RectangleVisible
(vpmyo, vpmyo+ht-1, hpmxo, hpmxo+wd-1,(* glyph edges *)
top,bottom,left,right) (* visible part *)
THEN
scaledtop := ScaleVpos(top - windowtop) + windowv;
scaledleft := ScaleHpos(left - windowleft) + windowh;
IF vscalefactor > 1.0 THEN
scaledbot := ScaleVpos(bottom + 1 - windowtop) - 1 + windowv;
ELSE
scaledbot := ScaleVpos(bottom - windowtop) + windowv;
END;
IF hscalefactor > 1.0 THEN
scaledright := ScaleHpos(right + 1 - windowleft) - 1 + windowh;
ELSE
scaledright := ScaleHpos(right - windowleft) + windowh;
END;
scaledheight := scaledbot - scaledtop + 1;
scaledwidth := scaledright - scaledleft + 1;
ch := CHR(code);
(* Only show edges that are also glyph outlines!
Following method reduces the number of ShowRectangle calls needed for
very small boxes.
*)
IF ((scaledheight < 3) AND (top = vpmyo) AND (bottom = vpmyo+ht-1)) OR
((scaledwidth < 3) AND (left = hpmxo) AND (right = hpmxo+wd-1)) THEN
ShowRectangle(scaledleft, scaledtop, scaledwidth, scaledheight, ch);
ELSE
IF left = hpmxo THEN (* left outline visible *)
ShowRectangle(scaledleft, scaledtop, 1, scaledheight, ch);
END;
IF bottom = vpmyo+ht-1 THEN (* bottom outline visible *)
ShowRectangle(scaledleft, scaledbot, scaledwidth, 1, ch);
END;
IF top = vpmyo THEN (* top outline visible *)
ShowRectangle(scaledleft, scaledtop, scaledwidth, 1, ch);
END;
IF right = hpmxo+wd-1 THEN (* right outline visible *)
ShowRectangle(scaledright, scaledtop, 1, scaledheight, ch);
END;
END;
charvisible := TRUE;
ELSE
charvisible := FALSE; (* checked in DisplayChars *)
END;
END;
END;
END;
END BoxChar;
(******************************************************************************)
PROCEDURE FullChar1;
(* Display all pixels in a glyph using bitmap from PXL font file.
This procedure is assigned to DisplayOneChar when h AND vscalefactors are
>= 1.0, so we don't have to worry about scaledheights/widths being 0.
*)
VAR
vpmyo, hpmxo, (* vp-yo, hp-xo: glyph's top and left edges *)
top, bottom, left, right, (* visible edges of glyph *)
scaledv, scalednextv, (* scaled vertical positions for rows *)
scaledh, (* scaled h coord of start of run within row *)
scaledwidth, scaledheight, (* scaled width and height of row *)
thisrow, thisbit (* in paper coordinates *)
: INTEGER;
wordsperrow, (* rows of PXL glyph are word aligned *)
firstbit, lastbit, (* 0..wordsperrow*32 - 1 *)
firstword, (* 0..wordsperrow-1 *)
bitpos : CARDINAL; (* 0..31 *)
glyphword : BITSET; (* current word in bitmap *)
inrun : BOOLEAN; (* are we in a run of black pixels in row? *)
BEGIN
WITH thisfontinfo^ DO
WITH thischarinfo^.chartable[thischar] DO
WITH pixelptr^[code] DO
IF mapadr = 0 THEN RETURN END; (* glyph all white or absent *)
(* check if any part of glyph is visible *)
vpmyo := vp-yo;
hpmxo := hp-xo;
IF RectangleVisible
(vpmyo,vpmyo+ht-1,hpmxo,hpmxo+wd-1, (* glyph edges *)
top,bottom,left,right) (* visible part *)
THEN
IF NOT fontopen THEN (* only open once *)
OpenFontFile;
fontopen := TRUE;
END;
wordsperrow := (wd + 31) DIV 32; (* words in one row of bitmap *)
firstbit := CARDINAL(left-hpmxo); (* first visible bit in row *)
lastbit := CARDINAL(right-hpmxo); (* last visible bit *)
firstword := firstbit DIV 32; (* first visible word *)
(* calculate scaled v coord of first visible row *)
scaledv := ScaleVpos(top - windowtop) + windowv;
(* only consider visible rows; thisrow := top to bottom *)
thisrow := top;
LOOP
(* calculate scaled v coord of next row *)
scalednextv := ScaleVpos(thisrow + 1 - windowtop) + windowv;
scaledheight := scalednextv - scaledv; (* can't be 0 *)
(* move to first byte of first visible word in this row *)
MoveToPXLByte(4 * (mapadr + (CARDINAL(thisrow-vpmyo) * wordsperrow)
+ firstword));
glyphword := BITSET(SignedPXLQuad());
bitpos := 31 - (firstbit MOD 32); (* 31..0 *)
inrun := FALSE;
(* display black pixel runs in row, doing any h/v expansion *)
(* only consider visible bits; thisbit := left to right *)
thisbit := left;
LOOP
IF bitpos IN glyphword THEN (* start/continue run *)
IF NOT inrun THEN
inrun := TRUE;
(* remember start of run *)
scaledh := ScaleHpos(thisbit - windowleft) + windowh;
END;
ELSIF inrun THEN (* 0 bit has ended run *)
inrun := FALSE;
scaledwidth := ScaleHpos(thisbit - windowleft) + windowh
- scaledh;
ShowRectangle
(scaledh,scaledv,scaledwidth,scaledheight,CHR(code));
END;
IF thisbit = right THEN EXIT (* bit loop *) END;
IF bitpos = 0 THEN (* look at first bit in next word of row *)
glyphword := BITSET(SignedPXLQuad());
bitpos := 31;
ELSE (* look at next bit in word *)
DEC(bitpos);
END;
INC(thisbit);
END; (* bit loop *)
IF inrun THEN (* show run at end of row; INC thisbit *)
scaledwidth := ScaleHpos(thisbit + 1 - windowleft) + windowh
- scaledh;
ShowRectangle
(scaledh,scaledv,scaledwidth,scaledheight,CHR(code));
END;
IF thisrow = bottom THEN EXIT (* row loop *) END;
scaledv := scalednextv;
INC(thisrow);
END; (* row loop *)
charvisible := TRUE;
ELSE
charvisible := FALSE; (* checked in DisplayChars *)
END;
END;
END;
END;
END FullChar1;
(******************************************************************************)
PROCEDURE FullChar2;
(* Display all pixels in a glyph using bitmap from PXL font file.
This procedure is assigned to DisplayOneChar when h/vscalefactor < 1.0.
The algorithm avoids overlapping rows when vscalefactor < 1.0.
When hscalefactor < 1.0, it is not worth the extra code to avoid overlapping
runs of 1 bits because the majority of character glyphs have only one or two
runs per row.
*)
CONST
maxviswords = 30;
(* SYSDEP: 30 * 32 = 960 bits wide.
Some sites may have very wide glyphs (such as a logo).
960 bits represents 3.2in on a 300 dpi device.
*)
TYPE
glyphrow = ARRAY [0..maxviswords-1] OF BITSET;
(* SYSDEP: BITSET is 32 bit word with elements 31,30,29,...,0 *)
VAR
vpmyo, hpmxo, (* vp-yo, hp-xo: glyph's top and left edges *)
top, bottom, left, right, (* visible edges of glyph *)
scaledv, scalednextv, (* scaled vertical positions for rows *)
scaledh, (* scaled horizontal positions within row *)
scaledwidth, scaledheight, (* scaled width and height of row *)
thisrow, thisbit (* in paper coordinates *)
: INTEGER;
row : glyphrow; (* holds VISIBLE bits in one row of glyph;
possibly > one row if vscalefactor < 1.0 *)
wordsperrow, (* rows of PXL glyph are word aligned *)
firstbit, lastbit, (* somewhere in 0 .. wordsperrow*32-1 *)
firstword, lastword, (* somewhere in 0 .. wordsperrow-1 *)
endword, (* = visible words in row, - 1 *)
wordpos, (* 0 .. endword *)
bitpos, (* 31 .. 0 *)
i : CARDINAL;
inrun : BOOLEAN; (* are we in a run of black pixels in row? *)
BEGIN
WITH thisfontinfo^ DO
WITH thischarinfo^.chartable[thischar] DO
WITH pixelptr^[code] DO
IF mapadr = 0 THEN RETURN END; (* glyph all white or absent *)
(* check if any part of glyph is visible *)
vpmyo := vp-yo;
hpmxo := hp-xo;
IF RectangleVisible
(vpmyo,vpmyo+ht-1,hpmxo,hpmxo+wd-1, (* glyph edges *)
top,bottom,left,right) (* visible part *)
THEN
IF NOT fontopen THEN (* only open once *)
OpenFontFile;
fontopen := TRUE;
END;
wordsperrow := (wd + 31) DIV 32; (* words in one row of bitmap *)
firstbit := CARDINAL(left-hpmxo); (* first visible bit *)
lastbit := CARDINAL(right-hpmxo); (* last visible bit *)
firstword := firstbit DIV 32; (* first visible word *)
lastword := lastbit DIV 32; (* last visible word *)
endword := lastword - firstword;
(* DEBUG
(* we impose a limit on width of glyph (unlikely to be exceeded) *)
IF endword > maxviswords-1 THEN
StartText;
ClearMessageLine;
WriteString('Glyph '); WriteCard(code);
WriteString(' too wide!');
WaitForReturn;
StartGraphics;
END;
GUBED *)
(* set the visible words in row to 0 *)
FOR i := 0 TO endword DO row[i] := {} END;
(* calculate scaled v coord of first visible row *)
scaledv := ScaleVpos(top - windowtop) + windowv;
(* only consider visible rows; thisrow := top to bottom *)
thisrow := top;
LOOP
(* move to first byte of first visible word in this row *)
MoveToPXLByte(4 * (mapadr + (CARDINAL(thisrow - vpmyo) * wordsperrow)
+ firstword));
(* get row of visible words from PXL file and OR with row array *)
FOR wordpos := 0 TO endword DO
row[wordpos] := BITSET(SignedPXLQuad()) + row[wordpos];
(* set union *)
END;
(* calculate scaled v coord of next row *)
scalednextv := ScaleVpos(thisrow + 1 - windowtop) + windowv;
scaledheight := scalednextv - scaledv;
IF (scaledheight > 0) OR (thisrow = bottom) THEN
(* display black pixels in row, doing any h/v expansion *)
IF scaledheight < 1 THEN scaledheight := 1 END; (* avoid 0 *)
inrun := FALSE;
bitpos := 31 - (firstbit MOD 32); (* 31..0 *)
wordpos := 0;
(* only consider visible bits; thisbit := left to right *)
thisbit := left;
LOOP
IF bitpos IN row[wordpos] THEN (* start/continue run *)
IF NOT inrun THEN (* remember start of run *)
inrun := TRUE;
scaledh := ScaleHpos(thisbit - windowleft) + windowh;
END;
ELSIF inrun THEN (* 0 bit has ended run *)
inrun := FALSE;
scaledwidth := ScaleHpos(thisbit - windowleft) + windowh
- scaledh;
IF scaledwidth < 1 THEN scaledwidth := 1 END; (* avoid 0 *)
ShowRectangle
(scaledh,scaledv,scaledwidth,scaledheight,CHR(code));
END;
IF thisbit = right THEN EXIT (* bit loop *) END;
IF bitpos = 0 THEN (* look at first bit in next word of row *)
INC(wordpos);
bitpos := 31;
ELSE (* look at next bit in word *)
DEC(bitpos);
END;
INC(thisbit);
END; (* bit loop *)
IF inrun THEN (* show run at end of row; INC thisbit *)
scaledwidth := ScaleHpos(thisbit + 1 - windowleft) + windowh
- scaledh;
IF scaledwidth < 1 THEN scaledwidth := 1 END; (* avoid 0 *)
ShowRectangle
(scaledh,scaledv,scaledwidth,scaledheight,CHR(code));
END;
IF thisrow = bottom THEN EXIT (* row loop *) END;
(* else reset the visible words in row to 0 *)
FOR i := 0 TO endword DO row[i] := {} END;
END;
scaledv := scalednextv;
INC(thisrow);
END; (* row loop *)
charvisible := TRUE;
ELSE
charvisible := FALSE; (* checked in DisplayChars *)
END;
END;
END;
END;
END FullChar2;
(******************************************************************************)
PROCEDURE OpenFontFile;
(* If thisfontinfo^.fontspec can't be opened then pixel table has been
loaded with dummyfont values (either the user requested an invalid font
magnification or the fontspec was truncated in BuildFontSpec).
*)
BEGIN
StartText;
ClearMessageLine;
WriteString("Drawing characters from ");
WITH thisfontinfo^ DO
IF OpenPXLFile(fontspec) THEN
WriteString(fontspec);
WriteLn;
ELSIF OpenPXLFile(dummyfont) THEN
WriteString("dummy font!");
WriteLn;
ELSE
(* DEBUG
(* should never happen since MyPixelTableRoutine will detect 1st *)
ResetVDU;
WriteLn; WriteString('Bug in OpenFontFile!'); WriteLn;
RestoreTerminal; HALT;
GUBED *)
END;
END;
StartGraphics;
END OpenFontFile;
(******************************************************************************)
PROCEDURE CheckPageEdges;
(* One or more page edges do not fall within the paper edges.
This routine is called after the page & paper have been displayed so
user can see how bad the problem is.
*)
BEGIN
IF minhp < paperleft THEN
ClearMessageLine;
WriteString('Page beyond left edge by ');
WriteDimension(paperleft - minhp);
PaperMessage;
END;
IF maxhp > paperright THEN
ClearMessageLine;
WriteString('Page beyond right edge by ');
WriteDimension(maxhp - paperright);
PaperMessage;
END;
IF minvp < papertop THEN
ClearMessageLine;
WriteString('Page above top edge by ');
WriteDimension(papertop - minvp);
PaperMessage;
END;
IF maxvp > paperbottom THEN
ClearMessageLine;
WriteString('Page below bottom edge by ');
WriteDimension(maxvp - paperbottom);
PaperMessage;
END;
END CheckPageEdges;
(******************************************************************************)
PROCEDURE PaperMessage;
(* Called by CheckPageEdges to remind user of the paper size. *)
BEGIN
CASE currentunits OF
inunits : WriteString('in') |
cmunits : WriteString('cm') |
mmunits : WriteString('mm') |
pcunits : WriteString('pc') |
ptunits : WriteString('pt') |
pxunits : WriteString('px')
END;
WriteString('! (Paper is ');
WriteDimension(paperwd); WriteString(' by ');
WriteDimension(paperht); Write(')');
WaitForReturn;
ClearMessageLine;
END PaperMessage;
(******************************************************************************)
PROCEDURE Finish;
BEGIN
CloseDVIFile;
ClearScreen;
MoveToTextLine(1);
WriteLn;
ResetVDU;
RestoreTerminal;
(* And HALT.
Note that ResetVDU and RestoreTerminal should be called before each HALT.
ResetVDU is called before any final message since it might erase the screen.
*)
END Finish;
(******************************************************************************)
BEGIN
TopLevel;
END dvitovdu.