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

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


<* PRAGMA LL *>

MODULE Subtypeview1ObliqView;

<*NOWARN*> IMPORT ObLibM3, ObLibUI, SynWr, Obliq, ObliqParser, Rd;
<*NOWARN*> IMPORT Filter, SubtypeViewClass, Fmt, ObLibAnim, ZFmt;
<*NOWARN*> IMPORT ZeusPanel, ObValue, TextWr, AlgSubtype, View;
<*NOWARN*> IMPORT VBT, Thread, TextRd, Rsrc;

CONST
  ViewName =  "view1.obl";

TYPE
  T = SubtypeViewClass.T BRANDED OBJECT
        object  : Obliq.Val;
        env     : Obliq.Env;
        wr      : TextWr.T;
        swr     : SynWr.T;
        parser  : ObliqParser.T;
      OVERRIDES
        <* LL.sup < VBT.mu *>
        startrun := Startrun;
        <* LL.sup < VBT.mu *>
        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;
        <* LL.sup = VBT.mu *>
      END;
 OUTPUT and UPDATE event handling methods: 

PROCEDURE Setup (view: T;  ) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "Setup") THEN
      Invoke (view, "Setup", ""
      )
    END
  END Setup;
PROCEDURE Begin (view: T;  lftRoot, rhtRoot: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "Begin") THEN
      Invoke (view, "Begin", ""
      & Fmt.Int(lftRoot)
      & ","
      & Fmt.Int(rhtRoot)
      )
    END
  END Begin;
PROCEDURE NewBot (view: T;  index: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "NewBot") THEN
      Invoke (view, "NewBot", ""
      & Fmt.Int(index)
      )
    END
  END NewBot;
PROCEDURE NewTop (view: T;  index: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "NewTop") THEN
      Invoke (view, "NewTop", ""
      & Fmt.Int(index)
      )
    END
  END NewTop;
PROCEDURE NewFun (view: T;  index, domEdgeIndex, rngEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "NewFun") THEN
      Invoke (view, "NewFun", ""
      & Fmt.Int(index)
      & ","
      & Fmt.Int(domEdgeIndex)
      & ","
      & Fmt.Int(rngEdgeIndex)
      )
    END
  END NewFun;
PROCEDURE NewDomRng (view: T;  index, domIndex, rngIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "NewDomRng") THEN
      Invoke (view, "NewDomRng", ""
      & Fmt.Int(index)
      & ","
      & Fmt.Int(domIndex)
      & ","
      & Fmt.Int(rngIndex)
      )
    END
  END NewDomRng;
PROCEDURE NewLoop (view: T;  fromIndex, toIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "NewLoop") THEN
      Invoke (view, "NewLoop", ""
      & Fmt.Int(fromIndex)
      & ","
      & Fmt.Int(toIndex)
      )
    END
  END NewLoop;
PROCEDURE Enter (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "Enter") THEN
      Invoke (view, "Enter", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END Enter;
PROCEDURE Exit (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER; result: BOOLEAN) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "Exit") THEN
      Invoke (view, "Exit", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      & ","
      & AlgSubtype.FmtBool(result)
      )
    END
  END Exit;
PROCEDURE SeenOK (view: T;  fromIndex, toIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "SeenOK") THEN
      Invoke (view, "SeenOK", ""
      & Fmt.Int(fromIndex)
      & ","
      & Fmt.Int(toIndex)
      )
    END
  END SeenOK;
PROCEDURE Notice (view: T;  fromIndex, toIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "Notice") THEN
      Invoke (view, "Notice", ""
      & Fmt.Int(fromIndex)
      & ","
      & Fmt.Int(toIndex)
      )
    END
  END Notice;
PROCEDURE BotLessAnyOK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "BotLessAnyOK") THEN
      Invoke (view, "BotLessAnyOK", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END BotLessAnyOK;
PROCEDURE TopLessTopOK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "TopLessTopOK") THEN
      Invoke (view, "TopLessTopOK", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END TopLessTopOK;
PROCEDURE TopLessNonTopKO (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "TopLessNonTopKO") THEN
      Invoke (view, "TopLessNonTopKO", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END TopLessNonTopKO;
PROCEDURE FunLessBotKO (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "FunLessBotKO") THEN
      Invoke (view, "FunLessBotKO", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END FunLessBotKO;
PROCEDURE FunLessTopOK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "FunLessTopOK") THEN
      Invoke (view, "FunLessTopOK", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END FunLessTopOK;
PROCEDURE FunLessFun (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "FunLessFun") THEN
      Invoke (view, "FunLessFun", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END FunLessFun;
PROCEDURE OK (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "OK") THEN
      Invoke (view, "OK", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END OK;
PROCEDURE KO (view: T;  lftIndex, rhtIndex, lftLeadingEdgeIndex, rhtLeadingEdgeIndex: INTEGER) =
  <* LL.sup < VBT.mu *>
  BEGIN
    IF FieldDefined(view.object, "KO") THEN
      Invoke (view, "KO", ""
      & Fmt.Int(lftIndex)
      & ","
      & Fmt.Int(rhtIndex)
      & ","
      & Fmt.Int(lftLeadingEdgeIndex)
      & ","
      & Fmt.Int(rhtLeadingEdgeIndex)
      )
    END
  END KO;

PROCEDURE RegisterView () =
  BEGIN
    ZeusPanel.RegisterView(New, "view1.obl", "Subtype")
  END RegisterView;

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

CONST
  ObliqStackSizeMultiplier = 8;

TYPE
  Closure = Thread.SizedClosure OBJECT
              view: T;
            OVERRIDES
              apply := ForkedStartrun;
            END;

PROCEDURE Startrun (view: T) =
  <* LL.sup < VBT.mu *>
  BEGIN
    EVAL
      Thread.Join(
        Thread.Fork(
          NEW(Closure, view := view,
              stackSize := ObliqStackSizeMultiplier * Thread.GetDefaultStackSize())));
  END Startrun;

PROCEDURE ForkedStartrun (cl: Closure): REFANY =
  VAR rd: Rd.T; view := cl.view;
  BEGIN
    IF view.parser = NIL THEN
      view.wr := TextWr.New();
      view.swr := SynWr.New(view.wr);
      view.parser := ObliqParser.New(view.swr);
    END;
    view.object := NIL;
    TRY
      rd := Rsrc.Open(ViewName, ZeusPanel.GetPath());
      view.env := ParseRd(view.parser, ViewName, rd);
      WITH obj = Obliq.Lookup("view", view.env) DO
        IF NOT ISTYPE(obj, ObValue.ValObj) THEN
          ZeusPanel.ReportError(
            "not an Obliq object in '" & ViewName & "'")
        ELSIF FieldDefined (obj, "graphvbt") THEN
          WITH graphvbt =
            NARROW(Obliq.ObjectSelect(obj, "graphvbt"),
                   ObLibAnim.ValGraph).vbt DO
            LOCK VBT.mu DO
              EVAL Filter.Replace(view, graphvbt)
            END
          END;
          view.object := obj;
        ELSIF FieldDefined (obj, "rectsvbt") THEN
          WITH rectsvbt =
            NARROW(Obliq.ObjectSelect(obj, "rectsvbt"),
                   ObLibAnim.ValRects).vbt DO
            LOCK VBT.mu DO
              EVAL Filter.Replace(view, rectsvbt)
            END
          END;
          view.object := obj;
        ELSIF FieldDefined (obj, "formsvbt") THEN
          WITH formsvbt =
            NARROW(Obliq.ObjectSelect(obj, "formsvbt"),
                   ObLibUI.ValForm).vbt DO
            LOCK VBT.mu DO
              EVAL Filter.Replace(view, formsvbt)
            END
          END;
          view.object := obj;
        ELSE
          ZeusPanel.ReportError(
            "cannot find 'graphvbt', 'rectsvbt', or 'formsvbt' in '" & ViewName & "'")
        END
      END
    EXCEPT
    | Rsrc.NotFound =>
        ZeusPanel.ReportError("cannot find '" & ViewName & "'")
    | ObValue.Error (packet) => OblError(view, packet)
    | ObValue.Exception (packet) => OblException(view, packet)
    END;
    RETURN NIL;
  END ForkedStartrun;

PROCEDURE ParseRd (p: ObliqParser.T; name: TEXT; rd: Rd.T):
  Obliq.Env RAISES {ObValue.Error, ObValue.Exception} =
  VAR env := Obliq.EmptyEnv();
  BEGIN
    ObliqParser.ReadFrom(p, name, rd, TRUE);
    TRY
      LOOP
        EVAL ObliqParser.EvalPhrase(p, ObliqParser.ParsePhrase(p), env)
      END
    EXCEPT
      ObliqParser.Eof => (* clean exit of loop *)
    END;
    RETURN env
  END ParseRd;

PROCEDURE Invoke (view: T; event, args: TEXT) =
  VAR
    exp    := "view." & event & "(" & args & ");";
    name   := "Zeus Event <" & event & ">";
  BEGIN
    ObliqParser.ReadFrom (view.parser, name, TextRd.New(exp), FALSE);
    TRY
      EVAL Obliq.EvalTerm(ObliqParser.ParseTerm(view.parser), view.env)
    EXCEPT
    | ObliqParser.Eof => <* ASSERT FALSE *>
    | ObValue.Error (packet) => OblError(view, packet)
    | ObValue.Exception (packet) => OblException(view, packet)
    END
  END Invoke;

PROCEDURE FieldDefined (object: Obliq.Val; event: TEXT): BOOLEAN =
  BEGIN
    TRY
      RETURN object # NIL AND Obliq.ObjectHas(object, event)
    EXCEPT
    | ObValue.Error =>
    | ObValue.Exception =>
    END;
    RETURN FALSE
  END FieldDefined;

PROCEDURE OblError (view: T; packet: ObValue.ErrorPacket) =
  BEGIN
    Obliq.ReportError(view.swr, packet);
    ZeusPanel.ReportError(
      "Obliq error: " & TextWr.ToText(view.wr))
  END OblError;

PROCEDURE OblException (view: T; packet: ObValue.ExceptionPacket) =
  BEGIN
    Obliq.ReportException(view.swr, packet);
    ZeusPanel.ReportError(
      "Obliq exception: " & TextWr.ToText(view.wr))
  END OblException;

BEGIN
  SynWr.Setup();
  ObliqParser.PackageSetup();
  ObLibM3.PackageSetup();
  ObLibUI.PackageSetup();
  ObLibAnim.PackageSetup();
  RegisterView ();
END Subtypeview1ObliqView.



interface View is in:

juno-app/src/View.i3
zeus/src/View.i3