obliqlib3D/src/ObRootGO.m3


Copyright (C) 1994, Digital Equipment Corp.
Digital Internal Use Only
                                                                           
       Created on Sat Mar  5 20:42:30 PST 1994 by najork                   

MODULE ObRootGO;

IMPORT GraphicsBase, ObAux, ObBooleanProp, ObCameraGO, ObColorProp, ObCommand,
       ObGO, ObGraphicsBase, ObGroupGO, ObLib, ObPoint, ObPoint3, ObProp,
       ObProtoLoader, ObReal, ObRealProp, ObValue, Obliq, ProxiedObj, RootGO,
       RootGOProxy, SynLocation;

CONST
  pkgname = "RootGO";
*************************************************************************** Wrapper for RootGO.T ***************************************************************************

TYPE
  T = ObGroupGO.T BRANDED "ObRootGO.T" OBJECT END;

PROCEDURE AddTObj (root : RootGO.T) =
  <* FATAL ObValue.Error, ObValue.Exception *>
  BEGIN
    WITH obj = Obliq.ObjectClone (Obliq.Vals {TProto}),
         raw = NEW (T, what := "<a RootGO.T>", po := root) DO
      Obliq.ObjectUpdate (obj, "raw", raw);
      root.proxy := NEW (ProxiedObj.Proxy, obj := obj);
    END;
  END AddTObj;

PROCEDURE GetArg (args    : ObValue.ArgArray;
                  idx     : INTEGER;
                  package : ObLib.T;
                  opCode  : ObLib.OpCode;
                  loc     : SynLocation.T) : RootGO.T
    RAISES {ObValue.Error, ObValue.Exception} =
  BEGIN
    WITH raw = Obliq.ObjectSelect (args[idx], "raw") DO
      TYPECASE raw OF
      | T (node) =>
        RETURN node.po;
      ELSE
        ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc);
        RETURN NIL;      (* ... only to suppress compiler warning *)
      END;
    END;
  END GetArg;
*************************************************************************** Setup procedures ***************************************************************************

PROCEDURE SetupPackage () =

  PROCEDURE NewOpCode (name : TEXT; arity : INTEGER; code : Code) : OpCode =
    BEGIN
      RETURN NEW (OpCode, name := name, arity := arity, code := code);
    END NewOpCode;

  TYPE
    OpCodes = ARRAY OF ObLib.OpCode;
  VAR
    opCodes: REF OpCodes;
  BEGIN
    opCodes := NEW (REF OpCodes, NUMBER (Code));
    opCodes^ :=
        OpCodes {
            NewOpCode ("New",                   2, Code.New),
            NewOpCode ("NewStd",                0, Code.NewStd),
            NewOpCode ("NewStdWithBase",        1, Code.NewStdWithBase),
            NewOpCode ("ChangeCamera",          2, Code.ChangeCamera),
            NewOpCode ("Background",           -1, Code.Background),
            NewOpCode ("DepthcueSwitch",       -1, Code.DepthcueSwitch),
            NewOpCode ("DepthcueColor",        -1, Code.DepthcueColor),
            NewOpCode ("DepthcueFrontPlane",   -1, Code.DepthcueFrontPlane),
            NewOpCode ("DepthcueBackPlane",    -1, Code.DepthcueBackPlane),
            NewOpCode ("DepthcueFrontScale",   -1, Code.DepthcueFrontScale),
            NewOpCode ("DepthcueBackScale",    -1, Code.DepthcueBackScale),
            NewOpCode ("SetBackground",         2, Code.SetBackground),
            NewOpCode ("SetDepthcueSwitch",     2, Code.SetDepthcueSwitch),
            NewOpCode ("SetDepthcueColor",      2, Code.SetDepthcueColor),
            NewOpCode ("SetDepthcueFrontPlane", 2, Code.SetDepthcueFrontPlane),
            NewOpCode ("SetDepthcueBackPlane",  2, Code.SetDepthcueBackPlane),
            NewOpCode ("SetDepthcueFrontScale", 2, Code.SetDepthcueFrontScale),
            NewOpCode ("SetDepthcueBackScale",  2, Code.SetDepthcueBackScale),
            NewOpCode ("ScreenToWorld",         3, Code.ScreenToWorld)
        };

    ObLib.Register (NEW (Package, name := pkgname, opCodes := opCodes));
    ObLib.RegisterHelp (pkgname, Help);
  END SetupPackage;

VAR
  TProto : ObValue.Val;

PROCEDURE SetupModule (loader : ObProtoLoader.T) =
  BEGIN
    (*** Retrieve the prototype ***)
    loader.load ("RootGO.obl");
    TProto := loader.get ("RootGO_TProto");

    (*** Register the proxy maker ***)
    RootGOProxy.MkProxyT := AddTObj;
  END SetupModule;
*************************************************************************** Execution machinery ***************************************************************************

TYPE
  Code = {ChangeCamera, New, NewStd, NewStdWithBase,
          Background, DepthcueSwitch, DepthcueColor, DepthcueFrontPlane,
          DepthcueBackPlane, DepthcueFrontScale, DepthcueBackScale,
          SetBackground, SetDepthcueSwitch, SetDepthcueColor,
          SetDepthcueFrontPlane, SetDepthcueBackPlane, SetDepthcueFrontScale,
          SetDepthcueBackScale, ScreenToWorld};

  OpCode = ObLib.OpCode OBJECT
    code: Code;
  END;

  Package = ObLib.T OBJECT
  OVERRIDES
    Eval := DoEval;
  END;

PROCEDURE DoEval (self         : Package;
                  opCode       : ObLib.OpCode;
     <* UNUSED *> arity        : ObLib.OpArity;
                  READONLY args: ObValue.ArgArray;
     <* UNUSED *> temp         : BOOLEAN;
                  loc          : SynLocation.T) : ObValue.Val
    RAISES {ObValue.Error, ObValue.Exception} =
  BEGIN
    CASE NARROW (opCode, OpCode).code OF
    | Code.New =>
      WITH cam  = ObCameraGO.GetArg     (args, 1, self, opCode, loc),
           base = ObGraphicsBase.GetArg (args, 2, self, opCode, loc),
           root = RootGO.New (cam, base) DO
        RETURN root.proxy.obj;
      END;
    | Code.NewStd =>
      TRY
        WITH root = RootGO.NewStd () DO
          RETURN root.proxy.obj;
        END;
      EXCEPT
        GraphicsBase.Failure =>
        ObValue.RaiseException (ObGraphicsBase.Failure, opCode.name, loc);
        <* ASSERT FALSE *>
      END;
    | Code.NewStdWithBase =>
      TRY
        WITH base = ObGraphicsBase.GetArg (args, 1, self, opCode, loc),
             root = RootGO.NewStd (base) DO
          RETURN root.proxy.obj;
        END;
      EXCEPT
        GraphicsBase.Failure =>
        ObValue.RaiseException (ObGraphicsBase.Failure, opCode.name, loc);
        <* ASSERT FALSE *>
      END;
    | Code.ChangeCamera =>
      WITH root = GetArg            (args, 1, self, opCode, loc),
           cam  = ObCameraGO.GetArg (args, 2, self, opCode, loc) DO
        root.changeCamera (cam);
        RETURN ObValue.valOk;
      END;
    | Code.Background =>
      RETURN ObProp.NameToObliq (RootGO.Background);
    | Code.SetBackground =>
      WITH go = ObGO.GetArg                  (args, 1, self, opCode, loc),
           pv = ObColorProp.GetOverloadedVal (args, 2, self, opCode, loc) DO
        go.setProp (RootGO.Background.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.DepthcueSwitch =>
      RETURN ObProp.NameToObliq (RootGO.DepthcueSwitch);
    | Code.SetDepthcueSwitch =>
      WITH go = ObGO.GetArg                   (args, 1, self, opCode, loc),
           pv = ObBooleanProp.GetOverloadedVal(args, 2, self, opCode, loc) DO
        go.setProp (RootGO.DepthcueSwitch.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.DepthcueColor =>
      RETURN ObProp.NameToObliq (RootGO.DepthcueColour);
    | Code.SetDepthcueColor =>
      WITH go = ObGO.GetArg                  (args, 1, self, opCode, loc),
           pv = ObColorProp.GetOverloadedVal (args, 2, self, opCode, loc) DO
        go.setProp (RootGO.DepthcueColour.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.DepthcueFrontPlane =>
      RETURN ObProp.NameToObliq (RootGO.DepthcueFrontPlane);
    | Code.SetDepthcueFrontPlane =>
      WITH go = ObGO.GetArg                 (args, 1, self, opCode, loc),
           pv = ObRealProp.GetOverloadedVal (args, 2, self, opCode, loc) DO
        go.setProp (RootGO.DepthcueFrontPlane.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.DepthcueBackPlane =>
      RETURN ObProp.NameToObliq (RootGO.DepthcueBackPlane);
    | Code.SetDepthcueBackPlane =>
      WITH go = ObGO.GetArg                 (args, 1, self, opCode, loc),
           pv = ObRealProp.GetOverloadedVal (args, 2, self, opCode, loc) DO
        go.setProp (RootGO.DepthcueBackPlane.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.DepthcueFrontScale =>
      RETURN ObProp.NameToObliq (RootGO.DepthcueFrontScale);
    | Code.SetDepthcueFrontScale =>
      WITH go = ObGO.GetArg                 (args, 1, self, opCode, loc),
           pv = ObRealProp.GetOverloadedVal (args, 2, self, opCode, loc) DO
        go.setProp (RootGO.DepthcueFrontScale.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.DepthcueBackScale =>
      RETURN ObProp.NameToObliq (RootGO.DepthcueBackScale);
    | Code.SetDepthcueBackScale =>
      WITH go = ObGO.GetArg                 (args, 1, self, opCode, loc),
           pv = ObRealProp.GetOverloadedVal (args, 2, self, opCode, loc) DO
        go.setProp (RootGO.DepthcueBackScale.bind (pv));
        RETURN ObValue.valOk;
      END;
    | Code.ScreenToWorld =>
      WITH root = GetArg         (args, 1, self, opCode, loc),
           pos  = ObPoint.GetArg (args, 2, self, opCode, loc),
           z    = ObReal.GetArg  (args, 3, self, opCode, loc) DO
        RETURN ObPoint3.M3ToObliq (root.screenToWorld (pos, z));
      END;
    END;
  END DoEval;
*************************************************************************** Help ***************************************************************************

PROCEDURE Help (self : ObCommand.T; arg : TEXT; <* UNUSED *> data : REFANY) =
  BEGIN
    ObAux.Help (self, arg, pkgname);
  END Help;

BEGIN
END ObRootGO.