{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
module Geodetics.Grid (
GridClass (..),
GridPoint (..),
GridOffset (..),
polarOffset,
offsetScale,
offsetNegate,
applyOffset,
offsetDistance,
offsetDistanceSq,
offsetBearing,
gridOffset,
unsafeGridCoerce,
fromGridDigits,
toGridDigits
) where
import Data.Char
import Data.Function
import Data.Monoid (Monoid)
import Data.Semigroup (Semigroup, (<>))
import Geodetics.Altitude
import Geodetics.Geodetic
import Numeric.Units.Dimensional.Prelude hiding ((.))
import qualified Prelude as P
class GridClass r e | r->e where
fromGrid :: GridPoint r -> Geodetic e
toGrid :: r -> Geodetic e -> GridPoint r
gridEllipsoid :: r -> e
data GridPoint r = GridPoint {
eastings, northings, altGP :: Length Double,
gridBasis :: r
} deriving (Show)
instance Eq (GridPoint r) where
p1 == p2 =
eastings p1 == eastings p2 &&
northings p1 == northings p2 &&
altGP p1 == altGP p2
instance HasAltitude (GridPoint g) where
altitude = altGP
setAltitude h gp = gp{altGP = h}
data GridOffset = GridOffset {
deltaEast, deltaNorth, deltaAltitude :: Length Double
} deriving (Eq, Show)
instance Semigroup GridOffset where
g1 <> g2 = GridOffset (deltaEast g1 + deltaEast g2)
(deltaNorth g1 + deltaNorth g2)
(deltaAltitude g1 + deltaAltitude g2)
instance Monoid GridOffset where
mempty = GridOffset _0 _0 _0
mappend = (<>)
polarOffset :: Length Double -> Angle Double -> GridOffset
polarOffset r d = GridOffset (r * sin d) (r * cos d) _0
offsetScale :: Dimensionless Double -> GridOffset -> GridOffset
offsetScale s off = GridOffset (deltaEast off * s)
(deltaNorth off * s)
(deltaAltitude off * s)
offsetNegate :: GridOffset -> GridOffset
offsetNegate off = GridOffset (negate $ deltaEast off)
(negate $ deltaNorth off)
(negate $ deltaAltitude off)
applyOffset :: GridOffset -> GridPoint g -> GridPoint g
applyOffset off p = GridPoint (eastings p + deltaEast off)
(northings p + deltaNorth off)
(altitude p + deltaAltitude off)
(gridBasis p)
offsetDistance :: GridOffset -> Length Double
offsetDistance = sqrt . offsetDistanceSq
offsetDistanceSq :: GridOffset -> Area Double
offsetDistanceSq off =
deltaEast off ^ pos2 + deltaNorth off ^ pos2 + deltaAltitude off ^ pos2
offsetBearing :: GridOffset -> Angle Double
offsetBearing off = atan2 (deltaEast off) (deltaNorth off)
gridOffset :: GridPoint g -> GridPoint g -> GridOffset
gridOffset p1 p2 = GridOffset (eastings p2 - eastings p1)
(northings p2 - northings p1)
(altitude p2 - altitude p1)
unsafeGridCoerce :: b -> GridPoint a -> GridPoint b
unsafeGridCoerce base p = GridPoint (eastings p) (northings p) (altitude p) base
fromGridDigits :: Length Double -> String -> Maybe (Length Double, Length Double)
fromGridDigits sq ds = if all isDigit ds then Just (d, p) else Nothing
where
n = length ds
d = sum $ zipWith (*)
(map ((*~ one) . fromIntegral . digitToInt) ds)
(tail $ iterate (/ (10 *~ one)) sq)
p = sq / ((10 *~ one) ** (fromIntegral n *~ one))
toGridDigits ::
Length Double
-> Int
-> Length Double
-> Maybe (Integer, String)
toGridDigits sq n d =
if sq < (1 *~ kilo meter) || n < 0 || d < _0
then Nothing
else
Just (sqs, pad)
where
p :: Integer
p = 10 P.^ n
unit :: Length Double
unit = sq / (fromIntegral p *~ one)
u = round ((d / unit) /~ one)
(sqs, d1) = u `divMod` p
s = show d1
pad = if n == 0 then "" else replicate (n P.- length s) '0' ++ s