GGUtilityImplA.mesa
Copyright Ó 1987, 1988, 1989, 1991, 1992 by Xerox Corporation. All rights reserved.
Contents: Created from files GGUtilityImpl.mesa, GGCubic2Impl.mesa, GGContainerImpl.mesa, GGCircleCacheImpl.mesa, GGBuiltInShapesImpl.mesa, GGDescribeImpl.mesa October 12, 1987
Last edited by Bier on October 28, 1987 7:51:27 pm PST.
Bier, July 29, 1992 3:24 pm PDT
Pier, June 18, 1992 3:20 pm PDT
Doug Wyatt, April 16, 1992 5:16 pm PDT
DIRECTORY
Basics, CodeTimer, ColorFns, CubicPaths, Feedback, FunctionCache, GGBasicTypes, GGBoundBox, GGBuiltinShapes, GGCircleCache, GGCircles, GGColorOps, GGContainer, GGCoreOps, GGCoreTypes, GGCubic2, GGDescribe, GGInterfaceTypes, GGModelTypes, GGOutline, GGParseIn, GGParseOut, GGSegment, GGSegmentTypes, GGShapes, GGSlice, GGSliceOps, GGTraj, GGTransform, GGUtility, Icons, Imager, ImagerBackdoor, ImagerBitmapContext, ImagerColor, ImagerSample, ImagerTransformation, IO, NamedColors, Real, RealFns, Rope, Vectors2d;
GGUtilityImplA: CEDAR PROGRAM
IMPORTS CodeTimer, ColorFns, Feedback, FunctionCache, GGBoundBox, GGCircles, GGColorOps, GGCoreOps, GGOutline, GGParseIn, GGParseOut, GGSegment, GGShapes, GGSlice, GGSliceOps, GGTraj, GGTransform, GGUtility, Imager, ImagerBackdoor, ImagerBitmapContext, ImagerColor, ImagerSample, IO, NamedColors, Real, RealFns, Rope, Vectors2d
EXPORTS GGDescribe, GGUtility, GGBuiltinShapes, GGCircleCache = BEGIN
AlignmentPoint: TYPE = GGInterfaceTypes.AlignmentPoint;
Bitmap: TYPE = Imager.SampleMap;
BitVector: TYPE = GGBasicTypes.BitVector;
Cache: TYPE = FunctionCache.Cache;
CachedCircle: TYPE = REF CachedCircleObj;
CachedCircleObj: TYPE = GGCircleCache.CachedCircleObj;
Color: TYPE = Imager.Color;
Context: TYPE = Imager.Context;
DefaultData: TYPE = GGModelTypes.DefaultData;
FeatureData: TYPE = GGModelTypes.FeatureData;
Path: TYPE = CubicPaths.Path;
Point: TYPE = GGBasicTypes.Point;
PointProc: TYPE = CubicPaths.PointProc;
Range: TYPE = FunctionCache.Range;
ROPE: TYPE = Rope.ROPE;
Segment: TYPE = GGSegmentTypes.Segment;
SegmentGenerator: TYPE = GGModelTypes.SegmentGenerator;
Sequence: TYPE = GGModelTypes.Sequence;
SequenceOfReal: TYPE = REF SequenceOfRealObj;
SequenceOfRealObj: TYPE = GGCoreTypes.SequenceOfRealObj;
Slice: TYPE = GGModelTypes.Slice;
SliceDescriptor: TYPE = GGModelTypes.SliceDescriptor;
SliceGenerator: TYPE = GGModelTypes.SliceGenerator;
SliceParts: TYPE = GGModelTypes.SliceParts;
Traj: TYPE = GGModelTypes.Traj;
TrajData: TYPE = GGModelTypes.TrajData;
Vector: TYPE = GGBasicTypes.Vector;
Problem: PUBLIC SIGNAL [msg: Rope.ROPE] = CODE;
EntityNotFound: PUBLIC SIGNAL = CODE;
NotYetImplemented: PUBLIC SIGNAL = CODE;
Templates for List Operations
Two Finger List Construction
StartTypeList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Type] = {
ptr ← entityList ← NIL;
};
AddType: PUBLIC PROC [entity: Type, entityList, ptr: LIST OF Type] RETURNS [newList, newPtr: LIST OF Type] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ← newList ← CONS[entity, NIL];
RETURN;
}
ELSE {
newList ← entityList;
ptr.rest ← CONS[entity, NIL];
newPtr ← ptr.rest;
};
};
AppendTypeList: PUBLIC PROC [list1, list2: LIST OF Type] RETURNS [result: LIST OF Type] = {
pos: LIST OF Type;
newCell: LIST OF Type;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ← CONS[list1.first, NIL];
pos ← result;
FOR l: LIST OF Type ← list1.rest, l.rest UNTIL l = NIL DO
newCell ← CONS[l.first, NIL];
pos.rest ← newCell;
pos ← newCell;
ENDLOOP;
pos.rest ← list2;
};
Destructive Delete
DeleteTypeFromList: PUBLIC PROC [entity: Type, entityList: LIST OF Type] RETURNS [smallerList: LIST OF Type] = {
beforeEnt, ent, afterEnt: LIST OF Type;
found: BOOLFALSE;
[beforeEnt, ent, afterEnt, found] ← FindTypeAndNeighbors[entity, entityList];
IF NOT found THEN RETURN[entityList];
IF beforeEnt = NIL THEN smallerList ← afterEnt
ELSE {
beforeEnt.rest ← afterEnt;
smallerList ← entityList;
};
};
FindTypeAndNeighbors: PROC [entity: Type, entityList: LIST OF Type] RETURNS [beforeEnt, ent, afterEnt: LIST OF Type, found: BOOLFALSE] = {
lastE: LIST OF Type ← NIL;
eList: LIST OF Type ← entityList;
IF eList = NIL THEN RETURN;
UNTIL eList = NIL DO
IF eList.first = entity THEN {
beforeEnt ← lastE;
ent ← eList;
afterEnt ← eList.rest;
found ← TRUE;
RETURN;
};
lastE ← eList;
eList ← eList.rest;
ENDLOOP;
};
Operations on LIST OF FeatureData
StartFeatureDataList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF FeatureData] = {
ptr ¬ entityList ¬ NIL;
};
AddFeatureData: PUBLIC PROC [entity: FeatureData, entityList, ptr: LIST OF FeatureData] RETURNS [newList, newPtr: LIST OF FeatureData] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ¬ newList ¬ CONS[entity, NIL];
RETURN;
}
ELSE {
newList ¬ entityList;
ptr.rest ¬ CONS[entity, NIL];
newPtr ¬ ptr.rest;
};
};
CopyFeatureDataList: PUBLIC PROC [l: LIST OF FeatureData] RETURNS [copyList: LIST OF FeatureData] = {
z: LIST OF FeatureData ¬ NIL;
IF l = NIL THEN RETURN[NIL];
copyList ¬ CONS[l.first, NIL];
z ¬ copyList;
UNTIL (l ¬ l.rest) = NIL DO
z.rest ¬ CONS[l.first, NIL];
z ¬ z.rest;
ENDLOOP;
};
FeatureDataNconc: PUBLIC PROC [l1, l2: LIST OF FeatureData] RETURNS [bigList: LIST OF FeatureData] = {
z: LIST OF FeatureData ¬ l1;
IF z = NIL THEN RETURN[l2];
UNTIL z.rest = NIL DO z ¬ z.rest; ENDLOOP;
z.rest ¬ l2;
RETURN[l1];
};
Operations on LIST OF Sequence
StartSequenceList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF Sequence] = {
ptr ¬ entityList ¬ NIL;
};
AddSequence: PUBLIC PROC [entity: Sequence, entityList, ptr: LIST OF Sequence] RETURNS [newList, newPtr: LIST OF Sequence] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ¬ newList ¬ CONS[entity, NIL];
RETURN;
}
ELSE {
newList ¬ entityList;
ptr.rest ¬ CONS[entity, NIL];
newPtr ¬ ptr.rest;
};
};
AppendSequenceList: PUBLIC PROC [list1, list2: LIST OF Sequence] RETURNS [result: LIST OF Sequence] = {
pos: LIST OF Sequence;
newCell: LIST OF Sequence;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ¬ CONS[list1.first, NIL];
pos ¬ result;
FOR l: LIST OF Sequence ¬ list1.rest, l.rest UNTIL l = NIL DO
newCell ¬ CONS[l.first, NIL];
pos.rest ¬ newCell;
pos ¬ newCell;
ENDLOOP;
pos.rest ¬ list2;
}; -- end of AppendSequenceList
DeleteSequenceFromList: PUBLIC PROC [seq: Sequence, seqList: LIST OF Sequence] RETURNS [smallerList: LIST OF Sequence] = {
beforeEnt, ent, afterEnt: LIST OF Sequence;
found: BOOL ¬ FALSE;
[beforeEnt, ent, afterEnt, found] ¬ FindSequenceAndNeighbors[seq, seqList];
IF NOT found THEN RETURN[seqList];
IF beforeEnt = NIL THEN smallerList ¬ afterEnt
ELSE {
beforeEnt.rest ¬ afterEnt;
smallerList ¬ seqList;
};
}; -- end of DeleteSequenceFromList
FindSequenceAndNeighbors: PROC [entity: Sequence, entityList: LIST OF Sequence] RETURNS [beforeEnt, ent, afterEnt: LIST OF Sequence, found: BOOL ¬ FALSE] = {
lastE: LIST OF Sequence ¬ NIL;
eList: LIST OF Sequence ¬ entityList;
IF eList = NIL THEN ERROR EntityNotFound;
IF eList = NIL THEN RETURN;
UNTIL eList = NIL DO
IF eList.first = entity THEN {
beforeEnt ¬ lastE;
ent ¬ eList;
afterEnt ¬ eList.rest;
found ¬ TRUE;
RETURN;
};
lastE ¬ eList;
eList ¬ eList.rest;
ENDLOOP;
};
Operations on LIST OF SliceDescriptor
StartSliceDescriptorList: PUBLIC PROC [] RETURNS [entityList, ptr: LIST OF SliceDescriptor] = {
ptr ¬ entityList ¬ NIL;
};
AddSliceDescriptor: PUBLIC PROC [entity: SliceDescriptor, entityList, ptr: LIST OF SliceDescriptor] RETURNS [newList, newPtr: LIST OF SliceDescriptor] = {
IF ptr = NIL THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ¬ newList ¬ CONS[entity, NIL];
RETURN;
}
ELSE {
newList ¬ entityList;
ptr.rest ¬ CONS[entity, NIL];
newPtr ¬ ptr.rest;
};
};
AppendSliceDescriptorList: PUBLIC PROC [list1, list2: LIST OF SliceDescriptor] RETURNS [result: LIST OF SliceDescriptor] = {
pos: LIST OF SliceDescriptor;
newCell: LIST OF SliceDescriptor;
Non-destructive (copies the first list).
IF list1 = NIL THEN RETURN[list2];
result ¬ CONS[list1.first, NIL];
pos ¬ result;
FOR l: LIST OF SliceDescriptor ¬ list1.rest, l.rest UNTIL l = NIL DO
newCell ¬ CONS[l.first, NIL];
pos.rest ¬ newCell;
pos ¬ newCell;
ENDLOOP;
pos.rest ¬ list2;
};
DeleteSliceDescriptorFromList: PUBLIC PROC [sliceD: SliceDescriptor, sliceDList: LIST OF SliceDescriptor] RETURNS [smallerList: LIST OF SliceDescriptor] = {
beforeEnt, ent, afterEnt: LIST OF SliceDescriptor;
found: BOOL ¬ FALSE;
[beforeEnt, ent, afterEnt, found] ¬ FindSliceDescriptorAndNeighbors[sliceD, sliceDList];
IF NOT found THEN RETURN[sliceDList];
IF beforeEnt = NIL THEN smallerList ¬ afterEnt
ELSE {
beforeEnt.rest ¬ afterEnt;
smallerList ¬ sliceDList;
};
};
FindSliceDescriptorAndNeighbors: PROC [sliceD: SliceDescriptor, sliceDList: LIST OF SliceDescriptor] RETURNS [beforeEnt, ent, afterEnt: LIST OF SliceDescriptor, found: BOOL ¬ FALSE] = {
lastE: LIST OF SliceDescriptor ¬ NIL;
eList: LIST OF SliceDescriptor ¬ sliceDList;
IF eList = NIL THEN RETURN;
UNTIL eList = NIL DO
IF eList.first = sliceD THEN {
beforeEnt ¬ lastE;
ent ¬ eList;
afterEnt ¬ eList.rest;
found ¬ TRUE;
RETURN;
};
lastE ¬ eList;
eList ¬ eList.rest;
ENDLOOP;
};
CopySliceDescriptorList: PUBLIC PROC [l1: LIST OF SliceDescriptor] RETURNS [val: LIST OF SliceDescriptor] = {
z: LIST OF SliceDescriptor ¬ NIL;
val ¬ NIL;
IF l1 = NIL THEN RETURN[val];
val ¬ CONS[l1.first, val];
z ¬ val;
UNTIL (l1 ¬ l1.rest) = NIL DO
z.rest ¬ CONS[l1.first, z.rest];
z ¬ z.rest;
ENDLOOP;
RETURN[val];
}; -- of Append
Operations on Bit Vectors
AllFalse: PUBLIC PROC [bitvec: BitVector] RETURNS [BOOL] = {
FOR i: NAT IN [0..bitvec.len) DO
IF bitvec[i] = TRUE THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
AllTrue: PUBLIC PROC [bitvec: BitVector] RETURNS [BOOL] = {
FOR i: NAT IN [0..bitvec.len) DO
IF bitvec[i] = FALSE THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
Dash Patterns
CopyPattern: PUBLIC PROC [pattern: SequenceOfReal] RETURNS [new: SequenceOfReal] = {
IF pattern=NIL THEN RETURN[NIL];
new ¬ NEW[SequenceOfRealObj[pattern.len]];
FOR index: NAT IN [0..pattern.len) DO
new[index] ¬ pattern[index];
ENDLOOP;
};
EquivalentPatterns: PUBLIC PROC [p1, p2: SequenceOfReal] RETURNS [BOOL ¬ FALSE] = {
IF p1.len # p2.len THEN RETURN[FALSE];
FOR i: NAT IN [0..p1.len) DO
IF p1[i] # p2[i] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
Colors
GetSpecialColor and TrackPatch moved to GGPortImpl
ConstantColor: TYPE ~ ImagerColor.ConstantColor;
HSVFromColor: PROC [color: ConstantColor] RETURNS [ColorFns.HSV] ~ {
RETURN[ColorFns.HSVFromRGB[ImagerColor.RGBFromColor[
ImagerColor.NarrowToOpConstantColor[color]]]];
};
ChangeHue: PUBLIC PROC [startColor: Color, hueFrom: Color] RETURNS [Color] = {
WITH startColor SELECT FROM
startColor: ConstantColor => WITH hueFrom SELECT FROM
hueFrom: ConstantColor => {
hsv: ColorFns.HSV ¬ HSVFromColor[startColor];
hsv.H ¬ HSVFromColor[hueFrom].H;
RETURN[ImagerColor.ColorFromRGB[ColorFns.RGBFromHSV[hsv]]];
};
ENDCASE;
ENDCASE;
RETURN[startColor];
};
ColorToRope: PUBLIC PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
stream: IO.STREAM;
stream ¬ IO.ROS[];
GGParseOut.WriteColor[stream, color];
rope ¬ IO.RopeFromROS[stream];
};
ColorFromRope: PUBLIC PROC [rope: Rope.ROPE] RETURNS [color: Imager.Color] = {
stream: IO.STREAM;
version: REAL ¬ GGUtility.version;
stream ¬ IO.RIS[rope];
color ¬ GGParseIn.ReadColor[stream, version];
};
ColorToRGBRope: PUBLIC PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
ENABLE Feedback.Problem, Imager.Error => GOTO Abort;
constantColor: Imager.ConstantColor ¬ NARROW[color];
red, green, blue: REAL;
[red,green,blue] ¬ GGCoreOps.ExtractRGB[constantColor];
rope ¬ IO.PutFR["RGB: %1.3f %1.3f %1.3f", [real[red]], [real[green]], [real[blue]] ];
EXITS
Abort => rope ¬ "RGB: none";
};
ColorToCMYKRope: PUBLIC PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
ENABLE Feedback.Problem, Imager.Error => GOTO Abort;
constantColor: Imager.ConstantColor ¬ NARROW[color];
cyan, magenta, yellow, black: REAL;
IF NOT ISTYPE[constantColor, ImagerColor.OpConstantColor] THEN GOTO Abort;
[cyan, magenta, yellow, black] ¬ GGColorOps.ExtractCMYK[constantColor];
rope ¬ IO.PutFLR["CMYK: %1.3f %1.3f %1.3f %1.3f", LIST[[real[cyan]], [real[magenta]], [real[yellow]], [real[black]]] ];
EXITS
Abort => rope ¬ "CMYK: none";
};
ColorToIntensityRope: PUBLIC PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
ENABLE Feedback.Problem, Imager.Error => GOTO Abort;
constantColor: Imager.ConstantColor ¬ NARROW[color];
intensity: REAL ¬ GGColorOps.ExtractIntensity[constantColor];
rope ¬ IO.PutFR1["Intensity: %1.3f", [real[intensity]] ];
EXITS
Abort => rope ¬ "Intensity: none";
};
ColorToNameRope: PUBLIC PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
ENABLE Feedback.Problem, Imager.Error => GOTO Abort;
constantColor: Imager.ConstantColor ¬ NARROW[color];
red, green, blue: REAL;
[red,green,blue] ¬ GGCoreOps.ExtractRGB[constantColor];
rope ¬ NamedColors.HSLToRope[ColorFns.HSLFromRGB[[red,green,blue]]];
EXITS
Abort => rope ¬ "none";
};
GGBuiltInShapes
PolygonInCircle: PUBLIC PROC [sideCount: NAT, origin: Point, radius: REAL, defaults: DefaultData] RETURNS [outline: Slice] = {
The bottom-most edge of the returned polygon will be horizontal. The polygon will be inscribed inside the circle with radius "radius" centered at "origin".
traj: Traj;
theta0, theta, deltaTheta, sin, cos: REAL;
lastPoint, thisPoint: Point;
success: BOOL;
seg: Segment;
IF sideCount = 0 THEN RETURN[NIL];
deltaTheta ¬ 360.0/sideCount;
theta0 ¬ -90.0 + deltaTheta/2.0;
sin ¬ RealFns.SinDeg[theta0];
cos ¬ RealFns.CosDeg[theta0];
thisPoint ¬ Vectors2d.Add[Vectors2d.Scale[[cos, sin], radius], origin];
traj ¬ GGTraj.CreateTraj[thisPoint];
lastPoint ¬ thisPoint;
FOR i: NAT IN [1..sideCount) DO
theta ¬ theta0 + i*deltaTheta;
sin ¬ RealFns.SinDeg[theta];
cos ¬ RealFns.CosDeg[theta];
thisPoint ¬ Vectors2d.Add[Vectors2d.Scale[[cos, sin], radius], origin];
seg ¬ GGSegment.MakeLine[lastPoint, thisPoint, NIL];
GGSegment.SetDefaults[seg, defaults];
success ¬ GGTraj.AddSegment[traj, hi, seg, lo];
IF NOT success THEN SIGNAL Problem[msg: "Couldn't add segment"];
lastPoint ¬ thisPoint;
ENDLOOP;
sin ¬ RealFns.SinDeg[theta0];
cos ¬ RealFns.CosDeg[theta0];
thisPoint ¬ Vectors2d.Add[Vectors2d.Scale[[cos, sin], radius], origin];
seg ¬ GGSegment.MakeLine[lastPoint, thisPoint, NIL];
GGSegment.SetDefaults[seg, defaults];
GGTraj.CloseWithSegment[traj, seg, lo];
outline ¬ GGOutline.CreateOutline[traj, ImagerColor.ColorFromGray[0.5]];
GGSliceOps.SetStrokeJoint[outline, GGSliceOps.NewParts[outline, NIL, topLevel].parts, defaults.strokeJoint, NIL];
GGSliceOps.SetFillColor[outline, NIL, defaults.fillColor, $Set, NIL];
};
Box: PUBLIC PROC [origin: Point, sideLength: REAL, defaults: DefaultData] RETURNS [slice: Slice] = {
halfSide: REAL ¬ sideLength/2.0;
box: GGBoundBox.BoundBox ¬ GGBoundBox.CreateBoundBox[origin.x-halfSide, origin.y-halfSide, origin.x+halfSide, origin.y+halfSide];
sliceD: SliceDescriptor ¬ GGSlice.MakeBoxSlice[box, ul, GGTransform.Identity[] ];
completeSliceD: SliceDescriptor ¬ GGSliceOps.NewParts[sliceD.slice, NIL, slice];
slice ¬ sliceD.slice;
GGSliceOps.SetDefaults[slice, completeSliceD.parts, defaults, NIL];
};
Circle: PUBLIC PROC [origin: Point, radius: REAL, defaults: DefaultData] RETURNS [slice: Slice] = {
outerPoint: Point ¬ [origin.x + radius, origin.y];
sliceD: SliceDescriptor ¬ GGSlice.MakeCircleSlice[origin, outerPoint];
completeSliceD: SliceDescriptor ¬ GGSliceOps.NewParts[sliceD.slice, NIL, slice];
slice ¬ sliceD.slice;
GGSliceOps.SetDefaults[slice, completeSliceD.parts, defaults, NIL];
};
KnotchedLine: PUBLIC PROC [p0, p1: Point, segmentCount: NAT] RETURNS [outline: Slice] = {
Returns a trajectory with "segmentCount" straight line segments, all of the same length. The entire trajectory is a single straight line, from point p0 to p1. All of its segments are collinear. Knotched lines are useful as rulers.
delta: Vector;
lastPoint, thisPoint: Point;
traj: Traj;
seg: Segment;
success: BOOL;
delta ¬ Vectors2d.Scale[Vectors2d.Sub[p1, p0], 1.0/segmentCount];
lastPoint ¬ p0;
traj ¬ GGTraj.CreateTraj[lastPoint];
THROUGH [1..segmentCount) DO
thisPoint ¬ Vectors2d.Add[lastPoint, delta];
seg ¬ GGSegment.MakeLine[lastPoint, thisPoint, NIL];
success ¬ GGTraj.AddSegment[traj, hi, seg, lo];
IF NOT success THEN SIGNAL Problem[msg: "Couldn't add segment"];
lastPoint ¬ thisPoint;
ENDLOOP;
thisPoint ¬ p1;
seg ¬ GGSegment.MakeLine[lastPoint, thisPoint, NIL];
success ¬ GGTraj.AddSegment[traj, hi, seg, lo];
IF NOT success THEN SIGNAL Problem[msg: "Couldn't add segment"];
outline ¬ GGOutline.CreateOutline[traj, ImagerColor.ColorFromGray[0.5]];
};
Text Descriptions of Simple Data Types
DescribeTraj: PUBLIC PROC [traj: Traj] RETURNS [text: Rope.ROPE] = {
trajData: TrajData ¬ NARROW[traj.data];
text ¬ SELECT trajData.role FROM
open => IO.PutFR1["a %g-segment open trajectory", [integer[trajData.segCount]]],
fence => IO.PutFR1["a %g-segment fence", [integer[trajData.segCount]]],
hole => IO.PutFR1["a %g-segment hole", [integer[trajData.segCount]]],
ENDCASE => "";
};
DescribeJoint: PUBLIC PROC [traj: Traj, jointNum: NAT] RETURNS [text: Rope.ROPE] = {
trajData: TrajData ¬ NARROW[traj.data];
end: BOOL ¬ FALSE;
end ¬ GGTraj.IsEndJoint[traj, jointNum];
IF end THEN text ¬ IO.PutFR1["end joint %g on ", [integer[jointNum]] ]
ELSE text ¬ IO.PutFR1["joint %g on ", [integer[jointNum]] ];
text ¬ Rope.Concat[text, DescribeSegment[traj, IF GGTraj.HiJoint[traj]=jointNum AND trajData.role=open THEN jointNum-1 ELSE jointNum]];
Describes one of the possible two segments this joint is on
};
DescribeControlPoint: PUBLIC PROC [traj: Traj, segNum: NAT, cpNum: NAT] RETURNS [text: Rope.ROPE] = {
text ¬ Rope.Concat[IO.PutFR1["control point %g on ", [integer[cpNum]]], DescribeSegment[traj, segNum] ];
};
DescribeSegment: PUBLIC PROC [traj: Traj, segNum: NAT] RETURNS [text: Rope.ROPE] = {
IF segNum=LAST[NAT] THEN text ¬ Rope.Concat["a segment on ", DescribeTraj[traj]] ELSE {
seg: Segment ¬ GGTraj.FetchSegment[traj, segNum];
text ¬ Rope.Cat[seg.class.describe[seg, TRUE, TRUE, TRUE, NIL], IO.PutFR1[" segment %g on ", [integer[segNum]]], DescribeTraj[traj]];
};
};
DescribeInterior: PUBLIC PROC [traj: Traj] RETURNS [text: Rope.ROPE] = {
text ¬ Rope.Concat["The interior of ", DescribeTraj[traj]];
};
DescribeSequence: PUBLIC PROC [sliceD: SliceDescriptor] RETURNS [text: Rope.ROPE] = {
text ¬ Rope.Concat["one or more parts of ", DescribeTraj[sliceD.slice]];
};
DescribeColor: PUBLIC PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
WITH color SELECT FROM
constantColor: ImagerColor.ConstantColor => {
op: ImagerColor.ColorOperator;
colorType: GGColorOps.ColorType;
[colorType, op] ¬ GGColorOps.GetColorType[color];
IF op#NIL THEN SELECT GGColorOps.GetOperatorType[op] FROM
grayLinear, grayDensity, grayVisual =>
rope ¬ ColorAsIntensityAndNameRope[color];
map, buildMap, rgbLinear, xeroxRgbLinear, colorMap =>
rope ¬ ColorAsRGBAndNameRope[color];
cmyk => rope ¬ ColorAsCMYKAndNameRope[color];
ENDCASE => rope ¬ "an unknown constant color operator type"
ELSE SELECT colorType FROM
constantSpecial => {
special: ImagerColor.SpecialColor ¬ NARROW[constantColor];
rope ¬ SpecialColorAsRGBAndNameRope[special];
};
ENDCASE => rope ¬ "an unknown constant color type";
};
special: ImagerColor.SpecialColor => {
rope ¬ special.name
};
sampledBlack: ImagerColor.SampledBlack => {
rope ¬ "a sampled black";
};
sampledColor: ImagerColor.SampledColor => {
rope ¬ "a sampled color";
};
ENDCASE => {
rope ¬ "an unknown color type";
};
};
SpecialColorAsRGBAndNameRope: PROC [color: Imager.SpecialColor] RETURNS [rope: Rope.ROPE] = {
IF color#NIL THEN rope ¬ IO.PutFLR["%g Name: %g %g %g",
LIST[[rope[IF color.substitute=NIL THEN "No equivalent RGB " ELSE ColorToRGBRope[color.substitute]]],
[rope[color.name]],
[rope[ColorToCMYKRope[color.substitute]]],
[rope[ColorToIntensityRope[color.substitute]]]]
]
ELSE rope ¬ "None";
};
ColorAsRGBAndNameRope: PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
cc: Imager.ConstantColor ¬ NARROW[color];
IF cc#NIL THEN rope ¬ IO.PutFLR["%g CNS: %g %g %g",
LIST[[rope[ColorToRGBRope[cc]]],
[rope[ColorToNameRope[cc]]],
[rope[ColorToCMYKRope[cc]]],
[rope[ColorToIntensityRope[cc]]]]
]
ELSE rope ¬ "None";
};
ColorAsCMYKAndNameRope: PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
cc: Imager.ConstantColor ¬ NARROW[color];
IF cc#NIL THEN rope ¬ IO.PutFLR["%g CNS: %g %g %g",
LIST[[rope[ColorToCMYKRope[cc]]],
[rope[ColorToNameRope[cc]]],
[rope[ColorToRGBRope[cc]]],
[rope[ColorToIntensityRope[cc]]]]
]
ELSE rope ¬ "None";
};
ColorAsIntensityAndNameRope: PROC [color: Imager.Color] RETURNS [rope: Rope.ROPE] = {
cc: Imager.ConstantColor ¬ NARROW[color];
IF cc#NIL THEN rope ¬ IO.PutFLR["%g CNS: %g %g %g",
LIST[[rope[ColorToIntensityRope[cc]]],
[rope[ColorToNameRope[cc]]],
[rope[ColorToRGBRope[cc]]],
[rope[ColorToCMYKRope[cc]]]]
]
ELSE rope ¬ "None";
};
ScalarButtonValuesToRope: PUBLIC PROC [names: LIST OF Rope.ROPE, values: LIST OF REAL, on: LIST OF BOOL] RETURNS [rope: Rope.ROPE] = {
stream: IO.STREAM;
stream ¬ IO.ROS[];
GGParseOut.WriteScalarButtonValues[stream, names, values, on];
rope ¬ IO.RopeFromROS[stream];
};
ScalarButtonValuesFromRope: PUBLIC PROC [rope: Rope.ROPE] RETURNS [names: LIST OF Rope.ROPE, values: LIST OF REAL, on: LIST OF BOOL] = {
stream: IO.STREAM;
version: REAL ¬ GGUtility.version;
stream ¬ IO.RIS[rope];
[names, values, on] ¬ GGParseIn.ReadScalarButtonValues[stream, version];
};
FactoredTransformationToRope: PUBLIC PROC [transform: ImagerTransformation.Transformation] RETURNS [rope: Rope.ROPE] = {
f: IO.STREAM ¬ IO.ROS[];
GGParseOut.WriteFactoredTransformation[f, transform];
rope ¬ IO.RopeFromROS[f];
};
FactoredTransformationFromRope: PUBLIC PROC [rope: Rope.ROPE] RETURNS [transform: ImagerTransformation.Transformation] = {
f: IO.STREAM ¬ IO.RIS[rope];
transform ¬ GGParseIn.ReadFactoredTransformation[f];
};
GGCircleCache
alignmentColor: Imager.Color ¬ ImagerBackdoor.MakeStipple[145065B];
Create: PUBLIC PROC [] RETURNS [Cache] = {
RETURN [FunctionCache.GlobalCache[] ];
};
Insert: PUBLIC PROC [x: Cache, radius: REAL] = {
IF Lookup[x, radius]#NIL OR radius NOT IN [1.0..512.0] THEN RETURN
ELSE {
context: Imager.Context;
argument: REF REAL ¬ NEW[REAL ¬ radius];
circle: GGBasicTypes.Circle;
dummySize: NAT ¬ 0;
side: INT ¬ 2*(Real.Fix[radius+1.0]+1); -- round up and add 1
bitmap: Bitmap ¬ ImagerSample.NewSampleMap[[max: [side, side]]];
cachedCircle: CachedCircle ¬ NEW[CachedCircleObj ¬ [bitmap: bitmap, cw: side, ch: side]];
context ¬ ImagerBitmapContext.Create[deviceSpaceSize: [side, side], scanMode: [down, right], surfaceUnitsPerInch: [72.0, 72.0], pixelUnits: TRUE];
ImagerBitmapContext.SetBitmap[context, bitmap];
context.SetColor[Imager.white];
context.MaskRectangle[ImagerBackdoor.GetBounds[context]];
context.SetColor[alignmentColor];
context.SetStrokeWidth[1.0];
circle ¬ GGCircles.CircleFromPointAndRadius[ [side/2, side/2], radius];
GGShapes.DrawCircle[dc: context, circle: circle ];
FunctionCache.Insert[x: x, argument: argument, value: cachedCircle, size: ImagerSample.WordsForMap[[side, side], 1] + 2, clientID: $GGCircle];
};
};
Lookup: PUBLIC PROC [x: Cache, radius: REAL] RETURNS [CachedCircle] = {
Returns NIL if lookup fails
FindRadius: FunctionCache.CompareProc = {
arg: REAL ¬ NARROW[argument, REF REAL]­;
RETURN [ABS[arg-radius] < 1.0E-3];
};
value: Range;
ok: BOOL;
[value, ok] ¬ FunctionCache.Lookup[x: x, compare: FindRadius, clientID: $GGCircle];
RETURN [IF ok THEN NARROW[value] ELSE NIL];
};
Remove: PUBLIC PROC [x: Cache, radius: REAL] = {
FindRadius: FunctionCache.CompareProc = {
arg: REAL ¬ NARROW[argument, REF REAL]­;
RETURN [ABS[arg- radius] < 1.0E-3];
};
[] ¬ FunctionCache.Obtain[x: x, compare: FindRadius, limit: 1, clientID: $GGCircle];
};
RemoveAll: PUBLIC PROC [x: Cache] = {
list: LIST OF FunctionCache.CacheEntry ¬ FunctionCache.Obtain[x: x, compare: FunctionCache.Any, limit: LAST[INT], clientID: $GGCircle];
UNTIL list=NIL DO
list ¬ FunctionCache.Obtain[x: x, compare: FunctionCache.Any, limit: LAST[INT], clientID: $GGCircle];
ENDLOOP;
};
DrawCachedCircle: PUBLIC PROC [context: Context, point: Point, circle: CachedCircle] = {
DoDrawCachedCircle: PROC = {
context.SetColor[Imager.black];
Imager.MaskBitmap[
context: context,
bitmap: circle.bitmap,
referencePoint: [circle.ch, 0],
position: [Real.Round[point.x]-(circle.cw/2),
Real.Round[point.y]-(circle.ch/2)]
];
};
Imager.DoSave[context, DoDrawCachedCircle];
};
Init: PROC [] ~ {
[] ¬ CodeTimer.CreateTable[$Gargoyle];
versionRope ← "8610.29";
versionRope ← "8612.04";
versionRope ← "8701.13";
versionRope ← "8701.135";
versionRope ← "8701.23";
versionRope ← "8701.26";
versionRope ← "8701.28";
versionRope ← "8701.30";
versionRope ← "8702.11";
versionRope ← "8702.26";
versionRope ← "8704.03";
versionRope ← "8705.14";
versionRope ← "8706.08";
versionRope ← "8706.16";
versionRope ← "8706.25";
versionRope ← "8708.21";
versionRope ← "8710.19";
versionRope ← "8802.04";
versionRope ← "8803.08";
versionRope ← "8803.24";
versionRope ← "8810.24";
versionRope ← "8811.30";
versionRope ← "8905.19";
versionRope ← "8906.16";
versionRope ¬ "9106.27"; -- black text should not have NIL fill color
versionRope ¬ "9207.29"; -- file out background color and other scene fields
version ¬ 9207.29;
};
versionRope: PUBLIC Rope.ROPE;
version: PUBLIC REAL;
Init[];
END.