TSJaMPageBuilderImpl.mesa
Edited by: Maxwell, January 25, 1983 2:39 pm
Michael Plass, February 15, 1983 1:03 pm
Last Edited by: Beach, May 24, 1983 5:06 pm
DIRECTORY
Atom,
TSTypes,
TSObject,
TSOps,
TSDumper,
TSFont,
TSGlue,
TSOutput,
NodeStyle,
NodeStyleExtra,
TSAList,
JaMBasic,
JaMOps,
Rope,
TSJaMPageBuilder
;
TSJaMPageBuilderImpl:
PROGRAM
IMPORTS
Atom, TSTypes, TSObject, TSOps, TSDumper, TSFont, TSOutput, NodeStyle, NodeStyleExtra, TSAList, JaMOps, Rope
EXPORTS TSJaMPageBuilder =
BEGIN OPEN TSTypes;
ROPE: TYPE = Rope.ROPE;
Frame: TYPE = NodeStyleExtra.Frame;
Handle: TYPE = REF TPStateRec;
TPStateRec:
TYPE =
RECORD [
pageReader: TSObject.ListReader,
currentMarks: TSObject.MarkList,
topMargin, leftMargin, pageHeight, paperHeight, paperWidth: Dimn,
columns: NAT,
output: TSOutput.Handle,
curFont: TSFont.Ref,
styleName: NodeStyle.Name,
documentName: ROPE,
abortCheckProc: TSJaMPageBuilder.AbortCheckProc,
stack: LIST OF REF ANY ← NIL,
aborted: BOOLEAN ← FALSE
];
RunPageBuilder:
PUBLIC
PROCEDURE [
galley: TSObject.ItemList,
style: NodeStyle.Ref,
output: TSOutput.Handle,
abortCheckProc: TSJaMPageBuilder.AbortCheckProc ← NIL,
documentName: Rope.ROPE ← NIL -- only a hint
]
RETURNS [aborted: BOOLEAN] = {
frame: Frame ← NodeStyleExtra.GetFrame[style: style, styleName: style.GetStyleName[], kind: print];
handle: Handle ← NEW[TPStateRec];
handle.styleName ← style.GetStyleName[];
RegisterJaMProcs[frame];
handle.paperHeight ← Pt[style.GetPageLength[]];
handle.paperWidth ← Pt[style.GetPageWidth[]];
handle.pageHeight ← Pt[style.GetPageLength[]-style.GetTopMargin[]-style.GetHeaderMargin[]-style.GetFooterMargin[]-style.GetBottomMargin[]];
handle.topMargin ← Pt[style.GetTopMargin[]];
handle.leftMargin ← Pt[style.GetLeftMargin[]];
handle.columns ← style.GetColumns[];
handle.documentName ← documentName;
handle.abortCheckProc ← abortCheckProc;
handle.pageReader ← TSOps.BreakUp[
list: TSOps.InsertLeading[galley],
direction: down,
size: handle.pageHeight
].CreateReader[];
handle.output ← output;
TSAList.Define[LOOPHOLE[frame], handle];
JaMOps.Execute[frame, NodeStyleExtra.
CVX[
NodeStyleExtra.NameToObject[pageBuilderName]
]];
TSAList.UnDefine[LOOPHOLE[frame]];
NodeStyleExtra.FreeFrame[frame: frame, name: handle.styleName, kind: print];
aborted ← handle.aborted;
};
GoodByeScript:
PROCEDURE [f: Frame] = {
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
IF handle =
NIL
THEN {
NodeStyleExtra.FreeFrame[frame: f, name: handle.styleName, kind: print];
};
};
pageBuilderName: NodeStyle.Name = NodeStyleExtra.MakeName["PageBuilder"];
PushItem:
PROCEDURE [handle: Handle, item:
REF
ANY] =
BEGIN
handle.stack ← CONS[item, handle.stack];
END;
PopItem:
PROCEDURE [handle: Handle]
RETURNS [item:
REF
ANY] =
BEGIN
IF handle.stack = NIL THEN item ← NIL
ELSE {
t: LIST OF REF ANY ← handle.stack;
handle.stack ← t.rest;
item ← t.first;
t.first ← NIL;
t.rest ← NIL;
}
END;
PopList:
PROCEDURE [handle: Handle, count:
NAT]
RETURNS [itemList: TSObject.ItemList] =
BEGIN
list: LIST OF REF ANY ← NIL;
THROUGH [0..count)
DO
item: REF ANY ← PopItem[handle];
IF item # NIL THEN list ← CONS[item, list];
ENDLOOP;
itemList ← TSObject.ItemListFromExplicitList[list];
END;
PopRope:
PROCEDURE [f: Frame]
RETURNS [rope:
ROPE] =
BEGIN
s: string JaMBasic.Object ← JaMOps.PopString[f.opstk];
C:
PROC[c:
CHAR]
RETURNS [
BOOLEAN] =
{t[t.length]𡤌 t.length ← t.length+1; RETURN[FALSE]};
t: REF TEXT ← NEW[TEXT[s.length]];
t.length ← 0;
JaMOps.StringForAll[s, C];
rope ← Rope.FromRefText[t];
END;
PushRope:
PROCEDURE [f: Frame, rope:
ROPE] =
BEGIN
JaMOps.Push[
f.opstk,
JaMOps.MakeString[LOOPHOLE[rope.ToRefText[], LONG STRING]]
];
END;
Page:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN -- Pushes the next page box onto the stack
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
IF handle.abortCheckProc # NIL THEN handle.aborted ← handle.abortCheckProc[];
DO
-- until we find a page box or empty the page list
IF handle.aborted
OR handle.pageReader =
NIL OR handle.pageReader.End[]
THEN {
JaMOps.PushBoolean[f.opstk, FALSE];
IF handle.pageReader # NIL THEN handle.pageReader.DestroyReader[];
handle.pageReader ← NIL;
EXIT
}
ELSE {
IF
ISTYPE[handle.pageReader.CurrentItem[], TSObject.MarkList]
THEN {
thisPageMarks: TSObject.MarkList ← NARROW[handle.pageReader.CurrentItem[], TSObject.MarkList];
handle.currentMarks ← MergeMarkLists[thisPageMarks, handle.currentMarks];
handle.pageReader.Next[];
LOOP;
};
PushItem[handle, handle.pageReader.CurrentItem[]];
handle.pageReader.Next[];
JaMOps.PushBoolean[f.opstk, TRUE];
EXIT
};
ENDLOOP;
END;
ShipOut:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN -- Sends a constructed page to the outside world
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
item: REF ANY ← PopItem[handle];
handle.output.newPageProc[handle.output];
IF item #
NIL
AND
ISTYPE[item, TSObject.Box]
THEN {
IF handle.output.pageSizeProc #
NIL THEN
handle.output.pageSizeProc[
handle.output, handle.paperHeight, handle.paperWidth
];
handle.output.BoxOut[
xRef: handle.leftMargin,
yRef: SubDimn[handle.paperHeight, handle.topMargin],
box: NARROW[item, TSObject.Box]^
];
};
END;
BoxFromHList:
PROCEDURE [list: TSObject.ItemList]
RETURNS [box: TSObject.Box] = {
source: TSObject.ListReader ← list.CreateReader[];
box ← TSOps.Package[source: source, direction: right, desired: [zeroDimn,nilDimn,nilDimn,nilDimn]].box;
source.DestroyReader[];
};
Columns:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
JaMOps.PushInteger[f.opstk, handle.columns];
END;
DocumentName:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
PushRope[f, handle.documentName];
END;
TextBox:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
rope: ROPE ← PopRope[f];
IF handle.curFont = NIL THEN handle.curFont ← TSFont.Lookup["Helvetica"];
PushItem[handle, BoxFromHList[TSOps.ItemListFromRope[handle.curFont, rope]]];
END;
TextFont:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
fontSize: Dimn ← RealDimn[JaMOps.PopReal[f.opstk], pt];
fontName: ROPE ← PopRope[f];
handle.curFont ← TSFont.Lookup[fontName, fontSize];
END;
Vbox:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
source: TSObject.ListReader ← PopList[handle, JaMOps.PopCardinal[f.opstk]].CreateReader[];
box: TSObject.Box ← TSOps.Package[
source: source,
direction: down,
desired: [nilDimn, nilDimn, zeroDimn, nilDimn]
].box;
PushItem[handle, box];
source.DestroyReader[];
END;
Hbox:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
PushItem[handle, BoxFromHList[
PopList[handle, JaMOps.PopCardinal[f.opstk]]
]];
END;
VboxTo:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
size: Dimn ← RealDimn[JaMOps.PopReal[f.opstk], pt];
source: TSObject.ListReader ← PopList[handle, JaMOps.PopCardinal[f.opstk]].CreateReader[];
PushItem[handle, TSOps.Package[
source: source,
direction: down,
desired: [nilDimn, nilDimn, zeroDimn, size]
].box];
source.DestroyReader[];
END;
HboxTo:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
size: Dimn ← RealDimn[JaMOps.PopReal[f.opstk], pt];
source: TSObject.ListReader ← PopList[handle, JaMOps.PopCardinal[f.opstk]].CreateReader[];
PushItem[handle, TSOps.Package[
source: source,
direction: right,
desired: [zeroDimn, size, nilDimn, nilDimn]
].box];
source.DestroyReader[];
END;
fillGlue: TSObject.Glue = NEW[TSGlue.Glue ← [zeroDimn, TSGlue.fill, zeroDimn]];
Fill:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
PushItem[handle, fillGlue];
END;
This proc can dump boxes, for use in debugging
DumpBox:
SAFE PROCEDURE [f: Frame] =
TRUSTED BEGIN
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
TSDumper.DumpList[TSObject.SingletonList[PopItem[handle]]];
END;
emptyBox: TSObject.Box = NEW[TSObject.BoxRec ← [[zeroDimn, zeroDimn, zeroDimn, zeroDimn], empty[]]];
GetMark:
SAFE PROCEDURE [f: Frame] =
TRUSTED {
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
markKind: ROPE ← PopRope[f];
IF handle.currentMarks #
NIL
THEN {
markAtom: ATOM ← Atom.MakeAtom[markKind];
l: REF TSObject.MarkListItem ← handle.currentMarks;
UNTIL l =
NIL
OR l.markKind = markAtom
DO
l ← l.link;
ENDLOOP;
IF l = NIL THEN PushItem[handle, emptyBox]
ELSE PushItem[handle, l.markValue];
}
ELSE PushItem[handle, emptyBox];
};
GetFirstMark:
SAFE PROCEDURE [f: Frame] =
TRUSTED {
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
markKind: ROPE ← PopRope[f];
IF handle.currentMarks #
NIL
THEN {
markAtom: ATOM ← Atom.MakeAtom[markKind];
l: REF TSObject.MarkListItem ← handle.currentMarks;
last: REF TSObject.MarkListItem ← NIL;
UNTIL l =
NIL
DO
IF l.markKind = markAtom THEN last ← l;
l ← l.link;
ENDLOOP;
IF last = NIL THEN PushItem[handle, emptyBox]
ELSE PushItem[handle, last.markValue];
}
ELSE PushItem[handle, emptyBox];
};
MergeMarkLists:
PROCEDURE [new, old: TSObject.MarkList]
RETURNS [TSObject.MarkList] = {
Merge the new and old lists of marks into one list with old duplicates eliminated, preserving order.
p, q, r: TSObject.MarkList;
Using a niave n**2 search, eliminate duplicates from the old list.
p ← old;
UNTIL p =
NIL
DO
r ← p;
q ← p.link;
UNTIL q =
NIL
DO
IF p.markKind = q.markKind THEN r.link ← q.link ELSE r ← q;
q ← q.link;
ENDLOOP;
p ← p.link;
ENDLOOP;
Find the end of the new list to concatenate the old one.
p ← new;
UNTIL p =
NIL
OR p.link =
NIL
DO
p ← p.link;
ENDLOOP;
IF p = NIL THEN new ← old ELSE p.link ← old;
RETURN [new];
};
ExchBox:
SAFE PROCEDURE [f: Frame] =
TRUSTED {
handle: Handle ← NARROW[TSAList.Find[LOOPHOLE[f]], Handle];
item1: REF ANY ← PopItem[handle];
item2: REF ANY ← PopItem[handle];
PushItem[handle, item1];
PushItem[handle, item2];
};
RegisterJaMProcs:
PROCEDURE [f: Frame] =
BEGIN OPEN NodeStyleExtra;
[]←StyleCommand[f, ".page", Page];
-- -> <pagebox> .true . OR -> .false
[]←StyleCommand[f, ".getmark", GetMark];
-- -> <pagebox> (markkind) -> <pagebox> <markbox>
[]←StyleCommand[f, ".getfirstmark", GetFirstMark];
-- -> <pagebox> (markkind) -> <pagebox> <markbox>
[]←StyleCommand[f, ".columns", Columns];
-- -> <pagebox> .true . OR -> .false
[]←StyleCommand[f, ".shipout", ShipOut]; -- <box> -> . The box is sent out
[]←StyleCommand[f, ".documentname", DocumentName]; -- -> string .
[]←StyleCommand[f, ".textbox", TextBox]; -- string -> <box> . uses current font
[]←StyleCommand[f, ".textfont", TextFont]; -- fontnamestring fontpointsize -> . sets current font
[]←StyleCommand[f, ".vbox", Vbox]; -- <item1> <item2> ... <itemn> n -> <box> .
[]←StyleCommand[f, ".hbox", Hbox]; -- <item1> <item2> ... <itemn> n -> <box> .
[]←StyleCommand[f, ".vboxto", VboxTo]; -- <item1> <item2> ... <itemn> n height -> <box> .
[]←StyleCommand[f, ".hboxto", HboxTo]; -- <item1> <item2> ... <itemn> n height -> <box> .
[]←StyleCommand[f, ".fill", Fill]; -- -> <fillglue> .
[]←StyleCommand[f, ".dumpbox", DumpBox]; -- <box> -> .
[]←StyleCommand[f, ".exchbox", ExchBox]; -- <box1> <box2> -> <box2> <box1>
END;
END.
Michael Plass, September 1, 1982 9:21 pm: Put in calls to TSObject.DestroyReader.
Michael Plass, November 2, 1982 2:39 pm. Tioga formatted.
Michael Plass, November 12, 1982 10:11 am. pZone.
Michael Plass, November 16, 1982 2:36 pm. Changed to use some of the page layout parameters.
Michael Plass, November 17, 1982 9:34 am. Fixed frame and style stuff.
Michael Plass, November 17, 1982 11:13 am. Fixed bug that prevented .page from working after the end marker was sent.
Michael Plass, February 15, 1983 1:04 pm. Removed dependency on JaMTypeScript.
Rick Beach, May 17, 1983 10:17 am. Added .getmark routines., Rick
Edited on May 17, 1983 10:16 am, by Beach
Added .exchbox to permit a layout style to get a page, then get headers which must precede the page.
Edited on May 24, 1983 8:52 am, by Beach
Added MergeMarkLists to properly maintain a page history of marks., MergeMarkLists