Permalink
Browse files

Maneuver.hs added.

  • Loading branch information...
1 parent 92ae139 commit 7c26eec59ba19bd0401dfcc66831c7a6fe1042d0 @bjornbm committed Jun 21, 2011
Showing with 43 additions and 0 deletions.
  1. +37 −0 Astro/Orbit/Maneuver.hs
  2. +6 −0 Setup.lhs
@@ -0,0 +1,37 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Astro.Orbit.Maneuver where
+
+import Numeric.Units.Dimensional.Prelude
+import qualified Prelude
+import Astro.Time
+import Astro.Orbit.Types
+import Astro.Trajectory
+import Data.List
+
+
+data Maneuver a = ImpulsiveRTN { dvr :: Velocity a
+ , dvt :: Velocity a
+ , dvn :: Velocity a
+ }
+
+data ManTrajectory t a = forall x. Trajectory x t a => MT (x t a) (Maybe (At t a (Maneuver a)))
+
+applyManeuver :: Trajectory x t a => x t a -> At t a (Maneuver a) -> ManTrajectory t a
+applyManeuver x = MT x . Just
+
+applyManeuvers :: Trajectory x t a => x t a -> [At t a (Maneuver a)] -> ManTrajectory t a
+applyManeuvers x [] = MT x Nothing
+applyManeuvers x [m] = applyManeuver x m -- Redundant but avoids extra layer with Nothing.
+applyManeuvers x (m:ms) = foldl' applyManeuver (applyManeuver x m) ms
+
+
+instance (Fractional a, Ord a) => Trajectory ManTrajectory t a where
+ startTime (MT x _) = startTime x
+ endTime (MT x _) = endTime x
+ ephemeris (MT x Nothing) = ephemeris x
+ ephemeris (MT x (Just (man`At`tman))) = map massage . ephemeris x
+ where
+ massage (m`At`t) = (if t < tman then m else m) `At` t -- NOOP!!! TODO!!!
View
@@ -0,0 +1,6 @@
+#!/usr/bin/runhaskell
+> module Main where
+> import Distribution.Simple
+> main :: IO ()
+> main = defaultMain
+

0 comments on commit 7c26eec

Please sign in to comment.