FsAdvent 2016 Code

application.fs

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 

forest.fs

// 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
            

forestComponent.fs

// 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
    ]

lightPath.xaml

<Path Canvas.ZIndex="2" DataContext="{Binding Tree}" Visibility="{Binding Lit, Converter={StaticResource boolToVis}}" Fill="White" Stroke="White" StrokeThickness="2"

mainwindow.xaml

<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>

rightMouse.xaml

<i:EventTrigger EventName="MouseRightButtonDown">
    <fsxb:EventToCommand Command="{Binding Light}" />
</i:EventTrigger>

tree.fs

// 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 }
            

tree2.fs

// 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 }

treeComponent.fs

// 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 
    ]

treeComponent2.fs

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
    ]

view1.fs

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)

view2.fs

// 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