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;
Readonly Viewers Creation
lastViewerPaintTime: BasicTime.Pulses;
Debugging only!
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]];
BiScroller Creation
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;
};
IF whatChanged is not a REF PipalPaint.Request, the whole viewer should be repainted.
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]]]]};
Coordinate axis
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;
};
Quick and Dirty Undo/Redo Buttons
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[];
};