NodeStyleSimpleImpl.mesa
Copyright Ó 1985, 1986 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
Russ Atkinson, March 7, 1985 3:29:21 am PST
Michael Plass, May 9, 1986 12:27:55 pm PDT
Rick Beach, March 27, 1985 10:54:03 am PST
Doug Wyatt, September 25, 1986 8:14:48 pm PDT
DIRECTORY
Ascii USING [Lower],
Atom USING [GetPName, MakeAtom],
Checksum USING [ComputeChecksum],
Convert USING [RopeFromInt],
NodeProps USING [Is],
NodeStyle USING [DataEntry, DataList, GetStyleName, IntegerValue, MaxNestingLevel, RealCode, Style, SetReal, StyleBody],
NodeStyleOps USING [ExtObjPair, LocalStyle, LocalStyleRec, OfStyle],
NodeStyleWorks USING [BadStyleFile, ExecuteLooksInStyle, ExecuteNameInStyle, ExecuteObjectInStyle, FreeFrame, GetFrame, GetStyleDict, RunStyle, StyleParamKey],
Rope USING [Cat, Concat, ROPE, Translate],
Tioga,
TiogaPrivate USING [AddEditNotifyProc, Change, ChangeSet],
TJaM USING [Frame, NumberRep, Object, TryToLoad];
NodeStyleOpsImpl: CEDAR MONITOR LOCKS env USING env: Env
IMPORTS Ascii, Atom, Checksum, Convert, NodeProps, NodeStyle, NodeStyleWorks, Rope, Tioga, TiogaPrivate, TJaM
EXPORTS NodeStyleOps
~ BEGIN OPEN NodeStyle, NodeStyleOps;
ROPE: TYPE ~ Rope.ROPE;
Frame: TYPE ~ TJaM.Frame;
Object: TYPE ~ TJaM.Object;
NodeStyleImpl
Real Parameters
lastIntAsReal: REAL ← LAST[INT];
firstIntAsReal: REAL ← FIRST[INT];
IntegerValue: PUBLIC PROC [value: REAL ← 0.0] RETURNS [INT] ~ {
RETURN [SELECT value FROM
> lastIntAsReal => LAST[INT],
< firstIntAsReal => FIRST[INT],
ENDCASE => Real.Round[value]];
};
realArray: REF ARRAY RealCode OF REAL ~ NEW[ARRAY RealCode OF REAL ← ALL[0.0]];
array of real-valued distances
nextFreeRealCode: RealCode ← 1;
next free entry in realArray
reserve entry 0 for 0.0
overflowCount: INT ← 0;
EnterReal: ENTRY PROC [value: REAL ← 0.0] RETURNS [code: RealCode] ~ {
ENABLE UNWIND => NULL;
FOR code ← RealCode.FIRST, code+1 UNTIL code=nextFreeRealCode DO
IF realArray[code]=value THEN RETURN; -- value already in realArray
ENDLOOP;
IF code=overflow THEN overflowCount ← overflowCount+1 -- realArray is full
ELSE { realArray[code] ← value; nextFreeRealCode ← code+1 }; -- enter in realArray
};
SetReal: PUBLIC PROC [s: Style, param: RealParam, value: REAL ← 0.0] ~ {
code: RealCode ~ EnterReal[value];
IF code=overflow THEN s.dataList ← NEW[DataEntry ← [s.dataList, real[param, value]]];
s.real[param] ← code;
};
GetReal: PUBLIC PROC [s: Style, param: RealParam] RETURNS [value: REAL ← 0.0] ~ {
code: RealCode ~ s.real[param];
IF code#overflow THEN RETURN[realArray[code]]
ELSE {
FOR entry: REF DataEntry ← s.dataList, entry.next UNTIL entry=NIL DO
WITH entry SELECT FROM
e: REF DataEntry.real => IF e.param=param THEN RETURN[e.value];
ENDCASE;
ENDLOOP;
ERROR; -- failed to find it on the data list --
};
};
Tabs
GetTabLoc: PUBLIC PROC [stop: TabStop, s:Style] RETURNS [REAL ← 0.0] ~ {
code: RealCode;
IF (code ← stop.loc) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,loc]];
};
GetTabLeaderSpacing: PUBLIC PROC [stop: LeaderTabStop, s:Style] RETURNS [REAL ← 0.0] ~ {
code: RealCode;
IF (code ← stop.spacing) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,spacing]];
};
GetTabRuleWeight: PUBLIC PROC [stop: RuleTabStop, s:Style] RETURNS [REAL ← 0.0] ~ {
code: RealCode;
IF (code ← stop.weight) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,weight]];
};
GetTabRuleVShift: PUBLIC PROC [stop: RuleTabStop, s:Style] RETURNS [REAL ← 0.0] ~ {
code: RealCode;
IF (code ← stop.vshift) # overflow THEN RETURN [realArray[code]];
RETURN [GetTabOverflow[s,stop,vshift]];
};
GetTabRealCode: PUBLIC PROC [s: Style, stop: TabStop, which: TabRealParam,
value: REAL ← 0.0] RETURNS [code: RealCode] ~ {
code ← EnterReal[value];
IF code=overflow THEN s.dataList ← NEW[DataEntry ← [s.dataList, tab[stop, which, value]]];
};
GetRulesTabCount: PUBLIC PROC [stop: RulesTabStop] RETURNS [count: INT] ~ {
RETURN [stop.rules.length];
};
GetRulesTabInfo: PUBLIC PROC [stop: RulesTabStop, num: INT]
RETURNS [weight, vshift: REAL] ~ {
For num in [0..RulesTabCount), returns the weight and vshift values for that rule.
weight ← stop.rules.array[num].weight;
vshift ← stop.rules.array[num].vshift;
};
GetTabOverflow: PROC [s: Style, stop: TabStop, which: TabRealParam]
RETURNS [value: REAL ← 0.0] ~ {
FOR x: DataList ← s.dataList, x.next UNTIL x=NIL DO
WITH x SELECT FROM
xx: REF DataEntry.tab => IF xx.tabStop=stop AND xx.which=which THEN RETURN [xx.value];
ENDCASE;
ENDLOOP;
ERROR -- failed to find it on the data list --
};
Dimensions
pointsPerPica: PUBLIC REAL ← 12.0;
pointsPerInch: PUBLIC REAL ← 1.0/0.0138370; -- 72.27
pointsPerCentimeter: PUBLIC REAL ← pointsPerInch/2.540;
pointsPerMillimeter: PUBLIC REAL ← pointsPerCentimeter/10;
pointsPerDidot: PUBLIC REAL ← pointsPerCentimeter/26.60;
pointsPerFil: PUBLIC REAL ← 10000.0;
pointsPerFill: PUBLIC REAL ← pointsPerFil*pointsPerFil;
pointsPerFilll: PUBLIC REAL ← pointsPerFill*pointsPerFil;
NodeStyleOpsImpl
Style Operations
LowerCaseRope: PROC [rope: ROPE] RETURNS [ROPE] ~ {
lower: Rope.TranslatorType ~ { new ← Ascii.Lower[old] };
RETURN [Rope.Translate[base: rope, translator: lower]];
};
LowerCaseAtom: PROC [atom: ATOM] RETURNS [ATOM] ~ {
RETURN [Atom.MakeAtom[LowerCaseRope[Atom.GetPName[atom]]]];
};
Create: PUBLIC PROC RETURNS [Style] ~ {
create a style body
RETURN [NEW[StyleBody]];
};
Copy: PUBLIC PROC [dest, source: Style] ~ {
copy a style body
dest^ ← source^;
};
Alloc: PUBLIC ENTRY PROC [env: Env] RETURNS [s: Style] ~ { OPEN env;
get from a small cache
ENABLE UNWIND => NULL;
IF s3 # NIL THEN { s ← s3; s3 ← NIL }
ELSE IF s2 # NIL THEN { s ← s2; s2 ← NIL }
ELSE IF s1 # NIL THEN { s ← s1; s1 ← NIL }
ELSE s ← Create[];
};
Free: PUBLIC ENTRY PROC [env: Env, s: Style] ~ { OPEN env;
don't free more than once or disaster!
ENABLE UNWIND => NULL;
IF s3 = NIL THEN s3 ← s
ELSE IF s2 = NIL THEN s2 ← s
ELSE IF s1 = NIL THEN s1 ← s;
};
WithFrame: PROC [style: Style, styleName: ATOM, kind: StyleKind, action: PROC [Frame]] ~ {
frame: Frame ~ NodeStyleWorks.GetFrame[style, styleName, kind];
action[frame];
NodeStyleWorks.FreeFrame[frame, styleName, kind];
};
LoadStyle: PUBLIC PROC [name: ATOM] RETURNS [ok: BOOL] ~ {
LoadStyleAction: PROC [frame: Frame] ~ {
[] ← NodeStyleWorks.GetStyleDict[frame, name, screen];
};
WithFrame[NIL, NIL, screen, LoadStyleAction];
RETURN [TRUE];
};
DefineStyle: PUBLIC PROC [name: ATOM, def: ROPE]
RETURNS [ok: BOOL] ~ {
DefineStyleAction: PROC [frame: Frame] ~ {
IF def = NIL
THEN NodeStyleWorks.BadStyleFile[frame, name]
ELSE [] ← NodeStyleWorks.GetStyleDict[frame, name, screen, def];
};
WithFrame[NIL, NIL, screen, DefineStyleAction];
RETURN [TRUE];
};
ReloadStyle: PUBLIC PROC [name: ATOM] RETURNS [ok: BOOL] ~ {
name ← ForceLowerName[name];
FOR kind: NodeStyleOps.OfStyle IN NodeStyleOps.OfStyle DO
frame: Frame ← NodeStyleWorks.GetFrame[NIL, NIL, kind];
ok ← NodeStyleWorks.RunStyle[frame, name];
IF ~ok THEN NodeStyleWorks.BadStyleFile[frame, name];
NodeStyleWorks.FreeFrame[frame, NIL, kind];
ENDLOOP;
};
Local Styles
SetDefaultStyle: PUBLIC PROC [name: ROPE] ~ {
defaultStyleName ← Atom.MakeAtom[ForceRopeLower[name]];
defaultStyle.name[style] ← defaultStyleName;
FlushCaches[];
};
SetExtensionStyles: PUBLIC PROC [value: LIST OF ROPE] ~ {
defaultStylesForExtensions ← NIL;
UNTIL value=NIL OR value.rest=NIL DO
ext: ATOM ← Atom.MakeAtom[ForceRopeLower[value.first]]; -- the extension
styleObject: Object ← Rope.Cat["\"", ForceRopeLower[value.rest.first], "\" style"];
defaultStylesForExtensions ← CONS[[ext, styleObject], defaultStylesForExtensions];
value ← value.rest.rest;
ENDLOOP;
FlushCaches[];
};
ReadStyleDef: PROC [name: ATOM, specs: ROPE] RETURNS [value: REF] ~ {
GenLocalName: ENTRY PROC RETURNS [gen: ROPE] ~ {
localStyleNumber ← localStyleNumber + 1;
gen ← Rope.Concat["LocalStyle-", Convert.RopeFromInt[localStyleNumber]];
};
localStyle: LocalStyle ← NEW[LocalStyleRec];
localStyleName: ROPE ~ GenLocalName[];
localStyle.name ← Atom.MakeAtom[localStyleName];
localStyle.def ← specs;
[] ← DefineStyle[localStyle.name, specs];
RETURN [localStyle];
};
WriteStyleDef: PROC [name: ATOM, value: REF] RETURNS [specs: ROPE] ~ {
localStyle: LocalStyle ← NARROW[value];
RETURN [IF localStyle=NIL THEN NIL ELSE localStyle.def];
};
CopyStyleDef: PROC [name: ATOM, value: REF] RETURNS [new: REF] ~ {
RETURN [value];
};
Apply Style to Node
ApplyAll: PUBLIC PROC [ref: Style, node: Tioga.Node, kind: OfStyle ← screen] ~ {
[] ← DoApplyAll[ref, node, kind];
};
DoApplyAll: PROC [ref: Style, node: Tioga.Node, kind: OfStyle]
RETURNS [depth: CARDINAL] ~ {
found: BOOL;
parent: Tioga.Node;
alt: ATOM;
IF node = NIL THEN { ref^ ← defaultStyle^; RETURN [0] };
[found, depth] ← FindInApplyAllCache[ref, node, kind];
IF found THEN RETURN [depth+1];
parent ← Tioga.Parent[node];
alt ← IF parent=NIL THEN rootFormatName ELSE defaultFormatName;
depth ← DoApplyAll[ref, parent, kind];
ApplyForNode[ref, node, alt, kind];
EnterInApplyAllCache[ref, node, depth];
RETURN [depth+1];
};
ApplyForNode: PUBLIC PROC [ref: Style, node: Tioga.Node, alt: ATOM, kind: OfStyle] ~ {
ext: ATOM;
ref.isComment ← IF node # NIL THEN node.comment ELSE FALSE;
ref.print ← (kind = print);
ref.nestingLevel ← MIN[Tioga.Level[node], MaxNestingLevel];
NodeStyleObsolete.EvalFreeVars[ref, node];
IF node.hasstyledef THEN {
localStyle: LocalStyle ← NARROW[Tioga.GetProp[node, $StyleDef]];
IF localStyle # NIL THEN ref.name[style] ← localStyle.name;
};
IF node.hasprefix
THEN ApplyObject[ref, Tioga.GetProp[node, $Prefix], kind]
ELSE IF ref.nestingLevel=0 -- root node -- AND -- check for file extension default
(ext ← NARROW[Tioga.GetProp[node, $FileExtension]]) # NIL THEN
FOR list: LIST OF ExtObjPair ← defaultStylesForExtensions, list.rest UNTIL list = NIL DO
IF list.first.fileExtension # ext THEN LOOP;
ApplyObject[ref, list.first.styleObject, kind];
EXIT;
ENDLOOP;
ApplyFormat[ref, node.formatName, alt, kind];
IF node.haspostfix THEN ApplyObject[ref, Tioga.GetProp[node, $Postfix], kind];
};
ApplyAll Cache
ApplyCacheRep: TYPE ~ RECORD [
depth: CARDINAL ← 0, -- next free entry
results: REF ApplyCacheResults,
nodes: REF ApplyCacheNodes,
probes, hits, saves: INT ← 0
];
applyCacheSize: CARDINAL ~ 8; -- number of levels deep in tree
ApplyCacheNodes: TYPE ~ ARRAY [0..applyCacheSize) OF Tioga.Node;
ApplyCacheResults: TYPE ~ ARRAY [0..applyCacheSize) OF StyleBody;
InitApplyCacheRecord: PROC ~ {
applyCache.results ← NEW[ApplyCacheResults];
applyCache.nodes ← NEW[ApplyCacheNodes];
};
RemoveAllFromApplyAllCache: PUBLIC PROC ~ { FlushApplyAllCache[] };
FlushApplyAllCache: PUBLIC ENTRY PROC [init: BOOL ← FALSE] ~ {
ENABLE UNWIND => NULL;
ClearApplyAllCache[init];
};
ClearApplyAllCache: INTERNAL PROC [init: BOOL] ~ {
when clearing, go all the way to applyCacheSize rather than stopping at applyCache.depth
FOR i: CARDINAL IN [0..applyCacheSize) DO applyCache.nodes[i] ← NIL; ENDLOOP;
applyCache.depth ← 0;
};
RemoveNodeFromApplyAllCache: PUBLIC ENTRY PROC [node: Tioga.Node] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes ← applyCache.nodes;
FOR i: CARDINAL IN [0..applyCache.depth) DO
IF nodes[i]=node THEN { -- clear from here on
FOR j: CARDINAL IN [i..applyCacheSize) DO
nodes[j] ← NIL;
ENDLOOP;
applyCache.depth ← i;
EXIT;
};
ENDLOOP;
};
FindInApplyAllCache: ENTRY PROC [ref: Style, node: Tioga.Node, kind: OfStyle]
RETURNS [found: BOOL, depth: CARDINAL] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes ← applyCache.nodes;
print: BOOL ~ (kind=print); -- if true, then find result with print true also
applyCache.probes ← applyCache.probes+1;
FOR i: CARDINAL DECREASING IN [0..applyCache.depth) DO
IF nodes[i]=node AND print=applyCache.results[i].print THEN { -- found it
applyCache.hits ← applyCache.hits+1;
applyCache.saves ← applyCache.saves+i+1;
ref^ ← applyCache.results[i];
RETURN [TRUE, i]
};
ENDLOOP;
RETURN [FALSE, 0];
};
EnterInApplyAllCache: ENTRY PROC [ref: Style, node: Tioga.Node, depth: CARDINAL] ~ {
ENABLE UNWIND => NULL;
nodes: REF ApplyCacheNodes ← applyCache.nodes;
IF depth >= applyCacheSize THEN RETURN;
nodes[depth] ← node;
applyCache.results[depth] ← ref^;
FOR i: CARDINAL IN [depth+1..applyCacheSize) DO nodes[i] ← NIL; ENDLOOP;
applyCache.depth ← depth+1;
};
Update ApplyAll Cache due to Editing Operations
Change: TYPE ~ TiogaPrivate.Change;
Notify: PROC [change: REF READONLY Change] ~ {
if change invalidates one node only, remove that node
else clear entire cache
DoNode: PROC [node: Tioga.Node] ~ {
IF Tioga.FirstChild[node] # NIL THEN FlushApplyAllCache[]
ELSE RemoveNodeFromApplyAllCache[node]
};
WITH change SELECT FROM
x: REF READONLY Change.InsertingNode => IF Tioga.FirstChild[x.new] # NIL THEN FlushApplyAllCache[];
x: REF READONLY Change.MovingNodes => FlushApplyAllCache[];
x: REF READONLY Change.NodeNesting => IF x.first = x.last -- only changing one node
AND Tioga.FirstChild[x.first] = NIL -- node has no children
THEN SELECT x.change FROM
+1 => -- increasing nesting in tree
IF Tioga.Next[x.first] = NIL THEN RemoveNodeFromApplyAllCache[x.first]
ELSE FlushApplyAllCache[];
-1 => -- decreasing nesting in tree
RemoveNodeFromApplyAllCache[x.first];
ENDCASE => FlushApplyAllCache[]
ELSE FlushApplyAllCache[];
x: REF READONLY Change.ChangingFormat => DoNode[x.node];
x: REF READONLY Change.ChangingProp => {
IF NodeProps.Is[x.propAtom, $Visible] THEN DoNode[x.node];
};
ENDCASE => ERROR; -- not expecting notify for any other kinds of changes
};
Hashing
HashStyle: PROC [ref: Style, looks: Tioga.Looks ← Tioga.noLooks, anotherRef: REF ← NIL]
RETURNS [CARDINAL] ~ TRUSTED {
Bits: TYPE ~ MACHINE DEPENDENT RECORD [
REF, REF, REF, REF, RealCode, RealCode, RealCode, RealCode, Tioga.Looks];
bits: Bits ← [ref.name[style], ref.name[fontPrefix], ref.name[fontFamily], anotherRef,
ref.real[fontSize], ref.real[leftIndent], ref.real[leading], 0, looks];
RETURN [Checksum.ComputeChecksum[3145, SIZE[Bits], @bits]];
};
Style Rule Cache
ruleCacheSize: CARDINAL ~ 64; -- should be a power of 2
ruleCacheMax: CARDINAL ~ (ruleCacheSize*4)/5; -- don't fill too full
RuleCacheLoc: TYPE ~ CARDINAL[0..ruleCacheSize);
RuleCacheNames: TYPE ~ ARRAY RuleCacheLoc OF ATOM;
RuleCacheBodies: TYPE ~ ARRAY RuleCacheLoc OF StyleBody;
RuleCache: TYPE ~ REF RuleCacheRep;
RuleCacheRep: TYPE ~ RECORD [
count: CARDINAL ← 0, -- number of entries currently in use
names: REF RuleCacheNames,
inputs: REF RuleCacheBodies,
results: REF RuleCacheBodies,
probes, hits: INT ← 0
];
InitRuleCacheInfo: PROC ~ {
ruleCache.names ← NEW[RuleCacheNames];
ruleCache.inputs ← NEW[RuleCacheBodies];
ruleCache.results ← NEW[RuleCacheBodies];
};
FlushRuleCache: ENTRY PROC [init: BOOL ← FALSE] ~ {
ENABLE UNWIND => NULL;
ClearRuleCache[];
};
ClearRuleCache: INTERNAL PROC [init: BOOL ← FALSE] ~ {
IF init OR ruleCache.count#0 THEN {
ruleCache.count ← 0;
FOR i: RuleCacheLoc IN RuleCacheLoc DO ruleCache.names[i] ← NIL; ENDLOOP;
};
};
ApplyFormat: PUBLIC PROC [ref: Style, name, alt: ATOM, kind: OfStyle] ~ {
input: StyleBody;
initloc: RuleCacheLoc;
FindInRuleCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
loc: RuleCacheLoc ← initloc;
ruleCache.probes ← ruleCache.probes+1;
DO -- search ruleCache
SELECT ruleCache.names[loc] FROM
name => IF ruleCache.inputs[loc] = ref^ THEN {
ref^ ← ruleCache.results[loc];
ruleCache.hits ← ruleCache.hits+1;
RETURN [TRUE];
};
NIL => RETURN [FALSE]; -- this is an unused entry
ENDCASE;
loc ← (loc+1) MOD ruleCacheSize;
IF loc=initloc THEN RETURN [FALSE];
ENDLOOP;
};
PutInRuleCache: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
loc: RuleCacheLoc ← initloc;
IF ruleCache.count = ruleCacheMax THEN ClearRuleCache[];
DO -- search ruleCache for place to put the entry
SELECT ruleCache.names[loc] FROM
name => IF ruleCache.inputs[loc] = input THEN RETURN; -- already in cache
NIL => EXIT; -- this is an unused entry
ENDCASE;
loc ← (loc+1) MOD ruleCacheSize;
IF loc=initloc THEN ERROR; -- cache full
ENDLOOP;
ruleCache.names[loc] ← name;
ruleCache.inputs[loc] ← input;
ruleCache.results[loc] ← ref^;
ruleCache.count ← ruleCache.count+1;
};
IF name=NIL AND (name ← alt)=NIL THEN RETURN;
initloc ← HashStyle[ref, , name] MOD ruleCacheSize;
IF FindInRuleCache[] THEN RETURN;
input ← ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteNameInStyle[ref, kind, name] THEN PutInRuleCache[]
ELSE IF name#alt THEN ApplyFormat[ref, alt, NIL, kind];
};
Looks Cache
looksCacheSize: CARDINAL ~ 16; -- should be a power of 2
looksCacheMax: CARDINAL ~ (looksCacheSize*4)/5; -- don't fill too full
LooksCacheLoc: TYPE ~ CARDINAL[0..looksCacheSize);
LooksCacheLooks: TYPE ~ ARRAY LooksCacheLoc OF Tioga.Looks;
LooksCacheBodies: TYPE ~ ARRAY LooksCacheLoc OF StyleBody;
LooksCache: TYPE ~ REF LooksCacheRep;
LooksCacheRep: TYPE ~ RECORD [
count: CARDINAL ← 0,
looks: REF LooksCacheLooks,
inputs: REF LooksCacheBodies,
results: REF LooksCacheBodies,
probes, hits: INT ← 0
];
InitLooksCacheInfo: PROC ~ {
looksCache.looks ← NEW[LooksCacheLooks];
looksCache.inputs ← NEW[LooksCacheBodies];
looksCache.results ← NEW[LooksCacheBodies];
};
FlushLooksCache: ENTRY PROC [init: BOOL ← FALSE] ~ {
ENABLE UNWIND => NULL;
ClearLooksCache[];
};
ClearLooksCache: PROC [init: BOOL ← FALSE] ~ {
IF ~init AND looksCache.count = 0 THEN RETURN;
looksCache.count ← 0;
FOR i: LooksCacheLoc IN LooksCacheLoc DO looksCache.looks[i] ← Tioga.noLooks; ENDLOOP;
};
ApplyLooks: PUBLIC PROC [ref: Style, looks: Tioga.Looks, kind: OfStyle] ~ {
initloc: LooksCacheLoc;
input: StyleBody;
FindInLooksCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
loc: LooksCacheLoc ← initloc;
looksCache.probes ← looksCache.probes+1;
DO -- search looksCache
SELECT looksCache.looks[loc] FROM
looks => IF looksCache.inputs[loc] = ref^ THEN {
ref^ ← looksCache.results[loc];
looksCache.hits ← looksCache.hits+1;
RETURN [TRUE];
};
Tioga.noLooks => EXIT; -- this is an unused entry
ENDCASE;
loc ← (loc+1) MOD looksCacheSize;
IF loc=initloc THEN EXIT;
ENDLOOP;
RETURN [FALSE];
};
PutInLooksCache: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
loc: LooksCacheLoc ← initloc;
IF looksCache.count = looksCacheMax THEN ClearLooksCache[];
DO -- search looksCache for place to put the entry
SELECT looksCache.looks[loc] FROM
looks => IF looksCache.inputs[loc] = input THEN RETURN; -- already in cache
Tioga.noLooks => EXIT; -- this is an unused entry
ENDCASE;
loc ← (loc+1) MOD looksCacheSize;
IF loc=initloc THEN ERROR; -- cache full
ENDLOOP;
looksCache.looks[loc] ← looks;
looksCache.inputs[loc] ← input;
looksCache.results[loc] ← ref^;
looksCache.count ← looksCache.count+1;
};
IF looks = Tioga.noLooks THEN RETURN;
initloc ← HashStyle[ref, looks] MOD looksCacheSize;
IF FindInLooksCache[] THEN RETURN;
input ← ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteLooksInStyle[ref, kind, looks] THEN PutInLooksCache[];
};
Object Cache
objectCacheSize: CARDINAL ~ 16; -- should be a power of 2
objectCacheMax: CARDINAL ~ (objectCacheSize*4)/5; -- don't fill too full
ObjectCacheLoc: TYPE ~ CARDINAL[0..objectCacheSize);
ObjectCacheObjects: TYPE ~ ARRAY [0..objectCacheSize) OF Object;
ObjectCacheBodies: TYPE ~ ARRAY [0..objectCacheSize) OF StyleBody;
ObjectCacheRep: TYPE ~ RECORD [
count: CARDINAL[0..objectCacheMax],
objects: REF ObjectCacheObjects,
inputs: REF ObjectCacheBodies,
results: REF ObjectCacheBodies,
probes, hits: INT ← 0
];
InitObjectCacheInfo: PROC ~ {
objectCache.objects ← NEW[ObjectCacheObjects];
objectCache.inputs ← NEW[ObjectCacheBodies];
objectCache.results ← NEW[ObjectCacheBodies];
};
FlushObjectCache: ENTRY PROC [init: BOOL ← FALSE] ~ {
ENABLE UNWIND => NULL;
ClearObjectCache[];
};
ClearObjectCache: PROC [init: BOOL ← FALSE] ~ {
IF ~init AND objectCache.count = 0 THEN RETURN;
objectCache.count ← 0;
FOR i: ObjectCacheLoc IN ObjectCacheLoc DO objectCache.objects[i] ← NIL; ENDLOOP;
};
ApplyObject: PUBLIC PROC [ref: Style, object: Object, kind: OfStyle ← screen] ~ {
input: StyleBody;
initloc: ObjectCacheLoc;
FindInObjectCache: ENTRY PROC RETURNS [BOOL] ~ {
ENABLE UNWIND => NULL;
loc: ObjectCacheLoc ← initloc;
objectCache.probes ← objectCache.probes+1;
DO -- search objectCache
SELECT objectCache.objects[loc] FROM
object => IF objectCache.inputs[loc] = ref^ THEN {
ref^ ← objectCache.results[loc];
objectCache.hits ← objectCache.hits+1;
RETURN [TRUE];
};
NIL => EXIT; -- this is an unused entry
ENDCASE;
loc ← (loc+1) MOD objectCacheSize;
IF loc=initloc THEN EXIT;
ENDLOOP;
RETURN [FALSE];
};
PutInObjectCache: ENTRY PROC ~ {
ENABLE UNWIND => NULL;
loc: ObjectCacheLoc ← initloc;
IF objectCache.count = objectCacheMax THEN ClearObjectCache[];
DO -- search objectCache for place to put the entry
SELECT objectCache.objects[loc] FROM
object => IF objectCache.inputs[loc] = input THEN RETURN; -- already in cache
NIL => EXIT; -- this is an unused entry
ENDCASE;
loc ← (loc+1) MOD objectCacheSize;
IF loc=initloc THEN ERROR; -- cache full
ENDLOOP;
objectCache.objects[loc] ← object;
objectCache.inputs[loc] ← input;
objectCache.results[loc] ← ref^;
objectCache.count ← objectCache.count+1;
};
IF object = nullObject THEN RETURN;
initloc ← HashStyle[ref, , object] MOD objectCacheSize;
IF FindInObjectCache[] THEN RETURN;
input ← ref^; -- save the input value of the record
IF NodeStyleWorks.ExecuteObjectInStyle[ref, kind, object] THEN PutInObjectCache[];
};
Flush Caches
FlushCaches: PUBLIC ENTRY PROC ~ {
ENABLE UNWIND => NULL;
ClearCaches[FALSE];
};
ClearCaches: PROC [init: BOOL] ~ {
ClearApplyAllCache[init];
ClearRuleCache[init];
ClearLooksCache[init];
ClearObjectCache[init];
};
Style Parameter Extensions
nonNumeric: PUBLIC ERROR ~ CODE;
GetStyleParam: PUBLIC PROC [s: Style, name: ATOM, styleName: ATOM, kind: OfStyle]
RETURNS [r: REAL] ~ {
May raise NodeStyleOps.nonNumeric or TJaM.Error[undefkey].
obj: Object ← GetStyleParamObj[s, name, styleName, kind];
WITH obj SELECT FROM
x: REF TJaM.NumberRep.int => r ← x.int;
x: REF TJaM.NumberRep.real => r ← x.real;
ENDCASE => ERROR nonNumeric;
RETURN [r];
};
GetStyleParamI: PUBLIC PROC [s: Style, name: ATOM, styleName: ATOM, kind: OfStyle]
RETURNS [i: INTEGER] ~ {
May raise NodeStyleOps.nonNumeric or TJaM.Error[undefkey].
obj: Object ← GetStyleParamObj[s, name, styleName, kind];
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;
RETURN [i];
};
GetStyleParamObj: PUBLIC PROC [s: Style, name: ATOM, styleName: ATOM, kind: OfStyle]
RETURNS [obj: Object] ~ {
frame: Frame;
key: ATOM ← NodeStyleWorks.StyleParamKey[name];
FOR x: 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;
frame ← NodeStyleWorks.GetFrame[s, styleName, kind];
obj ← TJaM.TryToLoad[frame, key].val;
NodeStyleWorks.FreeFrame[frame, styleName, kind];
RETURN [obj];
};
Miscellaneous
StyleNameForNode: PUBLIC PROC [node: Tioga.Node] RETURNS [name: ATOM] ~ {
Does an ApplyAll and then returns the style name
s: Style ← Alloc[];
ApplyAll[s, node];
name ← GetStyleName[s];
Free[s];
};
Initialization
InitializeDefaultStyle: PUBLIC PROC [world: Tioga.World, suggestedStyle: ROPE] ~ {
changeSet: TiogaPrivate.ChangeSet;
PointsPerInch: REAL ~ 1.0/0.0138370;
register the notify proc that updates the style caches when edits occur
changeSet[ChangingProp] ← TRUE;
changeSet[ChangingFormat] ← TRUE;
changeSet[MovingNodes] ← TRUE;
changeSet[NodeNesting] ← TRUE;
changeSet[InsertingNode] ← TRUE;
TiogaPrivate.AddEditNotifyProc[world, Notify, after, high, changeSet];
initialize all the style caches
InitApplyCacheRecord[];
InitRuleCacheInfo[];
InitLooksCacheInfo[];
InitObjectCacheInfo[];
ClearCaches[TRUE];
establish the default styles wired into Tioga
defaultStyle ← Create[];
defaultFormatName ← $default;
rootFormatName ← $root;
provide some basic style attribute values in case no style gets loaded successfully
defaultStyle.name[fontFamily] ← $Helvetica;
SetReal[defaultStyle, fontSize, 10];
SetReal[defaultStyle, leading, 12];
SetReal[defaultStyle, tabStops, 4];
SetReal[defaultStyle, pageWidth, 8.5*PointsPerInch];
SetReal[defaultStyle, pageLength, 11*PointsPerInch];
SetReal[defaultStyle, leftMargin, 1*PointsPerInch];
SetReal[defaultStyle, rightMargin, 1*PointsPerInch];
SetReal[defaultStyle, topMargin, 1*PointsPerInch];
SetReal[defaultStyle, bottomMargin, 1*PointsPerInch];
SetReal[defaultStyle, lineLength, 6.5*PointsPerInch];
SetReal[defaultStyle, underlineThickness, 1];
SetReal[defaultStyle, underlineDescent, 1];
SetReal[defaultStyle, strikeoutThickness, 1];
SetReal[defaultStyle, strikeoutAscent, 4];
register the special handling procedures for the local style property: StyleDef
Tioga.RegisterProp[name: $StyleDef, reader: ReadStyleDef, writer: WriteStyleDef, copier: CopyStyleDef];
SetDefaultStyle[suggestedStyle];
};
NodeStyleWorks1Impl
Execution Frames for Style Machinery
ROPE: TYPE ~ Rope.ROPE;
Frame: TYPE ~ TJaM.Frame;
OfStyle: TYPE ~ NodeStyleOps.OfStyle;
Object: TYPE ~ TJaM.Object;
FrameInfo: TYPE ~ REF FrameInfoBody;
FrameInfoBody: TYPE ~ RECORD [ frame: Frame, style: Style, rest: FrameInfo ];
GetFrame: PUBLIC PROC [style: Style, 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 {
get the proper style dictionary on the frame dictionary stack
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] ~ {
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 ← 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
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;
};
StyleForFrame: PUBLIC PROC [frame: Frame] RETURNS [style: Style] ~ {
GetIt: ENTRY PROC RETURNS [s: Style] ~ {
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];
};
Style Dictionaries
GetStyleDict: PUBLIC PROC [frame: Frame, styleName: ATOM, kind: OfStyle,
def: ROPE ← NIL]
RETURNS [d: TJaM.Dict] ~ {
found, ok: BOOL;
styleName ← ForceLowerName[styleName];
[d, found] ← CheckStyleDict[styleName, kind];
IF found THEN RETURN;
ok ← IF def # NIL
THEN RunStyleString[frame, styleName, def]
ELSE RunStyle[frame, styleName];
IF ok THEN [d, found] ← CheckStyleDict[styleName, kind];
IF NOT found THEN {
BadStyleFile[frame, styleName];
[d, found] ← CheckStyleDict[styleName, kind];
};
};
BadStyleFile: PUBLIC PROC [frame: Frame, styleName: ATOM] ~ {
fake it so looks as if had a file saying "BeginStyle (default) AttachStyle EndStyle"
{
ENABLE {
WhatStyle => RESUME[styleName];
StartOfStyle => RESUME;
EndOfStyle => RESUME;
};
BeginStyleOp[frame];
IF styleName # NodeStyleOps.defaultStyleName THEN {
TJaM.Push[frame, NodeStyleOps.defaultStyleName];
AttachStyleOp[frame];
};
EndStyleOp[frame];
};
[] ← RefTab.Store[fileForStyle, styleName, NEW [FileIDRep ← []]];
MessageWindow.Append[TJaM.RopeFromAtom[styleName], TRUE];
MessageWindow.Append[".style could not be loaded."];
MessageWindow.Blink[];
TJaM.Push[frame, styleName];
TJaM.PushRope[frame, "style was bad."];
StyleError[frame, 2];
};
CheckStyleDict: PROC [styleName: ATOM, kind: OfStyle]
RETURNS [d: TJaM.Dict, found: BOOL] ~ {
obj: Object;
[found, obj] ← TJaM.TryToGet[stylesDicts[kind], styleName];
IF found THEN d ← TypeCheckDict[obj];
};
CreateStyleDict: PROC RETURNS [d: TJaM.Dict] ~ { -- creates dict for style
RETURN [TJaM.NewDict[50]];
};
EnterStyleDict: PROC [styleName: ATOM, d: Object, kind: OfStyle] ~ {
TJaM.Put[stylesDicts[kind], styleName, d];
};
Style File handling.
Search rule handling
defaultSearch: LIST OF ROPE ← LIST["[]<>Commands>", "[]<>"];
FileID: TYPE ~ REF FileIDRep;
FileIDRep: TYPE ~ RECORD [name: ROPE ← NIL, time: BasicTime.GMT ← BasicTime.nullGMT];
Same: PROC [a, b: FileID] RETURNS [BOOL] ~ {
RETURN [a.time = b.time AND Rope.Equal[a.name, b.name, FALSE]]
};
GetFileID: PROC [shortName: ATOM, extension: ROPE] RETURNS [FileID] ~ {
dirs: LIST OF ROPE ← UserProfile.ListOfTokens["Tioga.StyleSearchRules", defaultSearch];
name: ROPE ~ Rope.Concat[TJaM.RopeFromAtom[shortName], extension];
fileName: ROPE ← NIL;
created: BasicTime.GMT ← BasicTime.nullGMT;
WHILE fileName = NIL AND dirs # NIL DO
[fullFName: fileName, created: created] ← FS.FileInfo[name: name, wDir: dirs.first ! FS.Error => CONTINUE];
dirs ← dirs.rest;
ENDLOOP;
IF fileName = NIL THEN RETURN [NIL];
RETURN [NEW[FileIDRep ← [fileName, created]]];
};
Locking to avoid concurrent changes to internal style representation.
DoLocked: PUBLIC PROC [action: PROC] ~ {
me: UNSAFE PROCESS ~ Process.GetCurrent[];
Lock: ENTRY PROC ~ {
UNTIL styleLockProcess = me OR styleLockCount = 0 DO WAIT styleLockFree ENDLOOP;
styleLockProcess ← me; styleLockCount ← styleLockCount + 1;
};
Unlock: ENTRY PROC ~ {
styleLockCount ← styleLockCount - 1;
IF styleLockCount = 0 THEN {styleLockProcess ← NIL; NOTIFY styleLockFree};
};
Lock[];
action[ ! UNWIND => Unlock[]];
Unlock[];
};
Running styles and validation of style to file correspondence.
ValidateStyles: PUBLIC PROC RETURNS [changed: BOOL ← FALSE] ~ {
Called from elsewhere in Tioga when something changes that may have changed any style.
Does not attempt to refresh screen.
Locked: PROC ~ {
Action: PROC [key: REF, val: REF] RETURNS [quit: BOOLEAN] ~ {
IF ValidateStyle[NARROW[key]] THEN changed ← TRUE;
RETURN [FALSE]
};
[] ← RefTab.Pairs[fileForStyle, Action];
};
DoLocked[Locked];
};
ValidateStyle: PUBLIC PROC [styleName: ATOM] RETURNS [changed: BOOL ← FALSE] ~ {
Called from elsewhere in Tioga when something changes that may have changed a style.
Does not attempt to refresh screen.
Locked: PROC ~ {
fileID: FileID ~ GetFileID[styleName, ".style"];
oldFileID: FileID ~ NARROW[RefTab.Fetch[fileForStyle, styleName].val];
IF oldFileID = NIL OR fileID = NIL OR Same[fileID, oldFileID]
THEN changed ← FALSE
ELSE {
frame: Frame ← GetFrame[NIL, NIL, screen];
IF NOT RunStyle[frame, styleName] THEN BadStyleFile[frame, styleName];
FreeFrame[frame, NIL, screen];
changed ← TRUE;
};
};
DoLocked[Locked];
};
RunStyle: PUBLIC PROC [frame: Frame, styleName: ATOM] RETURNS [ok: BOOL ← FALSE] ~ {
Inner: PROC ~ {
started, finished: BOOL ← FALSE;
this is probably where the use of working directories for style files needs to be added
fileID: FileID ~ GetFileID[styleName, ".style"];
TJaM.Put[attachmentsDict, styleName, TJaM.NewArray[0]];
IF fileID = NIL THEN {ok ← FALSE; RETURN};
MessageWindow.Append["Using ", runNesting=0];
MessageWindow.Append[fileID.name, FALSE];
MessageWindow.Append[" . . . ", FALSE];
runNesting ← runNesting + 1;
TJaM.PushRope[frame, fileID.name];
TJaM.Execute[frame, run !
WhatStyle => RESUME[styleName];
StartOfStyle => { started ← TRUE; RESUME };
EndOfStyle => { finished ← TRUE; RESUME };
TJaM.Stop => { finished ← FALSE; CONTINUE };
];
runNesting ← runNesting - 1;
ok ← started AND finished;
IF ok THEN MessageWindow.Append["ok ", FALSE];
IF ok THEN [] ← RefTab.Store[fileForStyle, styleName, fileID];
IF ok AND runNesting=0 THEN MessageWindow.Clear[];
};
DoLocked[Inner];
};
RunStyleString: PUBLIC PROC [frame: Frame, styleName: ATOM, def: ROPE]
RETURNS [ok: BOOL] ~ {
started, finished: BOOL ← FALSE;
TJaM.Put[attachmentsDict, styleName, TJaM.NewArray[0]];
TJaM.Execute[frame, TJaM.CvX[def] !
WhatStyle => { RESUME[styleName] };
StartOfStyle => { started ← TRUE; RESUME };
EndOfStyle => { finished ← TRUE; RESUME };
TJaM.Stop => { finished ← FALSE; CONTINUE };
];
RETURN [started AND finished];
};
styleDictName: ATOM ~ TJaM.AtomFromRope["##styleDictName"];
styleKindName: ATOM ~ TJaM.AtomFromRope["##styleKindName"];
InitDict: PUBLIC PROC [name: ATOM, size: CARDINAL ← 100]
RETURNS [dictionary: TJaM.Dict] ~ {
found: BOOL;
d: Object;
[found, d] ← TJaM.TryToGet[sysdict, name];
IF found THEN dictionary ← TypeCheckDict[d]
ELSE {
dictionary ← TJaM.NewDict[size];
TJaM.Put[sysdict, name, dictionary];
}
};
kindNames: REF ARRAY OfStyle OF ATOM ← NEW[ARRAY OfStyle OF ATOM ← [
$screen, $print, $base]];
styleRuleDictNames: REF ARRAY OfStyle OF ATOM ~ NEW[ARRAY OfStyle OF ATOM ← [
TJaM.AtomFromRope["##BaseStyleRuleDictName"],
TJaM.AtomFromRope["##ScreenStyleRuleDictName"],
TJaM.AtomFromRope["##PrintStyleRuleDictName"]
]];
styleDictNames: REF ARRAY OfStyle OF ATOM ~ NEW[ARRAY OfStyle OF ATOM ←[
TJaM.AtomFromRope["##BaseStyleDictName"],
TJaM.AtomFromRope["##ScreenStyleDictName"],
TJaM.AtomFromRope["##PrintStyleDictName"]
]];
StartOfStyle: SIGNAL ~ CODE; -- raised to indicate start of loading style
EndOfStyle: SIGNAL ~ CODE; -- raised to indicate successful loading
WhatStyle: SIGNAL RETURNS [ATOM] ~ CODE; -- raised to find name of style being loaded
BeginStyleOp: TJaM.CommandProc ~ {
name: ATOM ← ForceLowerName[SIGNAL WhatStyle]; -- get style name from RunStyle
screenDict, printDict, baseDict: TJaM.Dict;
ResetDict: PROC [dict: TJaM.Dict] ~ {
TJaM.ClrDict[dict];
TJaM.DetachAll[dict];
};
MakeDict: PROC [kind: OfStyle] RETURNS [dict: TJaM.Dict] ~ {
dict ← CreateStyleDict[];
EnterStyleDict[name, dict, kind];
};
SetupDict: PROC [dict: TJaM.Dict, kind: OfStyle] ~ {
TJaM.Put[baseDict, styleRuleDictNames[kind], TJaM.NewDict[50]];
create rule name dict in baseDict
TJaM.Put[dict, styleKindName, kindNames[kind]];
record the style 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] };
SetupDict[baseDict, base]; SetupDict[screenDict, screen]; SetupDict[printDict, print];
TJaM.AttachDict[screenDict, baseDict];
TJaM.AttachDict[printDict, baseDict];
TJaM.Put[baseDict, styleDictNames[screen], screenDict];
TJaM.Put[baseDict, styleDictNames[print], printDict];
TJaM.Put[baseDict, styleDictNames[base], baseDict];
TJaM.Put[baseDict, styleDictName, name];
TJaM.Begin[frame, baseDict];
TJaM.Push[frame, baseDict]; -- leave this around for EndStyleOp
SIGNAL StartOfStyle; -- caught by RunStyle
};
EndStyleOp: TJaM.CommandProc ~ {
d1, d2: TJaM.Dict;
d1 ← TJaM.DictTop[frame]; -- the current dictionary
d2 ← TJaM.PopDict[frame]; -- pushed by StyleOp
IF d1 # d2 THEN {
TJaM.PushRope[frame, "mismatched Style and EndStyle commands"];
StyleError[frame, 1];
}
ELSE { -- change attachments so look in own basicDict before any attached dicts
name: ATOM ← SIGNAL WhatStyle;
screenDict: TJaM.Dict ~ CheckStyleDict[name, screen].d;
printDict: TJaM.Dict ~ CheckStyleDict[name, print].d;
TJaM.DetachDict[screenDict, d1];
TJaM.DetachDict[printDict, d1];
TJaM.AttachDict[screenDict, d1];
TJaM.AttachDict[printDict, d1];
TJaM.End[frame];
};
SIGNAL EndOfStyle; -- caught by RunStyle
};
StyleNameOp: TJaM.CommandProc ~ { -- expects style dictionary on op stack
TJaM.Push[frame, TJaM.Load[frame, styleDictName]]
};
StyleRuleOp: TJaM.CommandProc ~ { DefineStyleRule[frame, base] };
PrintRuleOp: TJaM.CommandProc ~ { DefineStyleRule[frame, print] };
ScreenRuleOp: TJaM.CommandProc ~ { DefineStyleRule[frame, screen] };
DefineStyleRule: PROC [frame: Frame, kind: OfStyle] ~ {
expects <name> <comment> <definition> on op stack
definition: Object ← TJaM.Pop[frame];
comment: Object ← TJaM.Pop[frame];
styleRule: ATOM ← PopName[frame];
name: ATOM ← ForceLowerName[styleRule];
dict: TJaM.Dict ← LoadStyleDict[frame, kind];
WITH definition SELECT FROM
x: TJaM.Array => TJaM.ABind[x, bindingDict];
ENDCASE; -- def may be a string
definition ← TJaM.CvX[definition];
TJaM.Put[dict, name, definition]; -- save the definition
IF name # styleRule THEN TJaM.Put[dict, styleRule, definition];
TJaM.Put[LoadStyleRuleDict[frame, kind], name, comment]; -- save the comment in the rule name dict
};
LoadStyleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [TJaM.Dict] ~ {
RETURN [TypeCheckDict[TJaM.Load[frame, styleDictNames[kind]]]];
};
LoadStyleRuleDict: PROC [frame: Frame, kind: OfStyle] RETURNS [TJaM.Dict] ~ {
RETURN [TypeCheckDict[TJaM.Load[frame, styleRuleDictNames[kind]]]];
};
OpenPrintStyleOp: TJaM.CommandProc ~ { -- expects style name on op stack
OpenStyle[frame, print];
};
OpenScreenStyleOp: TJaM.CommandProc ~ { -- expects style name on op stack
OpenStyle[frame, screen];
};
OpenStyle: PROC [frame: Frame, kind: OfStyle] ~ {
name: ATOM ← PopName[frame];
IF NOT NodeStyleOps.LoadStyle[name] THEN RETURN;
WHILE TJaM.DictTop[frame] # sysdict DO TJaM.End[frame]; ENDLOOP;
TJaM.Begin[frame, styledict];
TJaM.Begin[frame, GetStyleDict[frame, name, kind]];
};
ResetTestStyleOp: TJaM.CommandProc ~ {
IF debugStyle=NIL THEN debugStyle ← NodeStyleOps.Create[];
debugStyle^ ← NodeStyleOps.defaultStyle^;
};
StyleRuleDictOp: TJaM.CommandProc ~ { GetRuleDict[frame, base] };
PrintRuleDictOp: TJaM.CommandProc ~ { GetRuleDict[frame, print] };
ScreenRuleDictOp: TJaM.CommandProc ~ { GetRuleDict[frame, screen] };
GetRuleDict: PROC [frame: Frame, kind: OfStyle] ~ {
TJaM.Push[frame, styleRuleDictNames[kind]];
TJaM.Execute[frame, get];
};
AttachStyleOp: TJaM.CommandProc ~ { -- expects opstk to contain style name as a rope
name: ATOM ← ForceLowerName[PopName[frame]];
found: BOOL;
printDict, screenDict: TJaM.Dict;
array: TJaM.Array;
styleName: ATOM ← SIGNAL WhatStyle;
val: Object;
[printDict, found] ← CheckStyleDict[name, print];
IF NOT found THEN {
IF RunStyle[frame, name] THEN [printDict, found] ← CheckStyleDict[name, print];
IF NOT found THEN {
BadStyleFile[frame, name];
RETURN;
};
};
[screenDict, found] ← CheckStyleDict[name, screen];
IF ~found THEN ERROR;
TJaM.AttachDict[LoadStyleDict[frame, screen], screenDict];
TJaM.AttachDict[LoadStyleDict[frame, print], printDict];
[found, val] ← TJaM.TryToGet[attachmentsDict, styleName];
IF NOT found THEN array ← TJaM.NewArray[1] -- this is the first attachment
ELSE { -- add new item to the array
WITH val SELECT FROM
x: TJaM.Array => array ← x;
ENDCASE => ERROR;
array ← TJaM.ACopy[array, 1];
};
TJaM.APut[array, array.len-1, name];
TJaM.Put[attachmentsDict, styleName, array];
};
ForEachAttachedStyle: PUBLIC PROC [dictName: ATOM, proc: PROC [attached: ATOM]
RETURNS [stop: BOOL]] ~ {
val: Object;
array: TJaM.Array;
found: BOOL;
dictName ← ForceLowerName[dictName];
[found, val] ← TJaM.TryToGet[attachmentsDict, dictName];
IF NOT found THEN RETURN;
WITH val SELECT FROM
x: TJaM.Array => array ← x;
ENDCASE => ERROR;
FOR i: CARDINAL IN [0..array.len) DO
IF proc[TypeCheckName[TJaM.AGet[array, i]]] THEN RETURN;
ENDLOOP;
};
Execute Styles
ExecuteObject: PROC [frame: Frame, object: Object] RETURNS [ok: BOOL ← TRUE] ~ {
Utility routine; ensures same stack depth after execution; does NOT handle TJaM.Stop
initDepth, finalDepth: INT;
initDepth ← TJaM.CountStack[frame];
TJaM.Execute[frame, object];
finalDepth ← TJaM.CountStack[frame];
IF finalDepth # initDepth THEN {
TJaM.PushRope[frame, "Failed to leave stack at same depth after execution.\n"];
TJaM.Push[frame, object];
StyleError[frame, 2];
ok ← FALSE;
};
};
ExecuteName: PUBLIC PROC [frame: Frame, name: ATOM] RETURNS [ok: BOOL] ~ {
makes sure that same stack depth after execute
oldName: ATOM ← executingName;
[ok, ] ← TJaM.TryToLoad[frame, name];
executingName ← name;
IF ok THEN ok ← ExecuteObject[frame, name ! TJaM.Stop => {ok ← FALSE; CONTINUE}];
executingName ← oldName;
};
ExecuteNameInStyle: PUBLIC PROC [ref: Style, kind: OfStyle, styleRule: ATOM]
RETURNS [ok: BOOL] ~ {
makes sure that same stack depth after execute
styleName: ATOM ← ref.name[style];
frame: Frame ← GetFrame[ref, styleName, kind];
ok ← ExecuteName[frame, styleRule];
FreeFrame[frame, styleName, kind];
frame ← NIL;
ref.font ← NIL;
};
ExecuteObjectInStyle: PUBLIC PROC [ref: Style, kind: OfStyle, object: Object]
RETURNS [ok: BOOL ← TRUE] ~ {
makes sure that same stack depth after execute
styleName: ATOM ← ref.name[style];
frame: Frame ← GetFrame[ref, styleName, kind];
{
ENABLE TJaM.Stop => GO TO stop;
ok ← ExecuteObject[frame, TJaM.CvX[object]];
EXITS stop => ok ← FALSE;
};
FreeFrame[frame, styleName, kind];
frame ← NIL;
ref.font ← NIL;
};
ExecuteLooksInStyle: PUBLIC PROC [ref: Style, kind: OfStyle, looks: TextLooks.Looks]
RETURNS [ok: BOOL ← TRUE] ~ {
makes sure that same stack depth after execute
styleName: ATOM ← ref.name[style];
frame: Frame ← GetFrame[ref, styleName, kind];
FOR c: CHAR IN TextLooks.Look DO
IF looks[c] THEN ok ← ExecuteName[frame, lookNames[c]]
ENDLOOP;
FreeFrame[frame, styleName, kind];
frame ← NIL;
ref.font ← NIL;
IF nodeStyleFonts THEN {
ref.font ← NodeStyleFont.FontFromStyleParams[prefix: ref.name[fontPrefix], family: ref.name[fontFamily], face: ref.fontFace, size: GetReal[ref, fontSize], alphabets: ref.fontAlphabets];
};
};
lookNames: REF LookNames ← NEW[LookNames];
LookNames: TYPE ~ ARRAY TextLooks.Look OF ATOM;
InitLookNames: PROC ~ {
names are "look.a", "look.b", "look.c", etc.
FOR c: CHAR IN TextLooks.Look DO
lookNames[c] ← TJaM.AtomFromRope[Rope.Concat["look.", Rope.FromChar[c]]];
ENDLOOP;
};
StyleError: PUBLIC PROC [frame: Frame, num: INTEGER] ~ {
TJaM.PushInt[frame, num];
TJaM.Execute[frame, $StyleError ! TJaM.Stop => CONTINUE];
};
Implementing Style Attribute Operations
DoStyleOp: PUBLIC PROC [frame: Frame, p: Param] ~ {
aName: BOOL;
name: ATOM;
style: Style ← StyleForFrame[frame];
Error: PROC ~ {
TJaM.Push[frame, p.opName];
TJaM.PushRope[frame, "illegal as qualifer for"];
TJaM.Push[frame, name];
StyleError[frame, 3];
};
[name, aName] ← TryToPopName[frame];
IF NOT aName 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, aName] ← TryToPopName[frame];
IF NOT aName THEN p.ops.AddReal[frame, TJaM.PopReal[frame], p, style]
-- e.g., "2 pt bigger leading"
ELSE IF name = $percent THEN p.ops.Percent[frame, 100+TJaM.PopReal[frame], p, style]
-- e.g., "2 percent bigger leading"
ELSE { Error[]; RETURN };
};
$smaller => {
[name, aName] ← TryToPopName[frame];
IF NOT aName THEN p.ops.AddReal[frame, -TJaM.PopReal[frame], p, style]
-- e.g., "2 pt smaller leading"
ELSE IF name = $percent THEN p.ops.Percent[frame, 100-TJaM.PopReal[frame], p, style]
-- e.g., "2 percent smaller leading"
ELSE { Error[]; RETURN };
};
$percent => p.ops.Percent[frame, TJaM.PopReal[frame], p, style];
ENDCASE => p.ops.SetName[frame, name, p, style]; -- e.g., "TimesRoman family"
};
General Error Routines
StoreError: PUBLIC StoreProc ~ {
ob: Object ← TJaM.Pop[frame];
TJaM.Push[frame, p.opName];
TJaM.PushRope[frame, "is not legal as value for"];
TJaM.Push[frame, ob];
StyleError[frame, 3];
};
AddRealError: PUBLIC AddRealProc ~ {
TJaM.Push[frame, p.opName];
TJaM.PushRope[frame, "Numbers are illegal as values for"];
StyleError[frame, 2];
};
PercentError: PUBLIC PercentProc ~ {
TJaM.Push[frame, p.opName];
TJaM.PushRope[frame, "Numbers are illegal as values for"];
StyleError[frame, 2];
};
SetNameError: PUBLIC SetNameProc ~ {
TJaM.Push[frame, p.opName];
TJaM.PushRope[frame, "Only numbers are legal as values for"];
StyleError[frame, 2];
};
Name Parameter Operations
nameOps: PUBLIC Ops ← NEW [OpsRec ←
[LoadNameParam, StoreError, AddRealError, PercentError, SetNameParam]];
LoadNameParam: PUBLIC LoadProc ~ {
x: REF ParamRec.name ~ NARROW[p];
TJaM.Push[frame, style.name[x.param]];
};
SetNameParam: PUBLIC SetNameProc ~ {
x: REF ParamRec.name ~ NARROW[p];
style.name[x.param] ← name;
};
NameError: PUBLIC PROC [frame: Frame, name: ATOM, p: Param] ~ {
TJaM.Push[frame, p.opName];
TJaM.PushRope[frame, "illegal as value for"];
TJaM.Push[frame, name];
StyleError[frame, 3];
};
Real Parameter Operations
realOps: PUBLIC Ops ← NEW [OpsRec ←
[RealOpLoad, RealOpSetReal, RealOpAddReal, RealOpPercent, SetNameError]];
RealOpLoad: PUBLIC LoadProc ~ {
x: REF ParamRec.real ~ NARROW[p];
TJaM.PushReal[frame, GetReal[style, x.param]];
};
RealOpSetReal: PUBLIC StoreProc ~ {
x: REF ParamRec.real ~ NARROW[p];
SetReal[style, x.param, TJaM.PopReal[frame]];
};
RealOpAddReal: PUBLIC AddRealProc ~ {
x: REF ParamRec.real ~ NARROW[p];
SetReal[style, x.param, GetReal[style, x.param]+inc];
};
RealOpPercent: PUBLIC PercentProc ~ {
x: REF ParamRec.real ~ NARROW[p];
SetReal[style, x.param, GetReal[style, x.param]*(percent/100)];
};
Glue Parameter Operations
glueOps: PUBLIC Ops ← NEW [OpsRec ←
[GlueOpLoad, GlueOpSetReal, GlueOpAddReal, GlueOpPercent, SetNameError]];
GlueOpLoad: PUBLIC LoadProc ~ {
Push: PROC [r: RealParam] ~ { TJaM.PushReal[frame, GetReal[style, r]] };
x: REF ParamRec.glue ~ NARROW[p];
Push[x.size]; Push[x.stretch]; Push[x.shrink];
};
GlueOpSetReal: PUBLIC StoreProc ~ {
Pop: PROC [r: RealParam] ~ { SetReal[style, r, TJaM.PopReal[frame]] };
x: REF ParamRec.glue ~ NARROW[p];
Pop[x.shrink]; Pop[x.stretch]; Pop[x.size];
};
GlueOpAddReal: PUBLIC AddRealProc ~ {
Add: PROC [r: RealParam] ~ { SetReal[style, r, GetReal[style, r]+inc] };
x: REF ParamRec.glue ~ NARROW[p];
Add[x.size]; Add[x.stretch]; Add[x.shrink];
};
GlueOpPercent: PUBLIC PercentProc ~ {
Pct: PROC [r: RealParam] ~ { SetReal[style, r, GetReal[style, r]*(percent/100)] };
x: REF ParamRec.glue ~ NARROW[p];
Pct[x.size]; Pct[x.stretch]; Pct[x.shrink];
};
Color Parameter Operations
colorOps: PUBLIC Ops ← NEW [OpsRec ←
[ColorOpLoad, ColorOpSetReal, ColorOpAddReal, ColorOpPercent, SetNameError]];
ColorOpLoad: PUBLIC LoadProc ~ {
Push: PROC [r: RealParam] ~ { TJaM.PushReal[frame, GetReal[style, r]] };
x: REF ParamRec.color ~ NARROW[p];
Push[x.hue]; Push[x.saturation]; Push[x.brightness];
};
ColorOpSetReal: PUBLIC StoreProc ~ {
Pop: PROC [r: RealParam] ~ { SetReal[style, r, TJaM.PopReal[frame]] };
x: REF ParamRec.color ~ NARROW[p];
Pop[x.brightness]; Pop[x.saturation]; Pop[x.hue];
};
ColorOpAddReal: PUBLIC AddRealProc ~ {
Add: PROC [r: RealParam] ~ { SetReal[style, r, GetReal[style, r]+inc] };
x: REF ParamRec.color ~ NARROW[p];
Add[x.hue]; Add[x.saturation]; Add[x.brightness];
};
ColorOpPercent: PUBLIC PercentProc ~ {
Pct: PROC [r: RealParam] ~ { SetReal[style, r, GetReal[style, r]*(percent/100)] };
x: REF ParamRec.color ~ NARROW[p];
Pct[x.hue]; Pct[x.saturation]; Pct[x.brightness];
};
Initialization
RegisterWorks1: PUBLIC PROC [frame: Frame] ~ {
InitLookNames[];
register the various style commands and JaM commands in this module
RegisterStyleCommand[frame, $BeginStyle, BeginStyleOp];
RegisterStyleCommand[frame, $EndStyle, EndStyleOp];
RegisterStyleCommand[frame, $StyleRule, StyleRuleOp];
RegisterStyleCommand[frame, $PrintRule, PrintRuleOp];
RegisterStyleCommand[frame, $ScreenRule, ScreenRuleOp];
RegisterStyleCommand[frame, $AttachStyle, AttachStyleOp];
TJaM.Register[frame, $StyleName, StyleNameOp];
TJaM.Register[frame, $OpenPrintStyle, OpenPrintStyleOp];
TJaM.Register[frame, $OpenScreenStyle, OpenScreenStyleOp];
TJaM.Register[frame, $ResetTestStyle, ResetTestStyleOp];
TJaM.Register[frame, $StyleRuleDict, StyleRuleDictOp];
TJaM.Register[frame, $PrintRuleDict, PrintRuleDictOp];
TJaM.Register[frame, $ScreenRuleDict, ScreenRuleDictOp];
};
NodeStyleWorks2Impl
Support Procs
GetCommand: PUBLIC PROC [frame: Frame, name: ATOM] RETURNS [TJaM.Cmd] ~ {
known: BOOL;
obj: Object;
[known, obj] ← TJaM.TryToLoad[frame, name];
IF NOT known THEN ERROR;
RETURN [TypeCheckCommand[obj]];
};
ForceLowerName: PUBLIC PROC [n: ATOM] RETURNS [ATOM] ~ {
IF n#NIL THEN {
rope: ROPE ~ Atom.GetPName[n];
CheckLower: Rope.ActionType ~ {quit ← c IN ['A..'Z]};
IF Rope.Map[base: rope, action: CheckLower] THEN {
len: NAT ~ Rope.Length[rope];
text: REF TEXT ~ RefText.ObtainScratch[len];
FOR i: NAT IN[0..len) DO text[i] ← Ascii.Lower[Rope.Fetch[rope, i]] ENDLOOP;
text.length ← len;
n ← Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[text];
};
};
RETURN [n];
};
ForceLowerRope: PUBLIC PROC [r: ROPE] RETURNS [ROPE] ~ {
ForceCharLower: PROC [old: CHAR] RETURNS [new: CHAR] ~ {
RETURN [Ascii.Lower[old]] };
RETURN [Rope.Translate[base: r, translator: ForceCharLower]];
};
PopName: PUBLIC PROC [frame: Frame] RETURNS [name: ATOM] ~ {
ok: BOOL ← TRUE;
obj: Object ← NIL;
IF TJaM.StackIsEmpty[frame] THEN ok ← FALSE;
IF ok THEN SELECT TJaM.TopType[frame] FROM
atom => RETURN [TJaM.PopAtom[frame]];
rope => RETURN [TJaM.AtomFromRope[TJaM.PopRope[frame]]]
ENDCASE => { ok ← FALSE; obj ← TJaM.Pop[frame]; };
IF NOT ok THEN {
TJaM.PushRope[frame, " -- found where a name was expected."];
TJaM.Push[frame, obj];
StyleError[frame, 2];
};
};
TryToPopName: PUBLIC PROC [frame: Frame] RETURNS [name: ATOM, ok: BOOL] ~ {
IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM
atom => RETURN [name: TJaM.PopAtom[frame], ok: TRUE];
rope => RETURN [name: TJaM.AtomFromRope[TJaM.PopRope[frame]], ok: TRUE];
ENDCASE;
RETURN[name: NIL, ok: FALSE];
};
TryToPopReal: PUBLIC PROC [frame: Frame] RETURNS [value: REAL, ok: BOOL] ~ {
IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM
number => RETURN [value: TJaM.PopReal[frame], ok: TRUE];
ENDCASE;
RETURN[value: 0, ok: FALSE];
};
TryToPopRope: PUBLIC PROC [frame: Frame] RETURNS [rope: ROPE, ok: BOOL] ~ {
IF NOT TJaM.StackIsEmpty[frame] THEN SELECT TJaM.TopType[frame] FROM
atom => RETURN [rope: TJaM.RopeFromAtom[TJaM.PopAtom[frame]], ok: TRUE];
rope => RETURN [rope: TJaM.PopRope[frame], ok: TRUE];
ENDCASE;
RETURN[rope: NIL, ok: FALSE];
};
TypeCheckName: PUBLIC PROC [obj: Object] RETURNS [ATOM] ~ {
WITH obj SELECT FROM
x: ATOM => RETURN [x];
x: ROPE => RETURN [TJaM.AtomFromRope[x]];
ENDCASE;
ERROR;
};
TypeCheckDict: PUBLIC PROC [obj: Object] RETURNS [TJaM.Dict] ~ {
WITH obj SELECT FROM
x: TJaM.Dict => RETURN [x];
ENDCASE;
ERROR;
};
TypeCheckCommand: PUBLIC PROC [obj: Object] RETURNS [TJaM.Cmd] ~ {
WITH obj SELECT FROM
x: TJaM.Cmd => RETURN [x];
ENDCASE;
ERROR;
};
Readonly Style Variables
IsCommentOp: TJaM.CommandProc ~ {
style: Style ← StyleForFrame[frame];
TJaM.PushBool[frame, style.isComment];
};
IsPrintOp: TJaM.CommandProc ~ {
style: Style ← StyleForFrame[frame];
TJaM.PushBool[frame, style.print];
};
NestingLevelOp: TJaM.CommandProc ~ {
style: Style ← StyleForFrame[frame];
TJaM.PushInt[frame, style.nestingLevel];
};
StyleParam Implementation
StyleParamOp: TJaM.CommandProc ~ {
called to declare a special style parameter
initialValue: Object ← TJaM.Pop[frame]; -- the initial value
name: ATOM ← PopName[frame]; -- the parameter name
key: ATOM;
array: TJaM.Array;
[key, array] ← SpecialOpArray[name, $SpecialOp];
TJaM.Def[frame, name, TJaM.CvX[array]]; -- store the definition
TJaM.Def[frame, key, initialValue]; -- store the initial value
};
SpecialOpArray: PUBLIC PROC [name: ATOM, op: Object]
RETURNS [key: ATOM, array: TJaM.Array] ~ {
create a 2-element array with (name, objectToExecute)
key ← StyleParamKey[name];
array ← TJaM.NewArray[2];
TJaM.APut[array, 0, TJaM.CvLit[key]];
TJaM.APut[array, 1, op];
};
StyleParamKey: PUBLIC PROC [name: ATOM] RETURNS [key: ATOM] ~ {
create a key which is "!!name" (sort of unique, don't you think)
scratch: REF TEXT ~ RefText.ObtainScratch[50];
text: REF TEXT ← scratch;
text ← RefText.AppendRope[text, "!!"];
text ← RefText.AppendRope[text, Atom.GetPName[name]];
key ← Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[scratch];
};
SpecialOp: TJaM.CommandProc ~ {
like DoStyleOperation, but for special parameters
aName: BOOL;
name: ATOM;
var: ATOM;
style: Style ← StyleForFrame[frame];
Error: PROC ~ {
TJaM.Push[frame, name];
TJaM.PushRope[frame, "has illegal qualifier:"];
TJaM.Push[frame, var];
StyleError[frame, 3];
};
FindObject: PROC RETURNS [Object] ~ {
FOR x: DataList ← style.dataList, x.next UNTIL x=NIL DO
xx: REF DataEntry.object ~ NARROW[x];
IF xx.name = var THEN RETURN [xx.object];
ENDLOOP;
TJaM.Push[frame, var];
TJaM.Execute[frame, load]; -- get the initial value
RETURN [TJaM.Pop[frame]];
};
Store: PROC [ob: Object] ~ {
style.dataList ← NEW[DataEntry ← [style.dataList, object[var, ob]]];
};
Load: PROC ~ { TJaM.Push[frame, FindObject[]] };
AddReal: PROC [inc: REAL] ~ {
value: REAL;
Load[];
value ← TJaM.PopReal[frame];
SetReal[value+inc];
};
SetReal: PROC [x: REAL] ~ {
TJaM.PushReal[frame, x];
Store[TJaM.Pop[frame]];
};
SetName: PROC [n: ATOM] ~ {
TJaM.Push[frame, n];
Store[TJaM.Pop[frame]];
};
Percent: PROC [percent: REAL] ~ {
value: REAL;
Load[];
value ← TJaM.PopReal[frame];
SetReal[(percent/100)*value];
};
var ← PopName[frame]; -- the name of the special parameter
[name, aName] ← TryToPopName[frame];
IF NOT aName THEN Store[TJaM.Pop[frame]]
store the object as new value
ELSE SELECT name FROM
$the => Load[];
$bigger =>
BEGIN
[name, aName] ← TryToPopName[frame];
IF NOT aName
THEN AddReal[TJaM.PopReal[frame]]
ELSE IF name = $percent THEN Percent[100+TJaM.PopReal[frame]]
ELSE { Error; RETURN };
END;
$smaller =>
BEGIN
[name, aName] ← TryToPopName[frame];
IF NOT aName
THEN AddReal[-TJaM.PopReal[frame]]
ELSE IF name = $percent THEN Percent[100-TJaM.PopReal[frame]]
ELSE { Error; RETURN };
END;
$percent => Percent[TJaM.PopReal[frame]];
ENDCASE => SetName[name];
};
RegisterStyleCommand: PUBLIC PROC [frame: Frame, name: ATOM,
proc: TJaM.CommandProc] ~ {
TJaM.Register[frame, name, proc];
-- add it to the binding dictionary
TJaM.Put[bindingDict, name, TJaM.Load[frame, name]];
};
RegisterStyleLiteral: PUBLIC PROC [frame: Frame, name: ATOM] ~ {
-- add it to the binding dictionary
TJaM.Put[bindingDict, name, name];
-- add it to the current dictionary
TJaM.Def[frame, name, TJaM.CvLit[name]];
};
ReportStyleErrorOp: TJaM.CommandProc ~ {
num: INT ← TJaM.PopInt[frame];
msg: ROPE;
ok: BOOL;
MessageWindow.Clear[];
IF executingName # NIL THEN {
TJaM.PushRope[frame, "style rule. "];
TJaM.Push[frame, executingName];
TJaM.PushRope[frame, "Error in"];
num ← num+3;
};
UNTIL num=0 DO
[msg, ok] ← TryToPopRope[frame];
IF NOT ok THEN EXIT;
MessageWindow.Append[msg];
num ← num-1;
IF num # 0 THEN MessageWindow.Append[" "];
ENDLOOP;
};
RegisterWorks2: PUBLIC PROC [frame: Frame] ~ {
register the various style commands and JaM commands in this module
TJaM.Register[frame, $isComment, IsCommentOp];
TJaM.Register[frame, $isPrint, IsPrintOp];
TJaM.Register[frame, $nestingLevel, NestingLevelOp];
TJaM.Register[frame, $StyleParam, StyleParamOp];
TJaM.Register[frame, $SpecialOp, SpecialOp];
TJaM.Register[frame, $ReportStyleError, ReportStyleErrorOp];
};
NodeStyleWorks3Impl
Initialization
This must be first to pick up the Preregister calls in the start code.
OpsListItem: TYPE ~ RECORD [name: ATOM, op: TJaM.CommandProc];
OpsList: TYPE ~ LIST OF OpsListItem;
opsList: OpsList ← NIL;
Preregister: PROC [param: Param, op: TJaM.CommandProc] RETURNS [Param] ~ {
opsList ← CONS[[param.opName, op], opsList];
RETURN [param];
};
RegisterWorks3: PUBLIC PROC [frame: Frame] ~ {
FOR list: OpsList ← opsList, list.rest UNTIL list=NIL DO
RegisterStyleCommand[frame, list.first.name, list.first.op];
ENDLOOP;
RegisterStyleCommand[frame, $clearTabStops, ClearTabStopsOp];
RegisterStyleCommand[frame, $tabStop, TabStopOp];
RegisterStyleCommand[frame, $defaultTabStops, DefaultTabStopsOp];
RegisterStyleCommand[frame, $tabStopLocations, RelativeTabStopsOp];
RegisterStyleCommand[frame, $pt, PointsOp];
RegisterStyleCommand[frame, $pc, PicasOp];
RegisterStyleCommand[frame, $in, InchesOp];
RegisterStyleCommand[frame, $cm, CentimetersOp];
RegisterStyleCommand[frame, $mm, MillimetersOp];
RegisterStyleCommand[frame, $dd, DidotPointsOp];
RegisterStyleCommand[frame, $em, EmsOp];
RegisterStyleCommand[frame, $en, EnsOp];
RegisterStyleCommand[frame, $screensp, ScreenSpacesOp];
RegisterStyleCommand[frame, $printsp, PrintSpacesOp];
RegisterStyleCommand[frame, $fil, FilOp];
RegisterStyleCommand[frame, $fill, FillOp];
RegisterStyleCommand[frame, $filll, FilllOp];
};
Style Name
StyleNameOp: TJaM.CommandProc ~ { DoStyleOp[frame, styleNameParam] };
styleNameParam: Param ← Preregister[NEW [name ParamRec ← [nameOps, $style, name[style]]], StyleNameOp];
Font Parameters
Font Prefix
FontPrefixOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontPrefixParam] };
fontPrefixParam: Param ← Preregister[NEW [name ParamRec ← [nameOps, $fontPrefix, name[fontPrefix]]], FontPrefixOp];
Font Family
FontFamilyOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontFamilyParam] };
fontFamilyParam: Param ← Preregister[NEW [name ParamRec ← [nameOps, $family, name[fontFamily]]], FontFamilyOp];
Font Size
FontSizeOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontSizeParam] };
fontSizeParam: Param ← Preregister[NEW [real ParamRec ← [realOps, $size, real[fontSize]]], FontSizeOp];
Font Face
FontFaceOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontFaceParam] };
fontFaceParam: Param ← Preregister[NEW[misc ParamRec ← [NEW [OpsRec ←
[FontFaceLoad, StoreError, AddRealError, PercentError, FontFaceSetName]],
$face, misc[]]], FontFaceOp];
FontFaceLoad: LoadProc ~ {
TJaM.Push[frame, SELECT style.fontFace FROM
Regular => $regular,
Bold => $bold,
Italic => $italic,
BoldItalic => bolditalic,
ENDCASE => ERROR]
};
FontFaceSetName: SetNameProc ~ {
Error: PROC RETURNS [FontFace] ~ { NameError[frame, name, p]; RETURN [Regular]; };
FontFaceArray: TYPE ~ ARRAY FontFace OF FontFace;
minusBold: FontFaceArray ~ [Regular, Regular, Italic, Italic];
minusItalic: FontFaceArray ~ [Regular, Bold, Regular, Bold];
plusBold: FontFaceArray ~ [Bold, Bold, BoldItalic, BoldItalic];
plusItalic: FontFaceArray ~ [Italic, BoldItalic, Italic, BoldItalic];
style.fontFace ← SELECT name FROM
$regular => Regular,
$bold => Bold,
$italic => Italic,
bolditalic => BoldItalic,
plusbold => plusBold[style.fontFace],
plusitalic => plusItalic[style.fontFace],
minusbold => minusBold[style.fontFace],
minusitalic => minusItalic[style.fontFace],
ENDCASE => Error[];
};
bolditalic: ATOM ~ TJaM.AtomFromRope["bold+italic"];
plusbold: ATOM ~ TJaM.AtomFromRope["+bold"];
plusitalic: ATOM ~ TJaM.AtomFromRope["+italic"];
minusbold: ATOM ~ TJaM.AtomFromRope["-bold"];
minusitalic: ATOM ~ TJaM.AtomFromRope["-italic"];
Font Alphabets
FontAlphabetsOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontAlphabetsParam] };
fontAlphabetsParam: Param ← Preregister[NEW[misc ParamRec ← [NEW [OpsRec ←
[FontAlphabetsLoad, StoreError, AddRealError, PercentError, FontAlphabetsSetName]],
$alphabets,
misc[]]], FontAlphabetsOp];
FontAlphabetsLoad: LoadProc ~ {
TJaM.Push[frame, SELECT style.fontAlphabets FROM
CapsAndLower => capsAndLower,
CapsAndSmallCaps => capsAndSmallCaps,
LowerOnly => $lowercase,
CapsOnly => $caps,
ENDCASE => ERROR]
};
FontAlphabetsSetName: SetNameProc ~ {
Error: PROC RETURNS [FontAlphabets] ~ {
NameError[frame, name, p];
RETURN [CapsAndLower];
};
style.fontAlphabets ← SELECT name FROM
capsAndLower => CapsAndLower,
capsAndSmallCaps => CapsAndSmallCaps,
$lowercase => LowerOnly,
$caps => CapsOnly,
ENDCASE => Error[];
};
capsAndLower: ATOM ~ TJaM.AtomFromRope["caps+lowercase"];
capsAndSmallCaps: ATOM ~ TJaM.AtomFromRope["caps+smallcaps"];
Text Rotation
TextRotationOp: TJaM.CommandProc ~ { DoStyleOp[frame, textRotationParam] };
textRotationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $textRotation, real[textRotation]]], TextRotationOp];
Indents
Left Indent
LeftIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, leftIndentParam] };
leftIndentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $leftIndent, real[leftIndent]]], LeftIndentOp];
Right Indent
RightIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, rightIndentParam] };
rightIndentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $rightIndent, real[rightIndent]]], RightIndentOp];
First Indent
FirstIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, firstIndentParam] };
firstIndentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $firstIndent, real[firstIndent]]], FirstIndentOp];
First Indent on the Right
FirstIndentRightOp: TJaM.CommandProc ~ { DoStyleOp[frame, firstIndentRightParam] };
firstIndentRightParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $firstIndentRight, real[firstIndentRight]]], FirstIndentRightOp];
Rest Indent
RestIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, restIndentParam] };
restIndentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $restIndent, real[restIndent]]], RestIndentOp];
Runaround Left
RunaroundLeftOp: TJaM.CommandProc ~ { DoStyleOp[frame, runaroundLeftParam] };
runaroundLeftParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $runaroundLeft, real[runaroundLeft]]], RunaroundLeftOp];
Runaround Right
RunaroundRightOp: TJaM.CommandProc ~ { DoStyleOp[frame, runaroundRightParam] };
runaroundRightParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $runaroundRight, real[runaroundRight]]], RunaroundRightOp];
Top Indent
TopIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, topIndentParam] };
topIndentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $topIndent, real[topIndent]]], TopIndentOp];
Bottom Indent
BottomIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomIndentParam] };
bottomIndentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $bottomIndent, real[bottomIndent]]], BottomIndentOp];
Leading Parameters
Line Leading Glue
LineLeadingOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingParam]; };
lineLeadingParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $leading, real[leading]]], LineLeadingOp];
LineLeadingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingStretchParam] };
lineLeadingStretchParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $leadingStretch, real[leadingStretch]]], LineLeadingStretchOp];
LineLeadingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingShrinkParam] };
lineLeadingShrinkParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $leadingShrink, real[leadingShrink]]], LineLeadingShrinkOp];
LineLeadingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingGlueParam] };
lineLeadingGlueParam: Param ← Preregister[NEW[glue ParamRec ← [glueOps, $leadingGlue, glue[leading, leadingStretch, leadingShrink]]], LineLeadingGlueOp];
Top Leading Glue
TopLeadingOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingParam]; };
topLeadingParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $topLeading, real[topLeading]]], TopLeadingOp];
TopLeadingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingStretchParam] };
topLeadingStretchParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $topLeadingStretch, real[topLeadingStretch]]], TopLeadingStretchOp];
TopLeadingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingShrinkParam] };
topLeadingShrinkParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $topLeadingShrink, real[topLeadingShrink]]], TopLeadingShrinkOp];
TopLeadingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingGlueParam] };
topLeadingGlueParam: Param ← Preregister[NEW[glue ParamRec ← [glueOps, $topLeadingGlue, glue[topLeading, topLeadingStretch, topLeadingShrink]]], TopLeadingGlueOp];
Bottom Leading Glue
BottomLeadingOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingParam]; };
bottomLeadingParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $bottomLeading, real[bottomLeading]]], BottomLeadingOp];
BottomLeadingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingStretchParam] };
bottomLeadingStretchParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $bottomLeadingStretch, real[bottomLeadingStretch]]], BottomLeadingStretchOp];
BottomLeadingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingShrinkParam] };
bottomLeadingShrinkParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $bottomLeadingShrink, real[bottomLeadingShrink]]], BottomLeadingShrinkOp];
BottomLeadingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingGlueParam] };
bottomLeadingGlueParam: Param ← Preregister[NEW[glue ParamRec ← [glueOps, $bottomLeadingGlue, glue[bottomLeading, bottomLeadingStretch, bottomLeadingShrink]]], BottomLeadingGlueOp];
Line Formatting
LineFormattingOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineFormattingParam]; };
lineFormattingParam: Param ← Preregister[NEW [misc ParamRec ← [NEW [OpsRec ←
[LineFormattingLoad, StoreError, AddRealError, PercentError, LineFormattingSetName]],
$lineFormatting, misc[]]], LineFormattingOp];
LineFormattingLoad: LoadProc ~ {
TJaM.Push[frame, SELECT style.lineFormatting FROM
Justified => $justified,
FlushLeft => $flushLeft,
FlushRight => $flushRight,
Centered => $centered,
ENDCASE => ERROR]
};
LineFormattingSetName: SetNameProc ~ {
Error: PROC RETURNS [LineFormatting] ~ {
NameError[frame, name, p]; RETURN [FlushLeft] };
style.lineFormatting ← SELECT name FROM
$justified => Justified,
$flushLeft => FlushLeft,
$flushRight => FlushRight,
$centered => Centered,
ENDCASE => Error[];
};
LastLineFormattingOp: TJaM.CommandProc ~ { DoStyleOp[frame, lastLineFormattingParam]; };
lastLineFormattingParam: Param ← Preregister[NEW [misc ParamRec ← [NEW [OpsRec ←
[LastLineFormattingLoad, StoreError, AddRealError, PercentError, LastLineFormattingSetName]],
$lastLineFormatting, misc[]]], LastLineFormattingOp];
LastLineFormattingLoad: LoadProc ~ {
TJaM.Push[frame, SELECT style.lastLineFormatting FROM
Justified => $justified,
FlushLeft => $flushLeft,
FlushRight => $flushRight,
Centered => $centered,
ENDCASE => ERROR]
};
LastLineFormattingSetName: SetNameProc ~ {
Error: PROC RETURNS [LineFormatting] ~ {
NameError[frame, name, p]; RETURN [FlushLeft] };
style.lastLineFormatting ← SELECT name FROM
$justified => Justified,
$flushLeft => FlushLeft,
$flushRight => FlushRight,
$centered => Centered,
ENDCASE => Error[];
};
Underlining
UnderliningOp: TJaM.CommandProc ~ { DoStyleOp[frame, underliningParam] };
underliningParam: Param ← Preregister[NEW [misc ParamRec ← [NEW [OpsRec ←
[UnderliningLoad, StoreError, AddRealError, PercentError, UnderliningSetName]],
$underlining, misc[]]], UnderliningOp];
UnderliningLoad: LoadProc ~ {
TJaM.Push[frame, SELECT style.underlining FROM
None => $none,
LettersAndDigits => lettersAndDigits,
Visible => $visible,
All => $all,
ENDCASE => ERROR]
};
lettersAndDigits: ATOM ~ TJaM.AtomFromRope["letters+digits"];
UnderliningSetName: SetNameProc ~ {
Error: PROC RETURNS [FontUnderlining] ~ { NameError[frame, name, p]; RETURN [None] };
style.underlining ← SELECT name FROM
$none => None,
lettersAndDigits => LettersAndDigits,
$visible => Visible,
$all => All,
ENDCASE => Error[];
};
Strikeout
StrikeoutOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutParam] };
strikeoutParam: Param ← Preregister[NEW [misc ParamRec ← [NEW [OpsRec ←
[StrikeoutLoad, StoreError, AddRealError, PercentError, StrikeoutSetName]],
$strikeout, misc[]]], StrikeoutOp];
StrikeoutLoad: LoadProc ~ {
TJaM.Push[frame, SELECT style.strikeout FROM
None => $none,
LettersAndDigits => lettersAndDigits,
Visible => $visible,
All => $all,
ENDCASE => ERROR]
};
StrikeoutSetName: SetNameProc ~ {
Error: PROC RETURNS [FontUnderlining] ~ { NameError[frame, name, p]; RETURN [None] };
style.strikeout ← SELECT name FROM
$none => None,
lettersAndDigits => LettersAndDigits,
$visible => Visible,
$all => All,
ENDCASE => Error[];
};
Miscellaneous Positioning Parameters
HShiftOp: TJaM.CommandProc ~ { DoStyleOp[frame, hshiftParam] };
hshiftParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $hShift, real[hshift]]], HShiftOp];
VShiftOp: TJaM.CommandProc ~ { DoStyleOp[frame, vshiftParam] };
vshiftParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $vShift, real[vshift]]], VShiftOp];
MinLineGapOp: TJaM.CommandProc ~ { DoStyleOp[frame, minLineGapParam]; };
minLineGapParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $minLineGap, real[minLineGap]]], MinLineGapOp];
TabStops
TabStopsOp: TJaM.CommandProc ~ { DoStyleOp[frame, tabStopsParam]; };
tabStopsParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $tabStops, real[tabStops]]], TabStopsOp];
Line Weight
LineWeightOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineWeightParam] };
lineWeightParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $lineWeight, real[lineWeight]]], LineWeightOp];
Page Layout Parameters
Page Width
PageWidthOp: TJaM.CommandProc ~ { DoStyleOp[frame, pageWidthParam] };
pageWidthParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageWidth, real[pageWidth]]], PageWidthOp];
PageLengthOp: TJaM.CommandProc ~ { DoStyleOp[frame, pageLengthParam] };
pageLengthParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageLength, real[pageLength]]], PageLengthOp];
LeftMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, leftMarginParam] };
leftMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $leftMargin, real[leftMargin]]], LeftMarginOp];
RightMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, rightMarginParam] };
rightMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $rightMargin, real[rightMargin]]], RightMarginOp];
TopMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, topMarginParam] };
topMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $topMargin, real[topMargin]]], TopMarginOp];
BottomMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomMarginParam] };
bottomMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $bottomMargin, real[bottomMargin]]], BottomMarginOp];
HeaderMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, headerMarginParam] };
headerMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $headerMargin, real[headerMargin]]], HeaderMarginOp];
FooterMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, footerMarginParam] };
footerMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $footerMargin, real[footerMargin]]], FooterMarginOp];
BindingMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, bindingMarginParam] };
bindingMarginParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $bindingMargin, real[bindingMargin]]], BindingMarginOp];
LineLengthOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLengthParam] };
lineLengthParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $lineLength, real[lineLength]]], LineLengthOp];
ColumnOp: TJaM.CommandProc ~ { DoStyleOp[frame, columnParam] };
columnParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $column, real[columns]]], ColumnOp];
Text Color
TextHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, textHueParam] };
textHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $textHue, real[textHue]]], TextHueOp];
TextSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, textSaturationParam] };
textSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $textSaturation, real[textSaturation]]], TextSaturationOp];
TextBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, textBrightnessParam] };
textBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $textBrightness, real[textBrightness]]], TextBrightnessOp];
TextColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, textColorParam] };
textColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $textColor, color[textHue, textSaturation, textBrightness]]], TextColorOp];
Page Break Penalty Parameters
PageBreakPenaltyOp: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenaltyParam] };
pageBreakPenaltyParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageBreakPenalty, real[pageBreakPenalty]]], PageBreakPenaltyOp];
PageBreakPenalty2Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty2Param] };
pageBreakPenalty2Param: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageBreakAfterFirstLinePenalty, real[pageBreakAfterFirstLinePenalty]]], PageBreakPenalty2Op];
PageBreakPenalty3Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty3Param] };
pageBreakPenalty3Param: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageBreakAfterLastLinePenalty, real[pageBreakAfterLastLinePenalty]]], PageBreakPenalty3Op];
PageBreakPenalty4Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty4Param] };
pageBreakPenalty4Param: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageBreakBeforeFirstLinePenalty, real[pageBreakBeforeFirstLinePenalty]]], PageBreakPenalty4Op];
PageBreakPenalty5Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty5Param] };
pageBreakPenalty5Param: Param ← Preregister[NEW[real ParamRec ← [realOps, $pageBreakBeforeLastLinePenalty, real[pageBreakBeforeLastLinePenalty]]], PageBreakPenalty5Op];
Fancy Tabs
ClearTabStopsOp: TJaM.CommandProc ~ {
ref: Style ← StyleForFrame[frame];
ref.tabStops ← NIL; ref.numTabStops ← 0;
};
TabStopOp: TJaM.CommandProc ~ {
ref: Style ← StyleForFrame[frame];
tabStop: TabStop ← TabSpec[ref, frame];
loc: REAL ← 0.0;
tabStop.loc ← GetTabRealCode[ref, tabStop, loc, TJaM.PopReal[frame]];
Insert in list of tab stops. kept sorted by decreasing location, i.e., from right to left on page
this may result in a slight decrease in efficiency for the formatters, but it substantially reduces allocations during the creation of the list since styles tend to define tab stops in increasing order, so can add to start of list and list additions must be non-destructive of the previous list
loc ← GetTabLoc[tabStop, ref];
ref.numTabStops ← ref.numTabStops+1;
IF ref.tabStops = NIL OR GetTabLoc[ref.tabStops.first, ref] <= loc THEN
ref.tabStops ← CONS[tabStop, ref.tabStops]
ELSE { -- copy list up to first with smaller loc
old: LIST OF TabStop ← ref.tabStops;
new: LIST OF TabStop ← CONS[old.first, NIL];
ref.tabStops ← new;
FOR lst: LIST OF TabStop ← old.rest, lst.rest DO
IF lst=NIL OR GetTabLoc[lst.first, ref] <= loc THEN { -- insert here
new.rest ← CONS[tabStop, lst];
EXIT;
};
new.rest ← CONS[lst.first, NIL];
new ← new.rest;
ENDLOOP;
};
};
RelativeTabStopsOp: TJaM.CommandProc ~ {
ref: Style ← StyleForFrame[frame];
name: ATOM;
ok: BOOL;
[name, ok] ← TryToPopName[frame];
IF NOT ok THEN { -- restore name to stack and return default
TJaM.PushRope[frame, "illegal value for tabStops: should be fixed or relative"];
StyleError[frame, 1];
};
SELECT name FROM
$fixed => ref.fixedTabs ← TRUE;
$relative => ref.fixedTabs ← FALSE;
ENDCASE => { -- restore name to stack and return default
TJaM.Push[frame, name];
TJaM.PushRope[frame, "illegal value for tabStops: should be fixed or relative"];
StyleError[frame, 2];
};
};
DefaultTabStopsOp: TJaM.CommandProc ~ {
ref: Style ← StyleForFrame[frame];
tabStop: TabStop ← TabSpec[ref, frame];
tabStop.loc ← GetTabRealCode[ref, tabStop, loc, TJaM.PopReal[frame]];
ref.defaultTabStops ← tabStop;
};
TabSpec: PROC [ref: Style, frame: Frame] RETURNS [tabStop: TabStop] ~ { -- parse tab specs
looks: Tioga.Looks ← TabLooksSpec[frame];
breakIfPast: BOOL ← TabPastSpec[frame];
tabStop ← TabPattern[ref, frame];
tabStop.looks ← looks;
tabStop.breakIfPast ← breakIfPast;
TabAlign[tabStop, frame];
};
TabLooksSpec: PROC [frame: Frame] RETURNS [lks: Tioga.Looks] ~ {
name: ATOM;
ok: BOOL;
SetLookBit: Rope.ActionType ~ {
PROC [c: CHAR] RETURNS [quit: BOOL ← FALSE]
c ← Ascii.Lower[c];
IF c IN ['a..'z] THEN lks[c] ← TRUE;
RETURN [FALSE];
};
lks ← Tioga.noLooks;
[name, ok] ← TryToPopName[frame];
IF NOT ok THEN RETURN;
IF name # $looks THEN { TJaM.Push[frame, name]; RETURN };
[] ← Rope.Map[base~TJaM.PopRope[frame], action~SetLookBit];
};
TabPastSpec: PROC [frame: Frame] RETURNS [break: BOOL] ~ {
name: ATOM;
ok: BOOL;
[name, ok] ← TryToPopName[frame];
IF NOT ok THEN RETURN;
SELECT name FROM
$breakIfPast => break ← TRUE;
$spaceIfPast => break ← FALSE;
ENDCASE => { -- restore name to stack and return default
TJaM.Push[frame, name];
break ← FALSE;
};
};
TabPattern: PROC [ref: Style, frame: Frame] RETURNS [tabStop: TabStop] ~ {
name: ATOM;
ok: BOOL;
[name, ok] ← TryToPopName[frame];
IF NOT ok THEN { tabStop ← NEW[blank TabStopRec]; RETURN };
SELECT name FROM
$blank => tabStop ← NEW[blank TabStopRec];
$leaders => {
leaderRope: ROPE;
value: REAL ← 0.0;
ldrStop: LeaderTabStop ← NEW[leaders TabStopRec];
tabStop ← ldrStop;
[name, ok] ← TryToPopName[frame];
IF NOT ok THEN ldrStop.congruent ← TRUE
ELSE SELECT name FROM
$centered => ldrStop.congruent ← FALSE;
$congruent => ldrStop.congruent ← TRUE;
ENDCASE => {
TJaM.Push[frame, name];
TJaM.PushRope[frame, "is not legal as value for tab leaders: congruent or centered"];
StyleError[frame, 2];
};
[value, ok] ← TryToPopReal[frame];
ldrStop.spacing ← GetTabRealCode[ref, tabStop, spacing, IF ok THEN value ELSE 0.0];
[leaderRope, ok] ← TryToPopRope[frame];
IF ok AND NOT leaderRope.IsEmpty THEN {
IF leaderRope.Length > 1 THEN {
TJaM.PushRope[frame, "Cannot specify more than one character for tab leaders"];
StyleError[frame, 1];
}
ELSE ldrStop.char ← leaderRope.Fetch[0];
}
ELSE {
TJaM.PushRope[frame, "Must specify character for tab leaders"];
StyleError[frame, 1];
};
};
$rule => {
ruleStop: RuleTabStop ← NEW[rule TabStopRec];
tabStop ← ruleStop;
ruleStop.vshift ← GetTabRealCode[ref, tabStop, vshift, TJaM.PopReal[frame]];
ruleStop.weight ← GetTabRealCode[ref, tabStop, weight, TJaM.PopReal[frame]];
};
$rules => {
array: TJaM.Array ← TJaM.PopArray[frame];
rulesStop: RulesTabStop ← NEW[rules TabStopRec];
tabStop ← rulesStop;
rulesStop.rules ← NEW[TabArrayRec[array.len]];
FOR i: NAT IN [0..array.len/2) DO
TJaM.Push[frame, TJaM.AGet[array, 2*i]];
rulesStop.rules.array[i].weight ←
GetTabRealCode[ref, tabStop, weight, TJaM.PopReal[frame]];
TJaM.Push[frame, TJaM.AGet[array, 2*i+1]];
rulesStop.rules.array[i].vshift ←
GetTabRealCode[ref, tabStop, vshift, TJaM.PopReal[frame]];
ENDLOOP;
};
ENDCASE => {
restore name to stack and return default
TJaM.Push[frame, name];
tabStop ← NEW[blank TabStopRec];
};
};
MissingChar: PROC [frame: Frame] ~ {
TJaM.PushRope[frame, "Cannot specify more than one character for tab alignment"];
StyleError[frame, 1];
};
TabAlign: PROC [tabStop: TabStop, frame: Frame] ~ {
name: ATOM;
ok: BOOL;
[name, ok] ← TryToPopName[frame];
IF NOT ok THEN { tabStop.alignment ← FlushLeft; RETURN };
SELECT name FROM
$flushLeft => tabStop.alignment ← FlushLeft;
$flushRight => tabStop.alignment ← FlushRight;
$centered => tabStop.alignment ← Centered;
$aligned => {
alignRope: ROPE;
tabStop.alignment ← Character;
[alignRope, ok] ← TryToPopRope[frame];
IF ok AND NOT alignRope.IsEmpty THEN {
IF alignRope.Length = 1 THEN tabStop.alignmentChar ← alignRope.Fetch[0]
ELSE {
TJaM.PushRope[frame, "Cannot specify more than one character for tab alignment"];
StyleError[frame, 1];
}
}
ELSE {
TJaM.PushRope[frame, "Must specify character for tab alignment"];
StyleError[frame, 1];
};
};
ENDCASE => {
TJaM.Push[frame, name];
tabStop.alignment ← FlushLeft;
};
};
Dimensions
PointsOp: TJaM.CommandProc ~ { }; -- no change needed to convert to points
pointsPerBigPoint: REAL ← 72.27/72;
BigPointsOp: TJaM.CommandProc ~ {TJaM.PushReal[frame, TJaM.PopReal[frame]*pointsPerBigPoint]};
PicasOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerPica] };
InchesOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerInch] };
CentimetersOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerCentimeter] };
MillimetersOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerMillimeter] };
DidotPointsOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerDidot] };
EmsOp: TJaM.CommandProc ~ {
oneEm: REAL ~ GetFontSize[StyleForFrame[frame]]; -- should really be width of "M" in current font
TJaM.PushReal[frame, TJaM.PopReal[frame]*oneEm];
};
EnsOp: TJaM.CommandProc ~ {
oneEn: REAL ~ GetFontSize[StyleForFrame[frame]]/2; -- should really be width of "N" in current font
TJaM.PushReal[frame, TJaM.PopReal[frame]*oneEn];
};
ScreenSpacesOp: TJaM.CommandProc ~ {
spaces: REAL ~ TJaM.PopReal[frame];
width: REAL ~ GetScreenSpaceWidth[StyleForFrame[frame]];
TJaM.PushReal[frame, spaces*width];
};
PrintSpacesOp: TJaM.CommandProc ~ {
spaces: REAL ~ TJaM.PopReal[frame];
width: REAL ~ GetPrintSpaceWidth[StyleForFrame[frame]];
TJaM.PushReal[frame, spaces*width];
};
FilOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerFil] };
FillOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerFill] };
FilllOp: TJaM.CommandProc ~ {
TJaM.PushReal[frame, TJaM.PopReal[frame]*PointsPerFilll] };
NodeStyleWorks4Impl
Initialization
This must be first to pick up the Preregister calls in the start code.
OpsListItem: TYPE ~ RECORD [name: ATOM, op: TJaM.CommandProc];
OpsList: TYPE ~ LIST OF OpsListItem;
opsList: OpsList ← NIL;
Preregister: PROC [param: Param, op: TJaM.CommandProc] RETURNS [Param] ~ {
opsList ← CONS[[param.opName, op], opsList];
RETURN [param];
};
RegisterWorks4: PUBLIC PROC [frame: Frame] ~ {
FOR list: OpsList ← opsList, list.rest UNTIL list=NIL DO
RegisterStyleCommand[frame, list.first.name, list.first.op];
ENDLOOP;
TJaM.Execute[frame, TJaM.CvX[prolog]];
};
New Style Parameters
These are style parameters that have not been given a place NodeStyle.RealParam. They may be used in a style just like any other real-valued style parameter, and they may be accessed from a client program by means of NodeStyleOps.GetStyleParam.
prolog: ROPE ← "
(firstFolio) 1 StyleParam
Number associated with first formatted page
(firstVisibleFolio) 1 StyleParam
Folios smaller than this will not be printed. Use a large value to kill page numbers.
(lastDropFolio) 1 StyleParam
Last folio to be placed at the bottom center of the page
(firstHeaders) 0 StyleParam
Page headers will first appear on the page with this folio.
(maxVerticalExpansion) 3 StyleParam
Extra fil is inserted if the vertical expansion ratio would exceed this.
(maxHorizontalExpansion) 1 fil StyleParam
Spaces in justified lines are never stretched by more than this amount, possibly resulting in a somewhat ragged right margin. Applies at the node level.
(sided) 1 StyleParam
Should be 1 or 2
(keep) 0 pt StyleParam
Asserts that a new column or page should be started if there is less than this amount of vertical space remaining when the first line of the node is formatted.
(keepStretch) 1 fil StyleParam
Added to the bottomIndentStretch when a new column is started because of a keep.
(columnGap) 0.5 in StyleParam
Minimum gap between columns
(topIndentStretch) 0 StyleParam
Stretchability at the top of the column
(bottomIndentStretch) 0 StyleParam
Stretchability at the bottom of the column
(hyphenation) (No) StyleParam
Kind of hyphenation applied to this node (applies at node level)
(hyphenCode) 45 StyleParam
Character code for hyphen (applies at character level)
(pageRotation) 0 StyleParam
Degrees of counterclockwise rotation for the whole page
(pageRotationVerso) 0 StyleParam
Degrees of counterclockwise rotation for verso pages (only used if 2 sided)
(mediumColor) {mediumBrightness mediumSaturation mediumHue} .cvx .def
Color of the page background
(mediumHue) 0 StyleParam
(mediumSaturation) 0 StyleParam
(mediumBrightness) 1 StyleParam
";
Letter Spacing Glue
LetterspacingOp: TJaM.CommandProc ~ { DoStyleOp[frame, letterspacingParam] };
letterspacingParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $letterspacing, real[letterspacing]]], LetterspacingOp];
LetterspacingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, letterspacingStretchParam] };
letterspacingStretchParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $letterspacingStretch, real[letterspacingStretch]]], LetterspacingStretchOp];
LetterspacingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, letterspacingShrinkParam] };
letterspacingShrinkParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $letterspacingShrink, real[letterspacingShrink]]], LetterspacingShrinkOp];
LetterspacingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, letterspacingGlueParam] };
letterspacingGlueParam: Param ← Preregister[NEW[glue ParamRec ← [glueOps, $letterspacingGlue, glue[letterspacing, letterspacingStretch, letterspacingShrink]]], LetterspacingGlueOp];
Pagebreak Glue
PagebreakOp: TJaM.CommandProc ~ { DoStyleOp[frame, pagebreakParam] };
pagebreakParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $pagebreak, real[pagebreak]]], PagebreakOp];
PagebreakStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, pagebreakStretchParam] };
pagebreakStretchParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $pagebreakStretch, real[pagebreakStretch]]], PagebreakStretchOp];
PagebreakShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, pagebreakShrinkParam] };
pagebreakShrinkParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $pagebreakShrink, real[pagebreakShrink]]], PagebreakShrinkOp];
PagebreakGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, pagebreakGlueParam] };
pagebreakGlueParam: Param ← Preregister[NEW[glue ParamRec ← [glueOps, $pagebreakGlue, glue[pagebreak, pagebreakStretch, pagebreakShrink]]], PagebreakGlueOp];
Underline Dimensions and Color
UnderlineThicknessOp: TJaM.CommandProc ~ { DoStyleOp[frame, underlineThicknessParam] };
underlineThicknessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $underlineThickness, real[underlineThickness]]], UnderlineThicknessOp];
UnderlineDescentOp: TJaM.CommandProc ~ { DoStyleOp[frame, underlineDescentParam] };
underlineDescentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $underlineDescent, real[underlineDescent]]], UnderlineDescentOp];
UnderlineHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, underlineHueParam] };
underlineHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $underlineHue, real[underlineHue]]], UnderlineHueOp];
UnderlineSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, underlineSaturationParam] };
underlineSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $underlineSaturation, real[underlineSaturation]]], UnderlineSaturationOp];
UnderlineBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, underlineBrightnessParam] };
underlineBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $underlineBrightness, real[underlineBrightness]]], UnderlineBrightnessOp];
UnderlineColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, underlineColorParam] };
underlineColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $underlineColor, color[underlineHue, underlineSaturation, underlineBrightness]]], UnderlineColorOp];
Strikeout Dimensions and Color
StrikeoutThicknessOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutThicknessParam] };
strikeoutThicknessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $strikeoutThickness, real[strikeoutThickness]]], StrikeoutThicknessOp];
StrikeoutAscentOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutAscentParam] };
strikeoutAscentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $strikeoutAscent, real[strikeoutAscent]]], StrikeoutAscentOp];
StrikeoutHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutHueParam] };
strikeoutHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $strikeoutHue, real[strikeoutHue]]], StrikeoutHueOp];
StrikeoutSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutSaturationParam] };
strikeoutSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $strikeoutSaturation, real[strikeoutSaturation]]], StrikeoutSaturationOp];
StrikeoutBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutBrightnessParam] };
strikeoutBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $strikeoutBrightness, real[strikeoutBrightness]]], StrikeoutBrightnessOp];
StrikeoutColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, strikeoutColorParam] };
strikeoutColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $strikeoutColor, color[strikeoutHue, strikeoutSaturation, strikeoutBrightness]]], StrikeoutColorOp];
Outline Box Dimensions and Color
OutlineBoxThicknessOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBoxThicknessParam] };
outlineBoxThicknessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineBoxThickness, real[outlineboxThickness]]], OutlineBoxThicknessOp];
OutlineBoxBearoffOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBoxBearoffParam] };
outlineBoxBearoffParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineBoxBearoff, real[outlineboxBearoff]]], OutlineBoxBearoffOp];
OutlineBoxHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBoxHueParam] };
outlineBoxHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineBoxHue, real[outlineboxHue]]], OutlineBoxHueOp];
OutlineBoxSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBoxSaturationParam] };
outlineBoxSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineBoxSaturation, real[outlineboxSaturation]]], OutlineBoxSaturationOp];
OutlineBoxBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBoxBrightnessParam] };
outlineBoxBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineBoxBrightness, real[outlineboxBrightness]]], OutlineBoxBrightnessOp];
OutlineBoxColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBoxColorParam] };
outlineBoxColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $outlineBoxColor, color[outlineboxHue, outlineboxSaturation, outlineboxBrightness]]], OutlineBoxColorOp];
Background Dimensions and Color
BackgroundAscentOp: TJaM.CommandProc ~ { DoStyleOp[frame, backgroundAscentParam] };
backgroundAscentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $backgroundAscent, real[backgroundAscent]]], BackgroundAscentOp];
BackgroundDescentOp: TJaM.CommandProc ~ { DoStyleOp[frame, backgroundDescentParam] };
backgroundDescentParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $backgroundDescent, real[backgroundDescent]]], BackgroundDescentOp];
BackgroundHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, backgroundHueParam] };
backgroundHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $backgroundHue, real[backgroundHue]]], BackgroundHueOp];
BackgroundSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, backgroundSaturationParam] };
backgroundSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $backgroundSaturation, real[backgroundSaturation]]], BackgroundSaturationOp];
BackgroundBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, backgroundBrightnessParam] };
backgroundBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $backgroundBrightness, real[backgroundBrightness]]], BackgroundBrightnessOp];
BackgroundColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, backgroundColorParam] };
backgroundColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $backgroundColor, color[backgroundHue, backgroundSaturation, backgroundBrightness]]], BackgroundColorOp];
Area Color
AreaHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, areaHueParam] };
areaHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $areaHue, real[areaHue]]], AreaHueOp];
AreaSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, areaSaturationParam] };
areaSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $areaSaturation, real[areaSaturation]]], AreaSaturationOp];
AreaBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, areaBrightnessParam] };
areaBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $areaBrightness, real[areaBrightness]]], AreaBrightnessOp];
AreaColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, areaColorParam] };
areaColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $areaColor, color[areaHue, areaSaturation, areaBrightness]]], AreaColorOp];
Outline Color
OutlineHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineHueParam] };
outlineHueParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineHue, real[outlineHue]]], OutlineHueOp];
OutlineSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineSaturationParam] };
outlineSaturationParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineSaturation, real[outlineSaturation]]], OutlineSaturationOp];
OutlineBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineBrightnessParam] };
outlineBrightnessParam: Param ← Preregister[NEW[real ParamRec ← [realOps, $outlineBrightness, real[outlineBrightness]]], OutlineBrightnessOp];
OutlineColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, outlineColorParam] };
outlineColorParam: Param ← Preregister[NEW[color ParamRec ← [colorOps, $outlineColor, color[outlineHue, outlineSaturation, outlineBrightness]]], OutlineColorOp];
NodeStyleWorksStartImpl
RunFile: PROC [frame: Frame, name: ATOM, fileName: ROPE] RETURNS [ran: BOOL] ~ {
if name is unknown in the current frame, then run the named file
known: BOOL;
[known, ] ← TJaM.TryToLoad[frame, name];
IF known THEN RETURN [FALSE];
TJaM.Push[frame, fileName];
TJaM.Execute[frame, run];
RETURN [TRUE];
};
StartTheWorks: PUBLIC PROC ~ {
frame: Frame ← defaultFrame ← TJaM.NewFrame[];
Some JaM commands needed to run the style machinery
get ← GetCommand[frame, TJaM.AtomFromRope[".get"]];
run ← GetCommand[frame, TJaM.AtomFromRope[".run"]];
load ← GetCommand[frame, TJaM.AtomFromRope[".load"]];
Remember the system dictionary, since the style machinery manipulates the dictionary stack
TJaM.Execute[frame, TJaM.AtomFromRope[".sysdict"]];
sysdict ← TypeCheckDict[TJaM.Pop[frame]];
Check if we have run the start jam code: (start.jam) .run
This provides a user dictionary into which start.jam loads util.jam and errordefs.jam
IF NOT RunFile[frame, $user ,"start.jam"] THEN
TJaM.Execute[frame, TJaM.AtomFromRope[".start"]];
Remember the user dictionary pointer
userdict ← TJaM.DictTop[frame];
Create the dictionary of Tioga style names
styledict ← InitDict[$TiogaStylesDictionary];
TJaM.AttachDict[styledict, userdict];
Replace userdict by styledict for rest of startup
TJaM.End[frame];
TJaM.Begin[frame, styledict];
Create and register dictionaries for style rules, name bindings, and attached styles
stylesDicts[base] ← InitDict[$TiogaBaseStylesDictionary];
stylesDicts[print] ← InitDict[$TiogaPrintStylesDictionary];
stylesDicts[screen] ← InitDict[$TiogaScreenStylesDictionary];
bindingDict ← InitDict[$TiogaBindingDictionary, 200];
attachmentsDict ← InitDict[$TiogaAttachedStylesDictionary];
Check if have run the Tioga utility jam code: (TiogaUtils.jam) .run
[] ← RunFile[frame, $StyleError, "TiogaUtils.jam"];
Register various style and JaM commands implemented elsewhere
RegisterWorks1[frame];
RegisterWorks2[frame];
RegisterWorks3[frame];
RegisterWorks4[frame];
TJaM.Register[frame, $GetFreeVarOp, NodeStyleObsolete.GetFreeVarOp];
TJaM.Register[frame, $GetFreeVarObjOp, NodeStyleObsolete.GetFreeVarObjOp];
Register various literals used by the style machinery as keywords
numeric style attributes
RegisterStyleLiteral[frame, $the];
RegisterStyleLiteral[frame, $smaller];
RegisterStyleLiteral[frame, $bigger];
RegisterStyleLiteral[frame, $percent];
font attributes
RegisterStyleLiteral[frame, $regular];
RegisterStyleLiteral[frame, $bold];
RegisterStyleLiteral[frame, $italic];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["bold+italic"]];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["+bold"]];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["+italic"]];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["-bold"]];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["-italic"]];
font alphabets
RegisterStyleLiteral[frame, TJaM.AtomFromRope["caps+lowercase"]];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["caps+smallcaps"]];
RegisterStyleLiteral[frame, $lowercase];
RegisterStyleLiteral[frame, $caps];
underlining and strikeout
RegisterStyleLiteral[frame, $all];
RegisterStyleLiteral[frame, $visible];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["letters+digits"]];
RegisterStyleLiteral[frame, $none];
line formatting
RegisterStyleLiteral[frame, $justified];
RegisterStyleLiteral[frame, $flush];
RegisterStyleLiteral[frame, $flushLeft];
RegisterStyleLiteral[frame, $flushRight];
RegisterStyleLiteral[frame, $centered];
graphical paths
RegisterStyleLiteral[frame, $filled];
RegisterStyleLiteral[frame, $outlined];
RegisterStyleLiteral[frame, $filled];
RegisterStyleLiteral[frame, TJaM.AtomFromRope["filled+outlined"]];
tab stop positioning
RegisterStyleLiteral[frame, $fixed];
RegisterStyleLiteral[frame, $relative];
tab stop attributes
RegisterStyleLiteral[frame, $looks];
RegisterStyleLiteral[frame, $breakIfPast];
RegisterStyleLiteral[frame, $spaceIfPast];
RegisterStyleLiteral[frame, $blank];
RegisterStyleLiteral[frame, $leaders];
RegisterStyleLiteral[frame, $rule];
RegisterStyleLiteral[frame, $rules];
RegisterStyleLiteral[frame, $aligned];
RegisterStyleLiteral[frame, $congruent];
Initialize the small cache of frames by allocating and freeing some
{
frame: ARRAY [0..4) OF Frame;
FOR i: NAT IN [0..4) DO frame[i] ← GetFrame[NIL, NIL, screen] ENDLOOP;
FOR i: NAT IN [0..4) DO FreeFrame[frame[i], NIL, screen] ENDLOOP;
};
Initialize the default style
NodeStyleOps.InitializeDefaultStyle["Cedar"];
[] ← NodeStyleOps.LoadStyle[NodeStyleOps.defaultStyleName];
};
StartTheWorks[!];
END.