TSTranslateImpl.mesa
Copyright (C) 1984, Xerox Corporation. All rights reserved.
Translates from Tioga tree representation to box & glue representation.
Michael Plass, June 24, 1985 2:20:47 pm PDT
Rick Beach, February 11, 1985 10:05:57 am PST
DIRECTORY
Ascii, Atom, LooksReader, NodeProps, NodeStyle, NodeStyleOps, Rope, RopeReader, TextLooks, TextNode, TSTranslate, TSTranslatePrivate, TSArtwork, TSFont, TSGraphic, TSGlue, TSObject, TSOps, TSTypes, TextEdit;
TSTranslateImpl: CEDAR PROGRAM
IMPORTS Atom, LooksReader, NodeProps, NodeStyleOps, Rope, RopeReader, TextNode, TSTranslatePrivate, TSArtwork, TSFont, TSGraphic, TSObject, TSOps, TSTypes, TextEdit
EXPORTS TSTranslate =
BEGIN OPEN TSTypes, TSTranslatePrivate;
FontNotFound: PUBLIC SIGNAL [fontName: Rope.ROPE, location: INT] RETURNS [substitute: Rope.ROPE] = CODE;
ROPE: TYPE = Rope.ROPE;
underAndStrikeThickess: REAL ← 0.4;
underlineDrop: REAL ← -3.0;
strikeoutRise: REAL ← 3.0;
TreeToVlist: PUBLIC PROCEDURE [t: TextNode.Ref, progressProc: TSTranslate.ProgressProc ← NIL] RETURNS [galley: TSObject.ItemList, style: NodeStyle.Ref] = TRUSTED
BEGIN
state: State ← NewState[];
distinguish the case when t is the root of a document (and hence its content is ignored)
from the case when t is the root of a subtree (and hence its content should be formatted).
state.level ← IF TextNode.Level[t] = 0 THEN 0 ELSE -1;
state.currentNode ← t;
state.remainingLength ← 0;
state.progressProc ← progressProc;
state.totalChars ← state.charsToGo ←
TextNode.LocNumber[TextNode.LastLocWithin[t], 0];
galley ← TSObject.CreateItemList[ProduceFromBranch, state];
style ← state.nodeStyle;
NodeStyleOps.ApplyAll[style, t, print];
IF NodeProps.GetProp[t, $Yum] # NIL THEN state.totalChars ← state.charsToGo ← 1;
END;
ProduceFromBranch: TSObject.ProducerProc = TRUSTED {
state: State ← NARROW[listWriter.writerData];
ProduceEndOfDocument: PROCEDURE = TRUSTED {
listWriter.ProduceItem[TSObject.fillGlue];
listWriter.ProduceEnd[];
IF state.progressProc # NIL THEN
state.progressProc[100];
};
IF state.remainingLength = 0 THEN {
DO
IF state.level < 0 THEN
this is the distinguished case when a subtree root contains content to be formatted,
so initialize but do not advance through the document until this node is consumed.
state.level ← 0
ELSE {
otherwise advance through the document to the next node
deltaLevel: INTEGER;
[state.currentNode, deltaLevel] ← TextNode.Forward[state.currentNode];
state.level ← state.level + deltaLevel;
IF state.progressProc # NIL THEN -- update progress as we advance nodes
state.progressProc[100*(state.totalChars-state.charsToGo)/(state.totalChars+0.01)];
IF state.level <= 0 THEN {
ProduceEndOfDocument[];
RETURN
};
};
IF NOT IsAMarkNode[state.currentNode] THEN EXIT; -- the current node content should be formatted
ProduceMarkBranch[listWriter, state];
SkipOverBranch[state];
IF state.level <= 0 THEN {
ProduceEndOfDocument[];
RETURN
};
ENDLOOP;
InitializeStateForNewNode[listWriter, state];
};
IF IsAnArtworkNode[state.currentNode] THEN {
ProduceArtworkBranch[listWriter, state];
SkipOverBranch[state];
IF state.level <= 0 THEN
ProduceEndOfDocument[];
RETURN
}
ELSE
ProduceFromTextNode[listWriter, state];
};
ProduceFromTextNode: PROCEDURE [listWriter: TSObject.ListWriter, state: State] = TRUSTED {
OPEN state^;
r: TSObject.ListReader;
hlist: TSObject.ItemList ← TSObject.CreateItemList[producer: NIL];
hlistWriter: TSObject.ListWriter ← hlist.listWriter;
hasCharProps: BOOL ~ currentNode.hascharprops;
oldCharPostfix: REF ← NIL;
hlist.listWriter ← NIL;
IF leftFillParameter # NIL THEN hlistWriter.ProduceItem[leftFillParameter];
IF rightFillParameter # NIL THEN hlistWriter.ProduceItem[rightFillParameter];
IF leftFillParameter # NIL THEN
FOR p: LIST OF REF ANY ← leftFillParameter.listParameter, p.rest UNTIL p=NIL DO
hlistWriter.ProduceItem[p.first];
ENDLOOP;
IF firstIndentItem # NIL THEN {hlistWriter.ProduceItem[firstIndentItem]; firstIndentItem ← NIL};
oldLooks ← TextLooks.allLooks; -- to force apply on first char
UNTIL remainingLength = 0 DO
ropeIndex: INT ← ropeReader.GetIndex[];
CharPostfixChange: PROC RETURNS [changed: BOOL] ~ CHECKED {
charPostfix: REF ~ TextEdit.GetCharProp[currentNode, ropeIndex, $Postfix];
changed ← oldCharPostfix # charPostfix;
oldCharPostfix ← charPostfix;
};
char: CHAR ← RopeReader.Get[ropeReader];
looks: TextLooks.Looks ← LooksReader.Get[looksReader];
charPostfix: REF ← NIL;
charsToGo ← charsToGo-1;
remainingLength ← remainingLength - 1;
IF looks # oldLooks OR underlining#None OR strikeout#None OR (hasCharProps AND CharPostfixChange[]) THEN {
under, strike: Dimn ← zeroDimn;
GetNewLooks[hlistWriter, state, looks ! TSFont.FontNotFound => TRUSTED {substituteName ← SIGNAL FontNotFound[name, state.totalChars-state.charsToGo]}];
SELECT underlining FROM
None => {};
LettersAndDigits => IF char IN ['A..'Z] OR char IN ['a..'z] OR char IN ['0..'9] THEN under ← Pt[underAndStrikeThickess];
Visible => IF char IN (' ..'~] THEN under ← Pt[underAndStrikeThickess];
All => under ← Pt[underAndStrikeThickess];
ENDCASE => ERROR;
SELECT strikeout FROM
None => {};
LettersAndDigits => IF char IN ['A..'Z] OR char IN ['a..'z] OR char IN ['0..'9] THEN strike ← Pt[underAndStrikeThickess];
Visible => IF char IN (' ..'~] THEN strike ← Pt[underAndStrikeThickess];
All => strike ← Pt[underAndStrikeThickess];
ENDCASE => ERROR;
hlistWriter.ProduceParameter[underlineThickness, under];
hlistWriter.ProduceParameter[strikeoutThickness, strike];
IF under#zeroDimn THEN hlistWriter.ProduceParameter[underlineBottom, Pt[underlineDrop]];
IF strike#zeroDimn THEN hlistWriter.ProduceParameter[strikeoutBottom, Pt[strikeoutRise]];
};
SELECT char FROM
Ascii.CR => EXIT;
Ascii.TAB => {
hlistWriter.ProduceEnd[];
hlist ← Tabify[hlist, state];
hlistWriter ← hlist.listWriter;
hlist.listWriter ← NIL;
};
Ascii.SP => hlistWriter.ProduceFromRope[curfont, rope, ropeIndex, space];
ENDCASE => hlistWriter.ProduceFromRope[curfont, rope, ropeIndex, char];
ENDLOOP;
IF progressProc#NIL THEN progressProc[100*(totalChars-charsToGo)/(totalChars+0.01)];
FOR p: LIST OF REF ANY ← endFill, p.rest UNTIL p=NIL DO
hlistWriter.ProduceItem[p.first];
ENDLOOP;
hlistWriter.ProduceEnd[];
r ← TSOps.BreakUp[hlist, right, galleyWidth].CreateReader[];
UNTIL r.End[] DO
IF r.CurrentTag[] = exception THEN listWriter.ProduceItem[r.CurrentItem[]]
ELSE ERROR;
r.Next[];
ENDLOOP;
r.DestroyReader[];
ProduceBottomLeadingStretchAndShrink[listWriter, state];
};
IsAnArtworkNode: PROC [node: TextNode.Ref] RETURNS [BOOLEAN] ~ {
recursingOnThisArtwork: BOOLEAN ← NodeProps.GetProp[node, $TSetterProcessingArtwork] # NIL;
IF recursingOnThisArtwork
THEN RETURN [FALSE]
ELSE RETURN [NOT Rope.IsEmpty[NARROW[NodeProps.GetProp[node, $ArtworkClass]]]];
};
ProduceArtworkBranch: PROCEDURE [listWriter: TSObject.ListWriter, state: State] = TRUSTED {
artworkClass: ROPE ← NARROW[NodeProps.GetProp[state.currentNode, $ArtworkClass]];
box: TSObject.Box;
Inhibit infinite recursion. (remember artwork prop for debugging)
NodeProps.PutProp[state.currentNode, $TSetterProcessingArtwork, $ArtworkClass];
box ← BoxFromArtworkBranch[state, artworkClass];
Remove recursion block
NodeProps.RemProp[state.currentNode, $TSetterProcessingArtwork];
{
set up the fill parameters for centering and the like
r: TSObject.ListReader;
hlist: TSObject.ItemList ← TSObject.CreateItemList[producer: NIL];
hlistWriter: TSObject.ListWriter ← hlist.listWriter;
hlist.listWriter ← NIL;
IF state.leftFillParameter # NIL THEN
hlistWriter.ProduceItem[state.leftFillParameter];
IF state.rightFillParameter # NIL THEN
hlistWriter.ProduceItem[state.rightFillParameter];
IF state.leftFillParameter # NIL THEN
FOR p: LIST OF REF ANY ← state.leftFillParameter.listParameter, p.rest UNTIL p=NIL DO
hlistWriter.ProduceItem[p.first];
ENDLOOP;
IF state.firstIndentItem # NIL THEN {
hlistWriter.ProduceItem[state.firstIndentItem]; state.firstIndentItem ← NIL};
hlistWriter.ProduceItem[box]; -- we do all this for this box
FOR p: LIST OF REF ANY ← state.endFill, p.rest UNTIL p=NIL DO
hlistWriter.ProduceItem[p.first];
ENDLOOP;
hlistWriter.ProduceEnd[];
r ← TSOps.BreakUp[hlist, right, state.galleyWidth].CreateReader[];
UNTIL r.End[] DO
IF r.CurrentTag[] = exception THEN listWriter.ProduceItem[r.CurrentItem[]]
ELSE ERROR;
r.Next[];
ENDLOOP;
r.DestroyReader[];
ProduceBottomLeadingStretchAndShrink[listWriter, state];
};
};
BoxFromArtworkBranch: PROCEDURE [state: State, artworkClass: ROPE] RETURNS [box: TSObject.Box] = TRUSTED {
objectFromBranch: TSArtwork.ObjectFromBranchProc ~ TSArtwork.Lookup[artworkClass];
object: TSGraphic.Object ~ objectFromBranch[state.currentNode];
extent: Dimensions ~ object.Layout[
maxX: state.galleyWidth,
maxY: RealDimn[11, in],
suggestedX: state.galleyWidth
];
box ← NEW[graphic TSObject.BoxRec ← [extent, graphic [object]]];
};
IsAMarkNode: PROC [node: TextNode.Ref] RETURNS [BOOLEAN] ~ {
recursingOnThisMark: BOOLEAN ← NodeProps.GetProp[node, $TSetterProcessingMark] # NIL;
IF recursingOnThisMark
THEN RETURN [FALSE]
ELSE RETURN [NOT Rope.IsEmpty[NARROW[NodeProps.GetProp[node, $Mark]]]];
};
ProduceMarkBranch: PROCEDURE [listWriter: TSObject.ListWriter, state: State] = TRUSTED {
contents: TSObject.ItemList;
box: TSObject.Box;
mark: ROPE ← NARROW[NodeProps.GetProp[state.currentNode, $Mark]];
newMark: TSObject.MarkList ← NEW[TSObject.MarkListItem];
Inhibit infinite recursion. (remember mark prop for debugging)
NodeProps.PutProp[state.currentNode, $TSetterProcessingMark, $Mark];
contents ← TreeToVlist[state.currentNode].galley;
box ← TSOps.GetSlimBoxFrom[contents];
newMark.link ← NIL;
newMark.markKind ← Atom.MakeAtom[mark];
newMark.markValue ← box;
listWriter.ProduceItem[newMark];
Remove recursion block
NodeProps.RemProp[state.currentNode, $TSetterProcessingMark];
};
SkipOverBranch: PROCEDURE [state: State] = {
continuationNode: TextNode.Ref ← TextNode.LastWithin[state.currentNode];
state.charsToGo ← state.totalChars-
TextNode.LocNumber[TextNode.LastLocWithin[state.currentNode], 0];
state.remainingLength ← 0;
state.level ← state.level +
TextNode.Level[continuationNode] - TextNode.Level[state.currentNode];
state.currentNode ← continuationNode;
};
END.
Michael Plass, June 28, 1982 8:56 am. Renamed from TPTranslateImpl.
Michael Plass, July 15, 1982 11:20 am. Fixed it so CRs do not cause firstIndent on the next line.
Michael Plass, September 15, 1982 10:54 am. Changed Rope.SP, etc, to refer to Ascii.
Michael Plass, November 12, 1982 10:53 am. Added underline and strikeout.
Michael Plass, November 17, 1982 9:13 am. Changed TreeToVlist to return style.
Michael Plass, November 17, 1982 12:09 pm. Added FontNotFound.
Michael Plass, December 8, 1982 3:38 pm. Took account of layout proc change.
Rick Beach, May 18, 1983 8:26 am. Added marks to ProduceFromBranch., Rick
Edited on May 18, 1983 8:24 am, by Beach
Move production of Mark branch inside test for initialize new branch.
Create: ProduceMarkBranch (local of ProduceFromBranch), ProduceArtworkBranch (local of ProduceFromBranch)
Edited on December 28, 1983 4:08 pm, by Beach
Restructure ProduceFromBranch to use Produce<mumble> procedures that took a listWriter and updated the current state.
Copied fill parameter handling code from ProduceTextNode to ProduceArtworkBranch.
Edited on January 25, 1984 2:27 pm, by Beach
changes to: ProduceArtworkBranch added firstIndentItem code.
Edited on May 7, 1984 4:15:46 pm PDT, by Beach
changes to: TSTranslateImpl, TreeToVlist, ProduceEndOfDocument (local of ProduceFromBranch), ProduceFromTextNode, ProduceArtworkBranch, ProduceMarkBranch
Edited on December 5, 1984 2:48:17 pm PST, by Beach
changes to: TreeToVlist, ProduceEndOfDocument (local of ProduceFromBranch), ProduceFromBranch
Edited on December 6, 1984 3:45:50 pm PST, by Beach
changes to: ProduceFromBranch
Edited on December 8, 1984 3:05:54 pm PST, by Beach
changes to: ProduceMarkBranch, ProduceArtworkBranch, BoxFromArtworkBranch, ProduceFromBranch
Beach, February 11, 1985 10:05:57 am PST
Modify the test for recursing on an Artwork or a Mark node without distrurbing the $ArtworkClass or $Mark properties.
changes to: ProduceFromBranch, IsAnArtworkNode, ProduceArtworkBranch, BoxFromArtworkBranch, IsAMarkNode, ProduceMarkBranch, ProduceArtworkBranch, ProduceMarkBranch, ProduceEndOfDocument (local of ProduceFromBranch)