孤独的猫

  博客园 :: 首页 :: 博问 :: 闪存 :: 新随笔 :: 联系 :: 订阅 订阅 :: 管理 ::

//----------------------------------------------------------------------------
// 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

posted on 2011-11-22 20:39  孤独的猫  阅读(145)  评论(0)    收藏  举报