NodeStyleObsoleteImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
written by Bill Paxton, January 1981
Paxton, December 21, 1982 9:55 am
Maxwell, January 6, 1983 9:50 am
Doug Wyatt, March 5, 1985 10:53:24 am PST
Russ Atkinson, March 7, 1985 3:29:21 am PST
Michael Plass, April 8, 1985 11:25:11 am PST
Rick Beach, March 28, 1985 9:27:25 am PST
DIRECTORY
NodeStyle USING [DataEntry, DataList, GetReal, IntegerValue, Ref, SetReal],
NodeStyleObsolete,
NodeStyleWorks USING [SpecialOpArray, styledict, StyleError, StyleForFrame, StyleParamKey],
TextNode USING [Ref],
TJaM USING [Array, CommandProc, Frame, Get, NumberRep, Object, PopAtom, Push, PushReal, PushRope, Put];
~
BEGIN
Important that this module be started after NodeStyleWorks
Frame: TYPE ~ TJaM.Frame;
Object: TYPE ~ TJaM.Object;
Ref: TYPE ~ NodeStyle.Ref;
Free Variables
styleFreeVarName: ATOM; -- for the first REAL valued free variable
realFreeVars: LIST OF RealFreeVarRec;
RealFreeVarRec:
TYPE ~
RECORD [
key: ATOM, eval: PROC [node: TextNode.Ref] RETURNS [REAL]];
objFreeVars: LIST OF ObjFreeVarRec;
ObjFreeVarRec:
TYPE ~
RECORD [
key: ATOM, eval: PROC [node: TextNode.Ref] RETURNS [Object]];
EvalFreeVars:
PUBLIC
PROC [style: Ref, node: TextNode.Ref] ~ {
key: ATOM;
SetVal:
PROC [value: Object] ~ {
FOR x: NodeStyle.DataList ← style.dataList, x.next
UNTIL x=
NIL
DO
-- see if already has this value
WITH x
SELECT
FROM
xx:
REF NodeStyle.DataEntry.object =>
IF xx.name = key
THEN {
IF xx.object = value THEN RETURN ELSE EXIT;
};
ENDCASE;
ENDLOOP;
style.dataList ← NEW[NodeStyle.DataEntry ← [style.dataList, object[key, value]]];
};
FOR lst:
LIST
OF RealFreeVarRec ← realFreeVars, lst.rest
UNTIL lst=
NIL
DO
value: REAL ← lst.first.eval[node];
key ← lst.first.key;
IF key=styleFreeVarName THEN NodeStyle.SetReal[style, freeVar, value] -- this one is special
ELSE SetVal[NEW[REAL ← value]];
ENDLOOP;
FOR lst:
LIST
OF ObjFreeVarRec ← objFreeVars, lst.rest
UNTIL lst=
NIL
DO
key ← lst.first.key;
SetVal[lst.first.eval[node]];
ENDLOOP;
UnregisterStyleFreeVar:
PUBLIC
PROC [name:
ATOM] ~ {
prev: LIST OF RealFreeVarRec ← realFreeVars;
prevObj: LIST OF ObjFreeVarRec ← objFreeVars;
key: ATOM ← NodeStyleWorks.StyleParamKey[name];
IF styleFreeVarName = key THEN styleFreeVarName ← NIL;
IF realFreeVars = NIL THEN NULL
ELSE IF realFreeVars.first.key = key THEN realFreeVars ← realFreeVars.rest
ELSE
FOR lst:
LIST
OF RealFreeVarRec ← realFreeVars, lst.rest
UNTIL lst=
NIL
DO
IF lst.first.key=key THEN { prev.rest ← lst.rest; EXIT };
prev ← lst;
ENDLOOP;
IF objFreeVars=NIL THEN NULL
ELSE IF objFreeVars.first.key=key THEN objFreeVars ← objFreeVars.rest
ELSE
FOR lst:
LIST
OF ObjFreeVarRec ← objFreeVars, lst.rest
UNTIL lst=
NIL
DO
IF lst.first.key=key THEN { prevObj.rest ← lst.rest; EXIT };
prevObj ← lst;
ENDLOOP;
};
GetFreeVarOp:
PUBLIC TJaM.CommandProc ~ {
style: Ref ← NodeStyleWorks.StyleForFrame[frame];
key: ATOM ← TJaM.PopAtom[frame]; -- key name for the free var
IF key=styleFreeVarName
THEN {
TJaM.PushReal[frame, NodeStyle.GetReal[style, freeVar]];
RETURN;
};
PushFreeVar[frame, style, key];
};
GetFreeVarObjOp:
PUBLIC TJaM.CommandProc ~ {
style: Ref ← NodeStyleWorks.StyleForFrame[frame];
key: ATOM ← TJaM.PopAtom[frame]; -- key name for the free var
PushFreeVar[frame, style, key];
};
PushFreeVar:
PROC [frame: Frame, style: Ref, key:
ATOM] ~ {
FOR x: NodeStyle.DataList ← style.dataList, x.next
UNTIL x=
NIL
DO
WITH x
SELECT
FROM
xx:
REF NodeStyle.DataEntry.object =>
IF xx.name = key
THEN {
TJaM.Push[frame, xx.object];
RETURN;
};
ENDCASE;
ENDLOOP;
TJaM.PushRope[frame, "not defined as a free variable?"];
TJaM.Push[frame, key];
NodeStyleWorks.StyleError[frame, 3];
};
RegisterStyleFreeVar:
PUBLIC
PROC [name:
ATOM,
eval:
PROC [node: TextNode.Ref]
RETURNS [
REAL]
] ~ {
key: ATOM;
array: TJaM.Array;
[key, array] ← NodeStyleWorks.SpecialOpArray[name, $GetFreeVarOp];
TJaM.Put[NodeStyleWorks.styledict, name, array]; -- store the definition
UnregisterStyleFreeVar[name];
IF styleFreeVarName = NIL THEN styleFreeVarName ← key;
realFreeVars ← CONS[[key, eval], realFreeVars];
};
RegisterStyleFreeObjVar:
PUBLIC
PROC [name:
ATOM,
eval:
PROC [node: TextNode.Ref]
RETURNS [Object]
] ~ {
key: ATOM;
array: TJaM.Array;
[key, array] ← NodeStyleWorks.SpecialOpArray[name, $GetFreeVarObjOp];
TJaM.Put[NodeStyleWorks.styledict, name, array]; -- store the definition
UnregisterStyleFreeVar[name];
objFreeVars ← CONS[[key, eval], objFreeVars];
};
Special Parameter Extensions
nonNumeric: PUBLIC ERROR ~ CODE;
DefineSpecial:
PUBLIC
PROC [name:
ATOM, initialValue:
REAL ← 0.0] ~ {
DefineSpecialObj[name, NEW[REAL ← initialValue]];
};
DefineSpecialObj:
PUBLIC
PROC [name:
ATOM, initialValue: Object] ~ {
key: ATOM;
array: TJaM.Array;
[key, array] ← NodeStyleWorks.SpecialOpArray[name, $SpecialOp];
TJaM.Put[NodeStyleWorks.styledict, name, array]; -- store the definition
TJaM.Put[NodeStyleWorks.styledict, key, initialValue]; -- store the initial value
};
GetSpecial:
PUBLIC
PROC [s: Ref, name:
ATOM]
RETURNS [r:
REAL] ~ {
obj: Object ~ GetSpecialObj[s, name];
WITH obj
SELECT
FROM
x: REF TJaM.NumberRep.int => r ← x.int;
x: REF TJaM.NumberRep.real => r ← x.real;
ENDCASE => ERROR nonNumeric;
};
GetSpecialI:
PUBLIC
PROC [s: Ref, name:
ATOM]
RETURNS [i:
INTEGER] ~ {
obj: Object ~ GetSpecialObj[s, name];
WITH obj
SELECT
FROM
x: REF TJaM.NumberRep.int => i ← x.int;
x: REF TJaM.NumberRep.real => i ← NodeStyle.IntegerValue[x.real];
ENDCASE => ERROR nonNumeric;
};
GetSpecialObj:
PUBLIC
PROC [s: Ref, name:
ATOM]
RETURNS [obj: Object] = {
key: ATOM ← NodeStyleWorks.StyleParamKey[name];
FOR x: NodeStyle.DataList ← s.dataList, x.next
UNTIL x=
NIL
DO
WITH x
SELECT
FROM
xx: REF NodeStyle.DataEntry.object => IF xx.name = key THEN RETURN[xx.object];
ENDCASE;
ENDLOOP;
RETURN [TJaM.Get[NodeStyleWorks.styledict, key]];
};