mentor/derived/DGraphIE.m3


 Copyright (C) 1995, Digital Equipment Corporation.       
 All rights reserved.                                     
 See the file COPYRIGHT for a full description.           
                                                          
 Last modified on Thu Feb  9 08:50:48 PST 1995 by kalsow  
      modified on Sun Jun  5 21:59:57 PDT 1994 by mhb     
      modified on Wed Feb 17 16:46:47 PST 1993 by johnh   

********************************************************************

      *  NOTE: This file is generated automatically from the event
      *        definition file DGraph.evt.
      ********************************************************************


<* PRAGMA LL *>

MODULE DGraphIE;

<*NOWARN*> IMPORT AdjMatrix, DGraphViewClass, ZeusClass, Zeus;
<*NOWARN*> IMPORT Algorithm, DGraphAlgClass, View, Thread;
<*NOWARN*> IMPORT AlgorithmClass;

<* FATAL Zeus.Error, Zeus.Locked *>
If you get either of these errors, contact a Zeus implementor.

TYPE
  SetupArgs = BRANDED REF RECORD
    m: AdjMatrix.T;
  END;

  AddEdgeArgs = BRANDED REF RECORD
    from: INTEGER;
    to: INTEGER;
  END;

  MarkEdgeArgs = BRANDED REF RECORD
    from: INTEGER;
    to: INTEGER;
    depth: INTEGER;
  END;

  UnMarkEdgeArgs = BRANDED REF RECORD
    from: INTEGER;
    to: INTEGER;
    depth: INTEGER;
  END;

  MarkVertexArgs = BRANDED REF RECORD
    v: INTEGER;
    depth: INTEGER;
    rcset: AdjMatrix.RCSet;
  END;

  UnMarkVertexArgs = BRANDED REF RECORD
    v: INTEGER;
    depth: INTEGER;
    rcset: AdjMatrix.RCSet;
  END;

  NewTreeArgs = BRANDED REF RECORD
    root: INTEGER;
    label: TEXT;
  END;

  HighlightArgs = BRANDED REF RECORD
    node: INTEGER;
    highlight: REAL;
    nodeOnly: BOOLEAN;
  END;

  AddChildArgs = BRANDED REF RECORD
    parent: INTEGER;
    pred: INTEGER;
    child: INTEGER;
    label: TEXT;
  END;

  RemoveChildArgs = BRANDED REF RECORD
    parent: INTEGER;
    ch: INTEGER;
  END;
Zeus calls the following to invoke vbt v's event handler:

<*NOWARN*> PROCEDURE OEDispatcher(v: ZeusClass.T; evt: REFANY) RAISES {Thread.Alerted} =
  <* LL <= VBT.mu *>
  (* LL = {} if event style is output, LL = VBT.mu if event style is update. *)
  BEGIN
    TYPECASE v OF
    | DGraphViewClass.T (view) => <*NOWARN*>
      TYPECASE evt OF
      | SetupArgs(varSetupArgs) => <*NOWARN*>
          view.oeSetup (
              varSetupArgs.m
              )
      | AddEdgeArgs(varAddEdgeArgs) => <*NOWARN*>
          view.oeAddEdge (
              varAddEdgeArgs.from
                ,
              varAddEdgeArgs.to
              )
      | MarkEdgeArgs(varMarkEdgeArgs) => <*NOWARN*>
          view.oeMarkEdge (
              varMarkEdgeArgs.from
                ,
              varMarkEdgeArgs.to
                ,
              varMarkEdgeArgs.depth
              )
      | UnMarkEdgeArgs(varUnMarkEdgeArgs) => <*NOWARN*>
          view.oeUnMarkEdge (
              varUnMarkEdgeArgs.from
                ,
              varUnMarkEdgeArgs.to
                ,
              varUnMarkEdgeArgs.depth
              )
      | MarkVertexArgs(varMarkVertexArgs) => <*NOWARN*>
          view.oeMarkVertex (
              varMarkVertexArgs.v
                ,
              varMarkVertexArgs.depth
                ,
              varMarkVertexArgs.rcset
              )
      | UnMarkVertexArgs(varUnMarkVertexArgs) => <*NOWARN*>
          view.oeUnMarkVertex (
              varUnMarkVertexArgs.v
                ,
              varUnMarkVertexArgs.depth
                ,
              varUnMarkVertexArgs.rcset
              )
      | NewTreeArgs(varNewTreeArgs) => <*NOWARN*>
          view.oeNewTree (
              varNewTreeArgs.root
                ,
              varNewTreeArgs.label
              )
      | HighlightArgs(varHighlightArgs) => <*NOWARN*>
          view.oeHighlight (
              varHighlightArgs.node
                ,
              varHighlightArgs.highlight
                ,
              varHighlightArgs.nodeOnly
              )
      | AddChildArgs(varAddChildArgs) => <*NOWARN*>
          view.oeAddChild (
              varAddChildArgs.parent
                ,
              varAddChildArgs.pred
                ,
              varAddChildArgs.child
                ,
              varAddChildArgs.label
              )
      | RemoveChildArgs(varRemoveChildArgs) => <*NOWARN*>
          view.oeRemoveChild (
              varRemoveChildArgs.parent
                ,
              varRemoveChildArgs.ch
              )
      ELSE <* ASSERT FALSE *>
      END;
    ELSE (* this view isn't a DGraphViewClass, so just ignore *)
    END
  END OEDispatcher;

<*NOWARN*> PROCEDURE FEDispatcher(v: ZeusClass.T; evt: REFANY) =
  <* LL = VBT.mu *>
  BEGIN
    TYPECASE v OF
    | DGraphAlgClass.T (alg) => <*NOWARN*>
      TYPECASE evt OF
      ELSE <* ASSERT FALSE *>
      END;
    ELSE (* this alg isn't a DGraphAlgClass, so just ignore *)
    END
  END FEDispatcher;

PROCEDURE Setup (
      initiator: Algorithm.T;
       m: AdjMatrix.T
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(SetupArgs
               , m := m
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfSetup);
      alg.stopAtEvent := alg.eventDataRec.stopAtSetup;
      alg.waitAtEvent := alg.eventDataRec.waitAtSetup;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "Setup", OEDispatcher, zumeArgRec);
    END;
  END Setup;

PROCEDURE AddEdge (
      initiator: Algorithm.T;
       from, to: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(AddEdgeArgs
               , from := from
               , to := to
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfAddEdge);
      alg.stopAtEvent := alg.eventDataRec.stopAtAddEdge;
      alg.waitAtEvent := alg.eventDataRec.waitAtAddEdge;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "AddEdge", OEDispatcher, zumeArgRec);
    END;
  END AddEdge;

PROCEDURE MarkEdge (
      initiator: Algorithm.T;
       from, to: INTEGER; depth: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(MarkEdgeArgs
               , from := from
               , to := to
               , depth := depth
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfMarkEdge);
      alg.stopAtEvent := alg.eventDataRec.stopAtMarkEdge;
      alg.waitAtEvent := alg.eventDataRec.waitAtMarkEdge;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "MarkEdge", OEDispatcher, zumeArgRec);
    END;
  END MarkEdge;

PROCEDURE UnMarkEdge (
      initiator: Algorithm.T;
       from, to: INTEGER; depth: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(UnMarkEdgeArgs
               , from := from
               , to := to
               , depth := depth
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfUnMarkEdge);
      alg.stopAtEvent := alg.eventDataRec.stopAtUnMarkEdge;
      alg.waitAtEvent := alg.eventDataRec.waitAtUnMarkEdge;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "UnMarkEdge", OEDispatcher, zumeArgRec);
    END;
  END UnMarkEdge;

PROCEDURE MarkVertex (
      initiator: Algorithm.T;
       v: INTEGER; depth: INTEGER; rcset: AdjMatrix.RCSet
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(MarkVertexArgs
               , v := v
               , depth := depth
               , rcset := rcset
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfMarkVertex);
      alg.stopAtEvent := alg.eventDataRec.stopAtMarkVertex;
      alg.waitAtEvent := alg.eventDataRec.waitAtMarkVertex;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "MarkVertex", OEDispatcher, zumeArgRec);
    END;
  END MarkVertex;

PROCEDURE UnMarkVertex (
      initiator: Algorithm.T;
       v: INTEGER; depth: INTEGER; rcset: AdjMatrix.RCSet
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(UnMarkVertexArgs
               , v := v
               , depth := depth
               , rcset := rcset
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfUnMarkVertex);
      alg.stopAtEvent := alg.eventDataRec.stopAtUnMarkVertex;
      alg.waitAtEvent := alg.eventDataRec.waitAtUnMarkVertex;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "UnMarkVertex", OEDispatcher, zumeArgRec);
    END;
  END UnMarkVertex;

PROCEDURE NewTree (
      initiator: Algorithm.T;
       root: INTEGER; label: TEXT
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(NewTreeArgs
               , root := root
               , label := label
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfNewTree);
      alg.stopAtEvent := alg.eventDataRec.stopAtNewTree;
      alg.waitAtEvent := alg.eventDataRec.waitAtNewTree;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "NewTree", OEDispatcher, zumeArgRec);
    END;
  END NewTree;

PROCEDURE Highlight (
      initiator: Algorithm.T;
       node: INTEGER; highlight: REAL; nodeOnly: BOOLEAN
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(HighlightArgs
               , node := node
               , highlight := highlight
               , nodeOnly := nodeOnly
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfHighlight);
      alg.stopAtEvent := alg.eventDataRec.stopAtHighlight;
      alg.waitAtEvent := alg.eventDataRec.waitAtHighlight;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "Highlight", OEDispatcher, zumeArgRec);
    END;
  END Highlight;

PROCEDURE AddChild (
      initiator: Algorithm.T;
       parent, pred, child: INTEGER; label: TEXT
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(AddChildArgs
               , parent := parent
               , pred := pred
               , child := child
               , label := label
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfAddChild);
      alg.stopAtEvent := alg.eventDataRec.stopAtAddChild;
      alg.waitAtEvent := alg.eventDataRec.waitAtAddChild;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "AddChild", OEDispatcher, zumeArgRec);
    END;
  END AddChild;

PROCEDURE RemoveChild (
      initiator: Algorithm.T;
       parent, ch: INTEGER
    ) RAISES {Thread.Alerted} =
  <* LL = {} *>
  VAR zumeArgRec := NEW(RemoveChildArgs
               , parent := parent
               , ch := ch
      );
      alg := NARROW(initiator, DGraphAlgClass.T);
  BEGIN
    LOCK alg.evtMu DO
      INC(alg.eventDataRec.ctOfRemoveChild);
      alg.stopAtEvent := alg.eventDataRec.stopAtRemoveChild;
      alg.waitAtEvent := alg.eventDataRec.waitAtRemoveChild;
      Zeus.Dispatch(initiator, Zeus.EventStyle.Output, 1,
                    "RemoveChild", OEDispatcher, zumeArgRec);
    END;
  END RemoveChild;

BEGIN
END DGraphIE.

interface View is in: