CDVMain.mesa (part of ChipNDale)
Copyright © 1983, 1985 by Xerox Corporation. All rights reserved.
Ch. Jacobi, June 24, 1983 3:33 pm
last edited by Christian Jacobi, April 11, 1985 3:35:39 pm PST
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�Sequencer.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.