learn-physics-0.3: src/examples/sunEarthRK4.hs
{-# OPTIONS_GHC -Wall #-}
-- Animation of Earth orbiting around a fixed Sun
-- Using SI units
module Main where
import Physics.Learn
import Graphics.Gloss
import Graphics.Gloss.Data.ViewPort
type Acceleration = Vec
gGrav :: Double
gGrav = 6.67e-11
massSun :: Double
massSun = 1.99e30
-- This is enlarged so we can see it.
radiusSun :: Double
radiusSun = 0.1 * earthSunDistance
-- This is enlarged so we can see it.
radiusEarth :: Double
radiusEarth = 0.05 * earthSunDistance
earthSunDistance :: Double
earthSunDistance = 1.496e11
year :: Double
year = 365.25*24*60*60
-- Derived constants
initialEarthSpeed :: Double
initialEarthSpeed = 2*pi*earthSunDistance/year
initialState :: SimpleState
initialState = (0
,cart (2 * earthSunDistance) 0 0
,vec 0 (initialEarthSpeed / 2) 0)
rS :: Position
rS = cart 0 0 0
earthGravity :: SimpleAccelerationFunction
earthGravity (_,rE,_)
= ((-gGrav) * massSun) *^ disp ^/ magnitude disp ** 3
where
disp = displacement rS rE
diskPic :: Double -> Picture
diskPic r = ThickCircle (radius/2) radius
where radius = realToFrac r
-- A yellow disk will represent the Sun
yellowDisk :: Picture
yellowDisk = Color yellow (diskPic radiusSun)
-- A blue disk will represent the Earth
blueDisk :: Picture
blueDisk = Color blue (diskPic radiusEarth)
worldToPicture :: SimpleState -> Picture
worldToPicture (_,rE,_)
= scale scl scl $ pictures [yellowDisk
,translate xE yE blueDisk
]
where
xE = realToFrac x
yE = realToFrac y
scl = 200 / realToFrac (earthSunDistance)
(x,y,_) = cartesianCoordinates rE
timeScale :: Double
timeScale = 0.25 * year
simStep :: ViewPort -> Float -> SimpleState -> SimpleState
simStep _ dt = simpleRungeKuttaStep earthGravity dtScaled
where
dtScaled = timeScale * realToFrac dt
main :: IO ()
main = simulate (InWindow "Sun-Earth Animation" (600, 600) (10, 10))
black 50 initialState worldToPicture simStep