The attached F# DirectX sample is one of the most compelling demonstrations of the power of the F# langauge in the arena of scientific visualization and simulation. I have used it consistently over the last two months, and each time have simply amazed audiences that a language can be so interoperable, so visual, so efficient, so succinct.
The sample shows how to draw surfaces that are a function over X/Y coordinates and also a function of time. It also shows how to track mouse events to adjust view parameters, how to use top level 'refs' as locations to hold tweakable/adjustable parameters, and how to use numerical differentiation to compute the normal vector used ot simulate the motion of ice hockey puckS on a moving 3D surface.
Now it's time to let the hub members loose with the goods. Get the code. Install DirectX. Learn how to go through the code. Learn how to interactively change the function being displayed, or the base mesh, or the parameters of the simulation (make gravity positive instead of negative!) Learn how to drag the mouse to change the view matrix. Learn how to explain to your friends why the simulation goes so fast, ~(because F# is fast, native code) Adapt the code to do something completely different. Turn it into a component, or use it to seed a funky library, or a community initiative to simplify and DirectX programming. Or use it to fix that niggling rattle you've had in your car for ages. It can do anything.
Normally I'd distribute this in two halves, but the Hub don't seem to handle two attachments to posts. Hence I've put it all in one file. The section marked LIBRARY is best put in a separate file called something like 'dxlib.fs'. Everything from SAMPLE onwards constitutes the bit I'd recommend going through interactively with you nuclear physicist friends.
The script won't do anything until the point where you set up lights on the form. After that each fragment does something more interesting. Look particularly for the bits marked 'ff :=' and which change the activeList of balls.
Have fun!
Again including the code below to stress the colorizer. Perhaps I just shouldn't 'attach' the code at all.
//----------------------------------------------------------------------------
// The Famous DirectX Demo
//
// reference dlls (various include paths, add yours if different)
//
// THIS DEMO IS A SCRIPT - USE F# INTERACTIVE. DO NOT COMPILE & RUN
//
//----------------------------------------------------------------------------
#I @"C:\WINDOWS\Microsoft.NET\Managed DirectX\v9.02.2904" ;;
#r @"Microsoft.DirectX.dll";;
#r @"Microsoft.DirectX.Direct3D.dll" ;;
#r @"Microsoft.DirectX.Direct3Dx.dll" ;;
//---------------------------------------------------------------
// THE LIBRARY (see below for the true sample)
open System
open Drawing
open Threading
open Windows.Forms
open Microsoft.DirectX
open Microsoft.DirectX.Direct3D
open Idioms
open Compatibility
open List
//----------------------------------------------------------------------------
// common
//----------------------------------------------------------------------------
let mapR a b f = List.init (b-a+1) (fun i -> f (a+i))
let rec iterR a b f = if a<=b then (f a; iterR (a+1) b f) else ()
type time = float
let now () = (float Environment.TickCount / 1000.0)
let sqr (x:float) = x * x
let pi = Math.PI
let single x = Float32.of_float x
let double x = Float32.to_float x
let singleFun2 f (x,y) = single (f (double x,double y))
//----------------------------------------------------------------------------
// DirectX form
//
// Create an enclosing form which owns its own painting.
//----------------------------------------------------------------------------
type SmoothForm = class
inherit Form
new() as x =
{ inherit Form(); }
then
x.SetStyle(Enum.combine [ControlStyles.AllPaintingInWmPaint; ControlStyles.Opaque], true);
end
//----------------------------------------------------------------------------
// DirectX device
//----------------------------------------------------------------------------
// Presentation parameters
let defaultPresentParams () =
let presentParams = new PresentParameters() in
presentParams.Windowed <- true;
presentParams.SwapEffect <- SwapEffect.Discard;
presentParams.EnableAutoDepthStencil <- true; // Turn on a Depth stencil
presentParams.AutoDepthStencilFormat <- DepthFormat.D16; // And the stencil format
presentParams
//----------------------------------------------------------------------------
// The drawScene event fires each time we draw the scene.
// The event is fired within the context of a BeginScene/EndScene
//----------------------------------------------------------------------------
type event<'a> = ('a -> unit) * IEvent<'a>
//----------------------------------------------------------------------------
// We must reset the device if it is rudely taken from us
//----------------------------------------------------------------------------
let rec checkResetThen (device: Device) presentParams f =
if device.CheckCooperativeLevel() then begin
f()
end else begin
let r = ref 0 in
if not (device.CheckCooperativeLevel(r)) then
if !r = Enum.to_int ResultCode.DeviceNotReset then begin
device.Reset([|presentParams|]);
checkResetThen device presentParams f
end
end;;
//----------------------------------------------------------------------------
// We don't render if the form's not visible
//----------------------------------------------------------------------------
let checkNotMinimizedThen (form : #Form) f =
let hidden = (form.WindowState = FormWindowState.Minimized) in
if not hidden then f()
let checkVisibleThen (form : #Control) f = if form.Visible then f()
let clearScene (color:Color) (device:Device) =
device.Clear(Enum.combine[ClearFlags.ZBuffer;ClearFlags.Target],color, 1.0f, 0)
//----------------------------------------------------------------------------
// The render function. Basically raises the drawScene event
// after checking the device is ready for us.
//----------------------------------------------------------------------------
// doRender: if device available and not hidden, do the required device actions
let doRender device presentParams form fireEvent =
checkResetThen device presentParams (fun () ->
checkVisibleThen form (fun () ->
device.BeginScene();
clearScene Color.Black device;
fireEvent();
device.EndScene();
try device.Present() with _ -> ()
)
)
// doInitialise: initialise device properties and invalidate to trigger redraw
let doInitialise(device:Device) (form: #Control) =
device.RenderState.ZBufferEnable <- true;
device.RenderState.Ambient <- Drawing.Color.White;
form.Invalidate()
//----------------------------------------------------------------------------
// vectors - origin, basis and operations - and - points
//----------------------------------------------------------------------------
let vector (x,y,z) = new Vector3(Float32.of_float x,Float32.of_float y,Float32.of_float z)
let scaleV k v = Vector3.Scale(v,k)
let vO = vector ( 0.0, 0.0, 0.0) // Require v0 to be "zero": All x. v0 + x = x
let vX = vector ( 1.0, 0.0, 0.0) // Basis vectors - all other vectors build on these
let vY = vector ( 0.0, 1.0, 0.0)
let vZ = vector ( 0.0, 0.0, 1.0)
let dot u v = Vector3.Dot(u,v)
let cross u v = Vector3.Cross(u,v)
let normalize u = Vector3.Normalize(u)
let scale k u = Vector3.Scale(u,k)
let planeProject n v = v - scale (dot n v) n // n is plane normal
let magnitude v = Vector3.Dot(v,v) |> double
let colorPoint (c:Color) v = new CustomVertex.PositionNormalColored(v,vZ,c.ToArgb())
let point v = colorPoint Color.White v
let transformAt v m = Matrix.Translation(v) * m * Matrix.Translation(-v)
//----------------------------------------------------------------------------
// DirectX - VertexBuffers
//----------------------------------------------------------------------------
let vertexBufferOfPoints (device:Device) (pts : CustomVertex.PositionNormalColored[]) =
let vertexBuffer = new VertexBuffer((type CustomVertex.PositionNormalColored),
pts.Length, // number pts
device,
Usage.None,
CustomVertex.PositionNormalColored.Format,
Pool.Managed) // Pool.Managed resources survive device loss
in
let offset = 0 in
vertexBuffer.SetData(pts,offset,LockFlags.None);
vertexBuffer
//----------------------------------------------------------------------------
// DirectX - clear, lines, triangles
//----------------------------------------------------------------------------
let drawPrimitive vertexBuffer primitive nPrim (device:Device) =
device.SetStreamSource(0,vertexBuffer,0); // stream number, stream data, offset
device.VertexFormat <- CustomVertex.PositionNormalColored.Format;
device.DrawPrimitives(primitive,0,nPrim)
let drawLineList pts device =
let ptsA = pts |> Array.of_list in
let vb = vertexBufferOfPoints device ptsA in
drawPrimitive vb PrimitiveType.LineList (ptsA.Length/2) device;
vb.Dispose()
let drawTriangeStrip pts device =
let ptsA = pts |> Array.of_list in
let vb = vertexBufferOfPoints device ptsA in
drawPrimitive vb PrimitiveType.TriangleStrip (ptsA.Length-2) device;
vb.Dispose()
//----------------------------------------------------------------------------
// DirectX setup lighting
//----------------------------------------------------------------------------
let setupLights (device:Device) =
let mutable material = new Direct3D.Material() in
material.DiffuseColor <- ColorValue.FromColor(Color.White);
material.AmbientColor <- ColorValue.FromColor(Color.White);
device.Material <- material;
device.RenderState.Lighting <- true;
(device.Lights.Item(0)).Type <- LightType.Directional;
(device.Lights.Item(0)).Diffuse <- System.Drawing.Color.White;
(device.Lights.Item(0)).Direction <- new Vector3(0.0f,0.0f,-1.0f);
(device.Lights.Item(0)).Enabled <- true;
device.RenderState.Ambient <- System.Drawing.Color.FromArgb(0x101010)
//----------------------------------------------------------------------------
// XY grid and axis box
//----------------------------------------------------------------------------
let planeN = 6 // number of division on XY plane grid
let planeVs =
mapR 0 planeN (fun i ->
let k = float32 i / float32 planeN in
[scaleV k vY;vX + scaleV k vY; // Line k.Y to X + k.Y
scaleV k vX;vY + scaleV k vX; ] // Line k.X to k.X + Y
) |> concat
let planePts = map (colorPoint Color.Gray) planeVs
let boxPts =
map point
[vO ;vO + vZ;
vO ;vX;
vX ;vX + vY;
] @
map (colorPoint Color.Gray)
[vY ; vY + vZ;
vX + vY ; vX + vY + vZ;
vO + vZ ; vY + vZ;
vY + vZ ; vX + vY + vZ;
]
//----------------------------------------------------------------------------
// Color interpolation
//----------------------------------------------------------------------------
let colorRange x =
let r,g,b =
if x<0.0 then 1.0,0.0,0.0 else
if x<0.5 then let z = 2.0 * x in 1.0 - z, z,0.0 else
if x<1.0 then let z = 2.0 * x - 1.0 in 0.0 ,1.0 - z,z else 0.0,0.0,1.0
in
let byte x = int_of_float (x * 255.0) in
Color.FromArgb(0,byte r,byte g,byte b)
//----------------------------------------------------------------------------
// surface - index
//----------------------------------------------------------------------------
let triangleRow n m =
// Generate triangle strip for row m.
// Points (0,m) .....(n-1,m)
// Points (0,m+1).....(n-1,m+1)
mapR 0 (2*n-1) (fun k ->
let i = k / 2 in
if k mod 2 = 0 then (i,m) else (i,m+1))
let triangleRows n m = mapR 0 (m-2) (fun m -> triangleRow n m)
//----------------------------------------------------------------------------
// Mouse events
//----------------------------------------------------------------------------
let mkMouseTracker (c : #Control) =
let fire,event = IEvent.create() in
let lastArgs = ref None in
c.MouseDown.Add(fun args -> lastArgs := Some args);
c.MouseUp.Add (fun args -> lastArgs := None);
c.MouseMove.Add(fun args ->
match !lastArgs with
| Some last -> fire(last,args); lastArgs := Some args
| None -> ());
event
//----------------------------------------------------------------------------
// setView
//----------------------------------------------------------------------------
// yaw, pitch, roll, focus, zoom state
type view = { mutable ypr: Matrix;
mutable focus: Vector3;
mutable zoom: float }
let move view ((a:MouseEventArgs),(b:MouseEventArgs)) =
let dx = b.X - a.X in
let dy = b.Y - a.Y in
if b.Button = MouseButtons.Left then
if Form.ModifierKeys = Keys.Shift then
view.zoom <- view.zoom * exp (float dy / 100.0) // Zoom
else
let rx = float32 dx / 20.0f in
let ry = float32 dy / 20.0f in
let m = Matrix.RotationYawPitchRoll(ry,0.0f,rx) in // Rotate
let m = transformAt (scaleV -0.5f (vX + vY + vZ)) m in // at centre point
view.ypr <- m * view.ypr
else
let dv = scale (float32 (-dx) / 50.0f) vY + scale (float32 dy / 50.0f) vZ in
view.focus <- view.focus + dv // Move focus
let setView view (device:Device) =
let eye = scaleV 2.0f (vX + vY + vZ) - scaleV (single view.zoom) vX in
device.Transform.View <-
Matrix.Invert(view.ypr) *
Microsoft.DirectX.Matrix.LookAtLH(
eye,
view.focus,
vZ);
device.Transform.Projection <-
Microsoft.DirectX.Matrix.PerspectiveFovLH(
single (Math.PI / 8.0), // FOV
1.0f, // aspect
0.1f, // min depth
100.0f // max depth
);
device.Transform.World <- Matrix.Identity;;
let mkMesh gx gy (m,n) = Array2.init n m (fun i j -> gx n i),Array2.init n m (fun i j -> gy m j)
let meshDims mesh = let X,Y = mesh in Array2.length1 X, Array2.length2 X
let meshGet mesh (i,j) = let X,Y = mesh in X.(i,j), Y.(i,j)
let ij2k mesh (i,j) = let m,n = meshDims mesh in i + j * n
let k2ij mesh k = let m,n = meshDims mesh in k mod n,k / n
let colorPlace mesh data c (i,j) =
let k = ij2k mesh (i,j) in
let x,y,z = data.(k) in
let x,y,z = Float32.of_float x,Float32.of_float y,Float32.of_float z in
colorPoint c (vO + scaleV x (vX - vO) + scaleV y (vY - vO) + scaleV z (vZ - vO))
let blendPlace mesh data (i,j) =
let k = ij2k mesh (i,j) in
let x,y,z = data.(k) in
let c = colorRange z in
let x,y,z = Float32.of_float x,Float32.of_float y,Float32.of_float z in
colorPoint c (vO + scaleV x vX + scaleV y vY + scaleV z vZ)
//---------------------------------------------------------------
// SAMPLE
open System
open Drawing
open System.Threading
open System.Windows.Forms
open Microsoft.DirectX
open Microsoft.DirectX.Direct3D
open Idioms
open List
//----------------------------------------------------------------------------
// DirectX form
//
// Create an enclosing form which owns its own painting.
//----------------------------------------------------------------------------
let form = new SmoothForm()
do form.Text <- "F# surface plot"
do form.ClientSize <- new Size(400,300)
do form.Visible <- true
do form.TopMost <- true
//----------------------------------------------------------------------------
// DirectX device
//----------------------------------------------------------------------------
let presentParams = defaultPresentParams()
// Create device
let device =
(new Device(0, DeviceType.Hardware, form,
CreateFlags.SoftwareVertexProcessing,
[| presentParams |]))
//----------------------------------------------------------------------------
// The drawScene event fires each time we draw the scene.
// The event is fired within the context of a BeginScene/EndScene.
// It gets passed the current time, so all recipients see
// a consistent view of time.
//----------------------------------------------------------------------------
let (doDrawScene,drawScene) : event = IEvent.create()
//----------------------------------------------------------------------------
// The render function. Raises the drawScene event
// after checking the device is ready for use.
//----------------------------------------------------------------------------
do form.Paint.Add(fun _ ->
let t = now() in
doRender device presentParams form (fun () -> doDrawScene t);
form.Invalidate())
do device.DeviceReset.Add(fun _ -> doInitialise device form)
do doInitialise device form;;
//----------------------------------------------------------------------------
// XY grid and axis box
//----------------------------------------------------------------------------
let drawAxis (device:Device) =
device.RenderState.CullMode <- Cull.None;
drawLineList planePts device;
drawLineList boxPts device
do drawScene.Add(fun _ -> drawAxis device)
//----------------------------------------------------------------------------
// DirectX setup lighting
//----------------------------------------------------------------------------
do drawScene.Add(fun time -> setupLights device)
//----------------------------------------------------------------------------
// setView
//----------------------------------------------------------------------------
// some interactive state (interactive state would eventually be subsumed into state of a chart object)
let view =
{ ypr = Matrix.RotationYawPitchRoll(0.0f,0.0f,0.0f);
focus = scale 0.5f (vX + vY + vZ);
zoom = 4.0 }
do drawScene.Add(fun time -> setView view device)
//----------------------------------------------------------------------------
// Mouse events
//----------------------------------------------------------------------------
let mouseEvent = mkMouseTracker form
do mouseEvent.Add(move view)
//----------------------------------------------------------------------------
// mesh and gridLines
//----------------------------------------------------------------------------
let normi n i = float i / float (n-1)
let grid (m,n) = mkMesh normi normi (m,n)
let mesh = ref (grid (20,20))
let dims () = meshDims !mesh
let gridLine i j = [i,j;i+1,j; i,j;i,j+1]
let gridLines n m = mapR 0 (n-2) (fun i -> mapR 0 (m-2) (gridLine i)) |> concat |> concat
let drawSurf f (device:Device) =
let m,n = meshDims !mesh in
let data = Array.init (n*m) (fun k ->
let i,j = k2ij !mesh k in
let x,y = meshGet !mesh (i,j) in
let z = f (x,y) in // single precision f
(x,y,z))
in
let strips = triangleRows n m |> map (map (blendPlace !mesh data)) in
List.iter (fun strip -> drawTriangeStrip strip device) strips;
let m,n = meshDims !mesh in
let lines = gridLines n m in
let lines = lines |> map (colorPlace !mesh data Color.Black) in
drawLineList lines device
//----------------------------------------------------------------------------
// state: evaluation function
//----------------------------------------------------------------------------
/// function to display
let ff = ref (fun (t:float) (x,y) -> x * (1.0 - y))
/// Z-range
let range = ref (0.0,1.0)
let eval t (x,y) =
let z = !ff t (x,y) in
let a,b = !range in // and scale w.r.t. range ...
let res = if b - a = 0.0 then 0.0 else (z-a) / (b-a) in
res
do drawScene.Add(fun time -> drawSurf (eval time) device);;
//----------------------------------------------------------------------------
// PART 2 - change the function
//----------------------------------------------------------------------------
do ff := fun t (x,y) -> sqr (x - 0.5) * sqr (y - 0.5) * 16.0;;
do ff := fun t (x,y) -> 0.5 * sin(x * 4.5 + t / 2.0) * cos(y * 8.0) * x + 0.5;;
do range := (-1.0,1.0)
do range := (0.0,1.0)
let ripple t (x,y) =
let x,y = x - 0.5,y - 0.5 in
let r = sqrt (x*x + y*y) in
exp(-4.0 * r) * sin(6.0 * 3.14 * r + t) + 0.5
do ff := ripple
//----------------------------------------------------------------------------
// PART 3 - change the grid
//----------------------------------------------------------------------------
do mesh := grid (50,50);;
do mesh := grid (20,20);;
let cgrid1 fd m =
let dxs = mapR 0 (m-2) (normi (m-1) >> fd) in
let sumx = fold_right (+) dxs 0.0 in
let _,xs = fold_right (fun dx (sum,res) -> (sum+dx),(sum/sumx :: res)) dxs (0.0,[]) in
let arr = Array.of_list (1.0 :: xs) in
fun i -> arr.(i)
let cgrid fdensity (m,n) = mkMesh (cgrid1 fdensity) (cgrid1 fdensity) (m,n)
do mesh := cgrid (fun x -> sqr ( (x - 0.5) * 2.0 ) + 0.2) (20,20);;
// First, set up a bowl shaped area
do range := (0.0,2.0)
let surfaceA t (x,y) = let f phi u = ((1.0 + cos(2.0 * pi * u + phi )) / 2.0) in
f t x * f 0.0 y + 1.0;;
ff := fun t (x,y) -> surfaceA 0.0 (x,y);;
//----------------------------------------------------------------------------
// PART 4 - Motion on a surface
//----------------------------------------------------------------------------
let gravity = ref (new Vector3(0.0f,0.0f,-5.0f))
let surfacePoint f (x,y) =
let z = f (x,y) in
new Vector3(x,y,z)
let surfaceNormal f (x,y) =
let dx,dy = 0.01f,0.01f in
let pA = surfacePoint f (x,y) in
let pA_dx = surfacePoint f (x+dx,y) - pA in
let pA_dy = surfacePoint f (x,y+dy) - pA in
normalize (cross pA_dx pA_dy)
type ball = Ball of Vector3 * Vector3
let radiusA = 0.010f
let radiusB = 0.005f
let stepMotion f dt (Ball (position,velocity)) =
let nHat = surfaceNormal f (position.X,position.Y) in // surface plane normal
let acc = planeProject nHat !gravity in // acceleration in plane
let velocity = planeProject nHat velocity in // velocity in plane
let position = position + Vector3.Scale(velocity,dt) in // iterate
let velocity = velocity + Vector3.Scale(acc ,dt) in // iterate
let bounce (p,v) =
if p < 0.0f + radiusA then (2.0f * (0.0f + radiusA) - p,-v) else
if p > 1.0f - radiusA then (2.0f * (1.0f - radiusA) - p,-v) else
(p,v) : float32 * float32
in
let px,vx = bounce (position.X,velocity.X) in // bounce X edges
let py,vy = bounce (position.Y,velocity.Y) in // bounce Y edges
let position = surfacePoint f (px,py) in // keep to surface
let velocity = new Vector3 (vx,vy,velocity.Z) in
let velocity = planeProject nHat velocity in // velocity in plane
Ball (position,velocity)
let position = surfacePoint (singleFun2 (eval (now()))) (0.2f,0.8f)
let velocity = surfacePoint (singleFun2 (eval (now()))) (0.1f,0.4f)
let ballP = Ball (position,velocity)
//----------------------------------------------------------------------------
// PART 5 - Motion on a surface rendered
//----------------------------------------------------------------------------
let drawPlaneArrow device n p dir =
let dir2 = normalize (cross n dir) in
drawLineList (
map point [p + scale 0.15f dir; p;
p + scale 0.15f dir; p + scale 0.10f dir + scale 0.02f dir2;
p + scale 0.15f dir; p + scale 0.10f dir - scale 0.02f dir2]) device
let drawBall device t (Ball (p,v)) =
let n = surfaceNormal (singleFun2 (eval t)) (p.X,p.Y) in
let p0 = new Vector3(p.X,p.Y,0.0f) in
let pV = new Vector3(v.X,v.Y,0.0f) in // unit velocity XY-projection
let pVxZ = Vector3.Cross(pV,vZ) in // and it's XY-perpendicular
drawLineList (map (colorPoint Color.Gray) [p0;p]) device; // vertical line
drawPlaneArrow device vZ p0 pV; // velocity arrow on floor
drawPlaneArrow device (cross n vX) p (scale 0.8f n); // normal arrow at point
device.Transform.World <- (let m = Matrix.LookAtLH(p + scale radiusB n,p+n,vX) in Matrix.Invert(m));
let mesh = Mesh.Torus(device,radiusB,radiusA,20,20) in
mesh.ComputeNormals();
//let mesh = Mesh.Sphere(device,radiusA,20,20) in
mesh.DrawSubset(0);
mesh.Dispose();
device.Transform.World <- Matrix.Identity;;
//----------------------------------------------------------------------------
// Motion on a surface example
//----------------------------------------------------------------------------
//do timer.Interval <- 50 // ms = frame rate
let activeList = ref [] : ball list ref
let addActiveList ball = activeList := (ball :: !activeList)
let simulate t =
let dt = 0.005f in
activeList := List.map (stepMotion (singleFun2 (eval t)) dt) !activeList
do drawScene |> IEvent.listen simulate
do drawScene.Add(fun t -> List.iter (drawBall device t) !activeList)
// Second, add a ball
let ballA = Ball (new Vector3(0.1f,0.1f,0.1f),new Vector3(0.6f,0.5f,0.0f))
do activeList := []
do addActiveList ballA
// Third, add a train of balls to a moving floor. Vary rate...
let spawn (f : unit -> unit) = ThreadPool.QueueUserWorkItem(fun _ -> f ()) |> ignore;;
do activeList := [];;
do spawn(fun () -> iterR 0 6 (fun i -> addActiveList ballA; Thread.Sleep(300)));;
let rate = 0.25
do ff := fun t (x,y) -> surfaceA (rate * t) (x,y)
do ff := ripple;;
//----------------------------------------------------------------------------
// PART 6 - Make the basic scene drawing framework into a component
//----------------------------------------------------------------------------
do form.Close();;
type DisplayControl = class
inherit UserControl
// The drawScene event fires each time we draw the scene.
val drawSceneE : event
val mutable device : Device
member x.DrawScene = snd x.drawSceneE
member x.Device = x.device
new() as form =
let drawSceneE = IEvent.create() in
{ inherit UserControl();
drawSceneE = drawSceneE;
device =