-- 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;
	};(635)

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[];

}.(600)