Use Newtonian gravity in model
This commit is contained in:
parent
7bdbf4861a
commit
df9969d20b
43
Main.hs
43
Main.hs
@ -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
|
||||||
|
Loading…
x
Reference in New Issue
Block a user