DIRECTORY
Ascii,
Atom,
Convert,
MessageWindow,
NameSymbolTable,
NodeProps,
NodeStyle,
NodeStyleOps,
NodeStyleWorks,
Process,
Rope,
TextLooks,
TJaMBasic,
TJaMInternal,
TJaMOps,
TJaMVM,
UserProfile;

NodeStyleWorksImpl: CEDAR MONITOR
IMPORTS TJaMOps, TJaMVM, Process, Rope, MessageWindow, 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 {
found: BOOL;
AllocFrame: ENTRY PROC [name: Name, kind: OfStyle] = TRUSTED { 
ENABLE UNWIND => NULL;
allocFrameCalls _ allocFrameCalls+1;
IF name # NameSymbolTable.nullName THEN {
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 }};
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 {
styleNameObj: Object;
done: BOOL _ FALSE;
[found, styleNameObj] _ TJaMOps.TryToLoad[frame, NameToObject[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, NameToObject[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 {
ENABLE UNWIND => NULL;
freeFrameCalls _ freeFrameCalls+1;
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
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];
};
GetStyleDict: PUBLIC PROC [frame: Frame, name: Name, kind: OfStyle, def: Rope.ROPE _ NIL]
RETURNS [d: dict Object] = {
found, ok: BOOL;
name _ ForceLowerName[name];
[d, found] _ CheckStyleDict[name, kind];
IF found THEN RETURN;
ok _ IF def # NIL THEN RunStyleString[frame, name, def] ELSE RunStyle[frame, name];
IF ok THEN [d, found] _ CheckStyleDict[name, kind];
IF ~found THEN {
BadStyleFile[frame, name];
[d, found] _ CheckStyleDict[name, kind];
};
};

BadStyleFile: PUBLIC PROC [frame: Frame, name: Name] = TRUSTED {
{
ENABLE {
WhatStyle => { styleName _ name; RESUME };
StartOfStyle => RESUME;
EndOfStyle => RESUME;
};
BeginStyleOp[frame];
IF name # NodeStyleOps.defaultStyleName THEN {
PushName[frame, NodeStyleOps.defaultStyleName];
AttachStyleOp[frame];
};
EndStyleOp[frame];
};
Process.Detach[FORK BadStyleMessage[name]];
PushName[frame, name];
PushText[frame, "style was bad."L];
StyleError[frame, 2];
};

BadStyleMessage: PROC [name: Name] = {
MessageWindow.Append[NameSymbolTable.RopeFromName[name], TRUE];
MessageWindow.Append[".style could not be loaded."];
};

CreateStyleDict: PROC RETURNS [d: dict Object] = TRUSTED { -- creates dict for style
RETURN [TJaMOps.Dict[50]];
};

EnterStyleDict: PROC [name: Name, d: Object, kind: OfStyle] = TRUSTED INLINE {
TJaMOps.Put[stylesDicts[kind], NameToObject[name], d];
};

CheckStyleDict: PROC [name: Name, kind: OfStyle]
RETURNS [d: dict Object, found: BOOL] = TRUSTED {
obj: Object;
[found, obj] _ TJaMOps.TryToGet[stylesDicts[kind], NameToObject[name]];
IF found THEN d _ TypeCheckDict[obj];
};

RunStyle: PUBLIC PROC [frame: Frame, name: Name] RETURNS [ok: BOOL] = TRUSTED {
txt: REF TEXT _ NEW[TEXT[64]];
ext: STRING = ".style";
txtlen: NAT;
hasExt, started, finished: BOOL _ FALSE;
NameSymbolTable.FromName[name, txt];
txtlen _ txt.length;
FOR i:NAT IN [0..txtlen) DO -- see if has an extension already
IF txt[i] = '. THEN { hasExt _ TRUE; EXIT }; ENDLOOP;
FOR i:NAT IN [0..ext.length) DO txt[txtlen+i] _ ext[i]; ENDLOOP;
txt.length _ txtlen+ext.length;
PushText[frame, LOOPHOLE[txt, LONG STRING]];
TJaMOps.Put[attachmentsDict, NameToObject[name], TJaMOps.Array[0]];
TJaMOps.Execute[frame, run ! 
WhatStyle => { styleName _ name; RESUME };
StartOfStyle => { started _ TRUE; RESUME };
EndOfStyle => { finished _ TRUE; RESUME };
];
RETURN [started AND finished];
};

RunStyleString: PUBLIC PROC [frame: Frame, name: Name, def: Rope.ROPE]
RETURNS [ok: BOOL] = TRUSTED {
started, finished: BOOL _ FALSE;
TJaMOps.Put[attachmentsDict, NameToObject[name], TJaMOps.Array[0]];
TJaMOps.Execute[frame,
CVX[TJaMOps.MakeString[LOOPHOLE[Rope.Flatten[def], LONG STRING]]] ! 
WhatStyle => { styleName _ name; RESUME };
StartOfStyle => { started _ TRUE; RESUME };
EndOfStyle => { finished _ TRUE; RESUME };
];
RETURN [started AND finished];
};

sysdict: PUBLIC dict Object;
userdict: PUBLIC dict Object;
styledict: PUBLIC dict Object;
styleDictName: Name = NameSymbolTable.MakeName["##styleDictName"];
styleKindName: Name = NameSymbolTable.MakeName["##styleKindName"];

StartOfStyle: SIGNAL = CODE; -- raised to indicate start of loading style
EndOfStyle: SIGNAL = CODE; -- raised to indicate successful loading
WhatStyle: SIGNAL RETURNS [styleName: Name] = CODE; -- raised to find name of style being loaded

BeginStyleOp: PROC [frame: Frame] = TRUSTED {
name: Name _ ForceLowerName[SIGNAL WhatStyle]; -- get style name from RunStyle
screenDict, printDict, baseDict: dict Object;
ResetDict: PROC [dict: dict Object] = TRUSTED {
TJaMOps.ClrDict[dict];
TJaMOps.DetachAll[dict];
};
MakeDict: PROC [kind: OfStyle] RETURNS [dict: dict Object] = TRUSTED {
dict _ CreateStyleDict[];
EnterStyleDict[name, dict, kind];
};
InitDict: PROC [dict: dict Object, kind: OfStyle] = TRUSTED {
TJaMOps.Put[baseDict, NameToObject[styleRuleDictNames[kind]], TJaMOps.Dict[50]];
TJaMOps.Put[dict, NameToObject[styleKindName], NameToObject[kindNames[kind]]];
};
found: BOOL;
[baseDict, found] _ CheckStyleDict[name, base]; -- check if reloading
IF found THEN {
ResetDict[baseDict];
[printDict, ] _ CheckStyleDict[name, print];
ResetDict[printDict];
[screenDict, ] _ CheckStyleDict[name, screen];
ResetDict[screenDict];
NodeStyleOps.FlushCaches[] }
ELSE {
baseDict _ MakeDict[base];
screenDict _ MakeDict[screen];
printDict _ MakeDict[print] };
InitDict[baseDict, base]; InitDict[screenDict, screen]; InitDict[printDict, print];

TJaMOps.AttachDict[screenDict, baseDict];
TJaMOps.AttachDict[printDict, baseDict];

TJaMOps.Put[baseDict, NameToObject[styleDictNames[screen]], screenDict];
TJaMOps.Put[baseDict, NameToObject[styleDictNames[print]], printDict];
TJaMOps.Put[baseDict, NameToObject[styleDictNames[base]], baseDict];

TJaMOps.Put[baseDict, NameToObject[styleDictName], NameToObject[name]];

TJaMOps.Begin[frame, baseDict];
PushObject[frame, baseDict]; -- leave this around for EndStyleOp
SIGNAL StartOfStyle; -- caught by RunStyle
};

StyleNameOp: PROC [frame: Frame] = TRUSTED { -- expects style dictionary on op stack
PushObject[frame, TJaMOps.Load[frame, NameToObject[styleDictName]]]
};

EndStyleOp: PROC [frame: Frame] = TRUSTED {
d1, d2: dict Object;
d1 _ TJaMOps.TopDict[frame.dictstk]; -- the current dictionary
d2 _ TJaMOps.PopDict[frame.opstk]; -- pushed by StyleOp
IF d1 # d2 THEN {
PushText[frame, "mismatched Style and EndStyle commands"L];
StyleError[frame, 1];
}
ELSE { -- change attachments so look in own basicDict before any attached dicts
name: Name _ SIGNAL WhatStyle;
screenDict: dict Object = CheckStyleDict[name, screen].d;
printDict: dict Object = CheckStyleDict[name, print].d;
TJaMOps.DetachDict[screenDict, d1];
TJaMOps.DetachDict[printDict, d1];
TJaMOps.AttachDict[screenDict, d1];
TJaMOps.AttachDict[printDict, d1];
TJaMOps.End[frame];
};
SIGNAL EndOfStyle; -- caught by RunStyle
};

styleRuleDictNames: REF ARRAY OfStyle OF Name = NEW[ARRAY OfStyle OF Name];
styleDictNames: REF ARRAY OfStyle OF Name = NEW[ARRAY OfStyle OF Name];

StyleRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame, base] };

PrintRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame, print] };

ScreenRuleOp: PROC [frame: Frame] = { DefineStyleRule[frame, screen] };

DefineStyleRule: PROC [frame: Frame, kind: OfStyle] = TRUSTED {
definition: Object _ PopObject[frame];
comment: Object _ PopObject[frame];
STKname: Name _ PopName[frame];
name: Name _ ForceLowerName[STKname];
nameObj: Object _ NameToObject[name];
dict: dict Object _ LoadStyleDict[frame, kind];
WITH x:definition SELECT FROM
array => TJaMOps.ABind[x, bindingDict];
ENDCASE; -- def may be a string
TJaMOps.Put[dict, nameObj, CVX[definition]]; -- save the definition
IF name#STKname THEN TJaMOps.Put[dict, NameToObject[STKname], CVX[definition]];
TJaMOps.Put[LoadStyleRuleDict[frame, kind], nameObj, comment]; -- save the comment in the rule name dict
};

LoadStyleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [dict Object] = TRUSTED {
RETURN [TypeCheckDict[TJaMOps.Load[frame, NameToObject[styleDictNames[kind]]]]];
};

LoadStyleRuleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [dict Object] = TRUSTED {
RETURN [TypeCheckDict[TJaMOps.Load[frame, NameToObject[styleRuleDictNames[kind]]]]];
};

OpenPrintStyleOp: PROC [frame: Frame] = { -- expects style name on op stack
OpenStyle[frame, print];
};

OpenScreenStyleOp: PROC [frame: Frame] = { -- expects style name on op stack
OpenStyle[frame, screen];
};

OpenStyle: PROC [frame: Frame, kind: OfStyle] = TRUSTED {
name: Name _ PopName[frame];
IF NOT NodeStyleOps.LoadStyle[name] THEN RETURN;
WHILE TJaMOps.TopDict[frame.dictstk] # sysdict DO TJaMOps.End[frame]; ENDLOOP;
TJaMOps.Begin[frame, styledict];
TJaMOps.Begin[frame, GetStyleDict[frame, name, kind]];
};

ResetTestStyleOp: PROC [frame: Frame] = { 
IF debugStyle=NIL THEN debugStyle _ NodeStyleOps.Create[];
debugStyle^ _ NodeStyleOps.defaultStyle^;
};

StyleRuleDictOp: PROC [frame: Frame] = { GetRuleDict[frame, base] };

PrintRuleDictOp: PROC [frame: Frame] = { GetRuleDict[frame, print] };

ScreenRuleDictOp: PROC [frame: Frame] = { GetRuleDict[frame, screen] };

GetRuleDict: PROC [frame: Frame, kind: OfStyle] = TRUSTED {
PushName[frame, styleRuleDictNames[kind]];
TJaMOps.Execute[frame, get];
};

AttachStyleOp: PROC [frame: Frame] = TRUSTED { -- expects opstk to contain style name
name: Name _ ForceLowerName[PopName[frame]];
found: BOOL;
printDict, screenDict: dict Object;
array: array Object;
styleName: Name _ SIGNAL WhatStyle;
val: Object;
[printDict, found] _ CheckStyleDict[name, print];
IF ~found THEN {
IF RunStyle[frame, name] THEN [printDict, found] _ CheckStyleDict[name, print];
IF ~found THEN {
BadStyleFile[frame, name];
RETURN }};
[screenDict, found] _ CheckStyleDict[name, screen];
IF ~found THEN ERROR;
TJaMOps.AttachDict[LoadStyleDict[frame, screen], screenDict];
TJaMOps.AttachDict[LoadStyleDict[frame, print], printDict];
[found, val] _ TJaMOps.TryToGet[attachmentsDict, NameToObject[styleName]];
IF ~found THEN array _ TJaMOps.Array[1] -- this is the first attachment
ELSE { -- add new item to the array
WITH val:val SELECT FROM
array => array _ val;
ENDCASE => ERROR;
array _ TJaMOps.ACopy[array, 1] };
TJaMOps.APut[array, array.length-1, NameToObject[name]];
TJaMOps.Put[attachmentsDict, NameToObject[styleName], array];
};
ForEachAttachedStyle: PUBLIC PROC [dictName: Name, proc: PROC [attached: Name]
RETURNS [stop: BOOL]] = TRUSTED {
val: Object;
array: array Object;
found: BOOL;
dictName _ NodeStyleWorks.ForceLowerName[dictName];
[found, val] _ TJaMOps.TryToGet[attachmentsDict, NameToObject[dictName]];
IF ~found THEN RETURN;
WITH val:val SELECT FROM
array => array _ val;
ENDCASE => ERROR;
FOR i: CARDINAL IN [0..array.length) DO
ob: Object _ TJaMVM.GetElem[array, i];
IF proc[TypeCheckName[ob]] THEN RETURN;
ENDLOOP;
};


ExecuteName: PUBLIC PROC [frame: Frame, name: Name] RETURNS [ok: BOOL] = TRUSTED {
initDepth: CARDINAL _ TJaMOps.CountStack[frame.opstk];
finalDepth: CARDINAL;
nameObj: Object _ NameToObject[name];
[ok, ] _ TJaMOps.TryToLoad[frame, nameObj];
IF ~ok THEN RETURN;
executingName _ name;
TJaMOps.Execute[frame, CVX[nameObj]];
executingName _ NameSymbolTable.nullName;
IF (finalDepth _ TJaMOps.CountStack[frame.opstk]) # initDepth THEN {
PushText[frame, "Failed to leave stack at same depth after execution.\n"L];
PushName[frame, name];
StyleError[frame, 2];
ok _ FALSE;
};
};

ExecuteNameInStyle: PUBLIC PROC [ref: Ref, kind: OfStyle, name: Name]
RETURNS [ok: BOOL] = TRUSTED {
styleName: Name _ ref.name[style];
frame: Frame _ GetFrame[ref, styleName, kind];
initDepth: CARDINAL _ TJaMOps.CountStack[frame.opstk];
finalDepth: CARDINAL;
nameObj: Object _ NameToObject[name];
[ok, ] _ TJaMOps.TryToLoad[frame, nameObj];
IF NOT ok THEN RETURN;
executingName _ name;
TJaMOps.Execute[frame, CVX[nameObj]];
executingName _ NameSymbolTable.nullName;
IF (finalDepth _ TJaMOps.CountStack[frame.opstk]) # initDepth THEN {
PushText[frame, "Failed to leave stack at same depth after execution.\n"L];
PushName[frame, name];
StyleError[frame, 2];
ok _ FALSE;
};
FreeFrame[frame, styleName, kind];
frame _ NIL;
};

ExecuteObjectInStyle: PUBLIC PROC [ref: Ref, kind: OfStyle, object: Object]
RETURNS [ok: BOOL] = TRUSTED {
styleName: Name _ ref.name[style];
frame: Frame _ GetFrame[ref, styleName, kind];
initDepth: CARDINAL _ TJaMOps.CountStack[frame.opstk];
finalDepth: CARDINAL;
ok _ TRUE;
TJaMOps.Execute[frame, CVX[object]];
IF (finalDepth _ TJaMOps.CountStack[frame.opstk]) # initDepth THEN {
PushObject[frame, object];
PushText[frame, "Failed to leave stack at same depth after execution.\n"L];
StyleError[frame, 2];
ok _ FALSE;
};
FreeFrame[frame, styleName, kind];
frame _ NIL;
};

ExecuteLooksInStyle: PUBLIC PROC [ref: Ref, kind: OfStyle, looks: TextLooks.Looks]
RETURNS [ok: BOOL] = TRUSTED {
styleName: Name _ ref.name[style];
frame: Frame _ GetFrame[ref, styleName, kind];
ok _ TRUE;
FOR c: CHAR IN TextLooks.Look DO
IF looks[c] THEN ok _ ExecuteName[frame, lookNames[c]]
ENDLOOP;
FreeFrame[frame, styleName, kind];
frame _ NIL;
};

executingName: PUBLIC Name;

lookNames: REF LookNames _ NEW[LookNames];
LookNames: TYPE = ARRAY TextLooks.Look OF Name; 
InitLookNames: PROC = TRUSTED {
txt: STRING _ [6];
txt[0] _ 'l; txt[1] _ txt[2] _ 'o; txt[3] _ 'k; txt[4] _ '.; txt.length _ 6;
FOR c: CHAR IN TextLooks.Look DO
txt[5] _ c;
lookNames[c] _ NameSymbolTable.MakeName[LOOPHOLE[LONG[txt], REF READONLY TEXT]];
ENDLOOP;
};

StyleError: PUBLIC PROC [frame: Frame, num: INTEGER] = TRUSTED {
PushInteger[frame, num];
TJaMOps.Execute[frame, CVX[NameToObject[styleerror]]];
};
opsList: PUBLIC LIST OF RECORD[param: Param, op: PROC [frame: Frame]];
Preregister: PUBLIC PROC [param: Param, op: PROC [frame: Frame]] RETURNS [Param] ~ {
opsList _ CONS[[param, op], opsList];
RETURN [param];
};
DoStyleOp: PUBLIC PROC [frame: Frame, p: Param] = {
nameflag: BOOL;
name: Name;
style: Ref _ StyleForFrame[frame];
Error: PROC = {
PushName[frame, NameSymbolTable.MakeName[p.opName]];
PushText[frame, "illegal as qualifer for"L];
PushName[frame, name];
StyleError[frame, 3];
};
[name, nameflag] _ TryToPopName[frame];
IF ~nameflag THEN p.ops.Store[frame, p, style] -- e.g., "10 pt leading"
ELSE SELECT name FROM
the => p.ops.Load[frame, p, style]; -- e.g., "the leading"
bigger => {
[name, nameflag] _ TryToPopName[frame];
IF ~nameflag THEN p.ops.AddReal[frame, PopReal[frame], p, style]
ELSE IF name=percent THEN p.ops.Percent[frame, 100+PopReal[frame], p, style]
ELSE { Error; RETURN };
};
smaller => {
[name, nameflag] _ TryToPopName[frame];
IF ~nameflag THEN p.ops.AddReal[frame, -PopReal[frame], p, style]
ELSE IF name=percent THEN p.ops.Percent[frame, 100-PopReal[frame], p, style]
ELSE { Error; RETURN };
};
percent => p.ops.Percent[frame, PopReal[frame], p, style];
ENDCASE => p.ops.SetName[frame, name, p, style]; -- e.g., "TimesRoman family"
};
StoreError: PUBLIC StoreProc = {
ob: TJaMBasic.Object _ PopObject[frame];
PushName[frame, NameSymbolTable.MakeName[p.opName]];
PushText[frame, "is not legal as value for"L];
PushObject[frame, ob];
StyleError[frame, 3];
};

AddRealError: PUBLIC AddRealProc = { 
PushName[frame, NameSymbolTable.MakeName[p.opName]];
PushText[frame, "Numbers are illegal as values for"L];
StyleError[frame, 2];
};

PercentError: PUBLIC PercentProc = { 
PushName[frame, NameSymbolTable.MakeName[p.opName]];
PushText[frame, "Numbers are illegal as values for"L];
StyleError[frame, 2];
};

SetNameError: PUBLIC SetNameProc = { 
PushName[frame, NameSymbolTable.MakeName[p.opName]];
PushText[frame, "Only numbers are legal as values for"L];
StyleError[frame, 2];
};
nameOps: PUBLIC Ops _ NEW [OpsRec _
[LoadNameParam, StoreError, AddRealError, PercentError, SetNameParam]];

LoadNameParam: PUBLIC LoadProc = {
PushName[frame, style.name[NARROW[p, REF ParamRec.name].param]];
};

SetNameParam: PUBLIC SetNameProc = {
style.name[NARROW[p, REF ParamRec.name].param] _ name;
};

NameError: PUBLIC PROC [frame: Frame, name: Name, p: Param] = {
PushName[frame, NameSymbolTable.MakeName[p.opName]];
PushText[frame, "illegal as value for"L];
PushName[frame, name];
StyleError[frame, 3];
};

realOps: PUBLIC Ops _ NEW [OpsRec _
[RealOpLoad, RealOpSetReal, RealOpAddReal, RealOpPercent, SetNameError]];

RealOpLoad: PUBLIC LoadProc = {
PushReal[frame, GetReal[style, NARROW[p, REF ParamRec.real].param]]};

RealOpSetReal: PUBLIC StoreProc = {
SetReal[style, NARROW[p, REF ParamRec.real].param, PopReal[frame]]};

RealOpAddReal: PUBLIC AddRealProc = {
x: REF ParamRec.real = NARROW[p];
SetReal[style, x.param, GetReal[style, x.param]+inc]};

RealOpPercent: PUBLIC PercentProc = {
val: REAL _ GetReal[style, NARROW[p, REF ParamRec.real].param];
SetReal[style, NARROW[p, REF ParamRec.real].param, (percent/100)*val];
};

glueOps: PUBLIC Ops _ NEW [OpsRec _
[GlueOpLoad, GlueOpSetReal, GlueOpAddReal, GlueOpPercent, SetNameError]];

GlueOpLoad: PUBLIC LoadProc = {
Get: PROC [param: RealParam] = {
PushReal[frame, GetReal[style, param]] };
x: REF ParamRec.glue = NARROW[p];
Get[x.size]; Get[x.stretch]; Get[x.shrink];
};

GlueOpSetReal: PUBLIC StoreProc = {
Set: PROC [param: RealParam] = {
SetReal[style, param, PopReal[frame]] };
x: REF ParamRec.glue = NARROW[p];
Set[x.shrink]; Set[x.stretch]; Set[x.size];
};

GlueOpAddReal: PUBLIC AddRealProc = {
Add: PROC [param: RealParam] = {
SetReal[style, param, GetReal[style, param]+inc] };
x: REF ParamRec.glue = NARROW[p];
Add[x.size]; Add[x.stretch]; Add[x.shrink];
};

GlueOpPercent: PUBLIC PercentProc = {
Set: PROC [param: RealParam] = {
val: REAL _ GetReal[style, param];
SetReal[style, param, (percent/100)*val];
};
x: REF ParamRec.glue = NARROW[p];
Set[x.size]; Set[x.stretch]; Set[x.shrink];
};

colorOps: PUBLIC Ops _ NEW [OpsRec _
[ColorOpLoad, ColorOpSetReal, ColorOpAddReal, ColorOpPercent, SetNameError]];

ColorOpLoad: PUBLIC LoadProc = {
Get: PROC [param: RealParam] = {
PushReal[frame, GetReal[style, param]];
};
x: REF ParamRec.color = NARROW[p];
Get[x.hue]; Get[x.saturation]; Get[x.brightness];
};

ColorOpSetReal: PUBLIC StoreProc = {
Set: PROC [param: RealParam] = {
SetReal[style, param, PopReal[frame]];
};
x: REF ParamRec.color = NARROW[p];
Set[x.brightness]; Set[x.saturation]; Set[x.hue];
};

ColorOpAddReal: PUBLIC AddRealProc = {
Add: PROC [param: RealParam] = {
SetReal[style, param, GetReal[style, param]+inc];
};
x: REF ParamRec.color = NARROW[p];
Add[x.hue]; Add[x.saturation]; Add[x.brightness];
};

ColorOpPercent: PUBLIC PercentProc = {
Set: PROC [param: RealParam] = {
val: REAL _ GetReal[style, param];
SetReal[style, param, (percent/100)*val];
};
x: REF ParamRec.color = NARROW[p];
Set[x.hue]; Set[x.saturation]; Set[x.brightness];
};

END.
NodeStyleWorksImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Written by Bill Paxton, January 1981
Paxton, June 3, 1983 3:35 pm
Maxwell, January 6, 1983 10:05 am
Russ Atkinson, March 7, 1985 3:37:01 am PST
Paul Rovner, August 10, 1983 4:43 pm
Doug Wyatt, March 5, 1985 10:51:57 am PST
Micheal Plass, March 14, 1985 4:26:04 pm PST
Rick Beach, March 19, 1985 8:22:33 am PST

Execution Frames for Style Machinery
-- 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
-- first try to find one that already has the right style 
-- look for any free one
-- get the proper style dictionary on the frame dictionary stack
-- name and kind are just a hint about what style dictionary is on the frame stack
-- add it to cache of free frames or really free it if cache full
-- remove it from active frame info
Load style procedures

fake it so looks as if had a file saying "BeginStyle (default) AttachStyle EndStyle"
-- need to fork this so to avoid monitor deadlock in viewers
Style Dictionary Operations
create rule name dict in baseDict
record the style kind
expects <name> <comment> <definition> on op stack
Execute Styles
makes sure that same stack depth after execute
makes sure that same stack depth after execute
makes sure that same stack depth after execute
makes sure that same stack depth after execute
names are "look.a", "look.b", "look.c", etc.
Implementing Style Attribute Operations
-- e.g., "2 pt bigger leading"
-- e.g., "2 percent bigger leading"
-- e.g., "2 pt smaller leading"
-- e.g., "2 percent smaller leading"
General Error Routines
Name Parameter Operations
Real Parameter Operations
Glue Parameter Operations
Color Parameter Operations

Κ:˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ$™$Kš
œ™Kš
œ!™!K™+K™$K™)K™,J™)—K™š
Οk	˜	K˜K˜K˜K˜K˜K˜
K˜
K˜
K˜K˜K˜K˜
K˜
K˜
K˜K˜K˜—K˜KšΠblœžœ
ž˜!Kšžœ]˜dKšžœ˜Kšœžœ
žœ˜'
headš
œ$™$Kšœžœžœ˜$Kšœžœžœ/˜KK˜š
Οnœžœ
žœ-žœžœ˜eKš
œ9™9Kš
œ2™2Kš
œC™CKšœžœ
˜š 
œžœ
žœžœ˜?Kšžœ
žœžœ
˜K˜$šžœ!žœ˜)Kš
œ:™:š	žœžœžœžœ
ž˜@Kšœ#žœžœ˜1—š	žœžœžœžœ
ž˜@Kšœ#žœžœ˜1—š	žœžœžœžœ
ž˜@Kšœ#žœžœ˜1—š	žœžœžœžœ
ž˜@Kšœ#žœžœ˜2——Kš
œ™Kšžœžœ
žœ$žœ˜AKš
žœ
žœžœ
žœ$žœ˜FKš
žœ
žœžœ
žœ$žœ˜FKš
žœ
žœžœ
žœ$žœ˜Fšžœ˜K˜6K˜K˜ K˜—K˜—š 
œžœ
žœžœ˜%Kšžœ
žœžœ
˜Kšžœ
žœ
žœ#˜7Kšžœ
žœ
žœ
žœ#˜<Kšžœ
žœ
žœ
žœ#˜<Kšžœ
žœ
žœ
žœ#˜<š	žœ
žœ&žœžœ
ž˜>Kšžœ
žœ
žœ)žœ˜GKšžœ
žœžœ,˜NKšžœ
˜—Kš
œ˜—KšœΟc9˜Všžœ&žœ˜.Kš
œ@™@K˜Kšœžœžœ
˜K˜Nšžœžœ‘)˜9šžœ)žœ‘!˜SK˜K˜Mšžœžœ,ž˜<Kšœžœ
˜—Kšœ‘˜—šžœžœ
‘˜*šžœ,ž˜3Kšœžœ
˜——Kš
œ˜—Kšžœžœ;˜HKš
œ
˜
—Kšžœ
žœ,žœžœ
˜UK˜K˜—K˜š
 	œžœ
žœ
žœ-žœ˜RKš
œR™RKšžœ
žœžœ
˜K˜"Kš
œA™Ašžœžœ
žœ˜Kš
œ:˜:—šžœ
žœžœ
žœ˜Kš
œ:˜:—šžœ
žœžœ
žœ˜ K˜:—šžœ
žœžœ
žœ˜K˜:—Kšžœ8‘˜MKš
œ#™#šžœž˜Kšœžœžœ˜)Kšœžœžœ˜)Kšœžœžœ˜)Kšœžœžœ˜)š	žœžœ&žœžœ
ž˜DKš
žœžœžœžœžœ˜EKšžœ
˜——K˜—K˜Kšœ(žœ‘˜LKšœžœ‘'˜<Kšœžœ‘!˜5Kšœžœ‘$˜>Kšœžœ‘=˜VKšœ&‘5˜[Kšœ‘4˜KK˜Kšœ8žœ
˜<K˜PK˜AK˜Kšœžœžœ
˜K˜K˜š
 
œžœ
žœžœžœ˜Jš œžœ
žœ
žœžœ
žœ˜5Kšžœ
žœžœ
˜šžœž˜Kšœ
žœ
˜Kšœ
žœ
˜Kšœ
žœ
˜Kšœ
žœ
˜š	žœžœ&žœžœ
ž˜DKšžœžœ
žœ
˜+Kšžœ˜
———šžœžœ
žœ‘˜=šžœžœ˜Kšžœžœ
žœ$˜:Kšžœ˜—Kšžœ˜—Kšžœ	˜Kš
œ˜——š
œ™š œžœ
žœ5žœžœžœ˜vKšœžœ
˜K˜K˜(Kšžœžœ
žœ
˜Kš	œžœžœ
žœ"žœ˜SKšžœžœ)˜3šžœžœ˜K˜K˜(K˜—K˜™K˜——š œžœ
žœžœ˜@Kš
œT™Tš
œ
˜
šžœ˜Kšœ!žœ˜*Kšœžœ
˜Kšœžœ
˜Kš
œ˜—K˜šžœ&žœ˜.K˜/K˜K˜—K˜K˜—Kšœžœ˜+K˜K˜#K˜K˜K˜—š œžœ˜&Kš
œ<™<Kšœ:žœ˜?K˜4K˜K˜—š	 œžœ
žœžœ‘˜TKšžœ˜Kš
œ˜K˜—š œžœ*žœ
žœ˜NK˜6K˜K˜—š
 œžœžœžœžœ˜bK˜K˜GKšžœžœ˜%Kš
œ˜K˜—š œžœ
žœžœžœžœ˜OKš	œžœ
žœžœ
žœ˜Kšœžœ˜Kšœžœ
˜Kšœžœžœ
˜(K˜$K˜š	žœžœ
žœ
žœ
‘"˜>Kš
žœ
žœžœžœžœ
˜5—Kš
žœžœ
žœžœžœ
˜@K˜Kšœžœžœ
žœ˜,K˜C˜Kšœ!žœ˜*Kšœžœžœ˜+Kšœžœžœ˜*Kš
œ˜—Kšžœ
žœ˜Kš
œ˜K˜—š œžœ
žœ&žœžœžœžœ˜eKšœžœžœ
˜ K˜Cš
œ˜Kšžœžœžœ
žœ˜DKšœ!žœ˜*Kšœžœžœ˜+Kšœžœžœ˜*Kš
œ˜—Kšžœ
žœ˜Kš
œ˜K˜—Kšœ	žœ
˜Kšœ
žœ
˜Kšœžœ
˜—š
œ™Kš
œB˜BKš
œB˜BK˜Kšœžœžœ‘,˜IKšœžœžœ‘(˜CKšœžœ
žœžœ‘,˜`K˜š œžœžœ˜-Kšœžœ
‘˜NK˜-š 	œžœžœ˜/Kš
œ˜Kš
œ˜Kš
œ˜—š œžœžœžœ˜FK˜K˜!K˜—š œžœ&žœ˜=K˜PKš
œ!™!K˜NKš
œ™K˜—Kšœžœ
˜Kšœ0‘˜Ešžœžœ˜K˜K˜,K˜K˜.K˜K˜—šžœ˜K˜K˜K˜—K˜SK˜K˜)K˜(K˜K˜HK˜FK˜DK˜K˜GK˜K˜Kšœ‘#˜@Kšžœ‘˜*Kš
œ˜K˜—š œžœžœ‘'˜TK˜CK˜K˜—š 
œžœžœ˜+K˜Kšœ%‘˜>Kšœ#‘˜7šžœ	žœ˜K˜;K˜K˜
—šžœ‘H˜OKšœ
žœ˜K˜9K˜7K˜#K˜"K˜#K˜"K˜K˜—Kšžœ
‘˜(Kš
œ˜—K˜Kš
œžœ
žœ	žœžœ
žœ	žœ˜KKš
œžœ
žœ	žœžœ
žœ	žœ˜GK˜š œžœ3˜DK˜—š œžœ4˜EK˜—Kš œžœ5˜GK˜š œžœ!žœ˜?Kš
œ1™1K˜&K˜#K˜K˜%Kš
œ%˜%K˜/šžœžœ
ž˜K˜'Kšžœ‘˜—Kšœžœ‘˜CKšžœžœ*žœ˜OKšœ?‘)˜hK˜K˜—š 
œžœžœžœ˜SKšžœJ˜PKš
œ˜K˜—š œžœžœžœ˜WKšžœN˜TKš
œ˜K˜—š œžœ‘!˜KK˜K˜K˜—š œžœ‘!˜LK˜K˜K˜—š 	œžœ!žœ˜9K˜Kšžœ
žœžœ
žœ
˜0Kšžœ*žœžœ
˜NK˜ K˜6K˜K˜—š œžœ˜*Kšžœžœ
žœ$˜:Kš
œ)˜)K˜—K˜š œžœ/˜DK˜—š œžœ0˜EK˜—Kš œžœ1˜GK˜š œžœ!žœ˜;K˜*K˜K˜K˜—š 
œžœžœ‘&˜UK˜,Kšœžœ
˜K˜#K˜Kšœžœ˜#K˜K˜1šžœžœ˜Kšžœžœ2˜Ošžœžœ˜K˜Kšžœ˜
——K˜3Kšžœžœ
žœ
˜K˜=K˜;K˜JKšžœžœ‘˜Gšžœ‘˜#šžœ	žœ
ž˜K˜Kšžœžœ
˜—K˜"—K˜8K˜=K˜—š œžœ
žœžœžœžœžœ˜pK˜K˜Kšœžœ
˜K˜3K˜IKšžœžœ
žœ
˜šžœ	žœ
ž˜K˜Kšžœžœ
˜—šžœžœ
žœž˜'K˜&Kšžœžœ
žœ
˜'Kšžœ
˜—K˜K˜—K˜—™š œžœ
žœžœžœžœ˜RKš
‘.™.Kšœžœ#˜6Kšœžœ
˜K˜%K˜+Kšžœžœ
žœ
˜K˜Kšœžœ˜%Kš
œ)˜)šžœ<žœ˜DK˜KK˜Kš
œ˜Kšœžœ
˜Kš
œ˜—š
œ˜K˜——š œžœ
žœ'žœžœžœ˜dKš
‘.™.Kš
œ"˜"Kš
œ.˜.Kšœžœ#˜6Kšœžœ
˜K˜%K˜+Kšžœ
žœžœ
žœ
˜K˜Kšœžœ˜%Kš
œ)˜)šžœ<žœ˜DK˜KKš
œ˜Kš
œ˜Kšœžœ
˜Kš
œ˜—Kš
œ"˜"Kšœžœ
˜š
œ˜K˜——š œžœ
žœ+žœžœžœ˜jKš
‘.™.Kš
œ"˜"Kš
œ.˜.Kšœžœ#˜6Kšœžœ
˜Kšœžœ
˜
Kšœžœ
˜$šžœ<žœ˜DKš
œ˜K˜KKš
œ˜Kšœžœ
˜Kš
œ˜—Kš
œ"˜"Kšœžœ
˜š
œ˜K˜——š œžœ
žœ3žœžœžœ˜qKš
‘.™.Kš
œ"˜"Kš
œ.˜.Kšœžœ
˜
šžœžœ
žœž˜ Kšžœ
žœ&˜6Kšžœ
˜—Kš
œ"˜"Kšœžœ
˜š
œ˜K˜——Kšœžœ˜K˜Kšœžœ
žœ˜*Kšœžœžœžœ˜0š 
œžœžœ˜Kš
‘,™,Kšœžœ˜K˜Lšžœžœ
žœž˜ K˜Kšœ(žœ
žœžœ
žœ
žœ˜PKšžœ
˜—Kš
œ˜—K˜š
 
œžœ
žœžœžœ˜@Kš
œ˜Kšœžœ˜6Kš
œ˜——™'Kš	œ	žœ
žœ
žœžœ˜Fš œžœžœžœ˜TJšœ
žœ˜%Jšžœ	˜J˜—š 	œžœ˜3Kšœ
žœ
˜K˜K˜"š œžœ˜K˜4K˜,K˜K˜K˜—K˜'Kšžœžœ‘˜Gšžœ
žœž˜Kšœ$‘˜:š
œ˜K˜'šžœžœ/˜@Kš
œ™—šžœ
žœžœ3˜LKš
œ#™#—Kšžœ
žœ˜Kš
œ˜—š
œ˜K˜'šžœžœ0˜AKš
œ™—šžœ
žœžœ3˜LKš
œ$™$—Kšžœ
žœ˜Kš
œ˜—Kš
œ:˜:Kšžœ*‘˜M—K˜——š
œ™š 
œžœ˜ K˜(K˜4K˜.K˜K˜K˜K˜—š œžœ˜%K˜4K˜6K˜K˜K˜—š œžœ˜%K˜4K˜6K˜K˜K˜—š œžœ˜%K˜4K˜9K˜K˜——š
œ™Kšœ	žœžœR˜kK˜š 
œžœ
˜"Kšœžœžœ˜@š
œ˜K˜——š œžœ˜$Kšœžœžœ˜6Kš
œ˜—K˜š 	œžœ
žœ)˜?K˜4K˜)K˜K˜K˜K˜——š
œ™Kšœ	žœžœT˜mK˜š 
œžœ
˜šœžœžœ˜EK˜——š 
œžœ˜#šœžœžœ(˜DK˜——š 
œžœ˜%Kšœžœžœ˜!š
œ6˜6K˜——š 
œžœ˜%Kšœžœžœžœ˜?Kšœžœžœ*˜FKš
œ˜K˜——š
œ™Kšœ	žœžœT˜mK˜š 
œžœ
˜š œžœ˜ Kš
œ)˜)—Kšœžœžœ˜!Kš
œ+˜+š
œ˜K˜——š 
œžœ˜#š œžœ˜ K˜(—Kšœžœžœ˜!Kš
œ+˜+š
œ˜K˜——š 
œžœ˜%š œžœ˜ K˜3—Kšœžœžœ˜!Kš
œ+˜+š
œ˜K˜——š 
œžœ˜%š œžœ˜ Kšœžœ˜"K˜)K˜—Kšœžœžœ˜!Kš
œ+˜+š
œ˜K˜———š
œ™Kšœ
žœžœX˜rK˜š œžœ
˜ š œžœ˜ Kš
œ'˜'K˜—Kšœžœžœ˜"Kš
œ1˜1š
œ˜K˜——š œžœ˜$š œžœ˜ K˜&K˜—Kšœžœžœ˜"Kš
œ1˜1š
œ˜K˜——š œžœ˜&š œžœ˜ K˜1K˜—Kšœžœžœ˜"Kš
œ1˜1š
œ˜K˜——š œžœ˜&š œžœ˜ Kšœžœ˜"K˜)K˜—Kšœžœžœ˜"Kš
œ1˜1Kš
œ˜K˜——K™Kšžœ
˜—…—YRyš