Skip to content

Instantly share code, notes, and snippets.

@ReedCopsey
Last active December 15, 2016 20:52
Show Gist options
  • Save ReedCopsey/f18b683b9d8d25056ebf70087c522390 to your computer and use it in GitHub Desktop.
Save ReedCopsey/f18b683b9d8d25056ebf70087c522390 to your computer and use it in GitHub Desktop.
FsAdvent 2016 Code
let application =
// Create our forest, wrapped in a mutable with an atomic update function
let forest = new AsyncMutable<_>(Forest.empty)
// Create our 3 functions for the application framework
// Start with the function to create our model (as an ISignal<'a>)
let createModel () : ISignal<_> = forest :> _
// Create a function that updates our state given a message
// Note that we're just taking the message, passing it directly to our model's update function,
// then using that to update our core "Mutable" type.
let update (msg : ForestMessage) : unit = Forest.update msg |> forest.Update |> ignore
// An init function that occurs once everything's created, but before it starts
let init () : unit =
// Handle pruning of the forest -
// Once per second, send a prune message to remove a tree if there are more than max
let rec pruneForever max update =
async {
do! Async.Sleep 500
Prune max |> update
do! pruneForever max update
}
// Start prune loop in the background asynchronously
pruneForever 10 update |> Async.Start
// Start our application
Framework.application createModel init update forestComponent
// Our main forest model
type Forest = Tree list
// Update types allowed on a forest
type ForestMessage =
| Add of Location // Add new tree at a location
| UpdateTree of msg : TreeMessage * tree : Tree // Update an existing tree
| Prune of maxTrees : int // Prune the trees
// Module with allowed operations on a forest
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Forest =
let private rnd = System.Random()
let empty : Forest = []
// Prune one tree if we're over the max size
let private prune max (forest : Forest) : Forest =
let l = List.length forest
if max < l then
// Remove an "older" tree, from the 2nd half of the list
let indexToRemove = rnd.Next ( l / 2, l)
forest
|> List.mapi (fun i t -> (i <> indexToRemove, t))
|> List.filter fst
|> List.map snd
else
forest
let update msg forest =
match msg with
| Add(location) -> Tree.create location :: forest
| UpdateTree(msg, tree) -> Tree.update msg tree :: List.except [ tree ] forest
| Prune(maxTrees) -> prune maxTrees forest
// Create binding for entire application. This will output all of our messages.
let forestComponent source (model : ISignal<Forest>) =
// Bind our collection to "Forest"
let forest = BindingCollection.toView source "Forest" model treeComponent
[
// Map Decorate messages in the treeComponent to UpdateTree messages
forest |> Observable.map UpdateTree
// Create a command that routes to Add messages
source |> Binding.createMessageParam "Add" Add
]
<Path Canvas.ZIndex="2" DataContext="{Binding Tree}" Visibility="{Binding Lit, Converter={StaticResource boolToVis}}" Fill="White" Stroke="White" StrokeThickness="2"
<Window
xmlns="http://schemas.microsoft.com/winfx/2006/xaml/presentation"
xmlns:x="http://schemas.microsoft.com/winfx/2006/xaml"
xmlns:sys="clr-namespace:System;assembly=mscorlib"
xmlns:fsx="clr-namespace:FsXaml;assembly=FsXaml.Wpf"
xmlns:fsxb="clr-namespace:FsXaml;assembly=FsXaml.Wpf.Blend"
xmlns:local="clr-namespace:Views;assembly=AdventTrees2016"
xmlns:i="clr-namespace:System.Windows.Interactivity;assembly=System.Windows.Interactivity"
Title="FsAdvent 2016 - Decorate Some Trees!"
Name="Win"
Height="500"
Width="500">
<Window.Resources>
<local:LocationConverter x:Key="locationConverter" />
<fsx:BooleanToVisibilityConverter x:Key="boolToVis" />
<DataTemplate x:Key="TreeTemplate">
<Canvas>
<i:Interaction.Triggers>
<i:EventTrigger EventName="MouseLeftButtonDown">
<fsxb:EventToCommand Command="{Binding Decorate}" />
</i:EventTrigger>
</i:Interaction.Triggers>
<Path DataContext="{Binding Tree}" Fill="DarkGreen" Stroke="DarkGreen" StrokeThickness="1" Data="M 0 -50 L -15 40 L -2 40 L -2 50 L 2 50 L 2 40 L 15 40 Z" RenderTransformOrigin="0.5,0.5" >
<Path.RenderTransform>
<TransformGroup>
<ScaleTransform ScaleX="0.15" ScaleY="0.1" />
<ScaleTransform ScaleX="{Binding Height}" ScaleY="{Binding Height}" />
<TranslateTransform X="{Binding Position.X}" Y ="{Binding Position.Y}"/>
</TransformGroup>
</Path.RenderTransform>
</Path>
<Path DataContext="{Binding Tree}" Visibility="{Binding Decorated, Converter={StaticResource boolToVis}}" Fill="Red" Stroke="Red" StrokeThickness="4" Data="M -6 -30 L 6 -28 M -12 0 L 12 3 M -16 30 L 16 34" RenderTransformOrigin="0.5,0.5" >
<Path.RenderTransform>
<TransformGroup>
<ScaleTransform ScaleX="0.15" ScaleY="0.1" />
<ScaleTransform ScaleX="{Binding Height}" ScaleY="{Binding Height}" />
<TranslateTransform X="{Binding Position.X}" Y ="{Binding Position.Y}"/>
</TransformGroup>
</Path.RenderTransform>
</Path>
</Canvas>
</DataTemplate>
</Window.Resources>
<Grid>
<Grid.RowDefinitions>
<RowDefinition Height="Auto" />
<RowDefinition Height="*"/>
</Grid.RowDefinitions>
<TextBlock HorizontalAlignment="Center">Click to add a Tree - Click on a tree to decorate it.</TextBlock>
<ItemsControl
Grid.Row="1" HorizontalAlignment="Stretch" VerticalAlignment="Stretch"
ItemsSource="{Binding Forest}"
ItemTemplate="{StaticResource TreeTemplate}"
>
<ItemsControl.ItemsPanel>
<ItemsPanelTemplate>
<Canvas HorizontalAlignment="Stretch" VerticalAlignment="Stretch" Background="Gray" ClipToBounds="True" >
<i:Interaction.Triggers>
<i:EventTrigger EventName="MouseLeftButtonDown">
<fsxb:EventToCommand Command="{Binding Add}" FilterOptionEventArgs="True" EventArgsConverter="{StaticResource locationConverter}" />
</i:EventTrigger>
</i:Interaction.Triggers>
</Canvas>
</ItemsPanelTemplate>
</ItemsControl.ItemsPanel>
</ItemsControl>
</Grid>
</Window>
<i:EventTrigger EventName="MouseRightButtonDown">
<fsxb:EventToCommand Command="{Binding Light}" />
</i:EventTrigger>
// Our tree types
type Location = { X: float; Y: float }
type Tree = { Position : Location ; Height : float ; Decorated : bool }
// Update types allowed on a tree
type TreeMessage = | Decorate
// Module showing allowed operations on an existing tree
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module Tree =
let private rnd = System.Random()
let private makeHeight () = 8.0 + rnd.NextDouble() * 4.0
let create location =
{ Position = location ; Height = makeHeight () ; Decorated = false }
let update msg tree =
match msg with
| Decorate -> { tree with Decorated = true }
// Add "Lit"
type Tree = { Position : Location ; Height : float ; Decorated : bool ; Lit : bool }
// Add Light message
type TreeMessage = | Decorate | Light
// In module Tree
// Handle new message here
let update msg tree =
match msg with
| Decorate -> { tree with Decorated = true }
| Light -> { tree with Lit = true }
// Create binding for a single tree. This will output Decorate messages
let treeComponent source (model : ISignal<Tree>) =
// Bind the tree itself to the view
model |> Binding.toView source "Tree"
[
// Create a command that turns into the Decorate message
source |> Binding.createMessage "Decorate" Decorate
]
let treeComponent source (model : ISignal<Tree>) =
model |> Binding.toView source "Tree"
[
source |> Binding.createMessage "Decorate" Decorate
// Add one line here to add a new command that maps to the light message
source |> Binding.createMessage "Light" Light
]
module internal MouseConverters =
// Create a converter from mouse clicks on a Canvas to Some(location), and clicks elsewhere to None
let locationConverter (args : MouseEventArgs) =
match args.OriginalSource with
| :? Canvas ->
let source = args.OriginalSource :?> IInputElement
let pt = args.GetPosition(source)
Some { X = pt.X; Y = pt.Y }
| _ -> None
// Create our converter from MouseEventArgs -> Location
type LocationConverter() = inherit EventArgsConverter<MouseEventArgs, Location option>(MouseConverters.locationConverter, None)
// Create our Window
type MainWindow = XAML<"MainWindow.xaml">
module Main =
[<STAThread>]
[<EntryPoint>]
let main _ =
// Run using the WPF wrappers around the basic application framework
Gjallarhorn.Wpf.Framework.runApplication System.Windows.Application MainWindow Program.application
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment