<> <> <> <> DIRECTORY AMBridge, AMTypes, CD, CDDraw, CDVFurtherPainters, CDVPrivate, RefTab, RuntimeError; CDVFurtherPaintersImpl: CEDAR PROGRAM IMPORTS AMBridge, AMTypes, RefTab, RuntimeError EXPORTS CDVFurtherPainters = BEGIN FurtherPaintProc: TYPE = CDVFurtherPainters.FurtherPaintProc; <<--PROC [me: CDVPrivate.MyGraphicRef, key: REF];>> valueTable: RefTab.Ref = RefTab.Create[mod: 13]; MyRec: TYPE = RECORD[type: AMTypes.Type, proc: FurtherPaintProc]; TypeList: TYPE = LIST OF REF MyRec; typeList: TypeList; InstallFurtherPaint: PUBLIC PROC[ keyReferentType: AMTypes.Type_AMTypes.nullType, --default means check value only keyValue: REF_NIL, --default means check type only; you can not install a proc for NIL proc: FurtherPaintProc ] = <<--All errors and signals from proc will be catched.>> <<--Sometimes calls proc with; sometimes without locks, depending on key.>> <<--It is ok to call the viewers-PaintProc recursively, but please>> <<--do not cause wedges, there is no protection.>> <<--Manual registration of key is requested.>> <<--May or may not check if keyValue is of type keyType, if both non NIL>> BEGIN IF proc=NIL THEN ERROR ELSE { IF keyValue#NIL THEN [] _ RefTab.Store[valueTable, keyValue, NEW[FurtherPaintProc_proc]] ELSE IF keyReferentType=CODE[CDDraw.Comm] OR keyReferentType=AMTypes.nullType THEN ERROR ELSE typeList _ CONS[NEW[MyRec_[type: keyReferentType, proc: proc]], typeList] } END; CallFurther: PUBLIC PROC[me: CDVPrivate.MyGraphicRef, key: REF] = <<--Catches all errors and signals!>> <<--Called by the viewer paintproc of chipndale-design viewers only.>> BEGIN found: BOOLEAN; val: RefTab.Val; transmitt: REF _ key; WITH key SELECT FROM comm: REF CDDraw.Comm => key _ comm.ref ENDCASE => NULL; [found, val] _ RefTab.Fetch[valueTable, key]; IF found THEN { <<--first check if we know the value of key>> p: REF FurtherPaintProc ~ NARROW[val]; p^[me, transmitt ! RuntimeError.UNCAUGHT => GOTO return] } ELSE { <<--then check if we know the type of key>> type: AMTypes.Type; TRUSTED { ENABLE RuntimeError.UNCAUGHT => GOTO return; type _ AMTypes.TVType[AMBridge.TVForReferent[key]] }; FOR list: TypeList _ typeList, list.rest WHILE list#NIL DO IF list.first.type=type THEN { list.first.proc[me, transmitt ! RuntimeError.UNCAUGHT => GOTO return]; EXIT } ENDLOOP; } EXITS return => NULL END; END.