-- AltoFontImpl.mesa
-- Last changed by Doug Wyatt, September 22, 1980 5:36 PM

DIRECTORY
AltoFont,
Font USING [Id, Weight, Slope, EncodeFam, EncodeFace],
Strike USING [Header, Format, Body, KernedStrike, PlainStrike,
BoundingBoxBlock, WidthEntry, nullWidthEntry],
Memory USING [NewZone],
AltoFileDefs USING [FP],
DirectoryDefs USING [EnumerateDirectory],
SegmentDefs USING [FileSegmentHandle, FileHandle, NewFile, InsertFile,
Read, OldFileOnly, NewFileSegment, DefaultBase, DefaultPages,
SwapIn, --Unlock, --FileSegmentAddress],
StringDefs USING [AppendChar, EquivalentString];

AltoFontImpl: PROGRAM
IMPORTS Memory,Font,DirectoryDefs,SegmentDefs,StringDefs
EXPORTS AltoFont SHARES AltoFont = {
OPEN AltoFont;

zone: UNCOUNTED ZONE = Memory.NewZone["AltoFontImpl"];

AltoFontError: PUBLIC SIGNAL = CODE;

FP: TYPE = AltoFileDefs.FP;
FileSegmentHandle: TYPE = SegmentDefs.FileSegmentHandle;

Node: TYPE = RECORD [
link: NodeRef,
id: Font.Id,
size: CARDINAL,
fp: FP,
seg: FileSegmentHandle
];
NodeRef: TYPE = LONG POINTER TO Node;

fontlist: NodeRef←NIL;

ParseFileName: PROCEDURE[file,name,ext: STRING] = {
part: {namepart,extpart}←namepart;
i: CARDINAL←0;
name.length←ext.length←0;
WHILE i<(file.length-1) DO -- ignore final dot
c: CHARACTER←file[i]; i←i+1;
SELECT part FROM
namepart => {
IF c=’. THEN part←extpart
ELSE StringDefs.AppendChar[name,c];
};
extpart => {
IF c=’! THEN EXIT -- strip version number
ELSE StringDefs.AppendChar[ext,c];
};
ENDCASE;
ENDLOOP;
};

ParseFontName: PROCEDURE[name: STRING]
RETURNS[id: Font.Id, size: CARDINAL] = {
family: STRING←[30];
ptsize: CARDINAL←0;
weight: Font.Weight←medium;
slope: Font.Slope←regular;
part: {fampart,sizepart,facepart}←fampart;
i: CARDINAL←0;
WHILE i<name.length DO
c: CHARACTER←name[i]; i←i+1;
SELECT part FROM
fampart => {
IF c IN[’0..’9] THEN { part←sizepart; i←i-1 }
ELSE StringDefs.AppendChar[family,c];
};
sizepart => {
IF c ~IN[’0..’9] THEN { part←facepart; i←i-1 }
ELSE ptsize←10*ptsize+(c-’0);
};
facepart => {
SELECT c FROM
’B,’b => weight←bold;
’I,’i => slope←italic;
ENDCASE;
};
ENDCASE;
ENDLOOP;
RETURN[
id: [
fam: Font.EncodeFam[family],
face: Font.EncodeFace[w: weight, s: slope]
],
size: ptsize
];
};

ReadFonts: PROC = {
AddFont: PROC[fp: POINTER TO FP, file: STRING] RETURNS[BOOLEAN] = {
name: STRING ← [50];
ext: STRING ← [50];
ParseFileName[file,name,ext];
IF StringDefs.EquivalentString[ext,"ks"]
OR StringDefs.EquivalentString[ext,"strike"] THEN {
n: NodeRef=zone.NEW[Node ← [link: NIL, id: , size: ,
fp: fp↑, seg: NIL]];
[id: n.id, size: n.size]←ParseFontName[name];
n.link←fontlist; fontlist←n;
};
RETURN[FALSE];
};
DirectoryDefs.EnumerateDirectory[AddFont];
};

Data: PUBLIC TYPE = RECORD [
GetCharInfo: CharInfoProc,
min,max: CARDINAL, -- min and max character codes
fbb: BBox, -- font bounding box
xtable: LONG POINTER TO ARRAY[0..0) OF CARDINAL,
wtable: LONG POINTER TO ARRAY[0..0) OF Strike.WidthEntry,
bitmap: LONG POINTER,
raster: CARDINAL,
seg: FileSegmentHandle
];
DataRef: TYPE = LONG POINTER TO Data;

procs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
Character: CCharacter,
CharBox: CCharBox,
StringBox: CStringBox,
FontBox: CFontBox,
Free: CFree
]];

New: PUBLIC PROC[id: Font.Id, size: CARDINAL] RETURNS[Handle] = {
FOR n: NodeRef←fontlist,n.link UNTIL n=NIL DO
IF n.id=id AND n.size=size THEN {
IF n.seg=NIL THEN n.seg←SegFromFP[n.fp];
RETURN[Create[n.seg]];
};
ENDLOOP;
RETURN[NIL];
};

defaultSeg: FileSegmentHandle ← SegFromName["MesaFont.strike"];

Default: PUBLIC PROC RETURNS[Handle] = {
RETURN[Create[defaultSeg]];
};

Create: PROC[seg: FileSegmentHandle] RETURNS[Handle] = {
RETURN[zone.NEW[Object ← [procs: procs, data: NewData[seg]]]];
};

SegFromName: PROC[name: STRING] RETURNS[FileSegmentHandle] = {
OPEN SegmentDefs;
fh: FileHandle=NewFile[name: name, access: Read, version: OldFileOnly];
seg: FileSegmentHandle←NewFileSegment[file: fh,
base: DefaultBase, pages: DefaultPages, access: Read];
SegmentDefs.SwapIn[seg]; -- stays swapped in, for now
RETURN[seg];
};

SegFromFP: PROC[fp: FP] RETURNS[FileSegmentHandle] = {
OPEN SegmentDefs;
fh: FileHandle=InsertFile[fp: @fp, access: Read];
seg: FileSegmentHandle←NewFileSegment[file: fh,
base: DefaultBase, pages: DefaultPages, access: Read];
SegmentDefs.SwapIn[seg]; -- stays swapped in, for now
RETURN[seg];
};

NewData: PROC[seg: FileSegmentHandle] RETURNS[DataRef] = {
p: LONG POINTER=SegmentDefs.FileSegmentAddress[seg];
f: LONG POINTER TO Strike.Header=p;
format: Strike.Format=f.format;
raster,height: CARDINAL;
bitmap: LONG POINTER←NIL;
IF NOT(format.oneBit=Yes AND format.index=No) THEN {
SIGNAL AltoFontError; RETURN[NIL]
};
IF format.kerned=Yes THEN {
ks: LONG POINTER TO Strike.KernedStrike=p;
box: Strike.BoundingBoxBlock=ks.box;
body: LONG POINTER TO Strike.Body=@ks.body;
raster←body.raster;
height←body.ascent+body.descent;
bitmap←body+SIZE[Strike.Body];
IF box.fbbdy#height THEN SIGNAL AltoFontError;
RETURN[zone.NEW[Data ← [
GetCharInfo: KSCharInfo,
min: f.min, max: f.max,
fbb: [
dx: box.fbbdx, dy: box.fbbdy,
ox: box.fbbox, oy: box.fbboy,
wx: f.maxwidth, wy: 0
],
xtable: LOOPHOLE[bitmap+raster*height],
wtable: LOOPHOLE[body+body.length],
bitmap: bitmap, raster: raster,
seg: seg
]]];
}
ELSE {
s: LONG POINTER TO Strike.PlainStrike=p;
body: LONG POINTER TO Strike.Body=@s.body;
raster←body.raster;
height←body.ascent+body.descent;
bitmap←body+SIZE[Strike.Body];
RETURN[zone.NEW[Data ← [
GetCharInfo: StrikeCharInfo,
min: f.min, max: f.max,
fbb: [
dx: f.maxwidth, dy: height,
ox: 0, oy: -body.descent,
wx: f.maxwidth, wy: 0
],
xtable: LOOPHOLE[bitmap+raster*height],
wtable: NIL,
bitmap: bitmap, raster: raster,
seg: seg
]]];
};
};

-- Operations for Kerned Strike fonts

CharInfo: TYPE = RECORD [
lx: CARDINAL, -- left x in bitmap
dx: CARDINAL, -- bounding box width
ox: INTEGER, -- bounding box x offset
wx: CARDINAL -- spacing width
];

CharInfoProc: TYPE = PROC[d: DataRef, c: CHARACTER,
info: POINTER TO CharInfo];

StrikeCharInfo: PROC[d: DataRef, c: CHARACTER,
info: POINTER TO CharInfo] = {
i: CARDINAL←LOOPHOLE[c];
min: CARDINAL=d.min;
max: CARDINAL=d.max;
xl,xr: CARDINAL←0;
IF i IN[min..max] THEN { i←i-min; xl←d.xtable[i]; xr←d.xtable[i+1] };
IF xl=xr THEN { i←(max+1)-min; xl←d.xtable[i]; xr←d.xtable[i+1] };
info↑ ← [
lx: xl,
dx: xr-xl,
ox: 0,
wx: xr-xl
];
};

KSCharInfo: PROC[d: DataRef, c: CHARACTER,
info: POINTER TO CharInfo] = {
i: CARDINAL←LOOPHOLE[c];
missing: Strike.WidthEntry=Strike.nullWidthEntry;
w: Strike.WidthEntry←missing;
min: CARDINAL=d.min;
max: CARDINAL=d.max;
xl,xr: CARDINAL;
IF i IN[min..max] THEN { i←i-min; w←d.wtable[i] };
IF w=missing THEN { i←(max+1)-min; w←d.wtable[i] };
xl←d.xtable[i]; xr←d.xtable[i+1];
info↑ ← [
lx: xl,
dx: xr-xl,
ox: d.fbb.ox+w.offset,
wx: w.width
];
};

CCharacter: PROC[self: Handle, c: CHARACTER,
bbox: POINTER TO BBox, rast: POINTER TO Rast] = {
d: DataRef=self.data;
dy: CARDINAL=d.fbb.dy;
oy: INTEGER=-(dy+d.fbb.oy); -- distance from origin to smallest y!
char: CharInfo;
d.GetCharInfo[d,c,@char];
bbox↑ ← [
dx: char.dx, dy: dy,
ox: char.ox, oy: oy,
wx: char.wx, wy: 0
];
rast↑ ← [
bca: d.bitmap, bmr: d.raster,
x0: char.lx-char.ox, y0: 0-oy
];
};

CCharBox: PROC[self: Handle, c: CHARACTER,
bbox: POINTER TO BBox] = {
d: DataRef=self.data;
char: CharInfo;
d.GetCharInfo[d,c,@char];
bbox↑ ← [
dx: char.dx, dy: d.fbb.dy,
ox: char.ox, oy: d.fbb.oy,
wx: char.wx, wy: 0
];
};

CStringBox: PROC[self: Handle, s: LONG STRING,
bbox: POINTER TO BBox] = {
d: DataRef=self.data;
xmin,xmax,x: INTEGER←0;
FOR j: CARDINAL IN[0..s.length) DO
char: CharInfo;
d.GetCharInfo[d,s[j],@char];
{
xl: INTEGER←x+char.ox; xr: INTEGER←xl+char.dx;
IF xl<xmin THEN xmin←xl; IF xr>xmax THEN xmax←xr;
};
x←x+char.wx;
ENDLOOP;
bbox↑←[
dx: xmax-xmin, dy: d.fbb.dy,
ox: xmin, oy: d.fbb.oy,
wx: x, wy: 0
];
};

CFontBox: PROC[self: Handle,
bbox: POINTER TO BBox] = {
d: DataRef=self.data;
bbox↑ ← d.fbb;
};

CFree: PUBLIC PROC[selfPtr: LONG POINTER TO Handle] = {
self: Handle←selfPtr↑;
d: DataRef←self.data;
selfPtr↑←NIL;
-- SegmentDefs.Unlock[d.seg];
zone.FREE[@d];
zone.FREE[@self];
};

-- initialization

ReadFonts[];

}.