Graphics
This commit is contained in:
parent
0576d02811
commit
8d31a13c30
2 changed files with 32 additions and 1 deletions
32
app/Main.hs
32
app/Main.hs
|
@ -5,6 +5,8 @@ import Lib
|
|||
import Linear.Affine
|
||||
import Linear.V3
|
||||
|
||||
import Graphics.Gloss hiding (Point)
|
||||
|
||||
csvFromPoint :: Point V3 Double -> String
|
||||
csvFromPoint (P (V3 x y z)) =
|
||||
show x ++ "," ++ show y ++ "," ++ show z
|
||||
|
@ -23,5 +25,33 @@ steps n dt bodies = do
|
|||
putStr . concat $ map ((++) (show n ++ ",")) $ csvFromBodies bodies
|
||||
steps (n-1) dt (updateAll dt bodies)
|
||||
|
||||
width, height, offset :: Int
|
||||
width = 1000
|
||||
height = 750
|
||||
offset = 100
|
||||
|
||||
window :: Display
|
||||
window = InWindow "Orbit" (width, height) (offset, offset)
|
||||
|
||||
displayBody :: Body -> Picture
|
||||
displayBody b = translate (realToFrac x/1e9) (realToFrac y/1e9) $ circle (realToFrac (bodyRadius b)/1e8)
|
||||
where P (V3 x y _) = bodyPosition b
|
||||
|
||||
displayBodies :: [Body] -> Picture
|
||||
displayBodies = (color white) . Pictures . (map displayBody)
|
||||
|
||||
drawing :: Picture
|
||||
drawing = color white $ circle 80
|
||||
|
||||
main :: IO ()
|
||||
main = steps 1000000 10 [sun, earth, moon, mercury, venus, mars]
|
||||
main = simulate
|
||||
window
|
||||
black
|
||||
25
|
||||
[sun, earth, moon, mercury, venus, mars]
|
||||
displayBodies
|
||||
(\_ dt bs -> updateAll (realToFrac dt*1e6) bs)
|
||||
|
||||
--main :: IO ()
|
||||
--main = steps 1000000 10 [sun, earth, moon, mercury, venus, mars]
|
||||
|
||||
|
|
|
@ -27,6 +27,7 @@ executable orbit-exe
|
|||
build-depends: base
|
||||
, orbit
|
||||
, linear
|
||||
, gloss
|
||||
default-language: Haskell2010
|
||||
|
||||
test-suite orbit-test
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue