{-|
Module: Data.Astro.Star
Description: Stars
Copyright: Alexander Ignatyev, 2017

Stars.

= Examples

== /Location/

@
import Data.Astro.Time.JulianDate
import Data.Astro.Coordinate
import Data.Astro.Types
import Data.Astro.Star


ro :: GeographicCoordinates
ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))

dt :: LocalCivilTime
dt = lctFromYMDHMS (DH 1) 2017 6 25 10 29 0

-- Calculate location of Betelgeuse

betelgeuseEC1 :: EquatorialCoordinates1
betelgeuseEC1 = starCoordinates Betelgeuse
-- EC1 {e1Declination = DD 7.407064, e1RightAscension = DH 5.919529}

betelgeuseHC :: HorizonCoordinates
betelgeuseHC = ec1ToHC ro (lctUniversalTime dt) betelgeuseEC1
-- HC {hAltitude = DD 38.30483892505852, hAzimuth = DD 136.75755644642248}
@

== /Rise and Set/

@
import Data.Astro.Time.JulianDate
import Data.Astro.Coordinate
import Data.Astro.Types
import Data.Astro.Effects
import Data.Astro.CelestialObject.RiseSet
import Data.Astro.Star


ro :: GeographicCoordinates
ro = GeoC (fromDMS 51 28 40) (-(fromDMS 0 0 5))

today :: LocalCivilDate
today = lcdFromYMD (DH 1) 2017 6 25

-- Calculate location of Betelgeuse

rigelEC1 :: EquatorialCoordinates1
rigelEC1 = starCoordinates Rigel

verticalShift :: DecimalDegrees
verticalShift = refract (DD 0) 12 1012
-- DD 0.5660098245614035

rigelRiseSet :: RiseSetLCT
rigelRiseSet = riseAndSetLCT ro today verticalShift rigelEC1
-- RiseSet (2017-06-25 06:38:18.4713 +1.0,DD 102.51249855335433) (2017-06-25 17:20:33.4902 +1.0,DD 257.48750144664564)
@
-}


module Data.Astro.Star
(
  Star(..)
  , starCoordinates
)

where

import Data.Astro.Coordinate (EquatorialCoordinates1(..))
import Data.Astro.Types (fromDMS, fromHMS)


-- | Some of the stars

data Star = Polaris
            | AlphaCrucis
            | Sirius
            | Betelgeuse
            | Rigel
            | Vega
            | Antares
            | Canopus
            | Pleiades
              deriving (Int -> Star -> ShowS
[Star] -> ShowS
Star -> String
(Int -> Star -> ShowS)
-> (Star -> String) -> ([Star] -> ShowS) -> Show Star
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Star] -> ShowS
$cshowList :: [Star] -> ShowS
show :: Star -> String
$cshow :: Star -> String
showsPrec :: Int -> Star -> ShowS
$cshowsPrec :: Int -> Star -> ShowS
Show, Star -> Star -> Bool
(Star -> Star -> Bool) -> (Star -> Star -> Bool) -> Eq Star
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Star -> Star -> Bool
$c/= :: Star -> Star -> Bool
== :: Star -> Star -> Bool
$c== :: Star -> Star -> Bool
Eq)


-- | Returns Equatorial Coordinates for the given star

starCoordinates :: Star -> EquatorialCoordinates1
starCoordinates :: Star -> EquatorialCoordinates1
starCoordinates Star
Polaris = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
89 Int
15 Double
51) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
2 Int
31 Double
48.7)
starCoordinates Star
AlphaCrucis = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (-(Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
63 Int
5 Double
56.73)) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
12 Int
26 Double
35.9)
starCoordinates Star
Sirius = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (-(Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
16 Int
42 Double
58.02)) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
6 Int
45 Double
8.92)
starCoordinates Star
Betelgeuse = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
07 Int
24 Double
25.4304) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
5 Int
55 Double
10.30536)
starCoordinates Star
Rigel = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (-(Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
8 Int
12 Double
05.8981)) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
5 Int
14 Double
32.27210)
starCoordinates Star
Vega = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
38 Int
47 Double
01.2802) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
18 Int
36 Double
56.33635)
starCoordinates Star
Antares = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (-(Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
26 Int
25 Double
55.2094)) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
16 Int
29 Double
24.45970)
starCoordinates Star
Canopus = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (-(Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
52 Int
41 Double
44.3810)) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
6 Int
23 Double
57.10988)
starCoordinates Star
Pleiades = DecimalDegrees -> DecimalHours -> EquatorialCoordinates1
EC1 (Int -> Int -> Double -> DecimalDegrees
forall a. RealFrac a => Int -> Int -> a -> DecimalDegrees
fromDMS Int
24 Int
7 Double
00) (Int -> Int -> Double -> DecimalHours
forall a. RealFrac a => Int -> Int -> a -> DecimalHours
fromHMS Int
3 Int
47 Double
24)