<> <> <> <> DIRECTORY Atom, TSTypes, TSObject, TSOps, TSDumper, TSFont, TSGlue, TSOutput, NodeStyle, NodeStyleWorks, TJaM, Rope, TSJaMPageBuilder ; TSJaMPageBuilderImpl: CEDAR PROGRAM IMPORTS Atom, TSTypes, TSObject, TSOps, TSDumper, TSFont, TSOutput, NodeStyle, NodeStyleWorks, TJaM EXPORTS TSJaMPageBuilder = BEGIN OPEN TSTypes; ROPE: TYPE = Rope.ROPE; Frame: TYPE = TJaM.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: ATOM, documentName: ROPE, aborted: BOOLEAN _ FALSE ]; AbortCheck: SIGNAL RETURNS [stop: BOOL] ~ CODE; 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] = { styleName: ATOM ~ style.GetStyleName[]; frame: Frame _ NodeStyleWorks.GetFrame[style: style, styleName: styleName, kind: print]; handle: Handle _ NEW[TPStateRec]; leadedGalley: TSObject.ItemList _ TSOps.InsertLeading[galley]; handle.styleName _ styleName; 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.pageReader _ TSOps.BreakUp[ list: TSOps.InsertLeading[galley], direction: down, size: handle.pageHeight ].CreateReader[]; handle.output _ output; frame.propList _ Atom.PutPropOnList[frame.propList, $PageBuilderHandle, handle]; TJaM.Execute[frame, TJaM.CvX[pageBuilderName] ! AbortCheck => {RESUME[abortCheckProc[]]}]; frame.propList _ Atom.RemPropFromList[frame.propList, $PageBuilderHandle]; NodeStyleWorks.FreeFrame[frame: frame, styleName: styleName, kind: print]; aborted _ handle.aborted; }; HandleFromFrame: PROC [f: Frame] RETURNS [Handle] ~ { RETURN [NARROW[Atom.GetPropFromList[f.propList, $PageBuilderHandle]]] }; pageBuilderName: ATOM = Atom.MakeAtom["PageBuilder"]; PopList: PROCEDURE [f: Frame] RETURNS [itemList: TSObject.ItemList] = BEGIN list: LIST OF REF ANY _ NIL; count: INT _ TJaM.PopInt[f]; THROUGH [0..count) DO item: REF ANY _ TJaM.Pop[f]; IF item # NIL THEN list _ CONS[item, list]; ENDLOOP; itemList _ TSObject.ItemListFromExplicitList[list]; END; Page: PROCEDURE [f: Frame] = BEGIN -- Pushes the next page box onto the stack handle: Handle _ HandleFromFrame[f]; handle.aborted _ SIGNAL AbortCheck[]; DO -- until we find a page box or empty the page list IF handle.aborted OR handle.pageReader = NIL OR handle.pageReader.End[] THEN { TJaM.PushBool[f, 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; }; TJaM.Push[f, handle.pageReader.CurrentItem[]]; handle.pageReader.Next[]; TJaM.PushBool[f, TRUE]; EXIT }; ENDLOOP; END; ShipOut: PROCEDURE [f: Frame] = BEGIN -- Sends a constructed page to the outside world handle: Handle _ HandleFromFrame[f]; item: REF ANY _ TJaM.Pop[f]; handle.output.newPageProc[handle.output]; WITH item SELECT FROM box: TSObject.Box => { 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: box^ ]; }; ENDCASE => NULL; 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: PROCEDURE [f: Frame] = BEGIN handle: Handle _ HandleFromFrame[f]; TJaM.PushInt[f, handle.columns]; END; DocumentName: PROCEDURE [f: Frame] = BEGIN handle: Handle _ HandleFromFrame[f]; TJaM.PushRope[f, handle.documentName]; END; TextBox: PROCEDURE [f: Frame] = BEGIN handle: Handle _ HandleFromFrame[f]; rope: ROPE _ TJaM.PopRope[f]; IF handle.curFont = NIL THEN handle.curFont _ TSFont.Lookup["Helvetica"]; TJaM.Push[f, BoxFromHList[TSOps.ItemListFromRope[handle.curFont, rope]]]; END; TextFont: PROCEDURE [f: Frame] = BEGIN handle: Handle _ HandleFromFrame[f]; fontSize: Dimn _ RealDimn[TJaM.PopReal[f], pt]; fontName: ROPE _ TJaM.PopRope[f]; handle.curFont _ TSFont.Lookup[fontName, fontSize]; END; Vbox: PROCEDURE [f: Frame] = BEGIN source: TSObject.ListReader _ PopList[f].CreateReader[]; box: TSObject.Box _ TSOps.Package[ source: source, direction: down, desired: [nilDimn, nilDimn, zeroDimn, nilDimn] ].box; TJaM.Push[f, box]; source.DestroyReader[]; END; Hbox: PROCEDURE [f: Frame] = BEGIN TJaM.Push[f, BoxFromHList[PopList[f]]]; END; VboxTo: PROCEDURE [f: Frame] = BEGIN size: Dimn _ RealDimn[TJaM.PopReal[f], pt]; source: TSObject.ListReader _ PopList[f].CreateReader[]; TJaM.Push[f, TSOps.Package[ source: source, direction: down, desired: [nilDimn, nilDimn, zeroDimn, size] ].box]; source.DestroyReader[]; END; HboxTo: PROCEDURE [f: Frame] = BEGIN size: Dimn _ RealDimn[TJaM.PopReal[f], pt]; source: TSObject.ListReader _ PopList[f].CreateReader[]; TJaM.Push[f, 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: PROCEDURE [f: Frame] = BEGIN TJaM.Push[f, fillGlue]; END; <> DumpBox: PROCEDURE [f: Frame] = BEGIN TSDumper.DumpList[TSObject.SingletonList[TJaM.Pop[f]]]; END; emptyBox: TSObject.Box = NEW[TSObject.BoxRec _ [[zeroDimn, zeroDimn, zeroDimn, zeroDimn], empty[]]]; GetMark: PROCEDURE [f: Frame] = { handle: Handle _ HandleFromFrame[f]; markKind: ROPE _ TJaM.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 TJaM.Push[f, emptyBox] ELSE TJaM.Push[f, l.markValue]; } ELSE TJaM.Push[f, emptyBox]; }; GetFirstMark: PROCEDURE [f: Frame] = { handle: Handle _ HandleFromFrame[f]; markKind: ROPE _ TJaM.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 TJaM.Push[f, emptyBox] ELSE TJaM.Push[f, last.markValue]; } ELSE TJaM.Push[f, emptyBox]; }; MergeMarkLists: PROCEDURE [new, old: TSObject.MarkList] RETURNS [TSObject.MarkList] = { <> p, q, r: TSObject.MarkList; <> 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; <> 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: PROCEDURE [f: Frame] = { item1: REF ANY _ TJaM.Pop[f]; item2: REF ANY _ TJaM.Pop[f]; TJaM.Push[f, item1]; TJaM.Push[f, item2]; }; RegisterJaMProcs: PROCEDURE [f: Frame] = BEGIN OPEN NodeStyleWorks; RegisterStyleCommand[f, Atom.MakeAtom[".page"], Page]; -- -> .true . OR -> .false RegisterStyleCommand[f, Atom.MakeAtom[".getmark"], GetMark]; -- -> (markkind) -> RegisterStyleCommand[f, Atom.MakeAtom[".getfirstmark"], GetFirstMark]; -- -> (markkind) -> RegisterStyleCommand[f, Atom.MakeAtom[".columns"], Columns]; -- -> .true . OR -> .false RegisterStyleCommand[f, Atom.MakeAtom[".shipout"], ShipOut]; -- -> . The box is sent out RegisterStyleCommand[f, Atom.MakeAtom[".documentname"], DocumentName]; -- -> string . RegisterStyleCommand[f, Atom.MakeAtom[".textbox"], TextBox]; -- string -> . uses current font RegisterStyleCommand[f, Atom.MakeAtom[".textfont"], TextFont]; -- fontnamestring fontpointsize -> . sets current font RegisterStyleCommand[f, Atom.MakeAtom[".vbox"], Vbox]; -- ... n -> . RegisterStyleCommand[f, Atom.MakeAtom[".hbox"], Hbox]; -- ... n -> . RegisterStyleCommand[f, Atom.MakeAtom[".vboxto"], VboxTo]; -- ... n height -> . RegisterStyleCommand[f, Atom.MakeAtom[".hboxto"], HboxTo]; -- ... n height -> . RegisterStyleCommand[f, Atom.MakeAtom[".fill"], Fill]; -- -> . RegisterStyleCommand[f, Atom.MakeAtom[".dumpbox"], DumpBox]; -- -> . RegisterStyleCommand[f, Atom.MakeAtom[".exchbox"], ExchBox]; -- -> END; END. <> <> <> <> <> <> <> <> <> <> <> <> <> <> <> < TJaM>> <> << >>