Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
Created on Wed Feb 16 14:15:37 PST 1994 by najork
MODULE*************************************************************************** Construction procedures ***************************************************************************RootGO EXPORTSRootGO ,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; PROCEDUREInit (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; PROCEDUREChangeCamera (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; PROCEDUREFindName (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; PROCEDUREAdjust (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; PROCEDUREDraw (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; PROCEDUREDamageIfDependent (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;
PROCEDURE*************************************************************************** Module body ***************************************************************************New (cam : CameraGO.T; base : GraphicsBase.T) : T = BEGIN RETURN NEW(T).init(cam,base); END New; PROCEDURENewStd (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; PROCEDUREPositionInvoke (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; PROCEDUREMouseInvoke (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;
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.