Quaternion.hs

-- This source file is part of HGamer3D
-- (A project to enable 3D game development in Haskell)
-- For the latest info, see http://www.althainz.de/HGamer3D.html
--
-- Copyright 2011 Dr. Peter Althainz
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

-- Quaternion.hs

module HGamer3D.Data.Quaternion 

(
	-- export Quaternion Type again
	Quaternion (Quaternion),
	
	-- export all functions
	realQ,
	imagQ,
	fromScalarQ,
	listFromQ,
	fromListQ,
	addQ,
	subQ,
	mulQ,
	normQ,
	conjQ,
	negQ,
	fromRotationQ,
	
)

where

import HGamer3D.Data.Vector3

data Quaternion = Quaternion {
  qFW :: Float,
  qFX :: Float,
  qFY :: Float,
  qFZ :: Float
   } deriving (Eq, Show)

realQ :: Quaternion -> Float
realQ (Quaternion r _ _ _) = r
 
imagQ :: Quaternion -> [Float]
imagQ (Quaternion _ i j k) = [i, j, k]
 
fromScalarQ s = Quaternion s 0 0 0
 
listFromQ (Quaternion a b c d) = [a,b,c,d]
fromListQ [a, b, c, d] = Quaternion a b c d
 
addQ, subQ, mulQ :: Quaternion -> Quaternion -> Quaternion

addQ (Quaternion a b c d) (Quaternion p q r s) = Quaternion (a+p) (b+q) (c+r) (d+s)
 
subQ (Quaternion a b c d) (Quaternion p q r s) = Quaternion (a-p) (b-q) (c-r) (d-s)
 
mulQ (Quaternion a b c d) (Quaternion p q r s) =
  Quaternion  (a*p - b*q - c*r - d*s)
     (a*q + b*p + c*s - d*r)
     (a*r - b*s + c*p + d*q)
     (a*s + b*r - c*q + d*p)

normQ :: Quaternion -> Float 
normQ q  = sqrt $ sum $ zipWith (*) x x where x = listFromQ q
 
conjQ, negQ :: Quaternion -> Quaternion

conjQ (Quaternion a b c d) = Quaternion a (-b) (-c) (-d)
 
negQ (Quaternion a b c d) = Quaternion (-a) (-b) (-c) (-d)

fromRotationQ :: Float -> Vector3 -> Quaternion
fromRotationQ a (Vector3 x y z) = Quaternion (cos h) (s*x) (s*y) (s*z) where
					h = a/2.0
					s = sin h