1. -- 
  2. -- Jan & Uwe R. Zimmer, Australia, July 2011 
  3. -- 
  4.  
  5. with Ada.Numerics.Generic_Elementary_Functions; 
  6.  
  7. package body Quaternions is 
  8.  
  9.    package Elementary_Functions is new Ada.Numerics.Generic_Elementary_Functions (Real); 
  10.    use Elementary_Functions; 
  11.  
  12.    -- 
  13.  
  14.    function "abs" (Quad : Quaternion_Real) return Real is 
  15.      (Sqrt (Quad.w**2 + Quad.x**2 + Quad.y**2 + Quad.z**2)); 
  16.  
  17.    function Unit (Quad : Quaternion_Real) return Quaternion_Real is 
  18.      (Quad / abs (Quad)); 
  19.  
  20.    function Conj (Quad : Quaternion_Real) return Quaternion_Real is 
  21.      (w => Quad.w, x => -Quad.x, y => -Quad.y, z => -Quad.z); 
  22.  
  23.    function "-" (Quad : Quaternion_Real) return Quaternion_Real is 
  24.      (w => -Quad.w, x => -Quad.x, y => -Quad.y, z => -Quad.z); 
  25.  
  26.    function "+" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  27.      (w => Left.w + Right.w, x => Left.x + Right.x, 
  28.       y => Left.y + Right.y, z => Left.z + Right.z); 
  29.  
  30.    function "-" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  31.      (w => Left.w - Right.w, x => Left.x - Right.x, 
  32.       y => Left.y - Right.y, z => Left.z - Right.z); 
  33.  
  34.    function "*" (Left : Quaternion_Real; Right : Real) return Quaternion_Real is 
  35.      (w => Left.w * Right, x => Left.x * Right, 
  36.       y => Left.y * Right, z => Left.z * Right); 
  37.  
  38.    function "*" (Left : Real; Right : Quaternion_Real) return Quaternion_Real is (Right * Left); 
  39.  
  40.    function "/" (Left : Quaternion_Real; Right : Real) return Quaternion_Real is 
  41.      (w => Left.w / Right, x => Left.x / Right, 
  42.       y => Left.y / Right, z => Left.z / Right); 
  43.  
  44.    function "/" (Left : Real; Right : Quaternion_Real) return Quaternion_Real is (Right / Left); 
  45.  
  46.    function "*" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  47.      (w => Left.w * Right.w - Left.x * Right.x - Left.y * Right.y - Left.z * Right.z, 
  48.       x => Left.w * Right.x + Left.x * Right.w + Left.y * Right.z - Left.z * Right.y, 
  49.       y => Left.w * Right.y - Left.x * Right.z + Left.y * Right.w + Left.z * Right.x, 
  50.       z => Left.w * Right.z + Left.x * Right.y - Left.y * Right.x + Left.z * Right.w); 
  51.  
  52.    function "/" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  53.      (w => Left.w * Right.w + Left.x * Right.x + Left.y * Right.y + Left.z * Right.z, 
  54.       x => Left.w * Right.x - Left.x * Right.w - Left.y * Right.z + Left.z * Right.y, 
  55.       y => Left.w * Right.y + Left.x * Right.z - Left.y * Right.w - Left.z * Right.x, 
  56.       z => Left.w * Right.z - Left.x * Right.y + Left.y * Right.x - Left.z * Right.w); 
  57.  
  58.    function Image (Quad : Quaternion_Real) return String is 
  59.        (Real'Image (Quad.w) & " +"  & 
  60.         Real'Image (Quad.x) & "i +" & 
  61.         Real'Image (Quad.y) & "j +" & 
  62.         Real'Image (Quad.z) & "k"); 
  63.  
  64.    -- 
  65.  
  66. end Quaternions;