obliqlibanim/src/ObLibAnim.m3


Copyright (C) 1994, Digital Equipment Corp.

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;
      arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
      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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); 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); END;
          TYPECASE args[2] OF | ObLibUI.ValColor(node) => clr1:=node.color;
          ELSE ObValue.BadArgType(2, "color", self.name, opCode.name, loc); 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>", 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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", 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;
          IF int1<0 THEN
            ObValue.BadArgVal(2, "non-negative", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", 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;
          IF int1<0 THEN
            ObValue.BadArgVal(2, "non-negative", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObLibUI.ValColor(node) => clr1:=node.color;
          ELSE ObValue.BadArgType(3, "color", 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;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); END;
          TYPECASE args[6] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(6, "real", self.name, opCode.name, loc); END;
          TYPECASE args[7] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(4, "bool", self.name, opCode.name, loc); END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          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); END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          IF (int1<0) OR (int1>rs1.n) THEN
            ObValue.BadArgVal(2, "in range", self.name, opCode.name, loc);
          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);
            END;
            node.shown := TRUE;
            Trestle.Install(node.vbt);
            NARROW(node.vbt,RectsVBT.T).redisplay();
          ELSE ObValue.BadArgType(1, "rects", self.name, opCode.name, loc);
          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);
          END;
          RETURN ObValue.valOk;
      END;
      EXCEPT
      | TrestleComm.Failure =>
        ObValue.RaiseException(rectsException, opCode.name, loc);
      | NetObj.Error(atoms) =>
              ObValue.RaiseNetException(
                               self.name&"_"&opCode.name, atoms, loc);
      | Thread.Alerted =>
          ObValue.RaiseException(ObValue.threadAlerted,
                               self.name&"_"&opCode.name,loc);
      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;
      arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
      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,
                     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) 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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc) END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); 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) 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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); 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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); 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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); 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) END;
          TYPECASE args[2] OF | ObValue.ValInt(node) => int1:=node.int;
          ELSE ObValue.BadArgType(2, "int", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValInt(node) => int2:=node.int;
          ELSE ObValue.BadArgType(3, "int", self.name, opCode.name, loc); 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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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>",
                           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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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>",
                           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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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>",
                           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) END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValReal(node) => real3:=node.real;
          ELSE ObValue.BadArgType(4, "real", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValReal(node) => real4:=node.real;
          ELSE ObValue.BadArgType(5, "real", self.name, opCode.name, loc); 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>",
                           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) 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) 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) END;
          TYPECASE args[2] OF | ObValue.ValFun(node) => fun1:=node;
          ELSE ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc); 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); 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);
          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); END;
          v1 :=NEW(GraphVBT.Vertex, graph:=gr1).init();
          RETURN NEW(ValVertex, what:="<a 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", 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;
          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); END;
          TYPECASE args[2] OF | ObValue.ValFun(node) => fun1:=node;
          ELSE ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc); 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); 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); 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); 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); 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); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); 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);
          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); 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); END;
          TYPECASE args[2] OF | ValFont(node) => font1:=node.font;
          ELSE ObValue.BadArgType(2, "font", self.name, opCode.name, loc); 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); END;
          TYPECASE args[2] OF | ObValue.ValText(node) => text1:=node.text;
          ELSE ObValue.BadArgType(2, "text", self.name, opCode.name, loc); 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); 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); 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); 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)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); END;
          vh1 :=NEW(GraphVBT.VertexHighlight, vertex:=v1).init();
          RETURN NEW(ValVertexHiLi, what:="<a 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); END;
          TYPECASE args[2] OF | ValVertex(node) => v1:=node.vertex;
          ELSE ObValue.BadArgType(2, "vertex", 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;
          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); 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); 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); 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); 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); 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); END;
          RETURN NEW(ValVertex, what:="<a 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); END;
          TYPECASE args[2] OF | ValVertex(node) => v2:=node.vertex;
          ELSE ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); END;
          e1 :=NEW(GraphVBT.Edge, vertex0:=v1, vertex1:=v2).init();
          RETURN NEW(ValEdge, what:="<a 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); END;
          TYPECASE args[2] OF | ValVertex(node) => v1:=node.vertex;
          ELSE ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ValVertex(node) => v2:=node.vertex;
          ELSE ObValue.BadArgType(3, "vertex", 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;
          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); END;
          TYPECASE args[2] OF | ValVertex(node) => v1:=node.vertex;
          ELSE ObValue.BadArgType(2, "vertex", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ValVertex(node) => v2:=node.vertex;
          ELSE ObValue.BadArgType(3, "vertex", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ValVertex(node) => v3:=node.vertex;
          ELSE ObValue.BadArgType(4, "vertex", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ValVertex(node) => v4:=node.vertex;
          ELSE ObValue.BadArgType(5, "vertex", self.name, opCode.name, loc); END;
          TYPECASE args[6] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(6, "bool", self.name, opCode.name, loc); 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); 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); 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); 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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); 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); 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); END;
          TYPECASE args[2] OF | ObValue.ValBool(node) => bool1:=node.bool;
          ELSE ObValue.BadArgType(2, "bool", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValBool(node) => bool2:=node.bool;
          ELSE ObValue.BadArgType(3, "bool", self.name, opCode.name, loc); 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); END;
          ar1 := NEW(REF ARRAY OF ObValue.Val, 2);
          ar1^[0] :=
              NEW(ValVertex, what:="<a GraphVBT.Vertex>",
                  picklable:=FALSE, vertex:=e1.vertex0);
          ar1^[1] :=
              NEW(ValVertex, what:="<a 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); 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>",
                  picklable:=FALSE, vertex:=e1.control0);
            ar1^[1] :=
              NEW(ValVertex, what:="<a 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); 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);
            END;
          END;
          p1 :=NEW(GraphVBT.Polygon, vertices:=list).init();
          RETURN NEW(ValPolygon, what:="<a 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); END;
          TYPECASE args[2] OF
          | ObValue.ValArray(node) => array1:=node.remote.Obtain();
          ELSE ObValue.BadArgType(2, "array", 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;
          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);
            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); 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); 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); 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); 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); 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.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          TYPECASE args[4] OF | ObValue.ValText(node) => text2:=node.text;
          ELSE ObValue.BadArgType(4, "text", self.name, opCode.name, loc); END;
          TYPECASE args[5] OF | ObValue.ValText(node) => text3:=node.text;
          ELSE ObValue.BadArgType(5, "text", self.name, opCode.name, loc); END;
          TYPECASE args[6] OF | ObValue.ValText(node) => text4:=node.text;
          ELSE ObValue.BadArgType(6, "text", self.name, opCode.name, loc); END;
          font1 :=
              gr1.font(text1, FLOAT(real1), ExtractSlant(text2), text3, text4);
          RETURN NEW(ValFont, what:="<a GraphVBT.WorldFont>",
            picklable:=FALSE, font:=font1);
      | GraphCode.DefaultFont =>
          RETURN NEW(ValFont, what:="<a 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) END;
          RETURN
            NEW(ValSpectrum, what:="<a 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) END;
          TYPECASE args[2] OF | ObLibUI.ValColor(node) => cl1:=node;
          ELSE ObValue.BadArgType(2, "color", self.name, opCode.name, loc) 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) END;
          TYPECASE args[2] OF | ObValue.ValFun(node) => fun1:=node;
          ELSE ObValue.BadArgType(2, "procedure", self.name, opCode.name, loc); 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);
            END;
            node.shown := TRUE;
            Trestle.Install(node.vbt);
            NARROW(node.vbt,GraphVBT.T).redisplay();
          ELSE ObValue.BadArgType(1, "graph", self.name, opCode.name, loc);
          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);
          END;
          RETURN ObValue.valOk;
      ELSE
        ObValue.BadOp(self.name, opCode.name, loc);
      END;
      EXCEPT
      | TrestleComm.Failure =>
        ObValue.RaiseException(graphException, opCode.name, loc);
      | NetObj.Error(atoms) =>
              ObValue.RaiseNetException(
                               self.name&"_"&opCode.name, atoms, loc);
      | Thread.Alerted =>
          ObValue.RaiseException(ObValue.threadAlerted,
                               self.name&"_"&opCode.name,loc);
      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);
        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);
          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);
    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;
      arity: ObLib.OpArity; READONLY args: ObValue.ArgArray;
      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); END;
          TYPECASE args[2] OF | ObValue.ValReal(node) => real1:=node.real;
          ELSE ObValue.BadArgType(2, "real", self.name, opCode.name, loc); END;
          TYPECASE args[3] OF | ObValue.ValReal(node) => real2:=node.real;
          ELSE ObValue.BadArgType(3, "real", self.name, opCode.name, loc); END;
          gr1.animate(FLOAT(real1), FLOAT(real2));
          RETURN ObValue.valOk;
      END;
      EXCEPT
      | TrestleComm.Failure =>
        ObValue.RaiseException(zeusException, opCode.name, loc);
      | NetObj.Error(atoms) =>
              ObValue.RaiseNetException(
                               self.name&"_"&opCode.name, atoms, loc);
      | Thread.Alerted =>
          ObValue.RaiseException(ObValue.threadAlerted,
                               self.name&"_"&opCode.name,loc);
      END;
    END EvalZeus;

BEGIN
END ObLibAnim.