<> <> <> <> DIRECTORY Atom USING [GetPName], CD, CDDraw, CDEvents, CDExtras, CDBasics, CDPanel, CDSequencer USING [Command, CommandRec, ExecuteCommand], CDTipEtc, CDDefaults, CDVFurtherPainters, CDVPrivate, CDViewer, CDVScale, Cursors, InputFocus USING [SetInputFocus], PrincOps USING [BBTableSpace], PrincOpsUtils, Process USING [Detach, Yield, priorityNormal, priorityBackground, SetPriority], Rope USING [ROPE, Concat], RuntimeError USING [UNCAUGHT], 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 Atom, CDDraw, CDEvents, CDExtras, CDBasics, CDPanel, CDVFurtherPainters, CDVScale, CDSequencer, CDTipEtc, CDDefaults, CDViewer, CDVPrivate, InputFocus, PrincOpsUtils, Process, Rope, RuntimeError, SafeStorage, TerminalIO, UserProfile, ViewerEvents, ViewerOps, WindowManager EXPORTS CDVPrivate SHARES CDVFurtherPainters = BEGIN greeting: Rope.ROPE = "Chipndale Version 0.20 for Cedar 5.2 "; date: Rope.ROPE = "May 14, 1985"; copyRight: Rope.ROPE = "Copyright (C) 1984, 1985 by Xerox Corporation. All rights reserved.\n"; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- viewerClassAtom: ATOM = $Chipndale; MyGraphicRef: TYPE = CDVPrivate.MyGraphicRef; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- terminalLock: BOOLEAN _ FALSE; TerminalLock: PROC [] = { terminalLock _ TRUE; viewerClassRec.cursor _ cursorWhileInput }; TerminalFree: PROC [] ={ terminalLock _ FALSE; SetCursor[] }; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> TrackRef: TYPE = REF TrackRecord; --type to force cursor tracking TrackRecord: TYPE = RECORD [ pos: CD.DesignPosition ]; RepaintRectAreaRef: TYPE = REF RepaintRectArea; --type to force drawing a rectangular aera RepaintRectArea: TYPE = RECORD[ rect: CD.DesignRect _ CDBasics.universe, erase: BOOL _ FALSE ]; <<>> <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> tryToPaint: CONDITION; viewerClassRec: ViewerClasses.ViewerClass; <<>> <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> 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; Paint: ViewerClasses.PaintProc = <<--PROC [self: Viewer, context: Graphics.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 errorExit; RuntimeError.UNCAUGHT => IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT; }; me: MyGraphicRef = NARROW[self.data]; TrackRefTrack: ENTRY PROC [me: MyGraphicRef, tr: TrackRef] = -- INLINE -- BEGIN ENABLE UNWIND => NULL; IF me.cursorInhibitations=0 THEN { IF me.onVC THEN me.usedCursor[me] ELSE { me.startVC _ me.designRec.startLC; me.firstHorizontalVC _ me.designRec.firstHLC; me.designRec.currentLayer _ CDDefaults.CurrentLayer[me.actualDesign]; me.defaultWidthVC _ me.designRec.widthLC _ CDDefaults.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]; }; END; RemoveTrack: ENTRY PROC[me: MyGraphicRef] = BEGIN ENABLE UNWIND => NULL; IF me.onVC THEN { me.usedCursor[me]; me.onVC _ FALSE; }; END; SetUpAndRedraw: ENTRY PROC[me: MyGraphicRef] = <<--called through anybody anytime;>> <<--reset viewer data and then sets up a buffered request for redrawing>> BEGIN ENABLE UNWIND => NULL; CDDraw.FlushCommands[me.ct]; me.onVC _ FALSE; --erasing viewer automaticaly makes cursor invisible CDVPrivate.CreateDrawInformation[me]; me.saveList _ NIL; CDDraw.ModifyCommandTable[me.actualDesign, me.ct, me.deviceDrawRef.interestClip]; <<-- erase to allow also backgrounds of arbitrary patterns or colors>> CDDraw.InsertCommand[me.ct, CDDraw.Comm[cmd: all, erase: TRUE, rect: CDBasics.universe, ref: NIL] ]; END; <<--Paint>> IF self.destroyed THEN RETURN; me.viewContext _ context; WITH whatChanged SELECT FROM tr: TrackRef => TrackRefTrack[me, tr]; -- called by Notify atom: ATOM => IF atom=$RemoveTrack THEN RemoveTrack[me] ELSE CDVFurtherPainters.CallFurther[me, atom]; area: RepaintRectAreaRef => -- protected by ProtectedRepaint CDVPrivate.RepaintRectAreaInViewer[me, area.rect, area.erase]; ENDCASE => IF whatChanged=NIL THEN SetUpAndRedraw[me] -- called from anywhere, not protected ELSE CDVFurtherPainters.CallFurther[me, whatChanged]; EXITS errorExit => NULL; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --local-- EnableCursoring: ENTRY PROC[me: MyGraphicRef] = <<--logically local to ProtectedRepaint>> <<--is outside to make callable from catch-phrase>> INLINE BEGIN ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => { BROADCAST tryToPaint; IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT }; }; me.cursorInhibitations _ me.cursorInhibitations-1; BROADCAST tryToPaint EXITS errorExit => NULL; END; ProtectedRepaint: PROC[me: MyGraphicRef, whatChanged: REF ANY] = <<--does:>> <<--remove cursor and disables any cursoring process>> <<--let only one client come through>> BEGIN ENABLE RuntimeError.UNCAUGHT => { EnableCursoring[me]; IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT }; DisableCursoring: ENTRY PROC[me: MyGraphicRef] RETURNS [mustRemoveCursor: BOOL] = <<--and enters protected region.>> INLINE BEGIN ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => {BROADCAST tryToPaint; REJECT}; }; 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]; EnableCursoring[me]; EXITS errorExit => NULL; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ViewerProcess: PROC[me: MyGraphicRef] = BEGIN comm: REF CDDraw.Comm ~ NEW[CDDraw.Comm]; bBTableSpace1, bBTableSpace2: PrincOps.BBTableSpace; <<--me.xBLT is a short pointer! (hardware) therefore must be local to some>> <<--procedure space.>> IF me.running THEN ERROR; TRUSTED { me.pBBptr _ PrincOpsUtils.AlignedBBTable[@bBTableSpace1]; me.xBBptr _ PrincOpsUtils.AlignedBBTable[@bBTableSpace2] }; me.running _ TRUE; DO comm^ _ CDDraw.FetchCommand[me.ct]; SELECT comm.cmd FROM rect => { paintArea: RepaintRectAreaRef _ NEW[RepaintRectArea_[comm.rect, comm.erase]]; IF me.hurryUp THEN TRUSTED {Process.SetPriority[Process.priorityNormal]}; ProtectedRepaint[me, paintArea]; }; all => { paintArea: RepaintRectAreaRef _ NEW[RepaintRectArea_[comm.rect, TRUE]]; IF me.hurryUp THEN TRUSTED {Process.SetPriority[Process.priorityNormal]}; ProtectedRepaint[me, paintArea]; }; ref => ProtectedRepaint [me, comm]; alldone => { ProtectedRepaint[me, $Temporaries]; me.hurryUp _ FALSE; TRUSTED {Process.SetPriority[Process.priorityBackground]}; <<--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]; }; none => Process.Yield[]; disapearforever => EXIT; ENDCASE => ProtectedRepaint[me, comm]; ENDLOOP; me.running _ FALSE; me.ct _ NIL; me.actualDesign _ NIL; me.designRec _ NIL; TerminalIO.WriteRope["Viewer destroyed\n"]; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- RemoveCursor: PROC [me: MyGraphicRef] = <<--removes visible cursor, if there is>> <<--monitores inside viewerpaintproc >> INLINE BEGIN IF me.onVC THEN ViewerOps.PaintViewer[me.viewer, client, FALSE, $RemoveTrack]; END; Modify: 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; Notify: ViewerClasses.NotifyProc -- PROC [self: Viewer, input: LIST OF REF ANY] -- = <<-- ENTRY ommitted since sequential already be viewer package >> BEGIN ENABLE RuntimeError.UNCAUGHT => IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO errorExit ELSE REJECT; me: MyGraphicRef = NARROW[self.data]; mouse: CD.Position_[0, 0]; --be a little robust and initialize, there are crazy tiptables. LogicalTrack: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = INLINE <<--makes cursor logically available>> BEGIN IF NOT me.designRec.startLCValid THEN { me.designRec.startLC _ pos; me.designRec.startLCValid _ TRUE; } END; LogicalTrackOff: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = INLINE <<--makes cursor logically unavailable>> BEGIN me.designRec.stopLC _ pos; me.designRec.startLCValid _ FALSE; END; Track: PROC [me: MyGraphicRef] = <<--uses intermediate layer variable mouse>> BEGIN VisibleTrack: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = INLINE <<--makes cursor visible>> BEGIN tr: TrackRef ~ NEW[TrackRecord]; tr.pos _ pos; ViewerOps.PaintViewer[me.viewer, client, FALSE, tr]; END; <<--Track>> pos: CD.DesignPosition = CDVScale.ViewerToDesignPosition[me.scale, mouse]; LogicalTrack[me, pos]; IF me.cursorInhibitations#0 THEN RETURN; VisibleTrack[me, pos] END; StopTrack: PROC [me: MyGraphicRef] = <<--uses intermediate layer variable mouse>> BEGIN pos: CD.DesignPosition = CDVScale.ViewerToDesignPosition[me.scale, mouse]; me.hurryUp _ TRUE; LogicalTrackOff[me, pos]; RemoveCursor[me]; CDVPrivate.SetCursorMode[me, NIL]; END; <<--Notify>> 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 paintprocedure happened;>> <<--but in ChipNDale, some initializations happens in paintprocedure only.>> <<--luckyli at that time cursoredCDViewer#self; so here is the only>> <<--place to check. >> RETURN }; IF tem#NIL AND tem.data#NIL THEN { temMe: MyGraphicRef = NARROW[tem.data]; RemoveCursor[temMe]; }; cursoredCDViewer _ self; SetCursor[]; }; DO -- loop over input list: <<--FOR input _ input, input.rest WHILE input # NIL DO >> <<--is programmed explicitely because internally input is changed also>> IF input=NIL THEN EXIT; WITH input.first SELECT FROM coords: TIPUser.TIPScreenCoords => { <<-- range test, because some crazy tiptables call 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]; }; atom: ATOM => IF atom=$Track THEN Track[me] ELSE IF terminalLock THEN { IF atom#$StopTrack THEN ViewerOps.BlinkIcon[self]; RETURN } ELSE { IF self#inputFocussedViewer THEN { InputFocus.SetInputFocus[self]; IF atom=$CloseReSelectOnlyP THEN RETURN; }; SELECT atom FROM $StopTrack => StopTrack[me]; $UseCursor => { --command involving 2 atoms RemoveCursor[me]; input _ input.rest; IF input=NIL THEN RETURN; CDVPrivate.SetCursorMode[me, input.first] }; $StopDrawing => CDDraw.FlushCommands[me.ct]; ENDCASE => { -- standard commands StopTrack[me]; TRUSTED {Process.Detach[FORK CDSequencer.ExecuteCommand[ design: me.actualDesign, comm: NEW[CDSequencer.CommandRec_CDSequencer.CommandRec[ design: me.actualDesign, a: atom, pos: me.designRec.stopLC, sPos: me.designRec.startLC, l: me.designRec.currentLayer, ref: me, n: me.defaultWidthVC, b: me.designRec.firstHLC ]]]] }; --trusted }; --endcase }; --atom ENDCASE; input _ input.rest ENDLOOP; EXITS errorExit => NULL; END; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> CaptionText: PROC [design: CD.Design] RETURNS [Rope.ROPE] = BEGIN TechnologyName: PROC [t: CD.Technology] RETURNS [Rope.ROPE] = INLINE { RETURN [IF t.name#NIL THEN t.name ELSE Atom.GetPName[t.key]] }; <<--CaptionText>> name: Rope.ROPE; IF design=NIL THEN RETURN["nil design"]; name _ Rope.Concat[(IF design.name#NIL THEN design.name ELSE "no name"), " ("]; name _ Rope.Concat[name, TechnologyName[design.technology]]; name _ Rope.Concat[name, ") cell: "]; name _ Rope.Concat[name, CDExtras.PushedCellName[design]]; RETURN [name] END; RepaintCaptions: CDEvents.EventProc = <<-- PROC [event: REF, design: CD.Design, x: REF] >> <<-- repaint captions and sometimes the contents>> BEGIN name: Rope.ROPE = CaptionText[design]; FOR l: CDViewer.ViewerList _ CDViewer.ViewersOf[design], l.rest WHILE l#NIL DO me: MyGraphicRef = NARROW [l.first.data]; l.first.name _ name; ViewerOps.PaintViewer[l.first, caption]; IF event=$AfterPop OR event=$AfterPush THEN { <<--redraw everything, because >> <<-- after pop: cell change may have propagated>> <<-- after push: background features must be redrawn greyish>> CDDraw.InsertCommand[me.ct, CDDraw.Comm[cmd: all, erase: TRUE, rect: CDBasics.universe, ref: NIL]] } ENDLOOP; END; CreateViewer: PUBLIC PROC[design: CD.Design] RETURNS [ViewerClasses.Viewer]= BEGIN b: CD.DesignRect _ CDExtras.BoundingBox[design]; me: MyGraphicRef = CDVPrivate.NewAndLink[design]; me.ct _ CDDraw.CreateCommandTable[me.actualDesign, [1, 1, 0, 0], me.stoprequest]; TRUSTED {Process.Detach[FORK ViewerProcess[me]]}; [] _ CDPanel.CreatePanel[design]; <<--must wait until me.xBLT is initialized by ViewerProcess>> WHILE NOT me.running DO Process.Yield[] ENDLOOP; <<--normal creation>> me.viewer _ ViewerOps.CreateViewer[ flavor: viewerClassAtom, info: [ name: CaptionText[design], scrollable: FALSE, icon: CDTipEtc.GetIcon[design], iconic: FALSE, column: ColumnForNewViewer[], tipTable: CDTipEtc.GetTipTable[design], data: me ] ]; IF CDBasics.NonEmpty[b] THEN CDViewer.ShowAndScale[me.viewer, b]; RETURN [me.viewer] END; ColumnForNewViewer: PROC [] RETURNS [col: ViewerClasses.Column_left] = <<--selects colordisplay if it is on and free>> BEGIN found: BOOL _ FALSE; CheckTheColorScreen: ViewerOps.EnumProc = { <<--PROC [v: Viewer] RETURNS [BOOL _ TRUE] -- >> IF v.column=color AND ~v.iconic AND ~v.offDeskTop THEN {found_TRUE; RETURN[FALSE]}; }; IF WindowManager.colorDisplayOn AND UserProfile.Boolean["Chipndale.FirstViewerOnColor", TRUE] THEN { ViewerOps.EnumerateViewers[CheckTheColorScreen]; IF ~found THEN col _ color } END; Destroy: ViewerClasses.DestroyProc = -- PROC [self: Viewer] BEGIN me: MyGraphicRef ~ NARROW[self.data]; CDVPrivate.UnLink[me]; CDDraw.DestroyCommandTable[me.ct]; self.data _ NIL END; CallOnClose: ViewerEvents.EventProc = <<-- PROC [viewer: ViewerClasses.Viewer, event: ViewerEvent, before: BOOL] RETURNS [abort: BOOL _ FALSE]>> BEGIN me: MyGraphicRef ~ NARROW[viewer.data]; IF event#close THEN ERROR; CDDraw.ModifyCommandTable[me.actualDesign, me.ct, CDBasics.empty]; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- <<--Initialization>> Init: PROC [] = BEGIN TerminalIO.AddLock[TerminalLock, TerminalFree]; viewerClassRec _ NEW[ViewerClasses.ViewerClassRec _ [ paint: Paint, notify: Notify, modify: Modify, destroy: Destroy, cursor: cursorNoFocus ]]; ViewerOps.RegisterViewerClass[viewerClassAtom, viewerClassRec]; [] _ ViewerEvents.RegisterEventProc[proc: CallOnClose, event: close, filter: viewerClassAtom, before: FALSE]; CDEvents.RegisterEventProc[$ResetDesign, RepaintCaptions]; CDEvents.RegisterEventProc[$RenameDesign, RepaintCaptions]; CDEvents.RegisterEventProc[$AfterPush, RepaintCaptions]; CDEvents.RegisterEventProc[$AfterPop, RepaintCaptions]; TerminalIO.WriteRope[greeting]; TerminalIO.WriteRope[date]; TerminalIO.WriteLn[]; TerminalIO.WriteRope[copyRight]; END; Init[]; END.