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, March 14, 1985 1:35:49 pm PST
Rick Beach, March 19, 1985 12:23:16 pm PST
DIRECTORY
NameSymbolTable USING [Name, nullName, Object],
NodeStyle USING [DataEntry, DataList, GetReal, IntegerValue, Ref, SetReal],
NodeStyleObsolete,
NodeStyleWorks USING [DefineSpecialOp, NameToObject, PopName, PushName, PushObject, PushReal, PushText, specialOp, SpecialOpArray, styledict, StyleError, StyleForFrame, StyleParamKey],
TextNode USING [Ref],
TJaMBasic USING [Object],
TJaMInternal USING [Frame],
TJaMOps USING [defaultFrame, Get, Put];
NodeStyleObsoleteImpl: CEDAR MONITOR
IMPORTS NodeStyle, NodeStyleWorks, TJaMOps
EXPORTS NodeStyleObsolete
= BEGIN
Important that this module be started after NodeStyleWorks
Frame: TYPE = TJaMInternal.Frame;
Object: TYPE = TJaMBasic.Object;
Name: TYPE = NameSymbolTable.Name;
Ref: TYPE = NodeStyle.Ref;
Free Variables
styleFreeVarName: Name; -- for the first REAL valued free variable
realFreeVars: LIST OF RealFreeVarRec;
RealFreeVarRec: TYPE = RECORD [
key: Name, eval: PROC [node: TextNode.Ref] RETURNS [REAL]];
objFreeVars: LIST OF ObjFreeVarRec;
ObjFreeVarRec: TYPE = RECORD [
key: Name, eval: PROC [node: TextNode.Ref] RETURNS [Object]];
EvalFreeVars: PUBLIC PROC [style: Ref, node: TextNode.Ref] = {
key: Name;
SetVal: PROC [value: Object] = {
FOR x: NodeStyle.DataList ← style.dataList, x.next UNTIL x=NIL DO -- see if already has this value
xx: REF NodeStyle.DataEntry.object = NARROW[x];
IF xx.name=key THEN {
ob: NameSymbolTable.Object ← LOOPHOLE[value];
IF xx.object=ob THEN RETURN ELSE EXIT };
ENDLOOP;
style.dataList ← NEW[NodeStyle.DataEntry ← [style.dataList, object[key,LOOPHOLE[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[[L, 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: Name] = {
prev: LIST OF RealFreeVarRec ← realFreeVars;
prevObj: LIST OF ObjFreeVarRec ← objFreeVars;
key: Name ← NodeStyleWorks.StyleParamKey[name];
IF styleFreeVarName=key THEN styleFreeVarName ← NameSymbolTable.nullName;
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: PROC [frame: Frame] = {
style: Ref ← NodeStyleWorks.StyleForFrame[frame];
key: Name ← NodeStyleWorks.PopName[frame]; -- key name for the free var
IF key=styleFreeVarName THEN {
NodeStyleWorks.PushReal[frame, NodeStyle.GetReal[style, freeVar]];
RETURN;
};
PushFreeVar[frame, style, key];
};
GetFreeVarObjOp: PROC [frame: Frame] = {
style: Ref ← NodeStyleWorks.StyleForFrame[frame];
key: Name ← NodeStyleWorks.PopName[frame]; -- key name for the free var
PushFreeVar[frame, style, key];
};
PushFreeVar: PROC [frame: Frame, style: Ref, key: Name] = {
FOR x: NodeStyle.DataList ← style.dataList, x.next UNTIL x=NIL DO
xx: REF NodeStyle.DataEntry.object = NARROW[x];
IF xx.name = key THEN {
NodeStyleWorks.PushObject[frame, LOOPHOLE[xx.object]];
RETURN
};
ENDLOOP;
NodeStyleWorks.PushText[frame, "not defined as a free variable?"L];
NodeStyleWorks.PushName[frame, key];
NodeStyleWorks.StyleError[frame, 3];
};
getFreeVarOp: Object ← NodeStyleWorks.DefineSpecialOp[TJaMOps.defaultFrame, "GetFreeVarOp", GetFreeVarOp];
getFreeVarObjOp: Object ← NodeStyleWorks.DefineSpecialOp[TJaMOps.defaultFrame, "GetFreeVarOp", GetFreeVarOp];
RegisterStyleFreeVar: PUBLIC PROC [name: Name,
eval: PROC [node: TextNode.Ref] RETURNS [REAL]
] = TRUSTED {
key: Name;
array: array Object;
[key, array] ← NodeStyleWorks.SpecialOpArray[name, getFreeVarOp];
TJaMOps.Put[NodeStyleWorks.styledict, NodeStyleWorks.NameToObject[name], array]; -- store the definition
UnregisterStyleFreeVar[name];
IF styleFreeVarName=NameSymbolTable.nullName THEN styleFreeVarName ← key;
realFreeVars ← CONS[[key, eval], realFreeVars];
};
RegisterStyleFreeObjVar: PUBLIC PROC [name: Name,
eval: PROC [node: TextNode.Ref] RETURNS [Object]
] = TRUSTED {
key: Name;
array: array Object;
[key, array] ← NodeStyleWorks.SpecialOpArray[name, getFreeVarObjOp];
TJaMOps.Put[NodeStyleWorks.styledict, NodeStyleWorks.NameToObject[name], array]; -- store the definition
UnregisterStyleFreeVar[name];
objFreeVars ← CONS[[key, eval], objFreeVars];
};
Special Parameter Extensions
nonNumeric: PUBLIC ERROR = CODE;
DefineSpecial: PUBLIC PROC [name: Name, initialValue: REAL ← 0.0] = {
DefineSpecialObj[name, [L,real[initialValue]]];
};
DefineSpecialObj: PUBLIC PROC [name: Name, initialValue: Object] = TRUSTED {
key: Name;
array: array Object;
[key, array] ← NodeStyleWorks.SpecialOpArray[name, NodeStyleWorks.specialOp];
TJaMOps.Put[NodeStyleWorks.styledict, NodeStyleWorks.NameToObject[name], array]; -- store the definition
TJaMOps.Put[NodeStyleWorks.styledict, NodeStyleWorks.NameToObject[key], initialValue]; -- store the initial value
};
GetSpecial: PUBLIC PROC [s: Ref, name: Name] RETURNS [r: REAL] = {
obj: Object = GetSpecialObj[s, name];
WITH x:obj SELECT FROM
real => r ← x.rvalue;
integer => r ← x.ivalue;
ENDCASE => ERROR nonNumeric;
};
GetSpecialI: PUBLIC PROC [s: Ref, name: Name] RETURNS [val: INTEGER] = {
obj: Object = GetSpecialObj[s, name];
WITH x:obj SELECT FROM
real => val ← NodeStyle.IntegerValue[x.rvalue];
integer => val ← x.ivalue;
ENDCASE => ERROR nonNumeric;
};
GetSpecialObj: PUBLIC PROC [s: Ref, name: Name] RETURNS [obj: Object] = TRUSTED {
key: Name ← NodeStyleWorks.StyleParamKey[name];
FOR x: NodeStyle.DataList ← s.dataList, x.next UNTIL x=NIL DO
xx: REF NodeStyle.DataEntry.object = NARROW[x];
IF xx.name = key THEN RETURN [LOOPHOLE[xx.object]];
ENDLOOP;
RETURN [TJaMOps.Get[NodeStyleWorks.styledict, NodeStyleWorks.NameToObject[key]]];
};
END.