<> <> <> <> <> <> <> <> <> <> <<>> DIRECTORY Ascii, Atom, Convert, MessageWindow, NameSymbolTable, NodeProps, NodeStyle, NodeStyleOps, NodeStyleWorks, Process, Rope, TextLooks, TJaMBasic, TJaMInternal, TJaMOps, TJaMVM, UserProfile; NodeStyleWorks1Impl: CEDAR MONITOR IMPORTS TJaMOps, TJaMVM, Process, Rope, MessageWindow, NodeStyle, NodeStyleOps, NodeStyleWorks, NameSymbolTable EXPORTS NodeStyleWorks = BEGIN OPEN NodeStyle, NodeStyleWorks; <> FrameInfo: TYPE = REF FrameInfoBody; FrameInfoBody: TYPE = RECORD [ frame: Frame, style: Ref, rest: FrameInfo ]; GetFrame: PUBLIC PROC [style: Ref, styleName: Name, kind: OfStyle] RETURNS [frame: Frame] = TRUSTED { <<-- 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: Name, kind: OfStyle] = TRUSTED { ENABLE UNWIND => NULL; allocFrameCalls _ allocFrameCalls+1; IF name # NameSymbolTable.nullName 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 _ TJaMOps.NewFrame[]; frameAlloc _ frameAlloc+1; TJaMOps.Begin[frame, sysdict]; TJaMOps.Begin[frame, styledict]; }; }; SaveStyleInfo: ENTRY PROC = TRUSTED { 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 # NameSymbolTable.nullName THEN { <<-- get the proper style dictionary on the frame dictionary stack>> styleNameObj: Object; done: BOOL _ FALSE; [found, styleNameObj] _ TJaMOps.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] _ TJaMOps.TryToLoad[frame, styleKindName]; IF found AND TypeCheckName[kindNameObj]=kindNames[kind] THEN done _ TRUE; }; -- already there IF ~done THEN -- get rid of top dictionary WHILE TJaMOps.TopDict[frame.dictstk] # styledict DO TJaMOps.End[frame]; ENDLOOP; }; IF ~done THEN TJaMOps.Begin[frame, GetStyleDict[frame, styleName, kind]] } ELSE WHILE TJaMOps.TopDict[frame.dictstk] # styledict DO TJaMOps.End[frame]; ENDLOOP; SaveStyleInfo[]; }; FreeFrame: PUBLIC ENTRY PROC [frame: Frame, name: Name, kind: OfStyle] = TRUSTED { <<-- name and kind are just a hint about what style dictionary is on the frame stack>> ENABLE UNWIND => NULL; freeFrameCalls _ freeFrameCalls+1; <<-- add it to cache of free frames or really free it if cache full>> IF freeFrame1 = NIL THEN { freeFrame1 _ frame; styleName1 _ name; styleKind1 _ kind } ELSE IF freeFrame2 = NIL THEN { freeFrame2 _ frame; styleName2 _ name; styleKind2 _ kind } ELSE IF freeFrame3 = NIL THEN { freeFrame3 _ frame; styleName3 _ name; styleKind3 _ kind } ELSE IF freeFrame4 = NIL THEN { freeFrame4 _ frame; styleName4 _ name; styleKind4 _ kind } ELSE { frameFree _ frameFree+1; TJaMOps.FreeFrame[frame] }; -- really free it <<-- remove it from active frame info>> 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: Name _ NameSymbolTable.nullName; styleKind1, styleKind2, styleKind3, styleKind4: OfStyle _ screen; debugFlag: BOOL _ TRUE; debugStyle: Ref; StyleForFrame: PUBLIC PROC [frame: Frame] RETURNS [style: Ref] = TRUSTED { GetIt: ENTRY PROC RETURNS [s: Ref] = TRUSTED INLINE { 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]; }; <