Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Wed Feb 16 14:15:37 PST 1994 by najork
MODULE RootGO EXPORTS RootGO, RootGOPrivate, RootGOProxy;
IMPORT AmbientLightGO, AnimServer, BooleanProp, BooleanPropPrivate, CameraGO,
CameraGOPrivate, Color, ColorProp, ColorPropPrivate, GO, GOPrivate,
GraphicsBase, GraphicsBasePrivate, GroupGO, GroupGOPrivate, MouseCB,
PerspCameraGO, Point, Point3, PositionCB, Prop, RealProp,
RealPropPrivate, TransformProp, VBT, VectorLightGO, X_PEX_Base;
REVEAL
T = Private BRANDED OBJECT
backgroundColor : Color.T; (* cached background color *)
OVERRIDES
init := Init;
changeCamera := ChangeCamera;
findName := FindName;
adjust := Adjust;
draw := Draw;
damageIfDependent := DamageIfDependent;
END;
PROCEDURE Init (self : T; cam : CameraGO.T; base : GraphicsBase.T) : T =
BEGIN
EVAL GroupGO.T.init (self);
self.cam := cam;
self.base := base;
base.root := self;
(* set the background color to a sentinel value, thereby triggering
an initial damage repair, i.e. proper background initialization ***)
self.backgroundColor := Color.T {-1.0, -1.0, -1.0};
(* Register to root with the animation server *)
AnimServer.RegisterRootGO (self);
IF MkProxyT # NIL THEN
MkProxyT (self);
END;
RETURN self;
END Init;
PROCEDURE ChangeCamera (self : T; cam : CameraGO.T) =
BEGIN
(*** Must be protected from interference with the animation server ***)
LOCK AnimServer.internalLock DO
self.cam := cam;
(*** damage the root, forcing a redraw ***)
self.damaged := TRUE;
END;
END ChangeCamera;
PROCEDURE FindName (self : T; name : TEXT) : GO.T =
BEGIN
IF self.cam.findName (name) # NIL THEN
RETURN self.cam;
ELSE
RETURN GroupGO.T.findName (self, name);
END;
END FindName;
PROCEDURE Adjust (self : T; time : LONGREAL) =
BEGIN
(*** Adjust self like any other root ... ***)
GroupGO.T.adjust (self, time);
(*** ... but also adjust the active camera ... ***)
self.cam.adjust (time);
(*** ... and propagate its damage up. ***)
IF self.cam.damaged THEN
self.damaged := TRUE;
END;
END Adjust;
PROCEDURE Draw (self : T; state : GraphicsBase.T) =
BEGIN
state.push (self);
(*** Take care of the background color ***)
WITH col = Background.getState (state) DO
IF self.backgroundColor # col THEN
self.backgroundColor := col;
state.setBackgroundColor (col);
END;
END;
(*** Take care of depth cueing ***)
WITH switch = DepthcueSwitch.getState (state),
fplane = DepthcueFrontPlane.getState (state),
bplane = DepthcueBackPlane.getState (state),
fscale = DepthcueFrontScale.getState (state),
bscale = DepthcueBackScale.getState (state),
color = DepthcueColour.getState (state) DO
state.setDepthcueing(switch, fplane, bplane, fscale, bscale, color);
END;
(*** Now do whatever has to be done for normal groups as well ***)
FOR i := 0 TO self.last DO
(* Calling draw may set self.damaged *)
self.children[i].draw (state);
END;
(*** Indicate that the damages have been repaired ***)
self.damaged := FALSE;
state.pop (self);
(* Test if the camera has been drawn (i.e. is part of the overall scene);
if this is not the case, draw it now. *)
IF NOT self.cam.flag THEN
(* Note that the order of the arguments to OR matters here!! *)
self.cam.draw (state);
END;
(*** As "caller" is NIL, we don't have to propagate self.damaged ***)
END Draw;
PROCEDURE DamageIfDependent (self : T; pn : Prop.Name) =
BEGIN
IF pn = Background OR pn = DepthcueSwitch OR pn = DepthcueColour OR
pn = DepthcueFrontPlane OR pn = DepthcueBackPlane OR
pn = DepthcueFrontScale OR pn = DepthcueBackScale THEN
self.damaged := TRUE;
END;
END DamageIfDependent;
***************************************************************************
Construction procedures
***************************************************************************
PROCEDURE New (cam : CameraGO.T; base : GraphicsBase.T) : T =
BEGIN
RETURN NEW(T).init(cam,base);
END New;
PROCEDURE NewStd (base : GraphicsBase.T) : T =
VAR
root : T;
cam := PerspCameraGO.New (from := Point3.T{0.0, 0.0, 100.0},
to := Point3.T{0.0, 0.0, 0.0},
up := Point3.T{0.0, 1.0, 0.0},
fovy := 0.05);
BEGIN
IF base = NIL THEN
base := NEW (X_PEX_Base.T).init ("Anim3D Viewer");
END;
cam.setName ("default-camera");
root := NEW (T).init (cam, base);
(* Attach two lights *)
WITH light = AmbientLightGO.New (Color.White) DO
light.setName ("default-ambient-light");
root.add (light);
END;
WITH light = VectorLightGO.New (Color.White, Point3.T{-1.0,-1.0,-1.0}) DO
light.setName ("default-vector-light");
root.add (light);
END;
(* Attach mouse and position callbacks to the root *)
root.setProp (GO.Transform.bind (TransformProp.NewConst ()));
root.pushMouseCB (NEW (MyMouseCB, go := root, invoke := MouseInvoke).init());
RETURN root;
END NewStd;
TYPE
MyPositionCB = PositionCB.T OBJECT
go : T;
pos : Point.T;
but : VBT.Button;
OVERRIDES
invoke := PositionInvoke;
END;
MyMouseCB = MouseCB.T OBJECT
go : T;
OVERRIDES
invoke := MouseInvoke;
END;
PROCEDURE PositionInvoke (self : MyPositionCB; pr : PositionCB.Rec) =
<* FATAL GO.PropUndefined *>
BEGIN
WITH d = Point.Sub (pr.pos2D, self.pos),
dx = FLOAT (d.h), dy = FLOAT (d.v),
beh = NARROW (GO.GetTransform(self.go).beh, TransformProp.ConstBeh) DO
IF VBT.Modifier.Shift IN pr.modifiers THEN
CASE self.but OF
| VBT.Modifier.MouseL => beh.translate (dx * 0.01, -dy * 0.01, 0.0);
| VBT.Modifier.MouseM => beh.scale (1.0 + dx * 0.01,
1.0 + dx * 0.01,
1.0 + dx * 0.01);
| VBT.Modifier.MouseR => beh.translate (0.0, 0.0, dx * 0.01);
ELSE
(* Mice have only three buttons those days ... *)
END;
ELSE
CASE self.but OF
| VBT.Modifier.MouseL => beh.rotateX (dx * 0.01);
| VBT.Modifier.MouseM => beh.rotateY (dx * 0.01);
| VBT.Modifier.MouseR => beh.rotateZ (dx * 0.01);
ELSE
(* Mice have only three buttons those days ... *)
END;
END;
END;
self.pos := pr.pos2D;
END PositionInvoke;
PROCEDURE MouseInvoke (self : MyMouseCB; mr : MouseCB.Rec) =
<* FATAL GO.StackError *>
BEGIN
IF mr.clickType = VBT.ClickType.FirstDown THEN
self.go.pushPositionCB (NEW (MyPositionCB,
go := self.go,
pos := mr.pos2D,
but := mr.whatChanged).init());
ELSIF mr.clickType = VBT.ClickType.LastUp THEN
self.go.popPositionCB ();
END;
END MouseInvoke;
***************************************************************************
Module body
***************************************************************************
BEGIN
Background := NEW (ColorProp.Name).init (Color.Black);
DepthcueColour := NEW (ColorProp.Name).init (Color.Black);
DepthcueFrontPlane := NEW (RealProp.Name).init (1.0);
DepthcueBackPlane := NEW (RealProp.Name).init (0.0);
DepthcueFrontScale := NEW (RealProp.Name).init (1.0);
DepthcueBackScale := NEW (RealProp.Name).init (0.0);
DepthcueSwitch := NEW (BooleanProp.Name).init (FALSE);
END RootGO.