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]; NodeStyleObsoleteImpl: CEDAR MONITOR IMPORTS NodeStyle, NodeStyleWorks, TJaM EXPORTS NodeStyleObsolete ~ BEGIN Frame: TYPE ~ TJaM.Frame; Object: TYPE ~ TJaM.Object; Ref: TYPE ~ NodeStyle.Ref; 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]; }; 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]]; }; END. ΰNodeStyleObsoleteImpl.mesa Copyright c 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 Important that this module be started after NodeStyleWorks Free Variables Special Parameter Extensions Κp˜codešœ™Kšœ Οmœ1™Kšœžœ˜ š‘œžœ˜ š žœ0žœžœžœ  ˜bšžœžœž˜šœžœžœžœ˜=Jš žœžœžœžœžœ˜+J˜—Jšžœ˜—Kšžœ˜—Kšœžœ=˜QKšœ˜—š žœžœžœ)žœžœž˜IKšœžœ˜#Kšœ˜Kšžœžœ* ˜\Kšžœžœžœ ˜Kšžœ˜—š žœžœžœ'žœžœž˜GKšœ˜Kšœ˜Kšžœ˜—˜K˜——š‘œžœžœžœ˜4Kšœžœžœ˜,Kšœ žœžœ˜-Kšœžœ&˜/Kšžœžœžœ˜6Kšžœžœžœž˜Kšžœžœžœ!˜Jš žœžœžœžœ)žœžœž˜NKšžœžœžœ˜9K˜ Kšžœ˜—Kšžœ žœžœž˜Kšžœžœžœ˜Eš žœžœžœžœ'žœžœž˜LKšžœžœžœ˜