Skip to content

Instantly share code, notes, and snippets.

@ReedCopsey
Last active December 9, 2015 21:02
Show Gist options
  • Save ReedCopsey/fdc403c3234553c6e52d to your computer and use it in GitHub Desktop.
Save ReedCopsey/fdc403c3234553c6e52d to your computer and use it in GitHub Desktop.
FsAdvent Code
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
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 }
<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>
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
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
// 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()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment