DIRECTORY
BasicTime, BiScrollers, Cursors, Geom2D, 
Imager, ImagerColor, ImagerTransformation, IO, Menus, Pipal, PipalEdit, PipalMutate, PipalPaint, PipalReal, Process, Real, RefTab, TerminalIO, TIPUser, ViewerClasses, ViewerOps;

PipalEditImpl: CEDAR MONITOR
LOCKS viewerData USING viewerData: ViewerData
IMPORTS BasicTime, BiScrollers, Cursors, Geom2D, Imager, ImagerColor, ImagerTransformation, IO, Menus, Pipal, PipalMutate, PipalPaint, PipalReal, Process, TerminalIO, TIPUser, ViewerOps
EXPORTS PipalEdit =
BEGIN OPEN PipalEdit;
lastViewerPaintTime: BasicTime.Pulses;

CreateViewer: PUBLIC PROC [object: Pipal.Object] RETURNS [viewer: ViewerClasses.Viewer] ~ {
viewer _ ViewerOps.CreateViewer[$Pipal, [name: "PipalViewer", data: object]];
};

background: Imager.ConstantColor = ImagerColor.Find["Xerox/Research/ChipNDale/CD/InitialColor"];

ViewerPaint: ViewerClasses.PaintProc = {
object: Pipal.Object = self.data;
lastViewerPaintTime _ BasicTime.GetClockPulses[];
Imager.SetColor[context, background];
Imager.MaskRectangleI[context, -LAST [INTEGER]/2, -LAST [INTEGER]/2, LAST [INTEGER], LAST [INTEGER]];
PipalPaint.Paint[object, context];
lastViewerPaintTime _ BasicTime.GetClockPulses[]-lastViewerPaintTime;
};

viewerClass: ViewerClasses.ViewerClass _ NEW [ViewerClasses.ViewerClassRec _ [paint: ViewerPaint]];
ViewerData : TYPE = REF ViewerDataRec;  -- what gets hung unto the viewer
ViewerDataRec: TYPE = MONITORED RECORD [
repaintNeeded: CONDITION,
editor: Pipal.Object,
queue: PipalPaint.Queue,
notify: NotifyProc
];

MakeMenu: PROC [viewerData: ViewerData] RETURNS [menu: Menus.Menu] = {
menu _ Menus.CreateMenu[2];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Reset", proc: ResetClick, clientData: viewerData, fork: FALSE, guarded: TRUE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Undo", proc: UndoClick, clientData: viewerData, fork: FALSE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Redo", proc: RedoClick, clientData: viewerData, fork: FALSE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Flush", proc: FlushClick, clientData: viewerData, fork: FALSE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Debug", proc: DebugClick, clientData: viewerData, fork: TRUE], 1];
};

CreateBiscroller: PUBLIC PROC [editor: Pipal.Object, tipTable: Pipal.ROPE, notify: NotifyProc, buttons: BOOL _ FALSE] = {
viewerData: ViewerData _ NEW [ViewerDataRec _ [
editor: editor, queue: PipalPaint.CreateQueue[], 
notify: notify
]];
style: BiScrollers.BiScrollerStyle _ BiScrollers.GetStyle["Buttonned"]; -- Buttonless
class: BiScrollers.BiScrollerClass _ style.NewBiScrollerClass[[
flavor: $PipalBiscroller, -- Note: it has better not be the same as for creating a simple viewer ... [BS]
extrema: Extrema,
paint: Paint,
notify: Notify,
bsUserAction: ForkAndDo,
finish: LIST [$Exit],
menu: IF buttons 
THEN BiScrollers.CatenateMenus[BiScrollers.bsMenu, MakeMenu[viewerData]] 
ELSE BiScrollers.bsMenu,
icon: fileCabinet,
tipTable: TIPUser.InstantiateNewTIPTable[tipTable],
cursor: textPointer,  -- was bullseye
mayStretch: FALSE,
offsetsMustBeIntegers: TRUE,
preferIntegerCoefficients: FALSE
]];
bs: BiScrollers.BiScroller _ class.style.CreateBiScroller[class: class, info: [
name: Pipal.ClassName[Pipal.ObjectClass[editor]], 
iconic: TRUE, 
data: viewerData
]];
TRUSTED {Process.Detach[FORK RepaintViewerProcess[viewerData, BiScrollers.QuaViewer[bs, TRUE]]]};
};

Extrema: BiScrollers.ExtremaProc = {
viewerData: ViewerData _ NARROW [clientData];
size: PipalReal.Size _ PipalReal.ObjectSize[viewerData.editor];
[min, max] _ Geom2D.ExtremaOfRect[[0, 0, size.x, size.y], direction];
};

RefProc: TYPE = PROC [ref: REF];
EnqueueSetCursor: PUBLIC PROC [queue: PipalPaint.Queue, cursor: Cursors.CursorType] = {
PipalPaint.Enqueue[queue, [type: other, data: NEW [RefProc _ SetCursor], area: NEW [Cursors.CursorType _ cursor]]];
};
SetCursor: RefProc = {
Cursors.SetCursor[NARROW [ref, REF Cursors.CursorType]^];
};

RepaintViewerProcess: ENTRY PROC [viewerData: ViewerData, viewer: ViewerClasses.Viewer] = {
TRUSTED {
Process.SetTimeout[@viewerData.repaintNeeded, Process.SecondsToTicks[3]];
}; -- this time out allows for automatically endind the process when the viewer is deleted
DO
empty: BOOL; request: PipalPaint.Request;
Process.SetPriority[Process.priorityForeground];
IF PipalPaint.IsQueueEmpty[viewerData.queue] THEN WAIT viewerData.repaintNeeded;
IF viewer.destroyed OR viewer.paintingWedged THEN RETURN;
[empty, request] _ PipalPaint.Dequeue[viewerData.queue];
IF empty THEN LOOP;
Process.SetPriority[Process.priorityBackground];
SELECT request.type FROM
clearArea, paintArea, clearAndPaint	=> IF PipalPaint.IsEmptyArea[request.area] THEN LOOP;
ENDCASE		=> {};
ViewerOps.PaintViewer[viewer, client, FALSE, NEW [PipalPaint.Request _ request]]; -- until the day we have commands which change menus
Process.Yield[];
ENDLOOP;
};

Paint: ViewerClasses.PaintProc = {
bs: BiScrollers.BiScroller _ BiScrollers.QuaBiScroller[self];
viewerData: ViewerData _ NARROW [BiScrollers.ClientDataOfViewer[self]];
editor: Pipal.Object = viewerData.editor;
request: PipalPaint.Request;
IF whatChanged#NIL AND ISTYPE [whatChanged, REF PipalPaint.Request] 
THEN request _ NARROW [whatChanged, REF PipalPaint.Request]^
ELSE {
empty: BOOL;
PipalPaint.Enqueue[viewerData.queue, [type: clearAndPaint, area: PipalPaint.fullArea, data: editor]];
[empty, request] _ PipalPaint.Dequeue[viewerData.queue];
IF empty THEN RETURN;
};
SELECT request.type FROM
clearArea		=> PipalPaint.ClearArea[context, request.area];
paintArea		=> PipalPaint.ClipAndPaint[context, request.data, request.area];
clearAndPaint	=> PipalPaint.ClearClipAndPaint[context, request.data, request.area];
scale		=> {
bitransf: BiScrollers.Transform _ bs.style.GetTransforms[bs].clientToViewer;
bitransf _ ImagerTransformation.Concat[NARROW [request.data], bitransf];
bs.style.ChangeTransform[bs, bitransf, ignore];
Cursors.SetCursor[textPointer];
};
other		=> (NARROW [request.data, REF RefProc]^)[request.area];
ENDCASE		=> TRUSTED {Process.Detach[FORK TerminalIO.PutF["*** PipalEditImpl: Unknown request: %g!\n", IO.int[ORD [request.type]]]]};
Imager.SetColor[context, Imager.black];
Imager.MaskVector[context, [-1000, 0], [1000, 0]];
Imager.MaskVector[context, [0, -1000], [0, 1000]];
};

ForkAndDo: BiScrollers.BSUserActionProc
~ TRUSTED {Process.Detach[FORK BiScrollers.DoBSUserAction[bs, input]]};

Notify: ViewerClasses.NotifyProc = {
IF input.first#$Exit THEN {
viewerData: ViewerData = NARROW [BiScrollers.ClientDataOfViewer[self]];
NotifyInternal[viewerData, self, input];
};
};

NotifyInternal: ENTRY PROC [viewerData: ViewerData, viewer: ViewerClasses.Viewer, input: LIST OF REF ANY] = {
ENABLE UNWIND => NULL;
newEditor: Pipal.Object _ viewerData.notify[viewerData.editor, viewerData.queue, viewer, input];
IF newEditor=NIL THEN ERROR; -- trivial test avoiding many wedged viewers!
viewerData.editor _ newEditor;
BROADCAST viewerData.repaintNeeded;
};
editMethod: PUBLIC Pipal.Method _ Pipal.RegisterMethod["Edit"];

HasEditProc: PUBLIC PROC [object: Pipal.Object] RETURNS [BOOL] = {
RETURN [Pipal.ObjectMethod[object, editMethod]#NIL];
};

Edit: PUBLIC EditProc = {
editor _ (NARROW [Pipal.ObjectMethod[mutant, editMethod], REF EditProc]^)[mutant];
};

Debug: SIGNAL = CODE;


ClickApply: ENTRY PROC [viewerData: ViewerData, atom: ATOM] = {
ENABLE UNWIND => NULL;
resultType: PipalMutate.ResultType;
result: REF;
newEditor: Pipal.Object;
queue: PipalPaint.Queue = viewerData.queue;
area: Pipal.Object;
[resultType, result, newEditor] _ PipalMutate.ApplyCommand[viewerData.editor, atom];
IF newEditor=NIL THEN ERROR; -- trivial test avoiding many wedged viewers!
area _ SELECT resultType FROM
changedArea	=> result,
none		=> PipalPaint.fullArea,
ENDCASE		=> ERROR;
PipalPaint.Enqueue[queue, [type: clearAndPaint, area: area, data: newEditor]];
viewerData.editor _ newEditor;
BROADCAST viewerData.repaintNeeded;
};

ResetClick: Menus.ClickProc ~ {
ClickApply[NARROW [clientData], $Reset];
};

UndoClick: Menus.ClickProc ~ {
ClickApply[NARROW [clientData], $Undo];
};

RedoClick: Menus.ClickProc ~ {
ClickApply[NARROW [clientData], $Redo];
};

FlushClick: Menus.ClickProc ~ {
ClickApply[NARROW [clientData], $Flush];
};

DebugClick: Menus.ClickProc ~ {
viewerData: ViewerData = NARROW [clientData];
editor: Pipal.Object = viewerData.editor;
SIGNAL Debug[];
};

ViewerOps.RegisterViewerClass[$Pipal, viewerClass];

TerminalIO.PutRope["Pipal welcomes you\n"];

END.

–PipalEditImpl.mesa
Copyright Σ 1988 by Xerox Corporation.  All rights reserved.
Louis Monier February 3, 1988 11:33:05 am PST
Bertrand Serlet April 30, 1988 6:13:41 pm PDT

Readonly Viewers Creation
Debugging only!
BiScroller Creation
IF whatChanged is not a REF PipalPaint.Request, the whole viewer should be repainted.
Coordinate axis
Editor Making
Quick and Dirty Undo/Redo Buttons
Initialization
ΚJ–

"cedar" style˜
codeš
œ™Kš
œ<™<Kšœ*Οk™-Kš
œ-™-K™—š
	˜	Kš
œ)˜)Kšœ+œ„
˜±
—K˜•StartOfExpansion[]šΟn
œœ
˜Kšœœ˜-KšœUœ[˜Ή
Kšœ˜Kšœ
œ˜—
headš
œ™˜&K™K˜—šžœœ
œœ#˜[Kš
œM˜MK˜K˜—š
œ`˜`K˜—šΠbnœ˜(Kš
œ!˜!Kš
œ1˜1Kš
œ%˜%Kšœ œœœœœœœœ˜eKš
œ"˜"Kš
œE˜EK˜K˜—Kšœ)œ7˜c—š
œ™Kšœ
œœΟc!˜Išœœ	œ
œ˜(Kšœ	œ
˜Kš
œ˜K˜Kš
œ˜Kš
œ˜K˜—šžœœœ˜FKš
œ˜Kšœmœœ˜„
Kšœkœ˜sKšœkœ˜sKšœmœ˜uKšœmœ˜wK˜K˜—šžœœ
œ(œœœ˜yšœœ˜/Jš
œ1˜1Jš
œ˜Jš
œ˜—JšœH 
˜Uš
œ?˜?Kšœ O˜iK˜K˜
K˜Kš
œ˜Kšœœ	˜šœœ	˜KšœE˜IKšœ˜—K˜Kš
œ3˜3Kšœ ˜%Kšœœ
˜Kšœœ
˜Kšœ˜ K˜—š
œO˜OKš
œ2˜2Kšœœ˜Kš
œ˜Kš
œ˜—Kšœœ<œ˜aK˜K˜—šžœ˜$Kšœœ˜-Kš
œ?˜?Kš
œE˜EK˜K˜—Kšœ	œœœ˜ šžœœ
œ:˜WKšœ.œœ!˜sK˜—šž	œ
˜Kšœœœ˜9K˜K˜—šžœœ
œ;˜[šœ˜	Kš
œI˜IKšœ W˜Z—š
˜Kšœœ˜)Kš
œ0˜0Kšœ+œ
œ˜PKšœœœ
œ
˜9Kš
œ8˜8Kšœœ
œ
˜Kš
œ0˜0šœ˜Kšœ'œ&œ
œ
˜YKšœ˜—Kšœ&œœ" 4˜†
K˜Kšœ
˜—K˜K˜—Kšœœ:™Ušžœ˜"Kš
œ=˜=Kšœœ(˜GKš
œ)˜)Kš
œ˜š
œ
œ
œ
œœ˜DKšœœœ˜<Kšœ˜Kšœœ
˜Kš
œe˜eKš
œ8˜8Kšœœ
œ
˜K˜—šœ˜Kš
œ:˜:Kš
œK˜KKš
œS˜Sš
œ˜Kš
œL˜LKšœ'œ˜HKš
œ/˜/Kš
œ˜K˜—Kšœœœ˜>Kš
œœœ>œœ˜„
—Kš
œ™Kš
œ'˜'Kš
œ2˜2Kš
œ2˜2K˜K˜—šž	œ˜'šœœœ)˜GK˜——šžœ˜$šœœ˜Kšœœ(˜GKš
œ(˜(Kš
œ˜—K˜K˜—šžœœ
œ?œ
œ
œ
œ˜mKšœ
œœ
˜Kš
œ`˜`Kš	œœ
œ
œ -˜JKš
œ˜Kš	œ˜#K˜——™
šœœ-˜?K˜—š
žœœ
œœœ˜BKšœ)œ˜4Kš
œ˜K˜—šžœœ
˜Kšœ
œ*œ˜RK˜K˜——™!šžœœœ
˜K˜—K˜šž
œœ
œ œ˜?Kšœ
œœ
˜Kš
œ#˜#Kšœœ
˜Kš
œ˜Kš
œ+˜+K˜Kš
œT˜TKš	œœ
œ
œ -˜Jšœœ˜Kš
œ˜Kš
œ˜Kšœœ
˜—Kš
œN˜NKš
œ˜Kš	œ˜#K˜K˜—šž
œ˜Kšœœ˜(K˜K˜—šž	œ˜Kšœœ˜'K˜K˜—šž	œ˜Kšœœ˜'K˜K˜—šž
œ˜Kšœœ˜(K˜K˜—šž
œ˜Kšœœ˜-Kš
œ)˜)Kšœ	˜K˜K˜——™Kš
œ3˜3K˜K˜+—K˜Kšœ
˜—…—!*π