obliqlibanim/src/ObLibAnim.m3


 Copyright 1991 Digital Equipment Corporation.               
 Distributed only by permission.                             

MODULE ObLibAnim;
IMPORT Text, ObLib, ObValue, ObEval, SynWr, SynLocation, Point,
Thread, NetObj, RefList, R2, PaintOp, VBT, GraphVBT, GraphVBTExtras,
Animate, Trestle, TrestleComm, ObLibUI, Color, PaintOpAnim, Rect, RectsVBT;

  VAR setupDone := FALSE;

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

  PROCEDURE Setup() =
  BEGIN
    SetupRects();
    SetupGraph();
    SetupZeus();
  END Setup;
============ rects package ============

TYPE

  RectsCode =
    {Error, New, SetN, Exists, Delete, Draw, Erase, SetColor,
    SetPosition, GetPosition, SetWorld, SetMargin, SetMins, SetBg,
    Show, Hide};

  RectsOpCode =
    ObLib.OpCode OBJECT
        code: RectsCode;
      END;

  PackageRects =
    ObLib.T OBJECT
      OVERRIDES
        Eval:=EvalRects;
      END;

  VAR rectsException: ObValue.ValException;

  PROCEDURE NewRectsOC(name: TEXT; arity: INTEGER; code: RectsCode)
    : RectsOpCode =
  BEGIN
    RETURN NEW(RectsOpCode, name:=name, arity:=arity, code:=code);
  END NewRectsOC;

  PROCEDURE SetupRects() =
  TYPE OpCodes = ARRAY OF ObLib.OpCode;
  VAR opCodes: REF OpCodes;
  BEGIN
    opCodes := NEW(REF OpCodes, NUMBER(RectsCode));
    opCodes^ :=
      OpCodes{
      NewRectsOC("failure", -1, RectsCode.Error),
      NewRectsOC("new", 0, RectsCode.New),
      NewRectsOC("setWorld", 5, RectsCode.SetWorld),
      NewRectsOC("setMargin", 5, RectsCode.SetMargin),
      NewRectsOC("setMins", 3, RectsCode.SetMins),
      NewRectsOC("setBg", 2, RectsCode.SetBg),
      NewRectsOC("setN", 3, RectsCode.SetN),
      NewRectsOC("draw", 2, RectsCode.Draw),
      NewRectsOC("erase", 2, RectsCode.Erase),
      NewRectsOC("exists", 2, RectsCode.Exists),
      NewRectsOC("delete", 3, RectsCode.Delete),
      NewRectsOC("setColor", 4, RectsCode.SetColor),
      NewRectsOC("setPosition", 7, RectsCode.SetPosition),
      NewRectsOC("getPosition", 2, RectsCode.GetPosition),
      NewRectsOC("show", 1, RectsCode.Show),
      NewRectsOC("hide", 1, RectsCode.Hide)};
    ObLib.Register(
      NEW(PackageRects, name := "rects", opCodes:=opCodes));
    rectsException := NEW(ObValue.ValException, name:="rects_failure");
    ObValue.InhibitTransmission(TYPECODE(ValRects),
      "rects cannot be transmitted/duplicated");
  END SetupRects;

  PROCEDURE EvalRects(self: PackageRects; opCode: ObLib.OpCode;
                      <*UNUSED*>arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
                      <*UNUSED*>temp: BOOLEAN; loc: SynLocation.T)
      : ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
    VAR rs1: ValRects; int1: INTEGER; bool1: BOOLEAN; clr1: Color.T;
      r1: Rect.T; p1,p2: RectsVBT.RealPoint;
      real1, real2, real3, real4: LONGREAL; ar1: REF ARRAY OF ObValue.Val;
    BEGIN
      TRY
      CASE NARROW(opCode, RectsOpCode).code OF
      | RectsCode.Error =>
          RETURN rectsException;
      | RectsCode.SetWorld =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          RectsVBT.SetWC(rs1.vbt,
            FLOAT(real1, REAL), FLOAT(real4, REAL),
            FLOAT(real2, REAL), FLOAT(real3, REAL));
          RETURN ObValue.valOk;
      | RectsCode.SetMargin =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          RectsVBT.SetMargin(rs1.vbt,
            FLOAT(real1, REAL), FLOAT(real4, REAL),
            FLOAT(real2, REAL), FLOAT(real3, REAL));
          RETURN ObValue.valOk;
      | RectsCode.SetMins =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          RectsVBT.SetMins(rs1.vbt, FLOAT(real1, REAL), FLOAT(real2, REAL));
          RETURN ObValue.valOk;
      | RectsCode.SetBg =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObLibUI.ValColor(node) => clr1:=node.color;
          ELSE ObValue.BadArgType(2, "color", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          RectsVBT.SetBg(rs1.vbt, PaintOp.FromRGB(clr1.r, clr1.g, clr1.b,
              mode:=PaintOp.Mode.Accurate));
          RETURN ObValue.valOk;
      | RectsCode.New =>
          RETURN NEW(ValRects, what:="<a RectsVBT.T>", tag := "RectsVBT`T",
                     picklable:=FALSE, vbt:=NEW(RectsVBT.T).init(),
                     n:=-1, shown:=FALSE);
      | RectsCode.SetN =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF int1<0 THEN
            ObValue.BadArgVal(2, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RectsVBT.SetN(rs1.vbt, int1, bool1);
          rs1.n := int1;
          RETURN ObValue.valOk;
      | RectsCode.Exists =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RETURN NEW(ObValue.ValBool, bool:=RectsVBT.Exists(rs1.vbt, int1));
      | RectsCode.Delete =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF int1<0 THEN
            ObValue.BadArgVal(2, "non-negative", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RectsVBT.Delete(rs1.vbt, int1, bool1);
          RETURN ObValue.valOk;
      | RectsCode.SetColor =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObLibUI.ValColor(node) => clr1:=node.color;
          ELSE ObValue.BadArgType(3, "color", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[4] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RectsVBT.Color(rs1.vbt, int1,
            PaintOp.FromRGB(clr1.r, clr1.g, clr1.b,
              mode:=PaintOp.Mode.Accurate),
            bool1);
          RETURN ObValue.valOk;
      | RectsCode.GetPosition =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          r1 := RectsVBT.Locate(rs1.vbt, int1);
          p1 := RectsVBT.VBT2WC(rs1.vbt,
                  Point.T{h:=r1.west, v:=r1.north});
          p2 := RectsVBT.VBT2WC(rs1.vbt,
                  Point.T{h:=r1.east, v:=r1.south});
          ar1 := NEW(REF ARRAY OF ObValue.Val, 4);
          ar1^[0] := NEW(ObValue.ValReal, real:=FLOAT(p1.h,LONGREAL), temp:=FALSE);
          ar1^[1] := NEW(ObValue.ValReal, real:=FLOAT(p2.h,LONGREAL), temp:=FALSE);
          ar1^[2] := NEW(ObValue.ValReal, real:=FLOAT(p1.v,LONGREAL), temp:=FALSE);
          ar1^[3] := NEW(ObValue.ValReal, real:=FLOAT(p2.v,LONGREAL), temp:=FALSE);
          RETURN ObValue.NewArray(ar1^);
      | RectsCode.SetPosition =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[6] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(6, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[7] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RectsVBT.Position(rs1.vbt, int1,
            FLOAT(real1, REAL), FLOAT(real4, REAL),
            FLOAT(real2, REAL), FLOAT(real3, REAL),
            bool1);
          RETURN ObValue.valOk;
      | RectsCode.Draw =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RectsVBT.Draw(rs1.vbt, int1);
          RETURN ObValue.valOk;
      | RectsCode.Erase =>
          TYPECASE args[1] OF | ValRects(node) => rs1:=node;
          ELSE ObValue.BadArgType(1,"rects",self.name,opCode.name,loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);<*ASSERT FALSE*>
          END;
          RectsVBT.Erase(rs1.vbt, int1);
          RETURN ObValue.valOk;
      | RectsCode.Show =>
          TYPECASE args[1] OF
          | ValRects(node) =>
            IF node.shown THEN
              ObValue.BadArgVal(1, "not already shown",
                self.name, opCode.name, loc);<*ASSERT FALSE*>
            END;
            node.shown := TRUE;
            Trestle.Install(node.vbt);
            NARROW(node.vbt,RectsVBT.T).redisplay();
          ELSE ObValue.BadArgType(1, "rects", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN ObValue.valOk;
      | RectsCode.Hide =>
          TYPECASE args[1] OF
          | ValRects(node) =>
            IF node.shown THEN
              node.shown := FALSE;
              Trestle.Delete(node.vbt);
            END;
          ELSE ObValue.BadArgType(1, "rects", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN ObValue.valOk;
      END;
      EXCEPT
      | TrestleComm.Failure =>
        ObValue.RaiseException(rectsException, opCode.name, loc);
        <*ASSERT FALSE*>
      END;
    END EvalRects;
============ graph package ============

TYPE

  GraphCode =
    {Error, New, Redisplay, Animate, Clear, SetWorld, SetMargin, SetAspect,
     SetPreferredSize, SetPixelSizeDivisor, VerticesAt, VertexHiLisAt,
     EdgesAt, PolygonsAt, SetClickAction, SetClickReleaseAction,
     SetDoubleClickAction, SetObjectLayer, NewVertex, MoveVertex,
     MoveVertexOnPath, RemoveVertex, VertexToFront, VertexToBack,
     VertexSetSize, VertexSetShape, VertexSetColor, VertexSetFont,
     VertexSetLabel, VertexSetLabelColor, VertexSetBorder,
     VertexSetBorderColor, VertexGetPosition, NewVertexHiLi,
     MoveVertexHiLi, RemoveVertexHiLi, VertexHiLiToFront, VertexHiLiToBack,
     VertexHiLiSetBorder, VertexHiLiSetColor, VertexHiLiGetVertex, NewEdge,
     MoveEdge, MoveEdgeBezier, RemoveEdge, EdgeToFront, EdgeToBack,
     EdgeSetWidth, EdgeSetColor, EdgeSetArrow, EdgeGetVertices,
     EdgeGetControls, NewPolygon, MovePolygon, RemovePolygon,
     PolygonToFront, PolygonToBack, PolygonSetColor, NewFont, DefaultFont,
     NewSpectrum, SetSpectrumColor, SetSpectrumRange, Show, Hide};

  GraphOpCode = ObLib.OpCode OBJECT code: GraphCode;  END;

  PackageGraph = ObLib.T OBJECT OVERRIDES Eval := EvalGraph; END;

PROCEDURE IsVertex (self: ValVertex; other: ObValue.ValAnything): BOOLEAN =
  BEGIN
    TYPECASE other OF
      ValVertex (oth) => RETURN self.vertex = oth.vertex;
    ELSE
      RETURN FALSE
    END;
  END IsVertex;

PROCEDURE IsVertexHiLi (self: ValVertexHiLi; other: ObValue.ValAnything):
  BOOLEAN =
  BEGIN
    TYPECASE other OF
      ValVertexHiLi (oth) => RETURN self.vertexHiLi = oth.vertexHiLi;
    ELSE
      RETURN FALSE
    END;
  END IsVertexHiLi;

PROCEDURE IsEdge (self: ValEdge; other: ObValue.ValAnything): BOOLEAN =
  BEGIN
    TYPECASE other OF
      ValEdge (oth) => RETURN self.edge = oth.edge;
    ELSE
      RETURN FALSE
    END;
  END IsEdge;

PROCEDURE IsPolygon (self: ValPolygon; other: ObValue.ValAnything):
  BOOLEAN =
  BEGIN
    TYPECASE other OF
      ValPolygon (oth) => RETURN self.polygon = oth.polygon;
    ELSE
      RETURN FALSE
    END;
  END IsPolygon;

PROCEDURE IsFont (self: ValFont; other: ObValue.ValAnything): BOOLEAN =
  BEGIN
    TYPECASE other OF
      ValFont (oth) => RETURN self.font = oth.font;
    ELSE
      RETURN FALSE
    END;
  END IsFont;

PROCEDURE IsSpectrum (self: ValSpectrum; other: ObValue.ValAnything):
  BOOLEAN =
  BEGIN
    TYPECASE other OF
      ValSpectrum (oth) => RETURN self.spectrum = oth.spectrum;
    ELSE
      RETURN FALSE
    END;
  END IsSpectrum;

VAR graphException: ObValue.ValException;

PROCEDURE NewGraphOC (name: TEXT; arity: INTEGER; code: GraphCode):
  GraphOpCode =
  BEGIN
    RETURN NEW(GraphOpCode, name := name, arity := arity, code := code);
  END NewGraphOC;

PROCEDURE SetupGraph () =
  TYPE OpCodes = ARRAY OF ObLib.OpCode;
  VAR opCodes: REF OpCodes;
  BEGIN
    opCodes := NEW(REF OpCodes, NUMBER(GraphCode));
    opCodes^ :=
      OpCodes{
        NewGraphOC("failure", -1, GraphCode.Error),
        NewGraphOC("new", 0, GraphCode.New),
        NewGraphOC("redisplay", 1, GraphCode.Redisplay),
        NewGraphOC("animate", 3, GraphCode.Animate),
        NewGraphOC("clear", 1, GraphCode.Clear),
        NewGraphOC("setWorld", 5, GraphCode.SetWorld),
        NewGraphOC("setMargin", 2, GraphCode.SetMargin),
        NewGraphOC("setAspect", 2, GraphCode.SetAspect),
        NewGraphOC("setPreferredSize", 3, GraphCode.SetPreferredSize),
        NewGraphOC("setPixelSizeDivisor", 3, GraphCode.SetPixelSizeDivisor),
        NewGraphOC("verticesAt", 5, GraphCode.VerticesAt),
        NewGraphOC("vertexHiLisAt", 5, GraphCode.VertexHiLisAt),
        NewGraphOC("edgesAt", 5, GraphCode.EdgesAt),
        NewGraphOC("polygonsAt", 5, GraphCode.PolygonsAt),
        NewGraphOC("setClickAction", 2, GraphCode.SetClickAction),
        NewGraphOC(
          "setClickReleaseAction", 2, GraphCode.SetClickReleaseAction),
        NewGraphOC(
          "setDoubleClickAction", 2, GraphCode.SetDoubleClickAction),
        NewGraphOC("setObjectLayer", 2, GraphCode.SetObjectLayer),

        NewGraphOC("newVertex", 1, GraphCode.NewVertex),
        NewGraphOC("moveVertex", 4, GraphCode.MoveVertex),
        NewGraphOC("moveVertexOnPath", 2, GraphCode.MoveVertexOnPath),
        NewGraphOC("removeVertex", 1, GraphCode.RemoveVertex),
        NewGraphOC("vertexToFront", 1, GraphCode.VertexToFront),
        NewGraphOC("vertexToBack", 1, GraphCode.VertexToBack),
        NewGraphOC("setVertexSize", 3, GraphCode.VertexSetSize),
        NewGraphOC("setVertexShape", 2, GraphCode.VertexSetShape),
        NewGraphOC("setVertexColor", 2, GraphCode.VertexSetColor),
        NewGraphOC("setVertexFont", 2, GraphCode.VertexSetFont),
        NewGraphOC("setVertexLabel", 2, GraphCode.VertexSetLabel),
        NewGraphOC("setVertexLabelColor", 2, GraphCode.VertexSetLabelColor),
        NewGraphOC("setVertexBorder", 2, GraphCode.VertexSetBorder),
        NewGraphOC(
          "setVertexBorderColor", 2, GraphCode.VertexSetBorderColor),
        NewGraphOC("getVertexPosition", 1, GraphCode.VertexGetPosition),

        NewGraphOC("newVertexHiLi", 1, GraphCode.NewVertexHiLi),
        NewGraphOC("moveVertexHiLi", 3, GraphCode.MoveVertexHiLi),
        NewGraphOC("removeVertexHiLi", 1, GraphCode.RemoveVertexHiLi),
        NewGraphOC("vertexHiLiToFront", 1, GraphCode.VertexHiLiToFront),
        NewGraphOC("vertexHiLiToBack", 1, GraphCode.VertexHiLiToBack),
        NewGraphOC("setVertexHiLiColor", 2, GraphCode.VertexHiLiSetColor),
        NewGraphOC("setVertexHiLiBorder", 3, GraphCode.VertexHiLiSetBorder),
        NewGraphOC("getVertexHiLiVertex", 1, GraphCode.VertexHiLiGetVertex),

        NewGraphOC("newEdge", 2, GraphCode.NewEdge),
        NewGraphOC("moveEdge", 4, GraphCode.MoveEdge),
        NewGraphOC("moveEdgeBezier", 6, GraphCode.MoveEdgeBezier),
        NewGraphOC("removeEdge", 1, GraphCode.RemoveEdge),
        NewGraphOC("edgeToFront", 1, GraphCode.EdgeToFront),
        NewGraphOC("edgeToBack", 1, GraphCode.EdgeToBack),
        NewGraphOC("setEdgeWidth", 2, GraphCode.EdgeSetWidth),
        NewGraphOC("setEdgeColor", 2, GraphCode.EdgeSetColor),
        NewGraphOC("setEdgeArrows", 3, GraphCode.EdgeSetArrow),
        NewGraphOC("getEdgeVertices", 1, GraphCode.EdgeGetVertices),
        NewGraphOC("getEdgeControls", 1, GraphCode.EdgeGetControls),

        NewGraphOC("newPolygon", 1, GraphCode.NewPolygon),
        NewGraphOC("movePolygon", 3, GraphCode.MovePolygon),
        NewGraphOC("removePolygon", 1, GraphCode.RemovePolygon),
        NewGraphOC("polygonToFront", 1, GraphCode.PolygonToFront),
        NewGraphOC("polygonToBack", 1, GraphCode.PolygonToBack),
        NewGraphOC("setPolygonColor", 2, GraphCode.PolygonSetColor),

        NewGraphOC("newFont", 6, GraphCode.NewFont),
        NewGraphOC("defaultFont", -1, GraphCode.DefaultFont),

        NewGraphOC("newSpectrum", 1, GraphCode.NewSpectrum),
        NewGraphOC("setSpectrumColor", 2, GraphCode.SetSpectrumColor),
        NewGraphOC("setSpectrumRange", 2, GraphCode.SetSpectrumRange),

        NewGraphOC("show", 1, GraphCode.Show),
        NewGraphOC("hide", 1, GraphCode.Hide)};
    ObLib.Register(NEW(PackageGraph, name := "graph", opCodes := opCodes));
    graphException := NEW(ObValue.ValException, name := "graph_failure");
    ObValue.InhibitTransmission(
      TYPECODE(ValGraph), "graphs cannot be transmitted/duplicated");
    ObValue.InhibitTransmission(
      TYPECODE(ValVertex), "vetices cannot be transmitted/duplicated");
    ObValue.InhibitTransmission(
      TYPECODE(ValVertexHiLi),
      "vertex hilights cannot be transmitted/duplicated");
    ObValue.InhibitTransmission(
      TYPECODE(ValEdge), "edges cannot be transmitted/duplicated");
    ObValue.InhibitTransmission(
      TYPECODE(ValPolygon), "polygons cannot be transmitted/duplicated");
    ObValue.InhibitTransmission(
      TYPECODE(ValFont), "fonts cannot be transmitted/duplicated");
    ObValue.InhibitTransmission(
      TYPECODE(ValSpectrum), "spectrums cannot be transmitted/duplicated");
  END SetupGraph;

PROCEDURE EvalGraph (                    self  : PackageGraph;
                                         opCode: ObLib.OpCode;
                     <*UNUSED*>          arity : ObLib.OpArity;
                                READONLY args  : ObValue.ArgArray;
                     <*UNUSED*>          temp  : BOOLEAN;
                                         loc   : SynLocation.T     ):
  ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
  VAR
    gr1                       : Graph;
    gr0                       : ValGraph;
    v1, v2, v3, v4            : GraphVBT.Vertex;
    e1                        : GraphVBT.Edge;
    p1                        : GraphVBT.Polygon;
    real1, real2, real3, real4: LONGREAL;
    list                      : RefList.T;
    size                      : INTEGER;
    bool1, bool2              : BOOLEAN;
    text1, text2, text3, text4: TEXT;
    vh1                       : GraphVBT.VertexHighlight;
    font1                     : GraphVBT.WorldFont;
    fun1                      : ObValue.Val;
    int1, int2                : INTEGER;
    sp1                       : ValSpectrum;
    moveClosure               : MoveClosure;
    cl1                       : ObLibUI.ValColor;
    array1, ar1               : REF ARRAY OF ObValue.Val;
    rl1                       : RefList.T;
  BEGIN
    TRY
      CASE NARROW(opCode, GraphOpCode).code OF
      | GraphCode.Error => RETURN graphException;
      | GraphCode.New =>
          gr1 := NEW(Graph, clickAction := NIL, clickReleaseAction := NIL,
                     doubleClickAction := NIL).init();
          gr0 :=
            NEW(ValGraph, what := "<a GraphVBT.T>", picklable := FALSE,
                tag := "GraphVBT`T", shown := FALSE);
          gr1.valGraph := gr0;
          gr0.vbt := gr1;
          RETURN gr0;
      | GraphCode.Redisplay =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.redisplay();
          RETURN ObValue.valOk;
      | GraphCode.Animate =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          Animate.SetDuration(1.0);
          Animate.ResetATime();
          gr1.animate(FLOAT(real1), FLOAT(real2));
          RETURN ObValue.valOk;
      | GraphCode.Clear =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.clear();
          RETURN ObValue.valOk;
      | GraphCode.SetWorld =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValReal (node) => real3 := node.real;
          ELSE
            ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ObValue.ValReal (node) => real4 := node.real;
          ELSE
            ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.setWorld(
            GraphVBT.WorldRectangle{w := FLOAT(real1), e := FLOAT(real2),
                                    n := FLOAT(real3), s := FLOAT(real4)});
          RETURN ObValue.valOk;
      | GraphCode.SetMargin =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.setMargin(FLOAT(real1));
          RETURN ObValue.valOk;
      | GraphCode.SetAspect =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.setAspect(FLOAT(real1));
          RETURN ObValue.valOk;
      | GraphCode.SetPreferredSize =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.setPreferredSize(R2.T{FLOAT(real1), FLOAT(real2)});
          RETURN ObValue.valOk;
      | GraphCode.SetPixelSizeDivisor =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValInt (node) => int1 := node.int;
          ELSE
            ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValInt (node) => int2 := node.int;
          ELSE
            ObValue.BadArgType(3, "int", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.setPixelSizeDivisor(
            ARRAY [0 .. 1] OF CARDINAL{MAX(1, int1), MAX(1, int2)});
          RETURN ObValue.valOk;
      | GraphCode.VerticesAt =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValReal (node) => real3 := node.real;
          ELSE
            ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ObValue.ValReal (node) => real4 := node.real;
          ELSE
            ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          rl1 := gr1.verticesAt(
                   WorldRectToScreenRect(gr1.world, VBT.Domain(gr1), real1,
                                         real2, real3, real4));
          int1 := RefList.Length(rl1);
          ar1 := NEW(REF ARRAY OF ObValue.Val, int1);
          FOR i := 0 TO int1 - 1 DO
            ar1^[i] := NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                           tag := "GraphVBT`Vertex", picklable := FALSE,
                           vertex := rl1.head);
            rl1 := rl1.tail;
          END;
          RETURN ObValue.NewArray(ar1^);
      | GraphCode.VertexHiLisAt =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValReal (node) => real3 := node.real;
          ELSE
            ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ObValue.ValReal (node) => real4 := node.real;
          ELSE
            ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          rl1 := gr1.vertexHighlightsAt(
                   WorldRectToScreenRect(gr1.world, VBT.Domain(gr1), real1,
                                         real2, real3, real4));
          int1 := RefList.Length(rl1);
          ar1 := NEW(REF ARRAY OF ObValue.Val, int1);
          FOR i := 0 TO int1 - 1 DO
            ar1^[i] :=
              NEW(ValVertexHiLi, what := "<a GraphVBT.VertexHighlight>",
                  tag := "GraphVBT`VertexHighlight", picklable := FALSE,
                  vertexHiLi := rl1.head);
            rl1 := rl1.tail;
          END;
          RETURN ObValue.NewArray(ar1^);
      | GraphCode.EdgesAt =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValReal (node) => real3 := node.real;
          ELSE
            ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ObValue.ValReal (node) => real4 := node.real;
          ELSE
            ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          rl1 :=
            gr1.edgesAt(WorldRectToScreenRect(gr1.world, VBT.Domain(gr1),
                                              real1, real2, real3, real4));
          int1 := RefList.Length(rl1);
          ar1 := NEW(REF ARRAY OF ObValue.Val, int1);
          FOR i := 0 TO int1 - 1 DO
            ar1^[i] := NEW(ValEdge, what := "<a GraphVBT.Edge>",
                           tag := "GraphVBT`Edge", picklable := FALSE,
                           edge := rl1.head);
            rl1 := rl1.tail;
          END;
          RETURN ObValue.NewArray(ar1^);
      | GraphCode.PolygonsAt =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValReal (node) => real3 := node.real;
          ELSE
            ObValue.BadArgType(4, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ObValue.ValReal (node) => real4 := node.real;
          ELSE
            ObValue.BadArgType(5, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          rl1 := gr1.polygonsAt(
                   WorldRectToScreenRect(gr1.world, VBT.Domain(gr1), real1,
                                         real2, real3, real4));
          int1 := RefList.Length(rl1);
          ar1 := NEW(REF ARRAY OF ObValue.Val, int1);
          FOR i := 0 TO int1 - 1 DO
            ar1^[i] := NEW(ValPolygon, what := "<a GraphVBT.Polygon>",
                           tag := "GraphVBT`Polygon", picklable := FALSE,
                           polygon := rl1.head);
            rl1 := rl1.tail;
          END;
          RETURN ObValue.NewArray(ar1^);
      | GraphCode.SetClickAction =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValFun (node) => fun1 := node;
          ELSE
            ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc);
          END;
          gr1.clickAction := fun1;
          RETURN ObValue.valOk;
      | GraphCode.SetClickReleaseAction =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValFun (node) => fun1 := node;
          ELSE
            ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc);
          END;
          gr1.clickReleaseAction := fun1;
          RETURN ObValue.valOk;
      | GraphCode.SetDoubleClickAction =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValFun (node) => fun1 := node;
          ELSE
            ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          gr1.doubleClickAction := fun1;
          RETURN ObValue.valOk;
      | GraphCode.SetObjectLayer =>
          TYPECASE args[2] OF
          | ObValue.ValInt (node) => int1 := node.int;
          ELSE
            ObValue.BadArgType(2, "int", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[1] OF
          | ValVertex (node) =>
              node.vertex.toFront(VAL(int1, GraphVBT.ZOrder));
          | ValVertexHiLi (node) =>
              node.vertexHiLi.toFront(VAL(int1, GraphVBT.ZOrder));
          | ValEdge (node) =>
              node.edge.toFront(VAL(int1, GraphVBT.ZOrder));
          | ValPolygon (node) =>
              node.polygon.toFront(VAL(int1, GraphVBT.ZOrder));
          ELSE
            ObValue.BadArgType(
              1, "graph object", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN ObValue.valOk;

      | GraphCode.NewVertex =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1 := NEW(GraphVBT.Vertex, graph := gr1).init();
          RETURN NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                     tag := "GraphVBT`Vertex", picklable := FALSE,
                     vertex := v1);
      | GraphCode.MoveVertex =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValBool (node) => bool1 := node.bool;
          ELSE
            ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.move(R2.T{FLOAT(real1), FLOAT(real2)}, bool1, 0.0, 1.0, NIL);
          RETURN ObValue.valOk;
      | GraphCode.MoveVertexOnPath =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValFun (node) => fun1 := node;
          ELSE
            ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          moveClosure := NEW(MoveClosure, fun := fun1, location := loc);
          (* -- Sets the final vertex position by calling the obliq
             procedure at time 1.0. *)
          v1.move(moveClosure.pos(1.0), TRUE, 0.0, 1.0, moveClosure);
          RETURN ObValue.valOk;
      | GraphCode.RemoveVertex =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.remove();
          RETURN ObValue.valOk;
      | GraphCode.VertexToFront =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.toFront();
          RETURN ObValue.valOk;
      | GraphCode.VertexToBack =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.toBack();
          RETURN ObValue.valOk;
      | GraphCode.VertexSetSize =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.setSize(R2.T{FLOAT(real1), FLOAT(real2)});
          RETURN ObValue.valOk;
      | GraphCode.VertexSetShape =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValText (node) => text1 := node.text;
          ELSE
            ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          IF Text.Equal(text1, "rectangle") THEN
            v1.setShape(GraphVBT.VertexShape.Rectangle);
          ELSIF Text.Equal(text1, "ellipse") THEN
            v1.setShape(GraphVBT.VertexShape.Ellipse);
          ELSE
            ObValue.BadArgVal(2, "\"rectangle\" or \"ellipse\"", self.name,
                              opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN ObValue.valOk;
      | GraphCode.VertexSetColor =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.setColor(
            ExtractColor(args[2], 2, self.name, opCode.name, loc));
          RETURN ObValue.valOk;
      | GraphCode.VertexSetFont =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ValFont (node) => font1 := node.font;
          ELSE
            ObValue.BadArgType(2, "font", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.setFont(font1);
          RETURN ObValue.valOk;
      | GraphCode.VertexSetLabel =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValText (node) => text1 := node.text;
          ELSE
            ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.setLabel(text1);
          RETURN ObValue.valOk;
      | GraphCode.VertexSetLabelColor =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.setFontColor(
            ExtractColor(args[2], 2, self.name, opCode.name, loc));
          RETURN ObValue.valOk;
      | GraphCode.VertexSetBorder =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          v1.setBorder(FLOAT(real1));
          RETURN ObValue.valOk;
      | GraphCode.VertexSetBorderColor =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          (* -- v1.setBorderColor(ExtractColor(args[2], 2, self.name,
             opCode.name, loc)); *)
          v1.setFontColor(
            ExtractColor(args[2], 2, self.name, opCode.name, loc));
          RETURN ObValue.valOk;
      | GraphCode.VertexGetPosition =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          ar1 := NEW(REF ARRAY OF ObValue.Val, 2);
          ar1^[0] :=
            NEW(ObValue.ValReal, real := FLOAT(v1.pos[0], LONGREAL),
                temp := FALSE);
          ar1^[1] :=
            NEW(ObValue.ValReal, real := FLOAT(v1.pos[1], LONGREAL),
                temp := FALSE);
          RETURN ObValue.NewArray(ar1^);

      | GraphCode.NewVertexHiLi =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1 := NEW(GraphVBT.VertexHighlight, vertex := v1).init();
          RETURN NEW(ValVertexHiLi, what := "<a GraphVBT.VertexHighlight>",
                     tag := "GraphVBT`VertexHighlight", picklable := FALSE,
                     vertexHiLi := vh1);
      | GraphCode.MoveVertexHiLi =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValBool (node) => bool1 := node.bool;
          ELSE
            ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1.move(v1, bool1);
          RETURN ObValue.valOk;
      | GraphCode.RemoveVertexHiLi =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1.remove();
          RETURN ObValue.valOk;
      | GraphCode.VertexHiLiToFront =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1.toFront();
          RETURN ObValue.valOk;
      | GraphCode.VertexHiLiToBack =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1.toBack();
          RETURN ObValue.valOk;
      | GraphCode.VertexHiLiSetColor =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1.setColor(
            ExtractColor(args[2], 2, self.name, opCode.name, loc));
          RETURN ObValue.valOk;
      | GraphCode.VertexHiLiSetBorder =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real2 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          vh1.setBorder(R2.T{FLOAT(real1), FLOAT(real2)});
          RETURN ObValue.valOk;
      | GraphCode.VertexHiLiGetVertex =>
          TYPECASE args[1] OF
          | ValVertexHiLi (node) => vh1 := node.vertexHiLi;
          ELSE
            ObValue.BadArgType(
              1, "vertexHiLi", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                     tag := "GraphVBT`Vertex", picklable := FALSE,
                     vertex := vh1.vertex);

      | GraphCode.NewEdge =>
          TYPECASE args[1] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(1, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ValVertex (node) => v2 := node.vertex;
          ELSE
            ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1 := NEW(GraphVBT.Edge, vertex0 := v1, vertex1 := v2).init();
          RETURN
            NEW(ValEdge, what := "<a GraphVBT.Edge>",
                tag := "GraphVBT`Edge", picklable := FALSE, edge := e1);
      | GraphCode.MoveEdge =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ValVertex (node) => v2 := node.vertex;
          ELSE
            ObValue.BadArgType(3, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValBool (node) => bool1 := node.bool;
          ELSE
            ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.move(v1, v2, NIL, NIL, bool1);
          RETURN ObValue.valOk;
      | GraphCode.MoveEdgeBezier =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ValVertex (node) => v1 := node.vertex;
          ELSE
            ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ValVertex (node) => v2 := node.vertex;
          ELSE
            ObValue.BadArgType(3, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ValVertex (node) => v3 := node.vertex;
          ELSE
            ObValue.BadArgType(4, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ValVertex (node) => v4 := node.vertex;
          ELSE
            ObValue.BadArgType(5, "vertex", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[6] OF
          | ObValue.ValBool (node) => bool1 := node.bool;
          ELSE
            ObValue.BadArgType(6, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.move(v1, v2, v3, v4, bool1);
          RETURN ObValue.valOk;
      | GraphCode.RemoveEdge =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.remove();
          RETURN ObValue.valOk;
      | GraphCode.EdgeToFront =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.toFront();
          RETURN ObValue.valOk;
      | GraphCode.EdgeToBack =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.toBack();
          RETURN ObValue.valOk;
      | GraphCode.EdgeSetWidth =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.setWidth(FLOAT(real1));
          RETURN ObValue.valOk;
      | GraphCode.EdgeSetColor =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.setColor(
            ExtractColor(args[2], 2, self.name, opCode.name, loc));
          RETURN ObValue.valOk;
      | GraphCode.EdgeSetArrow =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValBool (node) => bool1 := node.bool;
          ELSE
            ObValue.BadArgType(2, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValBool (node) => bool2 := node.bool;
          ELSE
            ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          e1.setArrow(ARRAY [0 .. 1] OF BOOLEAN{bool1, bool2});
          RETURN ObValue.valOk;
      | GraphCode.EdgeGetVertices =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          ar1 := NEW(REF ARRAY OF ObValue.Val, 2);
          ar1^[0] := NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                         tag := "GraphVBT`Vertex", picklable := FALSE,
                         vertex := e1.vertex0);
          ar1^[1] := NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                         tag := "GraphVBT`Vertex", picklable := FALSE,
                         vertex := e1.vertex1);
          RETURN ObValue.NewArray(ar1^);
      | GraphCode.EdgeGetControls =>
          TYPECASE args[1] OF
          | ValEdge (node) => e1 := node.edge;
          ELSE
            ObValue.BadArgType(1, "edge", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          IF (e1.control0 = NIL) OR (e1.control1 = NIL) THEN
            ar1 := NEW(REF ARRAY OF ObValue.Val, 0);
            RETURN ObValue.NewArray(ar1^);
          ELSE
            ar1 := NEW(REF ARRAY OF ObValue.Val, 2);
            ar1^[0] := NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                           tag := "GraphVBT`Vertex", picklable := FALSE,
                           vertex := e1.control0);
            ar1^[1] := NEW(ValVertex, what := "<a GraphVBT.Vertex>",
                           tag := "GraphVBT`Vertex", picklable := FALSE,
                           vertex := e1.control1);
            RETURN ObValue.NewArray(ar1^);
          END;

      | GraphCode.NewPolygon =>
          TYPECASE args[1] OF
          | ObValue.ValArray (node) => array1 := node.remote.Obtain();
          ELSE
            ObValue.BadArgType(1, "array", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          size := NUMBER(array1^);
          list := NIL;
          FOR i := 0 TO size - 1 DO
            TYPECASE array1^[(size - 1) - i] OF
            | ValVertex (node) => list := RefList.Cons(node.vertex, list);
            ELSE
              ObValue.BadArgType(
                1, "array(vertex)", self.name, opCode.name, loc); <*ASSERT FALSE*>
            END;
          END;
          p1 := NEW(GraphVBT.Polygon, vertices := list).init();
          RETURN NEW(ValPolygon, what := "<a GraphVBT.Polygon>",
                     tag := "GraphVBT`Polygon", picklable := FALSE,
                     polygon := p1);
      | GraphCode.MovePolygon =>
          TYPECASE args[1] OF
          | ValPolygon (node) => p1 := node.polygon;
          ELSE
            ObValue.BadArgType(1, "polygon", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValArray (node) => array1 := node.remote.Obtain();
          ELSE
            ObValue.BadArgType(2, "array", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValBool (node) => bool1 := node.bool;
          ELSE
            ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          size := NUMBER(array1^);
          list := NIL;
          FOR i := 0 TO size - 1 DO
            TYPECASE array1^[(size - 1) - i] OF
            | ValVertex (node) => list := RefList.Cons(node.vertex, list);
            ELSE
              ObValue.BadArgType(
                1, "array(vertex)", self.name, opCode.name, loc); <*ASSERT FALSE*>
            END;
          END;
          p1.move(list, bool1);
          RETURN ObValue.valOk;
      | GraphCode.RemovePolygon =>
          TYPECASE args[1] OF
          | ValPolygon (node) => p1 := node.polygon;
          ELSE
            ObValue.BadArgType(1, "polygon", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          p1.remove();
          RETURN ObValue.valOk;
      | GraphCode.PolygonToFront =>
          TYPECASE args[1] OF
          | ValPolygon (node) => p1 := node.polygon;
          ELSE
            ObValue.BadArgType(1, "polygon", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          p1.toFront();
          RETURN ObValue.valOk;
      | GraphCode.PolygonToBack =>
          TYPECASE args[1] OF
          | ValPolygon (node) => p1 := node.polygon;
          ELSE
            ObValue.BadArgType(1, "polygon", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          p1.toBack();
          RETURN ObValue.valOk;
      | GraphCode.PolygonSetColor =>
          TYPECASE args[1] OF
          | ValPolygon (node) => p1 := node.polygon;
          ELSE
            ObValue.BadArgType(1, "polygon", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          p1.setColor(
            ExtractColor(args[2], 2, self.name, opCode.name, loc));
          RETURN ObValue.valOk;

      | GraphCode.NewFont =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValText (node) => text1 := node.text;
          ELSE
            ObValue.BadArgType(2, "text", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[3] OF
          | ObValue.ValReal (node) => real1 := node.real;
          ELSE
            ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[4] OF
          | ObValue.ValText (node) => text2 := node.text;
          ELSE
            ObValue.BadArgType(4, "text", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[5] OF
          | ObValue.ValText (node) => text3 := node.text;
          ELSE
            ObValue.BadArgType(5, "text", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[6] OF
          | ObValue.ValText (node) => text4 := node.text;
          ELSE
            ObValue.BadArgType(6, "text", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          font1 := gr1.font(text1, FLOAT(real1), ExtractSlant(text2),
                            text3, text4);
          RETURN NEW(ValFont, what := "<a GraphVBT.WorldFont>",
                     tag := "GraphVBT`WorldFont", picklable := FALSE,
                     font := font1);
      | GraphCode.DefaultFont =>
          RETURN NEW(ValFont, what := "<a GraphVBT.WorldFont>",
                     tag := "GraphVBT`WorldFont", picklable := FALSE,
                     font := GraphVBT.DefaultFont);

      | GraphCode.NewSpectrum =>
          TYPECASE args[1] OF
          | ValGraph (node) => gr1 := node.vbt;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN NEW(ValSpectrum, what := "<a GraphVBT.Spectrum>",
                     tag := "GraphVBT`Spectrum", picklable := FALSE,
                     graph := gr1,
                     spectrum := NEW(PaintOpAnim.T).init(Color.Black));
      | GraphCode.SetSpectrumColor =>
          TYPECASE args[1] OF
          | ValSpectrum (node) => sp1 := node;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObLibUI.ValColor (node) => cl1 := node;
          ELSE
            ObValue.BadArgType(2, "color", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          sp1.spectrum.set(sp1.graph, cl1.color);
          RETURN ObValue.valOk;
      | GraphCode.SetSpectrumRange =>
          TYPECASE args[1] OF
          | ValSpectrum (node) => sp1 := node;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          TYPECASE args[2] OF
          | ObValue.ValFun (node) => fun1 := node;
          ELSE
            ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          sp1.spectrum.animate(
            sp1.graph, NEW(SpectrumClosure, fun := fun1, location := loc));
          RETURN ObValue.valOk;

      | GraphCode.Show =>
          TYPECASE args[1] OF
          | ValGraph (node) =>
              IF node.shown THEN
                ObValue.BadArgVal(
                  1, "not already shown", self.name, opCode.name, loc); <*ASSERT FALSE*>
              END;
              node.shown := TRUE;
              Trestle.Install(node.vbt);
              NARROW(node.vbt, GraphVBT.T).redisplay();
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN ObValue.valOk;
      | GraphCode.Hide =>
          TYPECASE args[1] OF
          | ValGraph (node) =>
              IF node.shown THEN
                node.shown := FALSE;
                Trestle.Delete(node.vbt);
              END;
          ELSE
            ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*>
          END;
          RETURN ObValue.valOk;
      ELSE
        ObValue.BadOp(self.name, opCode.name, loc); <*ASSERT FALSE*>
      END;
    EXCEPT
    | TrestleComm.Failure =>
        ObValue.RaiseException(graphException, opCode.name, loc); <*ASSERT FALSE*>
    | NetObj.Error (atoms) =>
        ObValue.RaiseNetException(
          self.name & "_" & opCode.name, atoms, loc); <*ASSERT FALSE*>
    | Thread.Alerted =>
        ObValue.RaiseException(
          ObValue.threadAlerted, self.name & "_" & opCode.name, loc); <*ASSERT FALSE*>
    END;
  END EvalGraph;

TYPE
  SpectrumClosure = PaintOpAnim.Animation OBJECT
                      fun     : ObValue.ValFun;
                      location: SynLocation.T;
                    OVERRIDES
                      rgb := SpectrumRangeClosure;
                    END;

PROCEDURE SpectrumRangeClosure (self: SpectrumClosure; t: REAL): Color.T
  RAISES {} =
  (* Can't produce any good error messages because it must raise {} *)
  VAR
    v   : ObValue.Val;
    args: ARRAY [0 .. 0] OF ObValue.Val;
  BEGIN
    TRY
      args[0] :=
        NEW(ObValue.ValReal, real := FLOAT(t, LONGREAL), temp := FALSE);
      v := ObEval.Call(self.fun, args, self.location);
      TYPECASE v OF
      | ObLibUI.ValColor (node) => RETURN node.color;
      | ValSpectrum (node) => RETURN node.spectrum.get();
      ELSE
        ObValue.RaiseError(
          "argument of graph_setSpectrumRange must return a color",
          self.location);        <*ASSERT FALSE*>
      END;
    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);
        RETURN Color.Black;
    | 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);
        RETURN Color.Black;
    END;
  END SpectrumRangeClosure;

TYPE
  MoveClosure = GraphVBT.AnimationPath OBJECT
                  fun     : ObValue.ValFun;
                  location: SynLocation.T;
                OVERRIDES
                  pos := MoveOnPathClosure;
                END;

PROCEDURE MoveOnPathClosure (self: MoveClosure; t: REAL): R2.T RAISES {} =
  (* Can't produce any good error messages because it must raise {} *)
  VAR
    v, vx, vy: ObValue.Val;
    rx, ry   : REAL;
    args     : ARRAY [0 .. 0] OF ObValue.Val;
  BEGIN
    TRY
      args[0] :=
        NEW(ObValue.ValReal, real := FLOAT(t, LONGREAL), temp := FALSE);
      v := ObEval.Call(self.fun, args, self.location);
      TYPECASE v OF
      | ObValue.ValArray (node) =>
          TRY
            vx := node.remote.Get(0);
            vy := node.remote.Get(1);
          EXCEPT
          | ObValue.ServerError (msg) =>
              ObValue.RaiseError(msg, self.location);
          | NetObj.Error (atoms) =>
              ObValue.RaiseNetException(
                "on remote array access", atoms, self.location);
          | Thread.Alerted =>
              ObValue.RaiseException(
                ObValue.threadAlerted, "on remote array access",
                self.location);
          END;
      ELSE
        ObValue.RaiseError(
          "argument of graph_moveOnPath must return an array(2,real)",
          self.location);
      END;
      TYPECASE vx OF
      | ObValue.ValReal (node) => rx := FLOAT(node.real, REAL);
      ELSE
        ObValue.RaiseError(
          "argument of graph_moveOnPath must return an array(2,real)",
          self.location);
      END;
      TYPECASE vy OF
      | ObValue.ValReal (node) => ry := FLOAT(node.real, REAL);
      ELSE
        ObValue.RaiseError(
          "argument of graph_moveOnPath must return an array(2,real)",
          self.location);
      END;
      RETURN R2.T{rx, ry};
    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);
        RETURN R2.T{0.0, 0.0};
    | 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);
        RETURN R2.T{0.0, 0.0};
    END;
  END MoveOnPathClosure;

PROCEDURE ExtractColor (ob          : ObValue.Val;
                        argNo       : INTEGER;
                        name, opName: TEXT;
                        loc         : SynLocation.T): PaintOp.T
  RAISES {ObValue.Error} =
  BEGIN
    TYPECASE ob OF
    | ObLibUI.ValColor (node) =>
        RETURN PaintOp.FromRGB(node.color.r, node.color.g, node.color.b,
                               mode := PaintOp.Mode.Accurate);
    | ValSpectrum (node) => RETURN node.spectrum.op();
    ELSE
      ObValue.BadArgType(argNo, "color or spectrum", name, opName, loc); <*ASSERT FALSE*>
    END;
  END ExtractColor;

PROCEDURE ExtractSlant (slant: TEXT): GraphVBT.Slant =
  BEGIN
    IF Text.Equal(slant, "Roman") THEN
      RETURN GraphVBT.Slant.Roman;
    ELSIF Text.Equal(slant, "Italic") THEN
      RETURN GraphVBT.Slant.Italic;
    ELSIF Text.Equal(slant, "Oblique") THEN
      RETURN GraphVBT.Slant.Oblique;
    ELSIF Text.Equal(slant, "ReverseItalic") THEN
      RETURN GraphVBT.Slant.ReverseItalic;
    ELSIF Text.Equal(slant, "ReverseOblique") THEN
      RETURN GraphVBT.Slant.ReverseOblique;
    ELSIF Text.Equal(slant, "Other") THEN
      RETURN GraphVBT.Slant.Other;
    ELSIF Text.Equal(slant, "Any") THEN
      RETURN GraphVBT.Slant.Any;
    ELSE
      RETURN GraphVBT.Slant.Roman;
    END;
  END ExtractSlant;

PROCEDURE Mouse (self: Graph; READONLY cd: VBT.MouseRec) =
  VAR
    r2  : R2.T;
    args: ARRAY [0 .. 2] OF ObValue.Val;
  BEGIN
    TRY
      IF (cd.clickType = VBT.ClickType.FirstDown) AND (cd.clickCount = 0) THEN
        IF self.clickAction = NIL THEN RETURN END;
        r2 := GraphVBTExtras.ScreenPtToWorldPos(self, cd.cp.pt);
        args[0] := self.valGraph;
        args[1] := NEW(ObValue.ValReal, real := FLOAT(r2[0], LONGREAL),
                       temp := FALSE);
        args[2] := NEW(ObValue.ValReal, real := FLOAT(r2[1], LONGREAL),
                       temp := FALSE);
        EVAL ObEval.Call(
               self.clickAction, args, self.clickAction.fun.location);
      ELSIF (cd.clickType = VBT.ClickType.LastUp) AND (cd.clickCount <= 1) THEN
        IF self.clickReleaseAction = NIL THEN RETURN END;
        r2 := GraphVBTExtras.ScreenPtToWorldPos(self, cd.cp.pt);
        args[0] := self.valGraph;
        args[1] := NEW(ObValue.ValReal, real := FLOAT(r2[0], LONGREAL),
                       temp := FALSE);
        args[2] := NEW(ObValue.ValReal, real := FLOAT(r2[1], LONGREAL),
                       temp := FALSE);
        EVAL ObEval.Call(self.clickReleaseAction, args,
                         self.clickReleaseAction.fun.location);
      ELSIF (cd.clickType = VBT.ClickType.FirstDown)
              AND (cd.clickCount = 2) THEN
        IF self.doubleClickAction = NIL THEN RETURN END;
        r2 := GraphVBTExtras.ScreenPtToWorldPos(self, cd.cp.pt);
        args[0] := self.valGraph;
        args[1] := NEW(ObValue.ValReal, real := FLOAT(r2[0], LONGREAL),
                       temp := FALSE);
        args[2] := NEW(ObValue.ValReal, real := FLOAT(r2[1], LONGREAL),
                       temp := FALSE);
        EVAL ObEval.Call(self.doubleClickAction, args,
                         self.doubleClickAction.fun.location);
      END;
    EXCEPT
    | ObValue.Error (packet) =>
        SynWr.Text(
          SynWr.out,
          "*** a graph_ click action caused an Obliq error: ***\n");
        ObValue.ErrorMsg(SynWr.out, packet);
        SynWr.Flush(SynWr.out);
    | ObValue.Exception (packet) =>
        SynWr.Text(
          SynWr.out,
          "*** a graph_ click action caused an Obliq exception: ***\n");
        ObValue.ExceptionMsg(SynWr.out, packet);
        SynWr.Flush(SynWr.out);
    END;
  END Mouse;

PROCEDURE WorldRectToScreenRect (world     : GraphVBT.WorldRectangle;
                                 domain    : Rect.T;
                                 w, e, n, s: LONGREAL                 ):
  Rect.T =
  VAR
    domainWidth, domainHeight, worldWidth, worldHeight: REAL;
    r                                                 : Rect.T;
  BEGIN
    domainWidth := FLOAT(domain.east) - FLOAT(domain.west);
    domainHeight := FLOAT(domain.south) - FLOAT(domain.north);
    worldWidth := world.e - world.w;
    worldHeight := world.s - world.n;
    IF (worldWidth = 0.0) OR (worldHeight = 0.0) THEN
      RETURN Rect.Empty
    END;
    r := Rect.T{
           west := domain.west + ROUND((FLOAT(w) - world.w) * domainWidth
                                         / worldWidth), east :=
           domain.west
             + ROUND((FLOAT(e) - world.w) * domainWidth / worldWidth),
           north := domain.north + ROUND((FLOAT(n) - world.n)
                                           * domainHeight / worldHeight),
           south := domain.north + ROUND((FLOAT(s) - world.n)
                                           * domainHeight / worldHeight)};
    IF r.east = r.west THEN r.east := r.east + 1 END;
    IF r.north = r.south THEN r.south := r.south + 1 END;
    RETURN r;
  END WorldRectToScreenRect;
============ zeus package ============

TYPE

  ZeusCode =
    {Error, Animate};

  ZeusOpCode =
    ObLib.OpCode OBJECT
        code: ZeusCode;
      END;

  PackageZeus =
    ObLib.T OBJECT
      OVERRIDES
        Eval:=EvalZeus;
      END;

  VAR zeusException: ObValue.ValException;

  PROCEDURE SetupZeus() =
  TYPE OpCodes = ARRAY OF ObLib.OpCode;
  VAR opCodes: REF OpCodes;
  BEGIN
    opCodes := NEW(REF OpCodes, NUMBER(ZeusCode));
    opCodes^ :=
      OpCodes{
      NEW(ZeusOpCode, name:="failure", arity:=-1, code:=ZeusCode.Error),
      NEW(ZeusOpCode, name:="animate",
          arity:=3, code:=ZeusCode.Animate)
      };
    ObLib.Register(
      NEW(PackageZeus, name:="zeus", opCodes:=opCodes));
    zeusException := NEW(ObValue.ValException, name:="zeus_failure");
  END SetupZeus;

  PROCEDURE EvalZeus(self: PackageZeus; opCode: ObLib.OpCode;
                     <*UNUSED*>arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
                     <*UNUSED*>temp: BOOLEAN; loc: SynLocation.T)
      : ObValue.Val RAISES {ObValue.Error, ObValue.Exception} =
    VAR gr1: Graph; real1, real2: LONGREAL;
    BEGIN
      TRY
      CASE NARROW(opCode, ZeusOpCode).code OF
      | ZeusCode.Error =>
          RETURN graphException;
      | ZeusCode.Animate =>
          TYPECASE args[1] OF | ValGraph(node) => gr1:=node.vbt;
          ELSE ObValue.BadArgType(1, "graph", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); <*ASSERT FALSE*> END;
          gr1.animate(FLOAT(real1), FLOAT(real2));
          RETURN ObValue.valOk;
      END;
      EXCEPT
      | Thread.Alerted =>
          ObValue.RaiseException(ObValue.threadAlerted,
                               self.name&"_"&opCode.name,loc);<*ASSERT FALSE*>
      END;
    END EvalZeus;

BEGIN
END ObLibAnim.

interface GraphVBT is in: