CDVMain.mesa (part of ChipNDale)
Copyright © 1983, 1986 by Xerox Corporation. All rights reserved.
Ch. Jacobi, June 24, 1983 3:33 pm
last edited by Christian Jacobi, May 22, 1986 3:17:13 pm PDT
gbb April 8, 1986 5:46:39 pm PST
DIRECTORY
CD,
CDCells,
CDColors,
CDCommandOps,
CDDrawQueue,
CDEvents,
CDBasics,
CDPanel,
CDProperties,
CDSequencer USING [Command, CommandRec, ExecuteCommand],
CDTipEtc,
CDLayers,
CDValue,
CDVFurtherPainters,
CDVPrivate,
CDViewer,
CDViewerBase,
CDVScale,
Cursors,
DebuggerSwap USING [WorryCallDebugger],
InputFocus USING [SetInputFocus],
List,
PrincOps USING [BBTableSpace],
PrincOpsUtils,
Process USING [Detach, Yield],
CedarProcess USING [SetPriority, Priority],
Rope USING [ROPE, Cat],
RuntimeError USING [UNCAUGHT],
SafeStorage USING [ReclaimCollectibleObjects],
TerminalIO,
TIPUser USING [TIPScreenCoords],
UserProfile,
ViewerClasses,
ViewerEvents USING [EventProc, RegisterEventProc],
ViewerOps USING [CreateViewer, RegisterViewerClass, PaintViewer, BlinkIcon, EnumProc, EnumerateViewers],
WindowManager USING [colorDisplayOn];
CDVMain:
CEDAR
MONITOR
--monitoring rule: aquire the ViewerLock first, the monitor's entry lock only after.
IMPORTS
CedarProcess, CD, CDCells, CDColors, CDCommandOps, CDDrawQueue, CDEvents, CDBasics, CDPanel, CDProperties, CDVFurtherPainters, CDVScale, CDSequencer, CDTipEtc, CDLayers, CDValue, CDViewer, CDViewerBase, CDVPrivate, DebuggerSwap, InputFocus, List, PrincOpsUtils, Process, Rope, RuntimeError, SafeStorage, 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 = "May 22, 1986";
copyRight: Rope.ROPE = "\nCopyright (C) 1984, 1986 by Xerox Corporation. All rights reserved.\n\n";
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
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];
};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
viewerClassAtom: ATOM = $ChipNDale;
VRef: TYPE = CDVPrivate.VRef;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
terminalLock: BOOL ← FALSE;
TerminalLock:
PROC [] = {
terminalLock ← TRUE;
viewerClassRec.cursor ← cursorWhileInput
};
TerminalFree:
PROC [] ={
terminalLock ← FALSE;
SetCursor[]
};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- types used for parameters to the viewer paint procedure
--TrackRef: type to force cursor tracking
TrackRef: TYPE = REF TrackRecord;
TrackRecord:
TYPE =
RECORD [
pos: CD.Position
];
--the Get and Dispose proc's are a hack to reduce the memory allocator's work
track: TrackRef ← NIL;
GetTrackRef:
PROC [p:
CD.Position]
RETURNS [t: TrackRef] =
INLINE {
--may be called by viewers NotifyViewer proc only; monitored through viewers NotifyViewer proc
t ← track; track ← NIL;
IF t=NIL THEN t ← NEW[TrackRecord];
t.pos ← p
};
DisposeTrackRef:
PROC [t: TrackRef] =
INLINE {
track ← t
};
--RepaintRectAreaRef: type to force drawing a rectangular aera
RepaintRectAreaRef: TYPE = REF RepaintRectArea;
RepaintRectArea:
TYPE =
RECORD[
rect: CD.Rect ← CDBasics.universe,
erase: BOOL ← FALSE
];
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
tryToPaint: CONDITION;
viewerClassRec: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← [
paint: PaintViewer,
notify: NotifyViewer,
modify: ModifyViewer,
destroy: DestroyViewer,
set: CDViewerBase.SetProc,
get: CDViewerBase.GetProc,
cursor: cursorNoFocus
]];
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
cursoredCDViewer: PUBLIC ViewerClasses.Viewer ← NIL;
inputFocussedViewer: ViewerClasses.Viewer ← NIL;
lastInputFocussedViewer: ViewerClasses.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 [ViewerClasses.Viewer] =
BEGIN
RETURN [lastInputFocussedViewer]
END;
SetUpAndRedraw:
ENTRY
PROC[me: VRef] =
--logically inside the viewer's paint proc;
--reset viewer data and then sets up a buffered request for redrawing
BEGIN ENABLE UNWIND => NULL;
IF me=NIL THEN RETURN WITH ERROR CD.Error[];
CDDrawQueue.Flush[me.ct];
me.onVC ← FALSE; --erasing viewer automaticaly makes cursor invisible
CDVPrivate.CreateDrawInformation[me];
CDDrawQueue.ChangeClipArea[me.ct, me.dClip];
-- erase to allow also backgrounds of arbitrary patterns or colors
CDDrawQueue.QueueInsertDrawCommand[me.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]];
END;
PaintViewer: ViewerClasses.PaintProc =
--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.
BEGIN
ENABLE {
CDVPrivate.notSupportedColorMode => GOTO oops;
RuntimeError.
UNCAUGHT =>
IF ShallContinue[self, TRUE, "CDVMain.PV"] THEN GOTO oops ELSE REJECT;
};
me: VRef = NARROW[self.data];
TrackRefTrack:
ENTRY
PROC [me: VRef, tr: TrackRef] =
INLINE
--me ABSOLUTELY never NIL {proc is local}
BEGIN ENABLE UNWIND => NULL;
IF me.cursorInhibitations=0
THEN {
--Proof hints: me.onVC initialized false; me.usedCursor not accessed outside
-- CDVMains monitorlock (use Grep)
IF me.onVC THEN me.usedCursor[me]
ELSE {
me.startVC ← me.designRec.startLC;
me.firstHorizontalVC ← me.designRec.firstHLC;
me.designRec.currentLayer ← CDLayers.CurrentLayer[me.actualDesign];
me.defaultWidthVC ← me.designRec.widthLC ←
CDLayers.LayerWidth[me.actualDesign, me.designRec.currentLayer];
me.onVC ← TRUE;
};
--now me.onVC is true
me.usedCursor ← me.designRec.outlineProcLC;
me.stopVC ← tr.pos;
me.usedCursor[me];
};
DisposeTrackRef[tr];
END;
RemoveTrack:
ENTRY
PROC[me: VRef] =
INLINE
--me ABSOLUTELY never NIL {proc is local}
BEGIN ENABLE UNWIND => NULL;
IF me.onVC
THEN {
me.usedCursor[me];
me.onVC ← FALSE;
};
END;
--PaintViewer
IF self.destroyed THEN RETURN;
me.viewContext ← context;
--here it would have trapped if me=NIL
WITH whatChanged
SELECT
FROM
tr: TrackRef => TrackRefTrack[me, tr]; -- called by NotifyViewer
atom:
ATOM => {
IF atom=$RemoveTrack THEN RemoveTrack[me]
ELSE CDVFurtherPainters.CallFurther[me, atom]; -- called from anywhere, maybe not protected
};
area: RepaintRectAreaRef =>
-- protected by ProtectedRepaint
CDVPrivate.RepaintRectAreaInViewer[me, area.rect, area.erase];
ENDCASE => {
IF whatChanged=
NIL
THEN {
IF me.viewer#self THEN RETURN; --initialization not finished
SetUpAndRedraw[me] -- called from anywhere, maybe not protected
}
ELSE CDVFurtherPainters.CallFurther[me, whatChanged];
}
EXITS oops => NULL;
END;
Flushed: CDVFurtherPainters.FurtherPaintProc =
-- PROC [me: CDVPrivate.VRef, key: REF]
-- logicaly local to viewers paint proc (PaintViewer)
BEGIN
CDDrawQueue.Flush[me.ct];
me.scale ← me.intendedScale;
SetUpAndRedraw[me];
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
--logically local to ProtectedRepaint and initialization--
--me never nil--
EnableCursoring:
ENTRY
PROC[me: VRef] =
INLINE
--logically local to ProtectedRepaint
--is outside to make callable from catch-phrase and initialization
BEGIN ENABLE UNWIND => NULL;
me.cursorInhibitations ← me.cursorInhibitations-1;
BROADCAST tryToPaint
END;
ProtectedRepaint:
PROC[me: VRef, whatChanged:
REF
ANY] =
--does:
--remove cursor and disables any cursoring process
--let only one client come through
--Caller must guarantee me#NIL (Use find; {proc neither exported nor assigned to variable})
BEGIN
ENABLE RuntimeError.
UNCAUGHT => {
EnableCursoring[me];
IF ShallContinue[me, TRUE, "CDVMain.PR"] THEN GOTO oops ELSE REJECT
};
DisableCursoring:
ENTRY
PROC[me: VRef]
RETURNS [mustRemoveCursor:
BOOL] =
INLINE
--and enters protected region.
--me never nil; guaranteed from caller {proc is local}
BEGIN ENABLE UNWIND => NULL;
me.cursorInhibitations ← me.cursorInhibitations+1;
WHILE me.cursorInhibitations>1
DO
me.cursorInhibitations ← me.cursorInhibitations-1;
WAIT tryToPaint;
me.cursorInhibitations ← me.cursorInhibitations+1;
ENDLOOP;
mustRemoveCursor ← me.onVC;
END;
--ProtectedRepaint
IF DisableCursoring[me].mustRemoveCursor THEN RemoveCursor[me];
ViewerOps.PaintViewer[me.viewer, client,
FALSE, whatChanged
! RuntimeError.UNCAUGHT => IF ShallContinue[me, TRUE, "CDVMain.PR2"] THEN CONTINUE
];
EnableCursoring[me];
EXITS oops => NULL;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
ViewerProcess:
PROC[me: VRef] =
BEGIN
comm: REF CDDrawQueue.Request = NEW[CDDrawQueue.Request];
bBTableSpace1, bBTableSpace2: PrincOps.BBTableSpace;
--me.fooBBptr 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^ ← CDDrawQueue.FetchCommand[me.ct];
SELECT comm.key
FROM
$redraw => {
paintArea: RepaintRectAreaRef = NEW[RepaintRectArea←[comm.rect, TRUE]];
ProtectedRepaint[me, paintArea];
};
$draw => {
paintArea: RepaintRectAreaRef = NEW[RepaintRectArea←[comm.rect, FALSE]];
ProtectedRepaint[me, paintArea];
};
CDDrawQueue.queueEmpty => {
ProtectedRepaint[me, $Temporaries];
CedarProcess.SetPriority[CedarProcess.Priority[background]];
--do the garbage collection now, when not to much else is to do,
--and also all the allocations of the drawing can be freed
SafeStorage.ReclaimCollectibleObjects[suspendMe: FALSE];
};
CDDrawQueue.finishedForEver => EXIT;
ENDCASE => ProtectedRepaint[me, comm];
ENDLOOP;
TerminalIO.WriteRope["Viewer destroyed\n"];
me.running ← FALSE;
me.ct ← NIL;
me.actualDesign ← NIL;
me.deviceDrawRef ← NIL;
me.painterList ← NIL;
me.properties ← NIL;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
SlowDown:
PROC [v: ViewerClasses.Viewer] =
BEGIN
IF v#
NIL
THEN
WITH v.data
SELECT
FROM
me: VRef => {
--order important
me.hurryUp ← FALSE;
me.slowDown ← TRUE;
me.check ← TRUE;
me.deviceDrawRef.checkPriority ← TRUE;
};
ENDCASE => NULL;
END;
SpeedUp:
PROC [v: ViewerClasses.Viewer] =
BEGIN
IF v#
NIL
THEN
WITH v.data
SELECT
FROM
me: VRef => {
--order important
me.slowDown ← FALSE;
me.hurryUp ← TRUE;
me.check ← TRUE;
me.deviceDrawRef.checkPriority ← TRUE;
};
ENDCASE => NULL;
END;
RemoveCursor:
PROC [me: VRef] =
--removes visible cursor, if there is
--monitores inside viewerpaintproc
INLINE BEGIN
IF me.onVC
THEN
ViewerOps.PaintViewer[me.viewer, client,
FALSE, $RemoveTrack
! RuntimeError.UNCAUGHT => IF ShallContinue[me, TRUE, "CDVMain.RC"] THEN CONTINUE
];
END;
ModifyViewer: ViewerClasses.ModifyProc =
-- PROC [self: Viewer, change: ModifyAction]
BEGIN ENABLE UNWIND => NULL;
SELECT change
FROM
set, pop => lastInputFocussedViewer ← inputFocussedViewer ← self;
kill, push => inputFocussedViewer ← NIL;
ENDCASE => NULL;
SetCursor[];
END;
NotifyViewer: ViewerClasses.NotifyProc =
-- PROC [self: Viewer, input: LIST OF REF ANY]
-- ENTRY ommitted since sequential already by viewer package
BEGIN
ENABLE RuntimeError.
UNCAUGHT =>
IF ShallContinue[self, TRUE, "CDVMain.Notify"] THEN GOTO oops ELSE REJECT;
me: VRef = NARROW[self.data];
mouse: CD.Position ← [0, 0]; --initialize, there are crazy tiptables.
LogicalTrack:
PROC [me: VRef, pos:
CD.Position] =
INLINE
--makes cursor logically available
BEGIN
IF
NOT me.designRec.startLCValid
THEN {
me.designRec.startLC ← pos;
me.designRec.startLCValid ← TRUE;
}
END;
LogicalTrackOff:
PROC [me: VRef, pos:
CD.Position] =
INLINE
--makes cursor logically unavailable
BEGIN
me.designRec.stopLC ← pos;
me.designRec.startLCValid ← FALSE;
END;
Track:
PROC [me: VRef] =
INLINE
--uses intermediate layer variable mouse
BEGIN
VisibleTrack:
PROC [me: VRef, pos:
CD.Position] =
INLINE
--makes cursor visible
BEGIN
ViewerOps.PaintViewer[me.viewer, client, FALSE, GetTrackRef[pos] ];
END;
--Track
pos: CD.Position = CDVScale.ViewerToDesignPosition[me.scale, mouse];
LogicalTrack[me, pos];
IF me.cursorInhibitations=0 THEN VisibleTrack[me, pos];
END;
StopTrack:
PROC [me: VRef] =
--uses intermediate layer variable mouse
BEGIN
pos: CD.Position = CDVScale.ViewerToDesignPosition[me.scale, mouse];
me.hurryUp ← TRUE;
LogicalTrackOff[me, pos];
RemoveCursor[me];
CDVPrivate.SetCursorMode[me, NIL];
END;
--NotifyViewer
IF self#cursoredCDViewer
THEN {
tem: ViewerClasses.Viewer = cursoredCDViewer;
IF me.deviceDrawRef=
NIL
THEN {
--silly Cedar Viewer package allows calls of notify before
--the first call to the paint procedure happened;
--but in ChipNDale, some initializations happens in paintprocedure only.
--luckily at that time cursoredCDViewer#self; so here is the only
--place to check.
RETURN
};
IF tem#NIL AND tem.data#NIL THEN RemoveCursor[NARROW[tem.data, VRef]];
cursoredCDViewer ← self;
SetCursor[];
};
WHILE input#
NIL
DO
WITH input.first
SELECT
FROM
atom:
ATOM => {
IF atom=$Track THEN Track[me]
ELSE IF atom=$StopTrack THEN StopTrack[me]
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[me];
input ← input.rest; IF input=NIL THEN RETURN;
CDVPrivate.SetCursorMode[me, input.first]
}
ELSE {
-- all other (standard) commands
StopTrack[me];
TRUSTED {Process.Detach[
FORK CDSequencer.ExecuteCommand[
design: me.actualDesign,
comm:
NEW[CDSequencer.CommandRec ← CDSequencer.CommandRec[
design: me.actualDesign,
key: atom,
pos: me.designRec.stopLC,
sPos: me.designRec.startLC,
l: me.designRec.currentLayer,
ref: me,
n: me.defaultWidthVC,
b: me.designRec.firstHLC
]]
]
]};
};
};
};
coords: TIPUser.TIPScreenCoords => {
-- range test,
-- [some crazy tiptables use coords without having had a mouse action first]
mouse.x ← MIN[MAX[coords.mouseX, 0], me.viewer.cw-1];
mouse.y ← MIN[MAX[coords.mouseY, 0], me.viewer.ch-1];
};
ENDCASE => NULL;
input ← input.rest
ENDLOOP;
EXITS oops => NULL;
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
Caption:
PROC [design:
CD.Design]
RETURNS [Rope.
ROPE] =
BEGIN
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]
]]
END;
CDEventHappened: CDEvents.EventProc =
-- PROC [event: REF, design: CD.Design, x: REF]
-- repaint captions and sometimes the contents
BEGIN
name: Rope.ROPE = Caption[design];
FOR l: CDViewer.ViewerList ← CDViewer.ViewersOf[design], l.rest
WHILE l#
NIL
DO
me: VRef = NARROW[l.first.data];
l.first.name ← name;
ViewerOps.PaintViewer[l.first, caption];
IF event=$AfterPop
OR event=$AfterPush
THEN {
--redraw everything, because
-- after pop: cell change may have propagated
-- after push: background features must be redrawn greyish
CDDrawQueue.QueueInsertDrawCommand[me.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]]
}
ENDLOOP;
END;
IsNewVersion:
PROC [design:
CD.Design]
RETURNS [newVersion:
BOOL←
FALSE] =
BEGIN
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];
END;
CreateViewer:
PUBLIC
PROC[design:
CD.Design]
RETURNS [v: ViewerClasses.Viewer]=
BEGIN
bb: CD.Rect = CDCommandOps.BoundingBox[design, FALSE];
me: VRef = New[design];
TRUSTED {Process.Detach[FORK ViewerProcess[me]]};
[] ← CDPanel.CreatePanel[design];
--must wait until me.fooBBLT is initialized by ViewerProcess
WHILE NOT me.running DO Process.Yield[] ENDLOOP;
v ← me.viewer ← ViewerOps.CreateViewer[
flavor: viewerClassAtom,
info: [
name: Caption[design],
scrollable: FALSE,
icon: CDTipEtc.GetIcon[design],
iconic: FALSE,
column: ColumnForNewViewer[],
tipTable: CDTipEtc.GetTipTable[design],
newVersion: IsNewVersion[design],
data: me
],
paint: FALSE --important: me.viewer is initialized only after return
paint: TRUE --sorry, must check elsewhere for this case, otherwise viewerpackage blusters
];
me.dClip ← CDVScale.GetClipRecord[me.intendedScale, v.cw, v.ch];
IF CDBasics.NonEmpty[bb]
THEN {
--but redraw does not yet come through... (clip area empty!)
CDViewer.ShowAndScale[v, bb];
CDDrawQueue.Flush[me.ct]; --I don't trust me
me.scale ← me.intendedScale;
me.dClip ← CDVScale.GetClipRecord[me.intendedScale, v.cw, v.ch];
};
CDDrawQueue.Flush[me.ct]; --I don't trust me
CDDrawQueue.ChangeClipArea[me.ct, me.dClip];
ViewerOps.PaintViewer[v, all];
EnableCursoring[me];
Include[me];
END;
ColumnForNewViewer:
PROC []
RETURNS [col: ViewerClasses.Column←left] =
--selects colordisplay if it is on and free
BEGIN
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
}
END;
DestroyViewer: ViewerClasses.DestroyProc =
BEGIN
vRef: VRef ~ NARROW[self.data];
CDValue.Store[vRef.actualDesign, $CDxNewVersion, (IF self.newVersion THEN $T ELSE NIL)];
Destroy[vRef];
self.data ← NIL;
END;
ViewerCorDEvent: ViewerEvents.EventProc =
-- PROC [viewer: Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE]
BEGIN
vRef: VRef ~ NARROW[viewer.data];
CDDrawQueue.ChangeClipArea[vRef.ct, CDBasics.empty];
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
New:
PUBLIC
ENTRY
PROC [design:
CD.Design]
RETURNS [me: VRef←
NIL] =
BEGIN ENABLE UNWIND => NULL;
NewScale:
PROC [design:
CD.Design]
RETURNS [CDVScale.ScaleRec] =
BEGIN
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]
]];
END;
InitDesignRec:
PROC [me: VRef] =
BEGIN
FOR l:
LIST
OF VRef ← allVRefs, l.rest
WHILE l#
NIL
DO
IF me.actualDesign=l.first.actualDesign THEN { me.designRec ← l.first.designRec; RETURN };
ENDLOOP;
me.designRec ←
NEW[CDVPrivate.VPrivatePerDesign ← [
outlineProcLC: CDVPrivate.DefaultOutLine,
currentLayer: CD.errorLayer
]];
CDVPrivate.SetCursorMode[me, NIL];
END;
InitVRef:
PROC [design:
CD.Design]
RETURNS [me: VRef] =
BEGIN
b: REF BOOL = NEW[BOOL←FALSE];
me ←
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[me];
END;
--New
--all critical work is done in procedures, so UNWIND really should work
me ← InitVRef[design];
END;
Include:
ENTRY
PROC [me: VRef] = {
allVRefs ← CONS[me, allVRefs];
};
Destroy:
PUBLIC
ENTRY
PROC [me: VRef] =
TRUSTED BEGIN ENABLE UNWIND => NULL;
IF me#
NIL
THEN {
allVRefs ← LOOPHOLE[List.DRemove[ref: me, list: LOOPHOLE[allVRefs]]];
CDDrawQueue.Destroy[me.ct];
}
END;
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
NoteProfileChange: UserProfile.ProfileChangedProc =
-- PROC [reason: ProfileChangeReason]
BEGIN
catchCritical ← UserProfile.Boolean["ChipNDale.CatchLowLevelErrors", TRUE];
catchWedging ← catchCritical OR UserProfile.Boolean["ChipNDale.CatchErrorsWhichCauseDeadlock", TRUE];
putNewViewerOnColor ← UserProfile.Boolean["ChipNDale.FirstViewerOnColor", TRUE];
END;
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];
TerminalIO.WriteRopes[greeting, date, copyRight];
END.
gbb April 4, 1986 6:26:26 pm PST
Changed first line written in Terminal.