Areas
Rectangle: TYPE = PipalReal.Rectangle;
Rectangles:
TYPE =
LIST
OF Rectangle;
enumerateAreaMethod:
PUBLIC Pipal.Method ← Pipal.RegisterMethod["EnumerateArea"];
EnumerateArea:
PUBLIC EnumerateAreaProc = {
data: REF ← Pipal.ObjectMethod[area, enumerateAreaMethod];
quit ← (IF data=NIL THEN AreaFromEnumerate ELSE (NARROW [data, REF EnumerateAreaProc]^))[area, each, transformation];
};
AreaFromEnumerate: EnumerateAreaProc = {
EachChild: PipalReal.EachChildProc = {quit ← EnumerateArea[child, each, transformation]};
quit ← PipalReal.Enumerate[area, EachChild, transformation];
};
emptyArea: PUBLIC Area = Pipal.void;
fullArea:
PUBLIC Area = CreateExplicitArea[PipalReal.fullRectangle];
-- anything would do ...
IsEmptyArea:
PUBLIC
PROC [area: Area]
RETURNS [empty:
BOOL] = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
empty ← NOT EnumerateArea[area, PipalReal.AlwaysQuit, transformation];
PipalReal.DestroyTransformation[transformation];
};
AreaToRope:
PUBLIC
PROC [area: Area]
RETURNS [rope: Pipal.
ROPE] = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
EachRect: PipalReal.RectangleProc = {
rope ← Rope.Cat[rope, PipalReal.RectangleToRope[rect], " "];
};
rope ← "{";
[] ← EnumerateArea[area, EachRect, transformation];
PipalReal.DestroyTransformation[transformation];
RETURN [Rope.Cat[rope, "}"]];
};
Special Area Classes
ExplicitArea: TYPE = REF ExplicitAreaRec;
ExplicitAreaRec:
TYPE =
RECORD [rectangle: Rectangle];
explicitAreaClass:
PRIVATE Pipal.Class ← Pipal.RegisterClass[name: "ExplicitArea", type:
CODE [ExplicitAreaRec]];
AreaExplicitArea: EnumerateAreaProc = {
ea: ExplicitArea ← NARROW [area];
quit ← each[ea.rectangle];
};
BBoxExplicitArea: PipalReal.BBoxProc = {
ea: ExplicitArea ← NARROW [object];
bbox ← PipalReal.TransformRectangle[transformation, ea.rectangle];
};
CreateExplicitArea:
PUBLIC
PROC [rectangle: PipalReal.Rectangle]
RETURNS [area: Area] = {
area ← NEW [ExplicitAreaRec ← [rectangle]];
};
ConsRect:
PROC [rect: Rectangle, rects: Rectangles]
RETURNS [Rectangles] = {
RETURN [IF PipalReal.IsDegeneratedRectangle[rect] THEN rects ELSE CONS [rect, rects]];
};
CollectRects:
PROC [area: Area, transformation: PipalReal.Transformation]
RETURNS [rects: Rectangles ←
NIL] = {
InsertEach: PipalReal.RectangleProc = {rects ← ConsRect[rect, rects]};
[] ← EnumerateArea[area, InsertEach, transformation];
};
IntersectRects:
PROC [rects1, rects2: Rectangles]
RETURNS [rects: Rectangles ←
NIL] = {
FOR list1: Rectangles ← rects1, list1.rest
WHILE list1#
NIL
DO
rect1: Rectangle ← list1.first;
FOR list2: Rectangles ← rects2, list2.rest
WHILE list2#
NIL
DO
rects ← ConsRect[PipalReal.IntersectBox[rect1, list2.first], rects];
ENDLOOP;
ENDLOOP;
};
DecomposeRects:
PROC [r, clip: Rectangle]
RETURNS [union: Rectangles ←
NIL] = {
InsertEach: PipalReal.RectangleProc = {union ← CONS [rect, union]};
[] ← PipalReal.DecomposeRect[r: r, clip: clip, outside: InsertEach];
};
ComplementRects:
PROC [rects1, rects2: Rectangles]
RETURNS [rects: Rectangles ←
NIL] = {
FOR list1: Rectangles ← rects1, list1.rest
WHILE list1#
NIL
DO
rect1: Rectangle ← list1.first;
inter: Rectangles ← LIST [rect1];
FOR list2: Rectangles ← rects2, list2.rest
WHILE list2#
NIL
DO
inter ← IntersectRects[inter, DecomposeRects[r: list2.first, clip: rect1]];
ENDLOOP;
FOR list2: Rectangles ← inter, list2.rest
WHILE list2#
NIL
DO
rects ← ConsRect[list2.first, rects];
ENDLOOP;
ENDLOOP;
};
IntersectionArea: TYPE = REF IntersectionAreaRec;
IntersectionAreaRec:
TYPE =
RECORD [sub:
BOOL, area1, area2: Area];
intersectionAreaClass:
PRIVATE Pipal.Class ← Pipal.RegisterClass[name: "IntersectionArea", type:
CODE [IntersectionAreaRec]];
AreaIntersectionArea: EnumerateAreaProc = {
ia: IntersectionArea = NARROW [area];
subRects1, subRects2: Rectangles;
subRects1 ← CollectRects[ia.area1, transformation];
subRects2 ← CollectRects[ia.area2, transformation];
FOR list: Rectangles ← (
IF ia.sub
THEN ComplementRects
ELSE IntersectRects)[subRects1, subRects2], list.rest
WHILE list#
NIL
DO
IF each[list.first] THEN RETURN [TRUE];
ENDLOOP;
};
BBoxIntersectionArea: PipalReal.BBoxProc = {
ia: IntersectionArea = NARROW [object];
bbox ← PipalReal.BBox[ia.area1, transformation];
IF NOT ia.sub THEN bbox ← PipalReal.BoundingBox[PipalReal.BBox[ia.area2, transformation], bbox];
};
IntersectArea:
PUBLIC
PROC [area1, area2: Area]
RETURNS [area: Area] = {
area ← NEW [IntersectionAreaRec ← [FALSE, area1, area2]];
};
SubArea:
PUBLIC
PROC [area1, area2: Area]
RETURNS [area: Area] = {
area ← NEW [IntersectionAreaRec ← [TRUE, area1, area2]];
};
ChildishArea: TYPE = REF ChildishAreaRec;
ChildishAreaRec:
TYPE =
RECORD [child: Pipal.Object, option: AreaOption];
childishAreaClass:
PRIVATE Pipal.Class ← Pipal.RegisterClass[name: "ChildishArea", type:
CODE [ChildishAreaRec]];
ApplyOnEdges:
PROC [rect: Rectangle, each: PipalReal.RectangleProc]
RETURNS [quit:
BOOL ←
FALSE] = {
IF each[[[rect.base.x, rect.base.y], [rect.size.x, 0]]] THEN RETURN [TRUE];
IF each[[[rect.base.x, rect.base.y], [0, rect.size.y]]] THEN RETURN [TRUE];
IF each[[[rect.base.x+rect.size.x, rect.base.y], [0, rect.size.y]]] THEN RETURN [TRUE];
IF each[[[rect.base.x, rect.base.y+rect.size.y], [rect.size.x, 0]]] THEN RETURN [TRUE];
};
AreaChildishArea: EnumerateAreaProc = {
ca: ChildishArea ← NARROW [area];
bbox: Rectangle = PipalReal.BBox[ca.child, transformation];
ExtendedEach: PipalReal.RectangleProc = {quit ← each[PipalReal.Extend[rect, 1.0]]};
Compensating for the thickness of the outline
EachChildEdge: PipalReal.RectangleProc ~ {quit ← ApplyOnEdges[rect, ExtendedEach]};
SELECT ca.option
FROM
bboxChild => quit ← ExtendedEach[bbox];
edgesChild => quit ← ApplyOnEdges[bbox, ExtendedEach];
edgesChildren => quit ← EnumerateArea[ca.child, EachChildEdge, transformation];
ENDCASE => ERROR;
};
BBoxChildishArea: PipalReal.BBoxProc = {
ca: ChildishArea = NARROW [object];
bbox ← PipalReal.Extend[PipalReal.BBox[ca.child, transformation], 1.0];
};
ChildArea:
PUBLIC
PROC [child: Pipal.Object, option: AreaOption]
RETURNS [area: Area] = {
area ← NEW [ChildishAreaRec ← [child, option]];
};
PaintAreaOutlineAnnotation: PaintProc = {
PaintAreaOutline[context, object];
};
CreatePaintAreaOutline:
PUBLIC
PROC [area: Area]
RETURNS [annotation: Pipal.Annotation] = {
annotation ← CreatePaintMethodAnnotation[area, PaintAreaOutlineAnnotation];
};
Paint Queue
nullRequest: Request = [none, emptyArea]; -- all what is important here is that referencing/copying it does not cause a memory fault.
RequestToRope:
PUBLIC
PROC [request: Request]
RETURNS [Pipal.
ROPE] = {
RETURN [Rope.Cat[
"Request { ",
SELECT request.type
FROM
none => "none",
clearArea => Rope.Cat["clearArea ", AreaToRope[request.area]],
paintArea => Rope.Cat["paintArea ", Pipal.DescribeToRope[request.data], " ", AreaToRope[request.area]],
clearAndPaint => Rope.Cat["clearAndPaint ", Pipal.DescribeToRope[request.data], " ", AreaToRope[request.area]],
scale => Rope.Cat["scale ", PipalReal.TransformationToRope[NARROW [request.data]]],
other => "other",
ENDCASE => ERROR,
" }"
]];
};
Mod:
PROC [index:
NAT, max:
NAT]
RETURNS [
NAT] =
INLINE {
RETURN [IF index<max THEN index ELSE index-max];
};
CreateQueue:
PUBLIC
PROC
RETURNS [queue: Queue] = {
requests: REF Requests ← NEW [Requests[1]];
requests[0] ← nullRequest;
queue ← NEW [QueueRec ← [start: 0, size: 0, requests: requests]];
};
IsQueueEmpty:
PUBLIC
PROC [queue: Queue]
RETURNS [
BOOL] = {
RETURN [queue.size=0];
};
ClipRequest:
PROC [request: Request, area: Area]
RETURNS [new: Request] = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
bbox1: PipalReal.Rectangle = PipalReal.BBox[request.area, transformation];
bbox2: PipalReal.Rectangle = PipalReal.BBox[area, transformation];
PipalReal.DestroyTransformation[transformation];
new ← request;
IF request.area=area THEN RETURN [nullRequest];
IF NOT PipalReal.DoRectanglesIntersect[bbox1, bbox2] THEN RETURN;
IF ISTYPE [request.area, ExplicitArea] AND ISTYPE [area, ExplicitArea] AND bbox1=bbox2 THEN RETURN [nullRequest];
IF NOT debugConservativeClip THEN new.area ← SubArea[request.area, area];
IF debugTestForEmpty AND IsEmptyArea[new.area] THEN RETURN [nullRequest];
};
OptimizeClear:
INTERNAL
PROC [queue: Queue, area: Area, start, size:
NAT] = {
requests: REF Requests = queue.requests;
max: NAT ← requests.max;
FOR i:
NAT
DECREASING
IN [start .. start+size)
DO
index: NAT = Mod[i, max];
SELECT requests[index].type
FROM
clearArea, paintArea, clearAndPaint => requests[index] ← ClipRequest[requests[index], area];
scale => RETURN;
none, other => {};
ENDCASE => ERROR;
ENDLOOP;
};
Enqueue:
PUBLIC
ENTRY
PROC [queue: Queue, request: Request, reverse:
BOOL ←
FALSE] = {
ENABLE UNWIND => NULL;
new: NAT;
max: NAT ← queue.requests.max;
IF queue.size>=max
THEN {
requests: REF Requests ← NEW [Requests[max*2]];
FOR i: NAT IN [0 .. max) DO requests[i] ← queue.requests[i] ENDLOOP;
FOR i: NAT IN [max .. max*2) DO requests[i] ← nullRequest ENDLOOP;
queue.requests ← requests;
max ← max*2;
};
new ← Mod[queue.start+(IF reverse THEN max-1 ELSE queue.size), max];
IF debugPrintEnqueued THEN TerminalIO.PutF["Enqueued: %g\n", IO.rope[RequestToRope[request]]];
queue.requests[new] ← request;
queue.size ← queue.size+1;
IF reverse THEN queue.start ← new;
IF NOT debugOptimize THEN RETURN;
SELECT request.type
FROM
clearArea, clearAndPaint => IF NOT reverse THEN OptimizeClear[queue, request.area, queue.start, queue.size-1];
ENDCASE => {};
};
Dequeue:
PUBLIC
ENTRY
PROC [queue: Queue]
RETURNS [empty:
BOOL, request: Request] = {
ENABLE UNWIND => NULL;
Decr:
PROC = {
queue.start ← Mod[queue.start+1, queue.requests.max];
queue.size ← queue.size-1;
};
SkipNone:
PROC = {
WHILE queue.size#0 AND queue.requests[queue.start].type=none DO Decr[] ENDLOOP;
};
SkipNone[];
IF queue.size=0 THEN RETURN [TRUE, nullRequest];
request ← queue.requests[queue.start];
Decr[];
empty ← FALSE;
We look around to see if the next request can be collapsed with request
SkipNone[];
WHILE queue.size#0
DO
next: Request ← queue.requests[queue.start];
IF request.type#clearAndPaint OR next.type#clearAndPaint OR request.data#next.data THEN EXIT; -- hack, of course!
request.area ← Pipal.CreateOverlay[LIST [request.area, next.area]];
Decr[];
SkipNone[];
ENDLOOP;
IF debugPrintDequeued THEN TerminalIO.PutF["Dequeued: %g\n", IO.rope[RequestToRope[request]]];
};
Speed-up hacks
PaintIntTranslation: PaintProc = {
translation: PipalInt.Translation ← NARROW [object];
Imager.TranslateT[context, PipalReal.IntToRealVector[translation.vector]];
Paint[translation.child, context];
Imager.TranslateT[context, PipalReal.IntToRealVector[PipalInt.Neg[translation.vector]]];
};
This one is more than a speed up since it does clipping. Maybe the clipping could be put in enumerate, and we could get rid of this one.
PaintOverlay: PaintProc = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[]; -- changed the day PaintProcs have a transformation!
overlay: Pipal.Overlay ← NARROW [object];
bounds: Imager.Rectangle ← ImagerBackdoor.GetBounds[context ! Imager.Error => GOTO PaintAnyway];
clip: Rectangle ← [[bounds.x, bounds.y], [bounds.w, bounds.h]];
FOR i:
NAT
DECREASING
IN [0..overlay.size)
DO
IF PipalReal.DoRectanglesIntersect[clip, PipalReal.BBox[overlay[i], transformation]]
THEN Paint[overlay[i], context];
ENDLOOP;
PipalReal.DestroyTransformation[transformation];
EXITS PaintAnyway => PaintFromEnumerate[object, context];
};
Utilities
RectanglePath:
PROC [r: Rectangle, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] = {
moveTo[r.base];
lineTo[[r.base.x+r.size.x, r.base.y]];
lineTo[[r.base.x+r.size.x, r.base.y+r.size.y]];
lineTo[[r.base.x, r.base.y+r.size.y]];
};
AreaPath:
PROC [area: Area, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
EachRect: PipalReal.RectangleProc = {RectanglePath[rect, moveTo, lineTo]};
[] ← EnumerateArea[area, EachRect, transformation];
PipalReal.DestroyTransformation[transformation];
};
white: Imager.ConstantColor = ImagerColor.Find["Xerox/Research/ChipNDale/CD/InitialColor"];
ClearArea:
PUBLIC
PROC [context: Imager.Context, area: Area] = {
Path: Imager.PathProc ~ {AreaPath[area, moveTo, lineTo]};
ClearAreaInternal:
PROC = {
SetColor[context, IF debugClipArea THEN Imager.MakeGray[0.25] ELSE white];
Imager.MaskFill[context: context, path: Path, oddWrap: FALSE];
};
Imager.DoSave[context, ClearAreaInternal];
};
ClipAndPaint:
PUBLIC
PROC [context: Imager.Context, object: Pipal.Object, clipArea: Area] = {
Path: Imager.PathProc ~ {AreaPath[clipArea, moveTo, lineTo]};
ClipAndPaintInternal:
PROC = {
Imager.Clip[context: context, path: Path, oddWrap: FALSE];
Paint[object, context];
};
Imager.DoSave[context, ClipAndPaintInternal];
};
ClearClipAndPaint:
PUBLIC
PROC [context: Imager.Context, object: Pipal.Object, clipArea: Area] = {
Path: Imager.PathProc ~ {AreaPath[clipArea, moveTo, lineTo]};
ClearClipAndPaintInternal:
PROC = {
SetColor[context, IF debugClipArea THEN Imager.MakeGray[0.25] ELSE white];
Imager.MaskFill[context: context, path: Path, oddWrap: FALSE];
Imager.Clip[context: context, path: Path, oddWrap: FALSE];
Paint[object, context];
};
Imager.DoSave[context, ClearClipAndPaintInternal];
};
PaintOutline:
PUBLIC
PROC [context: Imager.Context, r: Rectangle, color: Color ← Imager.black] = {
SetColor[context, color];
Imager.MaskVector[context, [r.base.x, r.base.y], [r.base.x+r.size.x, r.base.y]];
Imager.MaskVector[context, [r.base.x, r.base.y], [r.base.x, r.base.y+r.size.y]];
Imager.MaskVector[context, [r.base.x+r.size.x, r.base.y], [r.base.x+r.size.x, r.base.y+r.size.y]];
Imager.MaskVector[context, [r.base.x, r.base.y+r.size.y], [r.base.x+r.size.x, r.base.y+r.size.y]];
};
PaintAreaOutline:
PUBLIC
PROC [context: Imager.Context, area: Area, color: Color ← Imager.black] = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
Each: PipalReal.RectangleProc ~ {PaintOutline[context, rect, color]};
[] ← EnumerateArea[area, Each, transformation];
PipalReal.DestroyTransformation[transformation];
};
PaintArea:
PUBLIC
PROC [context: Imager.Context, area: Area, color: Color ← Imager.black] = {
transformation: PipalReal.Transformation ← PipalReal.CreateTransformation[];
EachRect: PipalReal.RectangleProc ~ {
Imager.MaskRectangle[context, [rect.base.x, rect.base.y, rect.size.x, rect.size.y]];
};
SetColor[context, color];
[] ← EnumerateArea[area, EachRect, transformation];
PipalReal.DestroyTransformation[transformation];
};
PaintText:
PUBLIC
PROC [context: Imager.Context, contents: Pipal.
ROPE, font: Imager.Font, color: Color ← Imager.black] = {
Imager.SetFont[context, font];
Imager.SetColor[context, color];
Imager.SetXY[context, [0, 0]];
Imager.ShowRope[context, contents];
};
debugFlipText:
BOOL ←
FALSE;
-- will be true if the flipping did not work!
PaintFlippedText:
PUBLIC
PROC [context: Imager.Context, contents: Pipal.
ROPE, font: Imager.Font, bbox: PipalInt.Rectangle, color: Color ← Imager.black] = {
vec: Imager.VEC ← ImagerBackdoor.TransformVec[context, [1, 1], client, surface ! Imager.Error => GOTO JustPaint];
tt: Imager.Transformation ← PipalReal.IntToRealTransformation[[
[IF vec.x<0 THEN bbox.size.x+bbox.base.x+bbox.base.x ELSE 0, IF vec.y<0 THEN bbox.size.y+bbox.base.y+bbox.base.y ELSE 0],
SELECT
TRUE
FROM
vec.y<0 AND vec.x<0 => rotate180,
vec.y<0 => rotate180X,
vec.x<0 => mirrorX,
ENDCASE => identity
]];
IF ImagerBackdoor.GetFont[context ! Imager.Error => GOTO JustPaint]#font THEN Imager.SetFont[context, font ! Imager.Error => GOTO JustPaint];
SetColor[context, color];
Imager.ConcatT[context, tt];
vec ← ImagerBackdoor.TransformVec[context, [1, 1], client, surface];
debugFlipText ← debugFlipText OR vec.x<0 OR vec.y<0;
Imager.SetXY[context, [0, 0]];
Imager.ShowRope[context, contents];
Imager.ConcatT[context, ImagerTransformation.Invert[tt]];
PipalReal.DestroyTransformation[tt];
EXITS JustPaint => PaintText[context, contents, font, color];
};
invertingBlack: PUBLIC Imager.Color ← ImagerBackdoor.MakeStipple[0FFFFH, TRUE];
invertingLightGray: PUBLIC Imager.Color ← ImagerBackdoor.MakeStipple[0208H, TRUE];
invertingDarkGray:
PUBLIC Imager.Color ← ImagerBackdoor.MakeStipple[0A5A5H,
TRUE];
GetBounds:
PUBLIC
PROC [context: Imager.Context]
RETURNS [bounds: PipalReal.Rectangle] = {
ibounds: Imager.Rectangle ← ImagerBackdoor.GetBounds[context ! Imager.Error => GOTO ReturnUniverse];
bounds ← [[ibounds.x, ibounds.y], [ibounds.w, ibounds.h]];
EXITS ReturnUniverse => bounds ← PipalReal.fullRectangle;
};
SetColor:
PUBLIC
PROC [context: Imager.Context, color: Color] = {
IF ImagerBackdoor.GetColor[context ! Imager.Error => GOTO SetAnyway]#color THEN Imager.SetColor[context, color]; -- the exception is needed, because ImagerBackdoor.GetColor might not be implemented (e.g. in an interpress context!)
EXITS SetAnyway => Imager.SetColor[context, color];
};
Initialization
Pipal.PutClassMethod[explicitAreaClass, enumerateAreaMethod, NEW [EnumerateAreaProc ← AreaExplicitArea]];
Pipal.PutClassMethod[explicitAreaClass, PipalReal.bboxMethod,
NEW [PipalReal.BBoxProc ← BBoxExplicitArea]];
Pipal.PutClassMethod[intersectionAreaClass, enumerateAreaMethod, NEW [EnumerateAreaProc ← AreaIntersectionArea]];
Pipal.PutClassMethod[intersectionAreaClass, PipalReal.bboxMethod,
NEW [PipalReal.BBoxProc ← BBoxIntersectionArea]];
Pipal.PutClassMethod[childishAreaClass, enumerateAreaMethod, NEW [EnumerateAreaProc ← AreaChildishArea]];
Pipal.PutClassMethod[childishAreaClass, PipalReal.bboxMethod,
NEW [PipalReal.BBoxProc ← BBoxChildishArea]];
Pipal.PutClassMethod[Pipal.annotationClass, paintMethod,
NEW [PaintProc ← PaintAnnotation]];
Pipal.PutClassMethod[PipalInt.translationClass, paintMethod, NEW [PaintProc ← PaintIntTranslation]]; -- speed up
Pipal.PutClassMethod[Pipal.overlayClass, paintMethod, NEW [PaintProc ← PaintOverlay]]; -- speed up