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.  
  16.    begin 
  17.       return Sqrt (Quad.w**2 + Quad.x**2 + Quad.y**2 + Quad.z**2); 
  18.    end "abs"; 
  19.  
  20.    -- 
  21.  
  22.    function Unit (Quad : Quaternion_Real) return Quaternion_Real is 
  23.  
  24.    begin 
  25.       return Quad / abs (Quad); 
  26.    end Unit; 
  27.  
  28.    -- 
  29.  
  30.    function Conj (Quad : Quaternion_Real) return Quaternion_Real is 
  31.  
  32.    begin 
  33.       return (w => Quad.w, x => -Quad.x, y => -Quad.y, z => -Quad.z); 
  34.    end Conj; 
  35.  
  36.    -- 
  37.  
  38.    function "-" (Quad : Quaternion_Real) return Quaternion_Real is 
  39.  
  40.    begin 
  41.       return (w => -Quad.w, x => -Quad.x, y => -Quad.y, z => -Quad.z); 
  42.    end "-"; 
  43.  
  44.    -- 
  45.  
  46.    function "+" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  47.  
  48.    begin 
  49.       return 
  50.       (w => Left.w + Right.w, x => Left.x + Right.x, 
  51.        y => Left.y + Right.y, z => Left.z + Right.z); 
  52.    end "+"; 
  53.  
  54.    -- 
  55.  
  56.    function "-" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  57.  
  58.    begin 
  59.       return 
  60.       (w => Left.w - Right.w, x => Left.x - Right.x, 
  61.        y => Left.y - Right.y, z => Left.z - Right.z); 
  62.    end "-"; 
  63.  
  64.    -- 
  65.  
  66.    function "*" (Left : Quaternion_Real; Right : Real) return Quaternion_Real is 
  67.  
  68.    begin 
  69.       return 
  70.       (w => Left.w * Right, x => Left.x * Right, 
  71.        y => Left.y * Right, z => Left.z * Right); 
  72.    end "*"; 
  73.  
  74.    -- 
  75.  
  76.    function "*" (Left : Real; Right : Quaternion_Real) return Quaternion_Real is 
  77.  
  78.    begin 
  79.       return Right * Left; 
  80.    end "*"; 
  81.  
  82.    -- 
  83.  
  84.    function "/" (Left : Quaternion_Real; Right : Real) return Quaternion_Real is 
  85.  
  86.    begin 
  87.       return 
  88.       (w => Left.w / Right, x => Left.x / Right, 
  89.        y => Left.y / Right, z => Left.z / Right); 
  90.    end "/"; 
  91.  
  92.    -- 
  93.  
  94.    function "/" (Left : Real; Right : Quaternion_Real) return Quaternion_Real is 
  95.  
  96.    begin 
  97.       return Right / Left; 
  98.    end "/"; 
  99.  
  100.    -- 
  101.  
  102.    function "*" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  103.  
  104.    begin 
  105.       return 
  106.       (w => Left.w * Right.w - Left.x * Right.x - Left.y * Right.y - Left.z * Right.z, 
  107.        x => Left.w * Right.x + Left.x * Right.w + Left.y * Right.z - Left.z * Right.y, 
  108.        y => Left.w * Right.y - Left.x * Right.z + Left.y * Right.w + Left.z * Right.x, 
  109.        z => Left.w * Right.z + Left.x * Right.y - Left.y * Right.x + Left.z * Right.w); 
  110.    end "*"; 
  111.  
  112.    -- 
  113.  
  114.    function "/" (Left, Right : Quaternion_Real) return Quaternion_Real is 
  115.  
  116.    begin 
  117.       return 
  118.       (w => Left.w * Right.w + Left.x * Right.x + Left.y * Right.y + Left.z * Right.z, 
  119.        x => Left.w * Right.x - Left.x * Right.w - Left.y * Right.z + Left.z * Right.y, 
  120.        y => Left.w * Right.y + Left.x * Right.z - Left.y * Right.w - Left.z * Right.x, 
  121.        z => Left.w * Right.z - Left.x * Right.y + Left.y * Right.x - Left.z * Right.w); 
  122.    end "/"; 
  123.  
  124.    -- 
  125.  
  126.    function Image (Quad : Quaternion_Real) return String is 
  127.  
  128.    begin 
  129.       return Real'Image (Quad.w) & " +"  & 
  130.              Real'Image (Quad.x) & "i +" & 
  131.              Real'Image (Quad.y) & "j +" & 
  132.              Real'Image (Quad.z) & "k"; 
  133.    end Image; 
  134.  
  135.    -- 
  136.  
  137. end Quaternions;