Copyright (C) 1994, Digital Equipment Corp.
MODULEGEFA EXPORTSGEF ,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; PROCEDUREFrameCreate (<* UNUSED *> po: ParseObject; <* UNUSED *> t : T; id: INTEGER ): REFANY = BEGIN RETURN NEW(Frame, id := id); END FrameCreate; PROCEDUREFrameDelete (<* UNUSED *> po: ParseObject; <* UNUSED *> t : T; <* UNUSED *> elem: GEFClass.Elem) = BEGIN END FrameDelete; PROCEDUREFrameGetId (<* UNUSED *> po : ParseObject; <* UNUSED *> t : T; elem: REFANY ): INTEGER = BEGIN RETURN NARROW(elem, Frame).id END FrameGetId; PROCEDUREFrameFinish (<* 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; PROCEDUREFrameIsType (<* UNUSED *> po: ParseObject; elem: REFANY): BOOLEAN = BEGIN RETURN ISTYPE(elem, Frame); END FrameIsType; PROCEDUREFrameSetReal (<* 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; PROCEDUREFrameSetElem (<* 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; PROCEDUREMoveCreate (<* UNUSED *> po: ParseObject; <* UNUSED *> t : T; id: INTEGER ): REFANY = BEGIN RETURN NEW(Move, id := id); END MoveCreate; PROCEDUREMoveDelete (<* UNUSED *> po: ParseObject; <* UNUSED *> t : T; <* UNUSED *> elem: GEFClass.Elem) = BEGIN END MoveDelete; PROCEDUREMoveGetId (<* UNUSED *> po : ParseObject; <* UNUSED *> t : T; elem: REFANY ): INTEGER = BEGIN RETURN NARROW(elem, Move).id END MoveGetId; PROCEDUREMoveFinish (<* 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; PROCEDUREMoveIsType (<* UNUSED *> po: ParseObject; elem: REFANY): BOOLEAN = BEGIN RETURN ISTYPE(elem, Move); END MoveIsType; PROCEDUREMoveSetBool (<* 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; PROCEDUREMoveSetReal (<* 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; PROCEDUREPushEdge (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; PROCEDUREVertexList (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; PROCEDUREMoveSetElem (<* 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; PROCEDURERotateCreate (<* UNUSED *> po: ParseObject; <* UNUSED *> t : T; id: INTEGER ): REFANY = BEGIN RETURN NEW(Rotate, id := id); END RotateCreate; PROCEDURERotateDelete (<* UNUSED *> po: ParseObject; <* UNUSED *> t : T; <* UNUSED *> elem: GEFClass.Elem) = BEGIN END RotateDelete; PROCEDURERotateGetId (<* UNUSED *> po : ParseObject; <* UNUSED *> t : T; elem: REFANY ): INTEGER = BEGIN RETURN NARROW(elem, Rotate).id END RotateGetId; PROCEDUREAngle (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; PROCEDURERotateFinish (<* 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; PROCEDURERotateIsType (<* UNUSED *> po: ParseObject; elem: REFANY): BOOLEAN = BEGIN RETURN ISTYPE(elem, Rotate); END RotateIsType; PROCEDURERotateSetReal (<* 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; PROCEDURERotateSetBool (<* 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; PROCEDURERotateSetElem (<* 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.