<> <> <> <> DIRECTORY CD, CDInstances, CDCallSpecific, CDOps, CDProperties; CDCallSpecificImpl: CEDAR PROGRAM IMPORTS CDInstances, CDOps, CDProperties 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 = CDProperties.GetProp[inst.ob.class.properties, 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_0] = 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_count+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_design^.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 proc and calls it,>> <<--if there is no objectSpecific proc, 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: CD.ObjectClass, proc: CallProc] = BEGIN callProcRef: REF CallProc = NEW[CallProc_proc]; CDProperties.PutProp[objectType, key, callProcRef]; END; END.