Refactor and reformat

This commit is contained in:
Dimitri Lozeve 2017-07-25 23:19:18 +02:00
parent 8d31a13c30
commit 35c0cc4446
2 changed files with 23 additions and 18 deletions

View file

@ -7,24 +7,34 @@ import Linear.V3
import Graphics.Gloss hiding (Point) import Graphics.Gloss hiding (Point)
--------------------------------------------------------------------------------
-- CSV export
--------------------------------------------------------------------------------
csvFromPoint :: Point V3 Double -> String csvFromPoint :: Point V3 Double -> String
csvFromPoint (P (V3 x y z)) = csvFromPoint (P (V3 x y z)) =
show x ++ "," ++ show y ++ "," ++ show z show x ++ "," ++ show y ++ "," ++ show z
csvFromBodies :: [Body] -> [String] csvFromBodies :: [Body] -> [String]
csvFromBodies [] = [] csvFromBodies =
csvFromBodies (x:xs) = map (\ x ->
(bodyName x ++ "," bodyName x ++
++ (show $ bodyMass x) ++ "," "," ++
++ (csvFromPoint $ bodyPosition x) ++ "\n") show (bodyMass x) ++
:(csvFromBodies xs) "," ++ csvFromPoint (bodyPosition x) ++ "\n")
steps :: Int -> Double -> [Body] -> IO () steps :: Int -> Double -> [Body] -> IO ()
steps 0 _ _ = return () steps 0 _ _ = return ()
steps n dt bodies = do steps n dt bodies = do
putStr . concat $ map ((++) (show n ++ ",")) $ csvFromBodies bodies putStr . concat $ map ((show n ++ ",") ++) $ csvFromBodies bodies
steps (n-1) dt (updateAll dt bodies) steps (n-1) dt (updateAll dt bodies)
--------------------------------------------------------------------------------
-- Gloss
--------------------------------------------------------------------------------
width, height, offset :: Int width, height, offset :: Int
width = 1000 width = 1000
height = 750 height = 750
@ -38,7 +48,7 @@ displayBody b = translate (realToFrac x/1e9) (realToFrac y/1e9) $ circle (realTo
where P (V3 x y _) = bodyPosition b where P (V3 x y _) = bodyPosition b
displayBodies :: [Body] -> Picture displayBodies :: [Body] -> Picture
displayBodies = (color white) . Pictures . (map displayBody) displayBodies = color white . Pictures . map displayBody
drawing :: Picture drawing :: Picture
drawing = color white $ circle 80 drawing = color white $ circle 80

View file

@ -1,11 +1,6 @@
module Lib ( module Lib (
gravity, gravity,
Body, Body(..),
bodyName,
bodyRadius,
bodyMass,
bodyPosition,
bodySpeed,
bodyDistance, bodyDistance,
field, field,
acceleration, acceleration,
@ -55,14 +50,14 @@ bodyDistance body1 body2 =
-- Field created by a body on a certain position -- Field created by a body on a certain position
field :: Body -> Point V3 Double -> V3 Double field :: Body -> Point V3 Double -> V3 Double
field body pos = field body pos =
unP $ (gravity * m / r**2) *^ (normalize vec) unP $ (gravity * m / r**2) *^ normalize vec
where m = bodyMass body where m = bodyMass body
vec = (bodyPosition body) - pos vec = bodyPosition body - pos
r = norm vec r = norm vec
-- Acceleration given to a body by its neighbours -- Acceleration given to a body by its neighbours
acceleration :: Body -> [Body] -> V3 Double acceleration :: Body -> [Body] -> V3 Double
acceleration body = foldr f (fromInteger 0) acceleration body = foldr f 0
where f neighbour acc = where f neighbour acc =
acc + field neighbour (bodyPosition body) acc + field neighbour (bodyPosition body)
@ -81,7 +76,7 @@ update dt (Body name r m pos speed) neighbours =
-- Update all bodies with a timestep dt -- Update all bodies with a timestep dt
updateAll :: Double -> [Body] -> [Body] updateAll :: Double -> [Body] -> [Body]
updateAll dt bodies = aux [] [] bodies updateAll dt = aux [] []
where where
-- Cycles through all bodies, updates each one and stores it in -- Cycles through all bodies, updates each one and stores it in
-- res. Each body already updated is moved to prev. -- res. Each body already updated is moved to prev.