NodeStyleWorks3Impl.mesa
Copyright Ó 1985, 1991, 1992 by Xerox Corporation. All rights reserved.
Written by Bill Paxton, January 1981
Bill Paxton, December 1, 1982 7:38 am
Maxwell, January 6, 1983 8:46 am
Russ Atkinson, March 7, 1985 3:34:46 am PST
Michael Plass, November 16, 1987 4:40:28 pm PST
Rick Beach, June 3, 1985 5:26:48 pm PDT
Willie-s, May 24, 1991 5:21 pm PDT
Doug Wyatt, February 28, 1992 11:34 am PST
Implements JaM commands for style rules and commands to load styles.
DIRECTORY
Ascii USING [Lower],
NodeStyle USING [FontAlphabets, FontFace, GetReal, GetSpaceWidth, GetTabLoc, GetTabRealCode, LeaderTabStop, LineFormatting, NameParam, PointsPerCentimeter, PointsPerDidot, PointsPerFil, PointsPerFill, PointsPerFilll, PointsPerInch, PointsPerMillimeter, PointsPerPica, RealParam, Ref, RulesTabStop, RuleTabStop, TabAlign, TabArrayRec, TabStop, TabStopRec],
NodeStyleWorks USING [AddRealError, colorOps, DoStyleOp, glueOps, LoadProc, NameError, nameOps, OpsRec, Param, ParamRec, PercentError, realOps, RegisterStyleCommand, SetNameProc, StoreError, StyleError, StyleForFrame, TryToPopName, TryToPopReal, TryToPopRope],
Rope USING [ActionType, Fetch, IsEmpty, Length, Map, ROPE],
Tioga USING [Looks, noLooks],
TJaM USING [AGet, Array, AtomFromRope, CommandProc, Frame, PopArray, PopReal, PopRope, Push, PushReal, PushRope];
NodeStyleWorks3Impl: CEDAR MONITOR
IMPORTS Ascii, NodeStyle, NodeStyleWorks, Rope, TJaM
EXPORTS NodeStyleWorks
~
BEGIN
OPEN NodeStyle, NodeStyleWorks;
Frame: TYPE ~ TJaM.Frame;
ROPE: TYPE ~ Rope.ROPE;
Initialization
This must be first to pick up the Preregister calls in the start code.
opsList:
LIST
OF
RECORD[name:
ATOM, op: TJaM.CommandProc] ¬
NIL;
Preregister:
PROC [param: Param, op: TJaM.CommandProc]
RETURNS [Param] ~ {
opsList ¬ CONS[[param.opName, op], opsList];
RETURN [param];
};
PreregisterName:
PROC [opName:
ATOM, op: TJaM.CommandProc,
param: NodeStyle.NameParam]
RETURNS [Param] ~ {
RETURN Preregister[NEW[ParamRec.name ¬ [nameOps, opName, name[param]]], op];
};
PreregisterReal:
PROC [opName:
ATOM, op: TJaM.CommandProc,
param: NodeStyle.RealParam]
RETURNS [Param] ~ {
RETURN Preregister[NEW[ParamRec.real ¬ [realOps, opName, real[param]]], op];
};
PreregisterGlue:
PROC [opName:
ATOM, op: TJaM.CommandProc,
size, stretch, shrink: NodeStyle.RealParam]
RETURNS [Param] ~ {
RETURN Preregister[NEW[ParamRec.glue ¬ [glueOps, opName,
glue[size: size, stretch: stretch, shrink: shrink]]], op];
};
PreregisterColor:
PROC [opName:
ATOM, op: TJaM.CommandProc,
hue, saturation, brightness: NodeStyle.RealParam]
RETURNS [Param] ~ {
RETURN Preregister[NEW[ParamRec.color ¬ [colorOps, opName,
color[hue: hue, saturation: saturation, brightness: brightness]]], op];
};
RegisterWorks3:
PUBLIC
PROC [frame: Frame] ~ {
WHILE opsList #
NIL
DO
RegisterStyleCommand[frame, opsList.first.name, opsList.first.op];
opsList ¬ opsList.rest;
ENDLOOP;
RegisterStyleCommand[frame, $clearTabStops, ClearTabStopsOp];
RegisterStyleCommand[frame, $tabStop, TabStopOp];
RegisterStyleCommand[frame, $defaultTabStops, DefaultTabStopsOp];
RegisterStyleCommand[frame, $tabStopLocations, RelativeTabStopsOp];
RegisterStyleCommand[frame, $pt, PointsOp];
RegisterStyleCommand[frame, $bp, BigPointsOp];
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, SpacesOp];
RegisterStyleCommand[frame, $printsp, SpacesOp];
RegisterStyleCommand[frame, $sp, SpacesOp];
RegisterStyleCommand[frame, $fil, FilOp];
RegisterStyleCommand[frame, $fill, FillOp];
RegisterStyleCommand[frame, $filll, FilllOp];
};
Style Name
StyleNameOp: TJaM.CommandProc ~ { DoStyleOp[frame, styleNameParam] };
styleNameParam: Param ¬ PreregisterName[$style, StyleNameOp, style];
Font Parameters
Font Prefix
FontPrefixOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontPrefixParam] };
fontPrefixParam: Param ~ PreregisterName[$fontPrefix, FontPrefixOp, fontPrefix];
Font Family
FontFamilyOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontFamilyParam] };
fontFamilyParam: Param ~ PreregisterName[$family, FontFamilyOp, fontFamily];
Font Size
FontSizeOp: TJaM.CommandProc ~ { DoStyleOp[frame, fontSizeParam] };
fontSizeParam: Param ~ PreregisterReal[$size, FontSizeOp, fontSize];
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 ~ PreregisterReal[$textRotation, TextRotationOp, textRotation];
Indents
Left Indent
LeftIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, leftIndentParam] };
leftIndentParam: Param ~ PreregisterReal[$leftIndent, LeftIndentOp, leftIndent];
Right Indent
RightIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, rightIndentParam] };
rightIndentParam: Param ~ PreregisterReal[$rightIndent, RightIndentOp, rightIndent];
First Indent
FirstIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, firstIndentParam] };
firstIndentParam: Param ~ PreregisterReal[$firstIndent, FirstIndentOp, firstIndent];
First Indent on the Right
FirstIndentRightOp: TJaM.CommandProc ~ { DoStyleOp[frame, firstIndentRightParam] };
firstIndentRightParam: Param ~ PreregisterReal[$firstIndentRight, FirstIndentRightOp, firstIndentRight];
Rest Indent
RestIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, restIndentParam] };
restIndentParam: Param ~ PreregisterReal[$restIndent, RestIndentOp, restIndent];
Runaround Left
RunaroundLeftOp: TJaM.CommandProc ~ { DoStyleOp[frame, runaroundLeftParam] };
runaroundLeftParam: Param ~ PreregisterReal[$runaroundLeft, RunaroundLeftOp, runaroundLeft];
Runaround Right
RunaroundRightOp: TJaM.CommandProc ~ { DoStyleOp[frame, runaroundRightParam] };
runaroundRightParam: Param ~ PreregisterReal[$runaroundRight, RunaroundRightOp, runaroundRight];
Top Indent
TopIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, topIndentParam] };
topIndentParam: Param ~ PreregisterReal[$topIndent, TopIndentOp, topIndent];
Bottom Indent
BottomIndentOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomIndentParam] };
bottomIndentParam: Param ~ PreregisterReal[$bottomIndent, BottomIndentOp, bottomIndent];
Leading Parameters
Line Leading Glue
LineLeadingOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingParam]; };
lineLeadingParam: Param ~ PreregisterReal[$leading, LineLeadingOp, leading];
LineLeadingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingStretchParam] };
lineLeadingStretchParam: Param ~ PreregisterReal[$leadingStretch, LineLeadingStretchOp, leadingStretch];
LineLeadingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingShrinkParam] };
lineLeadingShrinkParam: Param ~ PreregisterReal[$leadingShrink, LineLeadingShrinkOp, leadingShrink];
LineLeadingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLeadingGlueParam] };
lineLeadingGlueParam: Param ~ PreregisterGlue[$leadingGlue, LineLeadingGlueOp, leading, leadingStretch, leadingShrink];
Top Leading Glue
TopLeadingOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingParam]; };
topLeadingParam: Param ~ PreregisterReal[$topLeading, TopLeadingOp, topLeading];
TopLeadingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingStretchParam] };
topLeadingStretchParam: Param ~ PreregisterReal[$topLeadingStretch, TopLeadingStretchOp, topLeadingStretch];
TopLeadingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingShrinkParam] };
topLeadingShrinkParam: Param ~ PreregisterReal[$topLeadingShrink, TopLeadingShrinkOp, topLeadingShrink];
TopLeadingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, topLeadingGlueParam] };
topLeadingGlueParam: Param ~ PreregisterGlue[$topLeadingGlue, TopLeadingGlueOp, topLeading, topLeadingStretch, topLeadingShrink];
Bottom Leading Glue
BottomLeadingOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingParam]; };
bottomLeadingParam: Param ~ PreregisterReal[$bottomLeading, BottomLeadingOp, bottomLeading];
BottomLeadingStretchOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingStretchParam] };
bottomLeadingStretchParam: Param ~ PreregisterReal[$bottomLeadingStretch, BottomLeadingStretchOp, bottomLeadingStretch];
BottomLeadingShrinkOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingShrinkParam] };
bottomLeadingShrinkParam: Param ~ PreregisterReal[$bottomLeadingShrink, BottomLeadingShrinkOp, bottomLeadingShrink];
BottomLeadingGlueOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomLeadingGlueParam] };
bottomLeadingGlueParam: Param ~ PreregisterGlue[$bottomLeadingGlue, BottomLeadingGlueOp, bottomLeading, bottomLeadingStretch, bottomLeadingShrink];
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[];
};
Miscellaneous Positioning Parameters
HShiftOp: TJaM.CommandProc ~ { DoStyleOp[frame, hshiftParam] };
hshiftParam: Param ~ PreregisterReal[$hShift, HShiftOp, hshift];
VShiftOp: TJaM.CommandProc ~ { DoStyleOp[frame, vshiftParam] };
vshiftParam: Param ~ PreregisterReal[$vShift, VShiftOp, vshift];
MinLineGapOp: TJaM.CommandProc ~ { DoStyleOp[frame, minLineGapParam]; };
minLineGapParam: Param ~ PreregisterReal[$minLineGap, MinLineGapOp, minLineGap];
TabStops
TabStopsOp: TJaM.CommandProc ~ { DoStyleOp[frame, tabStopsParam]; };
tabStopsParam: Param ~ PreregisterReal[$tabStops, TabStopsOp, tabStops];
Line Weight
LineWeightOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineWeightParam] };
lineWeightParam: Param ~ PreregisterReal[$lineWeight, LineWeightOp, lineWeight];
Page Layout Parameters
Page Width
PageWidthOp: TJaM.CommandProc ~ { DoStyleOp[frame, pageWidthParam] };
pageWidthParam: Param ~ PreregisterReal[$pageWidth, PageWidthOp, pageWidth];
PageLengthOp: TJaM.CommandProc ~ { DoStyleOp[frame, pageLengthParam] };
pageLengthParam: Param ~ PreregisterReal[$pageLength, PageLengthOp, pageLength];
LeftMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, leftMarginParam] };
leftMarginParam: Param ~ PreregisterReal[$leftMargin, LeftMarginOp, leftMargin];
RightMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, rightMarginParam] };
rightMarginParam: Param ~ PreregisterReal[$rightMargin, RightMarginOp, rightMargin];
TopMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, topMarginParam] };
topMarginParam: Param ~ PreregisterReal[$topMargin, TopMarginOp, topMargin];
BottomMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, bottomMarginParam] };
bottomMarginParam: Param ~ PreregisterReal[$bottomMargin, BottomMarginOp, bottomMargin];
HeaderMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, headerMarginParam] };
headerMarginParam: Param ~ PreregisterReal[$headerMargin, HeaderMarginOp, headerMargin];
FooterMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, footerMarginParam] };
footerMarginParam: Param ~ PreregisterReal[$footerMargin, FooterMarginOp, footerMargin];
BindingMarginOp: TJaM.CommandProc ~ { DoStyleOp[frame, bindingMarginParam] };
bindingMarginParam: Param ~ PreregisterReal[$bindingMargin, BindingMarginOp, bindingMargin];
LineLengthOp: TJaM.CommandProc ~ { DoStyleOp[frame, lineLengthParam] };
lineLengthParam: Param ~ PreregisterReal[$lineLength, LineLengthOp, lineLength];
ColumnOp: TJaM.CommandProc ~ { DoStyleOp[frame, columnParam] };
columnParam: Param ~ PreregisterReal[$column, ColumnOp, columns];
Text Color
TextHueOp: TJaM.CommandProc ~ { DoStyleOp[frame, textHueParam] };
textHueParam: Param ~ PreregisterReal[$textHue, TextHueOp, textHue];
TextSaturationOp: TJaM.CommandProc ~ { DoStyleOp[frame, textSaturationParam] };
textSaturationParam: Param ~ PreregisterReal[$textSaturation, TextSaturationOp, textSaturation];
TextBrightnessOp: TJaM.CommandProc ~ { DoStyleOp[frame, textBrightnessParam] };
textBrightnessParam: Param ~ PreregisterReal[$textBrightness, TextBrightnessOp, textBrightness];
TextColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, textColorParam] };
textColorParam: Param ~ PreregisterColor[$textColor, TextColorOp, textHue, textSaturation, textBrightness];
TextNamedColorOp: TJaM.CommandProc ~ { DoStyleOp[frame, textNamedColorParam] };
textNamedColorParam: Param ~ PreregisterName[$textNamedColor, TextNamedColorOp, textNamedColor];
Page Break Penalty Parameters
PageBreakPenaltyOp: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenaltyParam] };
pageBreakPenaltyParam: Param ~ PreregisterReal[$pageBreakPenalty, PageBreakPenaltyOp, pageBreakPenalty];
PageBreakPenalty2Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty2Param] };
pageBreakPenalty2Param: Param ~ PreregisterReal[$pageBreakAfterFirstLinePenalty, PageBreakPenalty2Op, pageBreakAfterFirstLinePenalty];
PageBreakPenalty3Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty3Param] };
pageBreakPenalty3Param: Param ~ PreregisterReal[$pageBreakAfterLastLinePenalty, PageBreakPenalty3Op, pageBreakAfterLastLinePenalty];
PageBreakPenalty4Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty4Param] };
pageBreakPenalty4Param: Param ~ PreregisterReal[$pageBreakBeforeFirstLinePenalty, PageBreakPenalty4Op, pageBreakBeforeFirstLinePenalty];
PageBreakPenalty5Op: TJaM.CommandProc ~ { DoStyleOp[frame, pageBreakPenalty5Param] };
pageBreakPenalty5Param: Param ~ PreregisterReal[$pageBreakBeforeLastLinePenalty, PageBreakPenalty5Op, pageBreakBeforeLastLinePenalty];
Fancy Tabs
ClearTabStopsOp: TJaM.CommandProc ~ {
ref: Ref ¬ StyleForFrame[frame];
ref.tabStops ¬ NIL; ref.numTabStops ¬ 0;
};
TabStopOp: TJaM.CommandProc ~ {
ref: Ref ¬ 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: Ref ¬ 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: Ref ¬ StyleForFrame[frame];
tabStop: TabStop ¬ TabSpec[ref, frame];
tabStop.loc ¬ GetTabRealCode[ref, tabStop, loc, TJaM.PopReal[frame]];
ref.defaultTabStops ¬ tabStop;
TabSpec:
PROC [ref: Ref, 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 ¬
FALSE] ~ {
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: Ref, 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 ~ GetReal[StyleForFrame[frame], fontSize]; -- should really be width of "M" in current font
TJaM.PushReal[frame, TJaM.PopReal[frame]*oneEm];
};
EnsOp: TJaM.CommandProc ~ {
oneEn: REAL ~ GetReal[StyleForFrame[frame], fontSize]/2; -- should really be width of "N" in current font
TJaM.PushReal[frame, TJaM.PopReal[frame]*oneEn];
};
SpacesOp: TJaM.CommandProc ~ {
spaces: REAL ~ TJaM.PopReal[frame];
width: REAL ~ GetSpaceWidth[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] };
END.