-- NodeStyleExtraImpl.mesa
-- Written by Bill Paxton, January 1981
-- Last changed by Bill Paxton, 3-Jun-81 13:43:44

DIRECTORY
	NodeStyleExtra,
	NodeStyle,
	TextNode,
	TextLooks,
	TiogaJaM,
	Inline,
	JaMFnsDefs,
	JaMOtherDefs;

NodeStyleExtraImpl: PROGRAM
	IMPORTS TiogaJaM, JaMFnsDefs, JaMOtherDefs,
		NodeStyle, NodeStyleExtra, Inline
	EXPORTS NodeStyle, NodeStyleExtra =
BEGIN
OPEN NodeStyle, NodeStyleExtra, JaMFnsDefs,
	tjI:TiogaJaM,
	nodeI:TextNode,
	looksI:TextLooks,
	jamI:JaMOtherDefs;

-- Style Name

styleName: nodeI.StyleName _ nodeI.nullStyleName; -- the current style name

CurrentStyle: PUBLIC PROC RETURNS [nodeI.StyleName] =
	{ RETURN [styleName] };

SetStyle: PUBLIC PROC [name: nodeI.StyleName] = {
	IF name = styleName THEN RETURN;
	IF styleName # nodeI.nullStyleName THEN ExecuteCommand[end];
	PushObject[GetStyleDict[name]]; 
	ExecuteCommand[begin];
	styleName _ name;
	};


-- Load style procedures

LoadStyle: PUBLIC PROC [name: nodeI.StyleName] = { [] _ GetStyleDict[name] };

GetStyleDict: PROC [name: nodeI.StyleName] RETURNS [d: Object] = {
	found: BOOLEAN;
	[d, found] _ CheckStyleDict[name];
	IF found THEN RETURN;
	d _ CreateStyleDict[name];
	RunStyle[d, name, ".tes", TRUE];
	EnterStyleDict[name, d];
	};

ReloadStyle: PUBLIC PROC [name: nodeI.StyleName] = {
	d: Object;
	found: BOOLEAN;
	[d, found] _ CheckStyleDict[name];
	IF found THEN {
		PushObject[d]; ExecuteCommand[clrdict];
		PushObject[d]; ExecuteCommand[detachall] }
	ELSE d _ CreateStyleDict[name];
	RunStyle[d, name, ".tes", TRUE];
	IF ~found THEN EnterStyleDict[name, d];
	ClearLooksCache[]; ClearRuleCache[]};

CreateStyleDict: PROC [name: nodeI.StyleName] RETURNS [d: Object] = {
	-- creates dict for style and enters it in stylesDict
	PushInteger[20];
	ExecuteCommand[dict];
	d _ PopObject[]};

EnterStyleDict: PROC [name: nodeI.StyleName, d: Object] = {
	PushObject[stylesDict];
	PushName[tjI.StyleToJaM[name]];
	PushObject[d];
	ExecuteCommand[put];
	};

CheckStyleDict: PROC [name: nodeI.StyleName]
	RETURNS [d: Object, found: BOOLEAN] = {
	PushObject[stylesDict];
	PushName[tjI.StyleToJaM[name]];
	ExecuteCommand[known];
	IF (found _ PopBoolean[]) THEN {
		PushObject[stylesDict]; PushName[tjI.StyleToJaM[name]];
		ExecuteCommand[get]; d _ PopObject[] };
	};

RunStyle: PROC
	[d: Object, name: nodeI.StyleName, ext: REF TEXT, go: BOOLEAN] = {
	txt: REF TEXT _ NEW[TEXT[64]];
	txtlen: NAT;
	jamI.TextForName[LOOPHOLE[txt], LOOPHOLE[name] !
		jamI.TextOverflow =>
			RESUME[LOOPHOLE[txt _ NEW[TEXT[txt.maxLength*2]]]]];
	txtlen _ txt.length;
	FOR i:NAT IN [0..ext.length) DO txt[txtlen+i] _ ext[i]; ENDLOOP;
	txt.length _ txtlen+ext.length;
	PushCommand[end];
	PushCommand[run];
	PushName[MakeName[txt]];
	PushCommand[begin];
	PushObject[d];
	IF go THEN jamI.Go[];
	};

Apply: PUBLIC PROC
	[ref: Ref, name, alt: nodeI.TypeName _ nodeI.nullTypeName] = {
	initloc, loc: NAT;
	input: Body;
	IF name = nodeI.nullTypeName THEN RETURN;
	loc _ initloc _
		Inline.BITXOR[LOOPHOLE[name,CARDINAL],Hash[ref]] MOD ruleCacheSize;
	DO -- search cache
		SELECT ruleCacheNames[loc] FROM
			name => IF ruleCacheInputs[loc] = ref^ THEN
				{ ref^ _ ruleCacheResults[loc]; RETURN };
			nodeI.nullTypeName => EXIT; -- this is an unused entry
			ENDCASE;
		SELECT (loc _ loc+1) FROM
			ruleCacheSize => IF (loc _ 0)=initloc THEN EXIT;
			initloc => EXIT;
			ENDCASE;
		ENDLOOP;
	IF ruleCacheCount = ruleCacheMax THEN {
		loc _ initloc; ClearRuleCache[] };
	SetStyle[ref.styleName]; -- make style current
	style _ ref; -- make it current
	input _ ref^;
	IF ExecuteName[tjI.TypeToJaM[name]] THEN { -- save results in cache
		ruleCacheCount _ ruleCacheCount+1;
		ruleCacheInputs[loc] _ input;
		ruleCacheResults[loc] _ ref^;
		ruleCacheNames[loc] _ name }
	ELSE IF alt # nodeI.nullTypeName THEN [] _ ExecuteName[tjI.TypeToJaM[alt]];
	};

ruleCacheSize: NAT = 128; -- should be a power of 2
ruleCacheMax: NAT = (ruleCacheSize*2)/3; -- don't fill too full
ruleCacheCount: NAT; -- number of entries currently in use
RuleCacheNames: TYPE = ARRAY [0..ruleCacheSize) OF nodeI.TypeName;
ruleCacheNames: REF RuleCacheNames _ NEW[RuleCacheNames];
RuleCacheBodies: TYPE = ARRAY [0..ruleCacheSize) OF Body;
ruleCacheInputs: REF RuleCacheBodies _ NEW[RuleCacheBodies];
ruleCacheResults: REF RuleCacheBodies _ NEW[RuleCacheBodies];

ClearRuleCache: PROC = {
	ruleCacheCount _ 0;
	FOR i: NAT IN [0..ruleCacheSize) DO
		ruleCacheNames[i] _ nodeI.nullTypeName; ENDLOOP;
	};

Hash: PROC [ref: Ref] RETURNS [CARDINAL] = INLINE { RETURN [
	LOOPHOLE[
		Inline.BITXOR[LOOPHOLE[ref.styleName,CARDINAL],
			Inline.BITXOR[LOOPHOLE[ref.fontFamily,CARDINAL],
				Inline.BITXOR[Inline.LowHalf[ref.fontSize],
					Inline.BITXOR[Inline.LowHalf[ref.leftIndent],
						Inline.LowHalf[ref.leading]]]]],CARDINAL]] };

ApplyLooks: PUBLIC PROC [ref: Ref, looks: looksI.Looks] = {
	initloc, loc: NAT;
	IF looks = looksI.noLooks THEN RETURN;
	loc _ initloc _
		Inline.BITXOR[LOOPHOLE[looks, looksI.LooksBytes].byte0,
			Inline.BITXOR[LOOPHOLE[looks, looksI.LooksBytes].byte1,
				Inline.BITXOR[LOOPHOLE[looks, looksI.LooksBytes].byte2,
					Hash[ref]]]] MOD looksCacheSize;
	DO -- search cache
		SELECT looksCacheLooks[loc] FROM
			looks => IF looksCacheInputs[loc] = ref^ THEN
				{ ref^ _ looksCacheResults[loc]; RETURN };
			looksI.noLooks => EXIT; -- this is an unused entry
			ENDCASE;
		SELECT (loc _ loc+1) FROM
			looksCacheSize => IF (loc _ 0)=initloc THEN EXIT;
			initloc => EXIT;
			ENDCASE;
		ENDLOOP;
	IF looksCacheCount = looksCacheMax THEN {
		loc _ initloc; ClearLooksCache[] };
	SetStyle[ref.styleName]; -- make style current
	style _ ref; -- make it current
	looksCacheLooks[loc] _ looks;
	looksCacheInputs[loc] _ ref^;
	FOR c: CHARACTER IN looksI.Look DO
		IF looks[c] THEN [] _ ExecuteName[lookNames[c]]
		ENDLOOP;
	looksCacheResults[loc] _ ref^;
	looksCacheCount _ looksCacheCount+1;
	};

looksCacheSize: NAT = 128; -- should be a power of 2
looksCacheMax: NAT = (looksCacheSize*2)/3; -- don't fill too full
looksCacheCount: NAT; -- number of entries currently in use
LooksCacheLooks: TYPE = ARRAY [0..looksCacheSize) OF looksI.Looks;
looksCacheLooks: REF LooksCacheLooks _ NEW[LooksCacheLooks];
LooksCacheBodies: TYPE = ARRAY [0..looksCacheSize) OF Body;
looksCacheInputs: REF LooksCacheBodies _ NEW[LooksCacheBodies];
looksCacheResults: REF LooksCacheBodies _ NEW[LooksCacheBodies];

ClearLooksCache: PROC = {
	looksCacheCount _ 0;
	FOR i: NAT IN [0..looksCacheSize) DO
		looksCacheLooks[i] _ looksI.noLooks; ENDLOOP;
	};


-- Registered commands

StyleDefOp: PROC = { -- does bindingDict .abind .cvx .def
	PushObject[bindingDict];
	ExecuteCommand[abind];
	ExecuteCommand[cvx];
	ExecuteCommand[def];
	};

SubStyleOp: PROC = { -- expects opstk to contain style name
	found: BOOLEAN;
	name: nodeI.StyleName _ tjI.JaMToStyle[PopName[]];
	d: Object;
	[d, found] _ CheckStyleDict[name];
	IF ~found THEN d _ CreateStyleDict[name];
	PushObject[d]; ExecuteCommand[attachdict];
	IF ~found THEN {
		PushName[tjI.StyleToJaM[name]]; PushObject[d];
		PushCommand[finishSubStyle];
		RunStyle[d, name, ".tes", FALSE] };
	};

FinishSubStyle: PROC = { -- .run finished successfully
	d: Object _ PopObject[];
	EnterStyleDict[tjI.JaMToStyle[PopName[]], d] };

BadFileName: PROC = { -- ???? what should we do ????
	-- this comes from giving .run a file name it cannot open
	ERROR StyleError };

-- Dimensions

Points: PROC = { }; -- no change needed to convert to points

PointsPerPica: REAL = 12.0;
Picas: PROC = { PushReal[PopReal[]*PointsPerPica] };

PointsPerInch: REAL = 1.0/0.0138370; -- 72.27
Inches: PROC = { PushReal[PopReal[]*PointsPerInch] };

PointsPerCentimeter: REAL = PointsPerInch/2.540;
Centimeters: PROC = { PushReal[PopReal[]*PointsPerCentimeter] };

PointsPerMillimeter: REAL = PointsPerCentimeter/10;
Millimeters: PROC = { PushReal[PopReal[]*PointsPerMillimeter] };

PointsPerDidot: REAL = PointsPerCentimeter/26.60;
DidotPoints: PROC = { PushReal[PopReal[]*PointsPerDidot] };

Ems: PROC = { PushReal[PopReal[]*style.fontSize] };
	-- should really be width of "M" in current font
	-- use font size as an approximation for now


-- Initialization

lookNames: ARRAY looksI.Look OF tjI.JaMName; 

stylesDictName, bindingDictName: tjI.JaMName;

stylesDict, bindingDict: Object;

StyleCommand: PUBLIC PROC [text: REF TEXT, proc: PROC] = {
	name: tjI.JaMName _ MakeName[text];
	jamI.RegisterCommand[LOOPHOLE[text], proc];
	-- add it to the binding dictionary
	PushObject[bindingDict];
	PushName[name];
	PushName[name];
	ExecuteCommand[load];
	ExecuteCommand[cvx];
	ExecuteCommand[put]};

StyleLiteral: PUBLIC PROC [text: REF TEXT] RETURNS [name: tjI.JaMName] = {
	name _ MakeName[text];
	-- add it to the binding dictionary
	PushObject[bindingDict];
	PushName[name];
	PushName[name];
	ExecuteCommand[cvlit];
	ExecuteCommand[put];
	-- add it to the current dictionary
	PushName[name];
	PushName[name];
	ExecuteCommand[cvlit];
	ExecuteCommand[def]};

InitStylesDict: PROC = {
	stylesDictName _ MakeName["TiogaEditorStylesDictionary"];
	PushName[stylesDictName];
	ExecuteCommand[where];
	IF PopBoolean[] THEN {
		PushName[stylesDictName]; ExecuteCommand[get];
		stylesDict _ PopObject[] }
	ELSE {
		PushInteger[20]; ExecuteCommand[dict];
		stylesDict _ PopObject[];
		PushName[stylesDictName]; PushObject[stylesDict];
		ExecuteCommand[def] }};

InitBindingDict: PROC = {
	bindingDictName _ MakeName["TiogaEditorBindingDictionary"];
	PushName[bindingDictName];
	ExecuteCommand[where];
	IF PopBoolean[] THEN {
		PushName[bindingDictName]; ExecuteCommand[get];
		bindingDict _ PopObject[];
		PushObject[bindingDict]; ExecuteCommand[clrdict] }
	ELSE {
		PushInteger[100]; ExecuteCommand[dict];
		bindingDict _ PopObject[];
		PushName[bindingDictName]; PushObject[bindingDict];
		ExecuteCommand[def];
		PushObject[bindingDict] }};

InitLookNames: PROC = {
	-- names are "aLook", "bLook", "cLook", etc.
	txt: REF TEXT _ NEW[TEXT[5]];
	txt[1] _ 'L; txt[2] _ txt[3] _ 'o; txt[4] _ 'k; txt.length _ 5;
	FOR c: CHARACTER IN looksI.Look DO
		txt[0] _ c; lookNames[c] _ MakeName[txt]; ENDLOOP};

cvlit, cvx, def, put, get, dict, attachdict, detachall, abind,
	begin, end, run, load, clrdict, where, known, assign, finishSubStyle:
	PUBLIC Command;

GetCommand: PUBLIC PROC [name: tjI.JaMName] RETURNS [c: Command] = {
	flag: BOOLEAN;
	[c, flag] _ jamI.TryToGetCommand[LOOPHOLE[name]];
	IF ~flag THEN ERROR };

StartExtra: PUBLIC PROCEDURE =
	BEGIN

	cvlit _ GetCommand[MakeName[".cvlit"]];
	cvx _ GetCommand[MakeName[".cvx"]];
	def _ GetCommand[MakeName[".def"]];
	put _ GetCommand[MakeName[".put"]];
	get _ GetCommand[MakeName[".get"]];
	dict _ GetCommand[MakeName[".dict"]];
	attachdict _ GetCommand[MakeName[".attachdict"]];
	detachall _ GetCommand[MakeName[".detachall"]];
	abind _ GetCommand[MakeName[".abind"]];
	where _ GetCommand[MakeName[".where"]];
	begin _ GetCommand[MakeName[".begin"]];
	end _ GetCommand[MakeName[".end"]];
	run _ GetCommand[MakeName[".run"]];
	load _ GetCommand[MakeName[".load"]];
	clrdict _ GetCommand[MakeName[".clrdict"]];
	known _ GetCommand[MakeName[".known"]];
	assign _ GetCommand[MakeName[".assign"]];

	InitStylesDict[]; InitBindingDict[]; InitLookNames[];
	
	JaMFnsDefs.Register[LOOPHOLE["FinishSubStyle"],FinishSubStyle];
	finishSubStyle _ GetCommand[MakeName["FinishSubStyle"]];
	
	StyleCommand[".badfilename",BadFileName];
	StyleCommand["StyleDef",StyleDefOp];
	StyleCommand["SubStyle",SubStyleOp];

	StyleCommand["pt",Points];
	StyleCommand["pc",Picas];
	StyleCommand["in",Inches];
	StyleCommand["cm",Centimeters];
	StyleCommand["mm",Millimeters];
	StyleCommand["dd",DidotPoints];
	StyleCommand["em",Ems];

	ClearLooksCache[]; ClearRuleCache[];

	END;

END.