with bullet_c.Binding, bullet_physics.Shape, c_math_c.Conversion, c_math_c.Vector_3, c_math_c.Matrix_3x3, c_math_c.Matrix_4x4, Swig, interfaces.C, ada.unchecked_Deallocation, ada.Unchecked_Conversion, ada.Text_IO; package body bullet_Physics.Object is use bullet_c.Binding, c_math_c.Conversion, ada.Text_IO; type Any_limited_view is access all lace.Any.limited_item'Class; function new_Object (Shape : in physics.Shape.view; Mass : in Real; Friction : in Real; Restitution : in Real; at_Site : in Vector_3) return View -- is_Kinematic : in Boolean) return View is Self : constant View := new Item; begin Self.define (Shape => Shape, Mass => Mass, Friction => Friction, Restitution => Restitution, at_Site => at_Site); return Self; end new_Object; overriding procedure define (Self : access Item; Shape : in physics.Shape.view; Mass : in Real; Friction : in Real; Restitution : in Real; at_Site : in Vector_3) is use interfaces.C; function to_void_ptr is new ada.unchecked_Conversion (Any_limited_view, Swig.void_ptr); begin Self.C := b3d_new_Object (c_math_c.Real (Mass), bullet_physics.Shape.view (Shape).C, is_Kinematic => Boolean'Pos (False)); -- Boolean'Pos (is_Kinematic)); b3d_Object_Friction_is (Self.C, c_float (Friction)); b3d_Object_Restitution_is (Self.C, c_float (Restitution)); b3d_Object_user_Data_is (Self => Self.C.all'Access, Now => to_void_ptr (Self.all'Access)); Self.user_Data_is (Self); Self.Site_is (at_Site); end define; overriding procedure destruct (Self : in out Item) is begin null; end destruct; procedure free (the_Object : in out physics.Object.view) is procedure deallocate is new ada.unchecked_Deallocation (physics.Object.item'Class, physics.Object.view); begin the_Object.destruct; deallocate (the_Object); end free; function C (Self : in Item) return access bullet_C.Object is begin return Self.C; end C; overriding function Model (Self : in Item) return physics.Model.view is begin return Self.Model; end Model; overriding procedure Model_is (Self : in out Item; Now : in physics.Model.view) is begin Self.Model := Now; end Model_is; overriding function Shape (Self : in Item) return physics.Shape.view is c_Shape : constant bullet_c.Pointers.Shape_pointer := b3d_Object_Shape (Self.C); function to_Any_view is new ada.unchecked_Conversion (Swig.void_ptr, Any_limited_view); begin return physics.Shape.view (to_Any_view (b3d_Shape_user_Data (c_Shape))); end Shape; overriding function Scale (Self : in Item) return Vector_3 is begin raise Error with "TODO"; return math.Origin_3D; end Scale; overriding procedure Scale_is (Self : in out Item; Now : in Vector_3) is begin put_Line ("Scale_is not implemented for bullet_Physics.Object"); raise Error with "TODO"; end Scale_is; overriding procedure update_Dynamics (Self : in out Item) is Dynamics : constant Matrix_4x4 := Self.Transform; begin Self.Dynamics.set (Dynamics); end update_Dynamics; overriding function get_Dynamics (Self : in Item) return Matrix_4x4 is begin return Self.Dynamics.get; end get_Dynamics; overriding function is_Active (Self : in Item) return Boolean is begin return True; end is_Active; overriding procedure activate (Self : in out Item; forceActivation : in Boolean := False) is pragma unreferenced (forceActivation); begin null; end activate; overriding function Mass (Self : in Item) return Real is begin return Real (b3d_Object_Mass (Self.C)); end Mass; overriding function Site (Self : in Item) return Vector_3 is the_Site : constant c_math_c.Vector_3.item := b3d_Object_Site (Self.C); begin return +the_Site; end Site; overriding procedure Site_is (Self : in out Item; Now : in Vector_3) is c_Now : aliased c_math_c.Vector_3.item := +Now; begin b3d_Object_Site_is (Self.C, c_Now'unchecked_Access); end Site_is; overriding function Spin (Self : in Item) return math.Matrix_3x3 is use type bullet_c.Pointers.Object_pointer; begin if Self.C /= null then declare the_Spin : constant c_math_c.Matrix_3x3.item := b3d_Object_Spin (Self.C); begin return +the_Spin; end; else return Self.Dynamics.get_Spin; end if; end Spin; overriding procedure Spin_is (Self : in out Item; Now : in Matrix_3x3) is use type bullet_c.Pointers.Object_pointer; begin Self.Dynamics.set_Spin (Now); if Self.C /= null then declare c_Now : aliased c_math_c.Matrix_3x3.item := +Now; begin b3d_Object_Spin_is (Self.C, c_Now'unchecked_Access); end; end if; end Spin_is; overriding function xy_Spin (Self : in Item) return Radians is begin raise Error with "TODO"; return 0.0; end xy_Spin; overriding procedure xy_Spin_is (Self : in out Item; Now : in Radians) is begin raise Error with "TODO"; end xy_Spin_is; overriding function Transform (Self : in Item) return Matrix_4x4 is the_Transform : constant c_math_c.Matrix_4x4.item := b3d_Object_Transform (Self.C); begin return +the_Transform; end Transform; overriding procedure Transform_is (Self : in out Item; Now : in Matrix_4x4) is c_Now : aliased c_math_c.Matrix_4x4.item := +Now; begin b3d_Object_Transform_is (Self.C, c_Now'unchecked_Access); end Transform_is; overriding function Speed (Self : in Item) return math.Vector_3 is the_Speed : constant c_math_c.Vector_3.item := b3d_Object_Speed (Self.C); begin return +the_Speed; end Speed; overriding procedure Speed_is (Self : in out Item; Now : in Vector_3) is c_Now : aliased c_math_c.Vector_3.item := +Now; begin b3d_Object_Speed_is (Self.C, c_Now'unchecked_Access); end Speed_is; overriding function Gyre (Self : in Item) return math.Vector_3 is the_Gyre : constant c_math_c.Vector_3.item := b3d_Object_Gyre (Self.C); begin return +the_Gyre; end Gyre; overriding procedure Gyre_is (Self : in out Item; Now : in Vector_3) is c_Now : aliased c_math_c.Vector_3.item := +Now; begin b3d_Object_Gyre_is (Self.C, c_Now'unchecked_Access); end Gyre_is; overriding procedure Friction_is (Self : in out Item; Now : in Real) is begin b3d_Object_Friction_is (Self.C, +Now); end Friction_is; overriding procedure Restitution_is (Self : in out Item; Now : in Real) is begin b3d_Object_Restitution_is (Self.C, +Now); end Restitution_is; --- Forces -- overriding procedure apply_Torque (Self : in out Item; Torque : in Vector_3) is c_Torque : aliased c_math_c.Vector_3.item := +Torque; begin b3d_Object_apply_Torque (Self.C, c_Torque'unchecked_Access); end apply_Torque; overriding procedure apply_Torque_impulse (Self : in out Item; Torque : in Vector_3) is c_Torque : aliased c_math_c.Vector_3.item := +Torque; begin b3d_Object_apply_Torque_impulse (Self.C, c_Torque'unchecked_Access); end apply_Torque_impulse; overriding procedure apply_Force (Self : in out Item; Force : in Vector_3) is c_Force : aliased c_math_c.Vector_3.item := +Force; begin b3d_Object_apply_Force (Self.C, c_Force'unchecked_Access); end apply_Force; --- User data -- overriding procedure user_Data_is (Self : in out Item; Now : access lace.Any.limited_item'Class) is begin Self.user_Data := Now.all'unchecked_Access; end user_Data_is; overriding function user_Data (Self : in Item) return access lace.Any.limited_item'Class is begin return Self.user_Data; end user_Data; end bullet_Physics.Object;