-- 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.

-- Angle.hs

{- |
	Angles as Degrees or Radians, based on Float datatype
	copied and changed to float from AC-Angle packet
-}

module HGamer3D.Data.Angle 

(
	-- export Radians and Degrees 
	Radians (Radians),
	Degrees (Degrees),
	degrees,
	radians
	
	-- instances are automatically exported
	-- Angle, sine, cosine, tangent, arcsine, arccosine, arctangent
	
)

where

-- | An angle in radians.
data Radians = Radians Float deriving (Eq, Ord, Show)

-- | An angle in degrees.
data Degrees = Degrees Float deriving (Eq, Ord, Show)

-- | Convert from radians to degrees.
degrees :: Radians -> Degrees
degrees (Radians x) = Degrees (x/pi*180)

-- | Convert from degrees to radians.
radians :: Degrees -> Radians
radians (Degrees x) = Radians (x/180*pi)

-- | Type-class for angles.
class Angle a where
  sine    :: a -> Float
  cosine  :: a -> Float
  tangent :: a -> Float

  arcsine    :: Float -> a
  arccosine  :: Float -> a
  arctangent :: Float -> a

instance Angle Radians where
  sine    (Radians x) = sin x
  cosine  (Radians x) = cos x
  tangent (Radians x) = tan x

  arcsine    x = Radians (asin x)
  arccosine  x = Radians (acos x)
  arctangent x = Radians (atan x)

instance Angle Degrees where
  sine    =    sine . radians
  cosine  =  cosine . radians
  tangent = tangent . radians

  arcsine    = degrees . arcsine
  arccosine  = degrees . arccosine
  arctangent = degrees . arctangent