<> <> <> <> DIRECTORY Atom, CD, CDPrivate, CDApplications, CDDirectory, CDEvents, CDInline, CDOrient, Graphics, Process, RefTab, Rope USING [Cat, IsEmpty, ROPE], SafeStorage, TerminalIO; CDImpl: CEDAR MONITOR IMPORTS Atom, CDApplications, CDDirectory, CDEvents, CDInline, CDOrient, Graphics, Process, RefTab, Rope, SafeStorage, TerminalIO EXPORTS CD, CDPrivate SHARES CD, CDPrivate = BEGIN Error: PUBLIC ERROR[ec: CD.ErrorCode _ programmingError, explanation: Rope.ROPE _ NIL] = CODE; DebugCall: PUBLIC SIGNAL[what: REF] = CODE; permanent: ZONE ~ SafeStorage.GetPermanentZone[]; <<--assume everithing gets correct even if all references are lost, >> <<--don't care about memory area, hint only>> levels: PUBLIC REF ARRAY CD.Level OF CDPrivate.LevelRef ~ permanent.NEW[ARRAY CD.Level OF CDPrivate.LevelRef]; registerTechEvent: CDEvents.EventRegistration ~ CDEvents.RegisterEventType[$RegisterTechnology]; technologyRegistration: RefTab.Ref ~ RefTab.Create[]; -- contains technologies TechnologyPrivate: TYPE = REF TechnologyPrivateRep; TechnologyPrivateRep: PUBLIC TYPE = RECORD [ objectRegisterTab: RefTab.Ref, -- contains object types levelKeyTab: RefTab.Ref -- contains Levels ]; nilTechnologyPrivate: TechnologyPrivate = NEW[TechnologyPrivateRep_[ objectRegisterTab: RefTab.Create[], --for technology dependant objects it contains NIL levelKeyTab: RefTab.Create[] ]]; RegisterObjectType: PUBLIC PROC [objectType: ATOM, technology: CD.Technology_NIL] RETURNS [REF CD.ObjectProcs] = <<--also initializes procedures with default values >> BEGIN done: BOOL; p: REF CD.ObjectProcs ~ permanent.NEW[CD.ObjectProcs]; p.technology _ technology; p.objectType _ objectType; p.further _ RefTab.Create[]; p.drawMe _ DefaultDrawMe; p.quickDrawMe _ DefaultQuickDrawMe; p.showMeSelected _ OutlineObjectProc; p.hitInside _ DefaultHitInside; p.insideRect _ DefaultRectProc; p.hasChildren _ FALSE; p.wireTyped _ FALSE; p.match _ NIL; p.describe _ DefaultDescribe; IF technology=NIL THEN done _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, p] ELSE { techPriv: TechnologyPrivate = technology.technologyPrivate; objectRegisterTab: RefTab.Ref = techPriv.objectRegisterTab; globFound: BOOL; x: REF; [globFound, x] _ RefTab.Fetch[nilTechnologyPrivate.objectRegisterTab, objectType]; <<--still check if it might be global>> IF globFound AND x#NIL THEN done _ FALSE ELSE { [] _ RefTab.Insert[nilTechnologyPrivate.objectRegisterTab, objectType, NIL]; <<--global register it used per technology>> done _ RefTab.Insert[objectRegisterTab, objectType, p]; -- technology register } }; IF NOT done THEN RETURN [NIL]; RETURN [p] END; FetchObjectProcs: PUBLIC PROC [objectType: REF, technology: CD.Technology_NIL] RETURNS [REF CD.ObjectProcs] = BEGIN x: REF; p: REF CD.ObjectProcs_NIL; found: BOOL_FALSE; IF technology#NIL THEN { -- search in technology table techPriv: TechnologyPrivate = technology.technologyPrivate; [found, x] _ RefTab.Fetch[techPriv.objectRegisterTab, objectType]; }; IF NOT found THEN { -- search in global table [found, x] _ RefTab.Fetch[nilTechnologyPrivate.objectRegisterTab, objectType]; <<--may find it but have NIL value: then is technologydependant>> }; <<--sorry XXXX IF found THEN p _ NARROW[x];>> IF found THEN TRUSTED {p _ LOOPHOLE[x]}; RETURN [p] END; DefaultDrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN IF aptr.ob.p.quickDrawMe#DefaultQuickDrawMe THEN aptr.ob.p.quickDrawMe[aptr, pos, orient, pr] ELSE pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], CD.highLightShade, pr] END; DefaultDrawChild: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN aptr.ob.p.drawMe[aptr, pos, orient, pr] END; DefaultQuickDrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN IF aptr.ob.p.drawMe#DefaultDrawMe THEN aptr.ob.p.drawMe[aptr, pos, orient, pr] ELSE pr.drawRect[CDOrient.RectAt[pos, aptr.ob.size, orient], CD.highLightShade, pr] END; OutlineObjectProc: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN pr.outLineProc[CDOrient.RectAt[pos, aptr.ob.size, orient], pr] END; DefaultHitInside: PROC [aptr: CD.ApplicationPtr, hitRect: CD.DesignRect] RETURNS [BOOL] = BEGIN RETURN [CDInline.Intersect[CDApplications.ARectO[aptr], hitRect]] END; DefaultRectProc: PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] = {RETURN [CDInline.RectAt[[0, 0], ob.size]]}; DefaultDescribe: PROC [me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN IF me.p.hasChildren THEN { n: Rope.ROPE = CDDirectory.Name[me]; IF ~Rope.IsEmpty[n] THEN RETURN [Rope.Cat[Atom.GetPName[me.p.objectType], " ", n]] }; RETURN [Atom.GetPName[me.p.objectType]] END; lastLevel: CD.Level _ 3; InitiateLevel: PROC [lev: CD.Level, technology: CD.Technology_NIL, uniqueKey: ATOM] = BEGIN levRef: REF CD.Level ~ permanent.NEW[CD.Level_lev]; techPriv: TechnologyPrivate; levels[lev] _ permanent.NEW[CDPrivate.LevelRec]; levels[lev].technology _ technology; levels[lev].uniqueKey _ uniqueKey; IF technology=NIL THEN techPriv _ nilTechnologyPrivate ELSE { techPriv _ technology.technologyPrivate; technology.usedLevels _ CONS[lev, technology.usedLevels] }; [] _ RefTab.Insert[techPriv.levelKeyTab, uniqueKey, levRef]; END; NewLevel: PUBLIC ENTRY PROC [technology: CD.Technology_NIL, uniqueKey: ATOM] RETURNS [CD.Level] = BEGIN ENABLE UNWIND => NULL; IF uniqueKey=NIL OR uniqueKey=$NIL THEN RETURN WITH ERROR Error[callingError, "bad uniqueKey"]; -- avoid problems with NIL as ATOM; any IO routine might use $NIL instead IF lastLevel>=CD.levelNumber-1 THEN RETURN WITH ERROR Error[noResource, "too many levels have been requested; (probaly too many different technologies are used)"]; lastLevel _ lastLevel+1; InitiateLevel[lastLevel, technology, uniqueKey]; RETURN [lastLevel] END; <> <<--calls proc which may use context;>> <<--on recursive calls the context may or may not include previous transformations>> <> <> <> <> DrawToContext: PUBLIC PROC[pr: CD.DrawRef, proc: CD.ContextDraw, level: CD.Level] = <<--calls proc which may use context; mode and color are set to level's need>> <<--call is suppressed if level does not need drawing; this is default.>> <<--on recursive calls, the context may or may not include previous transformations>> BEGIN IF pr.deviceContext#NIL AND pr.contextFilter#NIL AND pr.contextFilter[level].doit THEN { mark: Graphics.Mark ~ Graphics.Save[pr.deviceContext]; [] _ Graphics.SetPaintMode[pr.deviceContext, pr.contextFilter[level].paintMode]; Graphics.SetColor[pr.deviceContext, pr.contextFilter[level].color]; proc[pr.deviceContext ! UNWIND => {Graphics.Restore[pr.deviceContext, mark]; GOTO return}]; Graphics.Restore[pr.deviceContext, mark] } EXITS return => NULL; END; FetchLevel: PUBLIC PROC [t: CD.Technology, uniqueKey: ATOM] RETURNS [CD.Level] = BEGIN found: BOOL_FALSE; l: CD.Level _ CD.combined; x: REF; IF t#NIL THEN { techPriv: TechnologyPrivate = t.technologyPrivate; [found: found, val: x] _ RefTab.Fetch[techPriv.levelKeyTab, uniqueKey]; }; IF ~found THEN { [found: found, val: x] _ RefTab.Fetch[nilTechnologyPrivate.levelKeyTab, uniqueKey]; }; IF found THEN l _ NARROW[x, REF CD.Level]^; RETURN [l] END; LevelTechnology: PUBLIC PROC [l: CD.Level] RETURNS [CD.Technology] = BEGIN IF levels[l]=NIL THEN RETURN [NIL]; RETURN [levels[l].technology]; END; LevelKey: PUBLIC PROC [l: CD.Level] RETURNS [ATOM] = BEGIN IF levels[l]=NIL THEN RETURN [$NIL]; RETURN [levels[l].uniqueKey]; END; NewNullDeviceDrawRef: PUBLIC PROC [design: CD.Design, deviceContext: Graphics.Context] RETURNS [CD.DrawRef] = BEGIN p: CD.DrawRef ~ NEW[CD.DrawInformation]; p.worldClip _ CDInline.universe; p.minimalSize _ 0; p.scaleHint _ 0.0; p.drawRect _ DrawRectWithGraphics; p.drawChild _ DefaultDrawChild; p.outLineProc _ EmptyOutLineProc; p.saveRect _ SaveByDraw; p.stopFlag _ NEW[BOOLEAN _ FALSE]; p.deviceContext _ deviceContext; p.devicePrivate _ NIL; p.design _ design; RETURN [p] END; EmptyOutLineProc: PROC[r: CD.Rect, pr: CD.DrawRef] = {}; SaveByDraw: PROC [r: CD.Rect, l: CD.Level, pr: CD.DrawRef] = {pr.drawRect[r, l, pr]}; DrawRectWithGraphics: PROC [r: CD.Rect, l: CD.Level, pr: CD.DrawRef] = BEGIN DrawRectInContext: PROC [context: Graphics.Context] = { context.DrawBox[Graphics.Box[xmin: r.x1, xmax: r.x2, ymin: r.y1, ymax: r.y2]]; }; DrawToContext[pr, DrawRectInContext, l] END; RegisterTechnology: PUBLIC PROC [key: ATOM, name: Rope.ROPE] RETURNS [CD.Technology] = <<--Returns NIL if key is already in use>> <<--This must be the only way to create data of type TechnologyRec>> <<--not ENTRY since RefTab.Insert does necessary monitoring and CDEvents.ProcessEvent>> <<--is dangerous>> BEGIN t: CD.Technology ~ permanent.NEW[CD.TechnologyRec]; IF ~RefTab.Insert[technologyRegistration, key, t] THEN RETURN[NIL]; t.key_key; t.name_name; t.usedLevels_NIL; t.technologyPrivate _ permanent.NEW[TechnologyPrivateRep_ [RefTab.Create[], RefTab.Create[]]]; [] _ CDEvents.ProcessEvent[ev: registerTechEvent, design: NIL, x: t]; RETURN[t] END; FetchTechnology: PUBLIC PROC [key: ATOM] RETURNS [CD.Technology] = <<--Returns NIL if key is not registered>> BEGIN x: REF; found: BOOL; tech: CD.Technology_NIL; [found: found, val: x] _ RefTab.Fetch[technologyRegistration, key]; IF found THEN tech _ NARROW[x]; RETURN[tech] END; <<-- -- -- -- -- -- -- -- -->> BreakProc: PROC [msg: Rope.ROPE, what: REF] = {SIGNAL DebugCall[what]}; Debug: PUBLIC PROC [msg: Rope.ROPE_NIL, what: REF_NIL, mayProceed: BOOL_TRUE] = BEGIN n: INT_0; IF msg=NIL THEN msg_"Unknown error"; IF mayProceed THEN { DO TerminalIO.WriteRope[msg]; TerminalIO.WriteRope["\nif you don't know what to do,\n"]; TerminalIO.WriteRope[" then mouse-click on proceed,\n"]; TerminalIO.WriteRope[" save your design onto a new file,\n"]; TerminalIO.WriteRope[" and restart chipndale\n"]; n _ TerminalIO.RequestSelection[ label: "Debug options", choice: LIST["proceed", "signal and proceed", "signal in main process"]]; SELECT n FROM 1 => {TerminalIO.WriteRope["proceed\n"]; EXIT}; 2 => {TRUSTED {Process.Detach[FORK BreakProc[msg, what]]}; EXIT}; 3 => {BreakProc[msg, what]; EXIT}; ENDCASE => TerminalIO.WriteRope["skipped\n"]; ENDLOOP; } ELSE { TerminalIO.WriteRope[msg]; ERROR DebugCall[what] }; END; <<>> <<-- -- -- -- -- -- -- -- -->> IF registerTechEvent=NIL THEN ERROR; InitiateLevel[CD.combined, NIL, $combined]; InitiateLevel[CD.highLightShade, NIL, $highLightShade]; InitiateLevel[CD.highLightError, NIL, $highLightError]; END.