anim3D/src/RootGO.m3


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.