Add initial prototype.

3-mid/physics/interface/source/private/box2d/box2d_physics-shape.adb

@@ -0,0 +1,208 @@
+with
+     box2d_c.Binding,
+
+     c_math_c.Vector_2,
+     c_math_c.Conversion,
+
+     ada.unchecked_Deallocation,
+     ada.unchecked_Conversion;
+
+package body box2d_Physics.Shape
+is
+   use c_math_c.Conversion,
+       box2d_c .Binding;
+
+
+   --  Base Shape
+   --
+
+   overriding
+   procedure define (Self : in out Item)
+   is
+   begin
+      raise Error with "Shape not supported.";
+   end define;
+
+
+   overriding
+   procedure destruct (Self : in out Item)
+   is
+   begin
+      b2d_free_Shape (Self.C);
+   end destruct;
+
+
+   overriding
+   procedure Scale_is (Self : in out Item;   Now : Vector_3)
+   is
+   begin
+      b2d_shape_Scale_is (Self.C, (c_math_c.Real (Now (1)),
+                                   c_math_c.Real (Now (2))));
+   end Scale_is;
+
+
+   -----------
+   --  Forge
+   --
+
+   --  2D
+   --
+
+   type Circle_view is access Circle;
+
+   function new_circle_Shape (Radius : in Real) return physics.Shape.view
+   is
+      Self : constant Circle_view := new Circle;
+      --  Self : constant access Circle := new Circle;
+--        c_Radius : aliased constant c_math_c.Real := +Radius;
+   begin
+      --        Self.C := b2d_new_Circle (c_Radius);
+      Self.Radius := Radius;
+      Self.define;
+      return physics.Shape.view (Self);
+   end new_circle_Shape;
+
+
+   overriding
+   procedure define (Self : in out Circle)
+   is
+      c_Radius : aliased constant c_math_c.Real := +Self.Radius;
+   begin
+      Self.C := b2d_new_Circle (c_Radius);
+   end define;
+
+
+
+   type Polygon_view is access Polygon;
+
+   function new_polygon_Shape (Vertices : in physics.Space.polygon_Vertices) return physics.Shape.view
+   is
+      --  P : Polygon (vertex_Count => Vertices'Length);
+      --  Self : constant Polygon_view := new Polygon' (P);
+      Self : constant Polygon_view := new Polygon (vertex_Count => Vertices'Length);
+--        c_Verts : array (1 .. Vertices'Length) of aliased c_math_c.Vector_2.item;
+   begin
+         Self.Vertices := Vertices;
+--        for i in c_Verts'Range
+--        loop
+--           c_Verts (i) := +Vertices (i);
+--        end loop;
+--
+--        Self.C := b2d_new_Polygon (c_Verts (1)'Unchecked_Access,
+--                                   c_Verts'Length);
+      Self.define;
+      return physics.Shape.view (Self);
+   end new_polygon_Shape;
+
+
+   overriding
+   procedure define (Self : in out Polygon)
+   is
+      c_Verts : array (1 .. Self.vertex_Count) of aliased c_math_c.Vector_2.item;
+   begin
+      for i in c_Verts'Range
+      loop
+         c_Verts (i) := +Self.Vertices (i);
+      end loop;
+
+      Self.C := b2d_new_Polygon (c_Verts (1)'unchecked_Access,
+                                 c_Verts'Length);
+   end define;
+
+
+   -- 3D
+   --
+
+   function new_box_Shape (half_Extents : in Vector_3) return physics.Shape.view
+   is
+      pragma unreferenced (half_Extents);
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_box_Shape;
+
+
+   function new_capsule_Shape (Radii  : in Vector_2;
+                               Height : in Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_capsule_Shape;
+
+
+   function new_cone_Shape (Radius,
+                            Height : in Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_cone_Shape;
+
+
+   function new_convex_hull_Shape (Points : in physics.Vector_3_array) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_convex_hull_Shape;
+
+
+   function new_cylinder_Shape (half_Extents : in Vector_3) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_cylinder_Shape;
+
+
+   function new_heightfield_Shape (Width,
+                                   Depth       : in Positive;
+                                   Heights     : access constant Real;
+                                   min_Height,
+                                   max_Height  : in Real;
+                                   Scale       : in Vector_3) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_heightfield_Shape;
+
+
+   function new_multiSphere_Shape (Positions : in physics.Vector_3_array;
+                                   Radii     : in Vector) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_multiSphere_Shape;
+
+
+   function new_plane_Shape (Normal : in Vector_3;
+                             Offset : in Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_plane_Shape;
+
+
+   function new_sphere_Shape (Radius : in math.Real) return physics.Shape.view
+   is
+   begin
+      raise physics.unsupported_Error;
+      return null;
+   end new_sphere_Shape;
+
+
+   procedure free (the_Shape : in out physics.Shape.view)
+   is
+      procedure deallocate is new ada.unchecked_Deallocation (physics.Shape.item'Class,
+                                                              physics.Shape.view);
+   begin
+      the_Shape.destruct;
+      deallocate (the_Shape);
+   end free;
+
+
+end box2d_Physics.Shape;