diff --git a/KSP.cabal b/KSP.cabal new file mode 100644 --- /dev/null +++ b/KSP.cabal @@ -0,0 +1,43 @@ +name: KSP +version: 0.1 +synopsis: A library with the kerbal space program universe and demo code +description: This library is intended to help the haskell affine ksp player to + calculations within the ksp universe. +homepage: https://github.com/frosch03/kerbal +license: PublicDomain +license-file: LICENSE +author: Matthias Brettschneider +maintainer: frosch03@frosch03.de +category: Testing +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + -- Modules exported by the library. + exposed-modules: System.KSP.DataConstructors, + System.KSP.DataDestructors, + System.KSP.Datatypes, + System.KSP.Universe, + System.KSP.OrbitalMechanics, + System.KSP.Auxiliary, + System.KSP.KSP + + other-modules: System.KSP.Datatype.Object, + System.KSP.Datatype.Body, + System.KSP.Datatype.Orbit, + System.KSP.Datatype.System + + -- other-extensions: GADT + -- , FlexibleInstances + + build-depends: base >=4.6 && <= 4.8 + + -- Directories containing source files. + hs-source-dirs: src + + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/frosch03/kerbal.git diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,121 @@ +Creative Commons Legal Code + +CC0 1.0 Universal + + CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE + LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN + ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS + INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES + REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS + PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM + THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED + HEREUNDER. + +Statement of Purpose + +The laws of most jurisdictions throughout the world automatically confer +exclusive Copyright and Related Rights (defined below) upon the creator +and subsequent owner(s) (each and all, an "owner") of an original work of +authorship and/or a database (each, a "Work"). + +Certain owners wish to permanently relinquish those rights to a Work for +the purpose of contributing to a commons of creative, cultural and +scientific works ("Commons") that the public can reliably and without fear +of later claims of infringement build upon, modify, incorporate in other +works, reuse and redistribute as freely as possible in any form whatsoever +and for any purposes, including without limitation commercial purposes. +These owners may contribute to the Commons to promote the ideal of a free +culture and the further production of creative, cultural and scientific +works, or to gain reputation or greater distribution for their Work in +part through the use and efforts of others. + +For these and/or other purposes and motivations, and without any +expectation of additional consideration or compensation, the person +associating CC0 with a Work (the "Affirmer"), to the extent that he or she +is an owner of Copyright and Related Rights in the Work, voluntarily +elects to apply CC0 to the Work and publicly distribute the Work under its +terms, with knowledge of his or her Copyright and Related Rights in the +Work and the meaning and intended legal effect of CC0 on those rights. + +1. Copyright and Related Rights. A Work made available under CC0 may be +protected by copyright and related or neighboring rights ("Copyright and +Related Rights"). Copyright and Related Rights include, but are not +limited to, the following: + + i. the right to reproduce, adapt, distribute, perform, display, + communicate, and translate a Work; + ii. moral rights retained by the original author(s) and/or performer(s); +iii. publicity and privacy rights pertaining to a person's image or + likeness depicted in a Work; + iv. rights protecting against unfair competition in regards to a Work, + subject to the limitations in paragraph 4(a), below; + v. rights protecting the extraction, dissemination, use and reuse of data + in a Work; + vi. database rights (such as those arising under Directive 96/9/EC of the + European Parliament and of the Council of 11 March 1996 on the legal + protection of databases, and under any national implementation + thereof, including any amended or successor version of such + directive); and +vii. other similar, equivalent or corresponding rights throughout the + world based on applicable law or treaty, and any national + implementations thereof. + +2. Waiver. To the greatest extent permitted by, but not in contravention +of, applicable law, Affirmer hereby overtly, fully, permanently, +irrevocably and unconditionally waives, abandons, and surrenders all of +Affirmer's Copyright and Related Rights and associated claims and causes +of action, whether now known or unknown (including existing as well as +future claims and causes of action), in the Work (i) in all territories +worldwide, (ii) for the maximum duration provided by applicable law or +treaty (including future time extensions), (iii) in any current or future +medium and for any number of copies, and (iv) for any purpose whatsoever, +including without limitation commercial, advertising or promotional +purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each +member of the public at large and to the detriment of Affirmer's heirs and +successors, fully intending that such Waiver shall not be subject to +revocation, rescission, cancellation, termination, or any other legal or +equitable action to disrupt the quiet enjoyment of the Work by the public +as contemplated by Affirmer's express Statement of Purpose. + +3. Public License Fallback. Should any part of the Waiver for any reason +be judged legally invalid or ineffective under applicable law, then the +Waiver shall be preserved to the maximum extent permitted taking into +account Affirmer's express Statement of Purpose. In addition, to the +extent the Waiver is so judged Affirmer hereby grants to each affected +person a royalty-free, non transferable, non sublicensable, non exclusive, +irrevocable and unconditional license to exercise Affirmer's Copyright and +Related Rights in the Work (i) in all territories worldwide, (ii) for the +maximum duration provided by applicable law or treaty (including future +time extensions), (iii) in any current or future medium and for any number +of copies, and (iv) for any purpose whatsoever, including without +limitation commercial, advertising or promotional purposes (the +"License"). The License shall be deemed effective as of the date CC0 was +applied by Affirmer to the Work. Should any part of the License for any +reason be judged legally invalid or ineffective under applicable law, such +partial invalidity or ineffectiveness shall not invalidate the remainder +of the License, and in such case Affirmer hereby affirms that he or she +will not (i) exercise any of his or her remaining Copyright and Related +Rights in the Work or (ii) assert any associated claims and causes of +action with respect to the Work, in either case contrary to Affirmer's +express Statement of Purpose. + +4. Limitations and Disclaimers. + + a. No trademark or patent rights held by Affirmer are waived, abandoned, + surrendered, licensed or otherwise affected by this document. + b. Affirmer offers the Work as-is and makes no representations or + warranties of any kind concerning the Work, express, implied, + statutory or otherwise, including without limitation warranties of + title, merchantability, fitness for a particular purpose, non + infringement, or the absence of latent or other defects, accuracy, or + the present or absence of errors, whether or not discoverable, all to + the greatest extent permissible under applicable law. + c. Affirmer disclaims responsibility for clearing rights of other persons + that may apply to the Work or any use thereof, including without + limitation any person's Copyright and Related Rights in the Work. + Further, Affirmer disclaims responsibility for obtaining any necessary + consents, permissions or other rights required for any use of the + Work. + d. Affirmer understands and acknowledges that Creative Commons is not a + party to this document and has no duty or obligation with respect to + this CC0 or use of the Work. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,7 @@ + +# README + +## What is this + +KSP is intended to be an library, that enables the haskell affine +kerbel space program nerd to do calculations. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/System/KSP/Auxiliary.hs b/src/System/KSP/Auxiliary.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Auxiliary.hs @@ -0,0 +1,35 @@ +{-| +Module : Auxiliary +Description : This module contains some auxiliary functions. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Auxiliary + ( takeUntil + , firstJust + ) +where + +import Data.Maybe (fromJust, catMaybes) +import Data.List (find) + + + +-- | The function 'takeUntil' takes a test function and a list of +-- values. It returns all elements that do not pass the test function +-- until it reaches the first one that passes the test function, +-- otherwise it returns the empty list. +takeUntil :: (a -> Bool) -> [a] -> [a] +takeUntil f (x:xs) + | not (f x) + = x : (takeUntil f xs) + + | otherwise + = [] + +-- | 'firstJust' returns of a list of 'Maybe' values the first actual +-- 'Just' value or nothing if none is within the list. +firstJust :: [Maybe a] -> Maybe a +firstJust x = find (const True) (catMaybes x) + diff --git a/src/System/KSP/DataConstructors.hs b/src/System/KSP/DataConstructors.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/DataConstructors.hs @@ -0,0 +1,34 @@ +{-| +Module : DataConstructors +Description : The Module "System.KSP.DataConstructors" imports everything + that is a data constructor and exports them. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.DataConstructors + ( Object(..) + , Celestial(..) + , Body(..) + , Orbit(..) + , mkOrbit + , mkCircOrbit + , Height + , System(..) + , GravConst + , KSystem + ) +where + +import System.KSP.Datatype.Body +import System.KSP.Datatype.Orbit +import System.KSP.Datatype.System + +-- | 'GravConst' is the type of the gravitation constant, which is +-- obious a double. +type GravConst = Double + +-- | 'KSystem' creates a data constructor, that binds the +-- 'System.KSP.Datatype.System' to a 'System.KSP.Datatype.System' of +-- 'System.KSP.Datatype.Orbit's around 'System.KSP.Datatype.Body's. +type KSystem = System Body diff --git a/src/System/KSP/DataDestructors.hs b/src/System/KSP/DataDestructors.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/DataDestructors.hs @@ -0,0 +1,156 @@ +{-| +Module : DataDestructors +Description : This module defines functions to deconstruct the types +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.DataDestructors + ( getNextUp + , getPathUp + , getDivid + , sOrbitInSystem + , pathOBetween + , pathOBetween' + , pathBetween_ + , pathBetween' + , pathBetween + , pathSpeeds + , orbitalSpeed + , updateOrbit + , burnFromCircOrb + , burnAt + , burnAtApoapsis + , burnAtPeriapsis + ) +where + +import System.KSP.DataConstructors +import System.KSP.Auxiliary +import System.KSP.OrbitalMechanics + +import Data.Maybe (fromJust) + + +-- | 'getNextUp' takes a 'KSystem' system and a 'Body'. It returns the +-- body that the supplied body orbits. 'Nothing' is returned if the +-- supplied body is not found within the system. +getNextUp :: KSystem Body -> Body -> Maybe Body +getNextUp Empty _ = Nothing +getNextUp (System s) f + | (length $ filter ((== f) . snd) s) > 0 + = Just $ centerBody . fst . head $ filter ((== f) . snd) s + + | (length $ filter ((== f) . snd) s) == 0 + = firstJust $ map (((flip getNextUp) f) . system . celestial . snd) s + + | otherwise + = Nothing + + +-- | 'getPathUp' takes a 'KSystem' system and a 'Body'. It returns the +-- chain of body's that are orbiting each other. +getPathUp :: KSystem Body -> Body -> [Body] +getPathUp s f + = func (Just f) + where + func (Nothing) = [] + func (Just b) = b : func (getNextUp s b) + + +-- | 'getDivid' takes a 'KSystem' system and a __from__ 'Body' and a +-- __to__ 'Body'. For both bodys, the path up is calculated by +-- 'getPathUp' and the position, where they reach the same body is +-- returned (as Position and with the actual body). +getDivid :: KSystem Body -> Body -> Body -> (Int, Body) +getDivid s f t + = ((fst res), (fst . snd $ res)) + where fU = reverse $ getPathUp s f + tU = reverse $ getPathUp s t + ftU = zip fU tU + res = head $ reverse $ filter (\(_,(x1,x2)) -> x1 == x2) $ zip [1..] ftU + + +-- | 'sOrbitInSystem' takes a body, a 'KSystem' system and maybe +-- returns the orbit of the body. +sOrbitInSystem :: Body -> KSystem Body -> Maybe (Orbit Body) +sOrbitInSystem b Empty = Nothing +sOrbitInSystem b s@(System sys) + | (length $ filter ((== b) . snd) sys) > 0 + = Just . fst . head $ (filter ((== b) . snd) sys) + + | (length $ filter ((== b) . snd) sys) == 0 + = firstJust $ map (\x -> (sOrbitInSystem b) . system . celestial . snd $ x) sys + +-- | 'pathOBetween' takes a 'KSystem' system and a __from__ 'Body' and a +-- __to__ 'Body'. If one want's to reach the __to__ body from __from__ body +-- the bodys between and their orbit around their centerBody are +-- returnd. +pathOBetween :: KSystem Body -> Body -> Body -> [(Body, (Orbit Body))] +pathOBetween Empty _ _ = [] +pathOBetween s f t + = (zip fU fU') ++ (zip tUR tUR') + where (fU, d, tUR) = pathBetween' s f t + fU', tUR' :: [Orbit Body] + fU' = map (\x -> fromJust $ x `sOrbitInSystem` s) fU + tUR' = map (\x -> fromJust $ x `sOrbitInSystem` s) tUR + d' = (\x -> fromJust $ x `sOrbitInSystem` s) d + +-- | 'pathOBetween'' takes a 'KSystem' system and a __from__ 'Body' +-- and a __to__ 'Body'. If one want's to reach the __to__ body from +-- __from__ body the bodys between and their orbit around their +-- centerBody are returnd. They are returnd as triple, with the +-- overlapping body in the center of the triple and the path of the +-- __from__ body in the first element of the triple. The path of the +-- __to__ body in the last element of the triple. +pathOBetween' :: KSystem Body -> Body -> Body -> ([(Body, (Orbit Body))], (Body, (Orbit Body)), [(Body, (Orbit Body))]) +pathOBetween' s f t + = ((zip fU fU'), (d,d'), (zip tUR tUR')) + where (fU, d, tUR) = pathBetween' s f t + fU', tUR' :: [Orbit Body] + fU' = map (\x -> fromJust $ x `sOrbitInSystem` s) fU + tUR' = map (\x -> fromJust $ x `sOrbitInSystem` s) tUR + d' = (\x -> fromJust $ x `sOrbitInSystem` s) d + +-- | 'pathBetween' takes a 'KSystem' system and a __from__ 'Body' and +-- a __to__ 'Body'. If one want's to reach the __to__ body from +-- __from__ body the bodys between are returnd, including the common +-- body. +pathBetween :: KSystem Body -> Body -> Body -> [Body] +pathBetween s f t + = fU ++ (d:tUR) + where (fU, d, tUR) = pathBetween' s f t + + +-- | 'pathBetween_' takes a 'KSystem' system and a __from__ 'Body' and +-- a __to__ 'Body'. If one want's to reach the __to__ body from +-- __from__ body the bodys between are returnd, without the common +-- body. +pathBetween_ :: KSystem Body -> Body -> Body -> [Body] +pathBetween_ s f t + = fU ++ tUR + where (fU, d, tUR) = pathBetween' s f t + + +-- | 'pathBetween' takes a 'KSystem' system and __from__ 'Body' and a +-- __to__ 'Body'. If one want's to reach the __to__ body from __from__ +-- body the bodys between and their orbit around their centerBody are +-- returnd. They are returnd as triple, with the overlapping body in +-- the center of the triple and the path of the __from__ body in the +-- first element of the triple. The path of the __to__ body in the +-- last element of the triple. +pathBetween' :: KSystem Body -> Body -> Body -> ([Body], Body, [Body]) +pathBetween' s f t + = (fU, d, (reverse tU)) + where fU = takeUntil (== d) $ getPathUp s f + tU = takeUntil (== d) $ getPathUp s t + d = snd $ getDivid s f t + +-- | 'orbitalSpeed' returns the orbital velocity of the given orbit. +orbitalSpeed :: (Orbit Body) -> Speed +orbitalSpeed o = v o (semiMajor o) + +-- | 'pathSpeeds' takes the result of 'pathOBetween' and calculates the +-- corresponding orbital speeds. +pathSpeeds :: [(Body, (Orbit Body))] -> [Speed] +pathSpeeds = map (orbitalSpeed . snd) diff --git a/src/System/KSP/Datatype/Body.hs b/src/System/KSP/Datatype/Body.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Datatype/Body.hs @@ -0,0 +1,126 @@ +{-| +Module : Body +Description : The Body module contains the type definition of a Body. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Datatype.Body + ( Body(..) + , DeltaV + , Celestial(..) + , Object(..) + ) +where + +import System.KSP.Datatype.Object +import System.KSP.Datatype.System + + -------- +-- Body -- + -------- + +-- | 'DeltaV' is an alias for a 'Double' value. +type DeltaV = Double + +-- | The 'Body' type is the central data type within the KSP +-- library. It could be either 'Railed' or 'Movable' +-- +-- * 'Railed' is everything withing ksp that is a star, a planet +-- or a moon. They are static in their orbits and are therefore +-- called railed. +-- +-- * 'Movable' is every other part in ksp, that is physical. Here +-- they include deltaV counter, but are also modelled as celestial +-- objects. Actually in ksp orbits around movable parts arent +-- possible. Anyhow, within this data type such constructs are +-- doable. +data Body + = Railed { object :: Object, celestial :: Celestial } + | Movable { object :: Object, celestial :: Celestial, deltaV :: DeltaV } + -- deriving (Show) + +-- | Make 'Body' an instance of Equalty +instance Eq Body where + (Railed o1 _) == (Railed o2 _) = o1 == o2 + (Movable o1 _ _) == (Movable o2 _ _) = o1 == o2 + +-- | Make 'Body' an instance of Show +instance Show Body + where + showsPrec p (Railed o c) + = (showString "R/") + . (showString (name o)) + showsPrec p (Movable o c d) + = (showString "M/") + . (showString (name o)) +-- instance Show Body +-- where +-- showsPrec p (Railed o c) +-- = ((name o) ++) +-- . (showString ": ") +-- . ((show c) ++) +-- showsPrec p (Movable o c d) +-- = ((name o) ++) +-- . (showString ", dV:") +-- . ((show d) ++) +-- . ((show c) ++) + + + ------------- +-- Celestial -- + ------------- + +-- | The 'Celestial' type defines a celestial object within this +-- library. Every celestial object has +-- +-- * 'r' [m] the radius (from the bodys center) in meter +-- +-- * 'm' [kg] the mass of the object in kilo gramms +-- +-- * 'soi' [m] the /s/phere /o/f /i/nfluence of the object in meter +-- +-- * 'system' empty or a system of surronding objects. +-- +data Celestial + = Celestial { r :: Double + , m :: Double + , soi :: Double + , system :: System Body Body + } deriving (Eq, Show) + + + +-- | Make 'Celestial' an instance of Show +-- instance Show Celestial +-- where +-- showsPrec d (Celestial r m soi Empty) +-- = (showString "r:") +-- . ((show r) ++) +-- . (showString ", ") +-- . (showString "m:") +-- . ((show m) ++) +-- . (showString ", soi:") +-- . (if (soi < (1/0)) +-- then ((show soi) ++) +-- else (showString "inf")) +-- showsPrec d (Celestial r m soi (System s)) +-- = (showChar '(') +-- . (showString . show $ length s) +-- . (showChar ')') +-- . (showString "r:") +-- . ((show r) ++) +-- . (showString ", ") +-- . (showString "m:") +-- . ((show m) ++) +-- . (showString ", soi:") +-- . (if (soi < (1/0)) +-- then ((show soi) ++) +-- else (showString "inf")) +-- where +-- -- fun [] = (showChar '\n') +-- -- fun (x:xs) = (showChar '\n') . (showsPrec d $ snd x) . (fun xs) + + + + diff --git a/src/System/KSP/Datatype/Object.hs b/src/System/KSP/Datatype/Object.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Datatype/Object.hs @@ -0,0 +1,27 @@ +{-| +Module : Object +Description : The Object module contains the type definition of a Object. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Datatype.Object +where + + + + ---------- +-- Object -- + ---------- + +-- | An 'Object' is something named. +data Object + = Object { name :: String } + deriving (Eq) + + +-- | Make 'Object' an instance of 'Show' +instance Show Object + where + show = name + diff --git a/src/System/KSP/Datatype/Orbit.hs b/src/System/KSP/Datatype/Orbit.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Datatype/Orbit.hs @@ -0,0 +1,75 @@ +{-| +Module : Orbit +Description : The "Orbit" module contains the type definition of a 'Orbit'. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Datatype.Orbit +where + + + --------- +-- Orbit -- + --------- + +-- | The 'Orbit a' data type defines an orbit around a central body +-- 'centerBody'. +-- +-- * 'centerBody' is the body the orbit is around +-- +-- * 'apoapsis' is the height of the heighest point of the orbit +-- +-- * 'periapsis' is the height of the lowest point of the orbit +-- +-- * 'inclination' is the angle that the orbit is inclined against +-- the aquatorial plane +-- +-- * 'omega_big' is the longitude of the ascending node +-- +-- * 'omega_small' is the argument of the periapsis +data Orbit a + = Landed + | O { centerBody :: a + , apoapsis :: Double + , periapsis :: Double + , inclination :: Maybe Double + , omega_big :: Maybe Double -- Longitude of Ascending Node + , omega_small :: Maybe Double -- Argument of Periapsis + } + deriving (Eq) + +-- | The 'Height' is the height above ground level. +type Height = Double + +-- | 'mkOrbit' takes a body as well as apoapsis and periapsis and +-- of that creates an orbit. +mkOrbit :: a -> Height -> Height -> Orbit a +mkOrbit b ap per + = O { centerBody = b + , apoapsis = ap + , periapsis = per + , inclination = Nothing + , omega_big = Nothing + , omega_small = Nothing } + +-- | 'mkCircOrbit' is similar to 'mkOrbit' with the difference that it +-- creates a circular orbit. +mkCircOrbit :: a -> Height -> Orbit a +mkCircOrbit b h = mkOrbit b h h + + +-- | An orbit is only showable if the type of the centerBody is also +-- showable. As @ a @ should normaly be a 'Body' that should be not a +-- problem. +instance (Show a) => Show (Orbit a) + where + showsPrec _ Landed = showString "Landed" + showsPrec _ obt + = (showString "Around ") + . (showString $ show . centerBody $ obt) + . (showString " (") + . (showString $ show . apoapsis $ obt) + . (showChar '|') + . (showString $ show . periapsis $ obt) + . (showChar ')') diff --git a/src/System/KSP/Datatype/System.hs b/src/System/KSP/Datatype/System.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Datatype/System.hs @@ -0,0 +1,37 @@ +{-| +Module : System +Description : This module defines a system type. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Datatype.System +where + + +import System.KSP.Datatype.Orbit + +-- | The "System" module contains the type definition of a 'System'. +data System b a + = Empty + | System [(Orbit b, a)] + deriving (Eq) + + +-- | A 'System' could be shown, if both type parameters are also +-- filled with types, that are showable. +instance (Show a, Show b) => Show (System b a) + where + showsPrec _ (Empty) = (showString "") + showsPrec _ (System []) = (showString "") + showsPrec _ (System (sys:syss)) + = (showString . show . snd $ sys) + . (showString . show . fst $ sys) + . (showChar '\n') + . (showString . show $ (System syss)) + +-- | Making 'System b' a member of class functor. With this instance, +-- one could use map over 'System b'. +instance Functor (System b) where + fmap f (System xs) = System $ zip os (fmap f xs') + where (os, xs') = unzip xs diff --git a/src/System/KSP/Datatypes.hs b/src/System/KSP/Datatypes.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Datatypes.hs @@ -0,0 +1,34 @@ +{-| +Module : Datatypes +Description : Helper module to get data types and functions on them. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Datatypes + ( Object(..) + , Celestial(..) + , Body(..) + , Orbit(..) + , mkOrbit + , mkCircOrbit + , Height + , System(..) + , GravConst + , KSystem + , getNextUp + , getPathUp + , getDivid + , sOrbitInSystem + , pathOBetween + , pathOBetween' + , pathBetween_ + , pathBetween' + , pathSpeeds + , orbitalSpeed + ) + +where + +import System.KSP.DataConstructors +import System.KSP.DataDestructors diff --git a/src/System/KSP/KSP.hs b/src/System/KSP/KSP.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/KSP.hs @@ -0,0 +1,131 @@ +{-| +Module : KSP +Description : Kind of the main module. Start the interactive haskell + session with this module loaded to try things out. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental + += Simple Calculation + +The folowing should show some basic calculations that can be done +with this library. + +== Orbital Velocity + +The orbital velocity of something in an 80k orbit around kerbin could +be calculated by: + +>>> v_orbKerbin 80e3 +2278.9316462467027 + +The corresponding velocity of a 100k orbit is calculated via: + +>>> v_orbKerbin 100e3 +2246.1395532335027 + +== Paths + +Paths are always calculated within an existing system. Typically is +such a system the one around kerbol. + +>>> let ksp_system = (system . celestial $ kKerbol) :: KSystem Body +>>> :t ksp_system +ksp_system :: KSystem Body + +An easy path is the one between mun and minmus, via kerbin. This one +is calculated via: + +>>> pathBetween ksp_system kMun kMinmus +[R/Mun,R/Kerbin,R/Minmus] + +A much wieder path would be the one between kerbins moon minmus and +jools moon tylo. The path could be calculated via: + +>>> pathBetween ksp_system kMinmus kTylo +[R/Minmus,R/Kerbin,R/Kerbol,R/Jool,R/Tylo] + +== Paths with Orbits + +The function 'pathOBetween' calculates not only the path between two +given bodys. It also calculates the orbit, of each body. For the path +between mun and minmus, the orbits of mun and minmus (each around +kerbin) are also returned. + +>>> pathOBetween ksp_system kMun kMinmus +[(R/Mun,Around R/Kerbin (1.14e7|1.14e7)),(R/Minmus,Around R/Kerbin +(4.64e7|4.64e7))] + +== Path speeds + +To calculate the differences in deltaV between different orbits, do +the following. First calculate the 'pathOBetween', then take that +result and feed it into 'pathSpeeds' to get the orbital speeds along +the path. + +>>> let pathMunMinmus = pathOBetween ksp_system kMun kMinmus +>>> pathSpeeds pathMunMinmus +[542.4942415070719,274.11754059162286] + +The orbital velocity of the Mun is 542.5 m/s, the one around Minmus is +274.1 m/s. + +== Hohmann Transfair + +To do a hohmann transfair of a low kerbin orbit (100km) to the orbit +of Mun (47Mm) the following burns must be done. + +>>> let o1 = mkCircOrbit kKerbin 100e3 +>>> let o2 = mkCircOrbit kKerbin 47000e3 +>>> hohmann o1 o2 +(907.2791882798308,226.01062520890378) + +Lets save these two speeds: + +>>> let (v1, v2) = hohmann o1 o2 + +To calculate the transfair orbit from orbit o1 to orbit o2, the speed +v1 has to be applied within the orbit o1. + +>>> burnFromCircOrb o1 v1 +Around R/Kerbin (4.7000000000000596e7|100000.0) + +Again save that orbit into o12 + +>>> let o12 = burnFromCircOrb o1 v1 + +And apply the speed v2 to the transfair orbit o12: + +>>> burnAtApoapsis o12 v2 +Around R/Kerbin (4.700000000000125e7|4.7000000000000596e7) + +Which is the desired, circular orbit, with the height of round 47Mm. + +-} + + +module System.KSP.KSP +where + +import System.KSP.DataConstructors +import System.KSP.DataDestructors +import System.KSP.Universe + +import System.KSP.OrbitalMechanics + + + + +-- | To calculate the orbital velocity of a circular orbit around +-- kerbin, 'v_orbKerbin' uses 'v_orb' with 'kKerbin' as default +-- parameter. +v_orbKerbin :: Height -> Speed +v_orbKerbin = flip v_orb $ kKerbin + +-- | 'v_orb' calculates the velocity within an orbit around 'Body' b, +-- 'Height' h meters above the ground. +v_orb :: Height -> Body -> Speed +v_orb h b + = v (mkCircOrbit b h) ((r . celestial $ b) + h) + + diff --git a/src/System/KSP/OrbitalMechanics.hs b/src/System/KSP/OrbitalMechanics.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/OrbitalMechanics.hs @@ -0,0 +1,123 @@ +{-| +Module : OrbitalMechanics +Description : This module contains basic orbital mechanic functions. +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.OrbitalMechanics +where + +import System.KSP.DataConstructors + + +-- | 'Radius' of 'Orbit' at the current Position +type Radius = Double + +-- | 'Speed' is an alias for 'Double' +type Speed = Double + + +-- | 'var_G' [Nm^2/kg^2] is the Gravitation constant in newton meter +-- squared over kilo gramms squared +var_G :: GravConst +var_G = 6.674e-11 + + +-- | 'semiMajor' calculates the semi major axis of an orbit. +semiMajor :: Orbit Body -> Double +semiMajor o + = 0.5 * ((apoapsis o) + (periapsis o) + (2 * (r . celestial . centerBody $ o))) + + +-- | 'v' takes an orbit and a radius (from the center of the +-- centerBody) and calculates the orbital speed at that position. +v :: Orbit Body -> Radius -> Speed +v o radius = sqrt $ mue * ( (2/radius) - (1/(semiMajor o)) ) + where + mue = var_G * (m . celestial . centerBody $ o) + + +-- | 'v_e' calculates the escape velocity of that body. +v_e :: Body -> Speed +v_e b = sqrt $ 2 * mue / (r . celestial $ b) + where + mue = var_G * (m . celestial $ b) + + +-- | 'burnProgradeFromCircOrb' calculates the transformed orbit, after +-- the supplied delta V is applied to the initial orbit. +-- +-- A prograde burn is done through a positive 'Speed' parameter, a +-- retrograde burn respective through a negative 'Speed'. +burnFromCircOrb :: Orbit Body -> Speed -> Orbit Body +burnFromCircOrb o dV + = updateOrbit o (periapsis o) ((2 * a_new) - (2 * r_body) - (periapsis o)) + where + a_new = 1/((2/(semiMajor o))-(((v_circ+dV)^2)/mue)) + r_body = (r . celestial . centerBody $ o) + m_body = (m . celestial . centerBody $ o) + v_circ = v o (semiMajor o) + mue = var_G * m_body + +-- | 'updateOrbit' is a function that takes an orbit and two +-- heights. It updates the apoapsis with the bigger height and the +-- periapsis with the smaller. +updateOrbit :: Orbit Body -> Double -> Double -> Orbit Body +updateOrbit o h1 h2 + | h1 > h2 + = o { apoapsis = h1, periapsis = h2 } + + | otherwise + = o { apoapsis = h2, periapsis = h1 } + +-- | 'burnAt' calculates the new orbit after a burn of 'Speed' delta V +-- is applied to the given orbit. +-- +-- * 'f' is the function that calculates returns the distance of +-- the body within orbit, to the center body. Typical this is one +-- of 'apoapsis' or 'periapsis' +-- +-- * 'o' is the initial orbit +-- +-- * 'dV' is the amount of delta V to apply to the orbit. +burnAt :: (Orbit Body -> Double) -> Orbit Body -> Speed -> Orbit Body +burnAt f o dV + = updateOrbit o (f o) ((2 * a_new) - (2 * r_body) - (f o)) + where + a_new = 1/( (2/dist_body) - (((v_atPos+dV)^2)/mue) ) + dist_body = (f o) + r_body + r_body = (r . celestial . centerBody $ o) + m_body = (m . celestial . centerBody $ o) + v_atPos = v o dist_body + mue = var_G * m_body + + +-- | 'burnAtPeriapsis' calculates the new orbit after a burn of +-- 'Speed' delta V is applied to the given orbit at the periapsis. +burnAtPeriapsis :: Orbit Body -> Speed -> Orbit Body +burnAtPeriapsis = burnAt periapsis + +-- | 'burnAt' calculates the new orbit after a burn of 'Speed' delta V +-- is applied to the given orbit at the apoapsis. +burnAtApoapsis :: Orbit Body -> Speed -> Orbit Body +burnAtApoapsis = burnAt apoapsis + + +-- | 'hohmann' takes two orbits around the same centerBody. It +-- calculates both (v1 and v2 ) delta V changes for a hohmann +-- transfair. +hohmann :: Orbit Body -> Orbit Body -> (Double, Double) +hohmann o1 o2 + | centerBody o1 /= centerBody o2 + || o1 == o2 + = (0,0) +hohmann o1 o2 + = ( sqrt(mue/r1) * (sqrt((2*r2)/(r1+r2)) - 1) + , sqrt(mue/r2) * (1 - (sqrt((2*r1)/(r1+r2)))) + ) + where + mue = var_G * (m . celestial . centerBody $ o1) + r1 = (r . celestial . centerBody $ o1) + (apoapsis o1) + r2 = (r . celestial . centerBody $ o2) + (apoapsis o2) + diff --git a/src/System/KSP/Universe.hs b/src/System/KSP/Universe.hs new file mode 100644 --- /dev/null +++ b/src/System/KSP/Universe.hs @@ -0,0 +1,274 @@ +{-| +Module : Universe +Description : This module contains planets moons and kerbol + as well as the corresponding orbits +License : CC0 +Maintainer : frosch03@frosch03.de +Stability : experimental +-} +module System.KSP.Universe +where + +import System.KSP.Datatypes + +-- | 'kMoho' is the definition of Moho +kMoho + = Railed (Object "Moho" ) + (Celestial 250e3 2.5263617e21 9646663 Empty) + +-- | 'kGilly' is the definition of Gilly +kGilly + = Railed (Object "Gilly" ) + (Celestial 13e3 1.2420512e17 126123.27 Empty) + +-- | 'kEve' is the definition of Eve +kEve + = Railed (Object "Eve") + (Celestial 700e3 1.2244127e23 85109365 + (System [ (kGillyOrbit, kGilly) ])) + +-- | 'kMun' is the definition of Mun +kMun + = Railed (Object "Mun" ) + (Celestial 200e3 9.7600236e20 2429559.1 Empty) + +-- | 'kMinmus' is the definition of Minmus +kMinmus + = Railed (Object "Minmus") + (Celestial 60e3 2.6457897e19 2247428.4 Empty) + +-- | 'kKerbin' is the definition of Kerbin +kKerbin + = Railed (Object "Kerbin") + (Celestial 600e3 5.2915793e22 84159286 + (System [ (kMunOrbit, kMun) + , (kMinmusOrbit, kMinmus) ])) + +-- | 'kIke' is the definition of Ike +kIke + = Railed (Object "Ike" ) + (Celestial 130e3 2.7821949e20 1049598.9 Empty) + +-- | 'kDres' is the definition of Dres +kDres + = Railed (Object "Dres" ) + (Celestial 138e3 3.2191322e20 32832840 Empty) + +-- | 'kDuna' is the definition of Duna +kDuna + = Railed (Object "Duna" ) + (Celestial 320e3 4.5154812e21 47921949 + (System [ (kIkeOrbit, kIke) + , (kDresOrbit, kDres) ])) + +-- | 'kLaythe' is the definition of Laythe +kLaythe + = Railed (Object "Laythe") + (Celestial 500e3 2.9397663e22 3723645.8 Empty) + +-- | 'kVall' is the definition of Vall +kVall + = Railed (Object "Vall" ) + (Celestial 300e3 3.1088028e21 2406401.4 Empty) + +-- | 'kTylo' is the definition of Tylo +kTylo + = Railed (Object "Tylo" ) + (Celestial 600e3 4.2332635e22 10856518 Empty) + +-- | 'kBop' is the definition of Bop +kBop + = Railed (Object "Bop" ) + (Celestial 65e3 3.7261536e19 1221060.9 Empty) + +-- | 'kPol' is the definition of Pol +kPol + = Railed (Object "Pol" ) + (Celestial 44e3 1.0813636e19 1042138.9 Empty) + +-- | 'kJool' is the definition of Jool +kJool + = Railed (Object "Jool" ) + (Celestial 6e6 4.2332635e24 2.4559852e9 + (System [ (kLaytheOrbit, kLaythe) + , (kVallOrbit, kVall) + , (kTyloOrbit, kTylo) + , (kBopOrbit, kBop) + , (kPolOrbit, kPol) ])) + +-- | 'kEeloo' is the definition of Eeloo +kEeloo + = Railed (Object "Eeloo" ) + (Celestial 210e3 1.1149358e21 1.1908294e8 Empty) + +-- | 'kKerbol' is the definition of Kerbol +kKerbol + = Railed (Object "Kerbol") + (Celestial 261.6e6 1.7565670e28 (1/0) + (System [ (kMohoOrbit, kMoho) + , (kEveOrbit, kEve) + , (kKerbinOrbit, kKerbin) + , (kDunaOrbit, kDuna) + , (kJoolOrbit, kJool) + , (kEelooOrbit, kEeloo) ])) + + + +-- | 'kGillyOrbit' is the definition of the Orbit of Gilly +kGillyOrbit + = O { centerBody = kEve + , apoapsis = ( 8.825e6 - 700e3) + , periapsis = (14.175e6 - 700e3) + , inclination = Just 12 + , omega_big = Just 80 + , omega_small = Just 10 } + + +-- | 'kMunOrbit' is the definition of the Orbit of Mun +kMunOrbit + = O { centerBody = kKerbin + , apoapsis = ( 12e6 - 600e3) + , periapsis = (12e6 - 600e3) + , inclination = Nothing + , omega_big = Nothing + , omega_small = Nothing } + + +-- | 'kMinmusOrbit' is the definition of the Orbit of Minmus +kMinmusOrbit + = O { centerBody = kKerbin + , apoapsis = ( 47e6 - 600e3) + , periapsis = (47e6 - 600e3) + , inclination = Just 6 + , omega_big = Just 78 + , omega_small = Just 38 } + + +-- | 'kIkeOrbit' is the definition of the Orbit of Ike +kIkeOrbit + = O { centerBody = kDuna + , apoapsis = ( 3.296e6 - 320e3) + , periapsis = (3.104e6 - 320e3) + , inclination = Just 0.03 + , omega_big = Nothing + , omega_small = Nothing } + + +-- | 'kLaytheOrbit' is the definition of the Orbit of Laythe +kLaytheOrbit + = O { centerBody = kJool + , apoapsis = ( 27.184e6 - 6e6) + , periapsis = ( 27.184e6 - 6e6) + , inclination = Nothing + , omega_big = Nothing + , omega_small = Nothing } + + +-- | 'kVallOrbit' is the definition of the Orbit of Vall +kVallOrbit + = O { centerBody = kJool + , apoapsis = ( 43.152e6 - 6e6) + , periapsis = ( 43.152e6 - 6e6) + , inclination = Nothing + , omega_big = Nothing + , omega_small = Nothing } + + +-- | 'kTyloOrbit' is the definition of the Orbit of Tylo +kTyloOrbit + = O { centerBody = kJool + , apoapsis = ( 68.5e6 - 6e6) + , periapsis = ( 68.5e6 - 6e6) + , inclination = Just 0.025 + , omega_big = Nothing + , omega_small = Nothing } + + +-- | 'kBopOrbit' is the definition of the Orbit of Bop +kBopOrbit + = O { centerBody = kJool + , apoapsis = (158.6975e6 - 6e6) + , periapsis = ( 98.3025e6 - 6e6) + , inclination = Just 15 + , omega_big = Just 10 + , omega_small = Just 25 } + + +-- | 'kPolOrbit' is the definition of the Orbit of Pol +kPolOrbit + = O { centerBody = kJool + , apoapsis = (210.624206e6 - 6e6) + , periapsis = (149.155794e6 - 6e6) + , inclination = Just 4.25 + , omega_big = Just 2 + , omega_small = Just 15 } + + +-- | 'kMohoOrbit' is the definition of the Orbit of Moho +kMohoOrbit + = O { centerBody = kKerbol + , apoapsis = ( 6315765980 -261.6e6) + , periapsis = ( 4210510628 -261.6e6) + , inclination = Just 7 + , omega_big = Just 70 + , omega_small = Just 15 } + + +-- | 'kEveOrbit' is the definition of the Orbit of Eve +kEveOrbit + = O { centerBody = kKerbol + , apoapsis = ( 9931011387 -261.6e6) + , periapsis = ( 9734357701 -261.6e6) + , inclination = Just 2.1 + , omega_big = Just 15 + , omega_small = Nothing } + + +-- | 'kKerbinOrbit' is the definition of the Orbit of Kerbin +kKerbinOrbit + = O { centerBody = kKerbol + , apoapsis = ( 13599840256 -261.6e6) + , periapsis = (13599840256 -261.6e6) + , inclination = Nothing + , omega_big = Nothing + , omega_small = Nothing } + + +-- | 'kDunaOrbit' is the definition of the Orbit of Duna +kDunaOrbit + = O { centerBody = kKerbol + , apoapsis = ( 21783189163 -261.6e6) + , periapsis = (19669121365 -261.6e6) + , inclination = Just 0.06 + , omega_big = Just 135.5 + , omega_small = Nothing } + + +-- | 'kDresOrbit' is the definition of the Orbit of Dres +kDresOrbit + = O { centerBody = kKerbol + , apoapsis = ( 46761053522 -261.6e6) + , periapsis = (34917642884 -261.6e6) + , inclination = Just 5 + , omega_big = Just 280 + , omega_small = Just 90 } + + +-- | 'kJoolOrbit' is the definition of the Orbit of Jool +kJoolOrbit + = O { centerBody = kKerbol + , apoapsis = ( 72212238387 -261.6e6) + , periapsis = (65334882253 -261.6e6) + , inclination = Just 1.302 + , omega_big = Just 52 + , omega_small = Nothing } + + +-- | 'kEelooOrbit' is the definition of the Orbit of Eeloo +kEelooOrbit + = O { centerBody = kKerbol + , apoapsis = (113549713200 -261.6e6) + , periapsis = (66687926800 -261.6e6) + , inclination = Just 6.15 + , omega_big = Just 50 + , omega_small = Just 260 }