-- Compiler Font/nb
-- Stone December 2, 1981  11:46 PM
-- Stone+Tiberi, February 7, 1980  11:40 AM
-- implementing module for griffin fonts

DIRECTORY
	GriffinMemoryDefs: FROM "GriffinMemoryDefs",
	StringDefs: FROM "StringDefs" USING [AppendString, EquivalentString, LowerCase],
	MiscDefs: FROM "MiscDefs" USING [Zero, SetBlock],
	AltoDefs: FROM "AltoDefs" USING [BytesPerPage],
	StyleDefs: FROM "StyleDefs",
	InlineDefs: FROM "InlineDefs"
		USING [BITOR, BITAND, LongMult, LongDiv,
		LongDivMod, LongNumber],
	GriffinFontDefs: FROM "GriffinFontDefs",
	IxDefs: FROM "IxDefs",
	GriffinFileDefs: FROM "GriffinFileDefs",
	AltoFileDefs: FROM "AltoFileDefs" USING [FA],
	DirectoryDefs: FROM "DirectoryDefs"
		USING [EnumerateDirectory],
	SegmentDefs: FROM "SegmentDefs"
		USING [FileNameError],
	ScreenDefs: FROM "ScreenDefs"
		USING [Bitmap, Block, BLTBlockInScreen, EraseBoxBW],
	PointDefs: FROM "PointDefs"
		USING [ScrPt, ObjPt, X, Y, ObjToScr, ScrToObj,
		ObjValToScrVal, ScrValToObjVal],
	Real: FROM "Real" USING [RoundI,RoundC],
	StreamDefs: FROM "StreamDefs"
		USING [NewWordStream, Read, Append, Write,
		DiskHandle, ReadBlock, WriteBlock, GetFA,
		JumpToFA, FileLength, CleanupDiskStream,
		TruncateDiskStream, CreateWordStream, StreamIndex,
		SetIndex];



Font:  PROGRAM
	IMPORTS GriffinMemoryDefs, StreamDefs, StringDefs,
	MiscDefs, InlineDefs, ScreenDefs, GriffinFileDefs,
	DirectoryDefs, PointDefs, Real, SegmentDefs
	EXPORTS GriffinFontDefs =
BEGIN OPEN GriffinFontDefs, InlineDefs; 

X: CARDINAL = PointDefs.X;
Y: CARDINAL = PointDefs.Y;


StrikeHeader: TYPE = MACHINE DEPENDENT RECORD
	[
	ignore1: [0 .. 4), fixed: BOOLEAN, ignore2: [0 .. 8192),
	minascii: CARDINAL,
	maxascii: CARDINAL,
	maxwidth: CARDINAL,
	length: CARDINAL, -- wrong
	ascent: CARDINAL,
	descent: CARDINAL,
	xoffset: CARDINAL,
	raster: CARDINAL
	];

lStrikeHeader: CARDINAL = SIZE [StrikeHeader];

indexSize: CARDINAL = 128;
nameSize: CARDINAL = 19;

fontVersion: CARDINAL = 6;
fontPassword: CARDINAL = 143000B + fontVersion;

GriffinFontHeader: TYPE = MACHINE DEPENDENT RECORD
	[
	rotation: CARDINAL, -- in degrees
	face: CARDINAL, -- face code as in Fonts.Widths
	points: CARDINAL,
	name: PACKED ARRAY [0 .. nameSize] OF CHARACTER,
	height: CARDINAL,  -- or width, if rotated
	maxwidth: CARDINAL,  -- or height, if rotated
	ascent: CARDINAL,
	raster: CARDINAL,
	bitmapwords: CARDINAL,
	offset: ARRAY [0 .. indexSize+2] OF CARDINAL,
	displaywidth: ARRAY [0 .. indexSize+2] OF CARDINAL,
	presswidth: ARRAY [0 .. indexSize+2] OF CARDINAL
	]; -- followed by bitmap

--Width philosophy: width and height routines return
--physical height and width, as used in BitBlt.  The width table
--contains the logical width of the character; i.e., for 90 degree
--rotation, it contains the physical height. 


lGriffinFontHeader: CARDINAL = SIZE [GriffinFontHeader];

GriffinFont: TYPE = RECORD
	[
	next: GriffinFontHandle,
	fd: FontDescriptor,
	fa: AltoFileDefs.FA
	];

lGriffinFont: CARDINAL = SIZE [GriffinFont];

GriffinFontHandle: TYPE = POINTER TO GriffinFont;

-- -----------------------------------------------------------------
FontError: PUBLIC SIGNAL = CODE;
StartupFontError: PUBLIC SIGNAL[type: ErrorType] = CODE;

-- -----------------------------------------------------------------
gFontHead, currentFont, lastFont: GriffinFontHandle _ NIL;

fontHeader: GriffinFontHeader;
bitMap: ScreenDefs.Bitmap _ [0, 0, 0, 0, NIL]; -- because it mustn't go away

gHandle: StreamDefs.DiskHandle _ StreamDefs.NewWordStream ["Griffin.Fonts",
	StreamDefs.Read + StreamDefs.Write + StreamDefs.Append];

fwHandle: StreamDefs.DiskHandle = StreamDefs.NewWordStream ["Fonts.Widths",
	StreamDefs.Read ! SegmentDefs.FileNameError => StartupFontError[nowidths]];

-- -----------------------------------------------------------------
DisplayString: PUBLIC PROCEDURE [string: STRING, screenpt: PointDefs.ScrPt, anchor: StyleDefs.Anchor, orientation: StyleDefs.Orientation, fd: FontDescriptorHandle] =
BEGIN
j: CARDINAL;
twiddle: REAL;
rotation: CARDINAL=fd.rotation;
bltpt: PointDefs.ObjPt;
char: CHARACTER;
block: ScreenDefs.Block;
height, width: CARDINAL;
aligned, vertical: BOOLEAN;
tl,br: PointDefs.ScrPt;

SetUpFont [fd];
block.bitmap _ @bitMap;
height _ StringHeight[string, fd, orientation];
width _ StringWidth[string, fd, orientation];
tl _ PointDefs.ObjToScr[TopLeft[PointDefs.ScrToObj[screenpt], height,
	width, anchor, orientation, fontHeader.rotation]];

bltpt _ PointDefs.ScrToObj[tl];
br _ [tl[X]+PointDefs.ObjValToScrVal[width]-1,
	tl[Y]+PointDefs.ObjValToScrVal[height]-1];
ScreenDefs.EraseBoxBW [tl, br];

vertical _ orientation = or90 OR orientation = or270;
aligned _ IF vertical
	THEN rotation = Rot0Degrees OR rotation = Rot180Degrees
	ELSE rotation = Rot90Degrees OR rotation = Rot270Degrees;
SELECT orientation FROM
or180 => bltpt[X] _ bltpt[X]+width;
or90 => bltpt[Y] _ bltpt[Y]-height;
ENDCASE;

FOR j IN [0 .. string.length)
	DO
	char _ string [j];
	block.h _ FDHeight [char];
	block.w _ FDWidth [char];
	block.ty _ 0;
	block.lx _ FLeft [char] ;
	twiddle _ IF vertical THEN (MaxWidth[fd] - FPWidth[char])/2
			ELSE (MaxHeight[fd] - FPHeight[char])/2;
	IF aligned THEN IF vertical
		THEN bltpt[X] _ bltpt[X] + twiddle
		ELSE bltpt[Y] _ bltpt[Y] - twiddle;
	SELECT orientation FROM
		or90 => bltpt[Y] _ bltpt[Y] + FPHeight[char];
		or180 => bltpt[X] _ bltpt[X] - FPWidth[char];
	ENDCASE;
	ScreenDefs.BLTBlockInScreen [@block,
		PointDefs.ObjToScr[bltpt], paint];
	SELECT orientation FROM
		or0 => bltpt[X] _ bltpt[X] + FPWidth[char];
		or270 => bltpt[Y] _ bltpt[Y] - FPHeight[char];
	ENDCASE;
	IF aligned THEN IF vertical
		THEN bltpt[X] _ bltpt[X] - twiddle
		ELSE bltpt[Y] _ bltpt[Y] + twiddle;
	ENDLOOP;
END;


-- -----------------------------------------------------------------
TopLeft: PUBLIC PROCEDURE [anchorPt: PointDefs.ObjPt,
		height, width: CARDINAL,
		anchor: StyleDefs.Anchor,
		orientation: StyleDefs.Orientation,
		rotation: CARDINAL]
	RETURNS [tl: PointDefs.ObjPt]=
BEGIN
vertical, aligned, reverse: BOOLEAN;
shift, amount: INTEGER;

tl _ anchorPt;
vertical _ orientation = or90 OR orientation = or270;
reverse _ orientation=or90 OR orientation=or180;
aligned _ IF vertical
	THEN rotation = Rot0Degrees OR rotation = Rot180Degrees
	ELSE rotation = Rot90Degrees OR rotation = Rot270Degrees;
amount _ IF vertical THEN height ELSE width;
shift _ SELECT anchor FROM
		right => IF reverse THEN 0 ELSE amount,
		left => IF reverse THEN amount ELSE 0,
		ENDCASE --center-- => amount/2;
IF vertical	--adjust for Anchor:
	THEN tl [Y] _ tl [Y] + shift
	ELSE tl [X] _ tl [X] - shift;

IF aligned THEN
-- here, if characters are rotated 90 degrees to the line, we must
-- center around the narrow amount
	BEGIN
	shift _ (IF vertical THEN width ELSE height)/2;
	IF vertical
		THEN tl [X] _ tl [X] - shift
		ELSE tl [Y] _ tl [Y] + shift;
	END;
END;

-- -----------------------------------------------------------------
BltChar: PUBLIC PROCEDURE [char: CHARACTER, tl: PointDefs.ScrPt,
	fd: FontDescriptorHandle]=
BEGIN
block: ScreenDefs.Block;

SetUpFont [fd];
block.bitmap _ @bitMap;
block.h _ FDHeight[char];
block.w _ FDWidth [char];
block.ty _ 0;
block.lx _ FLeft [char] ;
ScreenDefs.BLTBlockInScreen [@block, tl, replace];
END;

-- -----------------------------------------------------------------
Width: PUBLIC PROCEDURE [c: CHARACTER, fd: FontDescriptorHandle]
		RETURNS [CARDINAL] =
BEGIN
SetUpFont [fd];
RETURN [FPWidth [c]];
END;

-- -----------------------------------------------------------------
StringWidth: PUBLIC PROCEDURE [string: STRING, fd: FontDescriptorHandle, orientation: StyleDefs.Orientation]
		RETURNS [w: CARDINAL] =
BEGIN
j: CARDINAL;

SetUpFont [fd];
SELECT orientation FROM
or0, or180 =>
	BEGIN
	IF string=NIL THEN RETURN [0];
	w _ 0;
	FOR j IN [0 .. string.length)
		DO w _ w + FPWidth [string[j]] ENDLOOP;
	END;
or90, or270 => w _ MaxWidth[fd];
ENDCASE;
IF w#0 THEN w_w-1;
END;

-- -----------------------------------------------------------------
MaxWidth: PUBLIC PROCEDURE [fd: FontDescriptorHandle]
			RETURNS [CARDINAL] =
BEGIN
SetUpFont [fd];
RETURN [SELECT fontHeader.rotation FROM
	Rot0Degrees, Rot180Degrees =>
		Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.maxwidth]],
	ENDCASE => Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.height]]];
END;

-- -----------------------------------------------------------------
Height: PUBLIC PROCEDURE [c: CHARACTER, fd: FontDescriptorHandle] RETURNS [CARDINAL] =
BEGIN
SetUpFont [fd];
RETURN [FPHeight [c]];
END;

-- -----------------------------------------------------------------
StringHeight: PUBLIC PROCEDURE[string: STRING,
	fd:FontDescriptorHandle,
	orientation: StyleDefs.Orientation]
		RETURNS [h: CARDINAL] =
BEGIN
j: CARDINAL;

SetUpFont [fd];
SELECT orientation FROM
or0, or180 => h _ MaxHeight[fd];
or90, or270 =>
	BEGIN
	IF string=NIL THEN RETURN [0];
	h _ 0;
	FOR j IN [0 .. string.length)
		DO h _ h + FPHeight [string[j]] ENDLOOP;
	END;
ENDCASE;
IF h#0 THEN h_h-1;
END;

-- -----------------------------------------------------------------
MaxHeight: PUBLIC PROCEDURE [fd: FontDescriptorHandle]
			RETURNS [CARDINAL] =
BEGIN
SetUpFont [fd];
RETURN [SELECT fontHeader.rotation FROM
	Rot0Degrees, Rot180Degrees =>
		Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.height]],
	ENDCASE => Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.maxwidth]]];
END;

-- -----------------------------------------------------------------
FDWidth: PROCEDURE [char: CHARACTER] RETURNS [CARDINAL] = INLINE
BEGIN -- returns actual x dimension of char
rot: CARDINAL = fontHeader.rotation;
RETURN [IF rot = Rot0Degrees OR rot = Rot180Degrees
	THEN fontHeader.displaywidth[LOOPHOLE[char, CARDINAL]]
	ELSE fontHeader.height
	];
END;

-- -----------------------------------------------------------------
FDHeight: PROCEDURE [char: CHARACTER] RETURNS [CARDINAL] = INLINE
BEGIN -- returns actual y dimension of char for the display
rot: CARDINAL = fontHeader.rotation;
RETURN [IF rot = Rot0Degrees OR rot = Rot180Degrees
	THEN fontHeader.height
	ELSE fontHeader.displaywidth[LOOPHOLE[char,CARDINAL]]
	];
END;

-- -----------------------------------------------------------------
FPWidth: PROCEDURE [char: CHARACTER] RETURNS [CARDINAL] = INLINE
BEGIN -- returns actual x dimension of char
rot: CARDINAL = fontHeader.rotation;
RETURN [IF rot = Rot0Degrees OR rot = Rot180Degrees
	THEN fontHeader.presswidth[LOOPHOLE[char, CARDINAL]]
	ELSE Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.height]]
	];
END;

-- -----------------------------------------------------------------
FPHeight: PROCEDURE [char: CHARACTER] RETURNS [CARDINAL] = INLINE
BEGIN -- returns actual y dimension of char for the display
rot: CARDINAL = fontHeader.rotation;
RETURN [IF rot = Rot0Degrees OR rot = Rot180Degrees
	THEN Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.height]]
	ELSE fontHeader.presswidth[LOOPHOLE[char,CARDINAL]]
	];
END;

-- -----------------------------------------------------------------
BaseLine: PUBLIC PROCEDURE [fd: FontDescriptorHandle]
			RETURNS [CARDINAL] =
BEGIN
SetUpFont [fd];
RETURN [Real.RoundI[PointDefs.ScrValToObjVal[fontHeader.ascent]]];
END;

-- -----------------------------------------------------------------
FLeft: PROCEDURE [c: CHARACTER] RETURNS [CARDINAL] = INLINE
BEGIN
RETURN [fontHeader.offset [LOOPHOLE [c, CARDINAL]]];
END;

-- -----------------------------------------------------------------
ForAllFonts: PUBLIC PROCEDURE[do: PROCEDURE[font: FontDescriptorHandle]] = 
BEGIN
rover: GriffinFontHandle;
FOR rover _ gFontHead, rover.next UNTIL rover = NIL
	DO do[@rover.fd] ENDLOOP;
END;

-- -----------------------------------------------------------------
SetUpFont: PROCEDURE [fd: FontDescriptorHandle] =
BEGIN
OPEN GriffinMemoryDefs;
rover, precursor: GriffinFontHandle;
sameface, samerotation, faceprecursor: BOOLEAN;
rprecursor, fprecursor, rfprecursor: GriffinFontHandle _ NIL;
IF currentFont.fd.rotation = fd.rotation AND currentFont.fd.points = fd.points AND
	currentFont.fd.face= fd.face AND
	StringDefs.EquivalentString [currentFont.fd.name, fd.name]  THEN RETURN;
rover _ gFontHead;
WHILE rover # NIL DO
	IF NOT (StringDefs.EquivalentString [rover.fd.name, fd.name]
		AND rover.fd.points = fd.points)
		   THEN BEGIN rover _ rover.next; LOOP END;
	sameface _ rover.fd.face = fd.face;
	samerotation _ rover.fd.rotation = fd.rotation;
	faceprecursor _ rover.fd.face = 0 OR rover.fd.face = fd.face OR fd.face = 3;
	IF sameface AND samerotation THEN BEGIN
		currentFont _ rover; ReadGFont [currentFont]; EXIT END;
	IF sameface AND rover.fd.rotation = Rot0Degrees THEN rprecursor _ rover;
	IF samerotation AND faceprecursor THEN fprecursor _rover;
	IF faceprecursor THEN rfprecursor _ rover;
	rover _ rover.next;
REPEAT FINISHED => BEGIN
	precursor _ gFontHead;
	IF rfprecursor # NIL THEN precursor _ rfprecursor;
	IF fprecursor # NIL THEN precursor _ fprecursor;
	IF rprecursor # NIL THEN precursor _ rprecursor;
	IF precursor = NIL THEN SIGNAL FontError;
	ReadGFont [precursor];
	SELECT fd.rotation - fontHeader.rotation FROM
		Rot0Degrees => NULL;
		Rot90Degrees => BEGIN Rotate180D; Rotate90D END;
		Rot180Degrees => Rotate180D;
		Rot270Degrees => Rotate90D;
		ENDCASE => SIGNAL FontError;
	IF (fd.face = 2 OR fd.face = 3) AND
		(fontHeader.face # 2 AND fontHeader.face # 3) THEN Bolden;
	IF (fd.face = 1 OR fd.face =3) AND
		(fontHeader.face # 1 AND fontHeader.face # 3) THEN Italicize;
	AddGFont [fd];
	END;
	ENDLOOP;
END;



-- -----------------------------------------------------------------
ReadGFont: PROCEDURE [gfh: GriffinFontHandle] =
BEGIN
StreamDefs.JumpToFA [gHandle, @gfh.fa];
IF StreamDefs.ReadBlock [gHandle, @fontHeader, lGriffinFontHeader] #lGriffinFontHeader THEN
	SIGNAL FontError;
GriffinMemoryDefs.FreeSegment [bitMap.bits];
bitMap _ [0, fontHeader.raster, fontHeader.raster*16, fontHeader.height,
	GriffinMemoryDefs.AllocateSegment [fontHeader.bitmapwords]];
IF StreamDefs.ReadBlock [gHandle, bitMap.bits, fontHeader.bitmapwords] #
	fontHeader.bitmapwords THEN SIGNAL FontError;
END;


-- -----------------------------------------------------------------
AddGFont: PROCEDURE [fd: FontDescriptorHandle] =
BEGIN OPEN GriffinMemoryDefs;
[] _ StreamDefs.FileLength [gHandle];
IF gFontHead = NIL THEN gFontHead _ lastFont _ Allocate [lGriffinFont] ELSE
	lastFont _ lastFont.next _ Allocate [lGriffinFont];
currentFont _ lastFont;
currentFont.fd.rotation _ fd.rotation;
currentFont.fd.points _ fd.points;
currentFont.fd.face _ fd.face;
currentFont.fd.name _ AllocateString [fd.name.length];
currentFont.next _ NIL;
StringDefs.AppendString [currentFont.fd.name, fd.name];
StreamDefs.GetFA [gHandle, @currentFont.fa];
IF StreamDefs.WriteBlock [gHandle, @fontHeader, lGriffinFontHeader] # lGriffinFontHeader THEN SIGNAL FontError;
IF StreamDefs.WriteBlock [gHandle, bitMap.bits, fontHeader.bitmapwords] # fontHeader.bitmapwords THEN SIGNAL FontError;
StreamDefs.CleanupDiskStream [gHandle]
END;




-- -----------------------------------------------------------------
Rotate90D: PROCEDURE =
BEGIN
goodchars, newjindex, j, x, y, width, begin, end, oldraster: CARDINAL;
oldbitmap: POINTER;

SELECT fontHeader.rotation FROM
	Rot0Degrees => fontHeader.rotation _ Rot270Degrees;
	Rot180Degrees => fontHeader.rotation _ Rot90Degrees;
ENDCASE => FontError;
oldraster _ fontHeader.raster;
goodchars _ 0;
FOR j IN [0 .. indexSize + 1] DO
	IF fontHeader.offset [j+1] # fontHeader.offset [j] THEN goodchars _ goodchars + 1;
	ENDLOOP;
fontHeader.raster _ (goodchars*fontHeader.height+15)/16;
fontHeader.bitmapwords _ fontHeader.raster*fontHeader.maxwidth;
oldbitmap _ bitMap.bits;
bitMap _ [0, fontHeader.raster, fontHeader.raster*16, fontHeader.maxwidth,
	GriffinMemoryDefs.AllocateSegment [fontHeader.bitmapwords]];
MiscDefs.Zero [bitMap.bits, fontHeader.bitmapwords];
newjindex _ 0;
FOR j IN [0 .. indexSize]
	DO
	begin _ fontHeader.offset [j];
	end _ fontHeader.offset [j + 1];
	fontHeader.offset [j] _ newjindex;
	width _ end - begin;
	IF width = 0 THEN  LOOP; -- illegal character
	FOR x IN [0 .. width)
	   DO FOR y IN [0 .. fontHeader.height)
		DO
		IF IsOneBit [oldbitmap, x+begin, y, oldraster]
		THEN SetBit [bitMap.bits, newjindex+fontHeader.height-1-y, x, fontHeader.raster];
		ENDLOOP;
	   ENDLOOP; -- done with this character
	newjindex _ newjindex + fontHeader.height; -- end of the current character
	ENDLOOP; -- this is the end of the character loop
GriffinMemoryDefs.FreeSegment [oldbitmap];
END;

-- -----------------------------------------------------------------
Rotate180D: PROCEDURE =
BEGIN
j, x, y, width, begin, end: CARDINAL;
newbitmap: POINTER;

SELECT fontHeader.rotation FROM
	Rot0Degrees => fontHeader.rotation _ Rot180Degrees;
ENDCASE => FontError;
newbitmap _ GriffinMemoryDefs.AllocateSegment [fontHeader.bitmapwords];
MiscDefs.Zero [newbitmap, fontHeader.bitmapwords];
FOR j IN [0 .. indexSize]
	DO
	begin _ fontHeader.offset [j];
	end _ fontHeader.offset [j + 1];
	width _ end - begin;
	IF width  # 0
	   THEN FOR x IN [0 .. width)
		DO
		FOR y IN [0 .. fontHeader.height)
	  	   DO
		   IF IsOneBit [bitMap.bits, x+begin, y, fontHeader.raster]
			THEN SetBit [newbitmap, end-1-x, fontHeader.height-1-y, fontHeader.raster];
		   ENDLOOP;
		ENDLOOP; -- done with this character
	ENDLOOP; -- this is the end of the character loop
GriffinMemoryDefs.FreeSegment [bitMap.bits];
bitMap.bits _ newbitmap;
END;

oneBits: ARRAY [0 .. 15] OF WORD = [100000B, 40000B, 20000B, 10000B, 4000B, 2000B, 1000B,
	400B, 200B, 100B, 40B, 20B, 10B, 4B, 2B, 1B];


-- -----------------------------------------------------------------
SetBit: PROCEDURE [base: POINTER, x, y, raster: CARDINAL] = INLINE
BEGIN
WHILE x > 15 DO base _ base + 1; x _ x - 16; ENDLOOP;
WHILE y > 0 DO base _ base + raster; y _ y - 1; ENDLOOP;
base^ _ InlineDefs.BITOR [base^, oneBits [x]];
END;



-- -----------------------------------------------------------------
IsOneBit: PROCEDURE [base: POINTER, x, y, raster: CARDINAL] RETURNS [BOOLEAN] = INLINE
BEGIN
WHILE x > 15 DO base _ base + 1; x _ x - 16; ENDLOOP;
WHILE y > 0 DO base _ base + raster; y _ y - 1; ENDLOOP;
RETURN [InlineDefs.BITAND [base^, oneBits [x]] # 0];
END;

-- -----------------------------------------------------------------
Bolden, Italicize: PROCEDURE = BEGIN SIGNAL FontError END;

-- -----------------------------------------------------------------
ReadStrike: PUBLIC PROCEDURE [fp: POINTER, s: STRING]
	RETURNS [false: BOOLEAN] =
BEGIN
fonthandle: StreamDefs.DiskHandle;
strikeheader: StrikeHeader;
strikebits: POINTER;
rover: GriffinFontHandle _ gFontHead;
fd: FontDescriptor _ [NIL,0,0,0];
j, numoffsets, oldlen, newlen: CARDINAL;
false _ FALSE;
newlen _ GriffinFileDefs.IsTail[s, ".Strike."];
IF newlen = 0 THEN RETURN;
IF s [newlen-1] = 'I OR s[newlen-1] = 'iTHEN { fd.face _ fd.face + 1; newlen _ newlen - 1};
IF s [newlen-1] = 'B OR s[newlen-1] = 'b THEN { fd.face _ fd.face + 2; newlen _ newlen - 1};
IF s [newlen -1] IN ['0 .. '9] THEN
	{fd.points _ s [newlen-1] - '0; newlen _ newlen - 1};
IF s [newlen -1] IN ['0 .. '9] THEN 
	{fd.points _ fd.points + 10*(s [newlen-1]-'0); newlen _ newlen - 1};
oldlen _ s.length; -- strip junk off s for scan through prev fonts
s.length _ newlen;

--have we already stored this one?
UNTIL rover = NIL DO IF rover.fd.points = fd.points AND rover.fd.face = fd.face AND
	rover.fd.rotation = fd.rotation AND StringDefs.EquivalentString [rover.fd.name, s]
	THEN RETURN ELSE rover _ rover.next; ENDLOOP;

--is new to Griffin.fonts
fd.name _ GriffinMemoryDefs.AllocateString [newlen];
StringDefs.AppendString [fd.name, s];

--now check if it is in Fonts.widths and RETURN if not
IF ~ReadHWidths [@fd] THEN {GriffinMemoryDefs.FreeString[fd.name]; RETURN};

--is a good font, put it in
s.length _ oldlen; -- restore s
fonthandle _ StreamDefs.NewWordStream [s, StreamDefs.Read ];
IF StreamDefs.ReadBlock [fonthandle, @strikeheader, lStrikeHeader] # lStrikeHeader
	THEN SIGNAL FontError;
fontHeader.height _ strikeheader.ascent + strikeheader.descent;
fontHeader.ascent _ strikeheader.ascent;
fontHeader.raster _ strikeheader.raster;
fontHeader.bitmapwords _ fontHeader.raster*fontHeader.height;
fontHeader.rotation _ fd.rotation;
fontHeader.face _ fd.face;
fontHeader.points _ fd.points;
fontHeader.maxwidth _ strikeheader.maxwidth;
fd.name.length _ MIN [nameSize, fd.name.length];
fontHeader.name [0] _ LOOPHOLE [fd.name.length, CHARACTER];
FOR j IN [0 .. fd.name.length) DO fontHeader.name [j+1] _ fd.name [j]; ENDLOOP;
strikebits _ GriffinMemoryDefs.AllocateSegment [fontHeader.bitmapwords];
IF StreamDefs.ReadBlock [fonthandle, strikebits, fontHeader.bitmapwords] # fontHeader.bitmapwords THEN SIGNAL FontError;
MiscDefs.Zero [@fontHeader.offset, indexSize+2];
MiscDefs.Zero [@fontHeader.displaywidth, indexSize+2];
numoffsets _ strikeheader.maxascii+3 - strikeheader.minascii;
IF StreamDefs.ReadBlock [fonthandle, @fontHeader.offset + strikeheader.minascii, numoffsets]
	# numoffsets THEN SIGNAL FontError;
FOR j IN [strikeheader.minascii+numoffsets .. indexSize+2)
	DO
	fontHeader.offset [j] _ fontHeader.offset [strikeheader.minascii + numoffsets - 1];
	ENDLOOP;
FOR j IN [strikeheader.minascii .. MIN[indexSize+1,strikeheader.maxascii+1]]
	DO
	fontHeader.displaywidth[j] _
		fontHeader.offset[j+1] - fontHeader.offset[j];
	ENDLOOP;
fonthandle.destroy [fonthandle];
GriffinMemoryDefs.FreeSegment [bitMap.bits];
bitMap _ [0, fontHeader.raster, fontHeader.raster*16, fontHeader.height, strikebits];
AddGFont [@fd];
END;

-- -----------------------------------------------------------------
ReadHWidths: PROCEDURE [fd: FontDescriptorHandle]  RETURNS [BOOLEAN]=
BEGIN OPEN IxDefs;
j: CARDINAL;
ix,best: IX;
size: CARDINAL _ PointsToMicas[fd.points];
family: WORD;

fwHandle.reset [fwHandle];
	DO
	ReadIX[@ix];
	SELECT ix.header.type FROM
	IXTypeEnd => RETURN[FALSE];
	IXTypeName => FOR j IN [0 .. fd.name.length)
		DO OPEN StringDefs;
		IF LowerCase[fd.name[j]]
			# LowerCase[ix.name [j+1]] THEN EXIT;
		REPEAT FINISHED => EXIT; --from the outer loop
		ENDLOOP;
	ENDCASE;
	ENDLOOP;
--now we've found the family, look for the right widths
family _ ix.code;
best.header.type _ IXTypeEnd;
	DO
	ReadIX[@ix];
	SELECT ix.header.type FROM
	IXTypeEnd => EXIT;
	IXTypeWidths =>
		IF ix.fam = family
			AND ix.face = fd.face
			AND (ix.siz = 0 --splines--
			    OR (fd.points=MicasToPoints[ix.siz] 
				AND ix.rotation = fd.rotation))
		THEN	BEGIN
			best _ ix;
			IF ix.siz # 0 THEN EXIT;
				--may be non-spline later
			END;
	ENDCASE;
	ENDLOOP;
IF best.header.type = IXTypeEnd THEN RETURN[FALSE] ;
CalculateWidths[@best, fd, size];
RETURN[TRUE];
END;

-- -----------------------------------------------------------------
CalculateWidths: PROCEDURE [best: POINTER TO IxDefs.IX,
		font: FontDescriptorHandle, size: CARDINAL] =
BEGIN OPEN IxDefs, MiscDefs, AltoDefs, InlineDefs;
sa: LongNumber;
index: StreamDefs.StreamIndex;
wt: WTB;
bufl: CARDINAL = LENGTH[fontHeader.presswidth];
i: CARDINAL;

SetBlock[@fontHeader.presswidth, 0, bufl];

[sa.highbits, sa.lowbits] _ best.sa;  --Bcpl to Mesa LONG
[index.page, index.byte] _ LongDivMod[sa.lc*2, BytesPerPage];
StreamDefs.SetIndex[fwHandle, index];
[] _ StreamDefs.ReadBlock[fwHandle, @wt, SIZE[WTB]];

-- now read either one word or many for the widths
IF font.rotation#Rot0Degrees THEN FontError;
IF best.ec>bufl THEN FontError;
IF wt.XWidthFixed
 THEN	BEGIN
	w: CARDINAL _ fwHandle.get[fwHandle];
	SetBlock[@fontHeader.presswidth, w, bufl];
	END
 ELSE	[] _ StreamDefs.ReadBlock[fwHandle,
		@fontHeader.presswidth[best.bc], best.ec-best.bc+1];

--IF wt.YWidthFixed
-- THEN fontHeader.height _ fwHandle.get[fwHandle]
-- ELSE FontError;

-- now scale, if necessary
IF best.siz = 0 THEN
	BEGIN
	FOR i IN [best.bc..best.ec]
		DO fontHeader.presswidth[i] _ LongDiv[
		   LongMult[fontHeader.presswidth[i],size], 1000];
		ENDLOOP;
--	fontHeader.height _ LongDiv[LongMult[fontHeader.height,
--					size], 1000]
	END;
END;

-- -----------------------------------------------------------------
ReadIX: PROCEDURE[ ix: POINTER TO IxDefs.IX] =
BEGIN
ix.header _ fwHandle.get[fwHandle];
IF ix.header.length>0
   THEN IF StreamDefs.ReadBlock[fwHandle, ix+1, ix.header.length-1]+1
		# ix.header.length THEN FontError;
END;

-- -----------------------------------------------------------------
PointsToMicas: PROCEDURE[points: CARDINAL] RETURNS[CARDINAL] = 
BEGIN OPEN InlineDefs;
RETURN [LongDiv[LongMult[points,635],18]]
END;

-- -----------------------------------------------------------------
mtp: REAL _ 18.0/635.0;
MicasToPoints: PROCEDURE[micas: CARDINAL] RETURNS[CARDINAL] = 
BEGIN
RETURN [Real.RoundC[mtp*micas]]
END;

-- -----------------------------------------------------------------
EachFile: PROCEDURE [fp: POINTER, s: STRING]
	RETURNS [BOOLEAN] =
BEGIN
IF GriffinFileDefs.IsTail[s, ".Strike."] # 0
	THEN []_ReadStrike[fp,s];
RETURN[FALSE];
END;

-- -----------------------------------------------------------------
foo, baz: CARDINAL;

IF gHandle.endof [gHandle]
 THEN gHandle.put[gHandle, fontPassword]
 ELSE IF gHandle.get[gHandle] # fontPassword THEN
	BEGIN OPEN StreamDefs;
	old: DiskHandle_gHandle;
	gHandle_CreateWordStream[old.file, Read+Append];
	old.reset[old];
	old.put[old, fontPassword];
	TruncateDiskStream [old]; --destroys stream
	[]_FileLength[gHandle]; --position to end
	END;
bitMap.bits _ GriffinMemoryDefs.AllocateSegment [256];
UNTIL gHandle.endof [gHandle] DO
	IF gFontHead = NIL THEN
		gFontHead_lastFont_GriffinMemoryDefs.Allocate [lGriffinFont]
	ELSE lastFont_lastFont.next_GriffinMemoryDefs.Allocate [lGriffinFont];
	StreamDefs.GetFA [gHandle, @lastFont.fa];
	IF StreamDefs.ReadBlock [gHandle, @fontHeader, lGriffinFontHeader]
		#lGriffinFontHeader THEN SIGNAL FontError;
	foo _ fontHeader.bitmapwords;
	UNTIL foo =0 DO -- skip bitmap
		IF StreamDefs.ReadBlock [gHandle, bitMap.bits, MIN [foo, 256]] #
			MIN [foo, 256] THEN SIGNAL FontError;
		IF foo < 256 THEN foo _ 0 ELSE foo _ foo - 256;
		ENDLOOP;
	lastFont.fd.rotation _ fontHeader.rotation;
	lastFont.fd.points _ fontHeader.points;
	lastFont.fd.face _ fontHeader.face;
	lastFont.next _ NIL;
	foo _ LOOPHOLE [fontHeader.name [0], CARDINAL];
	lastFont.fd.name _ GriffinMemoryDefs.AllocateString [foo];
	FOR baz IN [ 1 .. foo] DO
		lastFont.fd.name [baz-1] _ fontHeader.name [baz]; ENDLOOP;
	lastFont.fd.name.length _ foo;
	ENDLOOP;

IF gFontHead # NIL THEN ReadGFont [gFontHead];
currentFont _ gFontHead;
DirectoryDefs.EnumerateDirectory [EachFile];
IF gFontHead = NIL THEN StartupFontError[nofonts];
END.