<> <> <> <> <> <> <<>> DIRECTORY BasicTime USING [GMT, nullGMT], FS USING [Error, FileInfo], MessageWindow USING [Append, Blink, Clear], NodeStyle USING [GetReal, RealParam, Ref, SetReal], NodeStyleFont USING [FontFromStyleParams], NodeStyleOps USING [Create, defaultStyle, defaultStyleName, FlushCaches, LoadStyle, OfStyle], NodeStyleValidate USING [], NodeStyleWorks USING [AddRealProc, ForceLowerName, get, LoadProc, Ops, OpsRec, Param, ParamRec, PercentProc, PopName, RegisterStyleCommand, run, SetNameProc, StoreProc, TryToPopName, TypeCheckDict, TypeCheckName], PrincOpsUtils USING [], Process USING [GetCurrent], RefTab USING [Create, Fetch, Pairs, Ref, Store], Rope USING [Concat, Equal, FromChar, ROPE], TextLooks USING [Look, Looks], TJaM USING [ABind, ACopy, AGet, APut, Array, AtomFromRope, AttachDict, Begin, ClrDict, CommandProc, CountStack, CvX, DetachAll, DetachDict, Dict, DictTop, End, Execute, 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 FS, MessageWindow, NodeStyle, NodeStyleFont, NodeStyleOps, NodeStyleWorks, Process, RefTab, Rope, 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] ~ { 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 ~ { 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]; }; <