<> <> <> <> DIRECTORY Atom USING [GetPName], CD, CDApplications, CDDraw, CDEvents, CDExtras, CDInline, CDOrient, CDPanel, CDProperties, CDSequencer USING [Command, CommandRec, ExecuteCommand], CDTechnology, CDValue, CDVPrivate, CDViewer, Cursors, Graphics, GraphicsOps, Icons USING [IconFlavor, NewIconFromFile], InputFocus USING [SetInputFocus], PrincOps USING [BBTableSpace], PrincOpsUtils, Process USING [Detach, Yield, priorityNormal, priorityBackground, SetPriority], Rope USING [ROPE, Concat], RuntimeError USING [UNCAUGHT], TerminalIO, TIPUser USING [TIPScreenCoords, RegisterTIPPredicate], UserProfile, ViewerClasses, ViewerEvents USING [EventProc, RegisterEventProc], ViewerOps USING [CreateViewer, RegisterViewerClass, PaintViewer, BlinkIcon]; CDVMain: CEDAR MONITOR IMPORTS Atom, CDApplications, CDDraw, CDEvents, CDExtras, CDInline, CDOrient, CDPanel, CDProperties, CDSequencer, CDTechnology, CDValue, CDViewer, CDVPrivate, Graphics, Icons, InputFocus, PrincOpsUtils, Process, Rope, RuntimeError, TerminalIO, TIPUser, UserProfile, ViewerEvents, ViewerOps EXPORTS CDVPrivate = BEGIN copyright: Rope.ROPE = "Copyright (C) 1984 by Xerox Corporation. All rights reserved\n"; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- terminalLock: BOOLEAN _ FALSE; TerminalLock: PROC [] = {terminalLock _ TRUE; viewerClassRec.cursor _ questionMark}; TerminalFree: PROC [] ={terminalLock _ FALSE; viewerClassRec.cursor _ myCursor}; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> coordSys: ViewerClasses.CoordSys = bottom; MyGraphicRef: TYPE = CDVPrivate.MyGraphicRef; viewerClassAtom: PUBLIC ATOM = $Chipndale; myCursorOK: Cursors.CursorType _ IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE textPointer; myCursorNoFocus: Cursors.CursorType _ IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE pointDown; myCursor: Cursors.CursorType _ myCursorNoFocus; TrackRef: TYPE = REF TrackRecord; --type to force cursor tracking TrackRecord: TYPE = RECORD [ pos: CD.DesignPosition ]; ArrowRef: TYPE = REF ArrowRecord; --type to force drawing an arrow ArrowRecord: TYPE = RECORD [ apos: CD.DesignPosition ]; RepaintRectAreaRef: TYPE = REF RepaintRectArea; --type to force drawing a rectangular aera RepaintRectArea: TYPE = RECORD[ rect: CD.DesignRect _ CDInline.universe, erase: BOOL _ FALSE ]; tryToPaint: CONDITION; cursoredViewer: ViewerClasses.Viewer _ NIL; inputFocussedViewer: ViewerClasses.Viewer _ NIL; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- <<--redraw single features; logically inside RePaint>> ShowViewers: PROC [me: MyGraphicRef] = BEGIN OutlineViewer: PROC [me: MyGraphicRef, other: ViewerClasses.Viewer] = BEGIN otherMe: MyGraphicRef = NARROW[other.data]; r: CD.DesignRect = otherMe.deviceDrawRef.worldClip; p1: CD.Position = CDVPrivate.DesignToViewerPosition[me, [r.x1, r.y1]]; p2: CD.Position = CDVPrivate.DesignToViewerPosition[me, [r.x2, r.y2]]; CDVPrivate.InvertArea[me, p1.x, p1.y, p1.x+1, p2.y]; CDVPrivate.InvertArea[me, p1.x, p2.y, p2.x, p2.y+1]; CDVPrivate.InvertArea[me, p2.x, p2.y, p2.x+1, p1.y]; CDVPrivate.InvertArea[me, p2.x, p1.y, p1.x, p1.y+1]; END; FOR l: CDViewer.ViewerList _ CDViewer.ViewersOf[me.actualDesign], l.rest WHILE l#NIL DO IF ~l.first.iconic AND l.first#me.viewer THEN OutlineViewer[me: me, other: l.first]; ENDLOOP END; PaintSignalNames: PROC [me: MyGraphicRef, r: CD.DesignRect] = BEGIN DrawCommentForViewers: PROC [pos: CD.DesignPosition, text: Rope.ROPE, me: MyGraphicRef] = BEGIN tc: Graphics.Context ~ Graphics.CopyContext[me.viewerContext]; p: CD.Position ~ CDVPrivate.DesignToViewerPosition[me, pos]; Graphics.SetColor[tc, Graphics.black]; Graphics.SetCP[tc, p.x, p.y]; IF coordSys=top THEN Graphics.Scale[tc, 1, -1]; Graphics.DrawRope[tc, text]; END; design: CD.Design = me.actualDesign; r _ CDInline.Intersection[r, me.deviceDrawRef.worldClip]; FOR w: CD.ApplicationList _ design^.actual.first.specific.contents, w.rest WHILE w#NIL DO IF CDInline.Intersect[CDApplications.ARectO[w.first], r] THEN BEGIN x: REF _ CDProperties.GetPropFromApplication[from: w.first, prop: $SignalName]; IF x=NIL THEN x _ CDProperties.GetPropFromObject[from: w.first.ob, prop: $SignalName]; IF x#NIL THEN { IF me.deviceDrawRef.stopFlag^ THEN EXIT; IF ISTYPE[x, Rope.ROPE] THEN { signame: Rope.ROPE = NARROW[x]; DrawCommentForViewers[CDInline.BaseOfRect[CDApplications.ARectI[w.first]], signame, me] } ELSE IF ISTYPE[x, ATOM] THEN { a: ATOM = NARROW[x]; signame: Rope.ROPE = Atom.GetPName[a]; DrawCommentForViewers[CDInline.BaseOfRect[CDApplications.ARectI[w.first]], signame, me] } }; END ENDLOOP; END; <> <> <> <> <> <> <> <> <<>> ShowArrow: PUBLIC PROC [design: CD.Design, pos: CD.DesignPosition] = BEGIN DoIt: PROC [] = { FOR l: MyGraphicRef _ CDVPrivate.linkBase, l.link WHILE l#NIL DO IF design=l.actualDesign THEN { l.designRec.arowAt_pos; l.designRec.arrowOn_TRUE; RETURN } ENDLOOP }; <<>> <<--ShowArrow>> DoIt[]; CDDraw.InsertCommandAll[design, CDDraw.Comm[cmd: ref, erase: FALSE, rect: [pos.x, pos.y, 0, 0], ref: $PutArrow]] END; RemoveArrow: PUBLIC PROC[design: CD.Design] = BEGIN FOR l: MyGraphicRef _ CDVPrivate.linkBase, l.link WHILE l#NIL DO IF design=l.actualDesign THEN { r: CD.Rect ~ l.arrowRect; l.designRec.arrowOn_FALSE; IF l.arrowIsOn THEN { l.arrowIsOn _ FALSE; CDDraw.InsertCommand[l.ct, CDDraw.Comm[cmd: rect, erase: TRUE, rect: r, ref: NIL]] } } ENDLOOP END; RePaint: ViewerClasses.PaintProc = <<--PROC [self: Viewer, context: Graphics.Context, whatChanged: REF ANY, clear: BOOL]-->> <<--depending on whatChanged, the call must be monitored or need not>> BEGIN me: MyGraphicRef = NARROW[self.data]; TrackRefTrack: ENTRY PROC [me: MyGraphicRef, tr: TrackRef] = -- INLINE -- <<--must be called within monitor lock;>> <<--called through Notify only, uses monitorlock from there>> 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.currentLevel _ CDTechnology.CurrentLevel[me.actualDesign]; me.defaultWidthVC _ me.designRec.widthLC _ CDTechnology.LevelWidth[me.actualDesign, me.designRec.currentLevel]; me.onVC _ TRUE; }; <<--now me.onVC is true>> me.usedCursor _ me.designRec.outlineProcLC; me.stopVC _ tr.pos; me.usedCursor[me]; }; END; MonitoringRemoveTrack: ENTRY PROC[me: MyGraphicRef] = BEGIN ENABLE UNWIND => NULL; IF me.onVC THEN { me.usedCursor[me]; me.onVC _ FALSE; }; END; InternalRemoveTrack: PROC[me: MyGraphicRef] = <<--must be called within monitor lock;>> <<--called throgh Notify and ProtectedRepaint only >> BEGIN 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; ConsiderRemoveTrack: INTERNAL PROC[me: MyGraphicRef] = -- INLINE -- <<--call this if viewer gets cleared>> BEGIN me.onVC _ FALSE; END; SetOffset: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = <<--sets me.noff such viewer origin is simultaneus a grid point;>> <<--remove this procedure when gridding is done better>> BEGIN IF me.ngrid<1 THEN ERROR; me.noff.x _ pos.x/me.ngrid*me.ngrid; me.noff.y _ pos.y/me.ngrid*me.ngrid END; <<--SetUpAndRedraw>> comm: CDDraw.Comm; SetOffset[me, me.noff]; -- adjust gridding; replace later by better algorithm ConsiderRemoveTrack[me]; me.deviceDrawRef _ CDVPrivate.CreateDrawInformation[me]; me.saveList _ NIL; CDDraw.ModifyCommandTable[me.actualDesign, me.ct, me.deviceDrawRef.worldClip]; comm.cmd _ all; comm.erase _ TRUE; -- to allow also black backgrounds set freely by colormap comm.rect _ me.deviceDrawRef.worldClip; CDDraw.InsertCommand[me.ct, comm]; END; PaintTemporaries: --ENTRY-- PROC [me: MyGraphicRef] = <<--eg. former paints ticks>> <<--called through ProtectedRepaint only>> BEGIN END; <<--RePaint>> IF self.destroyed THEN RETURN; me.viewerContext _ context; WITH whatChanged SELECT FROM tr: TrackRef => {TrackRefTrack[me, tr]}; -- monitored by Notify atom: ATOM => IF atom=$MonitoringRemoveTrack THEN MonitoringRemoveTrack[me] ELSE IF atom=$InternalRemoveTrack THEN InternalRemoveTrack[me] -- monitored by Notify and ProtectedRepaint ELSE IF atom=$BackGround THEN { CDVPrivate.RepaintBackground[me, CDInline.universe, FALSE];-- monitored by ProtectedRepaint } ELSE IF atom=$Temporaries THEN { -- monitored by ProtectedRepaint PaintTemporaries[me]; } ELSE IF atom=$ShowViewers THEN { -- monitored by ProtectedRepaint ShowViewers[me]; } ELSE IF atom=$SignalNames THEN { -- monitored by ProtectedRepaint PaintSignalNames[me, CDInline.universe]; } ELSE IF atom=$DrawSignalNames THEN { -- called from anywhere, not monitored CDDraw.InsertCommandAll[me.actualDesign, CDDraw.Comm[cmd: ref, erase: FALSE, rect: CDInline.universe, ref: $SignalNames]]; } ELSE ERROR; area: RepaintRectAreaRef => { -- monitored by ProtectedRepaint CDVPrivate.RepaintRectAreaInViewer[me, area.rect, area.erase]; }; arrow: ArrowRef => { -- monitored by ProtectedRepaint UnGridedScaleViewerToDesign: PROC [me: MyGraphicRef, v: LONG CARDINAL] RETURNS [CD.DesignNumber] = <<--without necessary translation, without gridding, rounded up>> INLINE {RETURN [LOOPHOLE[(v*me.sA+me.sE-1)/me.sE, CD.DesignNumber]]}; arrowSize: CD.DesignNumber ~ MAX[UnGridedScaleViewerToDesign[me, 20], 1]; IF me.arrowIsOn AND me.arrowRect.x1=arrow.apos.x AND me.arrowRect.y1=arrow.apos.y THEN RETURN; IF me.arrowIsOn THEN { me.arrowIsOn_FALSE; CDVPrivate.RepaintRectAreaInViewer[me, me.arrowRect, TRUE]; }; me.arrowRect _ [arrow.apos.x, arrow.apos.y, arrow.apos.x+arrowSize, arrow.apos.y+arrowSize]; me.arrowIsOn _ TRUE; CDVPrivate.RepaintRectAreaInViewer[me, me.arrowRect, FALSE]; }; ENDCASE => IF whatChanged=NIL THEN SetUpAndRedraw [me] -- called from anywhere, not monitored ELSE ERROR; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- EnableCursoring: ENTRY PROC[me: MyGraphicRef] = <<--this procedure is logically local to ProtectedRepaint;>> <<--but it must be callable in catch phrase >> BEGIN me.cursorInhibitations _ me.cursorInhibitations-1; BROADCAST tryToPaint END; ProtectedRepaint: PROC[me: MyGraphicRef, clear: BOOL, whatChanged: REF ANY] = BEGIN ENABLE RuntimeError.UNCAUGHT => { EnableCursoring[me]; IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO SomeError ELSE REJECT }; DisableCursoring: ENTRY PROC[me: MyGraphicRef] = BEGIN ENABLE { UNWIND => NULL; RuntimeError.UNCAUGHT => { IF me.cursorInhibitations>0 THEN me.cursorInhibitations _ me.cursorInhibitations-1; BROADCAST tryToPaint; IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO SomeError ELSE REJECT; }; }; me.cursorInhibitations _ me.cursorInhibitations+1; WHILE me.cursorInhibitations>1 DO me.cursorInhibitations _ me.cursorInhibitations-1; WAIT tryToPaint; me.cursorInhibitations _ me.cursorInhibitations+1; ENDLOOP; IF me.onVC THEN ViewerOps.PaintViewer[me.viewer, client, FALSE, $InternalRemoveTrack]; EXITS SomeError => NULL; END; <<--ProtectedRepaint>> DisableCursoring[me]; ViewerOps.PaintViewer[me.viewer, client, clear, whatChanged]; EnableCursoring[me]; EXITS SomeError => NULL; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- ViewerProcess: PROC[me: MyGraphicRef] = BEGIN comm: CDDraw.Comm; bBTableSpace1, bBTableSpace2: PrincOps.BBTableSpace; <<--me.xBLT is a short pointer! (hardware) therefore must be local to some>> <<--procedure space.>> TRUSTED {me.xBLT _ PrincOpsUtils.AlignedBBTable[@bBTableSpace1]}; TRUSTED {me.bBLT _ PrincOpsUtils.AlignedBBTable[@bBTableSpace2]}; IF me.running THEN ERROR; me.running _ TRUE; DO comm _ CDDraw.FetchCommand[me.ct]; SELECT comm.cmd FROM none => Process.Yield[]; rect => { paintArea: RepaintRectAreaRef _ NEW[RepaintRectArea_[comm.rect, comm.erase]]; IF me.hurryUp THEN TRUSTED {Process.SetPriority[Process.priorityNormal]}; ProtectedRepaint[me, FALSE, paintArea]; }; all => { paintArea: RepaintRectAreaRef _ NEW[RepaintRectArea_[comm.rect, TRUE]]; IF me.hurryUp THEN TRUSTED {Process.SetPriority[Process.priorityNormal]}; ProtectedRepaint[me, FALSE, paintArea]; }; ref => SELECT comm.ref FROM $BackGround => ProtectedRepaint[me, FALSE, $BackGround]; $PutArrow => { ap: ArrowRef _ NEW[ArrowRecord_[apos: [comm.rect.x1, comm.rect.y1]]]; ProtectedRepaint[me, FALSE, ap]; }; $SignalNames => ProtectedRepaint[me, FALSE, $SignalNames]; $ShowViewers => ProtectedRepaint[me, FALSE, $ShowViewers]; ENDCASE => ERROR; alldone => { ProtectedRepaint[me, FALSE, $Temporaries]; me.hurryUp _ FALSE; TRUSTED {Process.SetPriority[Process.priorityBackground]}; }; disapearforever => EXIT; ENDCASE => ERROR; ENDLOOP; me.running _ FALSE; me.ct _ NIL; me.actualDesign _ NIL; me.designRec _ NIL; TerminalIO.WriteRope["Viewer destroyed\n"]; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- MonitoringRemoveCursor: PROC [me: MyGraphicRef] = <<--removes visible cursor, if there is>> <<--monitores inside viewerpaintproc >> -- INLINE -- BEGIN ViewerOps.PaintViewer[me.viewer, client, FALSE, $MonitoringRemoveTrack]; END; InternalRemoveCursor: PROC [me: MyGraphicRef] = <<--removes visible cursor, if there is>> <<--logically local to (Modify and Notify)>> <<--assumes monitored correctly, is INTERNAL>> -- INLINE -- BEGIN ViewerOps.PaintViewer[me.viewer, client, FALSE, $InternalRemoveTrack]; END; <> <<-- not an ENTRY because logically called from inside NotifyProc>> <<-- (and I hope, with its monitorlock still set and very sequentially>> <<-- [hope wrong => program wrong!])>> <<-- therefore: keep track with cursoredViewer, and check it.>> <> < NULL;>> <> < {>> <> <> <<};>> < {>> <> <> <> <<};>> < NULL;>> <> <> <> <<};>> <> Modify: ViewerClasses.ModifyProc -- PROC [self: Viewer, change: ModifyAction] -- = BEGIN ENABLE UNWIND => NULL; SELECT change FROM set, pop => { inputFocussedViewer _ self; }; kill, push => { inputFocussedViewer_NIL; }; ENDCASE => NULL; IF cursoredViewer=inputFocussedViewer THEN myCursor _ myCursorOK ELSE myCursor _ myCursorNoFocus; IF ~terminalLock THEN viewerClassRec.cursor _ myCursor; END; Notify: ViewerClasses.NotifyProc -- PROC [self: Viewer, input: LIST OF REF ANY] -- = <<--ENTRY may be ommitted since sequential already be viewer package ???>> BEGIN ENABLE { UNWIND => NULL; <<--sorry; this really happens because: some data is set up by the first call>> <<--of the viewerpaint procedure; but sometime the Notify procedure is called first>> <<--we will not bother every call of Notify to check for that.>> RuntimeError.UNCAUGHT => IF CDVPrivate.catchAnyWhichDeadlock THEN GOTO AnyErrorHappened ELSE REJECT; }; me: MyGraphicRef = NARROW[self.data]; mouse: CD.Position; 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] = <<--makes cursor logically unavailable>> BEGIN me.designRec.stopLC _ pos; me.designRec.startLCValid _ FALSE; END; CursorSwitch: PROC [me: MyGraphicRef] = <<--makes cursor changing dirction of L bend>> BEGIN me.firstHorizontalVC _ me.designRec.firstHLC _ NOT me.designRec.firstHLC END; CheatLogicalStartTo: PROC [me: MyGraphicRef, pos: CD.DesignPosition] = <<--makes cursor logically changing position>> BEGIN me.designRec.startLCValid _ FALSE; LogicalTrack[me, pos]; END; Track: PROC [me: MyGraphicRef] = -- INLINE -- <<--uses intermediate level 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 = CDVPrivate.ViewerToDesignPosition[me, mouse]; LogicalTrack[me, pos]; IF me.cursorInhibitations#0 THEN RETURN; VisibleTrack[me, pos] END; StopTrack: PROC [me: MyGraphicRef] = -- XXXX -- INLINE -- <<--uses intermediate level variable mouse>> BEGIN pos: CD.DesignPosition = CDVPrivate.ViewerToDesignPosition[me, mouse]; LogicalTrackOff[me, pos]; MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cShadow]; END; AngleTrack: PROC [me: MyGraphicRef] = BEGIN newStartPosition: CD.DesignPosition; comm: CDSequencer.Command ~ NEW[CDSequencer.CommandRec]; StopTrack[me]; comm^ _ CDSequencer.CommandRec[ design: me.actualDesign, a: $ContinueWire, pos: me.designRec.stopLC, sPos: me.designRec.startLC, l: me.designRec.currentLevel, n: me.defaultWidthVC, b: me.designRec.firstHLC ]; newStartPosition _ IF me.designRec.firstHLC THEN [me.designRec.stopLC.x, me.designRec.startLC.y] ELSE [me.designRec.startLC.x, me.designRec.stopLC.y]; CDSequencer.ExecuteCommand[design: me.actualDesign, comm: comm]; CheatLogicalStartTo[me, newStartPosition]; CursorSwitch[me]; END; StopDrawing: PROC[me: MyGraphicRef] = BEGIN CDDraw.FlushCommands[me.ct] END; <<--Notify>> IF me.deviceDrawRef=NIL THEN { <<--silly cedar viewer system allows calls of notify before>> <<--the first call to the paintprocedure happened;>> <<--but for here, some initializations happen in paintprocedure only>> RETURN; -- silly system calls notify before first paint }; IF self#cursoredViewer THEN BEGIN tem: ViewerClasses.Viewer = cursoredViewer; IF tem#NIL AND tem.data#NIL THEN { temMe: MyGraphicRef = NARROW[tem.data]; MonitoringRemoveCursor[temMe]; }; cursoredViewer _ self; SetXMode[me, me.designRec.xMode]; IF self=inputFocussedViewer THEN myCursor _ myCursorOK ELSE myCursor _ myCursorNoFocus; IF ~terminalLock THEN viewerClassRec.cursor _ myCursor; END; FOR input _ input, input.rest WHILE input # NIL DO WITH input.first SELECT FROM coords: TIPUser.TIPScreenCoords => { mouse.x _ coords.mouseX; mouse.y _ coords.mouseY }; atom: ATOM => IF atom=$Track THEN Track[me] ELSE BEGIN me.hurryUp _ TRUE; IF terminalLock THEN { IF atom#$Track AND atom#$StopTrack THEN ViewerOps.BlinkIcon[self]; RETURN }; InputFocus.SetInputFocus[self: self]; SELECT atom FROM $StopTrack => {StopTrack[me]}; $SwitchTrack => { MonitoringRemoveCursor[me]; CursorSwitch[me] }; $AngleTrack => {AngleTrack[me]}; $UseBoxTrack => { MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cBox]; }; $UseLTrack => { MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cLBox]; }; $UseArrowTrack => { MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cArrow]; }; $UsePosTrack => { MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cPos]; }; $UseDontTrack => { MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cDont]; }; $UseShadowTrack => { MonitoringRemoveCursor[me]; CDVPrivate.SetCursorMode[me, cShadow]; }; $SetXModeOn => SetXMode[me, TRUE]; $SetXModeOff => SetXMode[me, FALSE]; $WiringOn => SetXMode[me, TRUE]; $WiringOff => SetXMode[me, FALSE]; $SetStartOnMark => {CheatLogicalStartTo[me, me.designRec.mark]}; $SetMarkOnStart => {me.designRec.mark _ me.designRec.startLC}; $SetMarkOnStop => {me.designRec.mark _ me.designRec.stopLC}; $ShowMark => { --does NO StopTrack comm: CDSequencer.Command _ NEW[CDSequencer.CommandRec]; comm^ _ CDSequencer.CommandRec[ design: me.actualDesign, a: $ShowMark, pos: me.designRec.mark, sPos: me.designRec.mark, l: me.designRec.currentLevel, ref: me, n: me.defaultWidthVC, b: me.designRec.firstHLC ]; CDSequencer.ExecuteCommand[design: me.actualDesign, comm: comm] }; $StopDrawing => StopDrawing[me]; ENDCASE => { comm: CDSequencer.Command _ NEW[CDSequencer.CommandRec]; StopTrack[me]; comm^ _ CDSequencer.CommandRec[ design: me.actualDesign, a: atom, pos: me.designRec.stopLC, sPos: me.designRec.startLC, l: me.designRec.currentLevel, ref: me, n: me.defaultWidthVC, b: me.designRec.firstHLC ]; CDSequencer.ExecuteCommand[design: me.actualDesign, comm: comm]; }; END; ENDCASE; ENDLOOP; EXITS AnyErrorHappened => NULL; END; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> IsTheCursor: PROC [mode: CDVPrivate.CursorMode] RETURNS [yes: BOOL_FALSE] = -- INLINE -- BEGIN ENABLE RuntimeError.UNCAUGHT => {--must have not yet been initialized-- GOTO deny}; IF cursoredViewer#NIL THEN RETURN [NARROW[cursoredViewer.data, MyGraphicRef].designRec.modeLC=mode]; EXITS deny => RETURN [FALSE] END; IsLBox: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cLBox]]}; IsBox: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cBox]]}; IsArrow: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cArrow]]}; IsPos: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cPos]]}; IsDont: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cDont]]}; IsShadow: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cShadow]]}; IsOther: PROC RETURNS [BOOL] = {RETURN [IsTheCursor[cOther]]}; IsXMode: PROC RETURNS [xMode: BOOL] = {xMode _ gXMode}; IsNotXMode: PROC RETURNS [notXMode: BOOL] = {notXMode _ ~ gXMode}; SetXMode: PROC [me: MyGraphicRef, xMode: BOOL] = BEGIN gXMode _ me.designRec.xMode _ xMode END; gXMode: BOOL _ FALSE; <<-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -->> TechnologyName: PROC [t: CD.Technology] RETURNS [Rope.ROPE] = {RETURN [IF t.name#NIL THEN t.name ELSE Atom.GetPName[t.key]]}; CaptionText: PROC [design: CD.Design] RETURNS [Rope.ROPE] = BEGIN 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 AND me.suppressOutsidePushedCell) THEN CDDraw.InsertCommand[me.ct, CDDraw.Comm[cmd: all, erase: TRUE, rect: CDInline.universe, ref: NIL]] ELSE IF (event=$AfterPush AND ~me.suppressOutsidePushedCell) THEN CDDraw.InsertCommand[me.ct, CDDraw.Comm[cmd: ref, erase: FALSE, rect: CDInline.universe, ref: $BackGround]] ENDLOOP; END; IconForDesign: PROC [design: CD.Design] RETURNS [Icons.IconFlavor] = BEGIN x: REF = CDValue.Fetch[boundTo: design, key: $Icon, propagation: global]; WITH x SELECT FROM ip: REF Icons.IconFlavor => RETURN [ip^]; ENDCASE => RETURN [Icons.IconFlavor[unInit]] 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; <<--construct the Graphic Area>> me.viewer _ ViewerOps.CreateViewer[ flavor: viewerClassAtom, info: [ name: CaptionText[design], scrollable: FALSE, icon: IconForDesign[design], iconic: UserProfile.Boolean["Chipndale.NewViewerIconic", FALSE], border: TRUE, tipTable: CDTechnology.GetTipTable[design.technology], -- XXX whats about errors? data: me ] ]; IF CDInline.NonEmpty[b] THEN CDViewer.ShowAndScale[me.viewer, b]; RETURN [me.viewer] 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 [event: REF, design: CD.Design, x: REF] RETURNS [dont: BOOL_FALSE]>> BEGIN me: MyGraphicRef ~ NARROW[viewer.data]; IF event#close THEN ERROR; CDDraw.ModifyCommandTable[me.actualDesign, me.ct, CDInline.empty]; END; NoteProfileChange: UserProfile.ProfileChangedProc = <<-- PROC [reason: ProfileChangeReason]>> BEGIN myCursorOK _ IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE textPointer; myCursorNoFocus _ IF UserProfile.Boolean["Chipndale.NoCursor", FALSE] THEN blank ELSE myCursorNoFocus; END; -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- <<--Define viewerclass and command>> viewerClassRec: ViewerClasses.ViewerClass; Init: PROC [] = BEGIN chipndaleIcon: REF Icons.IconFlavor ~ NEW[Icons.IconFlavor_tool]; TerminalIO.AddLock[TerminalLock, TerminalFree]; viewerClassRec _ NEW[ViewerClasses.ViewerClassRec _ [ paint: RePaint, notify: Notify, modify: Modify, destroy: Destroy, coordSys: coordSys, cursor: myCursorNoFocus ]]; CDValue.EnregisterKey[key: $Icon]; chipndaleIcon^ _ Icons.NewIconFromFile["Chipndale.icons", 0 ! RuntimeError.UNCAUGHT => {CONTINUE}]; CDValue.Store[boundTo: NIL, key: $Icon, value: chipndaleIcon]; ViewerOps.RegisterViewerClass[viewerClassAtom, viewerClassRec]; [] _ ViewerEvents.RegisterEventProc[proc: CallOnClose, event: close, filter: viewerClassAtom, before: FALSE]; <<-- x-mode>> --XXX-- TIPUser.RegisterTIPPredicate[key: $ChipndaleWMode, p: IsXMode]; --XXX-- TIPUser.RegisterTIPPredicate[key: $ChipndaleNWMode, p: IsNotXMode]; TIPUser.RegisterTIPPredicate[key: $ChipndaleXMode, p: IsXMode]; TIPUser.RegisterTIPPredicate[key: $ChipndaleNXMode, p: IsNotXMode]; <<--cursormodes>> TIPUser.RegisterTIPPredicate[key: $ChipndaleLBoxCursor, p: IsLBox]; TIPUser.RegisterTIPPredicate[key: $ChipndaleBoxCursor, p: IsBox]; TIPUser.RegisterTIPPredicate[key: $ChipndaleArrowCursor, p: IsArrow]; TIPUser.RegisterTIPPredicate[key: $ChipndalePosCursor, p: IsPos]; TIPUser.RegisterTIPPredicate[key: $ChipndaleDontCursor, p: IsDont]; TIPUser.RegisterTIPPredicate[key: $ChipndaleShadowCursor, p: IsShadow]; TIPUser.RegisterTIPPredicate[key: $ChipndaleOtherCursor, p: IsOther]; TerminalIO.WriteRope["\nChipndale Version 17 for Cedar 5.2; July 28, 1984 3:47:31 pm PDT\n\n"]; <> CDEvents.RegisterEventProc[$ResetDesign, RepaintCaptions]; CDEvents.RegisterEventProc[$RenameDesign, RepaintCaptions]; CDEvents.RegisterEventProc[$AfterPush, RepaintCaptions]; CDEvents.RegisterEventProc[$AfterPop, RepaintCaptions]; UserProfile.CallWhenProfileChanges[NoteProfileChange]; END; Init[]; END. -- remarks to the tip table ChipndaleXMode and ChipndaleNXMode must NOT be querried before the focus is set, because their handling assumes a current design