//----------------------------------------------------------------------------
// A Simple Solar SYstem Simulator, using Units of Measure
//
// Copyright (c) Microsoft Corporation 2005-2008.
//
// This sample code is provided "as is" without warranty of any kind.
// We disclaim all warranties, either express or implied, including the
// warranties of merchantability and fitness for a particular purpose.
//----------------------------------------------------------------------------
open System
open System.Windows.Forms
open System.Drawing
open Microsoft.FSharp.Control.CommonExtensions
//-----------------------------------------------
// Graphics System
// Define a special type of form that doesn't flicker
type SmoothForm() as x =
inherit Form()
do x.DoubleBuffered <- true
let form = new SmoothForm(Text="F# Solar System Simulator", Visible=true, TopMost=true, Width=500, Height=500)
type IPaintObject =
abstract Paint : Graphics -> unit
// Keep a list of objects to draw
let paintObjects = new ResizeArray<IPaintObject>()
form.Paint.Add (fun args ->
let g = args.Graphics
// Clear the form
g.Clear(color=Color.Blue)
// Draw the paint objects
for paintObject in paintObjects do
paintObject.Paint(g)
// Invalidate the form again in 10 milliseconds to get continuous update
async { do! Async.Sleep(10)
form.Invalidate() } |> Async.Start
)
// Set things going with an initial Invaldiate
form.Invalidate()
//-----------------------------------------------
[<Measure>]
type m
[<Measure>]
type km
[<Measure>]
type AU
[<Measure>]
type sRealTime
[<Measure>]
type s
[<Measure>]
type kg
[<Measure>]
type pixels
type System.TimeSpan with
member x.TotalSecondsTyped = (box x.TotalSeconds :?> float<sRealTime>)
let G = 6.67e-11<m ^ 3 / (kg s^2)>
let m_per_AU = 149597870691.0<m/AU>
let AU_per_m = 1.0/m_per_AU
let Pixels_per_AU = 200.0<pixels/AU>
let m_per_km = 1000.0<m/km>
let AU_per_km = m_per_km * AU_per_m
// Make 5 seconds into one year
let sec_per_year = 60.0<s> * 60.0 * 24.0 * 365.0
// One second of real time is 1/40th of a year of model time
let realTimeToModelTime (x:float<sRealTime>) = float x * sec_per_year / 80.0
let pixels (x:float<pixels>) = int32 x
type Planet(ipx:float<AU>,ipy:float<AU>,
ivx:float<AU/s>,ivy:float<AU/s>,
brush:Brush,mass:float<kg>,
width,height) =
// For this sample e store the simulation state directly in the object
let mutable px = ipx
let mutable py = ipy
let mutable vx = ivx
let mutable vy = ivy
member p.Mass = mass
member p.X with get() = px and set(v) = (px <- v)
member p.Y with get() = py and set(v) = (py <- v)
member p.VX with get() = vx and set(v) = (vx <- v)
member p.VY with get() = vy and set(v) = (vy <- v)
interface IPaintObject with
member obj.Paint(g) =
let rect = Rectangle(x=pixels (px * Pixels_per_AU)-width/2,
y=pixels (py * Pixels_per_AU)-height/2,
width=width,height=height)
g.FillEllipse(brush,rect)
type Simulator() =
// Get the start time for the animation
let startTime = System.DateTime.Now
let lastTimeOption = ref None
let ComputeGravitationalAcceleration (obj:Planet) (obj2:Planet) =
let dx = (obj2.X-obj.X)*m_per_AU
let dy = (obj2.Y-obj.Y)*m_per_AU
let d2 = (dx*dx) + (dy*dy)
let d = sqrt d2
let g = obj.Mass * obj2.Mass * G /d2
let ax = (dx / d) * g / obj.Mass
let ay = (dy / d) * g / obj.Mass
ax,ay
/// Find all the gravitational objects in the system except the given object
let FindObjects(obj) =
[ for paintObject in paintObjects do
match paintObject with
| :? Planet as p2 when p2 <> obj ->
yield p2
| _ ->
yield! [] ]
member sim.Step(time:TimeSpan) =
match !lastTimeOption with
| None -> ()
| Some(lastTime) ->
for paintObject in paintObjects do
match paintObject with
| :? Planet as obj ->
let timeStep = (time - lastTime).TotalSecondsTyped |> realTimeToModelTime
obj.X <- obj.X + timeStep * obj.VX
obj.Y <- obj.Y + timeStep * obj.VY
// Find all the gravitational objects in the system
let objects = FindObjects(obj)
// For each object, apply its gravitational field to this object
for obj2 in objects do
let (ax,ay) = ComputeGravitationalAcceleration obj obj2
obj.VX <- obj.VX + timeStep * ax * AU_per_m
obj.VY <- obj.VY + timeStep * ay * AU_per_m
| _ -> ()
lastTimeOption := Some time
member sim.Start() =
async { while true do
let time = System.DateTime.Now - startTime
// Sleep a little to give better GUI updates
do! Async.Sleep(1)
sim.Step(time) }
|> Async.Start
let s = Simulator().Start()
let massOfEarth = 5.9742e24<kg>
let massOfMoon = 7.3477e22<kg>
let massOfMercury = 3.3022e23<kg>
let massOfVenus = 4.8685e24<kg>
let massOfSun = 1.98892e30<kg>
let mercuryDistanceFromSun = 57910000.0<km> * AU_per_km
let venusDistanceFromSun = 0.723332<AU>
let distanceFromMoonToEarth =384403.0<km> * AU_per_km
let orbitalSpeedOfMoon = 1.023<km/s> * AU_per_km
let orbitalSpeedOfMecury = 47.87<km/s> * AU_per_km
let orbitalSpeedOfVenus = 35.02<km/s> * AU_per_km
let orbitalSpeedOfEarth = 29.8<km/s> * AU_per_km
let sun = new Planet(ipx=1.1<AU>,
ipy=1.1<AU>,
ivx=0.0<AU/s>,
ivy=0.0<AU/s>,
brush=Brushes.Yellow,
mass=massOfSun,
width=20,
height=20)
let mercury = new Planet(ipx=sun.X+mercuryDistanceFromSun,
ipy=sun.Y,
ivx=0.0<AU/s>,
ivy=orbitalSpeedOfMecury,
brush=Brushes.Goldenrod,
mass=massOfMercury,
width=10,
height=10)
let venus = new Planet(ipx=sun.X+venusDistanceFromSun,
ipy=sun.Y,
ivx=0.0<AU/s>,
ivy=orbitalSpeedOfVenus,
brush=Brushes.BlanchedAlmond,
mass=massOfVenus,
width=10,
height=10)
let earth = new Planet(ipx=sun.X+1.0<AU>,
ipy=sun.Y,
ivx=0.0<AU/s>,
ivy=orbitalSpeedOfEarth,
brush=Brushes.Green,
mass=massOfEarth,
width=10,
height=10)
let moon = new Planet(ipx=earth.X+distanceFromMoonToEarth,
ipy=earth.Y,
ivx=earth.VX,
ivy=earth.VY+orbitalSpeedOfMoon,
brush=Brushes.White,
mass=massOfMoon,
width=2,
height=2)
paintObjects.Add(sun)
paintObjects.Add(mercury)
paintObjects.Add(venus)
paintObjects.Add(earth)
paintObjects.Add(moon)
form.Show()
#if COMPILED
[<STAThread>]
do Application.Run(form)
#endif