DIRECTORY
CD, 
CDBasics,
CDCells,
CDColors,
CDCommandOps,
CDDrawQueue,
CDEnvironment USING [GetTipTable, GetIcon],
CDEvents,
CDLayers USING [CurrentLayer, LayerWidth],
CDPanel,
CDProperties,
CDSequencer USING [Command, CommandRec, ExecuteCommand],
CDValue USING [Fetch, Store, FetchInt],
CDVFurtherPainters USING [CallFurther, FurtherPaintProc, InstallFurtherPaint],
CDViewer,
CDViewerBase,
CDVPrivate, 
CDVScale,
CedarProcess USING [SetPriority, Priority],
Cursors USING [CursorType],
DebuggerSwap USING [WorryCallDebugger],
InputFocus USING [SetInputFocus, PopInputFocus],
InterminalBackdoor USING [terminal],
PrincOps USING [BBTableSpace],
PrincOpsUtils USING [AlignedBBTable],
Process USING [Detach, Yield],
Rope USING [ROPE, Cat],
RuntimeError USING [UNCAUGHT],
SafeStorage USING [ReclaimCollectibleObjects],
Terminal USING [GetColorMode],
TerminalIO USING [AddLock, WriteRope, WriteRopes],
TIPUser USING [TIPScreenCoords],
UserProfile USING [Boolean, ProfileChangedProc, CallWhenProfileChanges],
ViewerClasses USING [Viewer, ViewerClass, ViewerClassRec, PaintProc, ModifyProc, NotifyProc, Column, DestroyProc],
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerOps USING [CreateViewer, RegisterViewerClass, PaintViewer, BlinkIcon, EnumProc, EnumerateViewers],
WindowManager USING [colorDisplayOn];

CDVMain: CEDAR MONITOR 
IMPORTS 
CD, CDBasics, CDCells, CDColors, CDCommandOps, CDDrawQueue, CDEnvironment, CDEvents, CDLayers, CDPanel, CDProperties, CDSequencer, CDValue, CDVFurtherPainters, CDViewer, CDViewerBase, CDVPrivate, CDVScale, CedarProcess, DebuggerSwap, InputFocus, InterminalBackdoor, PrincOpsUtils, Process, Rope, RuntimeError, SafeStorage, Terminal, TerminalIO, UserProfile, ViewerEvents, ViewerOps, WindowManager 
EXPORTS CDVPrivate 
SHARES CDVFurtherPainters, TerminalIO, CDDrawQueue =
BEGIN
  
greeting: Rope.ROPE = "ChipNDale    Version 2.3 for Cedar 6.1 ";
date: Rope.ROPE = "August 4, 1986";
copyRight: Rope.ROPE = "\nCopyright (C) 1984, 1986 by Xerox Corporation.  All rights reserved.\n\n";

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
VRef: TYPE = CDVPrivate.VRef;
Viewer: TYPE = ViewerClasses.Viewer;

viewerClassAtom: ATOM = $ChipNDale;

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

tryToPaint: CONDITION;

notSupportedColorMode: PUBLIC ERROR = CODE;
putNewViewerOnColor: BOOL _ TRUE;

allVRefs: PUBLIC LIST OF VRef _ NIL;

catchCritical, catchWedging: BOOL _ TRUE;
errorRef: REF _ NIL;
errorMsg: Rope.ROPE _ NIL;
useForShallContinue: CDVPrivate.DebugProc _ DefaultDebug;

UseDebug: PUBLIC PROC [proc: CDVPrivate.DebugProc] = {
useForShallContinue _ proc
}; 

DefaultDebug: PROC [ref: REF, wedge: BOOL, msg: Rope.ROPE] RETURNS [shallCont: BOOL] = {
errorRef _ ref;
errorMsg _ msg;
shallCont _ catchCritical OR (wedge AND catchWedging);
IF ~shallCont THEN
DebuggerSwap.WorryCallDebugger["ChipNDale wedge"];
};

ShallContinue: PUBLIC PROC [ref: REF_NIL, wedge: BOOL_FALSE, msg: Rope.ROPE_NIL] RETURNS [yes: BOOL_TRUE] = {
sc: CDVPrivate.DebugProc _ useForShallContinue;
IF sc#NIL THEN yes _ sc[ref, wedge, msg];
};

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

terminalLock: BOOL _ FALSE;

TerminalLock: PROC [] = {
terminalLock _ TRUE; 
viewerClassRec.cursor _ cursorWhileInput
};

TerminalFree: PROC [] ={
terminalLock _ FALSE; 
SetCursor[]
};



TrackRef: TYPE = REF TrackRecord; 
TrackRecord: TYPE = RECORD [
pos: CD.Position
];

track: TrackRef _ NIL;

GetTrackRef: PROC [p: CD.Position] RETURNS [t: TrackRef] = INLINE {
t _ track; track _ NIL;
IF t=NIL THEN t _ NEW[TrackRecord];
t.pos _ p
};

DisposeTrackRef: PROC [t: TrackRef] = INLINE {
track _ t
};


RepaintRectAreaRef: TYPE = REF RepaintRectArea; 
RepaintRectArea: TYPE = RECORD[
rect: CD.Rect _ CDBasics.universe,
erase: BOOL _ FALSE
];

viewerClassRec: ViewerClasses.ViewerClass _ NEW[ViewerClasses.ViewerClassRec _ [
paint: PaintViewer,
notify: NotifyViewer,
modify: ModifyViewer,
destroy: DestroyViewer,
set: CDViewerBase.SetProc,
get: CDViewerBase.GetProc,
cursor: cursorNoFocus
]];

cursoredCDViewer: PUBLIC Viewer _ NIL;
inputFocussedViewer: Viewer _ NIL;
lastInputFocussedViewer: Viewer _ NIL;

cursorWithFocus: Cursors.CursorType = textPointer;
cursorNoFocus: Cursors.CursorType = pointDown;
cursorWhileInput: Cursors.CursorType = questionMark;

SetCursor: PROC [] = INLINE {
viewerClassRec.cursor _ 
IF terminalLock THEN cursorWhileInput
ELSE IF cursoredCDViewer=inputFocussedViewer THEN cursorWithFocus
ELSE cursorNoFocus;
};

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

LastViewer: PUBLIC PROC [] RETURNS [Viewer] = {
RETURN [lastInputFocussedViewer]
};


SetUpAndRedraw: ENTRY PROC[vRef: VRef] = {
ENABLE UNWIND => NULL;
IF vRef=NIL THEN RETURN WITH ERROR CD.Error[];
CDDrawQueue.Flush[vRef.ct];
vRef.onVC _ FALSE;  --erasing viewer automaticaly makes cursor invisible
CDVPrivate.CreateDrawInformation[vRef];
CDDrawQueue.ChangeClipArea[vRef.ct, vRef.dClip];
CDDrawQueue.QueueInsertDrawCommand[vRef.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]];
};

PaintViewer: ViewerClasses.PaintProc = {
ENABLE {
CDVPrivate.notSupportedColorMode => GOTO oops;
RuntimeError.UNCAUGHT => 
IF ShallContinue[self, TRUE, "CDVMain.PV"] THEN GOTO oops ELSE REJECT;
};
vRef: VRef;

TrackRefTrack: ENTRY PROC [vRef: VRef, tr: TrackRef] = INLINE { 
ENABLE UNWIND => NULL;
IF vRef.cursorInhibitations=0 THEN {
IF vRef.onVC THEN vRef.usedCursor[vRef]
ELSE {
vRef.startVC _ vRef.designRec.startLC;
vRef.firstHorizontalVC _ vRef.designRec.firstHLC; 
vRef.designRec.currentLayer _ CDLayers.CurrentLayer[vRef.actualDesign];
vRef.defaultWidthVC _ vRef.designRec.widthLC _
CDLayers.LayerWidth[vRef.actualDesign, vRef.designRec.currentLayer];
vRef.onVC _ TRUE;
};
vRef.usedCursor _ vRef.designRec.outlineProcLC;
vRef.stopVC _ tr.pos;
vRef.usedCursor[vRef];  
};   
DisposeTrackRef[tr];
};

RemoveTrack: ENTRY PROC[vRef: VRef] = INLINE {
ENABLE UNWIND => NULL;
IF vRef.onVC THEN {
vRef.usedCursor[vRef]; 
vRef.onVC _ FALSE;
};
};

IF self.destroyed THEN RETURN;
WITH self.data SELECT FROM
vr: VRef => vRef _ vr;
ENDCASE => RETURN;
vRef.viewContext _ context;  
WITH whatChanged SELECT FROM
tr: TrackRef => TrackRefTrack[vRef, tr]; -- called by NotifyViewer
atom: ATOM => {
IF atom=$RemoveTrack THEN RemoveTrack[vRef]
ELSE CDVFurtherPainters.CallFurther[vRef, atom]; -- called from anywhere, maybe not protected
};
area: RepaintRectAreaRef => -- protected by ProtectedRepaint
CDVPrivate.RepaintRectAreaInViewer[vRef, area.rect, area.erase];
ENDCASE =>  {
IF whatChanged=NIL THEN {
IF vRef.viewer#self THEN RETURN; --initialization not finished
SetUpAndRedraw[vRef] -- called from anywhere, maybe not protected
}
ELSE CDVFurtherPainters.CallFurther[vRef, whatChanged];
}
EXITS oops => NULL;
}; 

Flushed: CDVFurtherPainters.FurtherPaintProc = {
CDDrawQueue.Flush[me.ct];
me.scale _ me.intendedScale;
SetUpAndRedraw[me];
};

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

EnableCursoring: ENTRY PROC[vRef: VRef] =  INLINE {
ENABLE UNWIND => NULL;
vRef.cursorInhibitations _ vRef.cursorInhibitations-1;
BROADCAST tryToPaint
};

ProtectedRepaint: PROC[vRef: VRef, whatChanged: REF ANY] = {
ENABLE RuntimeError.UNCAUGHT => {
EnableCursoring[vRef];
IF ShallContinue[vRef, TRUE, "CDVMain.PR"] THEN GOTO oops ELSE REJECT
};

DisableCursoring: ENTRY PROC[vRef: VRef] RETURNS [mustRemoveCursor: BOOL] = INLINE {
ENABLE UNWIND => NULL;
vRef.cursorInhibitations _ vRef.cursorInhibitations+1;
WHILE vRef.cursorInhibitations>1 DO 
vRef.cursorInhibitations _ vRef.cursorInhibitations-1;
WAIT tryToPaint;
vRef.cursorInhibitations _ vRef.cursorInhibitations+1;
ENDLOOP;
mustRemoveCursor _ vRef.onVC;
};

IF DisableCursoring[vRef].mustRemoveCursor THEN RemoveCursor[vRef];
ViewerOps.PaintViewer[vRef.viewer, client, FALSE, whatChanged 
! RuntimeError.UNCAUGHT => IF ShallContinue[vRef, TRUE, "CDVMain.PR2"] THEN CONTINUE
];
EnableCursoring[vRef];
EXITS oops => NULL;
};   

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

ViewerProcess: PROC[vRef: VRef] = {
comm: REF CDDrawQueue.Request = NEW[CDDrawQueue.Request];
bBTableSpace1, bBTableSpace2: PrincOps.BBTableSpace; 
IF vRef.running THEN ERROR;
TRUSTED {
vRef.pBBptr _ PrincOpsUtils.AlignedBBTable[@bBTableSpace1];
vRef.xBBptr _ PrincOpsUtils.AlignedBBTable[@bBTableSpace2];
};
vRef.running _ TRUE;
DO
comm^ _ CDDrawQueue.FetchCommand[vRef.ct];
SELECT comm.key FROM
$redraw => {
paintArea: RepaintRectAreaRef = NEW[RepaintRectArea_[comm.rect, TRUE]];
ProtectedRepaint[vRef, paintArea];
};
$draw => {
paintArea: RepaintRectAreaRef = NEW[RepaintRectArea_[comm.rect, FALSE]];
ProtectedRepaint[vRef, paintArea];
};
CDDrawQueue.queueEmpty => { 
ProtectedRepaint[vRef, $Temporaries];
CedarProcess.SetPriority[CedarProcess.Priority[background]];
SafeStorage.ReclaimCollectibleObjects[suspendMe: FALSE];
};
CDDrawQueue.finishedForEver => EXIT;
ENDCASE => ProtectedRepaint[vRef, comm];
ENDLOOP;
TerminalIO.WriteRope["viewer destroyed\n"];
vRef.running _ FALSE;
vRef.ct _ NIL;
vRef.actualDesign _ NIL;
vRef.deviceDrawRef _ NIL;
vRef.painterList _ NIL;
vRef.properties _ NIL;
};

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

SlowDown: PROC [v: Viewer] = {
IF v#NIL THEN WITH v.data SELECT FROM
vRef: VRef => {
vRef.hurryUp _ FALSE;
vRef.slowDown _ TRUE;
vRef.check _ TRUE;
vRef.deviceDrawRef.checkPriority _ TRUE;
};
ENDCASE => NULL;
};

SpeedUp: PROC [v: Viewer] = {
IF v#NIL THEN WITH v.data SELECT FROM
vRef: VRef => {
vRef.slowDown _ FALSE;
vRef.hurryUp _ TRUE;
vRef.check _ TRUE;
vRef.deviceDrawRef.checkPriority _ TRUE;
};
ENDCASE => NULL;
};

RemoveCursor: PROC [vRef: VRef] = INLINE {
IF vRef.onVC THEN 
ViewerOps.PaintViewer[vRef.viewer, client, FALSE, $RemoveTrack
! RuntimeError.UNCAUGHT => IF ShallContinue[vRef, TRUE, "CDVMain.RC"] THEN CONTINUE
];
};

ModifyViewer: ViewerClasses.ModifyProc = { -- PROC [self: Viewer, change: ModifyAction] 
ENABLE UNWIND => NULL;
SELECT change FROM
set, pop => lastInputFocussedViewer _ inputFocussedViewer _ self;
kill, push => inputFocussedViewer _ NIL;
ENDCASE => NULL;
SetCursor[];
};

NotifyViewer: ViewerClasses.NotifyProc = {
-- PROC [self: Viewer, input: LIST OF REF ANY]  
ENABLE RuntimeError.UNCAUGHT => 
IF ShallContinue[self, TRUE, "CDVMain.Notify"] THEN GOTO oops ELSE REJECT;

vRef: VRef;
mouse: CD.Position _ [0, 0]; --initialize, there are crazy tiptables.

LogicalTrack: PROC [vRef: VRef, pos: CD.Position] = INLINE {
IF NOT vRef.designRec.startLCValid THEN {
vRef.designRec.startLC _ pos; 
vRef.designRec.startLCValid _ TRUE;
}
};

LogicalTrackOff: PROC [vRef: VRef, pos: CD.Position] = INLINE {
vRef.designRec.stopLC _ pos;
vRef.designRec.startLCValid _ FALSE; 
};

Track: PROC [vRef: VRef] = INLINE {

VisibleTrack: PROC [vRef: VRef, pos: CD.Position] = INLINE {
ViewerOps.PaintViewer[vRef.viewer, client, FALSE, GetTrackRef[pos] ];
};

pos: CD.Position = CDVScale.ViewerToDesignPosition[vRef.scale, mouse];
LogicalTrack[vRef, pos];
IF vRef.cursorInhibitations=0 THEN VisibleTrack[vRef, pos];
};

StopTrack: PROC [vRef: VRef] = {
pos: CD.Position ~ CDVScale.ViewerToDesignPosition[vRef.scale, mouse];
vRef.hurryUp _ TRUE;
LogicalTrackOff[vRef, pos]; 
RemoveCursor[vRef];
CDVPrivate.SetCursorMode[vRef, NIL];
};

WITH self.data SELECT FROM
vr: VRef => vRef _ vr;
ENDCASE => RETURN;
IF self#cursoredCDViewer THEN {
tem: Viewer ~ cursoredCDViewer;
IF vRef.deviceDrawRef=NIL THEN {
RETURN
};
IF tem#NIL THEN 
WITH tem.data SELECT FROM
vRef: VRef => RemoveCursor[vRef];
ENDCASE => NULL;
IF self.column=color THEN 
IF Terminal.GetColorMode[InterminalBackdoor.terminal].full THEN {
IF self=inputFocussedViewer THEN InputFocus.PopInputFocus[];
RETURN;
};
cursoredCDViewer _ self;
SetCursor[];
};
WHILE input#NIL DO 
WITH input.first SELECT FROM
atom: ATOM => {
IF atom=$Track THEN Track[vRef] 
ELSE IF atom=$StopTrack THEN StopTrack[vRef] 
ELSE IF terminalLock THEN {
IF atom#$UseCursor THEN 
ViewerOps.BlinkIcon[viewer: self, millisecondsPerBlink: 100]; 
RETURN;
}
ELSE {
IF self#inputFocussedViewer THEN {
SlowDown[inputFocussedViewer];
InputFocus.SetInputFocus[self];
SpeedUp[self];
IF atom=$CloseReSelectOnlyP THEN RETURN; 
};
IF atom=$UseCursor THEN { --command involving 2 atoms
RemoveCursor[vRef];
input _ input.rest;  IF input=NIL THEN RETURN;
CDVPrivate.SetCursorMode[vRef, input.first]
}
ELSE { -- all other (standard) commands
StopTrack[vRef];
TRUSTED {Process.Detach[
FORK CDSequencer.ExecuteCommand[
design: vRef.actualDesign, 
comm: NEW[CDSequencer.CommandRec _ CDSequencer.CommandRec[
design: vRef.actualDesign,
key: atom,
pos: vRef.designRec.stopLC,
sPos: vRef.designRec.startLC,
l: vRef.designRec.currentLayer,
ref: vRef,
n: vRef.defaultWidthVC,
b: vRef.designRec.firstHLC
]]
]
]}; 
}; 
}; 
};
coords: TIPUser.TIPScreenCoords => {
mouse.x _ MIN[MAX[coords.mouseX, 0], vRef.viewer.cw-1]; 
mouse.y _ MIN[MAX[coords.mouseY, 0], vRef.viewer.ch-1];
};
ENDCASE => NULL;
input _ input.rest
ENDLOOP;
EXITS oops => NULL;
}; 


Caption: PROC [design: CD.Design] RETURNS [Rope.ROPE] = {
IF design=NIL THEN RETURN["nil design"]
ELSE RETURN [Rope.Cat[
(IF design.name#NIL THEN design.name ELSE "no name"), 
"   (", 
design.technology.name, 
")   cell: ", 
CDCells.PushedCellName[design]
]]
};   

CDEventHappened: CDEvents.EventProc = {
name: Rope.ROPE = Caption[design];
FOR l: CDViewer.ViewerList _ CDViewer.ViewersOf[design], l.rest WHILE l#NIL DO
WITH l.first.data SELECT FROM
vRef: VRef => {
l.first.name _ name;
ViewerOps.PaintViewer[l.first, caption];
IF event=$AfterPop OR event=$AfterPush THEN { 
CDDrawQueue.QueueInsertDrawCommand[vRef.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]]
}
};
ENDCASE => NULL;
ENDLOOP;
};   

IsNewVersion: PROC [design: CD.Design] RETURNS [newVersion: BOOL_FALSE] = {
vList: CDViewer.ViewerList _ CDViewer.ViewersOf[design];
IF vList=NIL THEN RETURN [ CDValue.Fetch[design, $CDxNewVersion]=$T ];
FOR vl: CDViewer.ViewerList _ vList, vl.rest WHILE vl#NIL DO
IF vl.first.newVersion THEN {
CDValue.Store[design, $CDxNewVersion, $T];
RETURN [TRUE]
}
ENDLOOP;
CDValue.Store[design, $CDxNewVersion, NIL];
};

CreateViewer: PUBLIC PROC[design: CD.Design] RETURNS [v: Viewer] = {
bb: CD.Rect = CDCommandOps.BoundingBox[design, FALSE]; 
vRef: VRef = New[design];
TRUSTED {Process.Detach[FORK ViewerProcess[vRef]]};
IF CDProperties.GetDesignProp[design, $CDxDrawPanel]#$FALSE THEN
[] _ CDPanel.CreatePanel[design];
WHILE NOT vRef.running DO Process.Yield[] ENDLOOP;
v _ vRef.viewer _ ViewerOps.CreateViewer[
flavor: viewerClassAtom,
info: [
name: Caption[design],	
scrollable: FALSE,
icon: CDEnvironment.GetIcon[design],
iconic: FALSE,
column: ColumnForNewViewer[],
tipTable: CDEnvironment.GetTipTable[design], 
newVersion: IsNewVersion[design],
data: vRef
],
paint: TRUE --sorry, must check elsewhere for this case, otherwise viewerpackage blusters
];
vRef.dClip _ CDVScale.GetClipRecord[vRef.intendedScale, v.cw, v.ch];
IF CDBasics.NonEmpty[bb] THEN {
CDViewer.ShowAndScale[v, bb];
CDDrawQueue.Flush[vRef.ct]; --I don't trust vRef
vRef.scale _ vRef.intendedScale; 
vRef.dClip _ CDVScale.GetClipRecord[vRef.intendedScale, v.cw, v.ch];
};
CDDrawQueue.Flush[vRef.ct]; --I don't trust vRef
CDDrawQueue.ChangeClipArea[vRef.ct, vRef.dClip];
ViewerOps.PaintViewer[v, all]; 
EnableCursoring[vRef];
Include[vRef];
}; 

ColumnForNewViewer: PROC [] RETURNS [col: ViewerClasses.Column_left] = {
colorDisplayEmpty: BOOL _ TRUE;
CheckColorScreen: ViewerOps.EnumProc = {-- PROC [v: Viewer] RETURNS [BOOL _ TRUE] 
IF v.column=color AND ~v.iconic AND ~v.offDeskTop THEN 
RETURN [colorDisplayEmpty _ FALSE]
};
IF WindowManager.colorDisplayOn AND putNewViewerOnColor THEN { 
ViewerOps.EnumerateViewers[CheckColorScreen];
IF colorDisplayEmpty THEN col _ color
}
};

DestroyViewer: ViewerClasses.DestroyProc = {
WITH self.data SELECT FROM
vRef: VRef => {
CDValue.Store[vRef.actualDesign, $CDxNewVersion, (IF self.newVersion THEN $T ELSE NIL)];
Destroy[vRef];
self.data _ NIL;
};
ENDCASE => NULL;
}; 

ViewerCorDEvent: ViewerEvents.EventProc = {
WITH viewer.data SELECT FROM
vRef: VRef => CDDrawQueue.ChangeClipArea[vRef.ct, CDBasics.empty];
ENDCASE => NULL;
IF cursoredCDViewer=viewer THEN cursoredCDViewer _ NIL
}; 

ViewerChangeColEvent: ViewerEvents.EventProc = {
IF viewer=cursoredCDViewer THEN 
IF Terminal.GetColorMode[InterminalBackdoor.terminal].full THEN  
cursoredCDViewer _ NIL;
}; 

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

New: PUBLIC ENTRY PROC [design: CD.Design] RETURNS [vRef: VRef_NIL] = {
ENABLE UNWIND => NULL;

NewScale: PROC [design: CD.Design] RETURNS [CDVScale.ScaleRec] = {
scale: INT = CDValue.FetchInt[boundTo: design, key: $CDxInitScale, propagation: global, ifNotFound: 6];
grid: INT = CDValue.FetchInt[boundTo: design, key: $CDxInitGrid, propagation: global, ifNotFound: design.technology.lambda];
RETURN [ CDVScale.MakeScale[
nscale: MIN[MAX[scale, 0], CDVScale.scaleNum-1], 
grid: MIN[MAX[grid, 0], 512], 
off: [0, 0]
]];
};

InitDesignRec: PROC [vRef: VRef] = {
FOR l: LIST OF VRef _ allVRefs, l.rest WHILE l#NIL DO
IF vRef.actualDesign=l.first.actualDesign THEN { vRef.designRec _ l.first.designRec; RETURN };
ENDLOOP; 
vRef.designRec _ NEW[CDVPrivate.VPrivatePerDesign _ [
outlineProcLC: CDVPrivate.DefaultOutLine,
currentLayer: CD.errorLayer
]];
CDVPrivate.SetCursorMode[vRef, NIL];
};

InitVRef: PROC [design: CD.Design] RETURNS [vRef: VRef] = {
b: REF BOOL = NEW[BOOL_FALSE];
vRef _ NEW[CDVPrivate.VRec _ [
actualDesign: design,
ct: CDDrawQueue.Create[design, b, CDBasics.empty],
scale: NewScale[design],
dClip: CDBasics.empty,
intendedScale: NewScale[design],
stoprequest: b,
environment: CDProperties.GetDesignProp[design, $CDxDrawEnvironment]#$FALSE,
symbolics: CDProperties.GetDesignProp[design, $CDxDrawSymbolics]#$FALSE,
borders: CDProperties.GetDesignProp[design, $CDxSkipBorder]=$FALSE,
personalColors: CDColors.globalColors,
cursorInhibitations: 1, --disabled, not yet ready
properties: CD.InitPropRef[]
]];
InitDesignRec[vRef];
};
vRef _ InitVRef[design];
};

Include: ENTRY PROC [vRef: VRef] = {
allVRefs _ CONS[vRef, allVRefs];
};

Destroy: PUBLIC ENTRY PROC [vRef: VRef] = {
ENABLE UNWIND => NULL;
IF vRef#NIL THEN {
IF allVRefs#NIL THEN {
IF allVRefs.first=vRef THEN allVRefs _ allVRefs.rest
ELSE {
t: LIST OF VRef _ allVRefs;
WHILE t.rest#NIL DO  -- Assert t#NIL
IF t.rest.first=vRef THEN t.rest _ t.rest.rest
ELSE t _ t.rest
ENDLOOP
}
};
CDDrawQueue.Destroy[vRef.ct];
}
};

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

NoteProfileChange: UserProfile.ProfileChangedProc = {
catchCritical _ UserProfile.Boolean["ChipNDale.CatchLowLevelErrors", TRUE];
catchWedging _ catchCritical OR UserProfile.Boolean["ChipNDale.CatchErrorsWhichCauseDeadlock", TRUE];
putNewViewerOnColor _ UserProfile.Boolean["ChipNDale.FirstViewerOnColor", TRUE];
}; 

UserProfile.CallWhenProfileChanges[NoteProfileChange];
TerminalIO.AddLock[TerminalLock, TerminalFree];
CDVFurtherPainters.InstallFurtherPaint[keyValue: $changeScale, proc: Flushed];
CDVFurtherPainters.InstallFurtherPaint[keyValue: $flushed, proc: Flushed];
CDEvents.RegisterEventProc[$ResetDesign, CDEventHappened];
CDEvents.RegisterEventProc[$RenameDesign, CDEventHappened];
CDEvents.RegisterEventProc[$AfterPush, CDEventHappened];
CDEvents.RegisterEventProc[$AfterPop, CDEventHappened];
ViewerOps.RegisterViewerClass[viewerClassAtom, viewerClassRec];
[] _ ViewerEvents.RegisterEventProc[proc: ViewerCorDEvent, event: close, filter: viewerClassAtom, before: TRUE];
[] _ ViewerEvents.RegisterEventProc[proc: ViewerCorDEvent, event: destroy, filter: viewerClassAtom, before: TRUE];
[] _ ViewerEvents.RegisterEventProc[proc: ViewerChangeColEvent, event: changeColumn, filter: viewerClassAtom, before: TRUE];
TerminalIO.WriteRopes[greeting, date, copyRight];
END.
8CDVMain.mesa   (part of ChipNDale)
Copyright c 1983, 1986 by Xerox Corporation.  All rights reserved.
Ch. Jacobi,  June 24, 1983 3:33 pm
Last Edited by: Christian Jacobi, August 28, 1986 6:37:55 pm PDT
--monitoring rule: aquire the ViewerLock first, the monitor's entry lock only after.
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- types used for parameters to the viewer paint procedure
--TrackRef: type to force cursor tracking
--the Get and Dispose proc's are a hack to reduce the memory allocator's work 
--may be called by viewers NotifyViewer proc only; monitored through viewers NotifyViewer proc
--RepaintRectAreaRef:  type to force drawing a rectangular aera

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --

-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
--logically inside the viewer's paint proc;
--reset viewer data and then sets up a buffered request for redrawing
-- erase to allow also backgrounds of arbitrary patterns or colors
--PROC [self: Viewer, context: Imager.Context, whatChanged: REF ANY, clear: BOOL]
--depending on whatChanged, the call must be protected or need not.
--Never call with modules entry monitor lock set.
--vRef ABSOLUTELY never NIL {proc is local}
--Proof hints: vRef.onVC initialized false; vRef.usedCursor not accessed outside 
--	CDVMains monitorlock (use Grep)
--now vRef.onVC is true
--vRef ABSOLUTELY never NIL  {proc is local}
--PaintViewer
--here it would have trapped if vRef=NIL
PROC [me: CDVPrivate.VRef, key: REF]
-- logicaly local to viewers paint proc (PaintViewer)
--logically local to ProtectedRepaint and initialization-- 
--vRef never nil-- 
--logically local to ProtectedRepaint
--is outside to make callable from catch-phrase and initialization
--does:
--remove cursor and disables any cursoring process
--let only one client come through
--Caller must guarantee vRef#NIL (Use find; {proc neither exported nor assigned to variable})
--and enters protected region.
--vRef never nil; guaranteed from caller {proc is local} 
--ProtectedRepaint
--vRef.fooBBptr is a short pointer! (hardware) therefor must be local to some proc space.
--do the garbage collection now, when not to much else is to do,
--and also all the allocations of the drawing can be freed
--order important
--order important
--removes visible cursor, if there is
--monitores inside viewerpaintproc 
-- ENTRY ommitted since sequential already by viewer package 
--makes cursor logically available
--makes cursor logically unavailable
--uses intermediate layer variable mouse
--makes cursor visible
--Track
--uses intermediate layer variable mouse
--NotifyViewer
--silly Cedar Viewer package allows calls of notify before
--the first call to the paint procedure happened;
--but in ChipNDale, some initializations happens in paint procedure only.
--luckily at that time cursoredCDViewer#self; so here is the only
--place to check. 
--avoid running in 24 bit per pixel mode
-- range test, 
-- [some crazy tiptables use coords without a mouse action first] 
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- PROC [event: REF, design: CD.Design, x: REF] 
-- repaint captions and sometimes the contents
--redraw everything, because 
--		after pop: cell change may have propagated
--		after push: background features must be redrawn greyish
--must wait until vRef.fooBBLT is initialized by ViewerProcess
paint: FALSE --important: vRef.viewer is initialized only after return
--but redraw does not yet come through... (clip area empty!)
--selects colordisplay if it is on and free
-- PROC [viewer: Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]
--we do this to force Notify to check whether we are in 24 bit per pixel mode

--New
--all critical work is done in procedures, so UNWIND really should work 
--allVRefs _ LO OPHOLE[List.DRemove[ref: vRef, list: LO OPHOLE[allVRefs]]];
-- PROC [reason: ProfileChangeReason]


ΚΠ˜
codeš
œ"™"Kšœ
Οm
œ7™BKš
œ"™"K™@—K˜š
Οk	˜	Kšžœ˜K˜	Kš
œ˜Kš
œ	˜	Kš
œ
˜
Kš
œ˜Kšœžœ˜+K˜	Kšœ	žœ˜*K˜Kš
œ
˜
Kšœžœ'˜8Kšœžœ˜'Kšœžœ6˜NKš
œ	˜	Kš
œ
˜
Kš
œ˜Kš
œ	˜	Kšœ
žœ˜+Kšœžœ˜Kšœ
žœ˜'Kšœžœ ˜0Kšœžœ˜$Kšœ	žœ˜Kšœžœ˜%Kšœžœ˜Kšœžœžœ˜Kšœ
žœžœ˜Kšœžœ˜.Kšœ	žœ˜Kšœžœ"˜2Kšœžœ˜ Kšœžœ7˜HKšœžœ_˜rKšœ
žœ ˜2Kšœ
žœY˜hKšœžœ˜%—K˜šΠblœžœ
žœ
˜Kš
œT™Tšžœ
˜Kš
œ˜—Kšžœ˜Kšžœ.˜4—Kš
ž˜K˜Kšœžœ-˜@Kšœžœ˜#KšœžœP˜dK˜KšΟcœ
 œ
 œ
 œ
 œ
 œ
 œ
 œ
 ˜5Kšœžœ˜Kšœžœ˜$K˜Kšœžœ˜#K˜Kš œ
 œ
 œ
 œ
 œ
 œ
 œ
 œ
 ˜5K˜Kšœž	œ
˜K˜Kšœžœ
žœžœ
˜+Kšœžœžœ
˜!K˜Kš	œ
žœ
žœ
žœžœ
˜$K˜Kšœžœžœ
˜)Kšœ
žœ
žœ
˜Kšœžœ
žœ
˜Kš
œ9˜9K˜šΟnœžœ!˜6Kš
œ˜Kš
œ˜K˜—š‘œžœžœ	žœžœžœ
žœ˜XJš
œ˜Jš
œ˜Jšœžœžœ˜6šžœž˜Jš
œ2˜2—J˜—K˜š‘
œžœ
žœžœ
žœ	žœ
žœžœ
žœžœžœ
žœ˜mJš
œ/˜/Jšžœžœ
žœ˜)J˜—K˜Kš œ
 œ
 œ
 œ
 œ
 œ
 œ
 œ
 ˜5K˜Kšœžœžœ
˜K˜š‘œžœ˜Kšœžœ˜Kš
œ(˜(Kš
œ˜—K˜š‘œžœ˜Kšœž˜Kš
œ˜Kš
œ˜—K˜Kš
œ2™2K™:K˜Kš
œ)™)˜Kšœ
žœžœ˜"šœ
žœžœ˜Kšœžœ	˜K˜—K˜Kš
œN™NKšœžœ
˜K˜š
‘œžœžœžœžœ˜CKš
œ^™^Kšœžœ
˜Kš
žœžœ
žœ
žœ
žœ˜#Kš
œ	˜	K˜—K˜š‘œžœžœ˜.Kš
œ	˜	K˜—K˜—Kš
œ?™?˜Kšœžœžœ˜0šœžœžœ
˜Kšœžœ˜"Kšœžœž˜K˜——K™Kš
œ2™2K˜šœ,žœ!˜PKš
œ˜Kš
œ˜Kš
œ˜K˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—K™Kš
œ2™2K˜Kšœžœ
žœ
˜&Kšœžœ
˜"Kšœ"žœ
˜&˜Kš
œ2˜2Kš
œ.˜.Kš
œ4˜4—K˜š‘	œžœžœ˜š
œ˜Kšžœžœ˜%Kšžœ
žœ&žœ˜AKšžœ˜—K˜—K˜Kš
œ5˜5K˜š‘
œžœ
žœžœ
˜/Kšžœ˜ Kš
œ˜—K˜K˜š‘œžœ
žœ˜*Kš
œ+™+K™EKšžœ
žœžœ
˜Kšžœžœ
žœ
žœ
žœ
žœ
žœ	˜.Kš
œ˜Kšœžœ 4˜HKš
œ'˜'š
œ0˜0Kš
œB™B—Kš
œ]˜]Kš
œ˜—K˜šΟbœ˜(Kš
œQ™QKš
œC™CKš
œ1™1šžœ˜Kšœ$žœ˜.šœ
žœ˜Kšžœžœžœ
žœžœ
žœ
˜F—K˜—Kš
œ˜K˜š‘
œžœ
žœžœ˜@Kš
œ+™+Kšžœ
žœžœ
˜šžœžœ˜$Kš
œQ™QKš
œ"™"Kšžœžœ˜'šžœ˜Kš
œ&˜&Kš
œ2˜2Kš
œG˜Gš
œ.˜.Kš
œD˜D—Kšœžœ
˜K˜—Kš
œ™Kš
œ/˜/Kš
œ˜K˜K˜—Kš
œ˜Kš
œ˜K˜—š‘œžœ
žœžœ˜.Kš
œ,™,Kšžœ
žœžœ
˜šžœžœ˜K˜Kšœžœ
˜K˜—Kš
œ˜—K˜Kš
œ
™
Kšžœžœ
žœ
˜šžœžœ
ž˜Kš
œ˜Kšžœžœ
˜—š
œ˜Kšœ  ™(—šžœ
žœ
ž˜Kšœ) ˜Bšœžœ˜Kšžœžœ˜+Kšžœ- ,˜]K˜—šœ  ˜<Kš
œ@˜@—šžœ˜
šžœ
žœ
žœ˜Kšžœžœ
žœ ˜>Kšœ ,˜AK˜
—Kšžœ3˜7K˜
——Kšžœ	žœ
˜Kš
œ˜—K˜šΠbnœ)˜0KšœΟiœ™$Kš
œ5™5Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—Kš œ
 œ
 œ
 œ
 œ
 œ
 œ
 œ
 ˜5˜Kš
’;™;Kš
œ™š‘œžœ
žœžœ˜3Kš
œ%™%K™BKšžœ
žœžœ
˜Kš
œ6˜6Kšž	œ˜Kš
œ˜K˜——š‘œžœžœ
žœ˜<š
œ™Kš
œ2™2Kš
œ"™"—Kš
œ]™]šžœžœ˜!Kš
œ˜Kšžœžœžœ
žœžœ
ž˜EKš
œ˜—K˜š‘œžœ
žœ
žœžœžœ˜TKš
œ™Kš
œ9™9Kšžœ
žœžœ
˜K˜6šžœžœ
˜$K˜6Kšžœ˜K˜6Kšžœ
˜—Kš
œ˜Kš
œ˜K˜—Kš
œ™Kšžœ)žœ˜Cšœ+žœ˜>Kš
œžœžœžœžœ
ž˜TKš
œ˜—K˜Kšžœ	žœ
˜Kš
œ˜—K˜Kš œ
 œ
 œ
 œ
 œ
 œ
 œ
 œ
 ˜5K˜š‘
œžœ˜#Kšœžœžœ˜9š
œ5˜5Kš
œY™Y—Kšžœžœ
žœ
˜šžœ˜	Kš
œ;˜;Kš
œ;˜;Kš
œ˜—Kšœžœ
˜š
ž˜Kš
œ*˜*šžœ
ž˜˜Kšœ žœžœ˜GKš
œ"˜"Kš
œ˜—˜
Kšœ žœžœ˜HKš
œ"˜"Kš
œ˜—š
œ˜Kš
œ%˜%Kš
œ<˜<Kš
œ@™@K™:Kšœ1žœ˜8Kš
œ˜—Kšœžœ
˜$Kšžœ!˜(—Kšžœ
˜—K˜+Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kš
œ˜K˜—Kš œ
 œ
 œ
 œ
 œ
 œ
 œ
 œ
 ˜5K˜š‘œžœ˜šžœžœ
žœ
žœžœ
ž˜%š
œ˜Kš
œ™Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœ#žœ
˜(Kš
œ˜—Kšžœžœ
˜—Kš
œ˜—K˜š‘œžœ˜šžœžœ
žœ
žœžœ
ž˜%š
œ˜Kš
œ™Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœ#žœ
˜(K˜—Kšžœžœ
˜—Kš
œ˜—K˜š‘œžœžœ˜*Kš
œ%™%K™#šžœžœ
˜šœ+žœ˜>Kš
œžœžœžœžœ
ž˜SKš
œ˜——Kš
œ˜—K˜š‘œ -˜XKšžœ
žœžœ
˜šžœž˜Kš
œA˜AKšœ$žœ
˜(Kšžœžœ
˜—Kš
œ˜Kš
œ˜—K˜š’œ˜*Kš /œ
˜0Kš
œ=™=šžœžœ˜ Kšžœžœžœ
žœžœ
žœ
˜J—K˜Kš
œ˜Kšœžœ )˜EK˜š‘œžœžœ
žœ˜<Kš
œ"™"šžœ
žœžœ˜)Kš
œ˜Kšœžœ
˜#K˜
—Kš
œ˜K˜—š‘œžœžœ
žœ˜?Kš
œ$™$Kš
œ˜Kšœžœ˜%Kš
œ˜K˜—š‘œžœžœ˜#Kš
œ(™(K˜š‘œžœžœ
žœ˜<Kš
œ™Kšœ+žœ˜EKš
œ˜K˜—Kš
œ™Kšœžœ?˜FK˜Kšžœžœ˜;Kš
œ˜K˜—š‘	œžœ˜ Kš
œ(™(Kšœžœ?˜FKšœžœ
˜Kš
œ˜Kš
œ˜Kšœžœ˜$Kš
œ˜K˜—Kš
œ™šžœžœ
ž˜Kš
œ˜Kšžœžœ
˜—šžœžœ˜Kš
œ˜šžœžœ
žœ˜ Kš
œ:™:Kš
œ1™1Kš
œI™IKš
œA™AKš
œ™Kš
ž˜K˜—šžœžœ
žœ
˜šžœ
žœ
ž˜Kš
œ!˜!Kšžœžœ
˜——Kš
œ(™(šžœžœ
˜šžœ9žœ˜AKšžœžœ˜<Kšžœ
˜K˜——Kš
œ˜Kš
œ˜Kš
œ˜—šžœžœ
žœ
˜šžœ
žœ
ž˜šœžœ˜Kšžœ
žœ
˜ Kšžœžœ˜-šžœ
žœžœ˜šžœžœ
˜Kš
œ>˜>—Kš
ž˜Kš
œ
˜
—šžœ˜šžœžœ˜"Kš
œ˜Kš
œ˜Kš
œ˜Kšžœžœ
žœ˜)K˜—šžœžœ ˜5Kš
œ˜Kš	œžœžœ
žœ
žœ
˜.Kš
œ+˜+K˜
—šžœ  ˜'K˜šžœ˜šžœ˜ Kš
œ˜šœžœ1˜:K˜K˜
Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ
˜
K˜Kš
œ˜Kš
œ˜—Kš
œ
˜
—Kš
œ˜—Kš
œ˜—Kš
œ˜—K˜—˜$Kš
œ™Kš
œB™BKšœ
žœ
žœ'˜8Kšœ
žœ
žœ&˜7K˜—Kšžœžœ
˜—Kš
œ˜Kšžœ
˜—Kšžœ	žœ
˜Kš
œ˜—K˜Kš
œ8™8K˜š
‘œžœ
žœ	žœžœ˜9Kšžœžœ
žœ
žœ˜'šžœ
žœ˜Kš	œ
žœ
žœ
žœ
žœ
˜6Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kš
œ˜K˜—š’œ˜'Kš
œ0™0Kš
œ.™.Kšœžœ˜"šžœ=žœžœ
ž˜Nšžœžœ
ž˜š
œ˜K˜K˜(šžœžœžœ˜.Kš
œ™Kš
œ.™.Kš
œ;™;Kš
œ\˜\K˜
—K˜—Kšžœžœ
˜—Kšžœ
˜—Kš
œ˜K˜—š‘œžœ
žœ	žœžœ
žœ˜KKš
œ8˜8Kšžœžœ
žœ
žœ.˜Fšžœ*žœžœ
ž˜<šžœžœ˜Kš
œ*˜*Kšžœžœ
˜
K˜
—Kšžœ
˜—Kšœ&žœ˜+Kš
œ˜—K˜š
‘œžœ
žœ	žœ	žœ˜DKšœžœ)žœ˜7Kš
œ˜Kšžœžœ˜3šžœ:ž˜@K˜!—Kš
œ>™>Kšžœ
žœžœžœ
˜2š
œ)˜)Kš
œ˜˜Kš
œ˜Kšœžœ
˜Kš
œ$˜$Kšœžœ
˜Kš
œ˜Kš
œ-˜-Kš
œ!˜!Kš
œ
˜
K˜—Kšœžœ
 9™FKšœžœ
 M˜YK˜—Kš
œD˜Dšžœžœ˜Kš
œ<™<Kš
œ˜Kšœ ˜0Kš
œ!˜!Kš
œD˜DK˜—Kšœ ˜0Kš
œ0˜0Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—K˜š‘œžœžœ%˜HKš
œ+™+Kšœžœžœ
˜š’œ *˜Ršžœžœžœžœ
˜7Kšžœžœ
˜"—Kš
œ˜—šžœžœžœ˜?Kš
œ-˜-Kšžœžœ˜%K˜
—Kš
œ˜—K˜š£
œ˜,šžœžœ
ž˜š
œ˜Kš	œ2žœžœžœ
žœ˜XKš
œ˜Kšœžœ
˜K˜—Kšžœžœ
˜—Kš
œ˜—K˜š£œ˜+Kšœžœ.žœ
ž	œžœžœ
™Xšžœ
žœ
ž˜Kš
œB˜BKšžœžœ
˜—Kšžœžœž˜6Kš
œ˜—K˜š£œ˜0K™Mšžœžœ
˜ šžœ9žœ˜AKšœžœ
˜——Kš
œ˜—K˜Kš
‘;˜;K˜š‘œžœ
žœ
žœ
žœ	žœ
žœ˜GKšžœ
žœžœ
˜K˜š‘œžœ
žœ	žœ˜BKšœžœ]˜gKšœžœs˜|šžœ˜Kšœžœ
žœ"˜1Kšœžœ
žœ˜Kš
œ˜Kš
œ˜—Kš
œ˜—K˜š‘
œžœ˜$šžœžœ
žœžœžœ
ž˜5Kšžœ(žœ'žœ˜^Kšžœ˜	—šœžœ!˜5Kš
œ)˜)Kšœžœ˜Kš
œ˜—Kšœžœ˜$Kš
œ˜K˜—š‘œžœ
žœ	žœ˜;Kšœžœ
žœžœ
žœ
žœ˜šœžœ˜K˜Kš
œ2˜2Kš
œ˜Kš
œ˜Kš
œ ˜ Kš
œ˜Kš
œL˜LKš
œH˜HKš
œC˜CKš
œ&˜&Kšœ ˜1Kšœžœ˜K˜—K˜Kš
œ˜—K™Kš
œ™K™HKš
œ˜Kš
œ˜K˜—š‘œžœ
žœ˜$Kšœžœ˜ K˜—K˜š‘œžœ
žœ
žœ˜+Kšžœ
žœžœ
˜šžœžœ
žœ˜Kšœ
ž	œž	œ
™Kšžœ
žœ
žœ˜Kšžœžœ˜4šžœ˜Kšœžœ
žœ˜šžœžœ
žœ ˜$Kšžœžœ˜.Kšžœ˜Kš
ž˜—K˜
—K˜—Kš
œ˜K˜
—Kš
œ˜K˜—Kš
‘;˜;K˜š’œ$˜5Kšœžœ™%KšœEžœ˜KKšœžœ@žœ˜eKšœJžœ˜PKš
œ˜—K˜Kš
œ6˜6K˜/Kš
œN˜NKš
œJ˜JK˜:K˜;K˜8K˜7Kš
œ?˜?Kšœjžœ˜pKšœlžœ˜rKšœvžœ˜|Kš
œ1˜1Kšžœ
˜K™K™—…—LΌwΔ