CDCallSpecificImpl.mesa a ChipNDale module
Copyright © 1983, 1984 by Xerox Corporation. All rights reserved
by Ch. Jacobi September 20, 1983 12:35 pm
last edited Christian Jacobi June 11, 1985 10:10:52 am PDT
DIRECTORY
CD,
CDInstances,
CDCallSpecific,
CDObjectProcs,
CDOps;
CDCallSpecificImpl:
CEDAR
PROGRAM
IMPORTS CDInstances, CDObjectProcs, CDOps
EXPORTS CDCallSpecific =
BEGIN
CallProc:
TYPE =
PROC [design:
CD.Design, inst:
CD.Instance, x:
REF]
RETURNS [done: BOOL←TRUE, removeMe: BOOL←FALSE, include: CD.InstanceList←NIL,
repaintMe: BOOL←FALSE, repaintInclude: BOOL←FALSE];
--x: passed through
--done: if not done, this call will not be counted
--removeMe: inst is removed from the design
--include: this list is included into the design
--repaintMe: inst's rect is to be repainted
--repaintInclude: the rect of the included list is to be repainted
Call:
PROC [design:
CD.Design, inst:
CD.Instance, x:
REF,
objectSpecific: REF, whatElse: CallProc]
RETURNS [done:
BOOL←
FALSE, removeMe:
BOOL←
FALSE, include:
CD.InstanceList←
NIL,
repaintMe: BOOL←FALSE, repaintInclude: BOOL←FALSE] =
BEGIN
IF objectSpecific#
NIL
THEN
BEGIN
class: REF = CDObjectProcs.FetchFurther [inst.ob.class, objectSpecific];
IF class#
NIL
AND
ISTYPE[class,
REF CallProc]
THEN
BEGIN
[done: done,
removeMe: removeMe,
include: include,
repaintMe: repaintMe,
repaintInclude: repaintInclude] ← NARROW[class, REF CallProc]^[design, inst, x]
END;
END;
IF
NOT done
AND whatElse#
NIL
THEN
[done: done,
removeMe: removeMe,
include: include,
repaintMe: repaintMe,
repaintInclude: repaintInclude] ← whatElse[design, inst, x];
END;
Mode: TYPE = {all, selected, this};
CallForX:
PROC [design:
CD.Design,
objectSpecific: REF, whatElse: CallProc, x: REF, mode: Mode, inst: CD.Instance←NIL]
RETURNS [count: NAT𡤀] =
BEGIN
repaintList: LIST OF CD.Rect←NIL;
r: CD.Rect;
removeMe: BOOL←FALSE;
done: BOOL;
include: CD.InstanceList←NIL;
incall: CD.InstanceList←NIL;
removeList: CD.InstanceList←NIL;
repaintMe: BOOL←FALSE;
repaintInclude: BOOL←FALSE;
DoIt:
PROC [a:
CD.Instance] =
BEGIN
r ← CDInstances.InstRectO[a]; -- save size
[done, removeMe, include, repaintMe, repaintInclude] ←
Call[design, a, x, objectSpecific, whatElse];
IF done THEN count𡤌ount+1;
IF removeMe THEN removeList ← CONS[a, removeList];
IF repaintMe
THEN
BEGIN -- may have changed size
repaintList ← CONS[r, repaintList];
IF ~removeMe
THEN
repaintList ← CONS[CDInstances.InstRectO[a], repaintList]
END;
IF include#
NIL
THEN
DO
inst: CD.Instance;
IF include=NIL THEN EXIT;
inst ← include.first;
include ← include.rest;
incall ← CONS[inst, incall];
IF repaintInclude
THEN
repaintList ← CONS[CDInstances.InstRectO[inst], repaintList];
ENDLOOP;
END;
IF mode = this
THEN {
IF inst#NIL THEN DoIt[inst];
}
ELSE
FOR l:
CD.InstanceList�sign^.actual.first.specific.contents, l.rest
WHILE l#
NIL
DO
SELECT mode
FROM
all => DoIt[l.first];
selected => IF l.first.selected THEN DoIt[l.first];
ENDCASE
ENDLOOP;
RemoveFrom[design, removeList];
design^.actual.first.specific.contents ←
CDInstances.AppendToList[incall, design^.actual.first.specific.contents];
RepaintList[design, repaintList]
END;
RepaintList:
PROC [design:
CD.Design, l:
LIST
OF
CD.Rect] =
BEGIN
--assumes all nice optimizations done inside RedrawRectArea
FOR rl:
LIST
OF
CD.Rect ← l, rl.rest
WHILE rl#
NIL
DO
CDOps.DelayedRedraw[design, rl.first];
ENDLOOP
END;
RemoveFrom:
PROC [design:
CD.Design, remove:
CD.InstanceList] =
--slow (n square)
--remove all aplications from design which are in remove
BEGIN
FOR ll:
CD.InstanceList ← remove, ll.rest
WHILE ll#
NIL
DO
CDOps.RemoveInstance[design, ll.first, FALSE];
ENDLOOP
END;
CallForThis:
PUBLIC
PROC [design:
CD.Design, inst:
CD.Instance,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, this, inst]
END;
CallForAll:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, all]
END;
CallForSelected:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
RETURN CallForX[design, objectSpecific, whatElse, x, selected]
END;
CallForOneSelected:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
first: CD.Instance;
multiple: BOOL;
[first, multiple] ← CDOps.SelectedInstance[design];
IF first#
NIL
THEN
RETURN CallForX[design, objectSpecific, whatElse, x, this, first]
ELSE RETURN [0]
END;
CallIfOneSelected:
PUBLIC
PROC [design:
CD.Design,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
first: CD.Instance;
multiple: BOOL;
[first, multiple] ← CDOps.SelectedInstance[design];
IF first#
NIL
AND ~multiple
THEN
RETURN CallForX[design, objectSpecific, whatElse, x, this, first]
ELSE RETURN [0]
END;
CallForPointed:
PUBLIC
PROC [design:
CD.Design, point:
CD.Position,
objectSpecific: REF←NIL, whatElse: CallProc←NIL, x: REF←NIL]
RETURNS [NAT] =
BEGIN
inst: CD.Instance = CDOps.PointedInstance[design, point];
IF inst#
NIL
THEN
RETURN CallForX[design, objectSpecific, whatElse, x, this, inst]
ELSE RETURN [0]
END;
--the Call.. procedures loop over all instances of the most pushed in cell, or what
--ever their name suggests and:
--first check if the object has a objectSpecific furtherProc and calls it,
--if there is no objectSpecific furtherProc, or it returns NOT done, it calls whatElse.
--objectSpecific=NIL means no search
--whatElse=NIL means nothing else to call.
--using removeMe is a slow method for deleting
--usually setting removeMe demands setting repaintMe to remove it from screen
Register:
PUBLIC
PROC [key:
REF, objectType:
REF
CD.ObjectClass, proc: CallProc] =
--registers proc to be called for an objectType, if key=objectSpecific
--key must have been registered with CDObjectProcs.RegisterFurther
--[internally uses CDObjectProcs.StoreFurther; this procedure is for conveniance only]
BEGIN
callProcRef: REF CallProc = NEW[CallProc←proc];
CDObjectProcs.StoreFurther[objectType, key, callProcRef]; -- errors are propagated
END;
END.