gef/src/GEFA.m3


Copyright (C) 1994, Digital Equipment Corp.

MODULE GEFA EXPORTS GEF, GEFInternal;

IMPORT Animate, AnimationPath, Fmt, GEFClass, GEFError, GraphAnim,
       GraphVBT, RefList, RefListUtils, Math, R2, Thread;

<* PRAGMA LL *>

<* FATAL Fatal *>
EXCEPTION Fatal;

TYPE
  ParseObject = GEFClass.ParseObject;

TYPE
  FramePO = ParseObject OBJECT
            OVERRIDES
              create  := FrameCreate;
              delete  := FrameDelete;
              getId   := FrameGetId;
              setElem := FrameSetElem;
              setReal := FrameSetReal;
              finish  := FrameFinish;
              isType  := FrameIsType;
            END;

TYPE
  FrameFieldType = {Time, Actions};

  Frame = OBJECT
    id: INTEGER;
    start, end: REAL;
  END;

PROCEDURE FrameCreate (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                                    id: INTEGER      ): REFANY =
  BEGIN
    RETURN NEW(Frame, id := id);
  END FrameCreate;

PROCEDURE FrameDelete (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                       <* UNUSED *> elem: GEFClass.Elem) =
  BEGIN
  END FrameDelete;

PROCEDURE FrameGetId (<* UNUSED *> po  : ParseObject;
                      <* UNUSED *> t   : T;
                                   elem: REFANY       ): INTEGER =
  BEGIN
    RETURN NARROW(elem, Frame).id
  END FrameGetId;

PROCEDURE FrameFinish (<* UNUSED *> po: ParseObject; t: T; elem: REFANY)
  RAISES {Thread.Alerted} =
  VAR frame := NARROW(elem, Frame);
  BEGIN
    Animate.ResetATime();
    t.animate(frame.start, frame.end);
  END FrameFinish;

PROCEDURE FrameIsType (<* UNUSED *> po: ParseObject; elem: REFANY):
  BOOLEAN =
  BEGIN
    RETURN ISTYPE(elem, Frame);
  END FrameIsType;

PROCEDURE FrameSetReal (<* UNUSED *> po    : ParseObject;
                        <* UNUSED *> t     : T;
                                     elem  : REFANY;
                                     field : INTEGER;
                                     values: GEFClass.Reals)
  RAISES {GEFError.T} =
  VAR frame := NARROW(elem, Frame);
  BEGIN
    CASE VAL(field, FrameFieldType) OF
    | FrameFieldType.Time =>
        frame.start := values[0];
        frame.end := values[1];
    ELSE
      RAISE Fatal;
    END;
  END FrameSetReal;

PROCEDURE FrameSetElem (<* UNUSED *> po    : ParseObject;
                        <* UNUSED *> t     : T;
                        <* UNUSED *> elem  : REFANY;
                        <* UNUSED *> field : INTEGER;
                        <* UNUSED *> values: GEFClass.Elems)
  RAISES {GEFError.T} =
  BEGIN
  END FrameSetElem;

TYPE
  MovePO = ParseObject OBJECT
           OVERRIDES
             create  := MoveCreate;
             delete  := MoveDelete;
             getId   := MoveGetId;
             setElem := MoveSetElem;
             setReal := MoveSetReal;
             setBool := MoveSetBool;
             finish  := MoveFinish;
             isType  := MoveIsType;
           END;

TYPE
  MoveFieldType = {Elements, Pos, Animate, Path};

  Move = OBJECT
    id: INTEGER;
    vertices: RefList.T (* OF GraphVBT.Vertex *);
    pos: R2.T;
    animate: BOOLEAN;
    edges: RefList.T (* OF GraphVBT.Edge *)
  END;

PROCEDURE MoveCreate (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                                    id: INTEGER      ): REFANY =
  BEGIN
    RETURN NEW(Move, id := id);
  END MoveCreate;

PROCEDURE MoveDelete (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                       <* UNUSED *> elem: GEFClass.Elem) =
  BEGIN
  END MoveDelete;

PROCEDURE MoveGetId (<* UNUSED *> po  : ParseObject;
                     <* UNUSED *> t   : T;
                                  elem: REFANY       ): INTEGER =
  BEGIN
    RETURN NARROW(elem, Move).id
  END MoveGetId;

PROCEDURE MoveFinish (<* UNUSED *> po  : ParseObject;
                      <* UNUSED *> t   : T;
                                   elem: REFANY       )
  RAISES {GEFError.T} =
  VAR
    move                                   := NARROW(elem, Move);
    l     : RefList.T;
    vertex: GraphVBT.Vertex;
    path  : AnimationPath.MultipleEdgePath;
  BEGIN
    IF move.vertices = NIL THEN
      RAISE GEFError.T("No elements given to \"Move\"");
    END;
    IF move.animate AND move.edges # NIL THEN
      GraphAnim.MoveAlongEdges(move.edges, move.vertices);
    ELSE
      IF move.edges # NIL THEN
        path := NEW(AnimationPath.MultipleEdgePath).init(move.edges)
      ELSE
        path := NIL;
      END;
      l := move.vertices;
      WHILE l # NIL DO
        vertex := RefListUtils.Pop(l);
        vertex.move(move.pos, move.animate, path := path);
      END;
    END;
  END MoveFinish;

PROCEDURE MoveIsType (<* UNUSED *> po: ParseObject; elem: REFANY):
  BOOLEAN =
  BEGIN
    RETURN ISTYPE(elem, Move);
  END MoveIsType;

PROCEDURE MoveSetBool (<* UNUSED *> po    : ParseObject;
                       <* UNUSED *> t     : T;
                                    elem  : REFANY;
                                    field : INTEGER;
                                    values: GEFClass.Bools)
  RAISES {GEFError.T} =
  VAR move := NARROW(elem, Move);
  BEGIN
    CASE VAL(field, MoveFieldType) OF
    | MoveFieldType.Animate => move.animate := values[0]
    ELSE
      RAISE Fatal;
    END;
  END MoveSetBool;

PROCEDURE MoveSetReal (<* UNUSED *> po    : ParseObject;
                       <* UNUSED *> t     : T;
                                    elem  : REFANY;
                                    field : INTEGER;
                                    values: GEFClass.Reals)
  RAISES {GEFError.T} =
  VAR move := NARROW(elem, Move);
  BEGIN
    CASE VAL(field, MoveFieldType) OF
    | MoveFieldType.Pos => move.pos := R2.T{values[0], values[1]};
    ELSE
      RAISE Fatal;
    END;
  END MoveSetReal;

PROCEDURE PushEdge (VAR l: RefList.T; edge: GraphVBT.Edge) =
  BEGIN
    RefListUtils.Push(l, edge.vertex0);
    RefListUtils.Push(l, edge.vertex1);
    IF edge.control0 # NIL THEN
      RefListUtils.Push(l, edge.control0);
      RefListUtils.Push(l, edge.control1);
    END;
  END PushEdge;

PROCEDURE VertexList (values: GEFClass.Elems): RefList.T RAISES {GEFError.T} =
  VAR l: RefList.T;
  BEGIN
    FOR i := 0 TO LAST(values^) DO
      TYPECASE values[i] OF
      | GraphVBT.Vertex (v) => RefListUtils.Push(l, v);
      | GraphVBT.Edge (e) => PushEdge(l, e);
      | GraphVBT.Polygon (p) =>
          l := RefList.Append(l, p.vertices);
      | Arc (a) =>
          FOR i := 0 TO LAST(a.edges^) DO
            PushEdge(l, a.edges[i]);
          END;
      ELSE
        RAISE
          GEFError.T(
            "Element of unknown type found in \"Move\" or \" Rotate\"");
      END;
    END;
    RETURN l;
  END VertexList;

PROCEDURE MoveSetElem (<* UNUSED *> po    : ParseObject;
                       <* UNUSED *> t     : T;
                                    elem  : REFANY;
                                    field : INTEGER;
                                    values: GEFClass.Elems)
  RAISES {GEFError.T} =
  VAR
    move         := NARROW(elem, Move);
    l   : RefList.T;
  BEGIN
    CASE VAL(field, MoveFieldType) OF
    | MoveFieldType.Elements =>
        move.vertices := VertexList(values);
    | MoveFieldType.Path =>
        CASE NUMBER(values^) OF
        | 0 => RETURN
        | 1 =>
            TYPECASE values[0] OF
            | NULL => RAISE GEFError.T("Path given to Move is NIL");
            | GraphVBT.Edge (e) =>
                RefListUtils.Push(l, e);
                move.edges := l;
                move.pos := e.vertex1.pos;
            | Arc (arc) =>
                FOR i := LAST(arc.edges^) TO 0 BY -1 DO
                  RefListUtils.Push(l, arc.edges[i]);
                END;
                move.pos := NARROW(arc.edges[LAST(arc.edges^)],
                                   GraphVBT.Edge).vertex1.pos;
                move.edges := l;
            ELSE
              RAISE GEFError.T("Path given to Move is not an edge");
            END;
        ELSE
          FOR i := NUMBER(values^) - 1 TO 0 BY -1 DO
            TYPECASE values[i] OF
            | NULL => RAISE GEFError.T("Path given to Move is NIL");
            | GraphVBT.Edge (e) => RefListUtils.Push(l, e);
            | Arc (arc) =>
                FOR i := LAST(arc.edges^) TO 0 BY -1 DO
                  RefListUtils.Push(l, arc.edges[i]);
                END;
            ELSE
              RAISE GEFError.T("Path given to Move is not an edge");
            END;
          END;
          move.pos :=
            NARROW(values[LAST(values^)], GraphVBT.Edge).vertex1.pos;
          move.edges := l;
        END;
    ELSE
      RAISE Fatal;
    END;
  END MoveSetElem;

TYPE
  RotatePO = ParseObject OBJECT
             OVERRIDES
               create  := RotateCreate;
               delete  := RotateDelete;
               getId   := RotateGetId;
               setElem := RotateSetElem;
               setReal := RotateSetReal;
               setBool := RotateSetBool;
               finish  := RotateFinish;
               isType  := RotateIsType;
             END;

TYPE
  RotateFieldType = {Center, Elements, Angle, Ends, Clockwise};

  Rotate = OBJECT
             id         : INTEGER;
             vertices   : RefList.T (* OF GraphVBT.Vertex *);
             center     : GraphVBT.Vertex;
             angle      : REAL;
             clockwise  : BOOLEAN;
             start, stop: GraphVBT.Vertex;
           END;

PROCEDURE RotateCreate (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                                    id: INTEGER      ): REFANY =
  BEGIN
    RETURN NEW(Rotate, id := id);
  END RotateCreate;

PROCEDURE RotateDelete (<* UNUSED *> po: ParseObject;
                       <* UNUSED *> t : T;
                       <* UNUSED *> elem: GEFClass.Elem) =
  BEGIN
  END RotateDelete;

PROCEDURE RotateGetId (<* UNUSED *> po  : ParseObject;
                     <* UNUSED *> t   : T;
                                  elem: REFANY       ): INTEGER =
  BEGIN
    RETURN NARROW(elem, Rotate).id
  END RotateGetId;

PROCEDURE Angle (center, pt: Vertex): REAL =
  VAR
    angle := 180.0 * FLOAT(
               Math.atan2(FLOAT(pt.pos[0] - center.pos[0], LONGREAL),
                          FLOAT(pt.pos[1] - center.pos[1], LONGREAL)))
               / Math.Pi;
  BEGIN
    RETURN angle
  END Angle;

PROCEDURE RotateFinish (<* UNUSED *> po  : ParseObject;
                        <* UNUSED *> t   : T;
                                     elem: REFANY       )
  RAISES {GEFError.T} =
  VAR
    rotate       := NARROW(elem, Rotate);
    angle : REAL;
  BEGIN
    IF rotate.center = NIL THEN
      RAISE GEFError.T("No center give for rotation");
    END;
    IF rotate.start # NIL THEN
      IF rotate.stop = NIL THEN RAISE GEFError.T("Stop endpoint to \"Rotate\" is NIL"); END;
      WITH start = Angle(rotate.center, rotate.start),
           stop  = Angle(rotate.center, rotate.stop)   DO
        angle := stop - start;
        IF rotate.clockwise THEN
          IF angle > 0.0 THEN angle := angle - 360.0 END;
          GraphAnim.Rotate(rotate.center, angle, rotate.vertices);
        ELSE
          IF angle < 0.0 THEN angle := angle + 360.0 END;
          GraphAnim.Rotate(rotate.center, angle, rotate.vertices);
        END;
      END;
    ELSE
      IF rotate.stop # NIL THEN RAISE GEFError.T("Start endpoint to \"Rotate\" is NIL"); END;
      GraphAnim.Rotate(rotate.center, rotate.angle, rotate.vertices);
    END;
  END RotateFinish;

PROCEDURE RotateIsType (<* UNUSED *> po: ParseObject; elem: REFANY):
  BOOLEAN =
  BEGIN
    RETURN ISTYPE(elem, Rotate);
  END RotateIsType;

PROCEDURE RotateSetReal (<* UNUSED *> po    : ParseObject;
                         <* UNUSED *> t     : T;
                                      elem  : REFANY;
                                      field : INTEGER;
                                      values: GEFClass.Reals)
  RAISES {GEFError.T} =
  VAR rotate := NARROW(elem, Rotate);
  BEGIN
    CASE VAL(field, RotateFieldType) OF
    | RotateFieldType.Angle => rotate.angle := values[0]
    ELSE
      RAISE Fatal;
    END;
  END RotateSetReal;

PROCEDURE RotateSetBool (<* UNUSED *> po    : ParseObject;
                         <* UNUSED *> t     : T;
                                      elem  : REFANY;
                                      field : INTEGER;
                                      values: GEFClass.Bools)
  RAISES {GEFError.T} =
  VAR rotate := NARROW(elem, Rotate);
  BEGIN
    CASE VAL(field, RotateFieldType) OF
    | RotateFieldType.Clockwise => rotate.clockwise := values[0]
    ELSE
      RAISE Fatal;
    END;
  END RotateSetBool;

PROCEDURE RotateSetElem (<* UNUSED *> po    : ParseObject;
                         <* UNUSED *> t     : T;
                                      elem  : REFANY;
                                      field : INTEGER;
                                      values: GEFClass.Elems)
  RAISES {GEFError.T} =
  VAR
    rotate         := NARROW(elem, Rotate);
  BEGIN
    CASE VAL(field, RotateFieldType) OF
    | RotateFieldType.Elements =>
        rotate.vertices := VertexList(values);
    | RotateFieldType.Center =>
        TYPECASE values[0] OF
        | NULL => RAISE GEFError.T("Center given to Rotate is NIL");
        | GraphVBT.Vertex (v) => rotate.center := v;
        ELSE
          RAISE GEFError.T("Center given to Rotate is not a vertex");
        END;
    | RotateFieldType.Ends =>
        TYPECASE values[0] OF
        | NULL =>
        | GraphVBT.Vertex (v) => rotate.start := v;
        ELSE
          RAISE GEFError.T("Endpoint given to Rotate is not a vertex");
        END;
        TYPECASE values[1] OF
        | NULL =>
        | GraphVBT.Vertex (v) => rotate.stop:= v;
        ELSE
          RAISE GEFError.T("Endpoint given to Rotate is not a vertex");
        END;
    ELSE
      RAISE Fatal;
    END;
  END RotateSetElem;

BEGIN
  GEFClass.RegisterParseObject(
    NEW(FramePO,
        args := "((Name Frame)"
                  & Fmt.F("(Field %s Time Real 2 (start stop) (0.0 1.0))",
                          Fmt.Int(ORD(FrameFieldType.Time)))
                  & Fmt.F("(Field %s Actions Elem Infinity () ()))",
                          Fmt.Int(ORD(FrameFieldType.Actions)))));

  GEFClass.RegisterParseObject(
    NEW(
      MovePO, args := "((Name Move)"
                        & Fmt.F("(Field %s Elements Elem Infinity () ())",
                                Fmt.Int(ORD(MoveFieldType.Elements)))
                        & Fmt.F("(Field %s Pos Real 2 (x y) (0.0 0.0))",
                                Fmt.Int(ORD(MoveFieldType.Pos)))
                        & Fmt.F("(Field %s Animate Boolean 1 () (TRUE))",
                                Fmt.Int(ORD(MoveFieldType.Animate)))
                        & Fmt.F("(Field %s Path Elem Infinity () ()))",
                                Fmt.Int(ORD(MoveFieldType.Path)))));

  GEFClass.RegisterParseObject(
    NEW(RotatePO,
        args :=
          "((Name Rotate)" & Fmt.F("(Field %s Center Elem 1 () ())",
                                   Fmt.Int(ORD(RotateFieldType.Center)))
            & Fmt.F("(Field %s Angle Real 1 () (360))",
                    Fmt.Int(ORD(RotateFieldType.Angle)))
            & Fmt.F("(Field %s Ends Elem 2 (start stop) ())",
                    Fmt.Int(ORD(RotateFieldType.Ends)))
            & Fmt.F("(Field %s Clockwise Boolean 1 () (TRUE))",
                    Fmt.Int(ORD(RotateFieldType.Clockwise)))
            & Fmt.F("(Field %s Elements Elem Infinity () ()))",
                    Fmt.Int(ORD(RotateFieldType.Elements)))));
END GEFA.

interface Math is in: