DIRECTORY
Ascii USING [CR, SP, TAB],
Basics USING [BITAND, BITSHIFT, bitsPerWord, logBitsPerWord, LongMult],
Font USING [BadFontFileFormat, Box, FONT, FontFormattingClassRec, FontGraphicsClassRec, GetProp, LigatureOrKern, Pair, RegisterFontFormattingClass, RegisterFontGraphicsClass],
ImagerBasic USING [IntRectangle, Pair, Rectangle, Transformation],
ImagerTransform,
Real USING [RoundLI],
Rope USING [ROPE],
Scaled USING [Floor, PLUS, Value],
UFStrikeFormat USING [Body, Format, Header, KernedStrike, nullWidthEntry, PlainStrike, WidthEntry, WTable, XTable],
UFFileManager USING [FontFile, GetData, InitProc, Open, Pointer],
UFStrikeReader;
UFStrikeReaderImpl:
CEDAR
PROGRAM
IMPORTS Basics, ImagerTransform, Real, Scaled, UFFileManager, Font
EXPORTS UFStrikeReader
= BEGIN OPEN UFStrikeReader, Tran: ImagerTransform;
FONT: TYPE = Font.FONT;
Transformation: TYPE = ImagerBasic.Transformation;
StrikeFont: TYPE = REF StrikeFontRep;
StrikeFontRep: TYPE = RECORD [
kerned: BOOLEAN, -- plain (FALSE) or kerned (TRUE) strike format
height: [0..77777B], -- font height
min, max: CHARACTER, -- range of defined characters
width: REF WidthArray, -- a width for every character code
dx, dy: INTEGER, -- font bounding box dimensions
ox, oy: INTEGER, -- font bounding box offsets
xtable: LONG POINTER TO UFStrikeFormat.XTable, -- bitmap positions
wtable: LONG POINTER TO UFStrikeFormat.WTable, -- widths and kerns (if kerned=TRUE)
bitmap: LONG POINTER TO ARRAY [0..0) OF WORD, -- the strike itself
raster: CARDINAL, -- words per raster line in the strike
address: LONG POINTER, -- virtual address of font
fileName: Rope.ROPE ← NIL, -- name of font file, if available
other: REF ANY ← NIL -- escape hatch
];
WidthArray: TYPE = PACKED ARRAY CHARACTER OF [0..377B];
OpenInitialization: UFFileManager.InitProc =
TRUSTED {
This gets called when the font file is first opened; its responsibility is to build a description of the font.
address: LONG POINTER ← fontFile.Pointer;
hdr: LONG POINTER TO UFStrikeFormat.Header ← address;
format: UFStrikeFormat.Format ← hdr.format;
self: StrikeFont ← NEW[StrikeFontRep];
dx, dy, ox, oy: INTEGER ← 0;
body: LONG POINTER TO UFStrikeFormat.Body ← NIL;
raster, height: CARDINAL;
bitmap: LONG POINTER ← NIL;
kerned: BOOLEAN ← FALSE;
IF format.oneBit=F THEN ERROR Font.BadFontFileFormat;
IF format.index=T THEN ERROR Font.BadFontFileFormat;
kerned ← (format.kerned=T);
IF kerned
THEN {
ks: LONG POINTER TO UFStrikeFormat.KernedStrike ← address; body ← @ks.body;
[fbbdx: dx, fbbdy: dy, fbbox: ox, fbboy: oy] ← ks.box
}
ELSE {
ps: LONG POINTER TO UFStrikeFormat.PlainStrike ← address; body ← @ps.body;
dx ← hdr.maxwidth; dy ← body.ascent+body.descent;
ox ← 0; oy ← -body.descent
};
height ← body.ascent+body.descent;
bitmap ← LOOPHOLE[body + SIZE[UFStrikeFormat.Body]];
raster ← body.raster;
self^ ← [kerned: kerned, height: height,
min: hdr.min, max: hdr.max, width: NIL, dx: dx, dy: dy, ox: ox, oy: oy,
xtable: NIL, wtable: NIL, bitmap: bitmap, raster: raster, address: address];
self.xtable ← LOOPHOLE[bitmap+raster*height];
IF kerned THEN self.wtable ← LOOPHOLE[body+body.length];
Initialize[self];
RETURN[self];
};
Initialize:
UNSAFE
PROC[font: StrikeFont] =
UNCHECKED {
min: CHARACTER ← font.min;
max: CHARACTER ← font.max;
width: REF WidthArray ← NEW[WidthArray];
IF font.kerned
THEN {
wtable: LONG POINTER TO UFStrikeFormat.WTable ← font.wtable;
dummy: [0..377B] ← wtable[max-min+1].width;
width^ ← ALL[dummy];
FOR c:
CHARACTER
IN[min..max]
DO
i: NAT ← c - min; entry: UFStrikeFormat.WidthEntry ← wtable[i];
IF entry#UFStrikeFormat.nullWidthEntry THEN width[c] ← entry.width;
ENDLOOP;
}
ELSE {
xtable: LONG POINTER TO UFStrikeFormat.XTable ← font.xtable;
space: [0..377B] ← 0;
FOR c:
CHARACTER
IN[min..max+1]
DO
i: NAT ← c - min; width[c] ← xtable[i+1] - xtable[i];
ENDLOOP;
space ← width[Ascii.SP];
FOR c: CHARACTER IN [0C..min) DO width[c] ← space ENDLOOP;
FOR c: CHARACTER IN (max+1..177C] DO width[c] ← space ENDLOOP;
width[Ascii.TAB] ← 8*space;
width[Ascii.CR] ← space;
};
font.width ← width;
};
IntBB:
PROCEDURE [font: StrikeFont, char:
CHAR]
RETURNS [xmin, ymin, xmax, ymax:
INTEGER] =
TRUSTED {
xl,xr,xo: INTEGER;
i: NAT ← IF char IN [font.min..font.max] THEN char-font.min ELSE font.max-font.min+1;
IF font.kerned
THEN {
w: UFStrikeFormat.WidthEntry ← font.wtable[i];
IF w=UFStrikeFormat.nullWidthEntry THEN i ← font.max-font.min+1;
xl ← font.xtable[i]; xr ← font.xtable[i+1];
xo ← xl - (font.ox + w.offset);
}
ELSE {xo ← xl ← font.xtable[i]; xr ← font.xtable[i+1]};
xmin ← xl - xo;
xmax ← xr - xo;
ymin ← font.oy;
ymax ← font.oy + font.dy
};
BoundingBox:
PUBLIC
PROCEDURE [key: Key, char:
CHAR]
RETURNS [box: Font.Box] =
TRUSTED {
file: UFFileManager.FontFile ← UFFileManager.Open[key, OpenInitialization];
font: StrikeFont ← NARROW[file.GetData];
xmin, ymin, xmax, ymax: INTEGER;
[xmin, ymin, xmax, ymax] ← IntBB[font, char];
box ← [xmin: xmin, xmax: xmax, ymin: font.oy, ymax: font.oy + font.dy];
};
WidthVector:
PUBLIC
PROCEDURE [key: Key, char:
CHAR]
RETURNS [Font.Pair] =
TRUSTED {
file: UFFileManager.FontFile ← UFFileManager.Open[key, OpenInitialization];
font: StrikeFont ← NARROW[file.GetData];
RETURN [[font.width[char], 0]]
};
FontGraphicsClass interface
ScaledFromReal:
PROC [real:
REAL]
RETURNS [Scaled.Value] ~
TRUSTED {
Because of a bug in Real.FScale.
i: INT ← Real.RoundLI[real * 65536.0];
RETURN[LOOPHOLE[i]]
};
SKMask:
PROCEDURE [font:
FONT, transformation: Transformation, char:
CHAR,
run: PROC [sMin, fMin: INTEGER, fSize: NAT]] = TRUSTED {
file: UFFileManager.FontFile ← UFFileManager.Open[font.graphicsKey, OpenInitialization];
strikeFont: StrikeFont ← NARROW[file.GetData];
xLeft, xRight, xOrigin: INTEGER;
c: NAT ← IF char IN [strikeFont.min..strikeFont.max] THEN char-strikeFont.min ELSE strikeFont.max-strikeFont.min+1;
IF strikeFont.kerned
THEN {
w: UFStrikeFormat.WidthEntry ← strikeFont.wtable[c];
IF w=UFStrikeFormat.nullWidthEntry THEN c ← strikeFont.max-strikeFont.min+1;
xLeft ← strikeFont.xtable[c]; xRight ← strikeFont.xtable[c+1];
xOrigin ← xLeft - (strikeFont.ox + w.offset);
}
ELSE {xOrigin ← xLeft ← strikeFont.xtable[c]; xRight ← strikeFont.xtable[c+1]};
{
iSize: NAT ← strikeFont.dy;
Bit:
PROC [i, j:
INTEGER]
RETURNS [bit: [0..1]] ~
TRUSTED {
j ← j + xOrigin;
IF i<0 OR i>=iSize OR j<xLeft OR j>=xRight THEN bit ← 0
ELSE {
jQuotient: NAT ← Basics.BITSHIFT[j, -Basics.logBitsPerWord];
jRem: NAT ← Basics.BITAND[j, Basics.bitsPerWord-1];
wordOffset: LONG CARDINAL ← Basics.LongMult[i, strikeFont.raster] + jQuotient;
word: CARDINAL ← strikeFont.bitmap[wordOffset];
shiftedWord: CARDINAL ← Basics.BITSHIFT[word, jRem-(Basics.bitsPerWord-1)];
temp1, temp2: CARDINAL ← 0;
temp1 ← Basics.BITAND[shiftedWord, 1];
temp2 ← temp1;
bit ← temp1;
};
};
baselineToTop: REAL ← strikeFont.oy + strikeFont.dy;
candidateSize: REAL ← NARROW[font.GetProp[$candidateSize], REF REAL]^;
ijToxy: Transformation ← Tran.Create[0, 1/candidateSize, 0, -1/candidateSize, 0, baselineToTop/candidateSize];
ijTosf: Transformation ← Tran.Concat[ijToxy, transformation];
bbox: ImagerBasic.IntRectangle ← Tran.TransformIntRectangle[
[0, xLeft-xOrigin, iSize, xRight-xLeft], ijTosf];
sMin: INTEGER ← bbox.x;
fMin: INTEGER ← bbox.y;
sSize: NAT ← bbox.w;
fSize: NAT ← bbox.h;
nextPixel: ImagerBasic.Pair ← Tran.InverseTransformVec[[0, 1], ijTosf];
nextLine: ImagerBasic.Pair ← Tran.InverseTransformVec[[1, 0], ijTosf];
start: ImagerBasic.Pair ← Tran.InverseTransform[[0.5+sMin, 0.5+fMin], ijTosf];
iStart: Scaled.Value ← ScaledFromReal[start.x];
jStart: Scaled.Value ← ScaledFromReal[start.y];
iDeltaPixel: Scaled.Value ← ScaledFromReal[nextPixel.x];
jDeltaPixel: Scaled.Value ← ScaledFromReal[nextPixel.y];
iDeltaLine: Scaled.Value ← ScaledFromReal[nextLine.x];
jDeltaLine: Scaled.Value ← ScaledFromReal[nextLine.y];
FOR s:
INTEGER
IN [sMin..sMin+sSize)
DO
i: Scaled.Value ← iStart;
j: Scaled.Value ← jStart;
f: INTEGER ← fMin;
WHILE f<fMin+fSize
DO
fStart: INTEGER;
WHILE f<fMin+fSize
AND Bit[i.Floor, j.Floor] = 0
DO
f𡤏+1;
i ← i.PLUS[iDeltaPixel];
j ← j.PLUS[jDeltaPixel];
ENDLOOP;
fStart ← f;
WHILE f<fMin+fSize
AND Bit[i.Floor, j.Floor] = 1
DO
f𡤏+1;
i ← i.PLUS[iDeltaPixel];
j ← j.PLUS[jDeltaPixel];
ENDLOOP;
IF f>fStart THEN run[s, fStart, f-fStart];
ENDLOOP;
iStart ← iStart.PLUS[iDeltaLine];
jStart ← jStart.PLUS[jDeltaLine];
ENDLOOP;
};
};
SKBoundingBox:
PROCEDURE [font:
FONT, char:
CHAR]
RETURNS [box: Font.Box] = {
b: Font.Box ← BoundingBox[font.graphicsKey, char];
candidateSize: REAL ← NARROW[font.GetProp[$candidateSize], REF REAL]^;
c: ImagerBasic.Rectangle ← ImagerTransform.TransformRectangle[[b.xmin, b.ymin, b.xmax-b.xmin, b.ymax-b.ymin], ImagerTransform.Scale[1/candidateSize].Concat[font.actualTransformation]];
box ← [c.x, c.y, c.x+c.w, c.y+c.h];
};
SKWidthVector:
PROCEDURE [font:
FONT, char:
CHAR]
RETURNS [Font.Pair] = {
p: Font.Pair ← WidthVector[font.graphicsKey, char];
candidateSize: REAL ← NARROW[font.GetProp[$candidateSize], REF REAL]^;
p.x ← p.x/candidateSize;
RETURN [ImagerTransform.TransformVec[p, font.actualTransformation]];
};
SKContains:
PROCEDURE [font:
FONT, char:
CHAR]
RETURNS [
BOOLEAN] = {
RETURN[WidthVector[font.graphicsKey, char]#[0,0]];
};
SKGraphicsObjectInit:
PROCEDURE [font:
FONT] = {
file: UFFileManager.FontFile ← UFFileManager.Open[font.graphicsKey, OpenInitialization];
strikeFont: StrikeFont ← NARROW[file.GetData];
font.fontGraphicsClass ← SKGraphicsClass;
font.bc ← strikeFont.min;
font.ec ← strikeFont.max;
};
SKGraphicsClass:
REF Font.FontGraphicsClassRec←
NEW[Font.FontGraphicsClassRec←[
maskProc: SKMask,
boundingBoxProc: SKBoundingBox,
widthVectorProc: SKWidthVector,
containsProc: SKContains
]];
FontFormattingClass interface
LigatureOrKern: TYPE = Font.LigatureOrKern;
Box: TYPE = Font.Box;
SKLigKern: PROCEDURE [font: FONT, char1, char2: CHAR] RETURNS [ligatureOrKern: LigatureOrKern] = {RETURN[[neither[]]]};
SKFormattingBox:
PROCEDURE [font:
FONT, char:
CHAR]
RETURNS [box: Box] = {
box ← BoundingBox[font.graphicsKey, char];
box.xmin ← 0;
box.xmax ← WidthVector[font.graphicsKey, char].x;
};
SKFormattingMetric:
PROCEDURE [font:
FONT, metric:
ATOM, char:
CHAR]
RETURNS [
REAL] = {
RETURN[0.0];
};
SKFormattingObjectInit:
PROCEDURE [font:
FONT] = {
font.fontFormattingClass ← SKFormattingClass;
};
SKFormattingClass:
REF Font.FontFormattingClassRec ←
NEW[Font.FontFormattingClassRec←[
formattingBoxProc: SKFormattingBox,
ligKernProc: SKLigKern,
formattingMetricProc: SKFormattingMetric
]];
Font.RegisterFontGraphicsClass[$Strike, SKGraphicsObjectInit];
Font.RegisterFontFormattingClass[$Strike, SKFormattingObjectInit];
END.