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: BOOLFALSE]
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.