FsAdvent Code

Manager.fs

type ForestUpdate =
    | Add of Tree * Forest
    | Decorate of Tree * Forest

type ForestUpdateResult =
    | Success of Forest
    | Pruned of Forest
    | Error of string

module ForestManager =
    let private update forest f (reporter : MailboxProcessor<ForestUpdateResult>) =
        let updated = f forest
        Success updated |> reporter.Post
        if List.length updated.Trees > 10 then
            updated.Prune 5 |> Pruned |> reporter.Post
    let createUpdateAgent reporter =
        let updater (inbox : MailboxProcessor<ForestUpdate>) =
            let rec loop() =
                async {
                    let! forestUpdate = inbox.Receive()
                    let f, forest = 
                        match forestUpdate with
                        | Add(tree, forest) -> (fun _ -> forest.Add tree), forest
                        | Decorate(tree, forest) -> (fun _ -> forest.Decorate tree), forest
                    update forest f reporter
                    do! loop()
                }
            loop()
        let result = new MailboxProcessor<ForestUpdate>(updater)
        result.Start()
        result

Model.fs

type Location = { X: float; Y: float }

type Tree = { Position : Location ; Height : float ; Decorated : bool }

type Forest = { Trees : Tree list }
with
    static member Empty with get() = { Trees = [] }
    member f.Add tree = 
        { Trees = tree :: f.Trees }
    member f.Decorate tree = 
        let existing = f.Trees
        let updated = 
            existing
            |> List.except [ tree ]
        { Trees = { tree with Decorated = true } :: updated }
    member f.Prune max = 
        let updated = 
            if max < List.length f.Trees then
                f.Trees
                |> List.take max
            else
                f.Trees
        { Trees = updated }

view.xaml

        <ItemsControl 
            Grid.Row="1" 
            HorizontalAlignment="Stretch" 
            VerticalAlignment="Stretch" 
            ItemsSource="{Binding Forest.Trees}" 
            > <!-- One items control binding displays our trees.. -->
            <ItemsControl.ItemsPanel>
                <ItemsPanelTemplate>
                    <Canvas HorizontalAlignment="Stretch" VerticalAlignment="Stretch" Background="Gray" >
                        <i:Interaction.Triggers>
                            <i:EventTrigger EventName="MouseLeftButtonDown">
                                <fsx:EventToCommand Command="{Binding MouseCommand}" EventArgsConverter="{StaticResource addConverter}" />
                            </i:EventTrigger>
                        </i:Interaction.Triggers>
                    </Canvas>
                </ItemsPanelTemplate>
            </ItemsControl.ItemsPanel>
            <ItemsControl.ItemTemplate>
                <DataTemplate>
                    <Canvas> <! -- Our template for a tree -->
                        <i:Interaction.Triggers>
                            <i:EventTrigger EventName="MouseLeftButtonDown">
                                <fsx:EventToCommand Command="{Binding DataContext.MouseCommand, ElementName=Win}" EventArgsConverter="{StaticResource decorateConverter}" />
                            </i:EventTrigger>
                        </i:Interaction.Triggers>

vm1.fs

type TreeEvent =
    | Add of location:Location
    | Decorate of tree:Tree
    | Unknown

type ForestViewModel () as self =
    inherit EventViewModelBase<TreeEvent>()

    // Create a backing field for our Forest using FSharp.ViewModule
    let forest = self.Factory.Backing(<@ self.Forest @>, Forest.Empty)

    // ... Other code...
    member __.Forest with get() = forest.Value

vm2.fs

    let ui = SynchronizationContext.Current
    
    // Create an async update loop for our agent
    let update (inbox : MailboxProcessor<ForestUpdateResult>) =
        let rec loop() =
            async {
                let! update = inbox.Receive()
                match update with
                | Success updated ->
                    do! Async.SwitchToContext ui
                    forest.Value <- updated
                | Pruned updated ->
                    // Wait brief period (so you see the tree added before pruning), then update us
                    // Note: This creates a race condition if you click very fast
                    do! Async.Sleep 250
                    do! Async.SwitchToContext ui
                    forest.Value <- updated
                | Error _ -> 
                    // Handle error case here
                    ()
                do! loop()
            }
        loop()
    let reporter = new MailboxProcessor<_>(update)

    // Start our report handler
    do
        reporter.Start()

    // Create the agent used to update the model
    let updateAgent = ForestManager.createUpdateAgent reporter

vm3.fs

    // Create a handler for our UI event stream
    let handleEvent event =
        match event with
        | Add(location) -> 
            let height = 8.0 + rnd.NextDouble() * 4.0
            updateAgent.Post <| ForestUpdate.Add ({ Position = location ; Height = height ; Decorated = false }, forest.Value)                        
        | Decorate(tree) ->
            updateAgent.Post <| ForestUpdate.Decorate (tree, forest.Value)
        | Unknown -> 
            ()
    do
        self.EventStream
        |> Observable.subscribe handleEvent
        |> ignore

    // Create an EventValueCommand for our UI to send us events
    member val MouseCommand = self.Factory.EventValueCommand()