在 F# 中管理 DirectX

linesky

1. #load @"BindAsLegacyV2Runtime.fs"
   
2. // adjust these as needed for your latest installed version of ManagedDirectX
   
3. #I @"C:\WINDOWS\Microsoft.NET\DirectX for Managed Code\1.0.2902.0"
   
4. #I @"C:\WINDOWS\Microsoft.NET\DirectX for Managed Code\1.0.2903.0"  
   
5. #I @"C:\WINDOWS\Microsoft.NET\DirectX for Managed Code\1.0.2904.0"  
   
6. #I @"C:\WINDOWS\Microsoft.NET\DirectX for Managed Code\1.0.2907.0"  
   
7. 
   
8. 
   
9. #r @"Microsoft.DirectX.dll"
   
10. #r @"Microsoft.DirectX.Direct3D.dll"
    
11. #r @"Microsoft.DirectX.Direct3Dx.dll"
    
12. 
    
13. #load @"dxlib.fs"
    
14. 
    
15. open System
    
16. open System.Drawing
    
17. open System.Windows.Forms
    
18. open Microsoft.DirectX
    
19. open Microsoft.DirectX.Direct3D
    
20. open Microsoft.FSharp.Control.CommonExtensions
    
21. open Sample.DirectX
    
22. open Sample.DirectX.MathOps
    
23. open Sample.DirectX.VectorOps
    
24. 
    
25. let form = new SmoothForm(Visible = true, TopMost = true,
    
26.                           Text = "F# surface plot",
    
27.                           ClientSize = Size(600,400),
    
28.                           FormBorderStyle=FormBorderStyle.FixedSingle)
    
29. 
    
30. 
    
31. let renderer = new DirectXRenderer(form)
    
32. 
    
33. renderer.DrawScene.Add(fun _ -> renderer.DrawCubeAxis())
    
34. 
    
35. renderer.DrawScene.Add(fun _ -> renderer.SetupLights())
    
36. 
    
37. 
    
38. 
    
39. let mutable view =
    
40.    { YawPitchRoll   = Matrix.RotationYawPitchRoll(0.0f,0.0f,0.0f);
    
41.      Focus          = scale 0.5f (X1 + Y1 + Z1);
    
42.      Zoom           = 4.0 }
    
43. 
    
44. renderer.DrawScene.Add(fun _ -> renderer.SetView(view))
    
45. 
    
46. 
    
47. let mouseTrack = MouseTracker(form)
    
48. 
    
49. mouseTrack.Add(fun (a,b) ->
    
50.     let view2 =
    
51.         let dx = b.X - a.X
    
52.         let dy = b.Y - a.Y
    
53.         match b.Button, Form.ModifierKeys with
    
54.         | MouseButtons.Left, Keys.Shift -> view.AdjustZoom(dx,dy)
    
55.         | MouseButtons.Left, _          -> view.AdjustYawPitchRoll(dx,dy)
    
56.         | _                             -> view.AdjustFocus(dx,dy)  
    
57.     view <- view2
    
58. )
    
59. 
    
60. let mutable ff    = (fun (t:float32) x y -> x * (1.0f - y))
    
61. 
    
62. /// Z-range
    
63. let mutable range = (0.0f,1.0f)
    
64. 
    
65. /// XY-mesh
    
66. let mutable mesh = BaseMesh.Grid(20,20)
    
67. 
    
68. //mesh
    
69. 
    
70. // Scale w.r.t. range ...
    
71. let scalef (min,max) (z:float32) = (z-min) / (max-min)
    
72. 
    
73. // Get the function and scale it
    
74. let theFunction t x y = ff t x y |> scalef range
    
75. 
    
76. renderer.DrawScene.Add(fun t -> renderer.DrawSurface mesh (theFunction t))
    
77. 
    
78. //----------------------------------------------------------------------------
    
79. // PART 2 - change the function
    
80. 
    
81. ff <- (fun t x y -> sqr (x - 0.5f) * sqr (y - 0.5f) * 16.0f)
    
82. ff <- (fun t x y -> 0.5f * sin(x * 4.5f + t / 2.0f) * cos(y * 8.0f) * x + 0.5f)
    
83. 
    
84. range <- (-1.0f,1.0f)
    
85. range <- (0.0f,1.0f)
    
86. 
    
87. let ripple t x y =
    
88.    let x,y = x - 0.5f,y - 0.5f
    
89.    let r = sqrt (x*x + y*y)
    
90.    exp(-5.0f * r) * sin(6.0f * pi * r + t) + 0.5f
    
91. 
    
92. ff <- ripple
    
93. 
    
94.   
    
95. mesh <- BaseMesh.Grid (50,50)
    
96. 
    
97. mesh <- BaseMesh.Grid (20,20)
    
98. 
    
99. 
    
100. let surfacePoint f x y = Vector3(x,y,f x y)
     
101. 
     
102. let surfaceNormal f x y =
     
103.     let dx,dy = 0.01f,0.01f
     
104.     let pA    = surfacePoint f x y
     
105.     let pA_dx = surfacePoint f (x+dx) y - pA
     
106.     let pA_dy = surfacePoint f x (y+dy) - pA
     
107.     normalize (cross pA_dx pA_dy)
     
108. 
     
109. let gravity = Vector3(0.0f,0.0f,-9.81f)
     
110. 
     
111. // A ball is a pair of position/velocity vectors
     
112. type ball = Ball of Vector3 * Vector3
     
113. 
     
114. let radiusA = 0.010f
     
115. let radiusB = 0.005f     
     
116. 
     
117. let moveBall f timeDelta (Ball (position,velocity)) =
     
118. 
     
119.    
     
120.     let nHat     = surfaceNormal f position.X position.Y  
     
121. 
     
122.     let acc      = planeProject nHat gravity              // acceleration in plane
     
123.     let velocity = planeProject nHat velocity             // velocity     in plane
     
124.    
     
125.     // Compute the new position
     
126.     let position = position + Vector3.Scale(velocity,timeDelta)  // iterate
     
127.     let velocity = velocity + Vector3.Scale(acc     ,timeDelta)  // iterate
     
128. 
     
129.     // Handle the bounce!
     
130.     let bounce (p,v) =                                       
     
131.         if   (p < 0.0f + radiusA) then (2.0f * (0.0f + radiusA) - p,-v)
     
132.         elif (p > 1.0f - radiusA) then (2.0f * (1.0f - radiusA) - p,-v)
     
133.         else                           (p,v)  
     
134.     let px,vx = bounce (position.X,velocity.X)              // bounce X edges
     
135.     let py,vy = bounce (position.Y,velocity.Y)              // bounce Y edges
     
136.     let position = surfacePoint f px py                     // keep to surface
     
137.     let velocity = Vector3 (vx,vy,velocity.Z)
     
138.     let velocity = planeProject nHat velocity               // velocity in plane     
     
139. 
     
140.     Ball (position,velocity)
     
141. 
     
142. 
     
143. 
     
144. let drawBall t (Ball (p,v)) =
     
145.     let n    = surfaceNormal (theFunction t) p.X p.Y
     
146.     // position XY-projection
     
147.     let p0   = Vector3(p.X,p.Y,0.0f)
     
148.     // unit velocity XY-projection
     
149.     let pV   = Vector3(v.X,v.Y,0.0f)                  
     
150.     // and it's XY-perpendicular
     
151.     let pVxZ = Vector3.Cross(pV,Z1)                        
     
152.     // vertical line
     
153.     renderer.DrawLines (Array.map (Vertex.Colored Color.Gray) [| p0;p |])
     
154.     // velocity arrow on floor
     
155.     renderer.DrawPlaneArrow Z1 p0 pV      
     
156.     // normal arrow at point     
     
157.     renderer.DrawPlaneArrow (cross n X1) p  (scale 0.8f n)
     
158.     renderer.Device.Transform.World <-
     
159.         (let m = Matrix.LookAtLH(p + scale radiusB n,p+n,X1)
     
160.          Matrix.Invert(m))
     
161.       
     
162.     // Now draw the mesh
     
163.     using (Mesh .Torus(renderer.Device,radiusB,radiusA,20,20)) (fun mesh ->
     
164.         mesh.ComputeNormals()
     
165.         mesh.DrawSubset(0))
     
166.       
     
167.     renderer.Device.Transform.World <- Matrix.Identity
     
168. 
     
169. let mutable active = [] : ball list
     
170. let addBall ball = active <- (ball :: active)  
     
171. let drawBalls t =  active |> List.iter(drawBall t)
     
172. let mutable timeDelta = 0.008f
     
173. let moveBalls t =
     
174.          let active' = active |> List.map (moveBall (theFunction t) timeDelta)
     
175.          active <- active'
     
176. 
     
177. //timeDelta <- 0.014f
     
178. renderer.DrawScene.Add(fun t -> moveBalls t)
     
179. renderer.DrawScene.Add(fun t -> drawBalls t)
     
180. 
     
181. 
     
182. let bowl t x y =
     
183.    let f phi u = ((1.0f + cos(2.0f * pi * u + phi )) / 2.0f)
     
184.    f t x * f 0.0f y + 1.0f
     
185. 
     
186. range <- (0.0f,2.0f)
     
187. ff    <- (fun t -> bowl 0.0f)
     
188. 
     
189. 
     
190. // Second, add a ball
     
191. addBall (Ball (Vector3(0.1f,0.1f,0.1f),
     
192.                Vector3(0.6f,0.5f,0.0f)))
     
193. 
     
194. 
     
195. // Add a ball train.
     
196. 
     
197. Async.Start
     
198.     (async { for i in 0 .. 6 do
     
199.                 do addBall (Ball (Vector3(0.1f,0.1f,0.1f),
     
200.                                   Vector3(0.6f,0.5f,0.0f)))
     
201.                 do! Async.Sleep(100)  })
     
202. 
     
203. // Now move the floor!
     
204. 
     
205. let mutable rate = 0.25f
     
206. ff <- (fun t x y -> bowl (rate * t) x y)
     
207. rate <- 1.0f
     
208. rate <- 2.0f
     
209. 
     
210. ff <- ripple
     
211. range <- (0.0f,1.0f)
     
212. 
     
213. mesh <- BaseMesh.Grid (30,30)
     
214. 
     
215. #if COMPILED
     
216. []
     
217. do Application.Run(form)
     
218. 
     
219. do Application.Exit()
     
220. #endif

复制代码