1. pragma Style_Checks (Off); 
  2. pragma Warnings (Off); 
  3.  
  4. ------------------------------------------------------------------------- 
  5.  --  GLOBE_3D.Collision_detection 
  6.  -- 
  7.  --  Copyright (c) Gautier de Montmollin 1999 .. 2008 
  8.  --  SWITZERLAND 
  9.  -- 
  10.  --  Permission is hereby granted, free of charge, to any person obtaining a copy 
  11.  --  of this software and associated documentation files (the "Software"), to deal 
  12.  --  in the Software without restriction, including without limitation the rights 
  13.  --  to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 
  14.  --  copies of the Software, and to permit persons to whom the Software is 
  15.  --  furnished to do so, subject to the following conditions: 
  16.  
  17.  --  The above copyright notice and this permission notice shall be included in 
  18.  --  all copies or substantial portions of the Software. 
  19.  
  20.  --  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 
  21.  --  IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 
  22.  --  FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 
  23.  --  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 
  24.  --  LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 
  25.  --  OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 
  26.  --  THE SOFTWARE. 
  27.  
  28.  -- NB : this is the MIT License, as found 12 - Sep - 2007 on the site 
  29.  -- http://www.opensource.org/licenses/mit - license.php 
  30.  
  31.  ------------------------------------------------------------------------- 
  32.  
  33. with GLOBE_3D.Math;                     use GLOBE_3D.Math; 
  34. with GLOBE_3D.Options; 
  35.  
  36. package body GLOBE_3D.Collision_detection is 
  37.  
  38.   check_normals : constant Boolean := GLOBE_3D.Options.strict_geometry; 
  39.  
  40.   procedure Reaction ( 
  41.     o            : Object_3D'Class; 
  42.     ball         : Ball_type; 
  43.     method       : Reaction_method; 
  44.     step         : in out Vector_3D; -- Whole step (in : desired, out : effective) 
  45.     reacted      : out Real          -- in proportion to step 
  46. ) 
  47.   is 
  48.     P_after_step, P_face : Point_3D; 
  49.     u, n  : Vector_3D; 
  50.     dist_after, dist_before, nn : Real; -- distance orientee 
  51.     retour : Real := 0.0; 
  52.     lstep0 : constant Real := Norm (step); 
  53.  
  54.     -- This function check whether we are inside the prism above face f 
  55.  
  56.     function Dans_prisme_epaissi (f : Positive) return Boolean is 
  57.       sfp1 : Positive; 
  58.       Ps, Psp1 : Point_3D; 
  59.       u, edge_vector, npa : Vector_3D; 
  60.       dist_edge, nnpa : Real; 
  61.       facteur : constant := 1.05; 
  62.     begin 
  63.       -- Cycle through face's vertices 
  64.       for sf in reverse 1 .. o.Face_Invariant (f).last_edge loop 
  65.         sfp1 := 1 + sf mod o.Face_Invariant (f).last_edge; 
  66.         Ps  := o.point (o.Face_Invariant (f).P_compact (sf)); 
  67.         Psp1 := o.point (o.Face_Invariant (f).P_compact (sfp1)); 
  68.         edge_vector := Psp1 - Ps; 
  69.         npa := n * edge_vector; 
  70.         nnpa := Norm (npa); 
  71.         if Almost_Zero (nnpa) then -- degenerated edge 
  72.           return False; 
  73.         end if; 
  74.         npa := 1.0/nnpa * npa; 
  75.         -- npa points towards the prism's interior 
  76.         u := P_after_step - (Ps + o.Centre); 
  77.         dist_edge := u * npa; 
  78.         if dist_edge < - ball.radius * facteur then 
  79.           return False; 
  80.         end if; 
  81.       end loop; 
  82.       return True; 
  83.     end Dans_prisme_epaissi; 
  84.  
  85.   begin 
  86.     reacted := 0.0; 
  87.     if Almost_Zero (lstep0) then 
  88.       return; 
  89.     end if; 
  90.  
  91.     P_after_step := ball.centre + step; 
  92.  
  93.     for face in reverse 1 .. o.Max_faces loop 
  94.       n := o.Face_Invariant (face).normal; 
  95.       if check_normals then 
  96.         nn := Norm (n); 
  97.         if Almost_zero (nn) then 
  98.           raise Zero_normal; 
  99.         elsif abs (nn - 1.0) > 1.0e-7 then 
  100.           raise Not_one_normal with " norm = " & Real'Image (nn); 
  101.         end if; 
  102.       end if; 
  103.       if step * n < 0.0 then 
  104.         P_face := o.point (o.Face_Invariant (face).P_compact (1)) + o.Centre; 
  105.         -- ^ any point on the face, to measure distance to face's plane. 
  106.         u := ball.centre - P_face; 
  107.         dist_before := u * n; 
  108.         if dist_before > 0.0 then 
  109.           -- ^ Fine, we are on the right side of the face. 
  110.           --   Test added to Engine_3D's algo, since objects are 
  111.           --   not always hollow, convex polyhedrons anymore. 
  112.           u := P_after_step - P_face; 
  113.           dist_after := u * n; 
  114.           if dist_after < ball.radius 
  115.             -- ^ Ouch! React we must! 
  116.             -- This includes negatives values of dist_after, in cases 
  117.             -- the intended step makes going through the face! 
  118.           and then 
  119.              Dans_prisme_epaissi (face) 
  120.           then 
  121.             if o.face (face).skin /= invisible then 
  122.             -- ^ this assumes : invisible < => can go through 
  123.               reacted := reacted + retour / lstep0; 
  124.               -- !! seems wrong if reactions in different directions 
  125.               --    should be something like step * step0 
  126.               case method is 
  127.                 when elastic => 
  128.                   raise Unsupported with "elastic reaction"; 
  129.                   -- should compute the time the "ball" takes from rebound to 
  130.                   -- next face or portal. 
  131.                 when slide => 
  132.                   retour := ball.radius - dist_after; -- always > 0 
  133.                   step := step + retour * n; 
  134.                   -- Since step and n have a negative dot product      - checked - 
  135.                   -- and dist (ball.centre + step_old, face) < ball.radius - checked - 
  136.                   -- then: 
  137.                   -- ||step_new|| < ||step_old|| --> decreasing algo : - ) 
  138.               end case; 
  139.             end if; 
  140.           end if; 
  141.         end if; 
  142.       end if; 
  143.     end loop; 
  144.  end Reaction; 
  145.  
  146. end GLOBE_3D.Collision_detection;