CDVMain.mesa (part of Chipndale)
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved.
Ch. Jacobi June 24, 1983 3:33 pm
last edited by Christian Jacobi November 5, 1984 10:22:14 am PST
DIRECTORY
Atom USING [GetPName],
CD,
CDDraw,
CDEvents,
CDExtras,
CDBasics,
CDPanel,
CDSequencer USING [Command, CommandRec, ExecuteCommand],
CDTipEtc,
CDDefaults,
CDVFurtherPainters,
CDVPrivate,
CDViewer,
CDVScale,
Cursors,
InputFocus USING [SetInputFocus],
PrincOps USING [BBTableSpace],
PrincOpsUtils,
Process USING [Detach, Yield, priorityNormal, priorityBackground, SetPriority],
Rope USING [ROPE, Concat],
RuntimeError USING [UNCAUGHT],
TerminalIO,
TIPUser USING [TIPScreenCoords],
UserProfile,
ViewerClasses,
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerOps USING [CreateViewer, RegisterViewerClass, PaintViewer, BlinkIcon, EnumProc, EnumerateViewers],
WindowManager USING [colorDisplayOn];
CDVMain: CEDAR MONITOR
IMPORTS
Atom, CDDraw, CDEvents, CDExtras, CDBasics, CDPanel, CDVFurtherPainters, CDVScale, CDSequencer, CDTipEtc, CDDefaults, CDViewer, CDVPrivate, InputFocus, PrincOpsUtils, Process, Rope, RuntimeError, TerminalIO, UserProfile, ViewerEvents, ViewerOps, WindowManager
EXPORTS CDVPrivate
SHARES CDVFurtherPainters =
BEGIN
greeting: Rope.ROPE = "Chipndale Version 18 for Cedar 5.2 ";
date: Rope.ROPE = "November 5, 1984";
copyRight: Rope.ROPE = "Copyright (C) 1984 by Xerox Corporation. All rights reserved.\n";
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
terminalLock: BOOLEAN ← FALSE;
TerminalLock: PROC [] = {terminalLock ← TRUE; viewerClassRec.cursor ← questionMark};
TerminalFree: PROC [] ={terminalLock ← FALSE; viewerClassRec.cursor ← myCursor};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
MyGraphicRef: TYPE = CDVPrivate.MyGraphicRef;
viewerClassAtom: ATOM = $Chipndale;
myCursorOK: Cursors.CursorType ←
IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE textPointer;
myCursorNoFocus: Cursors.CursorType ←
IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE pointDown;
myCursor: Cursors.CursorType ← myCursorNoFocus;
TrackRef: TYPE = REF TrackRecord; --type to force cursor tracking
TrackRecord: TYPE = RECORD [
pos: CD.DesignPosition
];
RepaintRectAreaRef: TYPE = REF RepaintRectArea; --type to force drawing a rectangular aera
RepaintRectArea: TYPE = RECORD[
rect: CD.DesignRect ← CDBasics.universe,
erase: BOOL ← FALSE
];
tryToPaint: CONDITION;
cursoredCDViewer: PUBLIC ViewerClasses.Viewer ← NIL;
inputFocussedViewer: ViewerClasses.Viewer ← NIL;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
RePaint: ViewerClasses.PaintProc =
--PROC [self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]--
--depending on whatChanged, the call must be monitored or need not
BEGIN
ENABLE {
CDVPrivate.notSupportedColorMode => GOTO errorExit;
RuntimeError.UNCAUGHT =>
IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT;
};
me: MyGraphicRef = NARROW[self.data];
TrackRefTrack: ENTRY PROC [me: MyGraphicRef, tr: TrackRef] = -- INLINE --
--must be called within monitor lock;
--called through Notify only, uses monitorlock from there
BEGIN ENABLE UNWIND => NULL;
IF me.cursorInhibitations=0 THEN {
IF me.onVC THEN me.usedCursor[me]
ELSE {
me.startVC ← me.designRec.startLC;
me.firstHorizontalVC ← me.designRec.firstHLC;
me.designRec.currentLevel ← CDDefaults.CurrentLevel[me.actualDesign];
me.defaultWidthVC ← me.designRec.widthLC ←
CDDefaults.LevelWidth[me.actualDesign, me.designRec.currentLevel];
me.onVC ← TRUE;
};
--now me.onVC is true
me.usedCursor ← me.designRec.outlineProcLC;
me.stopVC ← tr.pos;
me.usedCursor[me];
};
END;
MonitoringRemoveTrack: ENTRY PROC[me: MyGraphicRef] =
BEGIN ENABLE UNWIND => NULL;
IF me.onVC THEN {
me.usedCursor[me];
me.onVC ← FALSE;
};
END;
InternalRemoveTrack: PROC[me: MyGraphicRef] =
--must be called within monitor lock;
--called throgh Notify and ProtectedRepaint only
BEGIN
IF me.onVC THEN {
me.usedCursor[me];
me.onVC ← FALSE;
};
END;
SetUpAndRedraw: ENTRY PROC[me: MyGraphicRef] =
--called through anybody anytime;
--reset viewer data and then sets up a buffered request for redrawing
BEGIN ENABLE UNWIND => NULL;
ConsiderRemoveTrack: INTERNAL PROC[me: MyGraphicRef] = INLINE
--call this if viewer gets cleared
BEGIN
me.onVC ← FALSE;
END;
--SetUpAndRedraw
CDDraw.FlushCommands[me.ct];
ConsiderRemoveTrack[me];
CDVPrivate.CreateDrawInformation[me];
me.saveList ← NIL;
CDDraw.ModifyCommandTable[me.actualDesign, me.ct, me.deviceDrawRef.worldClip];
-- erase to allow also black backgrounds set freely by colormap
CDDraw.InsertCommand[me.ct,
CDDraw.Comm[cmd: all, erase: TRUE, rect: CDBasics.universe, ref: NIL]
];
END;
--RePaint
IF self.destroyed THEN RETURN;
me.viewerContext ← context;
WITH whatChanged SELECT FROM
tr: TrackRef => TrackRefTrack[me, tr]; -- monitored by Notify
atom: ATOM =>
IF atom=$MonitoringRemoveTrack THEN MonitoringRemoveTrack[me]
ELSE IF atom=$InternalRemoveTrack THEN InternalRemoveTrack[me] -- monitored by Notify and ProtectedRepaint
ELSE CDVFurtherPainters.CallFurther[me, atom];
area: RepaintRectAreaRef => -- monitored by ProtectedRepaint
CDVPrivate.RepaintRectAreaInViewer[me, area.rect, area.erase];
ENDCASE =>
IF whatChanged=NIL THEN SetUpAndRedraw[me] -- called from anywhere, not monitored
ELSE CDVFurtherPainters.CallFurther[me, whatChanged];
EXITS errorExit => NULL;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
EnableCursoring: ENTRY PROC[me: MyGraphicRef] =
--this procedure is logically local to ProtectedRepaint;
--but it must be callable in catch phrase
BEGIN
me.cursorInhibitations ← me.cursorInhibitations-1;
BROADCAST tryToPaint
END;
ProtectedRepaint: PROC[me: MyGraphicRef, whatChanged: REF ANY] =
BEGIN
ENABLE RuntimeError.UNCAUGHT => {
EnableCursoring[me];
IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT
};
DisableCursoring: ENTRY PROC[me: MyGraphicRef] =
BEGIN
ENABLE {
UNWIND => NULL;
RuntimeError.UNCAUGHT => {
IF me.cursorInhibitations>0 THEN me.cursorInhibitations ← me.cursorInhibitations-1;
BROADCAST tryToPaint;
IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT;
};
};
me.cursorInhibitations ← me.cursorInhibitations+1;
WHILE me.cursorInhibitations>1 DO
me.cursorInhibitations ← me.cursorInhibitations-1;
WAIT tryToPaint;
me.cursorInhibitations ← me.cursorInhibitations+1;
ENDLOOP;
IF me.onVC THEN ViewerOps.PaintViewer[me.viewer, client, FALSE, $InternalRemoveTrack];
EXITS errorExit => NULL;
END;
--ProtectedRepaint
DisableCursoring[me];
ViewerOps.PaintViewer[me.viewer, client, FALSE, whatChanged];
EnableCursoring[me];
EXITS
errorExit => NULL;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
ViewerProcess: PROC[me: MyGraphicRef] =
BEGIN
comm: REF CDDraw.Comm ~ NEW[CDDraw.Comm];
bBTableSpace1, bBTableSpace2: PrincOps.BBTableSpace;
--me.xBLT is a short pointer! (hardware) therefore must be local to some
--procedure space.
IF me.running THEN ERROR;
TRUSTED {
me.pBBptr ← PrincOpsUtils.AlignedBBTable[@bBTableSpace1];
me.xBBptr ← PrincOpsUtils.AlignedBBTable[@bBTableSpace2]
};
me.running ← TRUE;
DO
comm^ ← CDDraw.FetchCommand[me.ct];
SELECT comm.cmd FROM
rect => {
paintArea: RepaintRectAreaRef ← NEW[RepaintRectArea←[comm.rect, comm.erase]];
IF me.hurryUp THEN TRUSTED {Process.SetPriority[Process.priorityNormal]};
ProtectedRepaint[me, paintArea];
};
all => {
paintArea: RepaintRectAreaRef ← NEW[RepaintRectArea←[comm.rect, TRUE]];
IF me.hurryUp THEN TRUSTED {Process.SetPriority[Process.priorityNormal]};
ProtectedRepaint[me, paintArea];
};
ref => ProtectedRepaint[me, comm];
alldone => {
ProtectedRepaint[me, $Temporaries];
me.hurryUp ← FALSE;
TRUSTED {Process.SetPriority[Process.priorityBackground]};
};
none => Process.Yield[];
disapearforever => EXIT;
ENDCASE => ProtectedRepaint[me, comm];
ENDLOOP;
me.running ← FALSE;
me.ct ← NIL;
me.actualDesign ← NIL;
me.designRec ← NIL;
TerminalIO.WriteRope["Viewer destroyed\n"];
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
MonitoringRemoveCursor: PROC [me: MyGraphicRef] =
--removes visible cursor, if there is
--monitores inside viewerpaintproc
INLINE BEGIN
IF me.onVC THEN
ViewerOps.PaintViewer[me.viewer, client, FALSE, $MonitoringRemoveTrack];
END;
InternalRemoveCursor: PROC [me: MyGraphicRef] =
--removes visible cursor, if there is
--logically local to (Modify and Notify)
--assumes monitored correctly, is INTERNAL
INLINE BEGIN
ViewerOps.PaintViewer[me.viewer, client, FALSE, $InternalRemoveTrack];
END;
Modify: ViewerClasses.ModifyProc -- PROC [self: Viewer, change: ModifyAction] -- =
BEGIN
ENABLE UNWIND => NULL;
SELECT change FROM
set, pop => inputFocussedViewer ← self;
kill, push => inputFocussedViewer←NIL;
ENDCASE => NULL;
IF cursoredCDViewer=inputFocussedViewer THEN myCursor ← myCursorOK
ELSE myCursor ← myCursorNoFocus;
IF ~terminalLock THEN viewerClassRec.cursor ← myCursor;
END;
Notify: ViewerClasses.NotifyProc
-- PROC [self: Viewer, input: LIST OF REF ANY] -- =
-- ENTRY ommitted since sequential already be viewer package
BEGIN
ENABLE {
UNWIND => NULL;
--sorry; this really happens because: some data is set up by the first call
--of the viewerpaint procedure; but sometime the Notify procedure is called first
--we will not bother every call of Notify to check for that.
RuntimeError.UNCAUGHT =>
IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT;
};
me: MyGraphicRef = NARROW[self.data];
mouse: CD.Position←[0, 0];--be a little robust, there are crazy people writing tiptables
LogicalTrack: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = INLINE
--makes cursor logically available
BEGIN
IF NOT me.designRec.startLCValid THEN {
me.designRec.startLC ← pos;
me.designRec.startLCValid ← TRUE;
}
END;
LogicalTrackOff: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = INLINE
--makes cursor logically unavailable
BEGIN
me.designRec.stopLC ← pos;
me.designRec.startLCValid ← FALSE;
END;
Track: PROC [me: MyGraphicRef] =
--uses intermediate level variable mouse
BEGIN
VisibleTrack: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = INLINE
--makes cursor visible
BEGIN
tr: TrackRef ~ NEW[TrackRecord];
tr.pos ← pos;
ViewerOps.PaintViewer[me.viewer, client, FALSE, tr];
END;
--Track
pos: CD.DesignPosition = CDVScale.ViewerToDesignPosition[me.scale, mouse];
LogicalTrack[me, pos];
IF me.cursorInhibitations#0 THEN RETURN;
VisibleTrack[me, pos]
END;
StopTrack: PROC [me: MyGraphicRef] =
--uses intermediate level variable mouse
BEGIN
pos: CD.DesignPosition = CDVScale.ViewerToDesignPosition[me.scale, mouse];
me.hurryUp ← TRUE;
LogicalTrackOff[me, pos];
MonitoringRemoveCursor[me];
CDVPrivate.SetCursorMode[me, NIL];
END;
--Notify
IF self#cursoredCDViewer THEN {
tem: ViewerClasses.Viewer = cursoredCDViewer;
IF me.deviceDrawRef=NIL THEN {
--silly cedar viewer system allows calls of notify before
--the first call to the paintprocedure happened;
--but for here, some initializations happen in paintprocedure only
--but at that time cursoredCDViewer can not be self; here is the only
--place to initialize cursoredCDViewer
RETURN
};
IF tem#NIL AND tem.data#NIL THEN {
temMe: MyGraphicRef = NARROW[tem.data];
MonitoringRemoveCursor[temMe];
};
cursoredCDViewer ← self;
IF self=inputFocussedViewer THEN myCursor ← myCursorOK
ELSE myCursor ← myCursorNoFocus;
IF ~terminalLock THEN viewerClassRec.cursor ← myCursor;
};
DO -- loop over input list:
--FOR input ← input, input.rest WHILE input # NIL DO
--is programmed explicitely because internally input is changed also
IF input=NIL THEN EXIT;
WITH input.first SELECT FROM
coords: TIPUser.TIPScreenCoords => {
mouse.x ← MIN[MAX[coords.mouseX, 0], me.viewer.cw-1];
mouse.y ← MIN[MAX[coords.mouseY, 0], me.viewer.ch-1];
};
atom: ATOM =>
IF atom=$Track THEN Track[me]
ELSE IF terminalLock THEN {
IF atom#$StopTrack THEN ViewerOps.BlinkIcon[self];
RETURN
}
ELSE {
InputFocus.SetInputFocus[self: self];
SELECT atom FROM
$StopTrack => StopTrack[me];
$UseCursor => {
MonitoringRemoveCursor[me];
input ← input.rest;
IF input=NIL THEN RETURN;
CDVPrivate.SetCursorMode[me, input.first]
};
$StopDrawing => CDDraw.FlushCommands[me.ct];
ENDCASE => {
StopTrack[me];
TRUSTED {Process.Detach[FORK CDSequencer.ExecuteCommand[
design: me.actualDesign,
comm: NEW[CDSequencer.CommandRec�Sequencer.CommandRec[
design: me.actualDesign,
a: atom,
pos: me.designRec.stopLC,
sPos: me.designRec.startLC,
l: me.designRec.currentLevel,
ref: me,
n: me.defaultWidthVC,
b: me.designRec.firstHLC
]]]]
}; --trusted
}; --endcase
}; --atom
ENDCASE;
input ← input.rest
ENDLOOP;
EXITS errorExit => NULL;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
TechnologyName: PROC [t: CD.Technology] RETURNS [Rope.ROPE] = {
RETURN [IF t.name#NIL THEN t.name ELSE Atom.GetPName[t.key]]
};
CaptionText: PROC [design: CD.Design] RETURNS [Rope.ROPE] =
BEGIN
name: Rope.ROPE;
IF design=NIL THEN RETURN["nil design"];
name ← Rope.Concat[(IF design.name#NIL THEN design.name ELSE "no name"), " ("];
name ← Rope.Concat[name, TechnologyName[design.technology]];
name ← Rope.Concat[name, ") cell: "];
name ← Rope.Concat[name, CDExtras.PushedCellName[design]];
RETURN [name]
END;
RepaintCaptions: CDEvents.EventProc =
-- PROC [event: REF, design: CD.Design, x: REF] --
-- repaint captions and sometimes the contents
BEGIN
name: Rope.ROPE = CaptionText[design];
FOR l: CDViewer.ViewerList ← CDViewer.ViewersOf[design], l.rest WHILE l#NIL DO
me: MyGraphicRef = NARROW [l.first.data];
l.first.name ← name;
ViewerOps.PaintViewer[l.first, caption];
IF event=$AfterPop OR event=$AfterPush THEN {
--redraw everithing, because
--  after pop: cell change may have propagated
--  after push: background features must be redrawn greyish
CDDraw.InsertCommand[me.ct, CDDraw.Comm[cmd: all, erase: TRUE, rect: CDBasics.universe, ref: NIL]]
}
ENDLOOP;
END;
CreateViewer: PUBLIC PROC[design: CD.Design] RETURNS [ViewerClasses.Viewer]=
BEGIN
b: CD.DesignRect ← CDExtras.BoundingBox[design];
me: MyGraphicRef = CDVPrivate.NewAndLink[design];
me.ct ← CDDraw.CreateCommandTable[me.actualDesign, [1, 1, 0, 0], me.stoprequest];
TRUSTED {Process.Detach[FORK ViewerProcess[me]]};
[] ← CDPanel.CreatePanel[design];
--must wait until me.xBLT is initialized by ViewerProcess
WHILE NOT me.running DO Process.Yield[] ENDLOOP;
--normal creation
me.viewer ← ViewerOps.CreateViewer[
flavor: viewerClassAtom,
info: [
name: CaptionText[design], 
scrollable: FALSE,
icon: CDTipEtc.GetIcon[design],
iconic: FALSE,
column: ColumnForNewViewer[],
tipTable: CDTipEtc.GetTipTable[design],
data: me
]
];
IF CDBasics.NonEmpty[b] THEN CDViewer.ShowAndScale[me.viewer, b];
RETURN [me.viewer]
END;
ColumnForNewViewer: PROC [] RETURNS [col: ViewerClasses.Column←left] =
--selects colordisplay if it is on and free
BEGIN
found: BOOL←FALSE;
CheckTheColorScreen: ViewerOps.EnumProc = {
--PROC [v: Viewer] RETURNS [BOOL ← TRUE] --
IF v.column=color AND ~v.iconic AND ~v.offDeskTop THEN {found←TRUE; RETURN[FALSE]};
};
IF WindowManager.colorDisplayOn AND
UserProfile.Boolean["Chipndale.FirstViewerOnColor", FALSE] THEN {
ViewerOps.EnumerateViewers[CheckTheColorScreen];
IF ~found THEN col ← color
}
END;
Destroy: ViewerClasses.DestroyProc -- PROC [self: Viewer] -- =
BEGIN
me: MyGraphicRef ~ NARROW[self.data];
CDVPrivate.UnLink[me];
CDDraw.DestroyCommandTable[me.ct];
self.data ← NIL
END;
CallOnClose: ViewerEvents.EventProc =
-- PROC [viewer: ViewerClasses.Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE]
BEGIN
me: MyGraphicRef ~ NARROW[viewer.data];
IF event#close THEN ERROR;
CDDraw.ModifyCommandTable[me.actualDesign, me.ct, CDBasics.empty];
END;
NoteProfileChange: UserProfile.ProfileChangedProc =
-- PROC [reason: ProfileChangeReason]
BEGIN
myCursorOK ←
IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE textPointer;
myCursorNoFocus ←
IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE myCursorNoFocus;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
--Define viewerclass and command
viewerClassRec: ViewerClasses.ViewerClass;
Init: PROC [] =
BEGIN
TerminalIO.WriteRope[greeting];
TerminalIO.WriteRope[date];
TerminalIO.WriteLn[];
TerminalIO.WriteRope[copyRight];
TerminalIO.AddLock[TerminalLock, TerminalFree];
viewerClassRec ← NEW[ViewerClasses.ViewerClassRec ← [
paint: RePaint,
notify: Notify,
modify: Modify,
destroy: Destroy,
cursor: myCursorNoFocus
]];
ViewerOps.RegisterViewerClass[viewerClassAtom, viewerClassRec];
[] ← ViewerEvents.RegisterEventProc[proc: CallOnClose, event: close, filter: viewerClassAtom, before: FALSE];
CDEvents.RegisterEventProc[$ResetDesign, RepaintCaptions];
CDEvents.RegisterEventProc[$RenameDesign, RepaintCaptions];
CDEvents.RegisterEventProc[$AfterPush, RepaintCaptions];
CDEvents.RegisterEventProc[$AfterPop, RepaintCaptions];
UserProfile.CallWhenProfileChanges[NoteProfileChange];
END;
Init[];
END.