diff --git a/app/Main.hs b/app/Main.hs index 5577a57..aa1a74e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -10,6 +10,9 @@ import Control.Monad (replicateM) import Graphics.Gloss hiding (Point) +import Options.Applicative +import Data.Semigroup ((<>)) +import Safe -------------------------------------------------------------------------------- -- Random body generation @@ -78,6 +81,65 @@ csvFromInit :: Int -- ^ The number of time steps to keep -> String -- ^ CSV data csvFromInit n dt theta b = concat $ map (uncurry csvFromBodies) (take n $ steps dt theta b) +-------------------------------------------------------------------------------- +-- Commandline arguments +-------------------------------------------------------------------------------- + +data CmdLineOptions = CmdLineOptions + { optionNumberBodies :: Int + , optionColor :: Color + , optionFPS :: Int + } + +numberBodiesParser :: Parser Int +numberBodiesParser = option auto + (long "number-bodies" + <> short 'n' + <> help "Number of Bodies" + <> showDefault + <> value 300 + <> metavar "N") + +fpsParser :: Parser Int +fpsParser = option auto + (long "fps" + <> help "Frame rate" + <> showDefault + <> value 25 + <> metavar "FPS") + +splitOn :: Char -> String -> [String] +splitOn c s = case dropWhile (== c) s of + "" -> [] + s' -> w : splitOn c s'' + where (w, s'') = break (== c) s' + +colorParser :: Parser Color +colorParser = option (eitherReader readRGB) + (long "color" + <> short 'c' + <> help "Foreground color RGBA (0-255)" + <> showDefault + <> value white + <> metavar "R,G,B") + where readRGB s = + case mapM readEitherSafe $ splitOn ',' s of + Right (r:g:b:a:_) -> Right $ makeColorI r g b a + Right (r:g:b:_) -> Right $ makeColorI r g b 255 + Right (r:g:_) -> Right $ makeColorI r g 255 255 + Right (r:_) -> Right $ makeColorI r 255 255 255 + Right _ -> Right $ makeColorI 255 255 255 255 + Left s -> Left s + +optionsParser :: Parser CmdLineOptions +optionsParser = CmdLineOptions <$> + numberBodiesParser <*> colorParser <*> fpsParser + +opts :: ParserInfo CmdLineOptions +opts = info (optionsParser <**> helper) + (fullDesc + <> progDesc "Barnes-Hut N-body simulator" + <> header "orbit") -------------------------------------------------------------------------------- -- Gloss @@ -92,22 +154,20 @@ window :: Display window = InWindow "Orbit" (width, height) (offset, offset) displayBody :: Body -> Picture -displayBody b = translate (realToFrac x) (realToFrac y) $ circle (realToFrac (_bodyRadius b)) +displayBody b = translate (realToFrac x) (realToFrac y) $ circleSolid (realToFrac (_bodyRadius b)) where P (V3 x y _) = _bodyPosition b -displayBodies :: [Body] -> Picture -displayBodies = color white . Pictures . map displayBody - -drawing :: Picture -drawing = color white $ circle 80 +displayBodies :: Color -> [Body] -> Picture +displayBodies c = color c . Pictures . map displayBody main :: IO () main = do - bodies <- replicateM 300 randomBody + CmdLineOptions n c fps <- execParser opts + bodies <- replicateM n randomBody simulate window black - 25 + fps bodies - displayBodies + (displayBodies c) (\_ dt bs -> updateAll (realToFrac dt*1e6) 0.5 bs) diff --git a/orbit.cabal b/orbit.cabal index f45e4f3..6ce41ac 100644 --- a/orbit.cabal +++ b/orbit.cabal @@ -32,6 +32,8 @@ executable orbit-exe , linear , random , gloss + , optparse-applicative + , safe default-language: Haskell2010 test-suite orbit-test diff --git a/stack.yaml b/stack.yaml index 3214ec8..f381e82 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-9.10 +resolver: lts-10.3 # User packages to be built. # Various formats can be used as shown in the example below.