CrankIPImpl.mesa
Copyright Ó 1991, 1992 by Xerox Corporation. All rights reserved.
Willie-s, February 3, 1992 1:06 pm PST
DIRECTORY Imager, ImagerPath, ImagerBox, ImagerFont, RefTab, Rope, Vector2, IO, ImagerInterpress, CrankIO;
CrankIPImpl: CEDAR PROGRAM
IMPORTS Imager, ImagerFont, RefTab, Rope, IO, ImagerInterpress, CrankIO
~ BEGIN
ROPE: TYPE = Rope.ROPE;
PrintStruct: PROC [fileName: ROPE, struct: REF, landscape: BOOL ¬ TRUE] RETURNS [treeBounds: ImagerBox.Box] = {
master: ImagerInterpress.Ref = ImagerInterpress.Create[fileName: fileName];
boundsTable: RefTab.Ref ~ RefTab.Create[];
bounds: Bounds ~ GetBounds[struct, boundsTable];
Action: PROC [context: Imager.Context] = {
IF landscape
THEN {
Imager.TranslateT[context, [36, 36]];
Imager.RotateT[context, 90];
Imager.TranslateT[context, [-bounds.treeBounds.xmin, 0]];
}
ELSE {
Imager.TranslateT[context, [72-bounds.treeBounds.xmin, 72-bounds.treeBounds.ymin]];
};
Imager.SetStrokeWidth[context, 1.0];
Imager.SetStrokeJoint[context, miter];
Imager.SetStrokeEnd[context, round];
PaintTree[context, struct, boundsTable];
};
ImagerInterpress.DoPage[self: master, action: Action, scale: 0.0254/72];
ImagerInterpress.Close[master];
RETURN [bounds.treeBounds]
};
RopeFromAttributeValue: PROC [ref: REF] RETURNS [ROPE] = {
WITH ref SELECT FROM
rope: ROPE => RETURN [rope];
ENDCASE => RETURN [CrankIO.RopeFromTree[ref]];
};
Bounds: TYPE = REF BoundsRep;
BoundsRep: TYPE = RECORD [
nodeBounds: ImagerBox.Box,
treeBounds: ImagerBox.Box,
vPad: REAL ¬ 0,
subWidth: REAL ¬ 0
];
w: REAL ¬ 8; -- size of NIL indicator;
nameFont: ImagerFont.Font ¬ Imager.FindFontScaled[name: "xerox/xc1-2-2/Modern-bold", s: 12];
nameSkip: REAL ¬ 14;
attrFont: ImagerFont.Font ¬ Imager.FindFontScaled[name: "xerox/xc1-2-2/Modern", s: 10];
attrSkip: REAL ¬ 12;
literalFont: ImagerFont.Font ¬ Imager.FindFontScaled[name: "xerox/xc1-2-2/Classic", s: 10];
literalSkip: REAL ¬ 12;
hPad: REAL ¬ 10;
vPad: REAL ¬ 15;
bearOff: REAL ¬ 3;
maxDescent: REAL ¬ 4;
nilBounds: Bounds ¬ NIL;
curse: NAT ¬ 50; -- deep recursion stopper
GetBounds: PROC [ref: REF, boundsTable: RefTab.Ref] RETURNS [Bounds] = {
bounds: Bounds ¬ NARROW[RefTab.Fetch[x: boundsTable, key: ref].val];
IF ref = NIL THEN {
IF nilBounds = NIL THEN {
nilBounds ¬ NEW[BoundsRep];
nilBounds.nodeBounds ¬ nilBounds.treeBounds ¬ [-w/2, -w, 0, w/2];
};
RETURN [nilBounds];
};
curse ¬ curse - 1;
IF bounds = NIL THEN {
bounds ¬ NEW[BoundsRep];
WITH ref SELECT FROM
lora: LIST OF REF ANY => {
nodeName: ROPE = NARROW[lora.first];
attributes: LIST OF REF ANY = NARROW[lora.rest.first];
width: REAL ¬ ImagerFont.RopeEscapement[font: nameFont, rope: nodeName].x;
height: REAL ¬ nameSkip;
subWidth: REAL ¬ 0;
subHeight: REAL ¬ 0;
totWidth: REAL ¬ 0;
totHeight: REAL ¬ 0;
FOR a: LIST OF REF ANY ¬ attributes, a.rest.rest UNTIL a = NIL DO
attributeName: ROPE = NARROW[a.first];
attributeValue: ROPE = RopeFromAttributeValue[a.rest.first];
width ¬ MAX[width, ImagerFont.RopeEscapement[font: attrFont, rope: Rope.Cat[attributeName, " ", attributeValue]].x];
height ¬ height + attrSkip;
ENDLOOP;
bounds.nodeBounds ¬ [-width/2, -height, width/2, 0];
FOR each: LIST OF REF ANY ¬ lora.rest.rest, each.rest UNTIL each = NIL DO
sub: Bounds = GetBounds[each.first, boundsTable];
subWidth ¬ subWidth + (sub.treeBounds.xmax-sub.treeBounds.xmin) + hPad;
subHeight ¬ MAX[subHeight, -sub.treeBounds.ymin];
bounds.vPad ¬ bounds.vPad + vPad;
ENDLOOP;
IF subWidth > 0 THEN subWidth ¬ subWidth - hPad;
totWidth ¬ MAX[width, subWidth];
totHeight ¬ height + subHeight + bounds.vPad;
bounds.treeBounds ¬ [-totWidth/2, -totHeight, totWidth/2, 0];
bounds.subWidth ¬ subWidth;
};
rope: ROPE => {
width: REAL ¬ ImagerFont.RopeEscapement[font: literalFont, rope: rope].x;
bounds.nodeBounds ¬ bounds.treeBounds ¬ [-width/2, -literalSkip, width/2, 0];
};
ENDCASE => {
rope: ROPE ~ IO.PutFR1["%g", [refAny[ref]]];
width: REAL ¬ ImagerFont.RopeEscapement[font: literalFont, rope: rope].x;
bounds.nodeBounds ¬ bounds.treeBounds ¬ [-width/2, -literalSkip, width/2, 0];
};
[] ¬ RefTab.Insert[x: boundsTable, key: ref, val: bounds];
};
curse ¬ curse + 1;
RETURN [bounds]
};
PaintTree: PROC [context: Imager.Context, ref: REF, boundsTable: RefTab.Ref] = {
curse ¬ curse - 1;
IF ref = NIL
THEN {
BoxPath: ImagerPath.PathProc = {
moveTo[[0, 0]];
lineTo[[w/2, 0]];
lineTo[[w/2, -w]];
lineTo[[-w/2, -w]];
lineTo[[-w/2, 0]];
lineTo[[0, 0]];
};
Imager.MaskStroke[context: context, path: BoxPath, closed: TRUE];
RETURN
}
ELSE {
bounds: Bounds = GetBounds[ref, boundsTable];
BoundsPath: ImagerPath.PathProc = {
bb: ImagerBox.Box ¬ bounds.nodeBounds;
bb.xmin ¬ bb.xmin - bearOff;
bb.xmax ¬ bb.xmax + bearOff;
bb.ymin ¬ bb.ymin - bearOff - maxDescent;
bb.ymax ¬ bb.ymax + bearOff;
moveTo[[bb.xmin, bb.ymin]];
lineTo[[bb.xmax, bb.ymin]];
lineTo[[bb.xmax, bb.ymax]];
lineTo[[bb.xmin, bb.ymax]];
};
Imager.MaskStroke[context: context, path: BoundsPath, closed: TRUE];
WITH ref SELECT FROM
lora: LIST OF REF ANY => {
nodeName: ROPE = NARROW[lora.first];
attributes: LIST OF REF ANY = NARROW[lora.rest.first];
width: REAL = ImagerFont.RopeEscapement[font: nameFont, rope: nodeName].x;
x: REAL ¬ -bounds.subWidth/2;
Imager.TranslateT[context, [0, -nameSkip]];
Imager.SetXY[context, [-width/2, 0]];
Imager.SetFont[context, nameFont];
Imager.ShowRope[context: context, rope: nodeName];
FOR a: LIST OF REF ANY ¬ attributes, a.rest.rest UNTIL a = NIL DO
attributeName: ROPE = NARROW[a.first];
attributeValue: ROPE = RopeFromAttributeValue[a.rest.first];
rope: ROPE = Rope.Cat[attributeName, " ", attributeValue];
width: REAL = ImagerFont.RopeEscapement[font: attrFont, rope: rope].x;
Imager.TranslateT[context, [0, -attrSkip]];
Imager.SetXY[context, [-width/2, 0]];
Imager.SetFont[context, attrFont];
Imager.ShowRope[context: context, rope: attributeName];
Imager.ShowRope[context: context, rope: " "];
Imager.ShowRope[context: context, rope: attributeValue];
ENDLOOP;
FOR each: LIST OF REF ANY ¬ lora.rest.rest, each.rest UNTIL each = NIL DO
subBounds: Bounds = GetBounds[each.first, boundsTable];
Inner: PROC = {
Imager.TranslateT[context, [x, -bounds.vPad]];
PaintTree[context, each.first, boundsTable];
};
x ¬ x - subBounds.treeBounds.xmin;
Imager.MaskVector[context: context, p1: [0, -bearOff-maxDescent], p2: [x, bearOff-bounds.vPad]];
Imager.DoSave[context, Inner];
x ¬ x + subBounds.treeBounds.xmax + hPad;
ENDLOOP;
};
rope: ROPE => {
Imager.SetXY[context, [bounds.nodeBounds.xmin, bounds.nodeBounds.ymin]];
Imager.SetFont[context, literalFont];
Imager.ShowRope[context: context, rope: rope];
};
ENDCASE => PaintTree[context, IO.PutFR1["%g", [refAny[ref]]], boundsTable];
};
curse ¬ curse + 1;
};
END.