mentor/derived/SubtypeTranscriptView.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:56:02 PST 1995 by kalsow  
      modified on Mon Jun  6 03:18:55 PDT 1994 by mhb   
      modified on Tue Feb 16 16:31:40 PST 1993 by johnh 

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

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


<* PRAGMA LL *>

MODULE SubtypeTranscriptView;

<*NOWARN*> IMPORT TextPort, Rd, ZeusClass, Filter, TextEditVBT;
<*NOWARN*> IMPORT SubtypeViewClass, Fmt, ZFmt, Wr, ZeusPanel;
<*NOWARN*> IMPORT FormsVBT, AlgSubtype, VBT, View;

<* FATAL FormsVBT.Error, FormsVBT.Unimplemented *>

REVEAL
  T = Public BRANDED OBJECT
    fv: FormsVBT.T := NIL;
    te: TextEditVBT.T := NIL;
  OVERRIDES
    init       := TViewInit;
    install    := TViewInstall;
    delete     := TViewDelete;
    snapshot   := TViewSnapshot;
    restore    := TViewRestore;
    config     := TViewConfig;
    reactivity := TViewReactivity;
    startrun   := TViewStartrun;
    endrun     := TViewEndrun;
    oeSetup := Setup;
    oeBegin := Begin;
    oeNewBot := NewBot;
    oeNewTop := NewTop;
    oeNewFun := NewFun;
    oeNewDomRng := NewDomRng;
    oeNewLoop := NewLoop;
    oeEnter := Enter;
    oeExit := Exit;
    oeSeenOK := SeenOK;
    oeNotice := Notice;
    oeBotLessAnyOK := BotLessAnyOK;
    oeTopLessTopOK := TopLessTopOK;
    oeTopLessNonTopKO := TopLessNonTopKO;
    oeFunLessBotKO := FunLessBotKO;
    oeFunLessTopOK := FunLessTopOK;
    oeFunLessFun := FunLessFun;
    oeOK := OK;
    oeKO := KO;
  END;

PROCEDURE TViewInit (view: T): T =
  <* LL = VBT.mu *>
  BEGIN
    TViewZTrace (view, "init");
    RETURN SubtypeViewClass.T.init (view, NIL);
  END TViewInit;

PROCEDURE Clear (<* UNUSED *> fv  : FormsVBT.T;
                 <* UNUSED *> name: TEXT;
                              cl  : REFANY;
                 <* UNUSED *> time: VBT.TimeStamp) =
  BEGIN
    TextPort.SetText(NARROW(cl, T).te.tp, "")
  END Clear;

PROCEDURE TViewInstall (view: T) =
  <* LL = VBT.mu *>
  BEGIN
    view.fv := ZeusPanel.NewForm("SubtypeTranscriptView.fv");
    view.te := FormsVBT.GetVBT(view.fv, "transcript");
    TViewZTrace (view, "install");
    FormsVBT.AttachProc(view.fv, "clear", Clear, view);
    EVAL Filter.Replace (view, view.fv);
    SubtypeViewClass.T.install (view);
  END TViewInstall;

PROCEDURE TViewDelete (view: T) =
  <* LL = VBT.mu *>
  BEGIN
    TViewZTrace (view, "delete");
    SubtypeViewClass.T.delete (view);
   END TViewDelete;

PROCEDURE TViewSnapshot (view: T; wr: Wr.T) RAISES {ZeusClass.Error} =
  <* LL = VBT.mu *>
  BEGIN
    TViewZTrace (view, "snapshot");
    SubtypeViewClass.T.snapshot (view, wr);
   END TViewSnapshot;

PROCEDURE TViewRestore (view: T; rd: Rd.T) RAISES {ZeusClass.Error} =
  <* LL = VBT.mu *>
  BEGIN
    TViewZTrace (view, "restore");
    SubtypeViewClass.T.restore (view, rd);
   END TViewRestore;

PROCEDURE TViewConfig (
    view: T;
    state: ZeusClass.StateChange;
    o: ZeusClass.T) =
  <* LL = VBT.mu *>
  BEGIN
    TViewZTrace (view, "config");
    SubtypeViewClass.T.config (view, state, o);
   END TViewConfig;

PROCEDURE TViewReactivity (view: T; <*UNUSED*> on: BOOLEAN) =
  <* LL = VBT.mu *>
  BEGIN
    TViewZTrace(view, "reactivity");
    SubtypeViewClass.T.reactivity (view, TRUE);
  END TViewReactivity;

PROCEDURE TViewStartrun (view: T) =
  <* LL = {} *>
  BEGIN
    TViewZTrace (view, "startrun");
    SubtypeViewClass.T.startrun (view);
   END TViewStartrun;

PROCEDURE TViewEndrun (view: T) =
  <* LL = {} *>
  BEGIN
    TViewZTrace (view, "endrun");
    SubtypeViewClass.T.endrun (view);
  END TViewEndrun;
event handling methods:

PROCEDURE Setup (view: T;  ) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "Setup ...")
       ELSE
          TViewTrace (view, "Setup "
          )
       END
    END
    END
  END Setup;

PROCEDURE Begin (view: T;  lftRoot, rhtRoot: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "Begin ...")
       ELSE
          TViewTrace (view, "Begin "
          & Fmt.Int(lftRoot)
          & " "
          & Fmt.Int(rhtRoot)
          )
       END
    END
    END
  END Begin;

PROCEDURE NewBot (view: T;  index: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "NewBot ...")
       ELSE
          TViewTrace (view, "NewBot "
          & Fmt.Int(index)
          )
       END
    END
    END
  END NewBot;

PROCEDURE NewTop (view: T;  index: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "NewTop ...")
       ELSE
          TViewTrace (view, "NewTop "
          & Fmt.Int(index)
          )
       END
    END
    END
  END NewTop;

PROCEDURE NewFun (view: T;  index, domEdgeIndex, rngEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "NewFun ...")
       ELSE
          TViewTrace (view, "NewFun "
          & Fmt.Int(index)
          & " "
          & Fmt.Int(domEdgeIndex)
          & " "
          & Fmt.Int(rngEdgeIndex)
          )
       END
    END
    END
  END NewFun;

PROCEDURE NewDomRng (view: T;  index, domIndex, rngIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "NewDomRng ...")
       ELSE
          TViewTrace (view, "NewDomRng "
          & Fmt.Int(index)
          & " "
          & Fmt.Int(domIndex)
          & " "
          & Fmt.Int(rngIndex)
          )
       END
    END
    END
  END NewDomRng;

PROCEDURE NewLoop (view: T;  fromIndex, toIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "NewLoop ...")
       ELSE
          TViewTrace (view, "NewLoop "
          & Fmt.Int(fromIndex)
          & " "
          & Fmt.Int(toIndex)
          )
       END
    END
    END
  END NewLoop;

PROCEDURE Enter (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "Enter ...")
       ELSE
          TViewTrace (view, "Enter "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END Enter;

PROCEDURE Exit (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER; result: BOOLEAN) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "Exit ...")
       ELSE
          TViewTrace (view, "Exit "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          & " "
          & AlgSubtype.FmtBool(result)
          )
       END
    END
    END
  END Exit;

PROCEDURE SeenOK (view: T;  fromIndex, toIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "SeenOK ...")
       ELSE
          TViewTrace (view, "SeenOK "
          & Fmt.Int(fromIndex)
          & " "
          & Fmt.Int(toIndex)
          )
       END
    END
    END
  END SeenOK;

PROCEDURE Notice (view: T;  fromIndex, toIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "Notice ...")
       ELSE
          TViewTrace (view, "Notice "
          & Fmt.Int(fromIndex)
          & " "
          & Fmt.Int(toIndex)
          )
       END
    END
    END
  END Notice;

PROCEDURE BotLessAnyOK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "BotLessAnyOK ...")
       ELSE
          TViewTrace (view, "BotLessAnyOK "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END BotLessAnyOK;

PROCEDURE TopLessTopOK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "TopLessTopOK ...")
       ELSE
          TViewTrace (view, "TopLessTopOK "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END TopLessTopOK;

PROCEDURE TopLessNonTopKO (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "TopLessNonTopKO ...")
       ELSE
          TViewTrace (view, "TopLessNonTopKO "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END TopLessNonTopKO;

PROCEDURE FunLessBotKO (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "FunLessBotKO ...")
       ELSE
          TViewTrace (view, "FunLessBotKO "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END FunLessBotKO;

PROCEDURE FunLessTopOK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "FunLessTopOK ...")
       ELSE
          TViewTrace (view, "FunLessTopOK "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END FunLessTopOK;

PROCEDURE FunLessFun (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "FunLessFun ...")
       ELSE
          TViewTrace (view, "FunLessFun "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END FunLessFun;

PROCEDURE OK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "OK ...")
       ELSE
          TViewTrace (view, "OK "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END OK;

PROCEDURE KO (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL = {} *>
  BEGIN
    LOCK VBT.mu DO
    IF FormsVBT.GetBoolean(view.fv, "alg") THEN
       IF NOT FormsVBT.GetBoolean(view.fv, "args") THEN
          TViewTrace (view, "KO ...")
       ELSE
          TViewTrace (view, "KO "
          & Fmt.Int(lftIndex)
          & " "
          & Fmt.Int(rhtIndex)
          & " "
          & Fmt.Int(lftLeadingEdgeIndex)
          & " "
          & Fmt.Int(rhtLeadingEdgeIndex)
          )
       END
    END
    END
  END KO;

PROCEDURE TViewZTrace (view: T; t: TEXT) =
  BEGIN
    IF view.fv # NIL THEN
      IF FormsVBT.GetBoolean(view.fv, "zeus") THEN
        TextPort.PutText(view.te.tp, "**zeus:  " & t & "\n");
        TextPort.Normalize(view.te.tp, LAST(INTEGER))
      END
    END
  END TViewZTrace;

PROCEDURE TViewTrace (view: T; t: TEXT) =
  BEGIN
    TextPort.PutText(view.te.tp, "--event: " & t & "\n");
    TextPort.Normalize(view.te.tp, LAST(INTEGER))
  END TViewTrace;

PROCEDURE TViewNew (): View.T =
  BEGIN
    RETURN NEW(T).init()
  END TViewNew;

BEGIN
  ZeusPanel.RegisterView
      (TViewNew, "Subtype Transcript View", "Subtype");
END SubtypeTranscriptView.

interface View is in: