Vector4.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
--
-- (c) 2011 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.

-- Vector4.hs

module HGamer3D.Data.Vector4 

(
	-- export Vector4 Type and its functions again
	
	Vector4 (Vector4),
	vector4,
	uniV4,
	v4X,v4Y,v4Z,v4W,
	HGamer3D.Data.Vector4.dotV4,
	HGamer3D.Data.Vector4.normSqV4,
	HGamer3D.Data.Vector4.normV4,
	HGamer3D.Data.Vector4.normalizeV4,
	HGamer3D.Data.Vector4.scaleV4
	
)

where

import Data.Vec.Base
import Data.Vec.Nat
import Data.Vec.Packed
import Data.Vec.LinAlg


newtype Vector4 = Vector4 Vec4F

vector4 :: Float -> Float -> Float -> Float -> Vector4
vector4 a b c d = Vector4 ( pack (a :. b :. c :. d :. ()) )

uniV4 :: Float -> Vector4
uniV4 f = Vector4 (pack (vec f))

v4X :: Vector4 -> Float
v4X (Vector4 v4) = get n0 v4

v4Y :: Vector4 -> Float
v4Y (Vector4 v4) = get n1 v4

v4Z :: Vector4 -> Float
v4Z (Vector4 v4) = get n2 v4

v4W :: Vector4 -> Float
v4W (Vector4 v4) = get n3 v4



liftv :: (a -> Vec4F) -> (a -> Vector4)
liftv f = f1 where
	f1 a1 = (Vector4 (f a1)) 


lift1 :: (Vec4F -> a) -> (Vector4 -> a)
lift1 f = f1 where
	f1 (Vector4 a1) = f a1 

lift1v :: (Vec4F -> Vec4F) -> (Vector4 -> Vector4)
lift1v f = f2 where
	f2 a = (Vector4 (f1 a))
	f1 (Vector4 a1) = f a1 

lift2 :: (Vec4F -> Vec4F -> a) -> (Vector4 -> Vector4 -> a)
lift2 f = f1 where
	f1 (Vector4 a1) (Vector4 b1) = f a1 b1 

lift2v :: (Vec4F -> Vec4F -> Vec4F) -> (Vector4 -> Vector4 -> Vector4)
lift2v f = f2 where
	f2 a b = (Vector4 (f1 a b))
	f1 (Vector4 a1) (Vector4 b1) = f a1 b1 

lift2vp :: (Vec4 Float -> Vec4 Float -> Vec4 Float) -> (Vector4 -> Vector4 -> Vector4)
lift2vp f = f2 where
	f2 a b = (Vector4 (pack (f1 a b)))
	f1 (Vector4 (Vec4F a1 a2 a3 a4)) (Vector4 (Vec4F b1 b2 b3 b4)) = f (a1 :. a2 :. a3 :. a4 :. ()) (b1 :. b2 :. b3 :. b4 :. ()) 

instance Show Vector4 where
	show = lift1 (Prelude.show)
	
instance Eq Vector4 where
	(==) = lift2 (Prelude.==)
	 
instance Num Vector4 where
	abs = lift1v (Prelude.abs)
	signum = lift1v (Prelude.signum)
	fromInteger = liftv (Prelude.fromInteger)

	(+) = lift2v (Prelude.+)
	(-) = lift2v (Prelude.-)
	(*) = lift2v (Prelude.*)

dotV4 :: Vector4 -> Vector4 -> Float
dotV4 = lift2 Data.Vec.LinAlg.dot

normSqV4 :: Vector4 -> Float
normSqV4 = lift1 Data.Vec.LinAlg.normSq

normV4 :: Vector4 -> Float
normV4 = lift1 Data.Vec.LinAlg.norm

normalizeV4 :: Vector4 -> Vector4
normalizeV4 = lift1v Data.Vec.LinAlg.normalize

scaleV4 :: Float -> Vector4 -> Vector4
scaleV4 f (Vector4 v) = Vector4 (Data.Vec.Base.map (*f) v)