module Data.Geo.Jord.Angle
(
Angle
, decimalDegrees
, dms
, radians
, arcLength
, central
, isNegative
, isWithin
, negate'
, normalise
, asin'
, atan2'
, cos'
, sin'
, getDegrees
, getArcminutes
, getArcseconds
, getArcmilliseconds
, toDecimalDegrees
, toRadians
, angleP
, readAngle
) where
import Control.Applicative ((<|>))
import Data.Fixed (mod')
import Text.ParserCombinators.ReadP (ReadP, char, option, readP_to_S, string)
import Text.Printf (printf)
import Text.Read (readMaybe)
import Data.Geo.Jord.Length
import Data.Geo.Jord.Parser
import Data.Geo.Jord.Quantity
newtype Angle =
Angle
{ microarcseconds :: Int
}
deriving (Eq)
instance Read Angle where
readsPrec _ = readP_to_S angleP
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
instance Quantity Angle where
add a1 a2 = Angle (microarcseconds a1 + microarcseconds a2)
sub a1 a2 = Angle (microarcseconds a1 - microarcseconds a2)
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 = metres (toMetres r * toRadians a)
central :: Length -> Length -> Angle
central s r = radians (toMetres s / toMetres r)
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 (atan2 y x)
asin' :: Double -> Angle
asin' a = radians (asin a)
cos' :: Angle -> Double
cos' a = cos (toRadians a)
sin' :: Angle -> Double
sin' a = 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
angleP :: ReadP Angle
angleP = degsMinsSecs <|> decimal
readAngle :: String -> Maybe Angle
readAngle 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 ()