NodeStyleImpl.mesa
Copyright Ó 1985, 1987, 1988, 1991, 1992 by Xerox Corporation. All rights reserved.
Written by Bill Paxton, January 1981
Bill Paxton, December 1, 1982 7:38 am
Maxwell, January 6, 1983 8:46 am
Russ Atkinson, March 7, 1985 3:34:46 am PST
Plass, March 14, 1985 5:00:54 pm PST
Rick Beach, March 21, 1985 2:32:26 pm PST
Michael Plass, November 17, 1987 2:21:05 pm PST
Doug Wyatt, February 26, 1992 5:49 pm PST
Implements JaM commands for style rules and commands to load styles.
DIRECTORY
NodeStyle USING [DataEntry, DataList, RealInit0, overflow, RealCode, RealParam, Ref, TabStop, LeaderTabStop, RuleTabStop, RulesTabStop, TabRealParam],
Real USING [Round],
RefTab USING [Create, Ref, Update, UpdateAction],
TJaM USING [Equal];
NodeStyleImpl: CEDAR MONITOR
IMPORTS Real, RefTab, TJaM
EXPORTS NodeStyle
~ BEGIN OPEN NodeStyle;
Real Parameters
GetReal: PUBLIC PROC [ref: Ref, param: RealParam] RETURNS [value: REAL ¬ 0.0] ~ {
code: RealCode;
IF (code ¬ ref.real[param]) # overflow THEN RETURN [realArray[code]];
RETURN [GetRealOverflow[ref,param]];
};
GetInt: PUBLIC PROC [ref: Ref, param: RealParam] RETURNS [value: INTEGER] ~ {
code: RealCode;
IF (code ¬ ref.real[param]) # overflow THEN RETURN [intArray[code]];
RETURN [GetIntOverflow[ref,param]];
};
GetRealOverflow: PROC [ref: Ref, param: RealParam] RETURNS [value: REAL ¬ 0.0] ~ {
code: RealCode ¬ ref.real[param];
IF code # overflow THEN RETURN [realArray[code]];
FOR x: DataList ¬ ref.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF DataEntry.real => { IF xx.param = param THEN RETURN [xx.value] };
ENDCASE => NULL;
ENDLOOP;
ERROR -- failed to find it on the data list --
};
GetIntOverflow: PROC [ref: Ref, param: RealParam] RETURNS [value: INTEGER] ~ {
code: RealCode ¬ ref.real[param];
IF code # overflow THEN RETURN [intArray[code]];
FOR x: DataList ¬ ref.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF DataEntry.real => { IF xx.param = param THEN RETURN [xx.valueI] };
ENDCASE => NULL;
ENDLOOP;
ERROR -- failed to find it on the data list --
};
realArray: PUBLIC REF ARRAY RealCode OF RealInit0 ¬ NEW[ARRAY RealCode OF RealInit0];
array of real-valued distances
intArray: PUBLIC REF ARRAY RealCode OF INTEGER ¬ NEW[ARRAY RealCode OF INTEGER];
parallel array of integer-valued distances
nextFreeRealCode: RealCode ¬ 1;
next free entry in realArray
reserve entry 0 for 0.0
overflowCount: INT ¬ 0;
realTableOverflow: PUBLIC ERROR ~ CODE;
IntegerValue: PUBLIC PROC [value: REAL ¬ 0.0] RETURNS [INTEGER] ~ {
RETURN [SELECT value FROM
> lastIntegerAsReal => LAST[INTEGER],
< firstIntegerAsReal => FIRST[INTEGER],
ENDCASE => INTEGER[Real.Round[value]]];
};
lastIntegerAsReal: REAL ¬ LAST[INTEGER];
firstIntegerAsReal: REAL ¬ FIRST[INTEGER];
EnterReal: PUBLIC ENTRY PROC [value: REAL ¬ 0.0] RETURNS [code: RealCode] ~ {
ENABLE UNWIND => NULL;
code ¬ nextFreeRealCode;
FOR c: RealCode IN [FIRST[RealCode]..nextFreeRealCode) DO
IF realArray[c]=value THEN { code ¬ c; EXIT };
ENDLOOP;
SELECT code FROM
< nextFreeRealCode => NULL; -- already was in realArray
= overflow => { -- realArray is full
overflowCount ¬ overflowCount+1;
ERROR realTableOverflow;
};
= nextFreeRealCode => { -- enter in realArray
nextFreeRealCode ¬ nextFreeRealCode+1;
realArray[code] ¬ value;
intArray[code] ¬ IntegerValue[value];
};
ENDCASE => ERROR;
};
SetReal: PUBLIC PROC [ref: Ref, param: RealParam, value: REAL ¬ 0.0] ~ {
ref.real[param] ¬ EnterReal[value !
realTableOverflow => {
ref.real[param] ¬ overflow;
ref.dataList ¬ ConsDataListReal[param, value, ref.dataList];
CONTINUE }
];
};
Tabs
GetTabLoc: PUBLIC PROC [stop: TabStop, s:Ref] RETURNS [REAL ¬ 0.0] ~ {
code: RealCode;
IF (code ¬ stop.loc) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,loc]];
};
GetTabLocI: PUBLIC PROC [stop: TabStop, s:Ref] RETURNS [INTEGER] ~ {
code: RealCode;
IF (code ¬ stop.loc) # overflow THEN RETURN [intArray[code]];
RETURN [GetTabIntOverflow[s,stop,loc]];
};
GetTabLeaderSpacing: PUBLIC PROC [stop: LeaderTabStop, s:Ref] RETURNS [REAL ¬ 0.0] ~ {
code: RealCode;
IF (code ¬ stop.spacing) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,spacing]];
};
GetTabLeaderSpacingI: PUBLIC PROC [stop: LeaderTabStop, s:Ref] RETURNS [INTEGER] ~ {
code: RealCode;
IF (code ¬ stop.spacing) # overflow THEN RETURN [intArray[code]];
RETURN [GetTabIntOverflow[s,stop,spacing]];
};
GetTabRuleWeight: PUBLIC PROC [stop: RuleTabStop, s:Ref] RETURNS [REAL ¬ 0.0] ~ {
code: RealCode;
IF (code ¬ stop.weight) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,weight]];
};
GetTabRuleWeightI: PUBLIC PROC [stop: RuleTabStop, s:Ref] RETURNS [INTEGER] ~ {
code: RealCode;
IF (code ¬ stop.weight) # overflow THEN RETURN [intArray[code]];
RETURN [GetTabIntOverflow[s,stop,weight]];
};
GetTabRuleVShift: PUBLIC PROC [stop: RuleTabStop, s:Ref] RETURNS [REAL ¬ 0.0] ~ {
code: RealCode;
IF (code ¬ stop.vshift) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,vshift]];
};
GetTabRuleVShiftI: PUBLIC PROC [stop: RuleTabStop, s:Ref] RETURNS [INTEGER] ~ {
code: RealCode;
IF (code ¬ stop.vshift) # overflow THEN RETURN [intArray[code]];
RETURN [GetTabIntOverflow[s,stop,vshift]];
};
GetTabRealCode: PUBLIC PROC [ref: Ref, stop: TabStop, which: TabRealParam,
value: REAL ¬ 0.0]
RETURNS [code: RealCode] ~ {
code ¬ EnterReal[value ! realTableOverflow => {
code ¬ overflow;
ref.dataList ¬ ConsDataListTab[stop, which, value, ref.dataList];
CONTINUE }];
};
GetRulesTabCount: PUBLIC PROC [stop: RulesTabStop] RETURNS [count: INTEGER] ~ {
RETURN [stop.rules.length];
};
GetRulesTabInfo: PUBLIC PROC [stop: RulesTabStop, num: INTEGER]
RETURNS [weight, vshift: REAL] ~ {
For num in [0..RulesTabCount), returns the weight and vshift values for that rule.
weight ¬ stop.rules.array[num].weight;
vshift ¬ stop.rules.array[num].vshift };
GetRulesTabInfoI: PUBLIC PROC [stop: RulesTabStop, num: INTEGER]
RETURNS [weight, vshift: INTEGER] ~ {
weight ¬ IntegerValue[stop.rules.array[num].weight];
vshift ¬ IntegerValue[stop.rules.array[num].vshift] };
GetTabOverflow: PROC [ref: Ref, stop: TabStop, which: TabRealParam]
RETURNS [value: REAL ¬ 0.0] ~ {
FOR x: DataList ¬ ref.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF DataEntry.tab => { IF xx.tabStop=stop AND xx.which=which THEN RETURN [xx.value] };
ENDCASE => NULL;
ENDLOOP;
ERROR -- failed to find it on the data list --
};
GetTabIntOverflow: PROC [ref: Ref, stop: TabStop, which: TabRealParam]
RETURNS [value: INTEGER] ~ {
FOR x: DataList ¬ ref.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF DataEntry.tab => { IF xx.tabStop=stop AND xx.which=which THEN RETURN [xx.valueI] };
ENDCASE => NULL;
ENDLOOP;
ERROR -- failed to find it on the data list --
};
Dimensions
PointsPerPica: PUBLIC REAL ¬ 12.0;
PointsPerInch: PUBLIC REAL ¬ 1.0/0.0138370; -- 72.27
PointsPerCentimeter: PUBLIC REAL ¬ PointsPerInch/2.540;
PointsPerMillimeter: PUBLIC REAL ¬ PointsPerCentimeter/10;
PointsPerDidot: PUBLIC REAL ¬ PointsPerCentimeter/26.60;
PointsPerFil: PUBLIC REAL ¬ 10000.0;
PointsPerFill: PUBLIC REAL ¬ PointsPerFil*PointsPerFil;
PointsPerFilll: PUBLIC REAL ¬ PointsPerFill*PointsPerFil;
DataList maintainence
It is desireable to canonicalize the dataList, so that the style cache hit rate is large, even in the presence of many StyleParams
canonicalizeDataLists: BOOL ¬ TRUE;
dataListTable: RefTab.Ref ¬ RefTab.Create[];
consStats: RECORD [calls, finds, allocs, real, tab: INT ¬ 0];
ConsDataListObject: PUBLIC PROC [name: ATOM, object: REF, dataList: DataList] RETURNS [newDataList: DataList ¬ NIL] ~ {
IF canonicalizeDataLists THEN {
Update: RefTab.UpdateAction = {
[found: BOOL, val: RefTab.Val] RETURNS [op: RefTab.UpdateOperation ← none, new: RefTab.Val ← NIL]
tops: LIST OF DataList ¬ NARROW[val];
FOR each: LIST OF DataList ¬ tops, each.rest UNTIL each = NIL DO
WITH each.first SELECT FROM
xx: REF DataEntry.object => {
IF xx.name = name AND TJaM.Equal[xx.object, object] THEN {
newDataList ¬ each.first;
consStats.finds ¬ consStats.finds + 1;
RETURN [op: none]
};
};
ENDCASE => NULL;
ENDLOOP;
newDataList ¬ NEW[DataEntry.object ¬ [dataList, object[name, object]]];
tops ¬ CONS[newDataList, tops];
consStats.allocs ¬ consStats.allocs + 1;
RETURN [op: store, new: tops]
};
consStats.calls ¬ consStats.calls + 1;
FOR x: DataList ¬ dataList, x.next UNTIL x = NIL DO
WITH x SELECT FROM
xx: REF DataEntry.object => {
IF xx.name = name THEN {
IF TJaM.Equal[xx.object, object] THEN RETURN [dataList] ELSE EXIT;
};
};
ENDCASE => NULL;
ENDLOOP;
RefTab.Update[x: dataListTable, key: dataList, action: Update]
};
IF newDataList = NIL THEN {
newDataList ¬ NEW[DataEntry.object ¬ [dataList, object[name, object]]];
};
};
ConsDataListReal: PROC [param: RealParam, value: REAL, dataList: DataList] RETURNS [DataList] ~ {
This is for overflow reals; if this happens often, should canonicalize here as well
consStats.real ¬ consStats.real + 1;
RETURN [NEW[DataEntry.real ¬ [dataList, real[param, value, IntegerValue[value]]]]];
};
ConsDataListTab: PROC [tabStop: TabStop, which: TabRealParam, value: REAL, dataList: DataList] RETURNS [DataList] ~ {
This is for overflow tab stops; if this happens often, should canonicalize here as well
consStats.tab ¬ consStats.tab + 1;
RETURN [NEW[DataEntry.tab ¬ [dataList, tab[tabStop, which, value, IntegerValue[value]]]]];
};
END.