PipalInteractiveEditImpl.mesa
Copyright Ó 1988 by Xerox Corporation. All rights reserved.
Louis Monier January 31, 1988 3:11:31 am PST
Bertrand Serlet January 31, 1988 8:17:27 pm PST
Barth, February 1, 1988 4:15:36 pm PST
DIRECTORY BasicTime, BiScrollers, Cursors, Geom2D, Imager, ImagerBackdoor, IO, Pipal, PipalInt, PipalInteractiveEdit, PipalEdit, PipalPaint, PipalReal, Process, Real, RefTab, TIPUser, ViewerClasses;
PipalInteractiveEditImpl: CEDAR PROGRAM
IMPORTS BasicTime, BiScrollers, Geom2D, Imager, ImagerBackdoor, PipalInt, PipalPaint, PipalReal, Process, TIPUser
EXPORTS PipalInteractiveEdit =
BEGIN OPEN PipalInteractiveEdit;
Operations
lastBiscrollerPaintTime: BasicTime.Pulses;
Create: PUBLIC PROC [editor: PipalEdit.Editor, tipTable: Pipal.ROPE, notify: ViewerClasses.NotifyProc] RETURNS [bs: BiScrollers.BiScroller] ~ {
viewerData: ViewerData;
style: BiScrollers.BiScrollerStyle ← BiScrollers.GetStyle["Buttonned"];
class: BiScrollers.BiScrollerClass ← style.NewBiScrollerClass[[
flavor: $BiPipal,
extrema: Extrema,
paint: BiscrollerPaint,
notify: notify,
bsUserAction: ForkAndDo,
finish: LIST [$Exit],
menu: BiScrollers.bsMenu,
icon: fileCabinet,
tipTable: TIPUser.InstantiateNewTIPTable[tipTable],
cursor: bullseye, -- was textPointer
mayStretch: FALSE,
offsetsMustBeIntegers: TRUE,
preferIntegerCoefficients: FALSE
]];
info: ViewerClasses.ViewerRec ← [name: "Pipal",
iconic: FALSE,
data: NEW [ViewerDataRec ← [editor: editor]]];
bs ← class.style.CreateBiScroller[class: class, info: info];
viewerData ← NARROW[BiScrollers.ClientDataOf[bs]];
};
Extrema: BiScrollers.ExtremaProc = {
viewerData: ViewerData ← NARROW[clientData];
bbox: PipalInt.Rectangle ← PipalInt.AbutBox[viewerData.editor.object];
[min, max] ← Geom2D.ExtremaOfRect[[bbox.base.x, bbox.base.y, bbox.size.x, bbox.size.x], direction];
};
PaintBBox: PROC [context: Imager.Context, object: Pipal.Object, color: Imager.Color ← Imager.black] ~ {
PipalPaint.PaintOutline[context, PipalReal.IntToRealRectangle[PipalInt.AbutBox[object]], color];
};
invertingGray: Imager.Color ← ImagerBackdoor.MakeStipple[5A5AH, TRUE]; -- XOR ???
PaintSelected: PROC [context: Imager.Context, object: Pipal.Object, base: PipalReal.Vector, color: Imager.Color ← invertingGray] ~ {
size: PipalReal.Vector ← PipalReal.ObjectSize[object];
Imager.SetColor[context, color];
Imager.MaskRectangle[context, [base.x, base.y, size.x, size.y]];
};
WhatChanged: TYPE = REF WhatChangedRec;
WhatChangedRec: TYPE = RECORD [
clipArea: LIST OF PipalReal.Rectangle, -- redisplay the data structure inside these areas
outlines: LIST OF PipalReal.Rectangle -- then paint these outlines
];
BiscrollerPaint: ViewerClasses.PaintProc = {
clipArea, outlines: LIST OF PipalReal.Rectangle ← NIL;
viewerData: ViewerData ← NARROW [BiScrollers.ClientDataOfViewer[self]];
editor: PipalEdit.Editor = viewerData.editor;
lastBiscrollerPaintTime ← BasicTime.GetClockPulses[];
-- coordinate axis
Imager.SetColor[context, Imager.black];
Imager.MaskVector[context, [-1000, 0], [1000, 0]];
Imager.MaskVector[context, [0, -1000], [0, 1000]];
-- bbox of the editor
PaintBBox[context, editor.object];
-- extra things to paint
IF whatChanged=NIL THEN {
-- Paint the data structure
PipalPaint.Paint[editor, context];
viewerData.previousTrackingArea ← NIL;
}
ELSE {
[clipArea, outlines] ← NARROW [whatChanged, WhatChanged]^;
WHILE viewerData.previousTrackingArea#NIL DO
clipArea ← CONS [viewerData.previousTrackingArea.first, clipArea];
viewerData.previousTrackingArea ← viewerData.previousTrackingArea.rest;
ENDLOOP;
-- Paint the data structure
PipalPaint.ClipAndPaint[editor, context, clipArea];
};
FOR list: LIST OF PipalReal.Rectangle ← outlines, list.rest WHILE list#NIL DO
PipalPaint.PaintOutline[context, list.first];
ENDLOOP;
lastBiscrollerPaintTime ← BasicTime.GetClockPulses[]-lastBiscrollerPaintTime;
};
ForkAndDo: BiScrollers.BSUserActionProc
~ TRUSTED {Process.Detach[FORK BiScrollers.DoBSUserAction[bs, input]]};
Commands
BoundingArea: PROC [rects: LIST OF PipalReal.Rectangle, deltaPrevious, deltaNow: PipalReal.Vector] RETURNS [new: LIST OF PipalReal.Rectangle ← NIL] = {
WHILE rects#NIL DO
new ← CONS [
PipalReal.BoundingBox[
PipalReal.Translate[rects.first, deltaPrevious],
PipalReal.Translate[rects.first, deltaNow]],
new];
rects ← rects.rest;
ENDLOOP;
};
TranslateArea: PROC [rects: LIST OF PipalReal.Rectangle, delta: PipalReal.Vector] RETURNS [new: LIST OF PipalReal.Rectangle ← NIL] = {
WHILE rects#NIL DO
new ← CONS [PipalReal.Translate[rects.first, delta], new];
rects ← rects.rest;
ENDLOOP;
};
Notify: ViewerClasses.NotifyProc = {
viewerData: ViewerData ← NARROW [BiScrollers.ClientDataOfViewer[self]];
atom: ATOM = NARROW [input.first];
result: REF;
resultType: PipalEdit.ResultType;
SELECT atom FROM
$MouseDown => viewerData.mouseDown ← NARROW [input.rest.first, BiScrollers.ClientCoords]^;
$TrackSelected => {
area: LIST OF PipalReal.Rectangle;
viewerData.mouseNow ← NARROW [input.rest.first, BiScrollers.ClientCoords]^;
[resultType, result] ← PipalEdit.ApplyCommand[viewerData.editor, $SelectedOutlines];
IF resultType#selectionArea THEN ERROR;
area ← NARROW [result];
area ← TranslateArea[area, PipalReal.Sub[viewerData.mouseNow, viewerData.mouseDown]];
ViewerOps.PaintViewer[self, client, FALSE, NEW [WhatChangedRec ← [
clipArea: area,
outlines: area
]]];
viewerData.previousTrackingArea ← area;
};
$Exit => NULL;
ENDCASE => {
arguments: LIST OF REFNIL;
FOR list: LIST OF REF ← input.rest, list.rest WHILE list#NIL DO
WITH list.first SELECT FROM
cc: BiScrollers.ClientCoords => {
viewerData.mouseNow ← cc^;
arguments ← CONS [cc, arguments];
};
atom: ATOM => SELECT atom FROM
$DownCoords => arguments ← CONS [NEW [PipalReal.Size ← viewerData.mouseDown], arguments];
ENDCASE => arguments ← CONS [atom, arguments];
ENDCASE => arguments ← CONS [atom, arguments];
ENDLOOP;
[resultType, result] ← PipalEdit.ApplyCommand[viewerData.editor, atom, List.Reverse[arguments]];
SELECT resultType FROM
none => ViewerOps.PaintViewer[self, client]; -- until the day we have commands which change menus
changedArea => ViewerOps.PaintViewer[self, client, FALSE, NEW [WhatChangedRec ← [clipArea: NARROW [result]]]];
ENDCASE => ERROR; -- including object
};
};
END.