{-# LANGUAGE NamedFieldPuns #-}
module SwissEphemeris.ChartUtils (
GlyphInfo(..),
PlanetGlyphInfo,
glyphPlanet,
gravGroup,
gravGroupEasy,
gravGroup2,
gravGroup2Easy
)
where
import Foreign
import Foreign.C.String
import Foreign.SwissEphemerisExtras
import SwissEphemeris.Internal
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad (forM)
import Control.Exception (bracket)
import Data.Bifunctor (second)
import Data.Maybe (listToMaybe)
type PlanetGlyph = GravityObject Planet
data GlyphInfo a = GlyphInfo
{ GlyphInfo a -> Double
originalPosition :: Double
, GlyphInfo a -> (Double, Double)
glyphSize :: (Double, Double)
, GlyphInfo a -> Double
placedPosition :: Double
, GlyphInfo a -> Int
sectorNumber :: Int
, GlyphInfo a -> Int
sequenceNumber :: Int
, GlyphInfo a -> Int
levelNumber :: Int
, GlyphInfo a -> Double
glyphScale :: Double
, :: a
} deriving (Int -> GlyphInfo a -> ShowS
[GlyphInfo a] -> ShowS
GlyphInfo a -> String
(Int -> GlyphInfo a -> ShowS)
-> (GlyphInfo a -> String)
-> ([GlyphInfo a] -> ShowS)
-> Show (GlyphInfo a)
forall a. Show a => Int -> GlyphInfo a -> ShowS
forall a. Show a => [GlyphInfo a] -> ShowS
forall a. Show a => GlyphInfo a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GlyphInfo a] -> ShowS
$cshowList :: forall a. Show a => [GlyphInfo a] -> ShowS
show :: GlyphInfo a -> String
$cshow :: forall a. Show a => GlyphInfo a -> String
showsPrec :: Int -> GlyphInfo a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> GlyphInfo a -> ShowS
Show, GlyphInfo a -> GlyphInfo a -> Bool
(GlyphInfo a -> GlyphInfo a -> Bool)
-> (GlyphInfo a -> GlyphInfo a -> Bool) -> Eq (GlyphInfo a)
forall a. Eq a => GlyphInfo a -> GlyphInfo a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GlyphInfo a -> GlyphInfo a -> Bool
$c/= :: forall a. Eq a => GlyphInfo a -> GlyphInfo a -> Bool
== :: GlyphInfo a -> GlyphInfo a -> Bool
$c== :: forall a. Eq a => GlyphInfo a -> GlyphInfo a -> Bool
Eq)
type PlanetGlyphInfo = GlyphInfo Planet
glyphPlanet :: PlanetGlyphInfo -> Planet
glyphPlanet :: PlanetGlyphInfo -> Planet
glyphPlanet = PlanetGlyphInfo -> Planet
forall a. GlyphInfo a -> a
extraData
gravGroup
:: HasEclipticLongitude a
=> (Double, Double)
-> [(Planet, a)]
-> [Double]
-> Either String [PlanetGlyphInfo]
gravGroup :: (Double, Double)
-> [(Planet, a)] -> [Double] -> Either String [PlanetGlyphInfo]
gravGroup (Double, Double)
sz [(Planet, a)]
positions [Double]
sectors =
IO (Either String [PlanetGlyphInfo])
-> Either String [PlanetGlyphInfo]
forall a. IO a -> a
unsafePerformIO (IO (Either String [PlanetGlyphInfo])
-> Either String [PlanetGlyphInfo])
-> IO (Either String [PlanetGlyphInfo])
-> Either String [PlanetGlyphInfo]
forall a b. (a -> b) -> a -> b
$ do
(Double, Double)
-> [(Planet, a)]
-> (Ptr PlanetGlyph -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b.
HasEclipticLongitude a =>
(Double, Double)
-> [(Planet, a)] -> (Ptr PlanetGlyph -> IO b) -> IO b
withGrobs (Double, Double)
sz [(Planet, a)]
positions ((Ptr PlanetGlyph -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo]))
-> (Ptr PlanetGlyph -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr PlanetGlyph
grobs ->
[CDouble]
-> (Ptr CDouble -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Double]
sectors) ((Ptr CDouble -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo]))
-> (Ptr CDouble -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
sbdy ->
(Ptr CChar -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall b. (Ptr CChar -> IO b) -> IO b
allocaErrorMessage ((Ptr CChar -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo]))
-> (Ptr CChar -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
serr -> do
let nob :: CInt
nob = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [(Planet, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Planet, a)]
positions
nsectors :: CInt
nsectors = CInt -> CInt -> CInt
forall a. Ord a => a -> a -> a
max CInt
0 (CInt -> CInt) -> CInt -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
sectors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
CInt
retval <-
Ptr PlanetGlyph
-> CInt -> Ptr CDouble -> CInt -> Ptr CChar -> IO CInt
forall a.
Ptr (GravityObject a)
-> CInt -> Ptr CDouble -> CInt -> Ptr CChar -> IO CInt
c_grav_group Ptr PlanetGlyph
grobs CInt
nob Ptr CDouble
sbdy CInt
nsectors Ptr CChar
serr
if CInt
retval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then do
String
msg <- Ptr CChar -> IO String
peekCAString Ptr CChar
serr
Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo]))
-> Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ String -> Either String [PlanetGlyphInfo]
forall a b. a -> Either a b
Left String
msg
else do
[PlanetGlyph]
repositioned <- Int -> Ptr PlanetGlyph -> IO [PlanetGlyph]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nob) Ptr PlanetGlyph
grobs
[PlanetGlyphInfo]
glyphInfos <- (PlanetGlyph -> IO PlanetGlyphInfo)
-> [PlanetGlyph] -> IO [PlanetGlyphInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PlanetGlyph -> IO PlanetGlyphInfo
glyphInfo [PlanetGlyph]
repositioned
Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo]))
-> ([PlanetGlyphInfo] -> Either String [PlanetGlyphInfo])
-> [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PlanetGlyphInfo] -> Either String [PlanetGlyphInfo]
forall a b. b -> Either a b
Right ([PlanetGlyphInfo] -> IO (Either String [PlanetGlyphInfo]))
-> [PlanetGlyphInfo] -> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ [PlanetGlyphInfo]
glyphInfos
gravGroupEasy :: HasEclipticLongitude a
=> Double
-> [(Planet, a)]
-> [HouseCusp]
-> Either String [PlanetGlyphInfo]
gravGroupEasy :: Double
-> [(Planet, a)] -> [Double] -> Either String [PlanetGlyphInfo]
gravGroupEasy = ((Double, Double)
-> [(Planet, a)] -> [Double] -> Either String [PlanetGlyphInfo])
-> Double
-> [(Planet, a)]
-> [Double]
-> Either String [PlanetGlyphInfo]
forall c.
HasEclipticLongitude c =>
((Double, Double)
-> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo])
-> Double
-> [(Planet, c)]
-> [Double]
-> Either String [PlanetGlyphInfo]
gravGroupEasy' (Double, Double)
-> [(Planet, a)] -> [Double] -> Either String [PlanetGlyphInfo]
forall a.
HasEclipticLongitude a =>
(Double, Double)
-> [(Planet, a)] -> [Double] -> Either String [PlanetGlyphInfo]
gravGroup
gravGroup2
:: HasEclipticLongitude a
=> (Double, Double)
-> [(Planet, a)]
-> [Double]
-> Bool
-> Either String [PlanetGlyphInfo]
gravGroup2 :: (Double, Double)
-> [(Planet, a)]
-> [Double]
-> Bool
-> Either String [PlanetGlyphInfo]
gravGroup2 (Double, Double)
sz [(Planet, a)]
positions [Double]
sectors Bool
allowShift =
let sectors' :: [Double]
sectors' = if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
sectors then [Double
0, Double
360.0] else [Double]
sectors
in IO (Either String [PlanetGlyphInfo])
-> Either String [PlanetGlyphInfo]
forall a. IO a -> a
unsafePerformIO (IO (Either String [PlanetGlyphInfo])
-> Either String [PlanetGlyphInfo])
-> IO (Either String [PlanetGlyphInfo])
-> Either String [PlanetGlyphInfo]
forall a b. (a -> b) -> a -> b
$ do
(Double, Double)
-> [(Planet, a)]
-> (Ptr PlanetGlyph -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b.
HasEclipticLongitude a =>
(Double, Double)
-> [(Planet, a)] -> (Ptr PlanetGlyph -> IO b) -> IO b
withGrobs (Double, Double)
sz [(Planet, a)]
positions ((Ptr PlanetGlyph -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo]))
-> (Ptr PlanetGlyph -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr PlanetGlyph
grobs ->
[CDouble]
-> (Ptr CDouble -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray ((Double -> CDouble) -> [Double] -> [CDouble]
forall a b. (a -> b) -> [a] -> [b]
map Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac [Double]
sectors') ((Ptr CDouble -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo]))
-> (Ptr CDouble -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr CDouble
sbdy ->
(Ptr CChar -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall b. (Ptr CChar -> IO b) -> IO b
allocaErrorMessage ((Ptr CChar -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo]))
-> (Ptr CChar -> IO (Either String [PlanetGlyphInfo]))
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
serr -> do
let nob :: CInt
nob = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [(Planet, a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Planet, a)]
positions
nsectors :: CInt
nsectors = CInt -> CInt -> CInt
forall a. Ord a => a -> a -> a
max CInt
0 (CInt -> CInt) -> CInt -> CInt
forall a b. (a -> b) -> a -> b
$ Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> Int -> CInt
forall a b. (a -> b) -> a -> b
$ [Double] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Double]
sectors Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
mayShift :: CBool
mayShift = Bool -> CBool
forall a. Num a => Bool -> a
fromBool Bool
allowShift
CInt
retval <-
Ptr PlanetGlyph
-> CInt -> Ptr CDouble -> CInt -> CBool -> Ptr CChar -> IO CInt
forall a.
Ptr (GravityObject a)
-> CInt -> Ptr CDouble -> CInt -> CBool -> Ptr CChar -> IO CInt
c_grav_group2 Ptr PlanetGlyph
grobs CInt
nob Ptr CDouble
sbdy CInt
nsectors CBool
mayShift Ptr CChar
serr
if CInt
retval CInt -> CInt -> Bool
forall a. Ord a => a -> a -> Bool
< CInt
0 then do
String
msg <- Ptr CChar -> IO String
peekCAString Ptr CChar
serr
Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo]))
-> Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ String -> Either String [PlanetGlyphInfo]
forall a b. a -> Either a b
Left String
msg
else do
[PlanetGlyph]
repositioned <- Int -> Ptr PlanetGlyph -> IO [PlanetGlyph]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
nob) Ptr PlanetGlyph
grobs
[PlanetGlyphInfo]
glyphInfos <- (PlanetGlyph -> IO PlanetGlyphInfo)
-> [PlanetGlyph] -> IO [PlanetGlyphInfo]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PlanetGlyph -> IO PlanetGlyphInfo
glyphInfo [PlanetGlyph]
repositioned
Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo]))
-> ([PlanetGlyphInfo] -> Either String [PlanetGlyphInfo])
-> [PlanetGlyphInfo]
-> IO (Either String [PlanetGlyphInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PlanetGlyphInfo] -> Either String [PlanetGlyphInfo]
forall a b. b -> Either a b
Right ([PlanetGlyphInfo] -> IO (Either String [PlanetGlyphInfo]))
-> [PlanetGlyphInfo] -> IO (Either String [PlanetGlyphInfo])
forall a b. (a -> b) -> a -> b
$ [PlanetGlyphInfo]
glyphInfos
gravGroup2Easy :: HasEclipticLongitude a
=> Double
-> [(Planet, a)]
-> [HouseCusp]
-> Bool
-> Either String [PlanetGlyphInfo]
gravGroup2Easy :: Double
-> [(Planet, a)]
-> [Double]
-> Bool
-> Either String [PlanetGlyphInfo]
gravGroup2Easy Double
w' [(Planet, a)]
ps' [Double]
hs' Bool
shift' =
((Double, Double)
-> [(Planet, a)] -> [Double] -> Either String [PlanetGlyphInfo])
-> Double
-> [(Planet, a)]
-> [Double]
-> Either String [PlanetGlyphInfo]
forall c.
HasEclipticLongitude c =>
((Double, Double)
-> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo])
-> Double
-> [(Planet, c)]
-> [Double]
-> Either String [PlanetGlyphInfo]
gravGroupEasy' (\(Double, Double)
w [(Planet, a)]
ps [Double]
hs -> (Double, Double)
-> [(Planet, a)]
-> [Double]
-> Bool
-> Either String [PlanetGlyphInfo]
forall a.
HasEclipticLongitude a =>
(Double, Double)
-> [(Planet, a)]
-> [Double]
-> Bool
-> Either String [PlanetGlyphInfo]
gravGroup2 (Double, Double)
w [(Planet, a)]
ps [Double]
hs Bool
shift') Double
w' [(Planet, a)]
ps' [Double]
hs'
withGrobs
:: HasEclipticLongitude a
=> (Double, Double)
-> [(Planet, a)]
-> (Ptr PlanetGlyph -> IO b)
-> IO b
withGrobs :: (Double, Double)
-> [(Planet, a)] -> (Ptr PlanetGlyph -> IO b) -> IO b
withGrobs (Double
lwidth, Double
rwidth) [(Planet, a)]
positions Ptr PlanetGlyph -> IO b
f = do
IO [PlanetGlyph]
-> ([PlanetGlyph] -> IO ()) -> ([PlanetGlyph] -> IO b) -> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
IO [PlanetGlyph]
mkGrobList
[PlanetGlyph] -> IO ()
forall a. [GravityObject a] -> IO ()
freePlanetPtrs
([PlanetGlyph] -> (Ptr PlanetGlyph -> IO b) -> IO b
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
`withArray` Ptr PlanetGlyph -> IO b
f)
where
mkGrobList :: IO [PlanetGlyph]
mkGrobList = [(Planet, a)]
-> ((Planet, a) -> IO PlanetGlyph) -> IO [PlanetGlyph]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Planet, a)]
positions (((Planet, a) -> IO PlanetGlyph) -> IO [PlanetGlyph])
-> ((Planet, a) -> IO PlanetGlyph) -> IO [PlanetGlyph]
forall a b. (a -> b) -> a -> b
$ \(Planet
planet, a
pos) -> do
Ptr Planet
planetPtr <- Planet -> IO (Ptr Planet)
forall a. Storable a => a -> IO (Ptr a)
new Planet
planet
PlanetGlyph -> IO PlanetGlyph
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlanetGlyph -> IO PlanetGlyph) -> PlanetGlyph -> IO PlanetGlyph
forall a b. (a -> b) -> a -> b
$
GravityObject :: forall a.
CDouble
-> CDouble
-> CDouble
-> CDouble
-> CInt
-> CInt
-> CInt
-> CDouble
-> Ptr a
-> GravityObject a
GravityObject {
pos :: CDouble
pos = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> CDouble) -> (a -> Double) -> a -> CDouble
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Double
forall a. HasEclipticLongitude a => a -> Double
getEclipticLongitude (a -> CDouble) -> a -> CDouble
forall a b. (a -> b) -> a -> b
$ a
pos
, lsize :: CDouble
lsize = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
lwidth
, rsize :: CDouble
rsize = Double -> CDouble
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
rwidth
, ppos :: CDouble
ppos = CDouble
0.0
, sector_no :: CInt
sector_no = CInt
0
, sequence_no :: CInt
sequence_no = CInt
0
, level_no :: CInt
level_no = CInt
0
, scale :: CDouble
scale = CDouble
0.0
, dp :: Ptr Planet
dp = Ptr Planet
planetPtr
}
freePlanetPtrs :: [GravityObject a] -> IO ()
freePlanetPtrs = (GravityObject a -> IO ()) -> [GravityObject a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Ptr a -> IO ()
forall a. Ptr a -> IO ()
free (Ptr a -> IO ())
-> (GravityObject a -> Ptr a) -> GravityObject a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GravityObject a -> Ptr a
forall a. GravityObject a -> Ptr a
dp)
glyphInfo :: PlanetGlyph -> IO PlanetGlyphInfo
glyphInfo :: PlanetGlyph -> IO PlanetGlyphInfo
glyphInfo GravityObject{CDouble
pos :: CDouble
pos :: forall a. GravityObject a -> CDouble
pos, CDouble
lsize :: CDouble
lsize :: forall a. GravityObject a -> CDouble
lsize, CDouble
rsize :: CDouble
rsize :: forall a. GravityObject a -> CDouble
rsize, CDouble
ppos :: CDouble
ppos :: forall a. GravityObject a -> CDouble
ppos, CInt
sector_no :: CInt
sector_no :: forall a. GravityObject a -> CInt
sector_no, CInt
sequence_no :: CInt
sequence_no :: forall a. GravityObject a -> CInt
sequence_no, CInt
level_no :: CInt
level_no :: forall a. GravityObject a -> CInt
level_no, CDouble
scale :: CDouble
scale :: forall a. GravityObject a -> CDouble
scale, Ptr Planet
dp :: Ptr Planet
dp :: forall a. GravityObject a -> Ptr a
dp} = do
Planet
planet' <- Ptr Planet -> IO Planet
forall a. Storable a => Ptr a -> IO a
peek Ptr Planet
dp
PlanetGlyphInfo -> IO PlanetGlyphInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlanetGlyphInfo -> IO PlanetGlyphInfo)
-> PlanetGlyphInfo -> IO PlanetGlyphInfo
forall a b. (a -> b) -> a -> b
$
GlyphInfo :: forall a.
Double
-> (Double, Double)
-> Double
-> Int
-> Int
-> Int
-> Double
-> a
-> GlyphInfo a
GlyphInfo {
originalPosition :: Double
originalPosition = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
pos
, glyphSize :: (Double, Double)
glyphSize = (CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
lsize, CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
rsize)
, placedPosition :: Double
placedPosition = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
ppos
, sectorNumber :: Int
sectorNumber = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sector_no
, sequenceNumber :: Int
sequenceNumber = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
sequence_no
, levelNumber :: Int
levelNumber = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
level_no
, glyphScale :: Double
glyphScale = CDouble -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac CDouble
scale
, extraData :: Planet
extraData = Planet
planet'
}
gravGroupEasy' :: HasEclipticLongitude c =>
((Double, Double) -> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo])
-> Double
-> [(Planet, c)]
-> [Double]
-> Either String [PlanetGlyphInfo]
gravGroupEasy' :: ((Double, Double)
-> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo])
-> Double
-> [(Planet, c)]
-> [Double]
-> Either String [PlanetGlyphInfo]
gravGroupEasy' (Double, Double)
-> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo]
gravGroupF Double
w [(Planet, c)]
ps [Double]
s = do
[PlanetGlyphInfo]
glyphs <- (Double, Double)
-> [(Planet, c)] -> [Double] -> Either String [PlanetGlyphInfo]
gravGroupF (Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2,Double
wDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) [(Planet, c)]
ps' ([Double]
s' [Double] -> [Double] -> [Double]
forall a. [a] -> [a] -> [a]
++ [Double]
coda)
[PlanetGlyphInfo] -> Either String [PlanetGlyphInfo]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([PlanetGlyphInfo] -> Either String [PlanetGlyphInfo])
-> [PlanetGlyphInfo] -> Either String [PlanetGlyphInfo]
forall a b. (a -> b) -> a -> b
$ (PlanetGlyphInfo -> PlanetGlyphInfo)
-> [PlanetGlyphInfo] -> [PlanetGlyphInfo]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Double -> PlanetGlyphInfo -> PlanetGlyphInfo
forall a. Maybe Double -> GlyphInfo a -> GlyphInfo a
recenterGlyph Maybe Double
s1) [PlanetGlyphInfo]
glyphs
where
coda :: [Double]
coda =
if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
s' then [Double]
forall a. Monoid a => a
mempty else [[Double] -> Double
forall a. [a] -> a
head [Double]
s' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
360]
s1 :: Maybe Double
s1 = [Double] -> Maybe Double
forall a. [a] -> Maybe a
listToMaybe [Double]
s
s' :: [Double]
s' = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Double -> Double -> Double
relativeTo Maybe Double
s1) [Double]
s
ps' :: [(Planet, c)]
ps' = ((Planet, c) -> (Planet, c)) -> [(Planet, c)] -> [(Planet, c)]
forall a b. (a -> b) -> [a] -> [b]
map ((c -> c) -> (Planet, c) -> (Planet, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (\c
p -> c -> Double -> c
forall a. HasEclipticLongitude a => a -> Double -> a
setEclipticLongitude c
p (Maybe Double -> Double -> Double
relativeTo Maybe Double
s1 (c -> Double
forall a. HasEclipticLongitude a => a -> Double
getEclipticLongitude c
p)))) [(Planet, c)]
ps
recenterGlyph :: Maybe Double -> GlyphInfo a -> GlyphInfo a
recenterGlyph :: Maybe Double -> GlyphInfo a -> GlyphInfo a
recenterGlyph Maybe Double
s1 g :: GlyphInfo a
g@GlyphInfo{Double
originalPosition :: Double
originalPosition :: forall a. GlyphInfo a -> Double
originalPosition, Double
placedPosition :: Double
placedPosition :: forall a. GlyphInfo a -> Double
placedPosition} =
GlyphInfo a
g{
originalPosition :: Double
originalPosition = Maybe Double -> Double -> Double
unrelativeTo Maybe Double
s1 Double
originalPosition,
placedPosition :: Double
placedPosition = Maybe Double -> Double -> Double
unrelativeTo Maybe Double
s1 Double
placedPosition
}
relativeTo :: Maybe Double -> Double -> Double
relativeTo :: Maybe Double -> Double -> Double
relativeTo Maybe Double
Nothing Double
pos = Double
pos
relativeTo (Just Double
s1) Double
pos =
let corrected :: Double
corrected = Double
pos Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
s1
in if Double
corrected Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 then
Double
corrected Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
360
else
Double
corrected
unrelativeTo :: Maybe Double -> Double -> Double
unrelativeTo :: Maybe Double -> Double -> Double
unrelativeTo Maybe Double
Nothing Double
pos = Double
pos
unrelativeTo (Just Double
s1) Double
pos =
let undone :: Double
undone = Double
pos Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
s1
in if Double
undone Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
360 then
Double
undone Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
360
else
Double
undone