PressFontReaderImpl:
PROGRAM
IMPORTS CGPrivate, FS, Graphics, IO, PressFontFormat, RealConvert, Rope, VM
EXPORTS PressFontReader
= BEGIN
OPEN PressFontReader, F: PressFontFormat;
Handle: PUBLIC TYPE = REF PressFontFileRec;
PressFontFileRec:
PUBLIC
TYPE =
RECORD [
vm: VM.Interval,
base: LONG POINTER,
length: INT,
names: LIST OF CodeNamePair
];
CodeNamePair:
TYPE =
RECORD [
code: [0..256),
name: ROPE
];
Error: PUBLIC SIGNAL[errorCode: ErrorCode, fontFileWordOffset: INT] = CODE;
NameFromCode:
PROCEDURE [handle: Handle, code: [0..256)]
RETURNS [
ROPE] = {
FOR n:
LIST
OF CodeNamePair ← handle.names, n.rest
UNTIL n=
NIL
DO
IF n.first.code = code THEN RETURN [n.first.name];
ENDLOOP;
RETURN [NIL]
};
FromFile:
PUBLIC
PROCEDURE [fileName:
ROPE]
RETURNS [handle: Handle] = {
file: FS.OpenFile ~ FS.Open[name: fileName, lock: $read, remoteCheck: FALSE];
stream: IO.STREAM ~ FS.StreamFromOpenFile[file];
length: INT ~ stream.GetLength[];
vm: VM.Interval ~ VM.Allocate[count: VM.PagesForBytes[length]];
base: LONG POINTER ← NIL;
TRUSTED {
base ← VM.AddressForPageNumber[vm.page];
IF stream.UnsafeGetBlock[[base: base, count: length]]#length THEN ERROR;
};
stream.Close[];
handle ← NEW[PressFontFileRec ← [vm: vm, base: base, length: length, names: NIL]];
EnumerateIndex[handle, TabulateNames];
};
ExtractName:
PROCEDURE [p:
LONG
POINTER
TO name F.RawIndex]
RETURNS [rope: ROPE] = {
i: NAT ← 1;
len: [0..20) ← p.fontname[0]-Ascii.NUL;
charProc:
SAFE
PROC
RETURNS [char:
CHAR] =
TRUSTED {
char ← p.fontname[i];
i ← i + 1;
};
rope ← Rope.FromProc[len, charProc];
};
TabulateNames: VisitProc = {
IF p.hdr.type = name
THEN {
pp: LONG POINTER ← p;
nameIndex: LONG POINTER TO name F.RawIndex ← pp;
handle.names ← CONS[[nameIndex.code, ExtractName[nameIndex]], handle.names]
}
};
VisitProc:
TYPE =
PROCEDURE [handle: Handle, p:
LONG
POINTER
TO F.RawIndex]
RETURNS [quit: BOOLEAN ← FALSE];
EnumerateIndex:
PROCEDURE [handle: Handle, visitProc: VisitProc] = {
p: LONG POINTER TO F.RawIndex ← handle.base;
offset: INT ← 0;
DO
p: LONG POINTER TO F.RawIndex ← handle.base + offset;
newOffset: INT ← offset + p.hdr.length;
IF newOffset > handle.length THEN ERROR Error[fontIndexTooLong, offset];
IF visitProc[handle, p] THEN EXIT;
IF p.hdr.type = end THEN EXIT;
offset ← newOffset;
ENDLOOP
};
Close:
PUBLIC
PROCEDURE [handle: Handle] = {
vm: VM.Interval ~ handle.vm;
handle.vm ← VM.nullInterval;
handle.base ← NIL;
handle.length ← 0;
handle.names ← NIL;
TRUSTED {VM.Free[vm]};
};
FirstFont:
PUBLIC PROCEDURE [handle: Handle]
RETURNS [font: Font] = {
visitFontProc: VisitFontProc = {quit ← TRUE};
font ← EnumerateDirectory[handle, visitFontProc];
};
ListFonts:
PUBLIC PROCEDURE [handle: Handle]
RETURNS [fonts:
LIST
OF Font] = {
visitProc: VisitProc = {
SELECT p.hdr.type
FROM
splines, chars, widths => {
fontInfoRec: FontInfoRec;
GetFontInfo[handle, p, @fontInfoRec];
fonts ← CONS[MakeFont[handle, fontInfoRec, p], fonts];
};
ENDCASE;
};
fonts ← NIL;
EnumerateIndex[handle, visitProc];
};
EnumerateDirectory:
PUBLIC
PROCEDURE [handle: Handle, visitFontProc: VisitFontProc]
RETURNS [font: Font] = {
visitProc: VisitProc = {
SELECT p.hdr.type
FROM
splines, chars, widths => {
fontInfoRec: FontInfoRec;
GetFontInfo[handle, p, @fontInfoRec];
quit ← visitFontProc[fontInfoRec];
IF quit THEN font ← MakeFont[handle, fontInfoRec, p];
};
ENDCASE;
};
EnumerateIndex[handle, visitProc];
};
GetFontInfo:
PROCEDURE [handle: Handle, raw:
LONG
POINTER, fontInfoRec:
LONG
POINTER
TO FontInfoRec] = {
-- The call by reference is to avoid a long REF-containing return record.
p: LONG POINTER TO chars F.RawIndex ← raw;
fontInfoRec.family ← NameFromCode[handle, p.family];
fontInfoRec.face ← p.face;
fontInfoRec.bc ← p.bc;
fontInfoRec.ec ← p.ec;
fontInfoRec.size ← p.size/100000.0;
fontInfoRec.rotation ← p.rotation/60.0;
fontInfoRec.representation ←
SELECT p.hdr.type
FROM
splines => outline,
chars => raster,
widths => widthsOnly,
ENDCASE => ERROR;
IF p.hdr.type # chars THEN {fontInfoRec.xRes ← fontInfoRec.yRes ← 0}
ELSE {
fontInfoRec.xRes ← p.resolutionx/10.0;
fontInfoRec.yRes ← p.resolutiony/10.0;
}
};
MakeFont:
PROCEDURE [handle: Handle, info: FontInfoRec, raw:
LONG
POINTER]
RETURNS [font:
REF FontRec] = {
font ← NEW[FontRec];
font.info ← info;
font.pressFontFile ← handle;
SELECT info.representation
FROM
raster => {p:
REF raster FontPrivateRec ←
NEW[raster FontPrivateRec];
r: LONG POINTER TO chars F.RawIndex ← raw;
nChars: NAT ← info.ec - info.bc + 1;
dataOffset, dirOffset, rasterOffset: LONG CARDINAL;
IF r.hdr.type # chars THEN ERROR Error[cantHappen, raw-handle.base];
p.indexEntry ← r;
p.base ← handle.base;
dataOffset ← F.LongCardinalFromBcplLongPointer[r.startaddress];
dirOffset ← dataOffset + nChars*SIZE[F.BoundingBox];
rasterOffset ← dirOffset + nChars*SIZE[F.bcplLONGPOINTER];
IF rasterOffset - dataOffset > F.BcplToMesaLongCardinal[r.length]
THEN
ERROR Error[dataSegmentTooLong, dataOffset];
p.rasterStart ← rasterOffset;
p.rasterEnd ← dataOffset + F.BcplToMesaLongCardinal[r.length];
p.dataDesc ← DESCRIPTOR[p.base+dataOffset, nChars];
p.dirDesc ← DESCRIPTOR[p.base+dirOffset, nChars];
font.private ← p};
outline => {p:
REF outline FontPrivateRec ←
NEW[outline FontPrivateRec];
r: LONG POINTER TO splines F.RawIndex ← raw;
nChars: NAT ← info.ec - info.bc + 1;
dataOffset, dirOffset, commandOffset: LONG CARDINAL;
IF r.hdr.type # splines THEN ERROR Error[cantHappen, raw-handle.base];
p.indexEntry ← r;
p.base ← handle.base;
dataOffset ← F.LongCardinalFromBcplLongPointer[r.startaddress];
dirOffset ← dataOffset + nChars*SIZE[F.BcplSplineData];
commandOffset ← dirOffset + nChars*SIZE[F.bcplLONGPOINTER];
IF commandOffset - dataOffset > F.BcplToMesaLongCardinal[r.length]
THEN
ERROR Error[dataSegmentTooLong, dataOffset];
p.commandStart ← commandOffset;
p.commandEnd ← dataOffset + F.BcplToMesaLongCardinal[r.length];
p.dataDesc ← DESCRIPTOR[p.base+dataOffset, nChars];
p.dirDesc ← DESCRIPTOR[p.base+dirOffset, nChars];
font.private ← p};
widthsOnly => {p:
REF widthsOnly FontPrivateRec ←
NEW[widthsOnly FontPrivateRec];
r: LONG POINTER TO widths F.RawIndex ← raw;
nChars: NAT ← info.ec - info.bc + 1;
segOffset, xWidthOffset, yWidthOffset: LONG CARDINAL;
nx, ny: NAT;
IF r.hdr.type # widths THEN ERROR Error[cantHappen, raw-handle.base];
p.indexEntry ← r;
p.base ← handle.base;
segOffset ← F.LongCardinalFromBcplLongPointer[r.startaddress];
p.widthSeg ← p.base + segOffset;
nx ← IF p.widthSeg.XWidthFixed THEN 1 ELSE nChars;
ny ← IF p.widthSeg.YWidthFixed THEN 1 ELSE nChars;
xWidthOffset ← segOffset + SIZE[F.BcplWidthSegment];
p.xWidthDesc ← DESCRIPTOR[p.base+xWidthOffset, nx];
yWidthOffset ← xWidthOffset + nx;
p.yWidthDesc ← DESCRIPTOR[p.base+yWidthOffset, ny];
IF yWidthOffset + ny - segOffset # F.BcplToMesaLongCardinal[r.length]
THEN
ERROR Error [consistencyCheck, raw-handle.base];
font.private ← p};
ENDCASE => ERROR;
};
GetCharInfo:
PUBLIC
PROCEDURE [font: Font, char:
CHAR]
RETURNS [info: CharInfo] = {
private: REF FontPrivateRec ← font.private;
handle: Handle ← font.pressFontFile;
IF private.base # handle.base THEN ERROR Error[fileHasBeenClosed, 0];
WITH priv: private
SELECT
FROM
raster => {
IF priv.indexEntry.hdr.type # chars THEN ERROR Error[cantHappen, 0];
IF (NOT char IN [font.info.bc..font.info.ec]) THEN RETURN[[0,0,0,0,0,0]]
ELSE {
data: F.BoundingBox ← priv.dataDesc[char-font.info.bc];
xscale: REAL ← 0.0254/(font.info.xRes*font.info.size);
yscale: REAL ← 0.0254/(font.info.yRes*font.info.size);
IF data.BBdy = LAST[CARDINAL] THEN RETURN[[0,0,0,0,0,0]];
info.widthX ← BcplFractionToMesaReal[data.xwidth]*xscale;
info.widthY ← BcplFractionToMesaReal[data.ywidth]*yscale;
info.minX ← data.BBox*xscale;
info.minY ← data.BBoy*yscale;
info.maxX ← data.BBdx*xscale + info.minX;
info.maxY ← data.BBdy*yscale + info.minY;
};
};
outline => {
IF priv.indexEntry.hdr.type # splines THEN ERROR Error[cantHappen, 0];
IF (NOT char IN [font.info.bc..font.info.ec])
OR priv.dataDesc[char-font.info.bc].xwidth = F.missingCharValue THEN RETURN[[0,0,0,0,0,0]]
ELSE {
data: F.BcplSplineData ← priv.dataDesc[char-font.info.bc];
info.widthX ← BcplToMesaReal[data.xwidth];
info.widthY ← BcplToMesaReal[data.ywidth];
info.minX ← BcplToMesaReal[data.bbox];
info.minY ← BcplToMesaReal[data.bboy];
info.maxX ← BcplToMesaReal[data.rightx];
info.maxY ← BcplToMesaReal[data.topy];
};
};
widthsOnly => {
IF priv.indexEntry.hdr.type # widths THEN ERROR Error[cantHappen, 0];
IF (NOT char IN [font.info.bc..font.info.ec]) THEN RETURN[[0,0,0,0,0,0]]
ELSE {
data: F.BcplWidthSegment ← priv.widthSeg^;
scale: REAL ← IF font.info.size = 0.0 THEN 0.001 ELSE 100000.0/font.info.size;
wx: INTEGER ← priv.xWidthDesc[IF data.XWidthFixed THEN 0 ELSE char-font.info.bc];
wy: INTEGER ← priv.yWidthDesc[IF data.YWidthFixed THEN 0 ELSE char-font.info.bc];
IF wx = FIRST[INTEGER] OR wy = FIRST[INTEGER] THEN RETURN[[0,0,0,0,0,0]];
info.widthX ← wx*scale;
info.widthY ← wy*scale;
info.minX ← data.FBBox*scale;
info.minY ← data.FBBoy*scale;
info.maxX ← data.FBBdx*scale + info.minX;
info.maxY ← data.FBBdy*scale + info.minY;
};
};
ENDCASE => ERROR;
};
DrawChar:
PUBLIC
PROCEDURE [context: Graphics.Context, font: Font, char:
CHAR] = {
mark: Graphics.Mark ← Graphics.Save[context];
scalex: REAL ← IF font.info.size = 0.0 THEN 1.0 ELSE 0.0254/(font.info.size*font.info.xRes);
scaley: REAL ← IF font.info.size = 0.0 THEN 1.0 ELSE 0.0254/(font.info.size*font.info.yRes);
xRef, yRef: REAL;
charInfo: CharInfo ← GetCharInfo[font, char];
[xRef, yRef] ← Graphics.GetCP[context];
Graphics.Scale[context, scalex, scaley];
SELECT font.info.representation
FROM
raster => {
DrawCharRaster[context, font, char];
};
outline => {
Graphics.Translate[context, xRef, yRef];
Graphics.DrawArea[self: context, path: GetCharPath[font, char], parityFill: TRUE];
};
ENDCASE;
Graphics.Restore[context, mark];
Graphics.SetCP[context, xRef+charInfo.widthX, yRef+charInfo.widthY];
};
DrawCharRaster:
PUBLIC
PROCEDURE [context: Graphics.Context, font: Font, char:
CHAR] = {
handle: Handle ← font.pressFontFile;
private: REF FontPrivateRec ← font.private;
WITH priv: private
SELECT
FROM
raster =>
BEGIN
IF priv.base # handle.base THEN ERROR Error[fileHasBeenClosed, 0];
IF priv.indexEntry.hdr.type # chars THEN ERROR Error[cantHappen, 0];
IF (NOT char IN [font.info.bc..font.info.ec]) THEN RETURN
ELSE {
mark: Graphics.Mark;
data: F.BoundingBox ← priv.dataDesc[char-font.info.bc];
offset: LONG CARDINAL ← F.LongCardinalFromBcplLongPointer[priv.dirDesc[char-font.info.bc]];
rawRasterPointer: LONG POINTER ← BASE[priv.dirDesc] + offset;
r: F.RasterPointer ← rawRasterPointer;
rawRasterPointer ← rawRasterPointer + SIZE[F.RasterDimension];
IF data.BBdy = LAST[CARDINAL] THEN RETURN;
IF offset = LAST[LONG CARDINAL] THEN RETURN;
IF (rawRasterPointer-priv.base) < priv.rasterStart
OR (rawRasterPointer-priv.base) >= priv.rasterEnd THEN
ERROR Error[invalidPointerInFile, @(priv.dirDesc[char-font.info.bc]) - priv.base];
Graphics.SetCP[self: context, x: data.BBox, y: data.BBoy, rel: TRUE];
mark ← Graphics.Save[context];
Graphics.Rotate[context, 90];
CGPrivate.DrawBits[
self: context,
base: rawRasterPointer,
raster: r.height,
bitsPerPixel: 0,
x: 0, y: 0,
w: data.BBdy, h: data.BBdx,
xorigin:0, yorigin: 0
];
Graphics.Restore[context, mark];
Graphics.SetCP[self: context,
x: BcplFractionToMesaReal[data.xwidth] - data.BBox,
y: BcplFractionToMesaReal[data.ywidth] - data.BBoy,
rel: TRUE];
};
END;
ENDCASE => ERROR Error[wrongFontFormatForThisOperation, 0]
};
BcplToMesaReal:
PROCEDURE [b:
F.BcplREAL]
RETURNS [r:
REAL] = {
r ← RealConvert.BcplToIeee[LOOPHOLE[b]]
};
BcplFractionToMesaReal:
PROCEDURE [f:
F.bcplFraction]
RETURNS [r:
REAL] = {
r ← F.BcplToMesaFraction[f]/(LAST[CARDINAL]+1.0);
};
GetCharOutline:
PUBLIC
PROCEDURE [
font: Font,
char: CHAR, moveToProc: MoveToProc,
lineToProc: LineToProc,
curveToProc: CurveToProc,
drawAreaProc: DrawAreaProc
] = {
p: LONG POINTER;
handle: Handle ← font.pressFontFile;
curX, curY: REAL ← 0.0;
private: REF FontPrivateRec ← font.private;
WITH spline: private
SELECT
FROM
outline =>
BEGIN
IF spline.base # handle.base THEN ERROR Error[fileHasBeenClosed, 0];
IF spline.indexEntry.hdr.type # splines THEN ERROR Error[cantHappen, 0];
IF NOT char IN [font.info.bc..font.info.ec] THEN RETURN;
IF spline.dataDesc[char-font.info.bc].xwidth = F.missingCharValue THEN RETURN;
p ← BASE[spline.dirDesc] + F.LongCardinalFromBcplLongPointer[spline.dirDesc[char-font.info.bc]];
DO splineCommand:
LONG
POINTER
TO
F.BcplSplineCommand ← p;
IF (p-spline.base) < spline.commandStart
OR (p-spline.base) >= spline.commandEnd THEN
ERROR Error[invalidPointerInFile, @(spline.dirDesc[char-font.info.bc])-spline.base];
SELECT splineCommand.type
FROM
F.moveToCode => {cmd:
LONG
POINTER
TO MoveTo
F.BcplSplineCommand ← p;
moveToProc[curX ← BcplToMesaReal[cmd.x], curY ← BcplToMesaReal[cmd.y]];
p ← p + SIZE[MoveTo F.BcplSplineCommand];
};
F.drawToCode => {cmd:
LONG
POINTER
TO DrawTo
F.BcplSplineCommand ← p;
lineToProc[curX ← BcplToMesaReal[cmd.x], curY ← BcplToMesaReal[cmd.y]];
p ← p + SIZE[DrawTo F.BcplSplineCommand];
};
F.drawCurveCode => {cmd:
LONG
POINTER
TO DrawCurve
F.BcplSplineCommand ← p;
b: Bezier ← CoeffsToBezier[[
[curX, curY],
[BcplToMesaReal[cmd.x0], BcplToMesaReal[cmd.y0]],
[BcplToMesaReal[cmd.x1], BcplToMesaReal[cmd.y1]],
[BcplToMesaReal[cmd.x2], BcplToMesaReal[cmd.y2]]
]];
[curX, curY] ← b.b3;
curveToProc[b.b1.x, b.b1.y, b.b2.x, b.b2.y, b.b3.x, b.b3.y];
p ← p + SIZE[DrawCurve F.BcplSplineCommand];
};
F.newObjectCode => {
drawAreaProc[];
p ← p + SIZE[NewObject F.BcplSplineCommand];
};
F.endSplineCode => {
drawAreaProc[];
EXIT
};
ENDCASE => ERROR Error[invalidCodeInFile, p-spline.base];
ENDLOOP
END;
ENDCASE => ERROR Error[wrongFontFormatForThisOperation, 0]
};
GetCharPath:
PUBLIC PROCEDURE [font: Font, char:
CHAR]
RETURNS [path: Graphics.Path] = {
moveToProc: PressFontReader.MoveToProc = {Graphics.MoveTo[path, x, y, FALSE]};
lineToProc: PressFontReader.LineToProc = {Graphics.LineTo[path, x, y]};
curveToProc: PressFontReader.CurveToProc = {Graphics.CurveTo[path, x1, y1, x2, y2, x3, y3]};
drawAreaProc: PressFontReader.DrawAreaProc = {};
path ← Graphics.NewPath[];
GetCharOutline[font, char, moveToProc, lineToProc, curveToProc, drawAreaProc];
};
-- Routines for converting to bezier points.
Vec: TYPE = RECORD [x,y: REAL];
VecAdd: PROCEDURE [a: Vec, b: Vec] RETURNS [Vec] = INLINE {RETURN[[a.x+b.x,a.y+b.y]]};
VecSub: PROCEDURE [a: Vec, b: Vec] RETURNS [Vec] = INLINE {RETURN[[a.x-b.x,a.y-b.y]]};
VecDiv: PROCEDURE [a: Vec, s: REAL] RETURNS [Vec] = INLINE {RETURN[[a.x/s,a.y/s]]};
Coeffs: TYPE = RECORD[c0,c1,c2,c3: Vec];
Bezier: TYPE = RECORD[b0,b1,b2,b3: Vec];
CoeffsToBezier:
PROCEDURE [c: Coeffs]
RETURNS [b: Bezier] = {
OPEN b,c;
b0�
b1←VecAdd[c0,VecDiv[c1,3]];
b2←VecAdd[b1,VecDiv[VecAdd[c1,c2],3]];
b3←VecAdd[VecAdd[VecAdd[c0,c1],c2],c3];
};
-- Stuff to help in debugging;
SplineBase:
PROCEDURE [d:
LONG
DESCRIPTOR
FOR
ARRAY
OF
F.BcplSplineData]
RETURNS [p:
LONG
POINTER] = {
p ← BASE[d];
};
DirBase:
PROCEDURE [d:
LONG
DESCRIPTOR
FOR
ARRAY
OF
F.bcplLONGPOINTER]
RETURNS [p:
LONG
POINTER] = {
p ← BASE[d];
};
splineDataPointer: LONG POINTER TO F.BcplSplineData;
bcplPtrPointer: LONG POINTER TO F.bcplLONGPOINTER;
moveToPointer: LONG POINTER TO MoveTo F.BcplSplineCommand;
drawCurvePointer: LONG POINTER TO DrawCurve F.BcplSplineCommand;
splineDataPointer ← NIL;
bcplPtrPointer ← NIL;
moveToPointer ← NIL;
drawCurvePointer ← NIL;
END.