TryItImpl.Mesa
Created by Rick Beach, October 14, 1984 1:41:34 pm PDT
DIRECTORY
List,
TableBase,
TableConstraints,
TableLayout,
TextNode,
TSArtwork,
TSFont,
TSGlue,
TSGraphic,
TSObject,
TSOps,
TSOutput,
TSTranslate,
TSTranslatePrivate,
TSTypes;
TryItImpl:
CEDAR
PROGRAM
IMPORTS List, TableBase, TableConstraints, TSFont, TSGlue, TSObject, TSOps, TSOutput, TSTranslate, TSTranslatePrivate, TSTypes
= {
OPEN TableBase, TableLayout;
MakeExtentsValid:
PROC [box: TableBase.RefTableBox] ~ {
IF
NOT box.nodeExtentsValid
THEN {
box.tsObject ← CreateTypesetObject[box.node];
box.nodeExtents ← box.tsObject.layoutProc[box.tsObject];
box.nodeExtentsValid ← TRUE;
};
};
BaselineList: TYPE ~ REF BaselineListRec;
BaselineListRec:
TYPE ~
RECORD [
x, y: TSTypes.Dimn,
extent: TSTypes.Dimensions];
BaselinesFromDownList:
PROCEDURE [box: TableBase.RefTableBox]
RETURNS [baselineList:
LIST
OF BaselineList] ~
TRUSTED {
IF NOT box.nodeExtentsValid THEN MakeExtentsValid[box];
WITH b: BoxFromTypesetObject[box.tsObject]
SELECT
FROM
list => {
source: TSObject.ListReader ← b.items.CreateReader[];
x: TSTypes.Dimn ← TSTypes.zeroDimn;
y: TSTypes.Dimn ← TSTypes.zeroDimn;
alignX: TSTypes.Dimn ← TSTypes.zeroDimn;
IF b.direction # down THEN ERROR ImplementationError["expected down list"];
UNTIL source.End[]
DO
SELECT source.CurrentTag[]
FROM
exception => {
item: REF ANY ← source.CurrentItem[];
SELECT
TRUE
FROM
ISTYPE[item, TSObject.Box] => {
WITH b:
NARROW[item, TSObject.Box]
SELECT
FROM
list => {
x ← x.AddDimn[b.extent[left]];
y ← y.AddDimn[b.extent[up]];
baselineList ← CONS[NEW[BaselineListRec ← [x, y, b.extent]], baselineList];
alignX ← PositionOfAlignChar[box.alignChar, box.alignFirst, b.items.CreateReader[], b.glueset];
};
ENDCASE => ERROR;
};
ISTYPE[item, TSObject.Glue] => {
glue: TSObject.Glue ~ NARROW[item];
delta: TSTypes.Dimn ~ TSGlue.FixGlue[glue^, b.glueset];
y ← y.AddDimn[delta];
};
ISTYPE[item, TSObject.Kern] => {
kern: TSObject.Kern ~ NARROW[item];
y ← y.AddDimn[kern^];
};
ENDCASE => ERROR;
};
ENDCASE => ERROR;
source.Next[];
ENDLOOP;
};
ENDCASE => ERROR ImplementationError["Expecting a down list box from a TypsetObject"];
IF baselineList # NIL THEN TRUSTED { baselineList ← LOOPHOLE[List.Reverse[LOOPHOLE[baselineList]]]; };
};
PositionOfAlignChar:
PROC [alignChar:
CHAR, alignFirst:
BOOLEAN, boxList: TSObject.ListReader, glueSet: TSGlue.GlueSet]
RETURNS [alignX: TSTypes.Dimn] ~ {
direction: TSObject.Direction ~ right;
opposite: TSObject.Direction ~ left;
x: TSTypes.Dimn ← TSTypes.zeroDimn;
lastCharX: TSTypes.Dimn ← TSTypes.zeroDimn;
UNTIL boxList.End[]
DO
SELECT boxList.CurrentTag[]
FROM
char => {
thisChar: CHAR ~ boxList.CurrentChar[];
extent: TSTypes.Dimensions ← boxList.currentFont.CharDimensions[thisChar];
IF alignChar = thisChar
THEN {
IF alignFirst THEN RETURN [lastCharX];
};
lastCharX ← x ← x.AddDimn[extent[direction].SubDimn[extent[opposite]]];
boxList.Next[];
};
space => {
WHILE boxList.CurrentTag[] = space
DO
x ← x.AddDimn[TSGlue.FixGlue[boxList.currentFont.SpaceGlue[], glueSet]];
boxList.Next[];
ENDLOOP;
};
exception => {
item: REF ANY ← boxList.CurrentItem[];
SELECT
TRUE
FROM
ISTYPE[item, TSObject.Glue] => {
g: TSObject.Glue ← NARROW[item];
x ← x.AddDimn[TSGlue.FixGlue[g^, glueSet]];
boxList.Next[];
};
ISTYPE[item, TSObject.Kern] => {
x ← x.AddDimn[NARROW[item, TSObject.Kern]^];
boxList.Next[];
};
ENDCASE => ERROR UnimplementedCase;
};
ENDCASE => ERROR UnimplementedCase;
ENDLOOP;
RETURN [lastCharX];
};
CreateTypesetObject: TSArtwork.ObjectFromBranchProc = {
object ← NEW[TSGraphic.ObjectRec];
object.paintProc ← TypesetObjectPaint;
object.layoutProc ← TypesetObjectLayout;
object.data ← NEW[TypesetObjectRec ← [node: node]];
};
TypesetObjectRec:
TYPE =
RECORD [
node: TextNode.Ref,
vlist: TSObject.ItemList,
box: TSObject.Box
];
TypesetObjectLayout: TSGraphic.LayoutProc =
TRUSTED {
data: REF TypesetObjectRec ← NARROW[self.data];
data.vlist ← TSTranslate.TreeToVlist[data.node].galley;
TSTranslatePrivate.InitializeStateForNewNode[
data.vlist.listWriter,
NARROW[data.vlist.listWriter.writerData]
];
data.box ← TSOps.GetSlimBoxFrom[data.vlist];
extent ← data.box.extent;
};
TypesetObjectPaint: TSGraphic.PaintProc = {
data: REF TypesetObjectRec ← NARROW[self.data];
TSOutput.BoxOut[NARROW[context], originX, originY, data.box^];
};
BoxFromTypesetObject:
PROC [self: TSGraphic.Object]
RETURNS [box: TSObject.Box] ~ {
data: REF TypesetObjectRec ← NARROW[self.data];
box ← data.box;
};
}.