module Data.Geo.Jord.Angle
(
Angle
, decimalDegrees
, dms
, radians
, arcLength
, central
, clockwiseDifference
, isNegative
, isWithin
, negate
, normalise
, asin
, atan2
, cos
, sin
, getDegrees
, getArcminutes
, getArcseconds
, getArcmilliseconds
, toDecimalDegrees
, toRadians
, angle
, read
, add
, subtract
, zero
) where
import Control.Applicative ((<|>))
import Data.Fixed (mod')
import Prelude hiding (atan2, asin, acos, cos, negate, read, sin, subtract)
import qualified Prelude (atan2, asin, cos, sin)
import Text.ParserCombinators.ReadP (ReadP, char, option, readP_to_S, string)
import Text.Printf (printf)
import Text.Read (readMaybe)
import Data.Geo.Jord.Length (Length)
import qualified Data.Geo.Jord.Length as Length (metres, toMetres)
import Data.Geo.Jord.Parser
newtype Angle =
Angle
{ microarcseconds :: Int
}
deriving (Eq)
instance Read Angle where
readsPrec _ = readP_to_S angle
instance Show Angle where
show a =
s ++
show d ++
"°" ++
show (getArcminutes a) ++
"'" ++ show (getArcseconds a) ++ "." ++ printf "%03d" (getArcmilliseconds a) ++ "\""
where
d = getDegrees a
s =
if d == 0 && microarcseconds a < 0
then "-"
else ""
instance Ord Angle where
(<=) (Angle uas1) (Angle uas2) = uas1 <= uas2
add :: Angle -> Angle -> Angle
add a1 a2 = Angle (microarcseconds a1 + microarcseconds a2)
subtract :: Angle -> Angle -> Angle
subtract a1 a2 = Angle (microarcseconds a1 - microarcseconds a2)
zero :: Angle
zero = Angle 0
decimalDegrees :: Double -> Angle
decimalDegrees dec = Angle (round (dec * 3600000000.0))
dms :: Int -> Int -> Double -> Either String Angle
dms degs mins secs
| mins < 0 || mins > 59 = Left ("Invalid arcminutes: " ++ show mins)
| secs < 0 || secs >= 60 = Left ("Invalid arcseconds: " ++ show secs)
| otherwise = Right (decimalDegrees d)
where
d =
signed
(fromIntegral (abs degs) + (fromIntegral mins / 60.0 :: Double) +
(secs / 3600.0))
(signum degs)
radians :: Double -> Angle
radians r = decimalDegrees (r / pi * 180.0)
arcLength :: Angle -> Length -> Length
arcLength a r = Length.metres (Length.toMetres r * toRadians a)
central :: Length -> Length -> Angle
central s r = radians (Length.toMetres s / Length.toMetres r)
clockwiseDifference :: Angle -> Angle -> Angle
clockwiseDifference f s = decimalDegrees d
where
d = cd (toDecimalDegrees f) (toDecimalDegrees s)
cd :: Double -> Double -> Double
cd d1 d2
| d2 < d1 = cd d1 (d2 + 360.0)
| otherwise = d2 - d1
negate :: Angle -> Angle
negate (Angle millis) = Angle (-millis)
normalise :: Angle -> Angle -> Angle
normalise a n = decimalDegrees dec
where
dec = mod' (toDecimalDegrees a + toDecimalDegrees n) 360.0
isNegative :: Angle -> Bool
isNegative (Angle millis) = millis < 0
isWithin :: Angle -> Angle -> Angle -> Bool
isWithin (Angle millis) (Angle low) (Angle high) = millis >= low && millis <= high
atan2 :: Double -> Double -> Angle
atan2 y x = radians (Prelude.atan2 y x)
asin :: Double -> Angle
asin a = radians (Prelude.asin a)
cos :: Angle -> Double
cos a = Prelude.cos (toRadians a)
sin :: Angle -> Double
sin a = Prelude.sin (toRadians a)
toRadians :: Angle -> Double
toRadians a = toDecimalDegrees a * pi / 180.0
toDecimalDegrees :: Angle -> Double
toDecimalDegrees (Angle uas) = fromIntegral uas / 3600000000.0
getDegrees :: Angle -> Int
getDegrees a = signed (field a 3600000000.0 360.0) (signum (microarcseconds a))
getArcminutes :: Angle -> Int
getArcminutes a = field a 60000000.0 60.0
getArcseconds :: Angle -> Int
getArcseconds a = field a 1000000.0 60.0
getArcmilliseconds :: Angle -> Int
getArcmilliseconds a = field a 1000.0 1000.0
field :: Angle -> Double -> Double -> Int
field (Angle uas) divisor modulo =
truncate (mod' (fromIntegral (abs uas) / divisor) modulo) :: Int
signed :: (Num a, Num b, Ord b) => a -> b -> a
signed n s
| s < 0 = -n
| otherwise = n
angle :: ReadP Angle
angle = degsMinsSecs <|> decimal
read :: String -> Maybe Angle
read s = readMaybe s :: (Maybe Angle)
degsMinsSecs :: ReadP Angle
degsMinsSecs = do
d' <- fmap fromIntegral integer
degSymbol
(m', s') <- option (0, 0.0) (minsSecs <|> minsOnly)
case dms d' m' s' of
Left err -> fail err
Right a -> return a
minsSecs :: ReadP (Int, Double)
minsSecs = do
m' <- natural
minSymbol
s' <- number
secSymbol
return (m', s')
minsOnly :: ReadP (Int, Double)
minsOnly = do
m' <- natural
minSymbol
return (m', 0.0)
decimal :: ReadP Angle
decimal = do
d <- double
degSymbol
return (decimalDegrees d)
degSymbol :: ReadP ()
degSymbol = do
_ <- char '°' <|> char 'd'
return ()
minSymbol :: ReadP ()
minSymbol = do
_ <- char '\'' <|> char '′' <|> char 'm'
return ()
secSymbol :: ReadP ()
secSymbol = do
_ <- string "\"" <|> string "''" <|> string "″" <|> string "s"
return ()