<> <> <> <> 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 <<--monitoring rule: aquire the ViewerLock first, the monitor's entry lock only after.>> 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[] }; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> <<-- 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: 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] = { <<--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 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 = { <> <<-- logicaly local to viewers paint proc (PaintViewer)>> CDDrawQueue.Flush[me.ct]; me.scale _ me.intendedScale; SetUpAndRedraw[me]; }; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- <<--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.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 => { <<--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; 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] <<-- 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]; CDVPrivate.SetCursorMode[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; 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 => { <<-- 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; }; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> 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 = { <<-- PROC [event: REF, design: CD.Design, x: REF] >> <<-- repaint captions and sometimes the contents>> 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 { <<--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; }; 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]; <<--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], 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 { <<--but redraw does not yet come through... (clip area empty!)>> 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] = { <<--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 => { CDValue.Store[vRef.actualDesign, $CDxNewVersion, (IF self.newVersion THEN $T ELSE NIL)]; 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; }; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- 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]; }; <<>> <<--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]; 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. <<>> <<>>