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: BOOL ← FALSE;
[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: BOOL ← FALSE] = {
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];
};
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];
};
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.