<<>> <> <> <> <> <> <> <> <> <<>> DIRECTORY Atom USING [GetPName, MakeAtom], IO USING [PutFR], NodeStyle USING [GetReal, RealParam, Ref, SetReal], NodeStyleOps USING [Create, defaultStyleName, FlushCaches, OfStyle], NodeStyleValidate USING [], NodeStyleWorks USING [AddRealProc, ForceLowerName, LoadProc, Ops, OpsRec, Param, ParamRec, PercentProc, PopName, RegisterStyleCommand, run, SetNameProc, StoreProc, TryToPopName, TypeCheckDict, TypeCheckName, WhoIsExecuting], PFS USING [AbsoluteName, Error, FileInfo, nullUniqueID, PATH, PathFromRope, RopeFromPath, UniqueID], Process USING [GetCurrent], RefTab USING [Create, Fetch, Pairs, Ref, Store], Rope USING [Cat, Concat, Equal, FromChar, ROPE], SimpleFeedback USING [Append, Blink], Tioga USING [Look, Looks], TJaM USING [ABind, ACopy, AGet, Any, APut, Array, AtomFromAny, AtomFromRope, AttachDict, Begin, ClrDict, CommandProc, CountStack, CvX, DetachAll, DetachDict, Dict, DictLength, DictTop, End, Execute, ExecuteAtom, Frame, Load, NewArray, NewDict, NewFrame, Object, Pop, PopDict, PopReal, Push, PushInt, PushReal, PushRope, Put, Register, RopeFromAtom, Stop, TryToGet, TryToLoad], UserProfile USING [ListOfTokens]; NodeStyleWorks1Impl: CEDAR MONITOR IMPORTS Atom, PFS, IO, NodeStyle, NodeStyleOps, NodeStyleWorks, Process, RefTab, Rope, SimpleFeedback, TJaM, UserProfile EXPORTS NodeStyleWorks, NodeStyleValidate ~ BEGIN OPEN NodeStyle, NodeStyleWorks; <> ROPE: TYPE ~ Rope.ROPE; Frame: TYPE ~ TJaM.Frame; OfStyle: TYPE ~ NodeStyleOps.OfStyle; Object: TYPE ~ TJaM.Object; defaultFrame: PUBLIC Frame; FrameInfo: TYPE ~ REF FrameInfoBody; FrameInfoBody: TYPE ~ RECORD [ frame: Frame, style: Ref, rest: FrameInfo ]; GetFrame: PUBLIC PROC [style: Ref, styleName: ATOM, kind: OfStyle] RETURNS [frame: Frame] ~ { <<-- style is the StyleRef you will be using with the frame>> <<-- styleName tells which style dictionary you want>> <<-- will give you default style if requested style bombs during load>> found: BOOL; AllocFrame: ENTRY PROC [name: ATOM, kind: OfStyle] ~ INLINE { ENABLE UNWIND => NULL; allocFrameCalls ¬ allocFrameCalls+1; IF name # NIL THEN { <<-- first try to find one that already has the right style >> IF name = styleName1 AND kind = styleKind1 AND freeFrame1 # NIL THEN { frame ¬ freeFrame1; freeFrame1 ¬ NIL; RETURN }; IF name = styleName2 AND kind = styleKind2 AND freeFrame2 # NIL THEN { frame ¬ freeFrame2; freeFrame2 ¬ NIL; RETURN }; IF name = styleName3 AND kind = styleKind3 AND freeFrame3 # NIL THEN { frame ¬ freeFrame3; freeFrame3 ¬ NIL; RETURN }; IF name = styleName4 AND kind = styleKind4 AND freeFrame4 # NIL THEN { frame ¬ freeFrame4; freeFrame4 ¬ NIL; RETURN }}; <<-- look for any free one>> IF freeFrame1 # NIL THEN { frame ¬ freeFrame1; freeFrame1 ¬ NIL } ELSE IF freeFrame2 # NIL THEN { frame ¬ freeFrame2; freeFrame2 ¬ NIL } ELSE IF freeFrame3 # NIL THEN { frame ¬ freeFrame3; freeFrame3 ¬ NIL } ELSE IF freeFrame4 # NIL THEN { frame ¬ freeFrame4; freeFrame4 ¬ NIL } ELSE { frame ¬ TJaM.NewFrame[]; frameAlloc ¬ frameAlloc+1; TJaM.Begin[frame, styledict]; }; }; SaveStyleInfo: ENTRY PROC ~ INLINE { ENABLE UNWIND => NULL; IF frame1 = NIL THEN { frame1 ¬ frame; style1 ¬ style } ELSE IF frame2 = NIL THEN { frame2 ¬ frame; style2 ¬ style } ELSE IF frame3 = NIL THEN { frame3 ¬ frame; style3 ¬ style } ELSE IF frame4 = NIL THEN { frame4 ¬ frame; style4 ¬ style } ELSE FOR lst: FrameInfo ¬ frameList, lst.rest UNTIL lst=NIL DO IF lst.frame = NIL THEN { lst.frame ¬ frame; lst.style ¬ style; EXIT }; REPEAT FINISHED => frameList ¬ NEW[FrameInfoBody ¬ [frame, style, frameList]]; ENDLOOP; }; AllocFrame[styleName, kind]; -- use styleName and kind as hint about which to allocate IF styleName # NIL THEN { <> styleNameObj: Object; done: BOOL ¬ FALSE; [found, styleNameObj] ¬ TJaM.TryToLoad[frame, styleDictName]; IF found THEN { -- some style dictionary on stack already IF TypeCheckName[styleNameObj] = styleName THEN { -- still must check kind of style kindNameObj: Object; [found, kindNameObj] ¬ TJaM.TryToLoad[frame, styleKindName]; IF found AND TypeCheckName[kindNameObj] = kindNames[kind] THEN done ¬ TRUE; }; -- already there IF NOT done THEN -- get rid of top dictionary WHILE TJaM.DictTop[frame] # styledict DO TJaM.End[frame]; ENDLOOP; }; IF NOT done THEN TJaM.Begin[frame, GetStyleDict[frame, styleName, kind]] } ELSE WHILE TJaM.DictTop[frame] # styledict DO TJaM.End[frame] ENDLOOP; SaveStyleInfo[]; }; FreeFrame: PUBLIC ENTRY PROC [frame: Frame, styleName: ATOM, kind: OfStyle] ~ { <> ENABLE UNWIND => NULL; freeFrameCalls ¬ freeFrameCalls+1; <> IF freeFrame1 = NIL THEN { freeFrame1 ¬ frame; styleName1 ¬ styleName; styleKind1 ¬ kind } ELSE IF freeFrame2 = NIL THEN { freeFrame2 ¬ frame; styleName2 ¬ styleName; styleKind2 ¬ kind } ELSE IF freeFrame3 = NIL THEN { freeFrame3 ¬ frame; styleName3 ¬ styleName; styleKind3 ¬ kind } ELSE IF freeFrame4 = NIL THEN { freeFrame4 ¬ frame; styleName4 ¬ styleName; styleKind4 ¬ kind } ELSE { frameFree ¬ frameFree+1; }; -- let garbage collector find it <> SELECT frame FROM frame1 => { frame1 ¬ NIL; style1 ¬ NIL }; frame2 => { frame2 ¬ NIL; style2 ¬ NIL }; frame3 => { frame3 ¬ NIL; style3 ¬ NIL }; frame4 => { frame4 ¬ NIL; style4 ¬ NIL }; ENDCASE => FOR lst: FrameInfo ¬ frameList, lst.rest UNTIL lst=NIL DO IF lst.frame = frame THEN { lst.frame ¬ NIL; lst.style ¬ NIL; EXIT }; ENDLOOP; }; frame1, frame2, frame3, frame4: Frame ¬ NIL; -- small cache of active frames frameAlloc: INT ¬ 0; -- number of frames allocated from TJaM frameFree: INT ¬ 0; -- number of frames freed by TJaM allocFrameCalls: INT ¬ 0; -- number of times called AllocFrame freeFrameCalls: INT ¬ 0; -- number of times called FreeFrame. should = allocFrameCalls style1, style2, style3, style4: Ref; -- style bodies associated with active frames 1,2,3,4 frameList: FrameInfo; -- chain of known frames beyond the small cache here freeFrame1, freeFrame2, freeFrame3, freeFrame4: Frame ¬ NIL; styleName1, styleName2, styleName3, styleName4: ATOM ¬ NIL; styleKind1, styleKind2, styleKind3, styleKind4: OfStyle ¬ screen; debugFlag: BOOL ¬ TRUE; debugStyle: Ref; StyleForFrame: PUBLIC PROC [frame: Frame] RETURNS [style: Ref] ~ { GetIt: ENTRY PROC RETURNS [s: Ref] ~ { ENABLE UNWIND => NULL; SELECT frame FROM frame1 => RETURN [style1]; frame2 => RETURN [style2]; frame3 => RETURN [style3]; frame4 => RETURN [style4]; ENDCASE => FOR lst: FrameInfo ¬ frameList, lst.rest UNTIL lst=NIL DO IF lst.frame=frame THEN RETURN [lst.style]; ENDLOOP }; IF (style ¬ GetIt[]) = NIL THEN { -- failed to find the frame IF debugFlag THEN { IF debugStyle = NIL THEN debugStyle ¬ NodeStyleOps.Create[]; RETURN [debugStyle]; }; ERROR; }; RETURN [style]; }; <