[_CDCSL_93-16_]<1>Cedar>release>Gargoyle>GGOutlineImplB.mesa

GGOutlineImplB.mesa

Contents: The second half of the $Outline class procs, plus Outline utility procs.

Pier, June 22, 1992 4:51 pm PDT

Bier, January 28, 1993 3:15 pm PST

Kurlander, August 20, 1987 11:41:43 pm PDT

DIRECTORY

Basics, Feedback, GGBasicTypes, GGBoundBox, GGCoreOps, GGCoreTypes, GGHistoryTypes, GGInterfaceTypes, GGModelTypes, GGOutline, GGParent, GGScene, GGSegmentTypes, GGSelect, GGSequence, GGSlice, GGSliceOps, GGTraj, GGTrajTypes, GGUtility, Imager, List, Rope, TextNode, TiogaImager;

GGOutlineImplB: CEDAR PROGRAM

IMPORTS Basics, Feedback, GGBoundBox, GGCoreOps, GGOutline, GGParent, GGScene, GGSelect, GGSequence, GGSlice, GGSliceOps, GGTraj, GGUtility, List, TextNode

EXPORTS GGSlice, GGOutline, GGParent = BEGIN

BoundBox: TYPE = GGCoreTypes.BoundBox;

Camera: TYPE = GGModelTypes.Camera;

Circle: TYPE = GGBasicTypes.Circle;

Color: TYPE = Imager.Color;

ControlPointGenerator: TYPE = GGModelTypes.ControlPointGenerator;

DefaultData: TYPE = GGModelTypes.DefaultData;

EditConstraints: TYPE = GGModelTypes.EditConstraints;

FeatureData: TYPE = GGInterfaceTypes.FeatureData;

GGData: TYPE = GGInterfaceTypes.GGData;

HistoryEvent: TYPE = GGHistoryTypes.HistoryEvent;

HitType: TYPE = GGModelTypes.TrajPartType;

Joint: TYPE = GGSegmentTypes.Joint;

JointGenerator: TYPE = GGModelTypes.JointGenerator;

Line: TYPE = GGCoreTypes.Line;

Orientation: TYPE = GGModelTypes.Orientation;

OutlineData: TYPE = GGOutline.OutlineData;

OutlineDataObj: TYPE = GGOutline.OutlineDataObj;

OutlineHitData: TYPE = GGOutline.OutlineHitData;

OutlineHitDataObj: TYPE = GGOutline.OutlineHitDataObj;

OutlineParts: TYPE = GGOutline.OutlineParts;

OutlinePartsObj: TYPE = GGOutline.OutlinePartsObj;

Point: TYPE = GGBasicTypes.Point;

PointAndDone: TYPE = GGModelTypes.PointAndDone;

PointGenerator: TYPE = GGModelTypes.PointGenerator;

PointGeneratorObj: TYPE = GGModelTypes.PointGeneratorObj;

PointPairAndDone: TYPE = GGModelTypes.PointPairAndDone;

PointPairGenerator: TYPE = GGModelTypes.PointPairGenerator;

PointPairGeneratorObj: TYPE = GGModelTypes.PointPairGeneratorObj;

RunProc: TYPE = GGTrajTypes.RunProc;

Scene: TYPE = GGModelTypes.Scene;

Segment: TYPE = GGSegmentTypes.Segment;

SegmentGenerator: TYPE = GGModelTypes.SegmentGenerator;

SegmentGeneratorObj: TYPE = GGModelTypes.SegmentGeneratorObj;

SelectionClass: TYPE = GGSegmentTypes.SelectionClass;

SelectMode: TYPE = GGModelTypes.SelectMode;

SequenceOfReal: TYPE = GGCoreTypes.SequenceOfReal;

Slice: TYPE = GGModelTypes.Slice;

SliceClass: TYPE = GGModelTypes.SliceClass;

SliceDescriptor: TYPE = GGModelTypes.SliceDescriptor;

SliceDescriptorGenerator: TYPE = GGModelTypes.SliceDescriptorGenerator;

SliceDescriptorGeneratorObj: TYPE = GGModelTypes.SliceDescriptorGeneratorObj;

SliceDescriptorTallyProc: TYPE = GGModelTypes.SliceDescriptorTallyProc;

SliceDescriptorWalkProc: TYPE = GGModelTypes.SliceDescriptorWalkProc;

SliceGenerator: TYPE = GGModelTypes.SliceGenerator;

SliceGeneratorObj: TYPE = GGModelTypes.SliceGeneratorObj;

SliceObj: TYPE = GGModelTypes.SliceObj;

SliceParts: TYPE = GGModelTypes.SliceParts;

SlicePartsWalkProc: TYPE = GGModelTypes.SlicePartsWalkProc;

SliceTallyProc: TYPE = GGModelTypes.SliceTallyProc;

SliceWalkProc: TYPE = GGModelTypes.SliceWalkProc;

StrokeEnd: TYPE = Imager.StrokeEnd;

StrokeJoint: TYPE = Imager.StrokeJoint;

Traj: TYPE = GGModelTypes.Traj;

TrajData: TYPE = GGModelTypes.TrajData;

TrajEnd: TYPE = GGModelTypes.TrajEnd;

TrajParts: TYPE = GGModelTypes.TrajParts;

TrajPartType: TYPE = GGModelTypes.TrajPartType;

TriggerBag: TYPE = GGInterfaceTypes.TriggerBag;

Vector: TYPE = GGBasicTypes.Vector;

WalkLevel: TYPE = GGModelTypes.WalkLevel;

Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = Feedback.Problem;

ClusterData: TYPE = REF ClusterDataObj;

ClusterDataObj: TYPE = GGSlice.ClusterDataObj;

The Outline Class

BuildMoreOutlineSliceClass: PUBLIC PROC [class: SliceClass] = {

class.closestPoint ¬ GGParent.ClosestPoint;

class.closestJointToHitData ¬ GGParent.ClosestJointToHitData;

class.closestPointAndTangent ¬ GGSlice.NoOpClosestPointAndTangent;

class.closestSegment ¬ GGParent.ClosestSegment;

class.filledPathsUnderPoint ¬ OutlineFilledPathsUnderPoint;

class.lineIntersection ¬ GGParent.LineIntersection;

class.circleIntersection ¬ GGParent.CircleIntersection;

class.hitDataAsSimpleCurve ¬ GGParent.HitDataAsSimpleCurve;

Style

class.setDefaults ¬ GGParent.SetDefaults;

class.setStrokeWidth ¬ GGParent.SetStrokeWidth;

class.getStrokeWidth ¬ GGParent.GetStrokeWidth;

class.setStrokeEnd ¬ GGParent.SetStrokeEnd;

class.getStrokeEnd ¬ GGParent.GetStrokeEnd;

class.setStrokeJoint ¬ GGParent.SetStrokeJoint;

class.getStrokeJoint ¬ GGParent.GetStrokeJoint;

class.setStrokeColor ¬ GGParent.SetStrokeColor;

class.getStrokeColor ¬ GGParent.GetStrokeColor;

class.setFillColor ¬ GGParent.SetFillColor;

class.getFillColor ¬ OutlineGetFillColor;

class.setArrows ¬ GGSlice.NoOpSetArrows;

class.getArrows ¬ GGSlice.NoOpGetArrows;

class.setDashed ¬ GGParent.SetDashed;

class.getDashed ¬ GGParent.GetDashed;

class.setOrientation ¬ GGParent.SetOrientation;

class.getOrientation ¬ GGParent.GetOrientation;

};

BuildMoreClusterSliceClass: PUBLIC PROC [class: SliceClass] = {

Hit Testing

class.closestPoint ¬ GGParent.ClosestPoint;

class.closestJointToHitData ¬ GGParent.ClosestJointToHitData;

class.closestPointAndTangent ¬ GGSlice.NoOpClosestPointAndTangent;

class.closestSegment ¬ GGParent.ClosestSegment;

class.filledPathsUnderPoint ¬ ClusterFilledPathsUnderPoint;

class.lineIntersection ¬ GGParent.LineIntersection;

class.circleIntersection ¬ GGParent.CircleIntersection;

class.hitDataAsSimpleCurve ¬ GGParent.HitDataAsSimpleCurve;

Style

class.setDefaults ¬ GGParent.SetDefaults;

class.setStrokeWidth ¬ GGParent.SetStrokeWidth;

class.getStrokeWidth ¬ GGParent.GetStrokeWidth;

class.setStrokeEnd ¬ GGParent.SetStrokeEnd;

class.getStrokeEnd ¬ GGParent.GetStrokeEnd;

class.setStrokeJoint ¬ GGParent.SetStrokeJoint;

class.getStrokeJoint ¬ GGParent.GetStrokeJoint;

class.setStrokeColor ¬ GGParent.SetStrokeColor;

class.getStrokeColor ¬ GGParent.GetStrokeColor;

class.setFillColor ¬ GGParent.SetFillColor;

class.getFillColor ¬ GGParent.GetFillColor;

class.setArrows ¬ GGSlice.NoOpSetArrows;

class.getArrows ¬ GGSlice.NoOpGetArrows;

class.setDashed ¬ GGParent.SetDashed;

class.getDashed ¬ GGParent.GetDashed;

class.setOrientation ¬ GGParent.SetOrientation;

class.getOrientation ¬ GGParent.GetOrientation;

};

Hit Testing

ClosestPoint: PUBLIC PROC [sliceD: SliceDescriptor, testPoint: Point, tolerance: REAL] RETURNS [bestPoint: Point ¬ [0.0, 0.0], bestDist: REAL ¬ 0.0, bestNormal: Vector ¬ [0,-1], hitData: REF ANY, success: BOOL ¬ FALSE] = {

IF sliceD=NIL THEN RETURN ELSE {

parts: OutlineParts ¬ NARROW[sliceD.parts];

outlineHitData: OutlineHitData;

thisPoint: Point;

thisDist: REAL;

thisNormal: Vector;

thisHitData, bestHitData: REF ANY;

thisSuccess: BOOL ¬ FALSE;

bestChild: Slice;

IF NOT GGBoundBox.PointIsInGrownBox[testPoint, GGSliceOps.GetTightBox[sliceD.slice], tolerance]

THEN RETURN;

bestDist ¬ GGUtility.plusInfinity;

FOR list: LIST OF SliceDescriptor ¬ parts.descriptors, list.rest UNTIL list = NIL DO

IF list.first=NIL THEN LOOP;

[thisPoint, thisDist, thisNormal, thisHitData, thisSuccess] ¬ list.first.slice.class.closestPoint[list.first, testPoint, tolerance];

Not called through GGSliceOps because the procedure overhead is deadly. This procedure is particularly expensive because it has so many parameters.

IF thisSuccess AND thisDist < bestDist THEN {

bestChild ¬ list.first.slice;

bestPoint ¬ thisPoint;

bestDist ¬ thisDist;

bestNormal ¬ thisNormal;

bestHitData ¬ thisHitData;

success ¬ TRUE;

};

ENDLOOP;

IF success THEN {

hitData ¬ outlineHitData ¬ NEW[OutlineHitDataObj ¬ [

bestChild, bestHitData]];

};

ClosestJointToHitData: PUBLIC PROC [sliceD: SliceDescriptor, mapPoint, testPoint: Point, hitData: REF ANY] RETURNS [jointD: SliceDescriptor, point: Point, normal: Vector ¬ [0,-1]] = {

outlineHitData: OutlineHitData ¬ NARROW[hitData];

child: Slice ¬ outlineHitData.child;

childHitData: REF ANY ¬ outlineHitData.childHitData;

childD: SliceDescriptor ¬ GGParent.ChildDescriptorFromDescriptor[sliceD, child];

newChildD: SliceDescriptor;

[newChildD, point, normal] ¬ GGSliceOps.ClosestJointToHitData[childD, mapPoint, testPoint, childHitData];

jointD ¬ GGParent.DescriptorFromChildDescriptor[sliceD.slice, newChildD];

};

ClosestSegment: PUBLIC PROC [sliceD: SliceDescriptor, testPoint: Point, tolerance: REAL] RETURNS [bestPoint: Point ¬ [0.0, 0.0], bestDist: REAL ¬ 0.0, bestNormal: Vector ¬ [0,-1], hitData: REF ANY, success: BOOL ¬ FALSE] = {

IF sliceD=NIL THEN RETURN ELSE {

parts: OutlineParts ¬ NARROW[sliceD.parts];

outlineHitData: OutlineHitData;

thisPoint: Point;

thisDist: REAL;

thisNormal: Vector;

thisHitData, bestHitData: REF ANY;

thisSuccess: BOOL ¬ FALSE;

bestChild: Slice;

IF NOT GGBoundBox.PointIsInGrownBox[testPoint, GGSliceOps.GetTightBox[sliceD.slice], tolerance]

THEN RETURN; -- success=FALSE, added February 24, 1988 by Bier

bestDist ¬ GGUtility.plusInfinity;

FOR list: LIST OF SliceDescriptor ¬ parts.descriptors, list.rest UNTIL list = NIL DO

IF list.first=NIL THEN LOOP;

[thisPoint, thisDist, thisNormal, thisHitData, thisSuccess] ¬ list.first.slice.class.closestSegment[list.first, testPoint, tolerance];

Not called through GGSliceOps because the procedure overhead is deadly. This procedure is particularly expensive because it has so many parameters.

IF thisSuccess AND thisDist < bestDist THEN {

bestChild ¬ list.first.slice;

bestPoint ¬ thisPoint;

bestDist ¬ thisDist;

bestNormal ¬ thisNormal;

bestHitData ¬ thisHitData;

success ¬ TRUE;

};

ENDLOOP;

IF success THEN {

hitData ¬ outlineHitData ¬ NEW[OutlineHitDataObj ¬ [

bestChild, bestHitData]];

};

ClusterFilledPathsUnderPoint: PROC [slice: Slice, point: Point, tolerance: REAL] RETURNS [hitData: REF ANY ¬ NIL, moreHitDatas: LIST OF REF ANY ¬ NIL] = {

Eventually, clusters should return an ordered list of the paths that are under the given point. For now, clusters will just return the frontmost such path.

outlineData: OutlineData ¬ NARROW[slice.data];

clusterData: ClusterData ¬ NARROW[outlineData.subclassData];

thisChild: Slice;

thisHitData: REF ANY;

childHitDatas: LIST OF REF ANY;

thisSuccess: BOOL ¬ FALSE;

success: BOOL ¬ FALSE;

FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList=NIL DO

thisChild ¬ childList.first;

[thisHitData, childHitDatas] ¬ GGSliceOps.FilledPathsUnderPoint[thisChild, point, tolerance];

IF thisHitData # NIL THEN {

FOR list: LIST OF REF ANY ¬ List.DReverse[childHitDatas], list.rest UNTIL list = NIL DO

IF NOT success THEN {

success ¬ TRUE;

hitData ¬ NEW[OutlineHitDataObj ¬ [thisChild, list.first]];

}

ELSE {

moreHitDatas ¬ CONS[hitData, moreHitDatas];

hitData ¬ NEW[OutlineHitDataObj ¬ [thisChild, list.first]];

};

ENDLOOP;

IF NOT success THEN {

success ¬ TRUE;

hitData ¬ NEW[OutlineHitDataObj ¬ [thisChild, thisHitData]];

}

ELSE {

moreHitDatas ¬ CONS[hitData, moreHitDatas];

hitData ¬ NEW[OutlineHitDataObj ¬ [thisChild, thisHitData]];

};

ENDLOOP;

};

OutlineFilledPathsUnderPoint: PROC [slice: Slice, point: Point, tolerance: REAL] RETURNS [hitData: REF ANY ¬ NIL, moreHitDatas: LIST OF REF ANY ¬ NIL] = {

For now, return a hitData if the point is in the fence and not in any holes, or if the point is in some hole but not in the fence.

outlineData: OutlineData ¬ NARROW[slice.data];

thisHole: Slice;

thisHitData, holeHitData: REF ANY;

childHitDatas: LIST OF REF ANY;

thisSuccess: BOOL ¬ FALSE;

success: BOOL ¬ FALSE;

fence: Slice ¬ outlineData.children.first;

pointInSomeHole: BOOL ¬ FALSE;

IF outlineData.fillColor = NIL THEN RETURN;

IF NOT GGBoundBox.PointIsInGrownBox[point, GGSliceOps.GetTightBox[slice], tolerance]

THEN RETURN;

Test for point inclusion in the holes

FOR childList: LIST OF Slice ¬ outlineData.children.rest, childList.rest UNTIL childList=NIL DO

thisHole ¬ childList.first;

[holeHitData, childHitDatas] ¬ GGSliceOps.FilledPathsUnderPoint[thisHole, point, tolerance];

IF holeHitData # NIL THEN {

pointInSomeHole ¬ TRUE;

EXIT;

};

ENDLOOP;

Test for point inclusion in the fence

[thisHitData, ] ¬ GGSliceOps.FilledPathsUnderPoint[fence, point, tolerance];

IF thisHitData # NIL THEN { -- is in the fence

IF pointInSomeHole THEN RETURN[NIL, NIL]

ELSE hitData ¬ NEW[OutlineHitDataObj ¬ [fence, thisHitData]];

}

ELSE IF pointInSomeHole

THEN hitData ¬ NEW[OutlineHitDataObj ¬ [thisHole, holeHitData]]

ELSE RETURN[NIL, NIL];

};

LineIntersection: PUBLIC PROC [sliceD: SliceDescriptor, line: Line] RETURNS [points: LIST OF Point, pointCount: NAT ¬ 0] = {

Finds the intersection of the line with those slice parts mentioned in sliceD. Is this routine really useful anymore?

segGen: GGModelTypes.SegmentGenerator;

outlineParts: OutlineParts ¬ NARROW[sliceD.parts];

thesePoints: LIST OF Point;

thisCount: NAT;

FOR descriptors: LIST OF SliceDescriptor ¬ outlineParts.descriptors, descriptors.rest UNTIL descriptors = NIL DO

childD: SliceDescriptor ¬ descriptors.first;

IF childD = NIL THEN LOOP;

segGen ¬ GGSliceOps.SegmentsInDescriptor[childD];

FOR seg: Segment ¬ GGSliceOps.NextSegment[childD.slice, segGen].seg, GGSliceOps.NextSegment[childD.slice, segGen].seg UNTIL seg = NIL DO

[thesePoints, thisCount] ¬ seg.class.lineIntersection[seg, line];

FOR list: LIST OF Point ¬ thesePoints, list.rest UNTIL list = NIL DO

points ¬ CONS[list.first, points];

ENDLOOP;

pointCount ¬ pointCount + thisCount;

ENDLOOP;

};

CircleIntersection: PUBLIC PROC [sliceD: SliceDescriptor, circle: Circle] RETURNS [points: LIST OF Point, pointCount: NAT ¬ 0] = {

Finds the intersection of the circle with those slice parts mentioned in sliceD. Is this routine really useful anymore?

segGen: GGModelTypes.SegmentGenerator;

outlineParts: OutlineParts ¬ NARROW[sliceD.parts];

thesePoints: LIST OF Point;

thisCount: NAT;

FOR descriptors: LIST OF SliceDescriptor ¬ outlineParts.descriptors, descriptors.rest UNTIL descriptors = NIL DO

childD: SliceDescriptor ¬ descriptors.first;

IF childD = NIL THEN LOOP;

segGen ¬ GGSliceOps.SegmentsInDescriptor[childD];

FOR seg: Segment ¬ GGSliceOps.NextSegment[childD.slice, segGen].seg, GGSliceOps.NextSegment[childD.slice, segGen].seg UNTIL seg = NIL DO

[thesePoints, thisCount] ¬ seg.class.circleIntersection[seg, circle];

FOR list: LIST OF Point ¬ thesePoints, list.rest UNTIL list = NIL DO

points ¬ CONS[list.first, points];

ENDLOOP;

pointCount ¬ pointCount + thisCount;

ENDLOOP;

};

HitDataAsSimpleCurve: PUBLIC PROC [slice: Slice, hitData: REF ANY] RETURNS [simpleCurve: REF ANY] = {

simpleCurve will be of type Edge, Arc, etc. There will be Conic and Bezier types as well.

outlineHitData: OutlineHitData ¬ NARROW[hitData];

simpleCurve ¬ GGSliceOps.HitDataAsSimpleCurve[outlineHitData.child, outlineHitData.childHitData];

};

PathOfHitData: PUBLIC PROC [slice: Slice, hitData: REF ANY] RETURNS [path: Slice, pathHitData: REF ANY] = {

path ¬ slice;

pathHitData ¬ hitData;

UNTIL NOT GGParent.IsParent[path] DO

outlineHitData: OutlineHitData ¬ NARROW[pathHitData];

path ¬ outlineHitData.child;

pathHitData ¬ outlineHitData.childHitData;

ENDLOOP;

};

Style

SetDefaults: PUBLIC PROC [slice: Slice, parts: SliceParts, defaults: DefaultData, history: HistoryEvent] = {

ChildSetDefaults: PROC [child: Slice, parts: SliceParts] = {

Call GGSliceOps.Set* on each child, with history=NIL so the children will not make history list entries. The outline will make one instead.

[] ¬ GGSliceOps.SetStrokeWidth[child, parts, defaults.strokeWidth, NIL];

GGSliceOps.SetStrokeEnd[child, parts, defaults.strokeEnd, NIL];

GGSliceOps.SetStrokeJoint[child, parts, defaults.strokeJoint, NIL];

GGSliceOps.SetDashed[child, parts, defaults.dashed, GGUtility.CopyPattern[defaults.pattern], defaults.offset, defaults.length, NIL];

GGSliceOps.SetStrokeColor[child, parts, defaults.strokeColor, $Set, NIL]; -- should this copy the Color??

GGSliceOps.SetFillColor[child, parts, defaults.fillColor, $Set, NIL]; -- should this copy the Color??

};

outlineParts: OutlineParts ¬ NARROW[parts];

outlineData: OutlineData ¬ NARROW[slice.data];

outlineData.fillColor ¬ defaults.fillColor;

parts=NIL => do for all children

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

ChildSetDefaults[childList.first, NIL];

ENDLOOP

ELSE FOR partsList: LIST OF SliceDescriptor ¬ outlineParts.descriptors, partsList.rest UNTIL partsList = NIL DO

IF partsList.first#NIL THEN ChildSetDefaults[partsList.first.slice, partsList.first.parts];

ENDLOOP;

};

SetStrokeWidth: PUBLIC PROC [slice: Slice, parts: SliceParts, strokeWidth: REAL, history: HistoryEvent] RETURNS [box: BoundBox] = {

Sets the stroke width of the named parts of slice to be strokeWidth.

parts=NIL => do for all children

outlineParts: OutlineParts ¬ NARROW[parts];

outlineData: OutlineData ¬ NARROW[slice.data];

Call GGSliceOps.SetStrokeWidth on each child, with history=NIL so the children will not make history list entries. The parent will make one instead.

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetStrokeWidth[childList.first, NIL, strokeWidth, NIL];

ENDLOOP

ELSE FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN {

[] ¬ GGSliceOps.SetStrokeWidth[list.first.slice, list.first.parts, strokeWidth, NIL];

};

ENDLOOP;

box ¬ GGBoundBox.CopyBoundBox[GGSliceOps.GetBoundBox[slice, parts]];

CopyBoundBox in case the caller or descendants messes with the conference of the slice boundBox

};

GetStrokeWidth: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [strokeWidth: REAL ¬ -1.0, isUnique: BOOL ¬ TRUE] = {

found: BOOL ¬ FALSE;

DoCheckStrokeWidth: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisWidth: REAL;

[thisWidth, thisIsUnique] ¬ GGSliceOps.GetStrokeWidth[child, childParts];

IF NOT thisIsUnique THEN {

strokeWidth ¬ thisWidth;

RETURN[TRUE];

}

ELSE {

IF found THEN {

IF thisWidth # strokeWidth THEN RETURN[TRUE];

}

ELSE {

strokeWidth ¬ thisWidth;

found ¬ TRUE;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckStrokeWidth] AND found;

};

SetStrokeEnd: PUBLIC PROC [slice: Slice, parts: SliceParts, strokeEnd: StrokeEnd, history: HistoryEvent] = {

Sets the stroke end of the named parts of slice to be strokeEnd.

parts=NIL => do for all children

outlineParts: OutlineParts ¬ NARROW[parts];

outlineData: OutlineData ¬ NARROW[slice.data];

call GGSliceOps.SetStrokeEnd on each child, with history=NIL so the children will not make history list entries. The outline will make one instead.

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetStrokeEnd[childList.first, NIL, strokeEnd, NIL];

ENDLOOP

ELSE FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN [] ¬ GGSliceOps.SetStrokeEnd[list.first.slice, list.first.parts, strokeEnd, NIL];

ENDLOOP;

};

GetStrokeEnd: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [strokeEnd: StrokeEnd ¬ round, isUnique: BOOL ¬ TRUE] = {

found: BOOL ¬ FALSE;

DoCheckStrokeEnd: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisEnd: StrokeEnd;

[thisEnd, thisIsUnique] ¬ GGSliceOps.GetStrokeEnd[child, childParts];

IF NOT thisIsUnique THEN {

strokeEnd ¬ thisEnd;

RETURN[TRUE];

}

ELSE {

IF found THEN {

IF thisEnd # strokeEnd THEN RETURN[TRUE];

}

ELSE {

strokeEnd ¬ thisEnd;

found ¬ TRUE;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckStrokeEnd] AND found;

};

SetStrokeJoint: PUBLIC PROC [slice: Slice, parts: SliceParts, strokeJoint: StrokeJoint, history: HistoryEvent] = {

Sets the stroke Joint of the named parts of slice to be strokeJoint.

parts=NIL => do for all children

outlineParts: OutlineParts ¬ NARROW[parts];

outlineData: OutlineData ¬ NARROW[slice.data];

call GGSliceOps.SetStrokeJoint on each child, with history=NIL so the children will not make history list entries. The outline will make one instead.

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetStrokeJoint[childList.first, NIL, strokeJoint, NIL];

ENDLOOP

ELSE FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN [] ¬ GGSliceOps.SetStrokeJoint[list.first.slice, list.first.parts, strokeJoint, NIL];

ENDLOOP;

};

GetStrokeJoint: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [strokeJoint: StrokeJoint ¬ round, isUnique: BOOL ¬ TRUE] = {

found: BOOL ¬ FALSE;

DoCheckStrokeJoint: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisJoint: StrokeJoint;

[thisJoint, thisIsUnique] ¬ GGSliceOps.GetStrokeJoint[child, childParts];

IF NOT thisIsUnique THEN {

strokeJoint ¬ thisJoint;

RETURN[TRUE];

}

ELSE {

IF found THEN {

IF thisJoint # strokeJoint THEN RETURN[TRUE];

}

ELSE {

strokeJoint ¬ thisJoint;

found ¬ TRUE;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckStrokeJoint] AND found;

};

SetStrokeColor: PUBLIC PROC [slice: Slice, parts: SliceParts, color: Color, setHow: ATOM, history: HistoryEvent] = {

Sets the stroke color of the named parts of slice to be color.

parts=NIL => do for all children

outlineParts: OutlineParts ¬ NARROW[parts];

outlineData: OutlineData ¬ NARROW[slice.data];

Call GGSliceOps.SetStrokeColor on each child, with history=NIL so the children will not make history list entries. The outline will make one instead.

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetStrokeColor[childList.first, NIL, color, setHow, NIL];

ENDLOOP

ELSE FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN {

[] ¬ GGSliceOps.SetStrokeColor[list.first.slice, list.first.parts, color, setHow, NIL];

};

ENDLOOP;

};

GetStrokeColor: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [color: Color, isUnique: BOOL ¬ TRUE] = {

found: BOOL ¬ FALSE;

DoCheckStrokeColor: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisColor: Color;

[thisColor, thisIsUnique] ¬ GGSliceOps.GetStrokeColor[child, childParts];

IF NOT thisIsUnique THEN {

color ¬ thisColor;

RETURN[TRUE];

}

ELSE {

IF found THEN {

IF NOT GGCoreOps.EquivalentColors[thisColor, color] THEN RETURN[TRUE];

}

ELSE {

color ¬ thisColor;

found ¬ TRUE;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckStrokeColor] AND found;

};

SetFillColor: PUBLIC PROC [slice: Slice, parts: SliceParts, color: Color, setHow: ATOM, history: HistoryEvent] = {

Sets the fill color of the named parts of slice to be color.

parts=NIL => do for all children

outlineData: OutlineData ¬ NARROW[slice.data];

outlineParts: OutlineParts ¬ NARROW[parts];

Call GGSliceOps.SetFillColor on each child, with history=NIL so the children will not make history list entries. The parent will make one instead.

SELECT setHow FROM

$Set => outlineData.fillColor ¬ color;

$ChangeHue => {

newColor: Color ¬ GGUtility.ChangeHue[outlineData.fillColor, color];

outlineData.fillColor ¬ newColor;

};

ENDCASE => ERROR;

IF parts = NIL THEN {

FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetFillColor[childList.first, NIL, color, setHow, NIL];

ENDLOOP;

}

ELSE {

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN {

[] ¬ GGSliceOps.SetFillColor[list.first.slice, list.first.parts, color, setHow, NIL];

};

ENDLOOP;

};

OutlineGetFillColor: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [color: Color, isUnique: BOOL ¬ TRUE] = {

Get the fill color of the slice.

outlineData: OutlineData ¬ NARROW[slice.data];

color ¬ outlineData.fillColor;

};

GetFillColor: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [color: Color, isUnique: BOOL ¬ TRUE] = {

found: BOOL ¬ FALSE;

DoCheckFillColor: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisColor: Color;

[thisColor, thisIsUnique] ¬ GGSliceOps.GetFillColor[child, childParts];

IF NOT thisIsUnique THEN {

color ¬ thisColor;

RETURN[TRUE];

}

ELSE {

IF found THEN {

IF NOT GGCoreOps.EquivalentColors[thisColor, color] THEN RETURN[TRUE];

}

ELSE {

color ¬ thisColor;

found ¬ TRUE;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckFillColor] AND found;

};

SetDashed: PUBLIC PROC [slice: Slice, parts: SliceParts, dashed: BOOL, pattern: SequenceOfReal ¬ NIL, offset: REAL ¬ 0.0, length: REAL ¬ -1.0, history: HistoryEvent] = {

Sets the dash pattern of the named parts of slice.

parts=NIL => do for all children

outlineParts: OutlineParts ¬ NARROW[parts];

outlineData: OutlineData ¬ NARROW[slice.data];

call GGSliceOps.SetDashed on each child, with history=NIL so the children will not make history list entries. The outline will make one instead.

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetDashed[childList.first, NIL, dashed, pattern, offset, length, NIL];

ENDLOOP

ELSE FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN {

[] ¬ GGSliceOps.SetDashed[list.first.slice, list.first.parts, dashed, pattern, offset, length, NIL];

};

ENDLOOP;

};

GetDashed: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [dashed: BOOL ¬ FALSE, pattern: SequenceOfReal, offset, length: REAL ¬ 0.0, isUnique: BOOL ¬ TRUE] = {

found: BOOL ¬ FALSE;

DoCheckDashes: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisDashed: BOOL ¬ FALSE;

thisPattern: SequenceOfReal;

thisOffset, thisLength: REAL;

[thisDashed, thisPattern, thisOffset, thisLength, thisIsUnique] ¬ GGSliceOps.GetDashed[child, childParts];

IF NOT thisIsUnique THEN {

dashed ¬ thisDashed; pattern ¬ thisPattern; offset ¬ thisOffset; length ¬ thisLength;

RETURN[TRUE];

}

ELSE {

IF found THEN {

thisDashed # dashed OR (thisDashed AND

(thisOffset # offset OR

thisLength # length OR

NOT GGUtility.EquivalentPatterns[thisPattern, pattern]))

THEN RETURN[TRUE];

}

ELSE {

found ¬ TRUE;

dashed ¬ thisDashed;

pattern ¬ thisPattern;

offset ¬ thisOffset;

length ¬ thisLength;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckDashes] AND found;

};

SetOrientation: PUBLIC PROC [slice: Slice, parts: SliceParts, orientation: Orientation, history: HistoryEvent] RETURNS [success: BOOL ¬ FALSE] = {

outlineData: OutlineData ¬ NARROW[slice.data];

outlineParts: OutlineParts ¬ NARROW[parts];

IF parts = NIL THEN FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

[] ¬ GGSliceOps.SetOrientation[childList.first, NIL, orientation, NIL];

ENDLOOP

ELSE FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL THEN {

[] ¬ GGSliceOps.SetOrientation[list.first.slice, list.first.parts, orientation, NIL];

};

ENDLOOP;

};

GetOrientation: PUBLIC PROC [slice: Slice, parts: SliceParts] RETURNS [orientation: Orientation ¬ ccw, isUnique: BOOL ¬ TRUE] = {

Define the orientation of an outline to be the orientation of its first child.

outlineData: OutlineData ¬ NARROW[slice.data];

found: BOOL ¬ FALSE;

DoCheckOrientation: PROC [child: Slice, childParts: SliceParts] RETURNS [done: BOOL ¬ FALSE] = {

thisIsUnique: BOOL ¬ TRUE;

thisOrient: Orientation;

[thisOrient, thisIsUnique] ¬ GGSliceOps.GetOrientation[child, childParts];

IF NOT thisIsUnique THEN {

orientation ¬ thisOrient;

RETURN[TRUE];

}

ELSE {

IF found THEN {

IF thisOrient # orientation THEN RETURN[TRUE];

}

ELSE {

orientation ¬ thisOrient;

found ¬ TRUE;

};

isUnique ¬ NOT WalkIncludedParts[slice, parts, first, DoCheckOrientation] AND found;

};

Outline Utility operations.

CreateOutline: PUBLIC PROC [child: Slice, fillColor: Imager.Color] RETURNS [parent: Slice] = {

data: OutlineData ¬ NEW[OutlineDataObj ¬ [oddWrap: TRUE, fillColor: fillColor, children: LIST[child]] ];

parent ¬ NEW[SliceObj ¬ [

data: data,

selectedInFull: [FALSE, FALSE, FALSE],

tightBox: GGBoundBox.NullBoundBox[],

boundBox: GGBoundBox.NullBoundBox[],

boxValid: FALSE]];

parent.nullDescriptor ¬ GGSlice.DescriptorFromParts[parent, NIL];

child.parent ¬ parent;

IF GGSliceOps.GetType[child]=$Traj THEN {

trajData: TrajData ¬ NARROW[child.data];

IF trajData.role=hole THEN trajData.role ¬ fence;

};

AddChild: PUBLIC PROC [outline: Slice, child: Slice] RETURNS [holier: Slice] = {

Should check for duplicates. -- Bier, February 20

holyData: OutlineData;

IF GGSliceOps.GetType[outline]#$Outline THEN ERROR;

holier ¬ GGSliceOps.Copy[outline].first; -- copy the outline

holyData ¬ NARROW[holier.data]; -- get the copy's children list

holyData.children ¬ GGUtility.AppendSliceList[holyData.children, LIST[child]]; -- and append the new hole

child.parent ¬ holier; -- make the new hole's parent the new copy

IF GGSliceOps.GetType[child]=$Traj THEN GGTraj.SetTrajRole[child, hole];

GGSlice.KillBoundBox[holier];

};

ReplaceFirstChild: PUBLIC PROC [outline: Slice, newChild: Slice] RETURNS [newOutline: Slice] = {

IF newChild = NIL, this routine removes the first child.

isClosed: BOOL ¬ FALSE;

holeList: LIST OF Slice ¬ GGOutline.ListHoles[outline]; -- all but the first child

newData: OutlineData;

newFirstChild: Slice;

IF GGSliceOps.GetType[outline]#$Outline THEN ERROR;

IF newChild#NIL THEN newFirstChild ¬ newChild

ELSE {

IF holeList = NIL THEN newFirstChild ¬ NIL

ELSE {

newFirstChild ¬ holeList.first;

holeList ¬ holeList.rest;

};

IF newFirstChild=NIL THEN RETURN[NIL];

isClosed ¬ GGSliceOps.GetType[newFirstChild]#$Traj OR NARROW[newFirstChild.data, TrajData].role#open;

IF NOT isClosed THEN ERROR;

newOutline ¬ GGOutline.CreateOutline[newFirstChild, GGSliceOps.GetFillColor[outline, NIL].color];

newData ¬ NARROW[newOutline.data];

FOR list: LIST OF Slice ¬ holeList, list.rest UNTIL list = NIL DO

hole: Slice ¬ list.first;

newSlice: Slice ¬ GGSliceOps.Copy[hole].first; -- Copy should keep role=hole if Traj

newData.children ¬ GGUtility.AppendSliceList[newData.children, LIST[newSlice]];

newSlice.parent ¬ newOutline;

ENDLOOP;

GGSlice.KillBoundBox[newOutline];

};

ReplaceChild: PUBLIC PROC [outline: Slice, oldChild, newChild: Slice] RETURNS [newOutline: Slice] = {

oldChild=NIL => RETURN[outline]

newChild=NIL => delete oldChild

newSlice: Slice;

newData: OutlineData;

holeList: LIST OF Slice;

oldData: OutlineData ¬ NARROW[outline.data];

IF GGSliceOps.GetType[outline]#$Outline THEN ERROR;

IF oldChild=NIL THEN RETURN [outline];

IF oldChild=oldData.children.first THEN RETURN [ReplaceFirstChild[outline, newChild]];

newSlice ¬ GGSliceOps.Copy[oldData.children.first].first;

newOutline ¬ GGOutline.CreateOutline[newSlice, oldData.fillColor];

newData ¬ NARROW[newOutline.data];

holeList ¬ GGOutline.ListHoles[outline]; -- all but the first child

FOR list: LIST OF Slice ¬ holeList, list.rest UNTIL list = NIL DO

hole: Slice ¬ list.first;

IF hole=oldChild AND newChild#NIL THEN { -- replace a matching child unless newChild=NIL

newSlice ¬ GGSliceOps.Copy[newChild].first;

newData.children ¬ GGUtility.AppendSliceList[newData.children, LIST[newSlice]];

newSlice.parent ¬ newOutline;

}

ELSE IF hole#oldChild THEN { -- copy any hole that does not match

newSlice ¬ GGSliceOps.Copy[hole].first;

newData.children ¬ GGUtility.AppendSliceList[newData.children, LIST[newSlice]];

newSlice.parent ¬ newOutline;

};

ENDLOOP;

GGSlice.KillBoundBox[newOutline];

};

ReplaceRunsInOutline: PUBLIC PROC [outlineD: SliceDescriptor, runProc: RunProc, segmentsOnly: BOOL ¬ TRUE, selectNewRuns: BOOL ¬ FALSE] RETURNS [newOutline: Slice ¬ NIL] = {

outlineD is a summary of the active bits of this outline that are set. We proceed as follows:

1) Find the first active run of outlineD.

2) Replace it with the desired new run to create a new trajectory and a new outline.

3) Extract a new outlineD from the active bits of the result.

4) If outlineD is empty, we are done. Otherwise return to step 1.

If newOutline is NIL at the end, no replaces were done.

WHILE outlineD # NIL AND NOT GGSliceOps.IsEmptyParts[outlineD] DO

thisChildD: SliceDescriptor ¬ GGParent.FirstIncludedChild[outlineD.slice, outlineD.parts, first];

SELECT GGSliceOps.GetType[thisChildD.slice] FROM

$Traj => {

newOutline ¬

GGTraj.ReplaceFirstRun[thisChildD, runProc, segmentsOnly, selectNewRuns];

IF newOutline = NIL THEN outlineD ¬ NIL

ELSE {

parts: SliceParts ¬ GGSliceOps.RemakeSelections[newOutline, active]; -- yuk

outlineD ¬ IF parts = NIL THEN NIL ELSE GGSlice.DescriptorFromParts[newOutline, parts];

};

ENDCASE => { -- $Box or $Circle. Clear its active bits and ignore it.

parts: SliceParts; -- yuk

GGSliceOps.SaveSelections[thisChildD.slice, NIL, active];

parts ¬ GGSliceOps.RemakeSelections[thisChildD.slice, active];

outlineD ¬ IF parts = NIL THEN NIL ELSE GGSlice.DescriptorFromParts[thisChildD.slice, parts];

};

ENDLOOP;

};

SetWrapRule: PUBLIC PROC [outline: Slice, oddWrap: BOOL] = {

NARROW[outline.data, OutlineData].oddWrap ¬ oddWrap;

};

GetWrapRule: PUBLIC PROC [outline: Slice] RETURNS [oddWrap: BOOL] = {

RETURN[NARROW[outline.data, OutlineData].oddWrap];

};

SetFillText: PUBLIC PROC [slice: Slice, node: TextNode.Ref, screenStyle: BOOL ¬ FALSE, history: HistoryEvent] = {

IF GGSliceOps.GetType[slice]#$Outline THEN ERROR -- debug check

ELSE {

PutTextInBox: PROC [thisChild: Slice] RETURNS [done: BOOL ¬ FALSE] = {

First call: previousChild=NIL, resumeLoc=FirstChild[node]

Rest calls: previousChild#NIL

IF previousChild#NIL THEN {

siblingNodes ¬ GGSlice.GetBoxNodes[previousChild];

resumeLoc ¬ siblingNodes.resume;

};

GGSlice.SetBoxText[thisChild, resumeLoc, screenStyle, history];

previousChild ¬ thisChild;

};

siblingNodes: TiogaImager.FormattedNodes;

resumeLoc: TextNode.Location ¬ [NIL, 0];

previousChild: Slice ¬ NIL;

IF GGParent.FirstChild[slice, first, $Box] # NIL THEN {

outlineData: OutlineData ¬ NARROW[slice.data];

outlineData.fillText ¬ node; -- complete document to outline (parent)

outlineData.screenStyle ¬ screenStyle;

initialize resumeLoc for first call of PutTextInBox

resumeLoc.node ¬ TextNode.FirstChild[node]; -- Remove root node for first child

[] ¬ GGParent.WalkChildren[slice, first, PutTextInBox, $Box];

};

DescriptorFromChildDescriptor: PUBLIC PROC [slice: Slice, childD: SliceDescriptor] RETURNS [sliceD: SliceDescriptor] = {

outlineData: OutlineData ¬ NARROW[slice.data];

outlineChildren: LIST OF Slice ¬ outlineData.children;

ptr: LIST OF SliceDescriptor;

newParts: OutlineParts ¬ NEW[OutlinePartsObj];

[newParts.descriptors, ptr] ¬ GGUtility.StartSliceDescriptorList[];

FOR children: LIST OF Slice ¬ outlineChildren, children.rest UNTIL children=NIL DO

[newParts.descriptors, ptr] ¬ GGUtility.AddSliceDescriptor[IF children.first=childD.slice THEN childD ELSE NIL, newParts.descriptors, ptr];

ENDLOOP;

sliceD ¬ GGSlice.DescriptorFromParts[slice, newParts];

};

DescriptorFromChild: PUBLIC PROC [slice: Slice, child: Slice] RETURNS [sliceD: SliceDescriptor] = {

childD: SliceDescriptor ¬ GGSliceOps.NewParts[child, NIL, slice];

sliceD ¬ DescriptorFromChildDescriptor[slice, childD];

};

TopLevelDescriptorFromChildDescriptor: PUBLIC PROC [childD: SliceDescriptor] RETURNS [ancestorD: SliceDescriptor] = {

IF GGScene.IsTopLevel[childD.slice] THEN RETURN[childD] ELSE RETURN [TopLevelDescriptorFromChildDescriptor[GGParent.DescriptorFromChildDescriptor[GGParent.GetParent[childD.slice], childD]]];

};

ChildDescriptorFromDescriptor: PUBLIC PROC [sliceD: SliceDescriptor, child: Slice] RETURNS [childD: SliceDescriptor] = {

outlineParts: OutlineParts ¬ NARROW[sliceD.parts];

IF child=NIL THEN RETURN[NIL];

IF outlineParts=NIL THEN RETURN[GGSlice.DescriptorFromParts[child, NIL]];

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list=NIL DO

IF list.first#NIL AND list.first.slice=child THEN RETURN[list.first];

ENDLOOP;

RETURN[NIL];

};

RemoveTraj: PUBLIC PROC [sliceD: SliceDescriptor, traj: Slice] RETURNS [newD: SliceDescriptor] = {

sliceD.slice is a cluster. For each child, if its descriptor contains traj, remove traj from the descriptor. Otherwise leave the descriptor alone. Build a new cluster descriptor from the results.

SELECT GGSliceOps.GetType[sliceD.slice] FROM

$Cluster => {

outlineParts: OutlineParts ¬ NARROW[sliceD.parts];

newChildD: SliceDescriptor;

newParts: OutlineParts;

newChildDList, ptr: LIST OF SliceDescriptor;

[newChildDList, ptr] ¬ GGUtility.StartSliceDescriptorList[];

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list=NIL DO

newChildD ¬ IF list.first = NIL THEN NIL

ELSE RemoveTraj[list.first, traj];

[newChildDList, ptr] ¬ GGUtility.AddSliceDescriptor[newChildD, newChildDList, ptr];

ENDLOOP;

newParts ¬ NEW[OutlinePartsObj ¬ [newChildDList]];

newD ¬ GGSlice.DescriptorFromParts[sliceD.slice, newParts];

};

$Outline => {

newD ¬ OutlineRemoveTraj[sliceD, traj];

};

ENDCASE => {

newD ¬ sliceD;

};

OutlineRemoveTraj: PROC [outlineD: SliceDescriptor, traj: Traj] RETURNS [newD: SliceDescriptor] = {

Used by GGSelect to do a DeselectTraj.

outlineParts: OutlineParts ¬ NARROW[outlineD.parts];

seq: SliceDescriptor;

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first#NIL AND list.first.slice = traj THEN {

seq ¬ list.first;

GOTO Done;

};

REPEAT

Done => {

newSeqs: LIST OF SliceDescriptor ¬ GGUtility.SequenceSubst[new: NIL, old: seq, expr: outlineParts.descriptors];

newParts: SliceParts ¬ NEW[OutlinePartsObj ¬ [newSeqs]];

newD ¬ GGSlice.DescriptorFromParts[outlineD.slice, newParts];

};

FINISHED => newD ¬ outlineD;

ENDLOOP;

};

DeleteControlPoints: PUBLIC PROC [outlineD: SliceDescriptor, scene: Scene] RETURNS [bBox: BoundBox] = {

DoDelete: PROC [nextPartsD: SliceDescriptor] RETURNS [done: BOOL ¬ FALSE] = {

GGBoundBox.EnlargeByBox[bBox, GGTraj.DeleteControlPoints[nextPartsD, scene]];

};

bBox ¬ GGBoundBox.NullBoundBox[]; -- start with empty refresh box, and increase size

[] ¬ GGParent.WalkIncludedChildren[outlineD.slice, outlineD.parts, leaf, DoDelete, $Traj];

};

SaveSelectionsInOutlineAllClasses: PUBLIC PROC [outline: Slice] = {

This routine could simply call GGSliceOps.SaveSelections for each selection class. It is slightly more optimized for the common case.

SaveSelectionsAux: PROC [selectClass: SelectionClass] = {

outlineD: SliceDescriptor ¬ GGSelect.FindSelectedSlice[outline, selectClass];

IF outlineD#NIL THEN {

DoSaveSelections: PROC [nextPart: SliceDescriptor] RETURNS [done: BOOL ¬ FALSE] = {

GGSliceOps.SaveSelections[nextPart.slice, nextPart.parts, selectClass];

};

[] ¬ GGParent.WalkIncludedChildren[outlineD.slice, outlineD.parts, first, DoSaveSelections];

};

outlineData: OutlineData ¬ NARROW[outline.data];

children: LIST OF Slice ¬ outlineData.children;

FOR nextChildren: LIST OF Slice ¬ children, nextChildren.rest UNTIL nextChildren=NIL DO

nextChild: Slice ¬ nextChildren.first; -- clear every selection bit in every child

GGSliceOps.SaveSelections[nextChild, NIL, normal]; -- clear

GGSliceOps.SaveSelections[nextChild, NIL, hot]; -- clear

GGSliceOps.SaveSelections[nextChild, NIL, active]; -- clear

GGSliceOps.SaveSelections[nextChild, NIL, match]; -- clear

ENDLOOP;

Now save the appropriate bits in the selected children.

SaveSelectionsAux[normal];

SaveSelectionsAux[hot];

SaveSelectionsAux[active];

SaveSelectionsAux[match];

};

UnpackHitData: PUBLIC PROC [hitData: REF ANY] RETURNS [child: Slice, hitType: TrajPartType ¬ none, segNum, cpNum, jointNum: INT ¬ -999, hitPoint: Point] = {

This will go away when the Caret machinery is revised.

hitType, segNum, cpNum, jointNum, hitPoint only valid if GetType[child] is Traj

outlineHitData: OutlineHitData ¬ NARROW[hitData];

child ¬ outlineHitData.child;

IF GGSliceOps.GetType[child]=$Traj THEN [hitType, segNum, cpNum, jointNum, hitPoint] ¬ GGTraj.UnpackHitData[outlineHitData.childHitData];

};

UnpackOneSegmentDescriptor: PUBLIC PROC [outlineD: SliceDescriptor] RETURNS [childDescriptor: SliceDescriptor, segNum: NAT ¬ 999] = {

outlineD describes a single segment. Return the segNum.

outlineParts: OutlineParts;

IF outlineD=NIL OR GGSliceOps.GetType[outlineD.slice]#$Outline THEN RETURN[NIL, 999];

outlineParts ¬ NARROW[outlineD.parts];

FOR descriptors: LIST OF SliceDescriptor ¬ outlineParts.descriptors, descriptors.rest UNTIL descriptors = NIL DO

IF descriptors.first#NIL THEN {

childDescriptor ¬ descriptors.first;

IF GGSliceOps.GetType[childDescriptor.slice]=$Traj THEN segNum ¬ GGSequence.UnpackOneSegmentSequence[NARROW[childDescriptor.parts]];

RETURN;

};

ENDLOOP;

};

UnpackSimpleDescriptor: PUBLIC PROC [outlineD: SliceDescriptor] RETURNS [success: BOOL ¬ FALSE, hitType: TrajPartType ¬ none, childDescriptor: SliceDescriptor ¬ NIL, joint: Joint ¬ NIL, jointNum: NAT ¬ 999, cp: Point ¬ [0,0], cpNum: NAT ¬ 999, seg: Segment ¬ NIL, segNum: NAT ¬ 999] = {

outlineParts: OutlineParts;

IF outlineD=NIL OR GGSliceOps.GetType[outlineD.slice]#$Outline THEN RETURN;

outlineParts ¬ NARROW[outlineD.parts];

FOR descriptors: LIST OF SliceDescriptor ¬ outlineParts.descriptors, descriptors.rest UNTIL descriptors = NIL DO

IF descriptors.first#NIL THEN {

success ¬ TRUE; -- questionable if child is not a Traj

childDescriptor ¬ descriptors.first;

IF GGSliceOps.GetType[childDescriptor.slice]=$Traj THEN

[success, hitType, ----, joint, jointNum, cp, cpNum, seg, segNum] ¬ GGSequence.UnpackSimpleSequence[childDescriptor.slice, childDescriptor.parts];

RETURN;

};

ENDLOOP;

};

Queries about Outlines

FindTrajShapeInOutline: PUBLIC PROC [traj: Slice, outline: Slice] RETURNS [oldTrajs: LIST OF Slice] = {

Looks through the children of outline to see if any of the shapes match, control point for control point and coordinate for the coordinate, the traj entry. If so, return all such trajectories that match.

outlineData: OutlineData ¬ NARROW[outline.data];

tail: LIST OF Slice;

MatchTraj: PROC [oldTraj: Slice] RETURNS [done: BOOL ¬ FALSE] = {

IF GGTraj.MatchShape[traj, oldTraj] THEN [oldTrajs, tail] ¬ GGUtility.AddSlice[oldTraj, oldTrajs, tail];

};

[] ¬ GGParent.WalkChildren[outline, first, MatchTraj, $Traj];

};

TrajsInOutline: PUBLIC PROC [outline: Slice] RETURNS [trajGen: SliceGenerator] = {

Generates only the trajectory parts of the outline

outlineData: OutlineData ¬ NARROW[outline.data];

partsList: LIST OF Slice ¬ TrajectoriesOfOutline[outline];

trajGen ¬ NEW[SliceGeneratorObj ¬ [partsList]];

};

TrajectoriesOfOutline: PUBLIC PROC [outline: Slice] RETURNS [trajs: LIST OF Slice ¬ NIL] = {

Like TrajsInOutline but returns a list (used by MatchTool).

outlineData: OutlineData ¬ NARROW[outline.data];

ptr: LIST OF Slice;

IF NOT GGSliceOps.GetType[outline]=$Outline THEN RETURN;

[trajs, ptr] ¬ GGUtility.StartSliceList[];

FOR list: LIST OF Slice ¬ outlineData.children, list.rest UNTIL list = NIL DO

IF GGSliceOps.GetType[list.first]=$Traj THEN [trajs, ptr] ¬ GGUtility.AddSlice[list.first, trajs, ptr];

ENDLOOP;

};

ListHoles: PUBLIC PROC [outline: Slice] RETURNS [holesList: LIST OF Slice] = {

data: OutlineData ¬ NARROW[outline.data];

N.B.: the type check is to prevent erroneous reporting that Cluster types have holes, because if this proc is called with a Slice of class=$Cluster the NARROW will succeed.

IF GGSliceOps.GetType[outline]=$Outline THEN holesList ¬ data.children.rest;

};

HasHoles: PUBLIC PROC [outline: Slice] RETURNS [BOOL ¬ FALSE] = {

data: OutlineData ¬ NARROW[outline.data];

N.B.: the type check is to prevent erroneous reporting that Cluster types have holes, because if this proc is called with a Slice of class=$Cluster the NARROW will succeed.

RETURN[GGSliceOps.GetType[outline]=$Outline AND data.children.rest#NIL];

};

The Parent Meta-Class

Parent Meta-Class Utility operations.

Parts: PUBLIC PROC [outlineD: SliceDescriptor] RETURNS [partsGen: SliceDescriptorGenerator] = {

partsGen ¬ Parts2[outlineD.slice, outlineD.parts];

};

PartsList: PUBLIC PROC [sliceD: SliceDescriptor] RETURNS [partsList: LIST OF SliceDescriptor] = {

outlineParts: OutlineParts ¬ NARROW[sliceD.parts];

ptr: LIST OF SliceDescriptor;

[partsList, ptr] ¬ GGUtility.StartSliceDescriptorList[];

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first # NIL THEN [partsList, ptr] ¬ GGUtility.AddSliceDescriptor[list.first, partsList, ptr];

ENDLOOP;

};

Parts2: PUBLIC PROC [outline: Slice, parts: SliceParts] RETURNS [partsGen: SliceDescriptorGenerator] = {

partsGen ¬ NEW[SliceDescriptorGeneratorObj ¬ [] ];

IF parts=NIL THEN RETURN -- empty parts

ELSE {

outlineParts: OutlineParts ¬ NARROW[parts];

partsList, ptr: LIST OF SliceDescriptor;

[partsList, ptr] ¬ GGUtility.StartSliceDescriptorList[];

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

IF list.first # NIL THEN [partsList, ptr] ¬ GGUtility.AddSliceDescriptor[list.first, partsList, ptr];

ENDLOOP;

partsGen.list ¬ partsList;

};

Children: PUBLIC PROC [outline: Slice] RETURNS [children: SliceGenerator] = {

data: OutlineData ¬ NARROW[outline.data];

children ¬ NEW[SliceGeneratorObj ¬ [

list: data.children

]];

};

ChildList: PUBLIC PROC [outline: Slice] RETURNS [childList: LIST OF Slice] = {

data: OutlineData ¬ NARROW[outline.data];

childList ¬ data.children;

};

WalkChildren: PUBLIC PROC [parent: Slice, level: WalkLevel, walkProc: SliceWalkProc ¬ NIL, classType: ATOM ¬ NIL] RETURNS [aborted: BOOL ¬ FALSE] = {

Built-in classes include: $Cluster, $Outline, $Traj, $Box, $Circle, $Text, and $IP. This routine finds all such slices, even within clusters. class=NIL => all classes. Use level=all to walk every slice of a given class.

IF GGParent.IsParent[parent] THEN {

outlineData: OutlineData ¬ NARROW[parent.data];

FOR slices: LIST OF Slice ¬ outlineData.children, slices.rest UNTIL slices = NIL DO

thisType: ATOM ¬ GGSliceOps.GetType[slices.first];

Top level classes

IF (level # leaf OR GGParent.IsLeafOfClass[slices.first, classType]) AND (classType = NIL OR thisType = classType) THEN {

aborted ¬ walkProc[slices.first];

IF aborted THEN RETURN;

};

Depth first walk

IF (level = all OR level = leaf OR (level = highest AND thisType # classType)) AND GGParent.IsParent[slices.first] THEN {

aborted ¬ GGParent.WalkChildren[slices.first, level, walkProc, classType];

IF aborted THEN RETURN;

};

ENDLOOP;

};

WalkIncludedChildren: PUBLIC PROC [parent: Slice, parts: SliceParts, level: WalkLevel, walkProc: SliceDescriptorWalkProc, classType: ATOM ¬ NIL] RETURNS [aborted: BOOL ¬ FALSE] = {

type: ATOM ¬ GGSliceOps.GetType[parent];

IF GGParent.IsParentType[type] THEN {

outlineParts: OutlineParts ¬ NARROW[parts];

IF outlineParts = NIL THEN RETURN;

FOR childDList: LIST OF SliceDescriptor ¬ outlineParts.descriptors, childDList.rest UNTIL childDList = NIL DO

thisChildD: SliceDescriptor ¬ childDList.first;

IF thisChildD # NIL AND NOT GGSliceOps.IsEmptyParts[thisChildD] THEN {

thisType: ATOM ¬ GGSliceOps.GetType[thisChildD.slice];

Depth first walk: First walk yourself ...

IF (level # leaf OR GGParent.IsLeafOfClass[thisChildD.slice, classType]) AND (classType = NIL OR GGSliceOps.GetType[thisChildD.slice] = classType) THEN {

aborted ¬ walkProc[thisChildD];

IF aborted THEN RETURN;

};

... then walk your children.

IF (level = all OR level = leaf OR (level = highest AND thisType # classType)) AND GGParent.IsParent[thisChildD.slice] THEN {

aborted ¬ WalkIncludedChildren[thisChildD.slice, thisChildD.parts, level, walkProc, classType];

IF aborted THEN RETURN;

};

ENDLOOP;

};

WalkIncludedParts: PROC [parent: Slice, parts: SliceParts, level: WalkLevel, walkProc: SlicePartsWalkProc, classType: ATOM ¬ NIL] RETURNS [aborted: BOOL ¬ FALSE] = {

type: ATOM ¬ GGSliceOps.GetType[parent];

IF GGParent.IsParentType[type] THEN {

IF parts = NIL THEN {

outlineData: OutlineData ¬ NARROW[parent.data];

FOR childList: LIST OF Slice ¬ outlineData.children, childList.rest UNTIL childList = NIL DO

thisChild: Slice ¬ childList.first;

thisType: ATOM ¬ GGSliceOps.GetType[thisChild];

Depth first walk: First walk yourself ...

IF (level # leaf OR GGParent.IsLeafOfClass[thisChild, classType]) AND (classType = NIL OR GGSliceOps.GetType[thisChild] = classType) THEN {

aborted ¬ walkProc[thisChild, NIL];

IF aborted THEN RETURN;

};

... then walk your children.

IF (level = all OR level = leaf OR (level = highest AND thisType # classType)) AND GGParent.IsParent[thisChild] THEN {

aborted ¬ WalkIncludedParts[thisChild, NIL, level, walkProc, classType];

IF aborted THEN RETURN;

};

ENDLOOP;

}

ELSE {

outlineParts: OutlineParts ¬ NARROW[parts];

IF outlineParts = NIL THEN RETURN;

FOR childDList: LIST OF SliceDescriptor ¬ outlineParts.descriptors, childDList.rest UNTIL childDList = NIL DO

thisChildD: SliceDescriptor ¬ childDList.first;

IF thisChildD # NIL AND NOT GGSliceOps.IsEmptyParts[thisChildD] THEN {

thisType: ATOM ¬ GGSliceOps.GetType[thisChildD.slice];

Depth first walk: First walk yourself ...

IF (level # leaf OR GGParent.IsLeafOfClass[thisChildD.slice, classType]) AND (classType = NIL OR GGSliceOps.GetType[thisChildD.slice] = classType) THEN {

aborted ¬ walkProc[thisChildD.slice, thisChildD.parts];

IF aborted THEN RETURN;

};

... then walk your children.

IF (level = all OR level = leaf OR (level = highest AND thisType # classType)) AND GGParent.IsParent[thisChildD.slice] THEN {

aborted ¬ WalkIncludedParts[thisChildD.slice, thisChildD.parts, level, walkProc, classType];

IF aborted THEN RETURN;

};

ENDLOOP;

};

ListChildren: PUBLIC PROC [parent: Slice, level: WalkLevel, classType: ATOM ¬ NIL] RETURNS [sliceList: LIST OF Slice] = {

ptr: LIST OF Slice;

DoAppendSlice: PROC [slice: Slice] RETURNS [done: BOOL ¬ FALSE] = {

[sliceList, ptr] ¬ GGUtility.AddSlice[slice, sliceList, ptr];

};

[sliceList, ptr] ¬ GGUtility.StartSliceList[];

[] ¬ WalkChildren[parent, level, DoAppendSlice, classType];

};

ListIncludedChildren: PUBLIC PROC [parent: Slice, parts: SliceParts, level: WalkLevel, classType: ATOM ¬ NIL] RETURNS [selectedList: LIST OF SliceDescriptor] = {

ptr: LIST OF SliceDescriptor;

DoAppendSlice: PROC [childD: SliceDescriptor] RETURNS [done: BOOL ¬ FALSE] = {

[selectedList, ptr] ¬ GGUtility.AddSliceDescriptor[childD, selectedList, ptr];

};

[selectedList, ptr] ¬ GGUtility.StartSliceDescriptorList[];

[] ¬ WalkIncludedChildren[parent, parts, level, DoAppendSlice, classType];

};

FirstChild: PUBLIC PROC [parent: Slice, level: WalkLevel, classType: ATOM ¬ NIL] RETURNS [firstChild: Slice] = {

StopAtFirstSlice: PROC [slice: Slice] RETURNS [done: BOOL ¬ FALSE] = {

firstChild ¬ slice;

RETURN[TRUE];

};

[] ¬ WalkChildren[parent, level, StopAtFirstSlice, classType];

};

FirstIncludedChild: PUBLIC PROC [parent: Slice, parts: SliceParts, level: WalkLevel, classType: ATOM ¬ NIL] RETURNS [childD: SliceDescriptor] = {

StopAtFirstSlice: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ¬ FALSE] = {

childD ¬ sliceD;

RETURN[TRUE];

};

[] ¬ WalkIncludedChildren[parent, parts, level, StopAtFirstSlice, classType];

};

TallyChildren: PUBLIC PROC [parent: Slice, tallyProc: SliceTallyProc] RETURNS [tallyD: SliceDescriptor, aborted: BOOL ¬ FALSE] = {

Walk through the children (and, if requested recursively through the children's children, etc.) building up a descriptor of all parts of parent that meet the criterion defined by the tallyProc.

visitChildren, keep, done, keepFound: BOOL ¬ FALSE;

[visitChildren, keep, done] ¬ tallyProc[parent];

IF GGParent.IsParent[parent] AND visitChildren THEN {

outlineData: OutlineData ¬ NARROW[parent.data];

ptr: LIST OF SliceDescriptor;

newParts: OutlineParts ¬ NEW[OutlinePartsObj];

[newParts.descriptors, ptr] ¬ GGUtility.StartSliceDescriptorList[];

FOR list: LIST OF Slice ¬ outlineData.children, list.rest UNTIL list = NIL DO

thisD: SliceDescriptor;

IF NOT aborted THEN {

[thisD, aborted] ¬ TallyChildren[list.first, tallyProc];

IF thisD # NIL THEN keepFound ¬ TRUE;

}

ELSE thisD ¬ NIL;

[newParts.descriptors, ptr] ¬ GGUtility.AddSliceDescriptor[thisD, newParts.descriptors, ptr];

ENDLOOP;

IF keepFound THEN tallyD ¬ GGSlice.DescriptorFromParts[parent, newParts]

ELSE tallyD ¬ NIL;

}

ELSE {

IF keep THEN tallyD ¬ GGSliceOps.NewParts[parent, NIL, slice]

ELSE tallyD ¬ NIL;

aborted ¬ done;

};

TallyIncludedChildren: PUBLIC PROC [parent: Slice, parts: SliceParts, tallyProc: SliceDescriptorTallyProc] RETURNS [tallyD: SliceDescriptor, aborted: BOOL ¬ FALSE] = {

Walk through the children (and, if requested recursively through the children's children, etc.) building up a descriptor of all parts of parent that meet the criterion defined by the tallyProc.

visitChildren, done, keepFound: BOOL ¬ FALSE;

keepD: SliceDescriptor;

parentD: SliceDescriptor ¬ GGSlice.DescriptorFromParts[parent, parts];

[visitChildren, keepD, done] ¬ tallyProc[parentD];

IF GGParent.IsParent[parent] AND visitChildren THEN {

outlineParts: OutlineParts ¬ NARROW[parts];

ptr: LIST OF SliceDescriptor;

newParts: OutlineParts ¬ NEW[OutlinePartsObj];

[newParts.descriptors, ptr] ¬ GGUtility.StartSliceDescriptorList[];

FOR list: LIST OF SliceDescriptor ¬ outlineParts.descriptors, list.rest UNTIL list = NIL DO

thisD: SliceDescriptor;

IF NOT aborted THEN {

IF list.first # NIL THEN {

[thisD, aborted] ¬ TallyIncludedChildren[list.first.slice, list.first.parts, tallyProc];

IF thisD # NIL THEN keepFound ¬ TRUE;

};

}

ELSE thisD ¬ NIL;

[newParts.descriptors, ptr] ¬ GGUtility.AddSliceDescriptor[thisD, newParts.descriptors, ptr];

ENDLOOP;

IF keepFound THEN tallyD ¬ GGSlice.DescriptorFromParts[parent, newParts]

ELSE tallyD ¬ NIL;

}

ELSE {

tallyD ¬ keepD;

aborted ¬ done;

};

IsParent: PUBLIC PROC [slice: Slice] RETURNS [BOOL] = {

RETURN[slice.class.type = $Outline OR slice.class.type = $Cluster];

};

IsParentType: PUBLIC PROC [classType: ATOM] RETURNS [BOOL] = {

RETURN[classType = $Outline OR classType = $Cluster];

};

GetParent: PUBLIC PROC [child: Slice] RETURNS [parent: Slice] = {

RETURN[child.parent];

};

GetTopLevelAncestor: PUBLIC PROC [slice: Slice] RETURNS [ancestor: Slice] = {

ancestor ¬ slice;

UNTIL GGScene.IsTopLevel[ancestor] DO ancestor ¬ GGParent.GetParent[ancestor]; ENDLOOP;

};

IsLeafOfClass: PUBLIC PROC [slice: Slice, classType: ATOM ¬ NIL] RETURNS [BOOL] = {

NoteSameClassChild: PROC [slice: Slice] RETURNS [done: BOOL ¬ FALSE] = {

done ¬ TRUE;

};

A slice is a leaf if it is not a Parent slice and class doesn't matter.

IF classType=NIL THEN RETURN [NOT IsParent[slice]];

Return TRUE if a cluster has no cluster child => it is a leaf cluster

IF classType = $Cluster THEN

RETURN[NOT GGParent.WalkChildren[slice, first, NoteSameClassChild, $Cluster]];

Return TRUE if a outline has no outline child => it is a leaf outline

IF classType = $Outline THEN

RETURN[NOT GGParent.WalkChildren[slice, first, NoteSameClassChild, $Outline]];

Return TRUE if any other type matches the class

RETURN[GGSliceOps.GetType[slice] = classType];

};

CreateCluster: PUBLIC PROC [frozen: BOOL ¬ TRUE] RETURNS [parent: Slice] = {

data: OutlineData ¬ NEW[OutlineDataObj ¬ [oddWrap: TRUE, fillColor: NIL, children: NIL, subclassData: NEW[ClusterDataObj ¬ [frozen: frozen]] ] ];

parent ¬ NEW[SliceObj ¬ [

data: data,

selectedInFull: [FALSE, FALSE, FALSE],

tightBox: GGBoundBox.NullBoundBox[],

boundBox: GGBoundBox.NullBoundBox[],

boxValid: FALSE]];

parent.nullDescriptor ¬ GGSlice.DescriptorFromParts[parent, NIL];

};

AddChildToCluster: PUBLIC PROC [parent: Slice, child: Slice, priority: INT] = {

Should check for duplicates.

parentData: OutlineData ¬ NARROW[parent.data];

IF GGSliceOps.GetType[parent]#$Cluster THEN ERROR;

IF child = NIL THEN RETURN;

child.parent ¬ parent;

IF priority = -1 OR GGParent.TopPriority[parent]<priority THEN AppendSlice[parent, child]

ELSE IF priority = 0 THEN {

parentData.ptrValid ¬ FALSE;

parentData.prioritiesValid ¬ FALSE;

parentData.children ¬ CONS[child, parentData.children];

}

ELSE GGParent.PutBehind[parent, GGParent.GetAtPriority[parent, priority], LIST[child]];

GGSlice.KillBoundBox[parent];

};

AddChildrenToCluster: PUBLIC PROC [parent: Slice, children: LIST OF Slice, priority: INT] = {

parentData: OutlineData ¬ NARROW[parent.data];

IF GGSliceOps.GetType[parent]#$Cluster THEN ERROR;

IF children=NIL THEN RETURN;

FOR list: LIST OF Slice ¬ children, list.rest UNTIL list = NIL DO

list.first.parent ¬ parent;

ENDLOOP;

IF priority = -1 OR TopPriority[parent]<priority THEN {

FOR list: LIST OF Slice ¬ children, list.rest UNTIL list = NIL DO

AppendSlice[parent, list.first];

ENDLOOP;

}

ELSE IF priority = 0 THEN {

parentData.ptrValid ¬ FALSE;

parentData.prioritiesValid ¬ FALSE;

parentData.children ¬ GGUtility.AppendSliceList[children, parentData.children];

}

ELSE {

Copy incoming list to avoid mutations by PutBehind

copiedSlices: LIST OF Slice ¬ GGUtility.CopySliceList[children];

GGParent.PutBehind[parent, GGParent.GetAtPriority[parent, priority], copiedSlices];

};

GGSlice.KillBoundBox[parent];

};

RemoveChild: PUBLIC PROC [parent: Slice, child: Slice] RETURNS [newParent: Slice] = {

Disconnects the named child from parent (to which it presumably belongs). Does not affect selections.

parentData: OutlineData ¬ NARROW[parent.data];

parentData.ptrValid ¬ FALSE;

parentData.prioritiesValid ¬ FALSE;

parentData.children ¬ GGUtility.DeleteSliceFromList[child, parentData.children];

GGSlice.KillBoundBox[parent];

newParent ¬ IF parentData.children = NIL THEN NIL ELSE parent;

};

PruneNullClusters: PUBLIC PROC [scene: Scene, cluster: Slice] = {

clusterData: OutlineData ¬ NARROW[cluster.data];

IF GGSliceOps.GetType[cluster]#$Cluster THEN ERROR;

IF clusterData.children = NIL THEN {

parent: Slice ¬ GetParent[cluster];

IF parent = NIL THEN {

GGScene.DeleteSlice[scene, cluster];

}

ELSE {

smallerParent: Slice ¬ RemoveChild[parent, cluster];

IF smallerParent = NIL THEN PruneNullClusters[scene, parent];

};

SetFrozen: PUBLIC PROC [cluster: Slice, frozen: BOOL] = {

parentData: OutlineData ¬ NARROW[cluster.data];

clusterData: ClusterData ¬ NARROW[parentData.subclassData];

clusterData.frozen ¬ frozen;

};

GetFrozen: PUBLIC PROC [cluster: Slice] RETURNS [frozen: BOOL] = {

parentData: OutlineData ¬ NARROW[cluster.data];

clusterData: ClusterData ¬ NARROW[parentData.subclassData];

frozen ¬ clusterData.frozen;

};

AppendSlice: PROC [parent: Slice, slice: Slice] = {

parentData: OutlineData ¬ NARROW[parent.data];

parentData.prioritiesValid ¬ FALSE;

IF NOT parentData.ptrValid THEN UpdatePtr[parentData];

[parentData.children, parentData.ptr] ¬ GGUtility.AddSlice[slice, parentData.children, parentData.ptr];

};

Priority order

TopPriority: PUBLIC PROC [parent: Slice] RETURNS [priority: INT] = {

Returns the priority of the frontmost position in the scene.

parentData: OutlineData ¬ NARROW[parent.data];

IF NOT parentData.prioritiesValid THEN UpdatePriorities[parent];

IF NOT parentData.ptrValid THEN UpdatePtr[parentData];

RETURN[IF parentData.ptr=NIL THEN 0 ELSE parentData.ptr.first.priority];

};

PutInFront: PUBLIC PROC [parent: Slice, child: Slice, slices: LIST OF Slice] = {

Destructively splices slices into scene

parentData: OutlineData ¬ NARROW[parent.data];

IF child#NIL AND slices#NIL THEN {

beforeEnt, ent, afterEnt, slicesRest: LIST OF Slice;

found: BOOL ¬ FALSE;

[beforeEnt, ent, afterEnt, found] ¬ GGUtility.FindSliceAndNeighbors[child, parentData.children];

IF found THEN {

IF ent.first#child THEN ERROR; -- debugging test

parentData.ptrValid ¬ FALSE;

parentData.prioritiesValid ¬ FALSE;

ent.rest ¬ slices; -- ent is really part of scene.entities. Skip over slice and then Splice in new slices.

FOR sList: LIST OF Slice ¬ slices, sList.rest UNTIL sList=NIL DO

slicesRest ¬ sList;

ENDLOOP;

slicesRest.rest ¬ afterEnt;

};

PutBehind: PUBLIC PROC [parent: Slice, child: Slice, slices: LIST OF Slice] = {

Destructively splices slices into scene

parentData: OutlineData ¬ NARROW[parent.data];

IF child#NIL AND slices#NIL THEN {

beforeEnt, ent, afterEnt, slicesRest: LIST OF Slice;

found: BOOL ¬ FALSE;

[beforeEnt, ent, afterEnt, found] ¬ GGUtility.FindSliceAndNeighbors[child, parentData.children];

IF found THEN {

IF ent.first#child THEN ERROR; -- debugging test

parentData.ptrValid ¬ FALSE;

parentData.prioritiesValid ¬ FALSE;

IF beforeEnt#NIL THEN beforeEnt.rest ¬ slices ELSE parentData.children ¬ slices; -- Splice in new slices before the existing slice

FOR sList: LIST OF Slice ¬ slices, sList.rest UNTIL sList=NIL DO

slicesRest ¬ sList;

ENDLOOP;

slicesRest.rest ¬ ent; -- add on the original slice and the remaining entities

};

GetAtPriority: PUBLIC PROC [parent: Slice, priority: INT] RETURNS [slice: Slice] = {

parentData: OutlineData ¬ NARROW[parent.data];

IF priority = -1 THEN { -- special case: frontmost

IF NOT parentData.ptrValid THEN UpdatePtr[parentData];

RETURN[parentData.ptr.first];

}

ELSE IF priority = 0 THEN RETURN[parentData.children.first] -- special case: rear-most

ELSE { -- somewhere in the middle

FOR sliceList: LIST OF Slice ¬ parentData.children.rest, sliceList.rest UNTIL sliceList=NIL DO

IF count=priority THEN RETURN[sliceList.first];

count ¬ count+1;

ENDLOOP;

or off the scale

IF NOT parentData.ptrValid THEN UpdatePtr[parentData];

RETURN[parentData.ptr.first];

};

GetChildPriority: PUBLIC PROC [parent: Slice, child: Slice] RETURNS [priority: INT] = {

parentData: OutlineData ¬ NARROW[parent.data];

If returned priority is 0, the child is the back-most entity.

IF NOT parentData.prioritiesValid THEN UpdatePriorities[parent];

THIS CODE SHOULD POST AN ERROR IF slice is not in scene !!

priority ¬ child.priority;

};

ComparePriorities: PUBLIC PROC [slice1, slice2: Slice] RETURNS [Basics.Comparison] = {

slice1 and slice2 must be descendents of the same parent slice. However, they can be at different levels within the parent slice's tree.

slice1List, slice2List: LIST OF INT;

parent1, parent2, child1, child2: Slice;

compare: Basics.Comparison;

child1 ¬ slice1;

child2 ¬ slice2;

UNTIL GGScene.IsTopLevel[child1] DO

parent1 ¬ GGParent.GetParent[child1];

slice1List ¬ CONS[GGParent.GetChildPriority[parent1, child1], slice1List];

child1 ¬ parent1;

ENDLOOP;

UNTIL GGScene.IsTopLevel[child2] DO

parent2 ¬ GGParent.GetParent[child2];

slice2List ¬ CONS[GGParent.GetChildPriority[parent2, child2], slice2List];

child2 ¬ parent2;

ENDLOOP;

UNTIL slice1List = NIL OR slice2List = NIL DO

compare ¬ Basics.CompareInt[slice1List.first, slice2List.first];

IF compare # equal THEN RETURN[compare];

slice1List ¬ slice1List.rest;

slice2List ¬ slice2List.rest;

ENDLOOP;

RETURN[equal];

};

UpdatePriorities: PROC [parent: Slice] = {

parentData: OutlineData ¬ NARROW[parent.data];

DoUpdate: PROC [child: Slice] RETURNS [done: BOOL ¬ FALSE] = {

child.priority ¬ index;

index ¬ index + 1;

};

index: NAT ¬ 0;

[] ¬ GGParent.WalkChildren[parent, first, DoUpdate];

parentData.prioritiesValid ¬ TRUE;

};

UpdatePtr: PROC [parentData: OutlineData] = {

IF parentData.children=NIL THEN parentData.ptr ¬ NIL ELSE

FOR list: LIST OF Slice ¬ parentData.children, list.rest UNTIL list=NIL DO

parentData.ptr ¬ list;

ENDLOOP;

parentData.ptrValid ¬ TRUE;

};

END.