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.