CDVMain.mesa (part of ChipNDale)
Copyright © 1983, 1984, 1985, 1986, 1987 by Xerox Corporation. All rights reserved.
Created by: Christian Jacobi, June 24, 1983 3:33 pm
Last Edited by: Christian Jacobi, April 28, 1987 6:36:44 pm PDT
Jean-Marc Frailong October 12, 1987 11:51:45 pm PDT
DIRECTORY
CD,
CDBasics,
CDCellsBackdoor,
CDColors,
CDDrawQueue,
CDEnvironment USING [GetTipTable, GetIcon],
CDEvents,
CDLayers USING [CurrentLayer, LayerWidth],
CDInstances,
CDProperties,
CDSequencer USING [Command, CommandRec, ExecuteCommand],
CDValue,
CDViewer,
CDViewerBackdoor,
CDVPrivate,
CDVScale,
CedarProcess USING [SetPriority, Priority],
Cursors USING [CursorType],
DebuggerSwap USING [WorryCallDebugger],
InputFocus USING [SetInputFocus, PopInputFocus],
InterminalBackdoor USING [terminal],
IO,
PrincOps USING [BBTableSpace],
PrincOpsUtils USING [AlignedBBTable],
Process USING [Detach, Yield],
Rope,
RuntimeError USING [UNCAUGHT],
SafeStorage USING [ReclaimCollectibleObjects],
Terminal USING [GetColorMode],
TerminalIO,
TIPUser USING [TIPScreenCoords],
UserProfile USING [Boolean, ProfileChangedProc, CallWhenProfileChanges],
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
CD, CDBasics, CDCellsBackdoor, CDColors, CDDrawQueue, CDEnvironment, CDEvents, CDInstances, CDLayers, CDProperties, CDSequencer, CDValue, CDViewer, CDViewerBackdoor, CDVPrivate, CDVScale, CedarProcess, DebuggerSwap, InputFocus, InterminalBackdoor, IO, PrincOpsUtils, Process, Rope, RuntimeError, SafeStorage, Terminal, TerminalIO, UserProfile, ViewerEvents, ViewerOps, WindowManager
EXPORTS CDVPrivate
SHARES CDViewerBackdoor, TerminalIO, CDDrawQueue =
BEGIN
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
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[]
};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
-- 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
];
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
viewerClassRec: ViewerClasses.ViewerClass ←
NEW[ViewerClasses.ViewerClassRec ← [
paint: PaintViewer,
notify: NotifyViewer,
modify: ModifyViewer,
destroy: DestroyViewer,
set: CDViewerBackdoor.CallSetProc,
get: CDViewerBackdoor.CallGetProc,
bltH: left,
bltV: bottom,
cursor: cursorNoFocus
]];
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
cursoredCDViewer: PUBLIC Viewer ← NIL;
inputFocussedViewer: Viewer ← NIL;
lastInputFocussedViewer: Viewer ← NIL;
lastDesign: CD.Design ← 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] = {
--logically inside the viewer's paint proc;
--reset viewer data and then sets up a buffered request for redrawing
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];
-- erase to allow also backgrounds of arbitrary patterns or colors
CDDrawQueue.QueueInsertDrawCommand[vRef.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]];
};
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.
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 {
--vRef ABSOLUTELY never NIL {proc is local}
ENABLE UNWIND => NULL;
IF vRef.cursorInhibitations=0
THEN {
--Proof hints: vRef.onVC initialized false; vRef.usedCursor not accessed outside
-- CDVMains monitorlock (use Grep)
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;
};
--now vRef.onVC is true
vRef.usedCursor ← vRef.designRec.outlineProcLC;
vRef.stopVC ← tr.pos;
vRef.usedCursor[vRef];
};
DisposeTrackRef[tr];
};
RemoveTrack:
ENTRY
PROC[vRef: VRef] =
INLINE {
--vRef ABSOLUTELY never NIL {proc is local}
ENABLE UNWIND => NULL;
IF vRef.onVC
THEN {
vRef.usedCursor[vRef];
vRef.onVC ← FALSE;
};
};
--PaintViewer
IF self.destroyed THEN RETURN;
WITH self.data
SELECT
FROM
vr: VRef => vRef ← vr;
ENDCASE => RETURN;
vRef.viewContext ← context;
--here it would have trapped if vRef=NIL
WITH whatChanged
SELECT
FROM
tr: TrackRef => TrackRefTrack[vRef, tr]; -- called by NotifyViewer
atom:
ATOM => {
IF atom=$RemoveTrack THEN RemoveTrack[vRef]
ELSE CDViewerBackdoor.CallFurtherPaint[vRef, atom]; -- called from anywhere, maybe not protected
};
area: RepaintRectAreaRef =>
-- protected by ProtectedRepaint
CDVPrivate.RepaintRectAreaInViewer[vRef, area.rect, area.erase];
vSave: ViewerClasses.PaintRectangle => RepaintParts[vRef, vSave];
ENDCASE => {
IF whatChanged=
NIL
THEN {
IF vRef.viewer#self THEN RETURN; --initialization not finished
SetUpAndRedraw[vRef] -- called from anywhere, maybe not protected
}
ELSE CDViewerBackdoor.CallFurtherPaint[vRef, whatChanged];
}
EXITS oops => NULL;
};
RepaintParts:
PROC [vr: VRef, vSave: ViewerClasses.PaintRectangle] = {
DrawOutside:
PROC [r:
CD.Rect] = {
CDDrawQueue.QueueInsertDrawCommand[vr.ct, CDDrawQueue.Request[$redraw, r]];
};
r: CD.Rect;
CDVPrivate.ResetDrawScale[vr];
IF vr.intendedScale#vr.scale
THEN {
DrawOutside[CDBasics.universe];
RETURN
};
r ←
CD.Rect[
x1: CDVScale.UngriddedViewerToDesignScalar[vr.scale, vSave.x-(vr.viewer.wx)]+vr.scale.off.x+1,
y1: CDVScale.UngriddedViewerToDesignScalar[vr.scale, vSave.y-(vr.viewer.wy)]+vr.scale.off.y+1,
x2: CDVScale.UngriddedViewerToDesignScalar[vr.scale, vSave.x+vSave.w-(vr.viewer.wx)]+vr.scale.off.x-1,
y2: CDVScale.UngriddedViewerToDesignScalar[vr.scale, vSave.y+vSave.h-(vr.viewer.wy)]+vr.scale.off.y-1
];
IF CDBasics.NonEmpty[r]
THEN CDBasics.DecomposeRect[r: vr.dClip, test: r, outside: DrawOutside]
ELSE DrawOutside[CDBasics.universe];
};
SetScaleAndRedraw: CDViewerBackdoor.FurtherPaintProc = {
-- logicaly local to viewers paint proc (PaintViewer)
CDDrawQueue.Flush[me.ct];
ResetDrawScale[me];
SetUpAndRedraw[me];
};
ResetDrawScale:
PUBLIC ENTRY
PROC [vRef: VRef] = {
-- logicaly local to viewers paint proc (PaintViewer)
ENABLE UNWIND => NULL;
vRef.scale ← vRef.intendedScale;
CDVPrivate.CreateDrawInformation[vRef];
CDDrawQueue.ChangeClipArea[vRef.ct, vRef.dClip];
};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
--logically local to ProtectedRepaint and initialization--
--vRef never nil--
EnableCursoring:
ENTRY
PROC[vRef: VRef] =
INLINE {
--logically local to ProtectedRepaint
--is outside to make callable from catch-phrase and initialization
ENABLE UNWIND => NULL;
vRef.cursorInhibitations ← vRef.cursorInhibitations-1;
BROADCAST tryToPaint
};
ProtectedRepaint:
PROC[vRef: VRef, whatChanged:
REF
ANY] = {
--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})
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 {
--and enters protected region.
--vRef never nil; guaranteed from caller {proc is local}
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;
};
--ProtectedRepaint
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;
--vRef.fooBBptr is a short pointer! (hardware) therefor must be local to some proc space.
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]];
--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[vRef, comm];
ENDLOOP;
TerminalIO.PutRope["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 => {
--order important
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 => {
--order important
vRef.slowDown ← FALSE;
vRef.hurryUp ← TRUE;
vRef.check ← TRUE;
vRef.deviceDrawRef.checkPriority ← TRUE;
};
ENDCASE => NULL;
};
RemoveCursor:
PROC [vRef: VRef] =
INLINE {
--removes visible cursor, if there is
--monitores inside viewerpaintproc
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;
RemoveCursoring:
PROC [from, now: Viewer] =
TRUSTED {
--RemoveCursoring from "from"; but not if "from" and "now" denote the same design
IF from#
NIL
AND now#
NIL
THEN
WITH from.data
SELECT
FROM
fromVr: VRef => {
WITH now.data
SELECT
FROM
nowVr: VRef => IF nowVr.actualDesign=fromVr.actualDesign THEN RETURN;
ENDCASE => NULL;
--calling CDViewerBackdoor.CallFurtherNotify is not cosher but
--calling with NIL mode is explicitely allowed
Process.Detach[FORK CDViewerBackdoor.CallFurtherNotify[fromVr, NIL]];
};
ENDCASE => NULL;
};
SELECT change
FROM
set, pop => {
IF lastInputFocussedViewer#self THEN RemoveCursoring[lastInputFocussedViewer, self];
lastInputFocussedViewer ← inputFocussedViewer ← self;
};
kill, push => inputFocussedViewer ← NIL;
ENDCASE => NULL;
SetCursor[];
};
NotifyViewer: ViewerClasses.NotifyProc = {
-- PROC [self: Viewer, input: LIST OF REF ANY]
-- ENTRY ommitted since sequential already by viewer package
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 {
--makes cursor logically available
IF
NOT vRef.designRec.startLCValid
THEN {
vRef.designRec.startLC ← pos;
vRef.designRec.startLCValid ← TRUE;
}
};
LogicalTrackOff:
PROC [vRef: VRef, pos:
CD.Position] =
INLINE {
--makes cursor logically unavailable
vRef.designRec.stopLC ← pos;
vRef.designRec.startLCValid ← FALSE;
};
Track:
PROC [vRef: VRef] =
INLINE {
--uses intermediate layer variable mouse
VisibleTrack:
PROC [vRef: VRef, pos:
CD.Position] =
INLINE {
--makes cursor visible
ViewerOps.PaintViewer[vRef.viewer, client, FALSE, GetTrackRef[pos] ];
};
--Track
pos: CD.Position = CDVScale.ViewerToDesignPosition[vRef.scale, mouse];
LogicalTrack[vRef, pos];
IF vRef.cursorInhibitations=0 THEN VisibleTrack[vRef, pos];
};
StopTrack:
PROC [vRef: VRef] = {
--uses intermediate layer variable mouse
pos: CD.Position ~ CDVScale.ViewerToDesignPosition[vRef.scale, mouse];
vRef.hurryUp ← TRUE;
LogicalTrackOff[vRef, pos];
RemoveCursor[vRef];
CDViewerBackdoor.CallFurtherNotify[vRef, NIL];
};
--NotifyViewer
WITH self.data
SELECT
FROM
vr: VRef => vRef ← vr;
ENDCASE => RETURN;
IF self#cursoredCDViewer
THEN {
tem: Viewer ~ cursoredCDViewer;
IF vRef.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 paint procedure only.
--luckily at that time cursoredCDViewer#self; so here is the only
--place to check.
RETURN
};
IF tem#
NIL
THEN
WITH tem.data
SELECT
FROM
vRef: VRef => RemoveCursor[vRef];
ENDCASE => NULL;
--avoid running in 24 bit per pixel mode
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;
CDViewerBackdoor.CallFurtherNotify[vRef, input.first]
}
ELSE {
-- all other (standard) commands
data: REF ← NIL;
StopTrack[vRef];
IF lastDesign#vRef.actualDesign
THEN {
data←lastDesign; lastDesign←vRef.actualDesign
};
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,
data: data
]]
!
CD.Error =>
IF ec=designMutability
THEN {
MessageBad[vRef.actualDesign, atom]; CONTINUE
}
]
]};
};
};
};
coords: TIPUser.TIPScreenCoords => {
-- range test,
-- [some crazy tiptables use coords without a mouse action first]
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;
};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
MessageBad:
PROC [design:
CD.Design, atom:
ATOM←
NIL] =
TRUSTED {
Process.Detach[
FORK TerminalIO.PutF["**design %g is immutable; can not execute %g command\n",
[rope[CD.DesignName[design]]], [atom[atom]]
]];
};
Caption:
PROC [design:
CD.Design, label: Rope.
ROPE]
RETURNS [Rope.
ROPE] = {
IF design=NIL THEN RETURN["nil design"];
RETURN [
IO.PutFR["%g %g %g %g",
[rope[label]],
[rope[design.technology.name]],
[rope[CDCellsBackdoor.PushedCellName[design]]],
[rope[(
SELECT design.mutability
FROM
editable => "" ,
readonly => "[READONLY]",
inaccessible => "[IN-ACCESSIBLE]",
ENDCASE => "[ACESSIBILITY UNDEFINED]"
)]]
]];
};
EventCheckCaptionAndRedraw: CDEvents.EventProc = {
-- repaint captions and sometimes the contents
FOR l: CDViewer.ViewerList ← CDViewer.ViewersOf[design], l.rest
WHILE l#
NIL
DO
WITH l.first.data
SELECT
FROM
vRef: VRef => {
IF event=$RenameDesign OR event=$ResetDesign THEN l.first.label ← design.name;
l.first.name ← Caption[design, l.first.label];
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[vRef.ct, CDDrawQueue.Request[$redraw, CDBasics.universe]]
}
};
ENDCASE => NULL;
ENDLOOP;
};
EventSetTipTable: CDEvents.EventProc = {
FOR l: CDViewer.ViewerList ← CDViewer.ViewersOf[
NIL], l.rest
WHILE l#
NIL
DO
WITH l.first.data
SELECT
FROM
vRef: VRef => {
--so now we are sure l.first is a ChipNDale viewer
l.first.tipTable ← CDEnvironment.GetTipTable[vRef.actualDesign];
};
ENDCASE => NULL;
ENDLOOP;
};
UseBBox:
PROC [d:
CD.Design]
RETURNS [bb:
CD.Rect ← [0, 0, 1, 1]] = {
--called on viewer creation [un-monitored]
pushList: LIST OF CD.PushRec ← NIL;
specific: CD.CellSpecific ← NIL;
contents: CD.InstanceList ← NIL;
IF d#NIL THEN pushList ← d.actual;
IF pushList#NIL THEN specific ← pushList.first.specific;
IF specific#NIL THEN contents ← specific.contents;
IF contents=
NIL
THEN bb ← [0, 0, 800, 400]
ELSE bb ← CDInstances.BoundingRectO[contents ! RuntimeError.UNCAUGHT => GOTO oops];
EXITS oops => NULL;
};
CreateViewer:
PUBLIC
PROC[design:
CD.Design]
RETURNS [v: Viewer] = {
vRef: VRef = New[design];
name: Rope.ROPE = CD.DesignName[design];
TRUSTED {Process.Detach[FORK ViewerProcess[vRef]]};
--must wait until vRef.fooBBLT is initialized by ViewerProcess
WHILE NOT vRef.running DO Process.Yield[] ENDLOOP;
v ← vRef.viewer ← ViewerOps.CreateViewer[
flavor: viewerClassAtom,
info: [
name: Caption[design, name],
label: name,
scrollable: FALSE,
icon: CDEnvironment.GetIcon[design],
iconic: FALSE,
column: ColumnForNewViewer[],
tipTable: CDEnvironment.GetTipTable[design],
newVersion: design.edited,
data: vRef
],
paint:
TRUE
--sorry; I would prefere not to paint here, but this is necessary to get
--some initializations right; we should flush painting out anyway.
];
vRef.dClip ← CDVScale.GetClipRecord[vRef.intendedScale, v.cw, v.ch];
CDViewer.ShowAndScale[v, UseBBox[design]];
-- but redraw does not yet come through... (clip area empty!)
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];
CDDrawQueue.Flush[vRef.ct];
--Here we flush because it could be that the following PaintViewer must wait
--until previous painting is finished.
--Experiment showed that the PaintViewer is not necessary, but that might work
--only because the paint from more above is slower than the previous Flush.
--I prefere to be on the safe side at cost of speed.
ViewerOps.PaintViewer[v, all];
EnableCursoring[vRef];
Include[vRef];
};
ColumnForNewViewer:
PROC []
RETURNS [col: ViewerClasses.Column←left] = {
--selects colordisplay if it is on and free
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 => {
Destroy[vRef];
self.data ← NIL;
};
ENDCASE => NULL;
};
ViewerCorDEvent: ViewerEvents.EventProc = {
-- PROC [viewer: Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL ← FALSE]
WITH viewer.data
SELECT
FROM
vRef: VRef => CDDrawQueue.ChangeClipArea[vRef.ct, CDBasics.empty];
ENDCASE => NULL;
IF cursoredCDViewer=viewer THEN cursoredCDViewer ← NIL
};
ViewerChangeColEvent: ViewerEvents.EventProc = {
--we do this to force Notify to check whether we are in 24 bit per pixel mode
IF viewer=cursoredCDViewer
THEN
IF Terminal.GetColorMode[InterminalBackdoor.terminal].full
THEN
cursoredCDViewer ← NIL;
};
SetLabel: ViewerClasses.SetProc ~ {
Changes the label & caption. Caption is derived from label by adding technology, push level & accessibility. Default label is design name.
Use this procedure by: ViewerOps.SetViewer[viewer: viewer, data: "New Label", op: $Label]
label: Rope.
ROPE =
WITH data
SELECT
FROM
r: Rope.ROPE => r,
t: REF TEXT => Rope.FromRefText[t],
ENDCASE => NIL;
IF label=NIL THEN RETURN;
self.label ← label;
self.name ← Caption[CDViewer.DesignOf[self], label];
ViewerOps.PaintViewer[self, caption];
};
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
NullOutline: CDVPrivate.OutLineProc = {};
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: NullOutline,
currentLayer: CD.errorLayer
]];
CDViewerBackdoor.CallFurtherNotify[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,
fontSubstitution: CDProperties.GetDesignProp[design, $CDxSubstituteFonts]=$TRUE,
personalColors: CDColors.globalColors,
cursorInhibitations: 1, --disabled, not yet ready
properties: CD.InitPropRef[]
]];
InitDesignRec[vRef];
};
--New
--all critical work is done in procedures, so UNWIND really should work
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 {
--allVRefs ← LO OPHOLE[List.DRemove[ref: vRef, list: LO OPHOLE[allVRefs]]];
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 = {
-- PROC [reason: ProfileChangeReason]
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];
CDViewerBackdoor.InstallFurtherPaint[keyValue: $changeScale, proc: SetScaleAndRedraw];
CDViewerBackdoor.InstallFurtherPaint[keyValue: $flushed, proc: SetScaleAndRedraw];
CDEvents.RegisterEventProc[$ResetDesign, EventCheckCaptionAndRedraw];
CDEvents.RegisterEventProc[$RenameDesign, EventCheckCaptionAndRedraw];
CDEvents.RegisterEventProc[$AfterPush, EventCheckCaptionAndRedraw];
CDEvents.RegisterEventProc[$AfterPop, EventCheckCaptionAndRedraw];
CDEvents.RegisterEventProc[$MutabilityChange, EventCheckCaptionAndRedraw];
CDEvents.RegisterEventProc[$CDReRegisterTipTables, EventSetTipTable];
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];
CDViewerBackdoor.InstallSetProc[$Label, SetLabel];
-- permit dynamic relabelling of CD viewer
END.