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.


   Д  
CrankIPImpl.mesa
Copyright ╙ 1991, 1992 by Xerox Corporation.  All rights reserved.
Willie-s, February 3, 1992 1:06 pm PST

 Э╩
  Ц(cedarcode) styleХNewlineDelimiter
Щ ЩJЪЬ
╧eЬ7ЩBJЩ&JЩ ЧcodeЪ╧k	ЬaШjKШ ЧKЪ╨lnЬЮШKЪЮЬ@ШGЪЬЮШKШ ЪЮЬЮЬЮЬШKШ ЧЪ╧nЬЮЬЮЬ
ЮЬЮЬЮЬЮЬ ШoKХStartOfExpansion([fileName: ROPE, header: ROPE _ NIL]ЪЬKШKKЪЬ*Ш*KЪЬ0Ш0ЪаЬЮЬШ*ЪЮЬ
ШЪЮЬШKЪЬ%Ш%KШKЪЬ9Ш9KЪЬШЧЪЮЬШKЪЬSШSKЪЬШЧЧKЪЬ$Ш$KЪЬ&Ш&KЪЬ$Ш$KЪЬ(Ш(KЪЬШЧKЦI[self: ImagerInterpress.Ref, action: PROC [...], scale: REAL _ 1.0]ЪЬHШHKЪЬШKЪЮЬШKЪЬШKШ ЧЪ
аЬЮЬЮЬЮЬЮЬШ:ЪЮЬЮЬЮШKЪЬЮЬЮЬШKЪЮЬЮЬШ.ЧKЪЬШKШ ЧKЪЬЮЬЮЬШЪЬЮЬЮЬШKШKШKЪЬЮЬШKЪЬ
ЮЬШKЪЬШKШ ЧKЪЬЮЬ╧cШ&KЦ[name: ROPE, s: REAL]ЪЬ\Ш\KЦ[name: ROPE, s: REAL]ЪЬ
ЮЬШKЦ[name: ROPE, s: REAL]ЪЬWШWKЦ[name: ROPE, s: REAL]ЪЬ
ЮЬШKЪЬ[Ш[KЪЬЮЬШKЪЬЮЬШKЪЬЮЬШKЪЬ	ЮЬШKЪЬЮЬШKШ KЪЬЮЬШKШ KЪЬЮЬбШ*Ъа	ЬЮЬЮЬЮЬШHKЦ$[x: RefTab.Ref, key: RefTab.Key]ЪЬЮЬ-ШDЪЮЬЮЬЮЬШЪЮЬЮЬЮЬШKЪЬЮЬШKЪЬAШAKЪЬШЧKЪЮЬШKЪЬШЧKШЪЮЬ
ЮЬЮЬШKЪЬ	ЮЬШЪЮЬЮЬЮШЪ	ЬЮЬЮЬЮЬЮЬШKЪЬ
ЮЬЮЬШ$KЪЬЮЬЮЬЮЬЮЬЮЬШ6KЪЬЮЬ?ШJKЪЬЮЬШKЪЬ
ЮЬШKЪЬЮЬШKЪЬ
ЮЬШKЪЬЮЬШЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮШAKЪЬЮЬЮЬ
Ш&KЪЬЮЬ(Ш<KЦn[font: ImagerFont.Font, rope: ROPE, start: INT _ 0, len: INT _ 2147483647, amplifySpace: REAL _ 1.0]ЪЬЮЬjШuKЪЬШKЪЮЬШЧKЪЬ4Ш4ЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮШIKЪЬ1Ш1KЪЬGШGKЪЬЮЬ"Ш1KЪЬ!Ш!KЪЮЬШЧKЪЮЬЮЬШ0KЪЬЮЬШ KЪЬ-Ш-KЪЬ=Ш=KЪЬШKШЧЪЬЮЬШKЪЬЮЬ>ШIKЪЬMШMKШЧЪЮЬШKЪЬЮЬЮЬШ,KЪЬЮЬ>ШIKЪЬMШMKЪЬШЧЧKЦ7[x: RefTab.Ref, key: RefTab.Key, val: RefTab.Val]ЪЬ:Ш:KЪЬШЧKШKЪЮЬ	ШKЪЬШKШ ЧЪа	ЬЮЬ ЮЬШPKШЪЮЬЮШЪЮЬШЪаЬШ KШKШKШKШKШKШKЪЬШЧKЪЬ;ЮЬШAKЪЮШKЪЬШЧЪЮЬШKЪЬ-Ш-ЦP[context: Imager.Context, path: ImagerPath.PathProc, closed: BOOL _ FALSE]Ъа
ЬШ#KЪЬ&Ш&KЪЬШKЪЬШKЪЬ)Ш)KЪЬШKЪЬШKЪЬШKЪЬШKЪЬШKЪЬШЧKЪЬ>ЮЬШDЪЮЬЮЬЮШЪ	ЬЮЬЮЬЮЬЮЬШKЪЬ
ЮЬЮЬШ$KЪЬЮЬЮЬЮЬЮЬЮЬШ6KЪЬЮЬ?ШJKЪЬЮЬШKЪЬ+Ш+KЪЬ%Ш%KЪЬ"Ш"KЪЬ2Ш2ЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮШAKЪЬЮЬЮЬ
Ш&KЪЬЮЬ(Ш<KЪЬЮЬ1Ш;KЪЬЮЬ;ШFKЪЬ+Ш+KЪЬ%Ш%KЪЬ"Ш"KЪЬ7Ш7KЪЬ.Ш.KЪЬ8Ш8KЪЮЬШЧЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮШIKЪЬ7Ш7ЪаЬЮЬШKШ.KЪЬ,Ш,KЪЬШЧKЪЬ"Ш"KЦ1[context: Imager.Context, p1: VEC, p2: VEC]ЪЬ`Ш`KЪЬШKЪЬ)Ш)KЪЮЬШЧKШЧЪЬЮЬШKЪЬHШHKЪЬ%Ш%KЪЬ.Ш.KШЧKЪЮЬЮЬ+ШKЧKЪЬШЧЧKШKЪЬШЧЧKШ ЪЮЬШKШ ЧKШ KШ Ч ЕЧ    v  #√  