CDVMain.mesa (part of Chipndale)
Copyright © 1983 by Xerox Corporation. All rights reserved.
Ch. Jacobi June 24, 1983 3:33 pm
last edited by Christian Jacobi July 23, 1984 11:08:47 am PDT
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;
FillOut: PROC[me: MyGraphicRef, r: CD.DesignRect] =
BEGIN
p1, p2: CD.Position;
r ← CDInline.Intersection[r, me.deviceDrawRef.worldClip];
p1 ← CDVPrivate.DesignToViewerPosition[me, [r.x1, r.y1]];
p2 ← CDVPrivate.DesignToViewerPosition[me, [r.x2, r.y2]];
Graphics.DrawBox[me.viewerContext, Graphics.Box[p1.x, p1.y, p2.x, p2.y]];
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];
END;
--ProtectedRepaint
DisableCursoring[me];
ViewerOps.PaintViewer[me.viewer, client, clear, whatChanged];
EnableCursoring[me];
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;
Modify: ViewerClasses.ModifyProc -- PROC [self: Viewer, change: ModifyAction] -- =
-- 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.
BEGIN
ENABLE UNWIND => NULL;
SELECT change FROM
set, pop => {
IF cursoredViewer#NIL THEN ERROR;
cursoredViewer ← self;
};
kill, push => {
IF self#cursoredViewer THEN ERROR;
RemoveCursor[NARROW[self.data, MyGraphicRef]];
cursoredViewer←NIL;
};
ENDCASE => NULL;
IF cursoredViewer#NIL THEN {
me: MyGraphicRef = NARROW[cursoredViewer.data, MyGraphicRef];
SetXMode[me, me.designRec.xMode];
};
END;
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�LSE] =
-- 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"];
TerminalIO.WriteRope[copyright];
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