Showing posts with label haskell. Show all posts
Showing posts with label haskell. Show all posts

Monday, May 09, 2011

Porting the Log Analysis Code to Haskell

My coworker approached me the other day and ask what open source log analysis tools would I recommend. I personally do not have much experience with a general purpose open source log analysis tools so I would have probably recommended him to take a look at Splunk. Since I've recently written a customized log analysis software, I became curious and asked him what he intend to do with the log analysis software.

My coworker said that he needed to analyze Tibco EMS logs. Tibco EMS logs incoming messages in the order it receives. My coworker is interested in a set of related messages that is identified by the message ID tag. His particular issue is that the logs entries that he's interested in are interspersed with other log entries that he's not interested. He wanted a log file where the log entries are grouped by message id in historical order.

Once I understood his needs, I realize that he did not need the Splunk and that I could quickly adapt my F# log analysis software written in the previous blog post for his need. When I gave him the modified F# code, he asked me if I could port it to Linux. That threw me for a loop. I briefly entertained the idea of building a Mono system and compile F# on Mono but decided against it for now. I thought it would be easier to just port it to Haskell, which I already have on Linux.

Here's the ported Haskell log analysis software with modifications to work with Tibco log entries.


import Data.Time.Calendar
import Data.Time.LocalTime
import Data.Time.Parse
import List
import System.Environment

type Category = String
type Entry = [String]
type TimeStamp = (LocalTime,String)
type LogHeader = (TimeStamp, Category)

alphaTime = LocalTime (fromGregorian 2000 1 1) midnight 

data LogEntry = LogEntry (TimeStamp, String) [String]
                deriving (Show)

{- Grab label -}
categorize (_ : _ : label : _) = label
categorize words = ""

{- Grab timestamp -}
timestamp (date : time : _ )  = strptime "%Y-%m-%d %H:%M:%S" (date ++ " " ++ time)
timestamp words  = Nothing
           
{- header :: String -> (String, Maybe (LocalTime, String)) -}           
header line = (timestamp tokens, categorize tokens)    
    where tokens = words line

{- Concrete implementation of Tibco log parser -}    
logparser :: [String] -> LogHeader -> [String] -> [LogEntry] -> [LogEntry]
logparser (line : rest) xheader entry entries  = process (header line)    
    where process (Just (ts),label) = 
              logparser rest h [line] ((LogEntry xheader (reverse entry)):entries ) where h = (ts,label)
          process (Nothing,_) = logparser rest xheader (line : entry) entries

logparser [] xheader entry entries = reverse ((LogEntry xheader entry) : entries) 

{- Utility method  to pull items out of LogEntry -}
entry (LogEntry _ entries) = entries    
category (LogEntry (_,label) _) = label

{- comparator based on category -}
categorysort (LogEntry (_,a) _) (LogEntry (_,b) _) 
    | a > b = GT
    | a < b = LT
    | otherwise = EQ

parselog parser lines = parser lines ((alphaTime,".000"),"STARTFLAG") [] []
    
processlog = unlines
             . map (unlines . entry)
             . sortBy categorysort
             . (parselog logparser)
             . lines 

main = do (filename:_) <- getArgs
          contents <- readFile filename
          putStr (processlog contents)

Wednesday, February 13, 2008

Learning WPF with F# - Toolbars and Status Bars

I've been working through Chapter 15 of Petzold's book,Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation. FormatRichText is probably the largest and most complete example that I've written so far with F#. For that reason, I decided to logically organize the code into modules. According to the book Expert F#, a module is just a simple container for values and type definitions. While I did not physically separate the modules into different file, but there's no reason why it cannot be done.

For the most part, FormatRichText functions just like Petzold's C# version. However, example code looks significantly different than the C# version and may be more difficult to understand compared with the first WPF examples that I wrote. I can see that a C# developer probably would not have much of a problem with the first few WPF examples but may have more problems reading later examples. Does this make the code less readable? Probably to those who are just jumping into F# from C# but not, I think or hope, to those who are familiar with F#.

One final comment on the published example. I first implemented seqdrop function based on Haskell's drop function. Later, I ran a timing test against that implementation of seqdrop with the following implementation:

let seqdrop2 n list =
   Seq.to_list list 
   |> List.rev 
   |> List.to_seq 
   |> Seq.truncate n 
   |> Seq.to_list
   |> List.rev 
   |> List.to_seq

I erroneously thought this version of the drop would be slower because of all the list reversal. When I did a timing test with seqdrop and seqdrop2, seqdrop2 was a lot faster. Basically, running seqdrop on a list of 10000 integers on my machine took almost 9 seconds while it ran in 0.1 seconds with the second version. The lesson learned is always use F# standard library functions whenever possible.

Below are the example codes with the slow version of seqdrop implemented.


CraftTheToolbar

#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.Media.Imaging
//
// From Chapter 15 - CraftTheToolbar
//
// Defining drop function...couldn't find a Seq equivalent
// I see Seq.take and Seq.truncate but no Seq.drop
let rec seqdrop n (list:seq<'a>) =
if n<=0 then list
else
match (List.of_seq list) with
| _ :: [] -> seq []
| _ :: t -> seqdrop (n-1) (List.to_seq t)
| _ -> failwith "Error in seqdrop - never should get here"
// I think if F# has Haskell's type classes, I can avoid
// these awkward type conversion expressions such as (List.to_seq t)


let dock = new DockPanel(LastChildFill=false)
let window = new Window(Title="Craft the Toolbar",
Content=dock)

let toolbar = new ToolBar()
dock.Children.Add(toolbar) |>ignore
DockPanel.SetDock(toolbar,Dock.Top)

let commands =
seq [ApplicationCommands.New;
ApplicationCommands.Open;
ApplicationCommands.Save;
ApplicationCommands.Print;
ApplicationCommands.Cut;
ApplicationCommands.Copy;
ApplicationCommands.Paste;
ApplicationCommands.Delete]

let images =
seq ["new.gif"; "open.gif"; "save.gif";
"print.gif"; "cut.gif"; "copy.gif";
"paste.gif"; "delete.gif"]

// Bind the commands outside toolbar creation
let show (msg:string) (label:string) = MessageBox.Show(msg,label) |>ignore

commands |> Seq.iter (fun cmd ->
new CommandBinding(cmd,(fun _ _ ->
show (cmd.Name + " command not yet implemented") window.Title))
|> window.CommandBindings.Add |>ignore)

// Create toolbar given the command and image file
let addToolbarButtons list =
list |> Seq.iter (fun (cmd:RoutedUICommand,imgFile) ->
let img = new Image(Stretch=Stretch.None)
img.Source <- new BitmapImage(new Uri(@"file:///icons/" + imgFile))
let tip = new ToolTip(Content=cmd.Text)
let btn = new Button(Command=cmd,Content=img,ToolTip=tip)
toolbar.Items.Add(btn) |>ignore)

// Create a separator at the every nth element
let rec addToolbarButtonsWithSeparator list n=
if (Seq.length list) > n then
addToolbarButtons (Seq.take n list)
toolbar.Items.Add(new Separator()) |>ignore
addToolbarButtonsWithSeparator (seqdrop n list) n
else
addToolbarButtons list

// Create the toolbar with separators
let list = Seq.zip commands images
addToolbarButtonsWithSeparator list 4

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

MoveTheToolbar

#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
//
// From Chapter 15 - MoveTheToolbar
//

let dock = new DockPanel(LastChildFill=false)
let window = new Window(Title="Move the Toolbar",
Content=dock)

let trayTop = new ToolBarTray()
dock.Children.Add(trayTop) |> ignore
DockPanel.SetDock(trayTop,Dock.Top)

let trayLeft = new ToolBarTray(Orientation = Orientation.Vertical)
dock.Children.Add(trayLeft) |> ignore
DockPanel.SetDock(trayLeft,Dock.Left)

dock.Children.Add(new TextBox())

// Create six toolbars
[1..6] |> Seq.iter (fun i ->
let toolbar = new ToolBar(Header= "Toolbar " + Int32.to_string i)

if i<4 then trayTop.ToolBars.Add(toolbar)
else trayLeft.ToolBars.Add(toolbar)

// Add six buttons to each toolbar
[0..5] |> Seq.iter (fun j ->
toolbar.Items.Add(new Button(FontSize=16.0,
Content=(Char.chr (Char.code 'A' + j))))
|>ignore
)

)


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

FormatRichText (combined)

#light
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"
#r @"selectcolorfromgrid.dll" // Compiled from Chap13 example

open Microsoft.Win32
open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Controls.Primitives
open System.Windows.Documents
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Imaging
open System.Windows.Shapes
open System.Windows.Threading
open Chapter13;
//
// From Chapter 15 - FormatRichText (combined)
//
//----------------------------------------------------------

// Using this chapter as an opportunity to play around with F# packaging

// Defining some utilities functions...normally I should package this elsewhere
// Nullable utilities for F# - Copied from FLinq sample code
let (=?!) (x: Nullable<'a>) (y:'a) =
x.HasValue && x.Value = y

// Defining drop function...I need this for adding toobar buttons with Separator
let rec seqdrop n (list:seq<'a>) =
if n<=0 then list
else
match (List.of_seq list) with
| _ :: [] -> seq []
| _ :: t -> seqdrop (n-1) (List.to_seq t)
| _ -> failwith "Error in seqdrop - never should get here"

//----------------------------------------------------------------------------
// This module could be physically packaged in a different file if desired.
//----------------------------------------------------------------------------
module Command =

let fileFilter =
"XAML Document Files (*.xaml)|*.xaml|" +
"XAML Package Files (*.zip)|*.zip|" +

"Rich Text Format Files (*.rtf)|*.rtf|" +
"Text Files (*.txt)|*.txt|" +
"All files (*.*)|*.*"

let formats =
seq [DataFormats.Xaml; DataFormats.XamlPackage; DataFormats.Rtf;
DataFormats.Text; DataFormats.Text]

// OnNew, OnOpen, OnSave - from FormatRichText.File.cs example
let OnNew (doc:FlowDocument)(win:Window) =
let range =new TextRange(doc.ContentStart,doc.ContentEnd)
range.Text <- ""

let OnOpen (doc:FlowDocument) (win:Window) =
let range = new TextRange(doc.ContentStart,doc.ContentEnd)
let dlg = new OpenFileDialog(CheckFileExists=true,Filter=fileFilter)
if (dlg.ShowDialog(win) =?! true) then
try
use strm = new FileStream(dlg.FileName,FileMode.Open)
range.Load(strm,(Seq.nth dlg.FilterIndex formats))
with e -> MessageBox.Show(e.Message,win.Title) |>ignore

let OnSave (doc:FlowDocument) (win:Window) =
let range = new TextRange(doc.ContentStart,doc.ContentEnd)
let dlg = new OpenFileDialog(CheckFileExists=true,Filter=fileFilter)
if (dlg.ShowDialog(win) =?! true) then
try
use strm = new FileStream(dlg.FileName,FileMode.Create)
range.Save(strm, (Seq.nth dlg.FilterIndex formats))
with e -> MessageBox.Show(e.Message,win.Title) |>ignore

// CanDelete, OnOpenOnDelete - from FormatRichText.Edit.cs example
let CanDelete (args:CanExecuteRoutedEventArgs) (rtbox:RichTextBox) =
args.CanExecute <- not rtbox.Selection.IsEmpty

let OnDelete (args:ExecutedRoutedEventArgs) (rtbox:RichTextBox) =
rtbox.Selection.Text <- ""

//----------------------------------------------------------------------------
// This module could be physically packaged in a different file if desired.
//----------------------------------------------------------------------------
module ToolbarFactory =

// I'm not sure how to handle this. Seems kind of ugly to
// have this mutable variable out here. The alternatives that I
// can think of aren't any better.
let mutable originalFontSize:String = "12"

let addButtons (toolbar:ToolBar) list =
list |> Seq.iter (fun (cmd:RoutedUICommand,imgFile) ->
let bitmap = new BitmapImage(new Uri(@"file:///icons/" + imgFile))
let img = new Image(Source=bitmap,Stretch=Stretch.None)
let tip = new ToolTip(Content=cmd.Text)
let btn = new Button(Command=cmd,Content=img,ToolTip=tip)
ignore(toolbar.Items.Add(btn)))


// Create a separator at the every nth element
let rec addButtonsWithSeparator (toolbar:ToolBar) n list =
if (Seq.length list) > n then
addButtons toolbar (Seq.take n list)
toolbar.Items.Add(new Separator()) |>ignore
addButtonsWithSeparator toolbar n (seqdrop n list)
else
addButtons toolbar list

// Create command bindings

// from FormatRichText.File.cs example
let createFileToolbar (doc:FlowDocument) (win:Window) =
let commands = seq [ ApplicationCommands.New; ApplicationCommands.Open; ApplicationCommands.Save]
let handlers = seq [new ExecutedRoutedEventHandler(fun _ _ -> Command.OnNew doc win);
new ExecutedRoutedEventHandler(fun _ _ -> Command.OnOpen doc win);
new ExecutedRoutedEventHandler(fun _ _ -> Command.OnSave doc win); ]

let images = seq ["new.gif"; "open.gif"; "save.gif" ]
let toolbar = new ToolBar()

Seq.zip commands images |> addButtons toolbar

// Add the command bindings
let addBind cmd = ignore(win.CommandBindings.Add cmd)
Seq.zip commands handlers |> Seq.iter (fun (cmd,handler) ->
new CommandBinding(cmd,handler) |> addBind)

toolbar

// from FormatRichText.Edit.cs example - create edit toolbar
let createEditToolbar (text:RichTextBox) (win:Window) =
let commands = seq [ ApplicationCommands.Cut;
ApplicationCommands.Copy;
ApplicationCommands.Paste;
ApplicationCommands.Delete;
ApplicationCommands.Undo;
ApplicationCommands.Redo]

// Use option type to handle the exceptions
let handlers = seq [None;None;None;
Some(((new ExecutedRoutedEventHandler(fun _ args ->
Command.OnDelete args text)),
(new CanExecuteRoutedEventHandler(fun _ args ->
Command.CanDelete args text))));
None; None]

let images = seq ["cut.gif"; "copy.gif"; "paste.gif";
"delete.gif"; "undo.gif"; "redo.gif"; ]

let toolbar = new ToolBar()
Seq.zip commands images |> addButtonsWithSeparator toolbar 4

// Add the command bindings
let addBind cmd = ignore(win.CommandBindings.Add cmd)

// exe - ExecutionRoutedEventHandler
// can - CanExecuteRoutedEventHandler
Seq.zip commands handlers |> Seq.iter (fun (cmd,optHandler) ->
match optHandler with
| Some((exe,can)) -> new CommandBinding(cmd,exe,can) |> addBind
| None -> new CommandBinding(cmd) |> addBind)

toolbar

// from FormatRichText.Char.cs example
let createCharToolbar (text:RichTextBox) =

// Some utility function so we can apply DRY principles

// Utility code use to build toggle buttons for FontWeight & FontStyle
let buildToggleButton tip image (property:DependencyProperty) checkedprop uncheckedprop =
let tip = new ToolTip(Content="tip")
let bitmap = new BitmapImage(new Uri(@"file:///icons/" + image))
let img = new Image(Source=bitmap,Stretch=Stretch.None)
let button = new ToggleButton(Content=img,ToolTip=tip)

button.Checked.Add(fun args ->
(property,checkedprop)
|> text.Selection.ApplyPropertyValue)

button.Unchecked.Add(fun args ->
(property,uncheckedprop)
|> text.Selection.ApplyPropertyValue)

button

// Utility code use to build menu items for Foreground/Background color
let buildColorMenuItems tip image (property:DependencyProperty) =
let tip = new ToolTip(Content="tip")
let bitmap = new BitmapImage(new Uri(@"file:///icons/" + image))
let img = new Image(Source=bitmap,Stretch=Stretch.None)
let item = new MenuItem(Header=img,ToolTip=tip)
let colorgrid = new ColorGridBox()
colorgrid.SelectionChanged.Add(fun _ ->
(property,colorgrid.SelectedValue)
|> text.Selection.ApplyPropertyValue)

item.Items.Add(colorgrid) |> ignore
item

let toolbar = new ToolBar()

// Create ComboBox for font families
toolbar.Items.Add
(let tip = new ToolTip(Content="Font Family")
let combo = new ComboBox(Width = 144.0,
ItemsSource = Fonts.SystemFontFamilies,
ToolTip = tip,
SelectedItem = text.FontFamily)
// Implement FamilyComboOnSelection - notice that
// control properties and behavior are a define and not
// separated in the code as in Petzold's example.
combo.SelectionChanged.Add(fun args ->
let family = combo.SelectedItem :?> FontFamily
if (family <> null) then
(FlowDocument.FontFamilyProperty,family)
|> text.Selection.ApplyPropertyValue
text.Focus() |>ignore)
combo) |>ignore

// Create ComboBox for font size
toolbar.Items.Add
(let fontsizes = seq [8.0; 9.0; 10.0; 11.0; 12.0; 14.0; 16.0; 18.0;
20.0; 22.0; 24.0; 26.0; 28.0; 36.0; 48.0; 72.0]

let tip = new ToolTip(Content="Font Size")
let combo = new ComboBox(Width = 48.0,
ItemsSource = fontsizes,
ToolTip = tip,
IsEditable = true,
IsReadOnly=false,
Text = (text.FontSize).ToString())

// Implement SizeComboOnSelection
combo.SelectionChanged.Add( fun args ->
if (combo.SelectedIndex <> -1) then
let size = (combo.SelectedValue :?> double)
text.Selection.ApplyPropertyValue(FlowDocument.FontSizeProperty, size)
originalFontSize <- Float.to_string size
text.Focus() |>ignore)

// Implement SizeComboOnGotFocus
combo.GotKeyboardFocus.Add(fun _ ->
originalFontSize <- combo.Text)

// Implement SizeComboOnLostFocus
combo.LostKeyboardFocus.Add(fun _ ->
let (valid,size) = Double.TryParse(combo.Text)
// Needed to add the addition filter (combo.SelectedIndex = -1)
// or font size drop down doesn't work properly.
if valid && (combo.SelectedIndex = -1) then
text.Selection.ApplyPropertyValue (FlowDocument.FontSizeProperty,size)
else
combo.Text <- originalFontSize
)
// Implement SizeComboOnKeyDown
combo.PreviewKeyDown.Add(fun args ->
match args.Key with
| Key.Escape ->
combo.Text <- originalFontSize
args.Handled <- true
text.Focus() |> ignore
| Key.Enter ->
args.Handled <- true
text.Focus() |> ignore
| _ -> ())

combo) |>ignore


// Create Bold Button
toolbar.Items.Add
(let prop = FlowDocument.FontWeightProperty
let bold = FontWeights.Bold
let normal =FontWeights.Normal
let button = buildToggleButton "Bold" "bold.png" prop bold normal
// Petzold's original implementation with text.SelectionChanged
// didn't do anything, I changed to using TextChanged event,
// which occurs when any content or format changes
text.TextChanged.Add(fun _ ->
let font = text.Selection.GetPropertyValue(FlowDocument.FontWeightProperty)
:?> FontWeight
button.IsChecked <-
if font = FontWeights.Bold then
new Nullable<bool>(true)
else new Nullable<bool>(false)
)
button) |>ignore

// Create Italic Button
toolbar.Items.Add
(let prop = FlowDocument.FontStyleProperty
let italic = FontStyles.Italic
let normal = FontStyles.Normal
let button = buildToggleButton "Italic" "italic.png" prop italic normal
text.TextChanged.Add(fun _ ->
let style = text.Selection.GetPropertyValue(FlowDocument.FontStyleProperty)
:?> FontStyle
button.IsChecked <-
if style = FontStyles.Italic then
new Nullable<bool>(true)
else new Nullable<bool>(false)
)

button
) |>ignore

// Create Background and Foreground Color Menus
toolbar.Items.Add
(let menu = new Menu()
// Add background color menu
let item = (buildColorMenuItems "Background Color" "bgcolor.png" FlowDocument.BackgroundProperty)
ignore(menu.Items.Add(item))
// Add foreground color menu
let item = (buildColorMenuItems "Foreground Color" "fgcolor.png" FlowDocument.ForegroundProperty)
ignore(menu.Items.Add(item))
menu) |> ignore

// Petzold also implemented a bunch of other RichTextBox Selection Changed events
// I elected to skip those as I could not see how you can change those other properties
// without going through the toolbar controls. If you had separate menu controls, then
// it would make sense to implement them. In any case, the implementation for
// FontStyle and FontWeight are illustrative examples of how to implement TextChanged
// events.
toolbar


// from FormatRichText.Para.cs example
let createParagraphToolbar (text:RichTextBox) =

let createbutton (align:TextAlignment) (btntip:string) (offsetLeft:float) (offsetRight:float) =
let canv = new Canvas(Width=16.0,Height=16.0)

[0..4] |> Seq.iter( fun i ->
let poly = new Polyline(Stroke=SystemColors.WindowTextBrush,
StrokeThickness = 1.0)
match i with
| 1 | 3 ->
poly.Points <-
new PointCollection([|new Point (2.0+ offsetLeft,
2.0+3.0*Int32.to_float i);
new Point (14.0+ offsetRight,
2.0+3.0*Int32.to_float i)|])
| _ ->
poly.Points <-
new PointCollection([|new Point (2.0,2.0+3.0*Int32.to_float i);
new Point (14.0,2.0+3.0*Int32.to_float i)|])
canv.Children.Add(poly)|>ignore)
let tip = new ToolTip(Content=btntip)
let btn = new ToggleButton(Tag=align,Content=canv,ToolTip=tip)

// Checked the button when clicked on
btn.Click.Add(fun args ->
btn.IsChecked <- new Nullable<bool>(true)
text.Selection.ApplyPropertyValue(Paragraph.TextAlignmentProperty,align))

// Uncheck all the other text alignment buttons
text.TextChanged.Add( fun _ ->
let checkAlignment = text.Selection.GetPropertyValue(Paragraph.TextAlignmentProperty)
:?> TextAlignment
if align <> checkAlignment then
btn.IsChecked <- new Nullable<bool>(false))

btn

let toolbar = new ToolBar()
toolbar.Items.Add(createbutton TextAlignment.Left "Align Left" 0.0 4.0) |>ignore
toolbar.Items.Add(createbutton TextAlignment.Center "" 2.0 2.0) |>ignore
toolbar.Items.Add(createbutton TextAlignment.Right "Align Right" 4.0 0.0) |>ignore
toolbar.Items.Add(createbutton TextAlignment.Justify "Justify" 0.0 0.0) |>ignore
toolbar

// Not really a toolbar - but packaging it under ToolbarFactory
// From FormatRichText.Status.cs example
let createStatusbar () =
let status = new StatusBar()
let itemDateTime = new StatusBarItem(HorizontalAlignment = HorizontalAlignment.Right)
status.Items.Add(itemDateTime) |> ignore

let tmr = new DispatcherTimer(Interval = TimeSpan.FromSeconds(1.0))
tmr.Tick.Add( fun e ->
let dt = DateTime.Now
itemDateTime.Content <- dt.ToLongDateString() + " " + dt.ToLongTimeString())

tmr.Start()

status


//----------------------------------------------------------------------------
// Main section where we compose our WPF components
//----------------------------------------------------------------------------

let dock = new DockPanel(LastChildFill=false)
let window = new Window(Title="Format Rich Text",
Content=dock)

let tray = new ToolBarTray()
dock.Children.Add(tray) |> ignore
DockPanel.SetDock(tray,Dock.Top)

let txtbox = new RichTextBox (VerticalScrollBarVisibility = ScrollBarVisibility.Auto)
dock.Children.Add(txtbox)

// Create all the toolbars and add to ToolBarTray

// Add file toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createFileToolbar txtbox.Document window
toolbar.Band <- 0
toolbar.BandIndex <- 0
toolbar)

// Add edit toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createEditToolbar txtbox window
toolbar.Band <- 1
toolbar.BandIndex <- 0
toolbar)

// Add char toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createCharToolbar txtbox
toolbar.Band <- 2
toolbar.BandIndex <- 1
toolbar)

// Add paragraph toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createParagraphToolbar txtbox
toolbar.Band <- 2
toolbar.BandIndex <- 0
toolbar)

// Add Status Bar
let status = ToolbarFactory.createStatusbar()
dock.Children.Add(status)
DockPanel.SetDock(status,Dock.Bottom)



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

Friday, November 23, 2007

Learning WPF with F# - The Dock and the Grid

Working through Chapter 6 of Petzold's "Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation" book.

There are some new concepts that I ran into while working through the examples on Chapter 6. The first is how to deal with C# out parameters in the code DateTime.TryParse. So I fired up the interactive F# system and did a type dump on DateTime.TryParse. The results from F# interactive is val it : string -> bool * DateTime. Now it becomes clear how F# deals with out parameters. C# is limited to a single return value while F# is not constrained by that. For any methods that has has more then one return values, they're packaged as tuples. So I can grab the return value from DateTime.TryParse as follows:

let (flag,date) = DateTime.TryParse("1/1/2007")

The second concept that I'm struggling with and trying to work through is how to write expressively elegant code that I see in Haskell's Prelude code such as zip and zipWidth. I guess I still have not full grok the combinator capability of functional programming to develop expressively elegant codes. I suspect this is just from the lack of experience in working with functional languages and hopefully, by working with functional languages more, I'll be able to develop more expressive and elegant code. I wish there was a book similar to Programming Pearls combined with Functional Programming Cookbook that would illustrate the expressive power of functional programming. In any case, I'm not able to find an equivalent zip and zipWith function in F#, so I decided to recreate Haskell's version in F#. My initial version was much more verbose then the Haskell version. But I went and took a look at the code samples from Don Syme's new book, "Expert F#" and found a way to rewrite it so that it's similarly compact compared with the Haskell version. Nothing like learning from the original creator of F#.

Here's the original version of zip and zipWidth from the Prelude library in Haskell:

zip              :: [a] -> [b] -> [(a,b)]
zip               = zipWith  (\a b -> (a,b))

zipWith                  :: (a->b->c) -> [a]->[b]->[c]
zipWith z (a:as) (b:bs)   = z a b : zipWith z as bs
zipWith _ _      _        = []


DockAroundTheBlock

#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

(* Could not cast to dock, create explicit mapping for Dock property *)
let getdock i =
match i with
| 0 -> Dock.Left
| 1 -> Dock.Top
| 2 -> Dock.Right
| 3 -> Dock.Bottom
| _ -> failwith "Not an option"

(* From Chap 5 - DockAroundTheBlock.cs *)
type DockAroundTheBlock = class
inherit Window as base

new () as this = {} then
this.Title <- "Dock Around the Block"
let dock = new DockPanel()
this.Content <- dock

let addButton i =
let btn = new Button()
btn.Content <- "Button No. " + Int32.to_string(i+1)
dock.Children.Add(btn) |>ignore
btn.SetValue(DockPanel.DockProperty, getdock (i%4)) |> ignore

List.iter addButton [0..16]
end

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

MeetTheDockers

#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.Controls.Primitives
open System.Windows.Input
open System.Windows.Media

(* From Chap 5 - MeetTheDockers.cs *)
type MeetTheDockers = class
inherit Window as base

new () as this = {} then
this.Title <- "Meet the Dockers"
let dock = new DockPanel()
this.Content <- dock

let menu = new Menu()
let item = new MenuItem()
item.Header <- "Menu"
menu.Items.Add(item) |> ignore

// Dock menu at top of panel
DockPanel.SetDock(menu,Dock.Top) |>ignore
dock.Children.Add(menu) |>ignore

// Create tool bar
let tool = new ToolBar()
tool.Header <- "Toolbar"
DockPanel.SetDock(tool,Dock.Top) |>ignore
dock.Children.Add(tool) |>ignore

// Create Status bar
let status = new StatusBar()
let statitem = new StatusBarItem()
statitem.Content <- "Status"
status.Items.Add(statitem) |> ignore

// Dock status bar at bottom of panel
DockPanel.SetDock(status,Dock.Bottom) |>ignore
dock.Children.Add(status) |>ignore

// Create list box
let lstbox = new ListBox()
lstbox.Items.Add("List Box Item") |> ignore
DockPanel.SetDock(lstbox,Dock.Left) |>ignore
dock.Children.Add(lstbox) |>ignore

// Create text box
let txtbox = new TextBox()
txtbox.AcceptsReturn <- true
dock.Children.Add(txtbox) |>ignore
txtbox.Focus() |>ignore
end

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

CalculateYourLife

#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.Controls.Primitives
open System.Windows.Input
open System.Windows.Media

// Utility functions
let checkPluralize i =
match i with
| 0 -> ""
| 1 -> ""
| _ -> "s"

let dayoffset deltaDays (dtEnd:DateTime) =
if (deltaDays < 0) then
(deltaDays + DateTime.DaysInMonth(dtEnd.Year, 1 + (dtEnd.Month+10)%10),-1)
else
(deltaDays,0)

let monthoffset deltaMonth =
if (deltaMonth <0) then
(deltaMonth + 12,1)
else
(deltaMonth,0)

let dateoffset (dtBegin:DateTime) (dtEnd:DateTime) =
let (day,deltaMonth) = dayoffset (dtEnd.Day - dtBegin.Day) dtEnd
let (deltaMonth,deltaYear) = monthoffset (dtEnd.Month - dtBegin.Month + deltaMonth)
let year = dtEnd.Year - dtBegin.Year + deltaYear
let month = dtEnd.Month - dtEnd.Year + deltaMonth
(day,month,year)


(* From Chap 5 - CalculateYourLife.cs *)
type CalculateYourLife = class
inherit Window as base

val mutable txtboxBegin : TextBox
val mutable txtboxEnd : TextBox
val mutable lablLifeYears : Label

new () as this = {
txtboxBegin = null
txtboxEnd = null
lablLifeYears = null} then

this.Title <- "Calculate Your Life"
this.SizeToContent <- SizeToContent.WidthAndHeight
this.ResizeMode <- ResizeMode.CanMinimize

let grid = new Grid()
this.Content <- grid

let addRowDef i =
let rowdef = new RowDefinition()
rowdef.Height <- GridLength.Auto
grid.RowDefinitions.Add(rowdef) |> ignore

List.iter addRowDef [0..2]

let addColDef i =
let coldef = new ColumnDefinition()
coldef.Width <- GridLength.Auto
grid.ColumnDefinitions.Add(coldef) |> ignore

List.iter addColDef [0..2]

// First Label
let lbl = new Label()
lbl.Content <- "Begin Date: "
grid.Children.Add(lbl) |> ignore
Grid.SetRow(lbl,0)
Grid.SetColumn(lbl,0)

// First TextBox
this.txtboxBegin <- new TextBox()
let begindate = new DateTime(1980,1,1)
this.txtboxBegin.Text <- begindate.ToShortDateString()

// Programming with out parameters!
this.txtboxBegin.TextChanged.Add(fun _ -> this.TextBoxOnTextChanged)
grid.Children.Add(this.txtboxBegin) |> ignore
Grid.SetRow(this.txtboxBegin, 0)
Grid.SetColumn(this.txtboxBegin, 1)

// Second Label
let lbl = new Label()
lbl.Content <- "End Date: "
grid.Children.Add(lbl) |> ignore
Grid.SetRow(lbl, 1)
Grid.SetColumn(lbl, 0)


// Second TextBox
this.txtboxEnd <- new TextBox()

// Programming with out parameters!
this.txtboxEnd.TextChanged.Add(fun _ -> this.TextBoxOnTextChanged)
grid.Children.Add(this.txtboxEnd) |> ignore
Grid.SetRow(this.txtboxEnd, 1)
Grid.SetColumn(this.txtboxEnd, 1)


// Third Label
let lbl = new Label()
lbl.Content <- "Life Years: "
grid.Children.Add(lbl) |> ignore
Grid.SetRow(lbl, 2)
Grid.SetColumn(lbl, 0)

// Label for calculated result
this.lablLifeYears <- new Label()
grid.Children.Add( this.lablLifeYears) |> ignore
Grid.SetRow( this.lablLifeYears, 2)
Grid.SetColumn( this.lablLifeYears, 1)

// Set margin for everybody
let thick = new Thickness(5.0)
grid.Margin <- thick

IEnumerable.untyped_to_typed grid.Children
|> IEnumerable.iter (fun (ctrl:Control) -> ctrl.Margin <- thick)

this.txtboxBegin.Focus() |>ignore

member this.TextBoxOnTextChanged =
// Use tuples to deal with C# out parameters...
let (begflag,dtBeg) = DateTime.TryParse(this.txtboxBegin.Text)
let (endflag,dtEnd) = DateTime.TryParse(this.txtboxEnd.Text)

match (begflag && endflag) with
| true ->
let (day,month,year) = dateoffset dtBeg dtEnd
// Replaced String.Format with Printf.sprintf...
let text = Printf.sprintf "%i year%s, %i month%s, %i day%s"
year (checkPluralize year)
month (checkPluralize month)
day (checkPluralize day)
this.lablLifeYears.Content <- text
| false -> this.lablLifeYears.Content <- ""

end

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

EnterTheGrid

#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

// Copied the zip & zipWith function from Haskell Prelude
// In the initial version, I forgot about pattern matching
// head/tail with head::tail. Revisiting the example codes
// from Don Syme's upcoming book refreshed my memory.
let rec zipWith func a b =
match (a,b) with
| (ha::ta),(hb::tb) -> [func ha hb] @ (zipWith func ta tb)
| _ -> []

// Curried function to create pairs of lists
let zip = zipWith (fun x y -> (x,y))

(* From Chap 5 - EnterTheGrid.cs *)
type EnterTheGrid = class
inherit Window as base

new () as this = {} then
this.Title <- "Enter the Grid"
this.MinWidth <- 300.0
this.SizeToContent <- SizeToContent.WidthAndHeight

// Create StackPanel for window content
let stack = new StackPanel()
this.Content <- stack

// Create Grid and add to StackPanel
let grid1 = new Grid()
grid1.Margin <- new Thickness(5.0)
stack.Children.Add(grid1)|>ignore

let addRow i =
let rowdef = new RowDefinition()
rowdef.Height <- GridLength.Auto
grid1.RowDefinitions.Add(rowdef)

List.iter addRow [0..4]

let coldef = new ColumnDefinition()
coldef.Width <- GridLength.Auto
grid1.ColumnDefinitions.Add(coldef)

let coldef = new ColumnDefinition()
coldef.Width <- new GridLength(100.0,GridUnitType.Star)
grid1.ColumnDefinitions.Add(coldef)

let strLabels = ["_First name:"
"_Last name:"
"_Social security number:"
"_Credit card number:"
"_Other personal stuff:"]

let addLabel (i,label) =
let lbl = new Label()
lbl.Content <- label
lbl.VerticalContentAlignment <- VerticalAlignment.Center
grid1.Children.Add(lbl) |>ignore
Grid.SetRow(lbl,i)
Grid.SetColumn(lbl,0)

let txtbox = new TextBox()
txtbox.Margin <- new Thickness(5.0)
grid1.Children.Add(txtbox)|>ignore
Grid.SetRow(txtbox,i)
Grid.SetColumn(txtbox,1)

// Using zip to create the pair argument needed for addLabel
List.iter addLabel (zip [0..(strLabels.Length-1)] strLabels)

// Create second grid and add to StackPanel
let grid2 = new Grid()
grid2.Margin <- new Thickness(10.0)
stack.Children.Add(grid2) |> ignore

// No row definitions needed for single row
// Default column definitions are "star"
grid2.ColumnDefinitions.Add(new ColumnDefinition())
grid2.ColumnDefinitions.Add(new ColumnDefinition())

// Create buttons
let addButton label =
let btn = new Button()
btn.Content <- label
btn.HorizontalAlignment <- HorizontalAlignment.Center
btn.IsDefault <- true;
btn.Click.Add(fun _ -> this.Close())
grid2.Children.Add(btn) |> ignore
btn

ignore(addButton "Submit")
let btn = addButton "Cancel"
Grid.SetColumn(btn,1)

// Set focus to first text box
let p = stack.Children.Item(0) :?> Panel in
p.Children.Item(1).Focus() |> ignore
end

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

SpanTheCells

#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 rec zipWith func a b =
match (a,b) with
| (ha::ta),(hb::tb) -> [func ha hb] @ (zipWith func ta tb)
| _ -> []

// Curried function to create pairs of lists
let zip = zipWith (fun x y -> (x,y))


(* From Chap 5 - SpanTheCells.cs *)
type SpanTheCells = class
inherit Window as base

new () as this = {} then
this.Title <- "Span the Cells"
this.MinWidth <- 300.0
this.SizeToContent <- SizeToContent.WidthAndHeight

let grid = new Grid()
grid.Margin <- new Thickness(5.0)
this.Content <- grid

for i = 0 to 6 do
let rowdef = new RowDefinition()
rowdef.Height <- GridLength.Auto
grid.RowDefinitions.Add(rowdef)

let addColumn i =
let coldef = new ColumnDefinition()
if (i=1) then
coldef.Width <- new GridLength(100.0,GridUnitType.Star)
else
coldef.Width <- GridLength.Auto
grid.ColumnDefinitions.Add(coldef)


List.iter addColumn [0..3]

let astrLabel = ["_First name:"
"_Last name:"
"_Social security number:"
"_Credit card number:"
"_Other personal stuff:"]

let addRow (i,label) =
let lbl = new Label()
lbl.Content <- label
lbl.VerticalContentAlignment <- VerticalAlignment.Center
grid.Children.Add(lbl) |>ignore
Grid.SetRow(lbl, i)
Grid.SetColumn(lbl,0)

let txtbox = new TextBox()
txtbox.Margin <- new Thickness(5.0)
grid.Children.Add(txtbox) |> ignore
Grid.SetRow(txtbox,i)
Grid.SetColumn(txtbox,1)
Grid.SetColumnSpan(txtbox,3)

List.iter addRow (zip [0..(astrLabel.Length -1)] astrLabel)

let btn = new Button()
btn.Content <- "Submit"
btn.Margin <- new Thickness(5.0)
btn.IsDefault <- true
btn.Click.Add(fun _ -> this.Close()) |>ignore
grid.Children.Add(btn) |> ignore
Grid.SetRow(btn,5)
Grid.SetColumn(btn,2)

let btn = new Button()
btn.Content <- "Cancel"
btn.Margin <- new Thickness(5.0)
btn.IsCancel <- true
btn.Click.Add(fun _ -> this.Close()) |>ignore
grid.Children.Add(btn) |> ignore
Grid.SetRow(btn,5)
Grid.SetColumn(btn,3)

grid.Children.[1].Focus() |> ignore

end

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

SplitNine

#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

(* From Chap 5 - SplitNine.cs *)
type SplitNine = class
inherit Window as base

new () as this = {} then
this.Title <- "Split Nine"

let grid = new Grid()
this.Content <- grid

for i = 0 to 3 do
grid.ColumnDefinitions.Add(new ColumnDefinition())
grid.RowDefinitions.Add(new RowDefinition())

let createButton (x,y) =
let btn = new Button()
btn.Content <- "Row " + Int32.to_string(y) + " and Column " + Int32.to_string(x)
btn.Margin <- new Thickness(20.0)
grid.Children.Add(btn)|> ignore
Grid.SetRow(btn,y)
Grid.SetColumn(btn,x)

let createSplitter =
let split = new GridSplitter()
split.Width <- 6.0
grid.Children.Add(split) |>ignore
Grid.SetRow(split,1)
Grid.SetColumn(split,1)
Grid.SetRowSpan(split,3)

for x = 0 to 2 do
for y = 0 to 2 do
createButton (x,y)
createSplitter


end

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

SplitTheClient

#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 addgridcol (grid:Grid) =
grid.ColumnDefinitions.Add(new ColumnDefinition())
grid.RowDefinitions.Add(new RowDefinition())


(* From Chap 5 - SplitTheClient.cs *)
type SplitTheClient = class
inherit Window as base

new () as this = {} then
this.Title <- "Split the Client"


// Grid with vertical splitter
let grid1 = new Grid()
addgridcol grid1
addgridcol grid1
addgridcol grid1

grid1.ColumnDefinitions.[1].Width <- GridLength.Auto
this.Content <- grid1

// Button at the left of the vertical splitter
let btn = new Button()
btn.Content <- "Button No. 1"
grid1.Children.Add(btn) |> ignore
Grid.SetRow(btn,0)
Grid.SetColumn(btn,0)

//Vertical Splitter
let split = new GridSplitter()
split.ShowsPreview <- true
split.HorizontalAlignment <- HorizontalAlignment.Center
split.VerticalAlignment <- VerticalAlignment.Stretch
split.Width <- 6.0
grid1.Children.Add(split)|>ignore
Grid.SetRow(split,0)
Grid.SetColumn(split,0)

let grid2 = new Grid()
addgridcol grid2
addgridcol grid2
addgridcol grid2
grid2.RowDefinitions.[1].Height <- GridLength.Auto
grid1.Children.Add(grid2) |>ignore
Grid.SetRow(grid2, 0);
Grid.SetColumn(grid2, 2)

let btn = new Button();
btn.Content <- "Button No. 2";
grid2.Children.Add(btn) |>ignore
Grid.SetRow(btn, 0)
Grid.SetColumn(btn, 0)

// Horizontal splitter.
let split = new GridSplitter()
split.ShowsPreview <- true;
split.HorizontalAlignment <- HorizontalAlignment.Stretch;
split.VerticalAlignment <- VerticalAlignment.Center;
split.Height <- 6.0;
grid2.Children.Add(split) |> ignore
Grid.SetRow(split, 1)
Grid.SetColumn(split, 0)

// Bottom at bottom of horizontal splitter.
let btn = new Button();
btn.Content <- "Button No. 3";
grid2.Children.Add(btn) |> ignore
Grid.SetRow(btn, 2);
Grid.SetColumn(btn, 0);
end

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

ScrollCustomColors

#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.Controls.Primitives
open System.Windows.Media


(* From Chap 6 - ScrollCustomColors.cs *)
type ColorScroll = class
inherit Window as base

val mutable pnlColor : Panel
val mutable scrolls : ScrollBar array

new () as this = {
pnlColor = (new StackPanel() :> Panel)
scrolls = Array.create 3 (new ScrollBar()) } then
this.Title <- "Color Scroll"
this.Width <- 500.0
this.Height <- 300.0

// GridMain contains a vertical splitter
let gridMain = new Grid()
this.Content <- gridMain

// GridMain column definitions
let coldef = new ColumnDefinition()
coldef.Width <- new GridLength(200.0,GridUnitType.Pixel)
gridMain.ColumnDefinitions.Add(coldef)

let coldef = new ColumnDefinition()
coldef.Width <- GridLength.Auto
gridMain.ColumnDefinitions.Add(coldef)

let coldef = new ColumnDefinition()
coldef.Width <- new GridLength(100.0,GridUnitType.Star)
gridMain.ColumnDefinitions.Add(coldef)

// Vertical splitter
let split = new GridSplitter()
split.HorizontalAlignment <- HorizontalAlignment.Center

split.VerticalAlignment <- VerticalAlignment.Stretch
split.Width <- 6.0
gridMain.Children.Add(split)|>ignore
Grid.SetRow(split,0)
Grid.SetColumn(split,1)

// Panel on right side of splitter to display color
this.pnlColor.Background <- new SolidColorBrush(SystemColors.WindowColor)
gridMain.Children.Add(this.pnlColor)|>ignore
Grid.SetRow(this.pnlColor,0)
Grid.SetColumn(this.pnlColor,2)

// Secondary grid at left of splitter
let grid = new Grid()
gridMain.Children.Add(grid)|>ignore
Grid.SetRow(grid,0)
Grid.SetColumn(grid,0)

// Three rows for label, scroll, and label
let rowdef = new RowDefinition()
rowdef.Height <- GridLength.Auto
grid.RowDefinitions.Add(rowdef)

let rowdef = new RowDefinition()
rowdef.Height <- new GridLength(100.0, GridUnitType.Star)
grid.RowDefinitions.Add(rowdef)

let rowdef = new RowDefinition()
rowdef.Height <- GridLength.Auto
grid.RowDefinitions.Add(rowdef)

// Three columns for Red, Green, and Blue.
for i in [0..2] do
let coldef = new ColumnDefinition()
coldef.Width <- new GridLength(33.0, GridUnitType.Star)
grid.ColumnDefinitions.Add(coldef)

let clr = (this.pnlColor.Background :?> SolidColorBrush).Color
let clrText = [|"Red";"Green";"Blue"|]
for i in [0..2] do
let lbl = new Label();
lbl.Content <- clrText.[i]
lbl.HorizontalAlignment <- HorizontalAlignment.Center;
grid.Children.Add(lbl) |>ignore
Grid.SetRow(lbl, 0)
Grid.SetColumn(lbl, i)

this.scrolls.[i] <- new ScrollBar()
this.scrolls.[i].Focusable <- true
this.scrolls.[i].Orientation <- Orientation.Vertical
this.scrolls.[i].Minimum <- 0.0
this.scrolls.[i].Maximum <- 255.0
this.scrolls.[i].SmallChange <- 1.0
this.scrolls.[i].LargeChange <- 16.0

// Implemented ScrollOnValueChanged as lambda expression
this.scrolls.[i].ValueChanged.Add
(fun args ->
let scroll = this.scrolls.[i]
let pnl = scroll.Parent :?> Panel
let txt = pnl.Children.[1 + pnl.Children.IndexOf(scroll)] :?> TextBlock
txt.Text <- String.Format("{0}\n0x{0:X2}", Int32.of_float(scroll.Value))
this.pnlColor.Background <-
new SolidColorBrush
(Color.FromRgb
(Byte.of_int32(Float.to_int32(this.scrolls.[0].Value)),
Byte.of_int32(Float.to_int32(this.scrolls.[1].Value)),
Byte.of_int32(Float.to_int32(this.scrolls.[2].Value)))))

grid.Children.Add(this.scrolls.[i]) |>ignore
Grid.SetRow(this.scrolls.[i], 1)
Grid.SetColumn(this.scrolls.[i], i)

let txtValue = new TextBlock() in
txtValue.TextAlignment <- TextAlignment.Center
txtValue.HorizontalAlignment <- HorizontalAlignment.Center
txtValue.Margin <- new Thickness(5.0);
grid.Children.Add(txtValue) |> ignore
Grid.SetRow(txtValue, 2)
Grid.SetColumn(txtValue, i)

this.scrolls.[0].Value <- Float.of_int32(Byte.to_int32(clr.R))
this.scrolls.[1].Value <- Float.of_int32(Byte.to_int32(clr.G))
this.scrolls.[2].Value <- Float.of_int32(Byte.to_int32(clr.B))

this.scrolls.[0].Focus() |> ignore

end

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