DIRECTORY BasicTime, BiScrollers, Cursors, Geom2D, Imager, ImagerBackdoor, ImagerTransformation, InputFocus, IO, List, Menus, Pipal, PipalDisplay, PipalEdit, PipalOverlayEditor, PipalPaint, PipalReal, Process, Real, RefTab, TerminalIO, TIPUser, ViewerClasses, ViewerOps;

PipalDisplayImpl: CEDAR PROGRAM
IMPORTS BasicTime, BiScrollers, Cursors, Geom2D, Imager, ImagerBackdoor, ImagerTransformation, InputFocus, List, Menus, Pipal, PipalEdit, PipalOverlayEditor, PipalPaint, PipalReal, Process, TerminalIO, TIPUser, ViewerOps
EXPORTS PipalDisplay =
BEGIN OPEN PipalDisplay;
lastViewerPaintTime: BasicTime.Pulses;

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

ViewerPaint: ViewerClasses.PaintProc = {
object: Pipal.Object = self.data;
lastViewerPaintTime _ BasicTime.GetClockPulses[];
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 = RECORD [
editor: PipalEdit.Editor,
mouseNow: PipalReal.Position _ PipalReal.zeroVector,  -- mouse position now
mouseDown: PipalReal.Position _ PipalReal.zeroVector,  -- mouse position when a button went down
previousTrackingArea: Pipal.Object _ Pipal.void,  -- previous area modified by tracking; should be cleaned up at every paint if non nil!
moving: BOOL _ FALSE,
cursor: ViewerClasses.CursorType _ textPointer
];

lastBiscrollerPaintTime: BasicTime.Pulses;

CreateEditorBiscroller: PUBLIC PROC [editor: PipalEdit.Editor, tipTable: Pipal.ROPE, menu: Menus.Menu _ NIL] RETURNS [bs: BiScrollers.BiScroller] ~ {
viewerData: ViewerData;
style: BiScrollers.BiScrollerStyle _ BiScrollers.GetStyle["Buttonned"]; -- Buttonless
class: BiScrollers.BiScrollerClass _ style.NewBiScrollerClass[[
flavor: $BiPipal, -- Note: it has better not be the same as for creating a simple viewer ... [BS]
extrema: Extrema,
paint: BiscrollerPaint,
notify: Notify,
bsUserAction: ForkAndDo,
finish: LIST [$Exit],
menu: IF menu=NIL THEN BiScrollers.bsMenu ELSE BiScrollers.CatenateMenus[BiScrollers.bsMenu, menu],
icon: fileCabinet,
tipTable: TIPUser.InstantiateNewTIPTable[tipTable],
cursor: textPointer,  -- was bullseye
mayStretch: FALSE,
offsetsMustBeIntegers: TRUE,
preferIntegerCoefficients: FALSE
]];
info: ViewerClasses.ViewerRec _ [name: "Pipal", 
iconic: TRUE, 
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];
size: PipalReal.Size _ PipalReal.ObjectSize[viewerData.editor.object];
[min, max] _ Geom2D.ExtremaOfRect[[0, 0, size.x, size.y], direction];
};

PaintBBox: PROC [context: Imager.Context, object: Pipal.Object, color: Imager.Color _ Imager.black] ~ {
PipalPaint.PaintOutline[context, PipalReal.BBox[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: Pipal.Object,  -- redisplay the data structure inside these areas
outlines: Pipal.Object  -- then paint these outlines
];

BiscrollerPaint: ViewerClasses.PaintProc = {
viewerData: ViewerData _ NARROW [BiScrollers.ClientDataOfViewer[self]];
editor: PipalEdit.Editor = viewerData.editor;
lastBiscrollerPaintTime _ BasicTime.GetClockPulses[];
Imager.SetColor[context, Imager.black];
Imager.MaskVector[context, [-1000, 0], [1000, 0]];
Imager.MaskVector[context, [0, -1000], [0, 1000]];
IF whatChanged=NIL THEN {
PipalPaint.Paint[editor, context];
viewerData.previousTrackingArea _ Pipal.void;
}
ELSE {
clipArea, outlines: Pipal.Object _ NIL;
[clipArea, outlines] _ NARROW [whatChanged, WhatChanged]^;
clipArea _ Pipal.CreateOverlay[LIST [clipArea, viewerData.previousTrackingArea]];
viewerData.previousTrackingArea _ Pipal.void;
PipalPaint.ClipAndPaint[editor, context, clipArea];
PipalPaint.PaintAreaOutline[context, outlines];
};
lastBiscrollerPaintTime _ BasicTime.GetClockPulses[]-lastBiscrollerPaintTime;
};

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

TranslateArea: PROC [object: Pipal.Object, delta: PipalReal.Vector] RETURNS [new: Pipal.Object _ NIL] = {
new _ PipalReal.TransformObject[ImagerTransformation.Translate[delta], object];
};

Notify: ViewerClasses.NotifyProc = {
viewerData: ViewerData _ NARROW [BiScrollers.ClientDataOfViewer[self]];
atom: ATOM = NARROW [input.first];
result: REF;
resultType: PipalEdit.ResultType;
SELECT atom FROM
$Exit => NULL;  -- only if the viewer has been "activated", whatever it means
$MouseDown => {
viewerData.mouseDown _ NARROW [input.rest.first, BiScrollers.ClientCoords]^;
InputFocus.SetInputFocus[self];
};
$TrackSelected => {
area: Pipal.Object;
clipArea: Pipal.Object;
IF NOT viewerData.moving THEN viewerData.mouseDown _ NARROW [input.rest.first, BiScrollers.ClientCoords]^;
viewerData.mouseNow _ NARROW [input.rest.first, BiScrollers.ClientCoords]^;
[resultType, result] _ PipalEdit.ApplyCommand[viewerData.editor, $SelectedOutlines, NIL, self];
IF resultType#selectionArea THEN ERROR;
area _ TranslateArea[result, PipalReal.Sub[viewerData.mouseNow, viewerData.mouseDown]];
clipArea _ PipalPaint.CreateAreaAnnotation[area, edgesChildren];
ViewerOps.PaintViewer[self, client, FALSE, NEW [WhatChangedRec _ [
clipArea: clipArea, 
outlines: area
]]];
viewerData.previousTrackingArea _ clipArea;
};
$Scrolling => {
Cursors.SetCursor[move];
};
$Scroll => {
cc: PipalReal.Position _ NARROW [input.rest.first, BiScrollers.ClientCoords]^;
delta: ImagerTransformation.VEC _ [
cc.x-viewerData.mouseDown.x, 
cc.y-viewerData.mouseDown.y];
bs: BiScrollers.BiScroller _ BiScrollers.QuaBiScroller[self];
tr: BiScrollers.Transform _ bs.style.GetTransforms[bs].clientToViewer;
tr _ ImagerTransformation.PreTranslate[tr, delta];
bs.style.ChangeTransform[bs, tr, ignore];
Cursors.SetCursor[textPointer];
};
ENDCASE => {
arguments: LIST OF REF _ NIL;
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], self];
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: result, outlines: Pipal.void]]];
ENDCASE => ERROR;  -- including object
};

viewerData.moving _ atom=$TrackSelected;
};

Debug: SIGNAL = CODE;

EditorTest: PROC [editor: PipalEdit.Editor, tipTable: Pipal.ROPE] RETURNS [bs: BiScrollers.BiScroller] = {
menu: Menus.Menu _ Menus.CreateMenu[2];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Reset", proc: ResetClick, clientData: editor, fork: FALSE, guarded: TRUE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Undo", proc: UndoClick, clientData: editor, fork: FALSE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Redo", proc: RedoClick, clientData: editor, fork: FALSE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Flush", proc: FlushClick, clientData: editor, fork: FALSE]];
Menus.AppendMenuEntry[menu, Menus.CreateEntry[name: "Debug", proc: DebugClick, clientData: editor, fork: TRUE], 1];
bs _ CreateEditorBiscroller[editor, tipTable, menu];
};

ResetClick: Menus.ClickProc ~ {
editor: PipalEdit.Editor _ NARROW [clientData];
PipalEdit.Reset[editor];
ViewerOps.PaintViewer[parent, all];
};

UndoClick: Menus.ClickProc ~ {
editor: PipalEdit.Editor _ NARROW [clientData];
IF editor.undoEvents=NIL 
THEN TerminalIO.PutF["*** Cannot Undo.\n"] 
ELSE PipalEdit.Undo[editor];
ViewerOps.PaintViewer[parent, all];
};

RedoClick: Menus.ClickProc ~ {
editor: PipalEdit.Editor _ NARROW [clientData];
IF editor.redoEvents=NIL 
THEN TerminalIO.PutF["*** Cannot Redo.\n"] 
ELSE PipalEdit.Redo[editor];
ViewerOps.PaintViewer[parent, all];
};

FlushClick: Menus.ClickProc ~ {
editor: PipalEdit.Editor _ NARROW [clientData];
PipalEdit.Flush[editor];
ViewerOps.PaintViewer[parent, all];
};

DebugClick: Menus.ClickProc ~ {
editor: PipalEdit.Editor _ NARROW [clientData];
SIGNAL Debug[];
ViewerOps.PaintViewer[parent, all];
};

PushCommand: PipalEdit.CommandProc = {
editors: LIST OF PipalEdit.Editor _ PipalOverlayEditor.Push[editor];
WHILE editors#NIL DO
[] _ EditorTest[editors.first, "[]<>Users>serlet.pa>Pipal.TIP"]; -- AAAARRRGH
editors _ editors.rest;
ENDLOOP;
};

PopCommand: PipalEdit.CommandProc = {
viewer: ViewerClasses.Viewer = NARROW [issuer];
TRUSTED {Process.Detach[FORK PipalEdit.DestroyEditor[editor]]}; -- believe it or not if you don't fork, you lock the viewers! (because of TerminalIO!)
};

PipalEdit.RegisterCommand[PipalOverlayEditor.overlayEditorClass, $Push, PushCommand];
PipalEdit.RegisterCommand[PipalOverlayEditor.overlayEditorClass, $Pop, PopCommand];
ViewerOps.RegisterViewerClass[$Pipal, viewerClass];

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

END.
ToBits: PROC [lines: ARRAY [0..16) OF Rope.ROPE] RETURNS [bits: Cursors.CursorArray] ~ {
FOR line: NAT IN [0..16) DO
bits[line] _ 0;
FOR i: NAT IN [0..16) DO
bits[line] _ 2*bits[line];
IF Rope.Equal[lines[line][i], "X"] THEN bits[line] _ bits[line]+1
ENDLOOP;
ENDLOOP;
};
HandCursor: PROC RETURNS [Cursors.CursorType] ~ {
dots: ARRAY [0..16) Rope.ROPE;
dots[0] 	= "................";
dots[1] 	= "................";
dots[2] 	= "................";
dots[3] 	= "................";
dots[4] 	= "................";
dots[5] 	= "................";
dots[6] 	= "................";
dots[7] 	= "................";
dots[8] 	= "................";
dots[9] 	= "................";
dots[10] 	= "................";
dots[11] 	= "................";
dots[12] 	= "................";
dots[13] 	= "................";
dots[14] 	= "................";
dots[15] 	= "................";
RETURN [Cursors.NewCursor[ToBits[dots]]];

};

^PipalDisplayImpl.mesa
Copyright Σ 1988 by Xerox Corporation.  All rights reserved.
Louis Monier February 3, 1988 11:33:05 am PST
Bertrand Serlet February 4, 1988 2:03:34 am PST

Viewers
Debugging only!
BiScroller

-- coordinate axis
-- bbox of the editor
PaintBBox[context, editor.object];
-- extra things to paint
-- Paint the data structure
-- Paint the data structure
Commands
End: PROC [viewerData: ViewerData] ~ {
child: Pipal.Object;
translation: PipalInt.Vector _ [Real.Round[viewerData.mouseNow.x-viewerData.mouseDown.x], Real.Round[viewerData.mouseNow.y-viewerData.mouseDown.y]];
state: State _ NARROW [viewerData.editor.state];
IF state.selected=NIL THEN RETURN;  -- no selection
child _ state.selected.first;
PipalEdit.ReplaceInEditor[viewerData.editor, child, PipalInt.TransformObject[[translation], child], state];
ViewerOps.PaintViewer[viewerData.v, all];
};

Exit: PROC [viewerData: ViewerData] ~ {  -- when mouse exits the viewer
Cursors.SetCursor[textPointer];
};
Little Quick and Dirty Test
Push / Pop
ViewerOps.CloseViewer[viewer]; -- this one does very very strange things ...
Initialization
Κ
Œ–

"cedar" style˜
codeš
œ™Kš
œ<™<Kšœ*Οk™-Kš
œ/™/K™—Kš	œdœŸ
˜ŽK˜•StartOfExpansion[]šΟnœœ
˜KšœΥ
˜ά
Kšœ˜Kšœ
œ˜—
head™˜&K™K˜—šžœœ
œœ#˜aKš
œG˜GK˜K˜—šΠbnœ˜(Kš
œ!˜!Kš
œ1˜1Kš
œ"˜"Kš
œE˜EK˜—K˜Kšœ)œ7˜c—š
œ
™
Kšœ
œœΟc!˜Išœœœ˜Kš
œ˜Kšœ6 ˜KKšœ7 )˜`Kšœ2 V˜ˆ
Kšœœœ
˜Kš
œ.˜.Kš
œ˜K˜—Kš
œ*˜*K˜šžœœ
œ,œœœ!˜•
Kš
œ˜JšœH 
˜Uš
œ?˜?Kšœ O˜aK˜K˜K˜Kš
œ˜Kšœœ	˜Kš	œœœ
œœ5˜cK˜Kš
œ3˜3Kšœ ˜%Kšœœ
˜Kšœœ
˜Kšœ˜ K˜—š
œ0˜0Kšœœ˜Kšœœ%˜.—K˜<Kšœ
œ˜2K˜K˜—šžœ˜$Kšœœ
˜,Kš
œF˜FKš
œE˜EK˜K˜—šž	œœX˜gKš
œ@˜@K˜K˜—Kšœ@œ 
˜Ršž
œœq˜„
Kš
œ6˜6Kš
œ ˜ Kš
œ@˜@K˜—K™Kšœ
œœ˜'šœœœ˜Kšœ 2˜KKšœ ˜4Kš
œ˜K˜—šžœ˜,Kšœœ(˜GKš
œ-˜-Kš
œ5˜5Kš
 ™Kš
œ'˜'Kš
œ2˜2Kš
œ2˜2Kš
 ™Kš
œ"™"Kš
 ™šœ
œ
œ˜Kš
 ™Kš
œ"˜"Kš
œ-˜-K˜
—šœ˜Kšœ#œ
˜'Kšœœ˜:Kš
 ™Kšœœ.˜QKš
œ-˜-Kš
œ3˜3Kš
œ/˜/K˜—Kš
œM˜MK˜K˜—šž	œ˜'šœœœ)˜GK˜———™šž
œœ1œœ˜iKš
œO˜OK˜K˜—šžœ˜$Kšœœ(˜GKšœœœ˜"Kšœœ
˜Kš
œ!˜!šœ˜Kšœ	œ =˜Mš
œ˜Kšœœ/˜LKš
œ˜K˜—š
œ˜Kš
œ˜Kš
œ˜Kšœ
œœœ/˜jKšœœ/˜KKšœTœ˜_Kšœœ
œ
˜'Kš
œW˜WKš
œ@˜@šœ$œœ˜BKš
œ˜Kš
œ˜Kš
œ˜—Kš
œ+˜+K˜—˜Kš
œ˜K˜—˜Kšœœ/˜Nšœœ˜#Kš
œ˜Kš
œ˜—Kš
œ=˜=Kš
œF˜FKš
œ2˜2Kš
œ)˜)Kš
œ˜K˜—šœ˜Kš	œœ
œ
œœ
˜š
œœ
œ
œœœ
˜?šœœ
˜š
œ!˜!Kš
œ˜Kšœœ˜!K˜—šœœœ˜Kšœœœ5˜YKšœœ˜.—Kšœœ˜/—Kšœ
˜—Kš
œf˜fšœ˜Kšœ- 4˜aKšœ3œœ>˜{Kšœœ ˜&—K˜K˜——Kš
œ(˜(K˜K˜—šžœœ™&Kš
œ™Kš
œ”
™”
Kšœœ™0Kš	œœ
œ
œ ™3Kš
œ™Kš
œk™kKš
œ)™)K™K™—šžœœ ™GKš
œ™K™——™šžœœœ
˜K˜—šž
œœ,œœ!˜jKš
œ'˜'Kšœiœœ˜€
Kšœgœ˜oKšœgœ˜oKšœiœ˜qKšœiœ˜sKš
œ4˜4K˜—K˜šž
œ˜Kšœœ˜/Kš
œ˜Kš
œ#˜#K˜K˜—šž	œ˜Kšœœ˜/šœœ
˜Kšœ'˜+Kšœ˜—Kš
œ#˜#K˜K˜—šž	œ˜Kšœœ˜/šœœ
˜Kšœ'˜+Kšœ˜—Kš
œ#˜#K˜K˜—šž
œ˜Kšœœ˜/Kš
œ˜Kš
œ#˜#K˜K˜—šž
œ˜Kšœœ˜/Kšœ	˜Kš
œ#˜#K˜K˜——™
šžœ˜&Kšœ	œ
œ4˜Dšœ	œ
˜KšœA Πbc	˜MKš
œ˜Kšœ
˜—K˜K˜—šž
œ˜%Kšœœ
˜/Kšœœ$ V˜–
Kš
ΟbL™LK˜K˜—Kš
œU˜UKš
œS˜S—™Kš
œ3˜3K˜K˜+—K˜Kšœ
˜šžœœ	œ	œœœ ˜Xšœœ
œ	˜Kš
œ˜šœœ
œ	˜Kš
œ˜Kšœ!œ˜AKšœ
˜—Kšœ
˜—K˜—šž
œœ
œ˜1Kšœœœ
˜KšœΟfœ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ£œ˜Kšœ
£œ˜Kšœ
£œ˜Kšœ
£œ˜Kšœ
£œ˜Kšœ
£œ˜Kšœ
£œ˜Kšœ#˜)K˜K˜—K˜—…—)ΰ8Κ