NodeStyleWorks3Impl.mesa
Copyright © 1985, 1986 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
Doug Wyatt, September 2, 1986 1:25:54 pm PDT
Michael Plass, March 14, 1986 11:02:57 am PST
Rick Beach, June 3, 1985 5:26:48 pm PDT
Implements JaM commands for style rules and commands to load styles.
DIRECTORY
Ascii USING [Lower],
NodeStyle USING [FontAlphabets, FontFace, FontUnderlining, GetFontSize, GetPrintSpaceWidth, GetScreenSpaceWidth, GetTabLoc, GetTabRealCode, LeaderTabStop, LineFormatting, PointsPerCentimeter, PointsPerDidot, PointsPerFil, PointsPerFill, PointsPerFilll, PointsPerInch, PointsPerMillimeter, PointsPerPica, Style, 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],
TextLooks 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];
};
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, $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: TextLooks.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: TextLooks.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 ← TextLooks.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] };
END.