Matt's Software Blog

Hi folks,

I have recently been experimenting with combining Reactive X, WPF, and F# and have found the combination to be very palatable. I chose drag and drop as the test case because it is both non trivial and generally deeply stateful. The resulting Rx turns out to be one fifth the code of my original C#, much easier to read and has fewer errors.

Drag and Drop code:

    leftDown
        |> map (fun e1 -> (e1, mouseMove |> takeUntil leftUp |> takeUntil mouseLeave))
        |> filter (fun (e1, e2s) -> e1.Source.Equals(canvas) |> not)
        |> map (fun (e1, e2s) ->
                        let control = e1.Source :?> UIElement
                        let leftTop = (Canvas.GetLeft(control), Canvas.GetTop(control))
                        let pt1 = e1.GetPosition(canvas)
                        e2s |> map (fun e2 ->
                                        let pt2 = e2.GetPosition(canvas)
                                        (control, leftTop, pt2 - pt1)))
        |> mergeAll
        |> subscribe (fun (control, (left,top), delta) -> Canvas.SetLeft(control, left + delta.X); Canvas.SetTop(control, top + delta.Y))

As always, I am interested in feedback.

Cheers,

Matt

Full Code:

open System
open System.Linq
open System.Windows
open System.Windows.Input
open System.Windows.Controls
open System.Windows.Shapes
open System.Windows.Media
open System.Xaml
open System.IO
open System.Text
open System.Windows.Markup

let parseXAML (xaml : string) =
    use ms = new MemoryStream(Encoding.ASCII.GetBytes(xaml))
    ms.Position <- int64 0
    XamlReader.Load(ms)

// helper functions from Steffen Forkmann (http://www.navision-blog.de)
let asAction f = new System.Action(f)

let doNothing = asAction (fun () -> ())

let create f =
    Observable.Create<_>(fun x ->
        f x
        doNothing)

let fromEvent (event:IEvent<_,_>) = create (fun x -> event.Add x.OnNext)

let mergeAll (observables:IObservable<IObservable<'a>>) = Observable.Merge observables

let map f observable = Observable.Select(observable, Func<_,_>(f))

let takeUntil other source = Observable.TakeUntil(source,other)

let filter f observable = Observable.Where(observable, Func<_,_>(f))

let subscribeComplete next error completed (obs: IObservable<'a>) =
    obs.Subscribe(
        (fun x -> next x),
        (fun e -> error e),
        (fun () -> completed()))

let subscribeWithError next error obs =
    subscribeComplete next error (fun () -> ()) obs

let subscribe next obs =
    subscribeWithError next ignore obs

let window =
    let window =
        "<Window
            xmlns=\"http://schemas.microsoft.com/winfx/2006/xaml/presentation\"
            xmlns:x=\"http://schemas.microsoft.com/winfx/2006/xaml\"
            Title=\"Event Sample\" Height=\"200\" Width=\"200\">
        <Canvas x:Name=\"canvas\" Background=\"LightBlue\">
            <Rectangle Canvas.Left=\"50\" Canvas.Top=\"50\"  Fill=\"Red\" Height=\"50\" Width=\"50\" />
            <TextBlock Canvas.Left=\"50\" Canvas.Top=\"120\"   Text=\"Hello World!\" />
        </Canvas>
    </Window>" |> parseXAML :?> Window
    let canvas = window.FindName("canvas") :?> Canvas

    let leftDown = canvas.MouseLeftButtonDown  |> fromEvent
    let leftUp   = canvas.MouseLeftButtonUp    |> fromEvent
    let mouseMove = canvas.MouseMove           |> fromEvent
    let mouseLeave = canvas.MouseLeave         |> fromEvent

    leftDown
        |> map (fun e1 -> (e1, mouseMove |> takeUntil leftUp |> takeUntil mouseLeave))
        |> filter (fun (e1, e2s) -> e1.Source.Equals(canvas) |> not)
        |> map (fun (e1, e2s) ->
                        let control = e1.Source :?> UIElement
                        let leftTop = (Canvas.GetLeft(control), Canvas.GetTop(control))
                        let pt1 = e1.GetPosition(canvas)
                        e2s |> map (fun e2 ->
                                        let pt2 = e2.GetPosition(canvas)
                                        (control, leftTop, pt2 - pt1)))
        |> mergeAll
        |> subscribe (fun (control, (left,top), delta) -> Canvas.SetLeft(control, left + delta.X); Canvas.SetTop(control, top + delta.Y))
        |> ignore

    window

let main() =
    let app = new Application()
    app.Run(window) |> ignore

[<STAThread>]
    do main()