Use Newtonian gravity in model

This commit is contained in:
Camden Dixie O'Brien 2021-01-01 00:00:40 +00:00
parent 7bdbf4861a
commit df9969d20b

43
Main.hs
View File

@ -8,32 +8,49 @@ import Graphics.Gloss.Geometry.Angle
data PolarCoord = PolarCoord { radius :: Float, angle :: Float } data PolarCoord = PolarCoord { radius :: Float, angle :: Float }
data State = State { position :: PolarCoord
, radialMomentum :: Float
, angularMomentum :: Float }
majorMass :: Float majorMass :: Float
majorMass = 10 majorMass = 200
minorMass :: Float minorMass :: Float
minorMass = 4 minorMass = 20
initialState :: State
initialState = State (PolarCoord 300 0) 0 0.001
framesPerSecond :: Int framesPerSecond :: Int
framesPerSecond = 120 framesPerSecond = 120
angularVelocity :: Float render :: State -> Picture
angularVelocity = pi render state = pictures [ circleSolid (sqrt majorMass)
, translatePolar (position state) $ circleSolid (sqrt minorMass) ]
render :: PolarCoord -> Picture step :: a -> b -> State -> State
render state = pictures [ circleSolid majorMass step _ _ state = state { position = nextPosition state
, translatePolar state $ circleSolid minorMass ] , radialMomentum = nextRadialMomentum state }
step :: a -> b -> PolarCoord -> PolarCoord nextPosition :: State -> PolarCoord
step _ _ state = let radiansPerFrame = angularVelocity / fromIntegral framesPerSecond nextPosition state = let r = radius . position $ state
nextAngle = normalizeAngle $ angle state + radiansPerFrame a = angle . position $ state
in state { angle = nextAngle } rDot = radialMomentum state / minorMass
aDot = angularMomentum state / (minorMass * r ^ 2)
in PolarCoord (r + rDot) (a + aDot)
nextRadialMomentum :: State -> Float
nextRadialMomentum state = let r = radius . position $ state
p = radialMomentum state
l = angularMomentum state
pDot = (l ^ 2 / (2 * minorMass * r) - minorMass * majorMass) / r ^ 2
in p + pDot
translatePolar :: PolarCoord -> Picture -> Picture translatePolar :: PolarCoord -> Picture -> Picture
translatePolar q = rotate (radToDeg $ angle q) . translate (radius q) 0 translatePolar q = rotate (radToDeg $ angle q) . translate (radius q) 0
window :: Display window :: Display
window = InWindow "Foo" (200, 200) (100, 100) window = InWindow "Foo" (800, 800) (100, 100)
main :: IO () main :: IO ()
main = simulate window white framesPerSecond (PolarCoord 80 0) render step main = simulate window white framesPerSecond initialState render step