Learning WPF with F# - ListBox Selection

I think I'm getting a better handle of F# programming language. For the sample codes in Chapter 13, I've decided to assume a Perl hacker mentality, which is try to do the same thing in different ways. One example is shown in the SelectColorGrid example. At the start of this series of blogs on F# and WPF, I would have written the following chunk of F# code for adding FrameworkElementFactory based on Rectangle to the FrameworkElementFactory based on StackPanel:

let factoryStack = new FrameworkElementFactory(typeof<StackPanel>)

let factoryRectangle = new FrameworkElementFactory(typeof<Rectangle>)
factoryRectangle.SetValue(Rectangle.WidthProperty,16.0)
factoryRectangle.SetValue(Rectangle.HeightProperty,16.0)
factoryRectangle.SetValue(Rectangle.MarginProperty,new Thickness(2.0)
factoryRectangle.SetValue(Rectangle.StrokeProperty,SystemColors.WindowTextBrush)
factoryRectangle.SetBinding(Rectangle.FillProperty,new Binding("Brush"))

factoryStack.AppendChild(factoryRectangle)

With some experimentation, I would can rewrite the above chunk of code as:

let factoryStack = new FrameworkElementFactory(typeof<StackPanel>)

factoryStack.AppendChild
  (let factory = new FrameworkElementFactory(typeof<Rectangle>)
  
   let setval = factory.SetValue
   let setbind = factory.SetBinding
   
   (Rectangle.WidthProperty,16.0)                          |> setval
   (Rectangle.HeightProperty,16.0)                         |> setval
   (Rectangle.MarginProperty,new Thickness(2.0))           |> setval
   (Rectangle.StrokeProperty,SystemColors.WindowTextBrush) |> setval
   (Rectangle.FillProperty,new Binding("Brush"))           |> setbind
   factory)

A couple points on the revised version of the example code. Note that I was able to define what I call function aliases via let setval = factory.SetValue. These provide syntatic sugar so I don't have to write verbose code. I can do this only because I can limit the scope within parameter tuple to factoryStack.AppendChild. I don't have to worry about setval being used elsewhere in my code. The other usage is flipping the order of parameter and function name with the forward pipe operator (|>). I'm not sure if this makes the code any more readable, but it sure warps my way of thinking when it comes to writing code and allows me to think about the code differently. The other operator I hope to take more advantage of is the forward composition operator (>>).

Another interesting representation of the code is implemented in the ColorWheel example. I'm able to isolate an entire chunk of functionality without exposing any variable. This ensures that I don't have to worry about change impacts to any other parts of the code. Here is where I wish I had a better understanding of F# compiler works and be able to tell which representation allows for better compiler optimization. When I'm ready for the challenge, I'm going to try to read through Simon Peyton Jone's book The Implementation of Functional Programming Languages which he has made freely available online.

Here are more code examples from working on Chapter 13 of Petzold's book Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation.

ListColorNames
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
//
// From Chapter 13 - ListColorNames
//
let lstbox = new ListBox(Width=150.0,Height=150.0)

// Fill ListBox with Color names
let props = (typeof<Colors>).GetProperties()
props |> Seq.iter (fun p -> lstbox.Items.Add(p.Name)|>ignore)

let window = new Window(Title="List Color Names",Content=lstbox)  

// ListBoxOnSelectionChanged
lstbox.SelectionChanged.Add( fun _ ->
   let str = lstbox.SelectedItem :?> string
   if str <> null then
      let clr = (typeof<Colors>).GetProperty(str).GetValue(null,null) :?> Color
      window.Background <- new SolidColorBrush(clr))

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ListColorValues
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
//
// From Chapter 13 - ListColorValues
//
let lstbox = new ListBox(Width=150.0,Height=150.0)

// Fill ListBox with Color values
let props = (typeof<Colors>).GetProperties()
props |> Seq.iter (fun p -> lstbox.Items.Add(p.GetValue(null,null))|>ignore)

let window = new Window(Title="List Color Values",Content=lstbox)  

// ListBoxOnSelectionChanged
lstbox.SelectionChanged.Add( fun _ ->
   if lstbox.SelectedIndex <> -1 then
      let clr = lstbox.SelectedItem :?> Color
      window.Background <- new SolidColorBrush(clr))

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

NamedColor & ListNamedColors
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
//
// From Chapter 13 - NamedColor
//
type NamedColor = 
   {clr : Color; clrname : string}
   
   // Using v instead of this...
   override v.ToString() = v.clrname 
   // normally I would write the above line of code as
   // override this.ToString() = this.clrname.  There's nothing
   // special with "this"
   
   member v.Name 
      with get() = 
         let retval = v.clrname |> String.map_concat (fun c -> 
            if Char.IsUpper(c) 
            then " " + String.of_char(c) 
            else String.of_char(c))
         retval.Trim()

   member v.Color 
      with get() = v.clr
   
   static member All =
      let props = (typeof<Colors>).GetProperties()
      props |> Seq.map (fun prop -> {clrname=prop.Name; clr=(prop.GetValue(null,null):?>Color)})
//
// From Chapter 13 - ListNamedColors
//
let lstbox = new ListBox(ItemsSource=NamedColor.All,
                         DisplayMemberPath="Name",
                         SelectedValuePath="Color",
                         Width=150.0,
                         Height=150.0)

let window = new Window(Title="List Named Colors",Content=lstbox)  

// ListBoxOnSelectionChanged
lstbox.SelectionChanged.Add( fun _ ->
   if lstbox.SelectedValue <> null then
      let clr = lstbox.SelectedValue :?> Color
      window.Background <- new SolidColorBrush(clr))

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

NamedBrush & ListNamedBrushes
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
//
// From Chapter 13 - NamedBrush
//
type NamedBrush = 
   {brush : Brush; name : string}
   
   override v.ToString() = v.name 
   
   member v.Name 
      with get() = 
         let retval = v.name |> String.map_concat (fun c -> 
            if Char.IsUpper(c) 
            then " " + String.of_char(c) 
            else String.of_char(c))
         retval.Trim()

   member v.Brush 
      with get() = v.brush
   
   static member All =
      let props = (typeof<Brushes>).GetProperties()
      props |> Seq.map (fun prop -> {name=prop.Name; brush=(prop.GetValue(null,null):?>Brush)})
//
// From Chapter 13 - ListNamedBrushes
//
let lstbox = new ListBox(ItemsSource=NamedBrush.All,
                         DisplayMemberPath="Name",
                         SelectedValuePath="Brush",
                         Width=150.0,
                         Height=150.0)

let window = new Window(Title="List Named Brushes",Content=lstbox)  

// Bind the SelectedValue to window Background
lstbox.SetBinding(ListBox.SelectedValueProperty,"Background")
lstbox.DataContext <- window

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ListColorShapes
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
open System.Windows.Shapes

//
// From Chapter 13 - ListColorShapes
//
let lstbox = new ListBox(Width=150.0,
                         Height=150.0)

// Fill ListBox with Ellipse objects                         
(typeof<Brushes>).GetProperties()
  |> Seq.iter (fun prop ->
     let brush = prop.GetValue(null,null) :?> Brush
     let ellip = new Ellipse(Width=100.0,
                             Height = 25.0,
                             Margin = new Thickness(10.0,5.0,0.0,5.0),
                             Fill = brush)
     lstbox.Items.Add(ellip)|>ignore)

let window = new Window(Title="List Color Shapes",Content=lstbox) 

lstbox.SelectionChanged.Add( fun _ ->
   if lstbox.SelectedIndex <> -1 then
      window.Background <- (lstbox.SelectedItem :?> Shape).Fill)


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ListColorLabels
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
open System.Windows.Shapes

//
// From Chapter 13 - ListColorLabels
//
let lstbox = new ListBox(Width=150.0,
                         Height=150.0)
    
// Fill ListBox with label controls     
(typeof<Colors>).GetProperties()
  |> Seq.iter (fun prop ->
     let clr = prop.GetValue(null,null) :?> Color
     let b2f x = Float.of_int (Byte.to_int x)
     let isBlack = 0.222*(b2f clr.R) + 0.707 * (b2f clr.G) + 0.071 * (b2f clr.B) > 128.0
     let lbl = new Label(Content=prop.Name,
                         Background = new SolidColorBrush(clr),
                         Foreground = (if isBlack then Brushes.Black else Brushes.White),
                         Width = 100.0,
                         Margin = new Thickness(15.0,0.0,0.0,0.0),
                         Tag = clr)
     lstbox.Items.Add(lbl) |> ignore)
                              

let window = new Window(Title="List Color Labels",Content=lstbox) 

lstbox.SelectionChanged.Add( fun _ ->
   match lstbox.SelectedItem with
   | :? Label as lbl ->
      let clr = lbl.Tag :?> Color
      window.Background <- new SolidColorBrush(clr)
   | _ -> ())
      


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ListWithListBoxItems
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media 

//
// From Chapter 13 - ListWithListBoxItems
//
let lstbox = new ListBox(Width=150.0,
                         Height=150.0)
    
// Fill ListBox with label controls     
(typeof<Colors>).GetProperties()
  |> Seq.iter (fun prop ->
     let clr = prop.GetValue(null,null) :?> Color
     
     let isBlack = 
        let b2f x = Float.of_int (Byte.to_int x)
        0.222*(b2f clr.R) + 0.707 * (b2f clr.G) + 0.071 * (b2f clr.B) > 128.0
     
     let item = new ListBoxItem(Content=prop.Name,
                                Background = new SolidColorBrush(clr),
                                Foreground = (if isBlack then Brushes.Black else Brushes.White),
                                HorizontalContentAlignment = HorizontalAlignment.Center,
                                Padding = new Thickness(2.0))
     lstbox.Items.Add(item) |> ignore)
                              

let window = new Window(Title="List with ListBoxItem",Content=lstbox) 

lstbox.SelectionChanged.Add( fun args ->
   if args.RemovedItems.Count > 0 then
      let item = args.RemovedItems.[0] :?> ListBoxItem
      let str = item.Content :?> string
      item.Content <- String.sub str 2 (str.Length-4)
      item.FontWeight <- FontWeights.Regular
   
   if args.AddedItems.Count > 0 then
      let item = args.AddedItems.[0] :?> ListBoxItem
      let str = item.Content :?> string
      item.Content <- "[ " + str + " ]"
      item.FontWeight <- FontWeights.Bold
      
      
   match lstbox.SelectedItem with
   | :? ListBoxItem as item ->
      window.Background <- item.Background
   | _ -> ())
      


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ColorListBoxItem, ColorListBox & ListColorsElegantly
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media 
open System.Windows.Shapes 
//
// From Chapter 13 - ColorListBoxItem, ColorListBox & ListColorsElegantly
//
//
// From Chapter 13 - ColorListBoxItem
//
type ColorListBoxItem() = class
   inherit ListBoxItem() as base
   
   let mutable str = ""
   let stack = new StackPanel(Orientation=Orientation.Horizontal)
   let text = new TextBlock(VerticalAlignment = VerticalAlignment.Center)
   
   let rect = new Rectangle(Width=16.0,
                            Height=16.0,
                            Margin=new Thickness(2.0),
                            Stroke = SystemColors.WindowTextBrush)
   do
      base.Content <- stack
      stack.Children.Add(rect) |> ignore
      stack.Children.Add(text) |> ignore  
   
   member this.Text
     with get() = str
     and set value = 
        str <- value
        let strSpaced = value |> String.map_concat (fun c ->
            if Char.IsUpper(c)
            then " " + String.of_char(c)
            else String.of_char(c))
        text.Text <- strSpaced
   
   member this.Color
     with get() =
        let brush = rect.Fill :?> SolidColorBrush
        if brush = null then Colors.Transparent else brush.Color  
     and set value = 
        rect.Fill <- new SolidColorBrush(value)
        
   override this.OnSelected (args:RoutedEventArgs) =
      base.OnSelected(args)
      text.FontWeight <- FontWeights.Bold
      
   override this.OnUnselected (args:RoutedEventArgs) =
      base.OnUnselected(args)
      text.FontWeight <- FontWeights.Regular
      
   override this.ToString() = str
end
//
// From Chapter 13 - ColorListBox
//
type ColorListBox() = class
   inherit ListBox() as base
   
   do
      let this = base
      typeof<Colors>.GetProperties() 
        |> Seq.iter (fun prop ->
           let item = new ColorListBoxItem(Text=prop.Name,
                                           Color=(prop.GetValue(null,null):?> Color))
           this.Items.Add(item) |> ignore
           ())
      this.SelectedValuePath <- "Color"
   
   member this.SelectedColor
      with get() = this.SelectedValue :?> Color
      and set (value:Color) = this.SelectedValue <- value
   
end   
//
// From Chapter 13 - ListColorsElegantly
//

let lstbox = new ColorListBox(SelectedColor = SystemColors.WindowColor,
                              Width=150.0,
                              Height=150.0)
    

let window = new Window(Title="List Colors Elegantly",Content=lstbox) 

lstbox.SelectionChanged.Add( fun _ ->
   window.Background <- new SolidColorBrush(lstbox.SelectedColor))      


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

NamedBrush & ListColorsEvenMoreElegantlier
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Reflection
open System.Windows
open System.Windows.Data
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media 
open System.Windows.Shapes 
//
// From Chapter 13 - NamedBrush
//
type NamedBrush = 
   {brush : Brush; name : string}
   
   override v.ToString() = v.name 
   
   member v.Name 
      with get() = 
         let retval = v.name |> String.map_concat (fun c -> 
            if Char.IsUpper(c) 
            then " " + String.of_char(c) 
            else String.of_char(c))
         retval.Trim()

   member v.Brush 
      with get() = v.brush
   
   static member All =
      (typeof<Brushes>).GetProperties()
      |> Seq.map (fun prop -> {name=prop.Name; brush=(prop.GetValue(null,null):?>Brush)})

//
// From Chapter 13 - ListColorsEvenMoreElegantlier
//

// Create a data template for the items and populate it.
let template = 
   let brushTemplate = new DataTemplate(typeof<NamedBrush>)

   // Create a FrameworkElementFactory based on StackPanel
   let factoryStack = new FrameworkElementFactory(typeof<StackPanel>)
   factoryStack.SetValue(StackPanel.OrientationProperty,Orientation.Horizontal)
   
   brushTemplate.VisualTree <- factoryStack
   
   // Create a FrameworkElementFactory based on Rectangle and   
   // add it to the stack panel.  Note, with this construct, I don't
   // pollute the rest of the code with the factory definition
   factoryStack.AppendChild
     (let factory = new FrameworkElementFactory(typeof<Rectangle>)
      // function aliases (syntactic sugar) so I don't have to type as much
      let setval = factory.SetValue
      let setbind = factory.SetBinding
      
      // I flipped the parameters with function name via the forward (|>) operator
      // Not sure is this is a more readable format or not, but it sure is a
      // departure from normal C# forms.
      (Rectangle.WidthProperty,16.0)                          |> setval
      (Rectangle.HeightProperty,16.0)                         |> setval
      (Rectangle.MarginProperty,new Thickness(2.0))           |> setval
      (Rectangle.StrokeProperty,SystemColors.WindowTextBrush) |> setval
      (Rectangle.FillProperty,new Binding("Brush"))           |> setbind
      factory)

   // Create a FrameworkElementFactory based on TextBlock and add it to stack panel
   (let factory = new FrameworkElementFactory(typeof<TextBlock>)
    (TextBlock.VerticalAlignmentProperty,VerticalAlignment.Center) |> factory.SetValue
    (TextBlock.TextProperty,new Binding("Name"))                   |> factory.SetBinding
    factory) |> factoryStack.AppendChild
      
   // return the data template
   brushTemplate

// variables factoryRectangle, factoryStack & factoryTextBlock no longer pollute
// the rest of the code space

let lstbox = new ListBox(Width=150.0,
                         Height=150.0,
                         ItemTemplate=template,
                         ItemsSource=NamedBrush.All,
                         SelectedValuePath="Brush")
    

let window = new Window(Title="List Colors Even Elegantlier",Content=lstbox) 
lstbox.SetBinding(ListBox.SelectedValueProperty,"Background")
lstbox.DataContext <- window

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ColorGridBox & SelectColorFromGrid
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Data
open System.Windows.Controls
open System.Windows.Controls.Primitives
open System.Windows.Input
open System.Windows.Media 
open System.Windows.Shapes 
//
// From Chapter 13 - ColorGridBox
//
type ColorGridBox() as this =  class
   inherit ListBox() as base
   
   // list of colors to be displayed
   let strColors = 
      ["Black"; "Brown"; "DarkGreen"; "MidnightBlue";
       "Navy"; "DarkBlue"; "Indigo"; "DimGray";
       "DarkRed"; "OrangeRed"; "Olive"; "Green";
       "Teal"; "Blue"; "SlateGray"; "Gray";
       "Red"; ""; "YellowGreen"; "SeaGreen";
       "Aqua"; "LightBlue"; "Violet"; "DarkGray";
       "Pink"; "Gold"; "Yellow"; "Lime";
       "Turquoise"; "SkyBlue"; ""; "LightGray";
       "LightPink"; "Tan"; "LightYellow"; "LightGreen";
       "LightCyan"; "LightSkyBlue"; "Lavender"; "White"]
   
   do 
       let factory = new FrameworkElementFactory(typeof<UniformGrid>)
       (UniformGrid.ColumnsProperty,8) |> factory.SetValue
       
       this.ItemsPanel <- new ItemsPanelTemplate(factory)
       
       // Add items to the ListBox
       strColors |> Seq.iter (fun color ->
          (new Rectangle(Width=12.0, 
                         Height=12.0,
                         Fill=(typeof<Brushes>.GetProperty(color).GetValue(null,null):?>Brush),
                         ToolTip = new ToolTip(Content=color),
                         Margin=new Thickness(4.0))
          |> this.Items.Add |> ignore))  
       
       this.SelectedValuePath <- "Fill"
end   
//
// From Chapter 13 - SelectColorFromGrid
//

let stack = new StackPanel()

let window = new Window(Title="Select Color from Grid",
                        SizeToContent = SizeToContent.WidthAndHeight,
                        Content=stack) 

let createDoNothingButton () =                         
   new Button(Content = "Do-nothing button\nto test tabbing",
              Margin = new Thickness(24.0),
              HorizontalAlignment = HorizontalAlignment.Center,
              VerticalAlignment = VerticalAlignment.Center)
              
// Create do-nothing button to test tabbing and add to StackPanel
createDoNothingButton () |> stack.Children.Add |> ignore

// Create ColorGridBox control and add to StackPanel
(let clrgrid = new ColorGridBox(Margin = new Thickness(24.0),
                                DataContext=window,
                                HorizontalAlignment = HorizontalAlignment.Center,
                                VerticalAlignment = VerticalAlignment.Center)
 // Bind background
 (ColorGridBox.SelectedValueProperty,"Background")
       |>clrgrid.SetBinding |> ignore
 clrgrid)  |> stack.Children.Add |> ignore

// Create another do-nothing button to test tabbing and add to StackPanel
createDoNothingButton () |> stack.Children.Add |> ignore


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

ColorWheel & SelectColorFromWheel
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"
#r @"radialpanel.dll"

open System
open System.Windows
open System.Windows.Data
open System.Windows.Controls
open System.Windows.Controls.Primitives
open System.Windows.Input
open System.Windows.Media 
open System.Windows.Shapes 
open Chapter12  

//
// From Chapter 13 - ColorWheel
//
type ColorWheel() as this =  class
   inherit ListBox() as base

   do 
      this.ItemsPanel <- new ItemsPanelTemplate
         (new FrameworkElementFactory(typeof<RadialPanel>))

      // Create DataTemplate for the items and create a FrameworkElementFactory
      // based on Rectangle and use that factory for visual tree.
      // Again, I'm just playing around with the expressiveness of F# and not
      // necessarily recommending coding in this format.
      // Look ma!  No let bindings....
      new DataTemplate(typeof<Brush>) |> (fun template ->
         new FrameworkElementFactory(typeof<Rectangle>) |> (fun f ->
            (Rectangle.WidthProperty, 4.0)   |> f.SetValue
            (Rectangle.HeightProperty, 12.0) |> f.SetValue
            (Rectangle.MarginProperty, new Thickness(1.0, 8.0, 1.0, 8.0)) |> f.SetValue
            (Rectangle.FillProperty, new Binding("")) |> f.SetBinding
            template.VisualTree <- f)
         this.ItemTemplate <- template)

      // Set the items in the ListBox
      (typeof<Brushes>).GetProperties() |> Seq.iter (fun prop ->
         (prop.GetValue(null,null) :?> Brush) |> this.Items.Add |> ignore)
end   
//
// From Chapter 13 - SelectColorFromWheel
//


let createDoNothingButton () =                         
   new Button(Content = "Do-nothing button\nto test tabbing",
              Margin = new Thickness(24.0),
              HorizontalAlignment = HorizontalAlignment.Center,
              VerticalAlignment   = VerticalAlignment.Center)

let stack = new StackPanel(Orientation=Orientation.Horizontal)

// Add a do-nothing button to test tabbing              
createDoNothingButton() |> stack.Children.Add |> ignore

// Create ColorWheel Control
let clrwheel = new ColorWheel(Margin = new Thickness(24.0),
                              HorizontalAlignment = HorizontalAlignment.Center,
                              VerticalAlignment = VerticalAlignment.Center)
clrwheel |> stack.Children.Add |> ignore               

// Add another do-nothing button to test tabbing              
createDoNothingButton() |> stack.Children.Add |> ignore
              

let window = new Window(Title="Select Color from Wheel",
                        SizeToContent = SizeToContent.WidthAndHeight,
                        Content=stack) 

// Bind Background of window to selected  value of ColorWheel                        
(ColorWheel.SelectedValueProperty, "Background") |> clrwheel.SetBinding
clrwheel.DataContext <- window

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

Learning WPF with F# - Custom Panels

In my last blog posting, I decided to label my blog with the title "Learning F# with WPF" and later decided that title doesn't make sense semantically even if most people would understand what I mean. So I later revert the title back to "Learning WPF with F#". Unbeknownst to me, Dr. Don Syme kindly featured my blogs in his blog. All of a sudden my blog jumped from page hits of less then a hundred for the entire existence of this blog to several hundred page hits in just a couple of days. It made me realize that my blog posting is no longer my personal journal to be changed on a whim and apologize if my title changed may have caused any confusion with what Dr. Don Syme have posted.

I'm continuing to experiment with the different expressions of F# language. I suppose when this language becomes popular enough, someone will be able to put together a book on programming idioms in F#. Here are more code examples from working on Chapter 12 of Petzold's book Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation.

UniformGridAlmost & DuplicateUniformGrid

#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  

// Again, plagarizing some functions from Haskell's Prelude
let max x y = if x <= y then y else x
// Find the max value of a sequence
let seqmax s = Seq.fold1 max s

let mutable initColumnsProperty : DependencyProperty = null

//
// From Chapter 12 - UniformGridAlmost
//
type UniformGridAlmost () = class
   inherit Panel() as base
  
   static member ColumnsProperty =
      if initColumnsProperty = null then
         initColumnsProperty <- DependencyProperty.Register
            ("Columns", typeof<int>,typeof<UniformGridAlmost>,
             new FrameworkPropertyMetadata
                (1, FrameworkPropertyMetadataOptions.AffectsMeasure))
         initColumnsProperty
      else
         initColumnsProperty   
   
   member this.Columns
      with get() = (this.GetValue(UniformGridAlmost.ColumnsProperty) :?> int)
      and set (value :int) =
         this.SetValue(UniformGridAlmost.ColumnsProperty,value)
         

   member this.Rows
      with get() = (this.InternalChildren.Count + this.Columns -1)/ this.Columns
         
     
   override this.MeasureOverride(sizeAvailable:Size) = 
     
     // aliases for column/row count in float type
     let colf = Float.of_int this.Columns
     let rowf = Float.of_int this.Rows
     
     let sizeChild = new Size(sizeAvailable.Width/ colf,
                              sizeAvailable.Height/ rowf)
                              
     let internalChildren = this.InternalChildren |> Seq.untyped_to_typed
     // Alternatively, I could have written the above expression as
     // let internalChildren = Seq.untyped_to_typed this.InternalChildren 
     // However, I'm leaning toward this first form because it makes it's easier
     // to pick out that I'm working with this.InternalChildren
     
     // Call Measure for each child....
     internalChildren |> Seq.iter (fun (child:UIElement) -> child.Measure(sizeChild))
     
     // Get max width/height
     let maxwidth =  internalChildren 
                     |> Seq.map (fun (child:UIElement) -> child.DesiredSize.Width) 
                     |> seqmax
                     
     let maxheight =  internalChildren 
                      |> Seq.map (fun (child:UIElement) -> child.DesiredSize.Height) 
                      |> seqmax
     
     new Size(colf * maxwidth, rowf * maxheight)
     

   override this.ArrangeOverride(sizeFinal:Size) = 
     // aliases for column/row count in float type
     let colf = Float.of_int this.Columns
     let rowf = Float.of_int this.Rows
     
     let sizeChild = new Size(sizeFinal.Width/ colf,
                              sizeFinal.Height/ rowf)
                              
     let internalChildren = this.InternalChildren |> Seq.untyped_to_typed
     
     internalChildren
     |> Seq.iteri (fun i (child:UIElement) ->
        let row = Int32.to_float (i / this.Columns)
        let col = Int32.to_float (i % this.Columns)
        let rectChild = new Rect(new Point(col*sizeChild.Width,
                                           row*sizeChild.Height),
                                 sizeChild)
        child.Arrange(rectChild))
     sizeFinal
      
                 
end   
//
// From Chapter 12 - DuplicateUniformGrid
//
let window = new Window(Title="Duplicate Uniform Grid",
                        SizeToContent = SizeToContent.WidthAndHeight)   

let unigrid = new UniformGridAlmost(Columns=5)
let rand = new Random()

// Fill grid with randomly-sized buttons
seq {0..47} |> Seq.iteri (fun i _ ->
   let name = "Button" + Int32.to_string i
   let sizemodifier = Float.of_int (rand.Next(10) )
   let btn = new Button(Name=name,
                        Content=name)
   btn.FontSize <- btn.FontSize + sizemodifier
   btn.Click.Add(fun _ -> MessageBox.Show(btn.Name + " has been clicked",window.Title)|>ignore)
   unigrid.Children.Add(btn)|>ignore)
   
window.Content <- unigrid   


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

CanvasClone & PaintOnCanvasClone
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
open System.Windows.Shapes

let mutable initLeftProperty : DependencyProperty = null
let mutable initTopProperty : DependencyProperty = null

//
// From Chapter 12 - CanvasClone
//
type CanvasClone () = class
   inherit Panel() as base
  
   static member LeftProperty =
      if initLeftProperty = null then
         initLeftProperty <- DependencyProperty.RegisterAttached
            ("Left", typeof<double>,typeof<CanvasClone>,
             new FrameworkPropertyMetadata
                (0.0, FrameworkPropertyMetadataOptions.AffectsParentArrange))
         initLeftProperty
      else
         initLeftProperty   

   static member TopProperty  =
      if initTopProperty = null then
         initTopProperty <- DependencyProperty.RegisterAttached
            ("Top", typeof<double>,typeof<CanvasClone>,
             new FrameworkPropertyMetadata
                (0.0, FrameworkPropertyMetadataOptions.AffectsParentArrange))
         initTopProperty
      else
         initTopProperty   
   
   static member SetLeft (depobj:DependencyObject, value:double) =
      depobj.SetValue(CanvasClone.LeftProperty,value)
      
   static member GetLeft (depobj:DependencyObject) =
      depobj.GetValue(CanvasClone.LeftProperty) :?> double
      
   static member SetTop (depobj:DependencyObject, value:double) =
      depobj.SetValue(CanvasClone.TopProperty,value)
      
   static member GetTop (depobj:DependencyObject) =
      depobj.GetValue(CanvasClone.TopProperty) :?> double

   override this.MeasureOverride(sizeAvailable:Size) = 
     let posInf = new Size(Double.PositiveInfinity,Double.PositiveInfinity)
     let internalChildren = this.InternalChildren |> Seq.untyped_to_typed
     internalChildren 
       |> Seq.iter (fun (child:UIElement) -> child.Measure(posInf))
     base.MeasureOverride(sizeAvailable)
   
   override this.ArrangeOverride(sizeFinal:Size) = 
     let internalChildren = this.InternalChildren |> Seq.untyped_to_typed
     internalChildren |> Seq.iter (fun (child:UIElement) -> 
           child.Arrange(new Rect(new Point(CanvasClone.GetLeft(child), 
                                            CanvasClone.GetTop(child)),
                                  child.DesiredSize)))
     sizeFinal                 
end   
//
// From Chapter 12 - PaintOnCanvasClone
//
let canv = new CanvasClone()
let brushes = [Brushes.Red; Brushes.Green; Brushes.Blue; ]
brushes |> Seq.iteri (fun i brush ->
   let location = Float.of_int (100*(i+1))
   let rect = new Rectangle(Fill=brush,
                            Width = 200.0,
                            Height = 200.0)
   canv.Children.Add(rect)|>ignore
   CanvasClone.SetLeft(rect, location)
   CanvasClone.SetTop(rect, location))
                            
let window = new Window(Title="Paint on Canvas Clone",
                        Content=canv)  

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

DiagonalPanel & DiagonalizeTheButtons
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  

let mutable initBackgroundProperty : DependencyProperty = null

//
// From Chapter 12 - DiagonalPanel
//
type DiagonalPanel () = class
   inherit FrameworkElement() as base
   
   let children = new ResizeArray<UIElement>()
  
   // Sum the widths of all the child elements 
   let sumwidth elements = 
      Seq.map (fun (c:UIElement) -> c.DesiredSize.Width) (ResizeArray.to_list elements) 
      |> Seq.fold1 (+)
  
   // Sum the heights of all the child elements
   let sumheight elements = 
      Seq.map (fun (c:UIElement) -> c.DesiredSize.Height) (ResizeArray.to_list elements) 
      |> Seq.fold1  (+)

   static member BackgroundProperty =
      if initBackgroundProperty = null then
         initBackgroundProperty <- DependencyProperty.Register
            ("Background", typeof<Brush>,typeof<DiagonalPanel>,
             new FrameworkPropertyMetadata
                (null, FrameworkPropertyMetadataOptions.AffectsRender))
         initBackgroundProperty
      else
         initBackgroundProperty   

   member this.Background 
      with get() = (this.GetValue(DiagonalPanel.BackgroundProperty) :?> Brush)
      and set (value :Brush) =
         this.SetValue(DiagonalPanel.BackgroundProperty,value)
   
   member this.Add (el:UIElement) =
      children.Add(el)
      this.AddVisualChild(el)
      this.AddLogicalChild(el)
      this.InvalidateMeasure()
   
   member this.Remove (el:UIElement) =
      children.Remove(el) |> ignore
      this.RemoveVisualChild(el)
      this.RemoveLogicalChild(el)
      this.InvalidateMeasure()
      
   member this.IndexOf (el:UIElement) =
      children.IndexOf(el)
      
   override this.VisualChildrenCount =
      children.Count
   
   override this.GetVisualChild (index:int) =
      if index >= children.Count then
         raise (new ArgumentOutOfRangeException("index"))
      let child = ResizeArray.get children index
      child :> Visual
      
   override this.MeasureOverride(sizeAvailable:Size) = 
      children |> ResizeArray.iter (fun child ->
         child.Measure(new Size(Double.PositiveInfinity,Double.PositiveInfinity)))
      new Size(sumwidth children ,sumheight children) 
   
   
   // Whew!  This seems a lot more complicated then the C# version.
   // In theory, writing functionally should scale better on multicore/multi cpu
   // machines and allow the compiler to better perform parallel processing optimization.
   override this.ArrangeOverride(sizeFinal:Size) = 
      // Precalculate all starting points and sizes with sequence expressions
      let rec arrangelist (pt:Point) (elements:UIElement list) = 
         match elements with
         | child :: remainder ->
              let w = child.DesiredSize.Width * (sizeFinal.Width/(sumwidth children))
              let h =  child.DesiredSize.Height *(sizeFinal.Height/(sumheight children))
              (pt,new Size(w,h),child) :: arrangelist (new Point(pt.X+w,pt.Y+h)) remainder
         | [] -> []
      
      arrangelist (new Point(0.0,0.0)) (ResizeArray.to_list children) 
        |> Seq.iter (fun item ->
           match item with
           | (pt,size,child) -> child.Arrange(new Rect(pt,size)))
      sizeFinal
      
   override this.OnRender (dc:DrawingContext) =
      dc.DrawRectangle(this.Background, null, new Rect(new Point(0.0,0.0),this.RenderSize))
   
end   
//
// From Chapter 12 - DiagonalizeTheButtons
//
let pnl = new DiagonalPanel()
let rand = new Random()
[1..5] |> List.iter (fun i ->
   let btn = new Button(Content="Button Number " + Int32.to_string i)
   btn.FontSize <- btn.FontSize + Int32.to_float (rand.Next(20))
   pnl.Add(btn))
                            
let window = new Window(Title="Diagonalize the Buttons", Content=pnl)  

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif

RadialPanelOrientation, RadialPanel & CircleTheButtons
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  

// Again, plagarizing some functions from Haskell's Prelude
let max x y = if x <= y then y else x
// Find the max value of a sequence
let seqmax s = Seq.fold1 max s
//
// From Chapter 12 - RadialPanelOrientation enum
//
type RadialPanelOrientation =
   | ByWidth
   | ByHeight

let mutable initOrientationProperty : DependencyProperty = null

//
// From Chapter 12 - RadialPanel
//
type RadialPanel () = class
   inherit Panel() as base
    
   let mutable showPieLines = false
   
   // I'm caching all the following calculations.  Not sure what is
   // the rule of thumb in terms of what should be cached and what
   // should be calculated on the fly.  
   let mutable radius = 0.0
   let mutable din = 0.0  // innerEdgeFromCenter
   let mutable dout = 0.0 // outerEdgeFromCenter
   let mutable sizeLargest = new Size(0.0,0.0)   
   
   static member OrientationProperty =
      if initOrientationProperty = null then
         initOrientationProperty <- DependencyProperty.Register
            ("Orientation", typeof<RadialPanelOrientation>,typeof<RadialPanel>,
             new FrameworkPropertyMetadata
                (RadialPanelOrientation.ByWidth, FrameworkPropertyMetadataOptions.AffectsMeasure))
         initOrientationProperty
      else
         initOrientationProperty   

   member this.ShowPieLines 
      with get() = showPieLines
      and set (value) =
         if value <> showPieLines then this.InvalidateVisual()
         showPieLines <- value
   
   member this.Orientation 
      with get() = (this.GetValue(RadialPanel.OrientationProperty) :?> RadialPanelOrientation)
      and set (value :Brush) =
         this.SetValue(RadialPanel.OrientationProperty,value)
         
   override this.MeasureOverride(sizeAvailable:Size) = 
      let measure (children:seq<UIElement>) = 
         let maxSize = new Size(Double.PositiveInfinity,Double.PositiveInfinity)
         
         // Call measure for each child...
         children |> Seq.iter (fun (x:UIElement) -> x.Measure(maxSize))
         
         let maxwidth =  children 
                         |> Seq.map (fun (x:UIElement) -> x.DesiredSize.Width) 
                         |> seqmax
         let maxheight = children 
                         |> Seq.map (fun (child:UIElement) -> child.DesiredSize.Height) 
                         |> seqmax
                         
         // AngleEach in radians 
         let angle = Math.PI / Int32.to_float (Seq.length children)
         
         // Cache this calculation
         sizeLargest <- new Size(maxwidth,maxheight)         
         
         match this.Orientation with
           | ByWidth -> 
               din <- maxwidth / (2.0 * Math.Tan(angle))
               dout <- din + maxheight
               radius <- Math.Sqrt((maxwidth/2.0)**2.0 + dout**2.0)
               new Size(2.0*radius,2.0*radius)
           | ByHeight -> 
               din <- maxheight / (2.0 * Math.Tan(angle))
               dout <- din + maxwidth
               radius <- Math.Sqrt((maxheight/2.0)**2.0 + dout**2.0)
               new Size(2.0*radius,2.0*radius)
                
      match this.InternalChildren.Count with
      | 0 -> new Size(0.0,0.0)
      | _ -> measure (Seq.untyped_to_typed this.InternalChildren)
   
   override this.ArrangeOverride(sizeFinal:Size) = 
   
       // Generate a list of angles
       let genAngles n = seq { for i in 0 .. (n-1) do
                                  yield Int32.to_float(i)*360.0/Int32.to_float(n) }

       // Generate a list of tuples (angle,child).  There's probably a better
       // term for the variable "elements" to make it more clear.                                 
       let elements = Seq.untyped_to_typed this.InternalChildren 
                      |> Seq.zip (genAngles this.InternalChildren.Count)
                      
       let ptCenter = new Point(sizeFinal.Width / 2.0, sizeFinal.Height/2.0)
       let multiplier = Math.Min(sizeFinal.Width / (2.0*radius),
                                 sizeFinal.Height / (2.0*radius))
       
       let arrangeRect  =
          match this.Orientation with
          | ByWidth -> 
             new Rect(ptCenter.X - multiplier * sizeLargest.Width / 2.0,
                      ptCenter.Y - multiplier * dout,
                      multiplier * sizeLargest.Width,
                      multiplier * sizeLargest.Height)
          | ByHeight -> 
             new Rect(ptCenter.X + multiplier * din,
                      ptCenter.Y - multiplier * sizeLargest.Height/2.0,
                      multiplier * sizeLargest.Width,
                      multiplier * sizeLargest.Height)
                      
       // Use pattern matching to extract the angle and child from each tuple in elements
       elements |> Seq.iter (fun element ->
          match element with
          | (angle,child:UIElement) -> 
             child.RenderTransform <- Transform.Identity
             child.Arrange(arrangeRect)
             let pt = this.TranslatePoint(ptCenter,child)
             child.RenderTransform <- new RotateTransform(angle,pt.X,pt.Y) )
       sizeFinal

   override this.OnRender (dc:DrawingContext) =
      base.OnRender(dc)
      
      // Display option pie lines
      if showPieLines then
         let ptCenter = new Point(this.RenderSize.Width / 2.0,
                                  this.RenderSize.Height / 2.0)
         let multiplier = Math.Min(this.RenderSize.Width / (2.0*radius),
                                   this.RenderSize.Height / (2.0*radius))
         let pen = new Pen(SystemColors.WindowTextBrush,1.0)
         pen.DashStyle <- DashStyles.Dash
         
         // Display circle
         dc.DrawEllipse(null,pen,ptCenter, multiplier* radius, multiplier * radius)
         
         let genAngles n = seq { for i in 0 .. (n-1) do
                                 let floati = Int32.to_float(i)
                                 let floatn = Int32.to_float(n)
                                 let offset = Math.PI/floatn
                                 let angle = offset + 2.0 * Math.PI * floati/floatn
                                 yield angle }
         let angles = 
            match this.Orientation with
            // Add 90 degrees (in radians) if orientation is ByWidth
            | ByWidth -> Seq.map (fun x -> x+ Math.PI/2.0) 
                                 (genAngles this.InternalChildren.Count)
            | ByHeight -> genAngles this.InternalChildren.Count
            
         let elements = Seq.untyped_to_typed this.InternalChildren 
                       |> Seq.zip angles
         
         // Draw each line.  Again I prefer the using the forward pipe operator
         // to make it clear that we're working with elements.  
         elements |> Seq.iter (fun element ->
             match element with
             | (angle,child:UIElement) -> 
                let pt2 = new Point(ptCenter.X + multiplier * radius * Math.Cos(angle),
                                    ptCenter.Y + multiplier * radius * Math.Sin(angle)) 
                dc.DrawLine(pen, ptCenter,pt2))
end   
//
// From Chapter 12 - CircleTheButtons
//
let pnl = new RadialPanel(Orientation=ByHeight,
                          ShowPieLines=true)
let rand = new Random()
[1..10] |> List.iter (fun i ->
   let btn = new Button(Content="Button Number + " + Int32.to_string i)
   btn.FontSize <- btn.FontSize + Int32.to_float (rand.Next(10))
   pnl.Children.Add(btn) |>ignore)
                         
let window = new Window(Title="Circle the Buttons",Content=pnl)  

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(window) |> ignore
#endif