Copyright (C) 1992, Digital Equipment Corporation
All rights reserved.
See the file COPYRIGHT for a full description.
Last modified on Mon Dec 15 13:59:24 PST 1997 by heydon
MODULE ScrnFontExtras;
IMPORT ScrnFont, Rect, Text;
Most of this was copied from the implementation in ScrnFont.m3
.
PROCEDURE TightBoundingBox(txt: TEXT; fnt: ScrnFont.T): Rect.T =
CONST BufSize = 64;
VAR junk: BOOLEAN; len := Text.Length (txt); BEGIN
IF (len <= BufSize) THEN
VAR buf: ARRAY [0..BufSize-1] OF CHAR; BEGIN
Text.SetChars(buf, txt);
RETURN TightBoundingBoxSubValid(SUBARRAY(buf, 0, len), fnt, junk)
END
ELSE
VAR ref := NEW(REF ARRAY OF CHAR, len); BEGIN
Text.SetChars(ref^, txt);
RETURN TightBoundingBoxSubValid(ref^, fnt, junk)
END
END;
END TightBoundingBox;
PROCEDURE TightBoundingBoxSub(
READONLY txt: ARRAY OF CHAR;
fnt: ScrnFont.T)
: Rect.T =
VAR junk: BOOLEAN; BEGIN
RETURN TightBoundingBoxSubValid(txt, fnt, junk)
END TightBoundingBoxSub;
PROCEDURE TightBoundingBoxSubValid(
READONLY txt: ARRAY OF CHAR;
fnt: ScrnFont.T;
VAR (*OUT*) valid: BOOLEAN)
: Rect.T =
VAR res: Rect.T; len := NUMBER(txt); BEGIN
valid := TRUE;
IF len = 0 THEN RETURN Rect.Empty END;
IF fnt = NIL OR fnt.metrics = NIL THEN RETURN Rect.FromSize(len, 1) END;
WITH m = fnt.metrics DO
<* ASSERT m # NIL *>
IF m.charMetrics # NIL THEN
(* This font has character metrics *)
(* Compute join of bounding boxes *)
res := Rect.Empty;
VAR rp := 0; BEGIN
FOR i := 0 TO LAST(txt) DO
WITH cm = GetCM(m, txt[i], valid) DO
res := Rect.Join(res, Rect.MoveH(cm.boundingBox, rp));
INC(rp, cm.printWidth)
END
END
END
ELSE
(* All characters have the same "printWidth" and "boundingBox", which
are stored in "m.charMetrics.maxBounds". *)
(* Set "valid" if some characters may be invalid, and set "len"
to the number of valid characters. *)
VAR fc, lc: INTEGER; BEGIN
IF NOT AllCharsValid(m, fc, lc) THEN
VAR validCnt := 0; ch: INTEGER; BEGIN
FOR i := 0 TO len - 1 DO
ch := ORD(txt[i]);
IF fc <= ch AND ch <= lc THEN INC(validCnt) END
END;
valid := (len = validCnt);
len := validCnt
END
END
END;
(* Compute the bounding box *)
IF len = 0 THEN RETURN Rect.Empty END;
WITH max = m.maxBounds, pw = max.printWidth, box = max.boundingBox DO
res := box;
IF len > 1 THEN
res := Rect.Join(res, Rect.MoveH(box, pw * (len - 1)))
END
END
END;
RETURN res
END
END TightBoundingBoxSubValid;
CONST EmptyCM = ScrnFont.CharMetric{
boundingBox := Rect.Empty, printWidth := 0};
PROCEDURE GetCM(
m: ScrnFont.Metrics;
ch: CHAR;
VAR (*INOUT*) valid: BOOLEAN)
: ScrnFont.CharMetric =
CONST SpaceCode = ORD(' '); Char240 = 8_240;
VAR c := ORD(ch); BEGIN
WITH fc = m.firstChar, lc = m.lastChar DO
IF c < fc OR c > lc THEN
c := m.defaultChar;
IF c < fc OR c > lc THEN
valid := FALSE;
RETURN EmptyCM
END
END;
IF c # SpaceCode AND c # Char240 THEN
RETURN m.charMetrics[c - fc]
ELSE
(* The space character should have an empty bounding box, but the X
font definition mistakenly gives it a width and height of 1. The
same is true for character 8_240 in all fonts. *)
RETURN ScrnFont.CharMetric{boundingBox := Rect.Empty,
printWidth := m.charMetrics[c - fc].printWidth}
END
END
END GetCM;
PROCEDURE AllCharsValid(m: ScrnFont.Metrics; VAR (*OUT*) fc,lc: INTEGER):
BOOLEAN =
Return TRUE
iff all characters must be valid, that is, if m
is defined
on all characters, or if its default character is defined. This also has
the side-effect of setting fc
and lc
to the codes of m
's first and
last defined characters.
BEGIN
fc := m.firstChar;
lc := m.lastChar;
WITH dc = m.defaultChar DO
RETURN (fc <= ORD(FIRST(CHAR)) AND ORD(LAST(CHAR)) <= lc)
OR (fc <= dc AND dc <= lc)
END
END AllCharsValid;
BEGIN
END ScrnFontExtras.