obliqlibui/src/ObLibUI.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE ObLibUI;
IMPORT Text, ObLib, ObValue, Rd, SynWr, SynLocation,
Thread, ObEval, VBT, FormsVBT, Trestle, TrestleComm,
Color, ColorName, MultiSplit;

  VAR setupDone := FALSE;

  PROCEDURE PackageSetup() =
  BEGIN
    IF NOT setupDone THEN
      setupDone := TRUE;
      Setup();
    END;
  END PackageSetup;

  PROCEDURE Setup() =
  BEGIN
    SetupColor();
    SetupForm();
  END Setup;
============ color package ============

TYPE

  ColorCode = {Named, RGB, HSV, R, G, B, H, S, V, Brightness};

  ColorOpCode =
    ObLib.OpCode OBJECT
        code: ColorCode;
      END;

  PackageColor =
    ObLib.T OBJECT
      OVERRIDES
        Eval:=EvalColor;
      END;

  PROCEDURE IsColor(self: ValColor; other: ObValue.ValAnything): BOOLEAN =
  BEGIN
    TYPECASE other OF ValColor(oth)=> RETURN self.color = oth.color;
    ELSE RETURN FALSE END;
  END IsColor;

  PROCEDURE CopyColor(self: ObValue.ValAnything; tbl: ObValue.Tbl;
    loc: SynLocation.T): ObValue.ValAnything RAISES {ObValue.Error} =
  BEGIN
    RETURN self;
  END CopyColor;

  PROCEDURE NewColorOC(name: TEXT; arity: INTEGER; code: ColorCode)
    : ColorOpCode =
  BEGIN
    RETURN NEW(ColorOpCode, name:=name, arity:=arity, code:=code);
  END NewColorOC;

  PROCEDURE SetupColor() =
  TYPE OpCodes = ARRAY OF ObLib.OpCode;
  VAR opCodes: REF OpCodes;
  BEGIN
    opCodes := NEW(REF OpCodes, NUMBER(ColorCode));
    opCodes^ :=
      OpCodes{
      NewColorOC("named", 1, ColorCode.Named),
      NewColorOC("rgb", 3, ColorCode.RGB),
      NewColorOC("hsv", 3, ColorCode.HSV),
      NewColorOC("r", 1, ColorCode.R),
      NewColorOC("g", 1, ColorCode.G),
      NewColorOC("b", 1, ColorCode.B),
      NewColorOC("h", 1, ColorCode.H),
      NewColorOC("s", 1, ColorCode.S),
      NewColorOC("v", 1, ColorCode.V),
      NewColorOC("brightness", 1, ColorCode.Brightness)
      };
    ObLib.Register(
      NEW(PackageColor, name:="color", opCodes:=opCodes));
  END SetupColor;

  PROCEDURE EvalColor(self: PackageColor; opCode: ObLib.OpCode;
      arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
      temp: BOOLEAN; loc: SynLocation.T)
      : ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
    VAR real1, real2, real3: LONGREAL; rgb1: Color.T; hsv1: Color.HSV;
      text1: TEXT;
    BEGIN
      CASE NARROW(opCode, ColorOpCode).code OF
      | ColorCode.Named =>
          TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); END;
          TRY rgb1 := ColorName.ToRGB(text1);
          EXCEPT ColorName.NotFound => rgb1 := Color.Black;
          END;
          RETURN NEW(ValColor,  what:="<a Color.T>", picklable:=TRUE,
              color:=rgb1);
      | ColorCode.RGB =>
          TYPECASE args[1] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(1, "real", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
	  IF (real1<0.0d0) OR (real1>1.0d0)
          THEN ObValue.BadArgVal(1, "in range", self.name, opCode.name, loc);
          END;
	  IF (real2<0.0d0) OR (real2>1.0d0)
          THEN ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          END;
	  IF (real3<0.0d0) OR (real3>1.0d0)
          THEN ObValue.BadArgVal(3, "in range", self.name, opCode.name, loc);
          END;
          rgb1 := Color.T{r:=FLOAT(real1), g:=FLOAT(real2), b:=FLOAT(real3)};
          RETURN NEW(ValColor, what:="<a Color.T>", picklable:=TRUE,
            color:=rgb1);
      | ColorCode.HSV =>
          TYPECASE args[1] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(1, "real", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
	  IF (real1<0.0d0) OR (real1>1.0d0)
          THEN ObValue.BadArgVal(1, "in range", self.name, opCode.name, loc);
          END;
	  IF (real2<0.0d0) OR (real2>1.0d0)
          THEN ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          END;
	  IF (real3<0.0d0) OR (real3>1.0d0)
          THEN ObValue.BadArgVal(3, "in range", self.name, opCode.name, loc);
          END;
          rgb1 := Color.FromHSV(
              Color.HSV{h:=FLOAT(real1), s:=FLOAT(real2), v:=FLOAT(real3)});
          RETURN NEW(ValColor, what:="<a Color.T>", picklable:=TRUE,
            color:=rgb1);
      | ColorCode.R =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          RETURN NEW(ObValue.ValReal, real:=FLOAT(rgb1.r, LONGREAL), temp:=temp);
      | ColorCode.G =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          RETURN NEW(ObValue.ValReal, real:=FLOAT(rgb1.g, LONGREAL), temp:=temp);
      | ColorCode.B =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          RETURN NEW(ObValue.ValReal, real:=FLOAT(rgb1.b, LONGREAL), temp:=temp);
      | ColorCode.H =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          hsv1 := Color.ToHSV(rgb1);
          RETURN NEW(ObValue.ValReal, real:=FLOAT(hsv1.h, LONGREAL), temp:=temp);
      | ColorCode.S =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          hsv1 := Color.ToHSV(rgb1);
          RETURN NEW(ObValue.ValReal, real:=FLOAT(hsv1.s, LONGREAL), temp:=temp);
      | ColorCode.V =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          hsv1 := Color.ToHSV(rgb1);
          RETURN NEW(ObValue.ValReal, real:=FLOAT(hsv1.v, LONGREAL), temp:=temp);
      | ColorCode.Brightness =>
          TYPECASE args[1] OF | ValColor(node) => rgb1:=node.color;
          ELSE ObValue.BadArgType(1, "color", self.name, opCode.name, loc);END;
          RETURN NEW(ObValue.ValReal,
            real:=FLOAT(Color.Brightness(rgb1), LONGREAL), temp:=temp);
      ELSE
        ObValue.BadOp(self.name, opCode.name, loc);
      END;
    END EvalColor;
============ form package ============

TYPE

  FormCode = {Error, New, FromFile, Attach,
    GetBool, PutBool, GetInt, PutInt, GetText, PutText,
    GetBoolean, PutBoolean, GetChoice, PutChoice, TakeFocus,
    GetReactivity, PutReactivity, PopUp, PopDown,
    Insert, Move, Delete, DeleteRange,
    ChildIndex, Child, NumOfChildren,
    ShowAt, Show, Hide};

  FormOpCode =
    ObLib.OpCode OBJECT
        code: FormCode;
      END;

  PackageForm =
    ObLib.T OBJECT
      OVERRIDES
        Eval:=EvalForm;
      END;

  TYPE FormClosure =
    FormsVBT.Closure OBJECT
      fun: ObValue.ValFun;
      fv: ObValue.Val;
      location: SynLocation.T;
    OVERRIDES
      apply := ApplyFormClosure;
    END;

  PROCEDURE ApplyFormClosure(self: FormClosure;
      fv: FormsVBT.T; name: TEXT; time: VBT.TimeStamp) RAISES {} =
    VAR args: ARRAY [0..0] OF ObValue.Val;
    BEGIN
      TRY
        args[0] := self.fv;
        EVAL ObEval.Call(self.fun, args, self.location);
      EXCEPT
      | ObValue.Error(packet) =>
          SynWr.Text(SynWr.out,
           "*** A Modula3 callback to Obliq caused an Obliq error: ***\n");
          ObValue.ErrorMsg(SynWr.out, packet);
          SynWr.Flush(SynWr.out);
      | ObValue.Exception(packet) =>
          SynWr.Text(SynWr.out,
           "*** A Modula3 callback to Obliq caused an Obliq exception: ***\n");
          ObValue.ExceptionMsg(SynWr.out, packet);
          SynWr.Flush(SynWr.out);
      END;
    END ApplyFormClosure;

  PROCEDURE IsForm(self: ValForm; other: ObValue.ValAnything): BOOLEAN =
  BEGIN
    TYPECASE other OF ValForm(oth)=> RETURN self.form = oth.form;
    ELSE RETURN FALSE END;
  END IsForm;

  PROCEDURE CopyForm(self: ObValue.ValAnything; tbl: ObValue.Tbl;
    loc: SynLocation.T): ObValue.ValAnything RAISES {ObValue.Error} =
  BEGIN
    ObValue.RaiseError("Cannot copy forms", loc);
  END CopyForm;

  VAR formException: ObValue.ValException;

  PROCEDURE NewFormOC(name: TEXT; arity: INTEGER; code: FormCode)
    : FormOpCode =
  BEGIN
    RETURN NEW(FormOpCode, name:=name, arity:=arity, code:=code);
  END NewFormOC;

  PROCEDURE SetupForm() =
  TYPE OpCodes = ARRAY OF ObLib.OpCode;
  VAR opCodes: REF OpCodes;
  BEGIN
    opCodes := NEW(REF OpCodes, NUMBER(FormCode));
    opCodes^ :=
      OpCodes{
      NewFormOC("failure", -1, FormCode.Error),
      NewFormOC("new", 1, FormCode.New),
      NewFormOC("fromFile", 1, FormCode.FromFile),
      NewFormOC("attach", 3, FormCode.Attach),
      NewFormOC("getBool", 3, FormCode.GetBool),
      NewFormOC("putBool", 4, FormCode.PutBool),
      NewFormOC("getInt", 3, FormCode.GetInt),
      NewFormOC("putInt", 4, FormCode.PutInt),
      NewFormOC("getText", 3, FormCode.GetText),
      NewFormOC("putText", 5, FormCode.PutText),
      NewFormOC("getBoolean", 2, FormCode.GetBoolean),
      NewFormOC("putBoolean", 3, FormCode.PutBoolean),
      NewFormOC("getChoice", 2, FormCode.GetChoice),
      NewFormOC("putChoice", 3, FormCode.PutChoice),
      NewFormOC("takeFocus", 3, FormCode.TakeFocus),
      NewFormOC("getReactivity", 2, FormCode.GetReactivity),
      NewFormOC("putReactivity", 3, FormCode.PutReactivity),
      NewFormOC("popUp", 2, FormCode.PopUp),
      NewFormOC("popDown", 2, FormCode.PopDown),
      NewFormOC("insert", 4, FormCode.Insert),
      NewFormOC("move", 5, FormCode.Move),
      NewFormOC("delete", 3, FormCode.Delete),
      NewFormOC("deleteRange", 4, FormCode.DeleteRange),
      NewFormOC("childIndex", 3, FormCode.ChildIndex),
      NewFormOC("child", 3, FormCode.Child),
      NewFormOC("numOfChildren", 2, FormCode.NumOfChildren),
      NewFormOC("showAt", 3, FormCode.ShowAt),
      NewFormOC("show", 1, FormCode.Show),
      NewFormOC("hide", 1, FormCode.Hide)
      };
    ObLib.Register(
      NEW(PackageForm, name:="form", opCodes:=opCodes));
    formException := NEW(ObValue.ValException, name:="form_failure");
    ObValue.InhibitTransmission(TYPECODE(ValForm),
      "forms cannot be transmitted/duplicated");
  END SetupForm;

  PROCEDURE EvalForm(self: PackageForm; opCode: ObLib.OpCode;
      arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
      temp: BOOLEAN; loc: SynLocation.T)
      : ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
    VAR text1, text2, text3: TEXT; fv1: FormsVBT.T; bool1: BOOLEAN;
      int1, int2, index: INTEGER; fun1: ObValue.Val;
      ch, toCh, p: VBT.T;
    BEGIN
      TRY
      CASE NARROW(opCode, FormOpCode).code OF
      | FormCode.Error =>
          RETURN formException;
      | FormCode.New =>
          TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); END;
          fv1 :=NEW(FormsVBT.T).init(text1);
          RETURN NEW(ValForm, what:="<a FormsVBT.T>", picklable:=FALSE,
              form:=fv1);
      | FormCode.FromFile =>
          TYPECASE args[1] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(1, "text", self.name, opCode.name, loc); END;
          TRY
            fv1 :=NEW(FormsVBT.T).initFromFile(text1);
          EXCEPT
          | Rd.Failure =>
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          RETURN NEW(ValForm, what:="<a FormsVBT.T>", picklable:=FALSE,
              form:=fv1);
      | FormCode.Attach =>
          TYPECASE args[1] OF | ValForm(node) => fv1:=node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValFun(node) => fun1:=node;
          ELSE ObValue.BadArgType(3, "procedure", self.name, opCode.name, loc);
          END;
          FormsVBT.Attach(fv1, text1,
              NEW(FormClosure, fun:=fun1, fv:=args[1], location:=loc));
          RETURN ObValue.valOk;
      | FormCode.GetBool =>
          TYPECASE args[1] OF | ValForm(node) => fv1:=node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          bool1 := FormsVBT.GetBooleanProperty(fv1, text1, text2);
          RETURN NEW(ObValue.ValBool, bool:=bool1);
      | FormCode.PutBool =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); END;
          FormsVBT.PutBooleanProperty(fv1, text1, text2, bool1);
          RETURN ObValue.valOk;
      | FormCode.GetInt =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          IF Text.Empty(text2) THEN
            int1 := FormsVBT.GetInteger(fv1, text1);
          ELSE
            int1 := FormsVBT.GetIntegerProperty(fv1, text1, text2);
          END;
          RETURN NEW(ObValue.ValInt, int:=int1);
      | FormCode.PutInt =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); END;
          IF Text.Empty(text2) THEN
            FormsVBT.PutInteger(fv1, text1, int1);
          ELSE
            FormsVBT.PutIntegerProperty(fv1, text1, text2, int1);
          END;
          RETURN ObValue.valOk;
      | FormCode.GetText =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          IF Text.Empty(text2) THEN
            text3 := FormsVBT.GetText(fv1, text1);
          ELSE
            text3 := FormsVBT.GetTextProperty(fv1, text1, text2);
          END;
          RETURN ObValue.NewText(text3);
      | FormCode.PutText =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValText(node) => text3:=node.text;
          ELSE ObValue.BadArgType(4, "text", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(5, "bool", self.name, opCode.name, loc); END;
          IF Text.Empty(text2) THEN
            FormsVBT.PutText(fv1, text1, text3, bool1);
          ELSE
            FormsVBT.PutTextProperty(fv1, text1, text2, text3);
          END;
          RETURN ObValue.valOk;
      | FormCode.GetBoolean =>
          TYPECASE args[1] OF | ValForm(node) => fv1:=node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          bool1 := FormsVBT.GetBoolean(fv1, text1);
          RETURN NEW(ObValue.ValBool, bool:=bool1);
      | FormCode.PutBoolean =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); END;
          FormsVBT.PutBoolean(fv1, text1, bool1);
          RETURN ObValue.valOk;
      | FormCode.GetChoice =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          text2 := FormsVBT.GetChoice(fv1, text1);
          RETURN ObValue.NewText(text2);
       | FormCode.PutChoice =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          IF Text.Empty(text2) THEN
            FormsVBT.PutChoice(fv1, text1, NIL);
          ELSE
            FormsVBT.PutChoice(fv1, text1, text2);
          END;
          RETURN ObValue.valOk;
      | FormCode.GetReactivity =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          IF FormsVBT.IsActive(fv1, text1) THEN
            RETURN ObValue.NewText("active");
          ELSIF FormsVBT.IsPassive(fv1, text1) THEN
            RETURN ObValue.NewText("passive");
          ELSIF FormsVBT.IsDormant(fv1, text1) THEN
            RETURN ObValue.NewText("dormant");
          ELSIF FormsVBT.IsVanished(fv1, text1) THEN
            RETURN ObValue.NewText("vanished");
          ELSE
            RETURN ObValue.NewText("");
          END;
       | FormCode.PutReactivity =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          IF Text.Equal(text2, "active") THEN
            FormsVBT.MakeActive(fv1, text1);
          ELSIF Text.Equal(text2, "passive") THEN
            FormsVBT.MakePassive(fv1, text1);
          ELSIF Text.Equal(text2, "dormant") THEN
            FormsVBT.MakeDormant(fv1, text1);
          ELSIF Text.Equal(text2, "vanished") THEN
            FormsVBT.MakeVanish(fv1, text1);
          ELSE ObValue.BadArgVal(3, "a valid reactivity",
                               self.name, opCode.name, loc);
          END;
          RETURN ObValue.valOk;
      | FormCode.TakeFocus =>
          TYPECASE args[1] OF | ValForm(node) => fv1:=node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); END;
          FormsVBT.TakeFocus(fv1, text1, FormsVBT.GetTheEventTime(fv1), bool1);
          RETURN ObValue.valOk;
      | FormCode.PopUp =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          FormsVBT.PopUp(fv1, text1);
          RETURN ObValue.valOk;
      | FormCode.PopDown =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          FormsVBT.PopDown(fv1, text1);
          RETURN ObValue.valOk;
      | FormCode.Insert =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); END;
          IF int1 < 0 THEN
            ObValue.BadArgVal(4, "non-negative", self.name, opCode.name, loc);
          END;
          EVAL FormsVBT.Insert(fv1, text1, text2, int1);
          RETURN ObValue.valOk;
      | FormCode.ChildIndex =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          p := FormsVBT.GetVBT(fv1, text1);
          ch := FormsVBT.GetVBT(fv1, text2);
          IF (p = NIL) OR (ch = NIL) THEN
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          TRY int1 := MultiSplit.Index(p, ch);
          EXCEPT MultiSplit.NotAChild =>
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          RETURN NEW(ObValue.ValInt, int:=int1);
      | FormCode.Child =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(3, "int", self.name, opCode.name, loc); END;
          IF int1 < 0 THEN
            ObValue.BadArgVal(3, "non-negative", self.name, opCode.name, loc);
          END;
          p := FormsVBT.GetVBT(fv1, text1);
	  ch := MultiSplit.Nth(p, int1);
	  IF (p=NIL) OR (ch=NIL) THEN
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          TRY text2 := FormsVBT.GetName(ch);
          EXCEPT FormsVBT.Error =>
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          RETURN ObValue.NewText(text2);
      | FormCode.NumOfChildren =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          p := FormsVBT.GetVBT(fv1, text1);
	  IF p=NIL THEN
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          TRY int1 := MultiSplit.NumChildren(p);
          EXCEPT MultiSplit.NotAChild =>
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          RETURN NEW(ObValue.ValInt, int:=int1);
      | FormCode.Move =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValText(node) => text3:=node.text;
          ELSE ObValue.BadArgType(4, "text", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(5, "bool", self.name, opCode.name, loc); END;
          IF Text.Equal(text2, text3) THEN RETURN ObValue.valOk END;
          p := FormsVBT.GetVBT(fv1, text1);
          ch := FormsVBT.GetVBT(fv1, text2);
          IF Text.Empty(text3) THEN toCh := NIL
          ELSE toCh := FormsVBT.GetVBT(fv1, text3);
          END;
          IF (p = NIL) OR (ch = NIL) OR
            ((NOT Text.Empty(text3)) AND (toCh = NIL)) THEN
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          TRY
            IF bool1 THEN toCh := MultiSplit.Pred(p, toCh) END;
            MultiSplit.Move(p, toCh, ch);
          EXCEPT MultiSplit.NotAChild =>
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          RETURN ObValue.valOk;
      | FormCode.Delete =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          p := FormsVBT.GetVBT(fv1, text1);
          ch := FormsVBT.GetVBT(fv1, text2);
          IF (p = NIL) OR (ch = NIL) THEN
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          TRY
            index := MultiSplit.Index(p, ch);
          EXCEPT MultiSplit.NotAChild =>
            ObValue.RaiseException(formException, opCode.name, loc);
          END;
          FormsVBT.Delete(fv1, text1, index, 1);
          RETURN ObValue.valOk;
      | FormCode.DeleteRange =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(3, "int", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValInt(node) => int2:=node.int;
          ELSE ObValue.BadArgType(4, "int", self.name, opCode.name, loc); END;
          IF int1 < 0 THEN
            ObValue.BadArgVal(3, "non-negative", self.name, opCode.name, loc);
          END;
          IF int2 < 0 THEN
            ObValue.BadArgVal(4, "non-negative", self.name, opCode.name, loc);
          END;
          FormsVBT.Delete(fv1, text1, int1, int2);
          RETURN ObValue.valOk;
      | FormCode.Show =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          Trestle.Install(fv1);
          RETURN ObValue.valOk;
      | FormCode.ShowAt =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(3, "text", self.name, opCode.name, loc); END;
          IF Text.Empty(text1) THEN Trestle.Install(fv1);
          ELSE
            Trestle.Install(v:=fv1, trsl:=Trestle.Connect(text1),
              windowTitle:=text2, iconTitle:=text2);
          END;
          RETURN ObValue.valOk;
      | FormCode.Hide =>
          TYPECASE args[1] OF | ValForm(node) => fv1 := node.form;
          ELSE ObValue.BadArgType(1, "form", self.name, opCode.name, loc); END;
          Trestle.Delete(fv1);
          RETURN ObValue.valOk;
      ELSE
        ObValue.BadOp(self.name, opCode.name, loc);
      END;
      EXCEPT
      | FormsVBT.Error, FormsVBT.Unimplemented, TrestleComm.Failure =>
        ObValue.RaiseException(formException, opCode.name, loc);
      | Thread.Alerted =>
          ObValue.RaiseException(ObValue.threadAlerted,
                               self.name&"_"&opCode.name,loc);
      END;
    END EvalForm;

BEGIN
END ObLibUI.