Angle.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE TypeFamilies               #-}

-- | Basic types associated with geometry.
module Naqsha.Geometry.Angle
  ( Angle
  , degree , minute, second
  , radian
  , toDegree, toRadian
  , Angular(..)
  ) where


import           Control.Monad               ( liftM )
import           Data.Default
import           Data.Group
import           Data.Int
import           GHC.Real
import           Data.Vector.Unboxed         ( MVector(..), Vector, Unbox)
import qualified Data.Vector.Generic         as GV
import qualified Data.Vector.Generic.Mutable as GVM


----------------------------- Angles and Angular quantities -----------------------

-- | An abstract angle. Internally, angles are represented as a 64-bit
-- integer with each unit contribute 1/2^64 fraction of a complete
-- circle. This means that angles are accurate up to a resolution of 2
-- π / 2^64 radians. Angles form a group under the angular addition
-- and the fact that these are represented as integers means one can
-- expect high speed accurate angle arithmetic.
--
-- When expressing angles one can use a more convenient notation:
--
-- > myAngle   = degree 21.71167
-- > yourAngle = degree 21 <> minute 42 <> second 42
--
newtype Angle = Angle {unAngle :: Int64} deriving (Enum, Eq, Ord, Unbox, Show, Read)

-- | Express angle in degrees.
degree :: Rational -> Angle
degree = Angle  . fromInteger  . round . (*scale)
  where scale = (2^(64:: Int)) % 360

-- | Express angle in minutes.
minute :: Rational -> Angle
minute = degree . (*scale)
  where scale = 1 % 60

-- | Express angle in seconds.
second :: Rational -> Angle
second = degree . (*scale)
    where scale = 1 % 3600

-- | Express angle in radians
radian  :: Double -> Angle
radian  = Angle . round . (*scale)
  where scale = (2^(63:: Int)) / pi


---------------------- Decimal representation of angle ----------------------------------

-- | Measure angle in degrees. This conversion may lead to loss of
-- precision.
toDegree :: Fractional r => Angle -> r
toDegree  = fromRational  . (*conv) . toRational . unAngle
  where conv = 360 % (2^(64  :: Int))

-- | Measure angle in radians. This conversion may lead to loss of
-- precision.
toRadian :: Angle -> Double
toRadian = (*conv) . fromIntegral . unAngle
  where conv = pi / (2^(63:: Int))

instance Default Angle where
  def = Angle 0

instance Angular Angle where
  toAngle = id

instance Monoid Angle where
  mempty                        = Angle 0
  mappend  (Angle x)  (Angle y) = Angle $ x + y
  mconcat                       = Angle . sum . map unAngle

instance Group Angle where
  invert (Angle x) = Angle $ negate x

instance Bounded Angle where
  maxBound = Angle maxBound
  minBound = Angle minBound

------------------------------ The angular class ------------------------

-- | Angular quantities.
class Angular a where
  toAngle   :: a -> Angle

------------------- Making stuff suitable for unboxed vector. --------------------------

newtype instance MVector s Angle = MAngV  (MVector s Int64)
newtype instance Vector    Angle = AngV   (Vector Int64)


instance GVM.MVector MVector Angle where
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicOverlaps #-}
  {-# INLINE basicUnsafeNew #-}
  {-# INLINE basicUnsafeReplicate #-}
  {-# INLINE basicUnsafeRead #-}
  {-# INLINE basicUnsafeWrite #-}
  {-# INLINE basicClear #-}
  {-# INLINE basicSet #-}
  {-# INLINE basicUnsafeCopy #-}
  {-# INLINE basicUnsafeGrow #-}
  basicLength          (MAngV v)          = GVM.basicLength v
  basicUnsafeSlice i n (MAngV v)          = MAngV $ GVM.basicUnsafeSlice i n v
  basicOverlaps (MAngV v1) (MAngV v2)     = GVM.basicOverlaps v1 v2

  basicUnsafeRead  (MAngV v) i            = Angle `liftM` GVM.basicUnsafeRead v i
  basicUnsafeWrite (MAngV v) i (Angle x)  = GVM.basicUnsafeWrite v i x

  basicClear (MAngV v)                    = GVM.basicClear v
  basicSet   (MAngV v)         (Angle x)  = GVM.basicSet v x

  basicUnsafeNew n                        = MAngV `liftM` GVM.basicUnsafeNew n
  basicUnsafeReplicate n     (Angle x)    = MAngV `liftM` GVM.basicUnsafeReplicate n x
  basicUnsafeCopy (MAngV v1) (MAngV v2)   = GVM.basicUnsafeCopy v1 v2
  basicUnsafeGrow (MAngV v)   n           = MAngV `liftM` GVM.basicUnsafeGrow v n

#if MIN_VERSION_vector(0,11,0)
  basicInitialize (MAngV v)               = GVM.basicInitialize v
#endif

instance GV.Vector Vector Angle where
  {-# INLINE basicUnsafeFreeze #-}
  {-# INLINE basicUnsafeThaw #-}
  {-# INLINE basicLength #-}
  {-# INLINE basicUnsafeSlice #-}
  {-# INLINE basicUnsafeIndexM #-}
  {-# INLINE elemseq #-}
  basicUnsafeFreeze (MAngV v)         = AngV  `liftM` GV.basicUnsafeFreeze v
  basicUnsafeThaw (AngV v)            = MAngV `liftM` GV.basicUnsafeThaw v
  basicLength (AngV v)                = GV.basicLength v
  basicUnsafeSlice i n (AngV v)       = AngV $ GV.basicUnsafeSlice i n v
  basicUnsafeIndexM (AngV v) i        = Angle   `liftM`  GV.basicUnsafeIndexM v i

  basicUnsafeCopy (MAngV mv) (AngV v) = GV.basicUnsafeCopy mv v
  elemseq _ (Angle x)                 = GV.elemseq (undefined :: Vector a) x