Sunday, April 20, 2008

Learning WPF with F# - Notepad Clone

I have a natural tendency to fall back on old habits when not paying attention. My first pass at Petzold's NotepadClone looks very much like a direct translation of C# to F#. Since the goal of these exercises is not just to get a working implementation but to expand my thinking more, I had to work extra hard to get out of my normal mode of thinking. I would deliberately tried to apply F# features to the example code. One example is the use of discriminated unions to assist in building the menu system. With the discriminated union, I can isolate the menu creation to one core builder function and configured the menu as a block. I have logically consolidated and partitioned menu creation logic in one file and command binding and action definition in another file as oppose to Petzold's way of chunking it by first level menu functionality. I have also tried to rewrite PlainTextDocumentPaginator in a more functional way. Format and ProcessLine has been rewritten in a recursive manner with ProcessLine written without any side effects.

One thing that I did notice while working in Visual Studio 2005 is that the order of the files make a difference in whether my project compiles successfully or not. I had to add the files in the order of when it is referenced. I assume once F# is productionized and integrated with the next release of Visual Studio (2010?), this issue will go away. But for now, if you have variables defined in module A physically located in file A.fs that is needed by module B in file B.fs, A.fs must be added to the project before B.fs in order for the compile to be successful.

Here's my implementation of Notepad Clone from Chapter 18 of Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation


NotepadCloneAssembly

#light

open System.Reflection

[<assembly: AssemblyTitle("Notepad Clone")>]
[<assembly: AssemblyProduct("NotepadClone")>]
[<assembly: AssemblyDescription("Functionally Similar to Windows Notepad")>]
[<assembly: AssemblyCompany("jyliao.blogspot.com")>]

[<assembly: AssemblyCopyright("\u00A9 2008 by XYZ")>]
[<assembly: AssemblyVersion("1.0.*")>]
[<assembly: AssemblyFileVersion("1.0.0.0")>]
do()

NotepadLib

#light
module NotepadCloneLib

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

open Microsoft.Win32
open System
open System.Diagnostics
open System.Globalization
open System.IO
open System.Printing
open System.Reflection
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.Xml.Serialization

// Begin NotepadClone Libraries......
(*

I wanted to serialize the following type implmentation...
unfortunately, it did not work.

type NotepadCloneSettings =
{ windowState : WindowState;
restoreBounds : Rect;
textWrapping : TextWrapping;
fontFamily : string;
fontStyle : string;
fontWeight : string;
fontStretch : string;
fontSize : double;
}

I found this forum entry in hubFS that help me implement the serialization of NotepadCloneSettings:
http://cs.hubfs.net/forums/thread/4192.aspx

When running this example, the first run will always fail...the issue
is referenced this forum entry in hubFS
http://cs.hubfs.net/forums/thread/4464.aspx

*)
type NotepadCloneSettings = class
[<field: XmlAttribute("WindowState"); property:XmlIgnoreAttribute>]
val mutable windowState : WindowState

[<XmlAttribute("RestoreBounds"); property:XmlIgnoreAttribute>]
val mutable restoreBounds : Rect

[<field: XmlAttribute("TextWrapping"); property:XmlIgnoreAttribute>]
val mutable textWrapping : TextWrapping

[<field: XmlAttribute("FontFamily"); property:XmlIgnoreAttribute>]
val mutable fontFamily : string

[<field: XmlAttribute("FontStyle"); property:XmlIgnoreAttribute>]
val mutable fontStyle : string

[<field: XmlAttribute("FontWeight"); property:XmlIgnoreAttribute>]
val mutable fontWeight : string

[<field: XmlAttribute("FontStretch"); property:XmlIgnoreAttribute>]
val mutable fontStretch : string

[<field: XmlAttribute("FontSize"); property:XmlIgnoreAttribute>]
val mutable fontSize : double

new() = {windowState = WindowState.Normal;
restoreBounds = Rect.Empty;
textWrapping = TextWrapping.NoWrap;
fontFamily = "Arial";
fontStyle = "";
fontWeight = "";
fontStretch = "";
fontSize = 12.0;}

end

type Direction =
| Up
| Down

type SearchReplaceParameters =
{ What : string;
Direction : Direction;
Comparison : StringComparison;
ReplaceWith : string}

type PrintParameters =
{Queue : PrintQueue;
Ticket : PrintTicket;
Margins : Thickness}


let (=?!) (x: Nullable<'a>) (y:'a) =
x.HasValue && x.Value = y


let getAssemblyAttr assemblyType =
let assembly = Assembly.GetExecutingAssembly()
(assemblyType,false)
|> Assembly.GetExecutingAssembly().GetCustomAttributes
|> Array.to_list
|> List.map (fun item -> item)
|> List.nth <| 0

type AppAssembly =
{Title : string;
Version : string;
Copyright : string;
Company : string;
Website : string; }


// Save settings to file
let saveSettings strAppData (data:NotepadCloneSettings) =
try
Console.WriteLine (Path.GetDirectoryName(strAppData))

Directory.CreateDirectory(Path.GetDirectoryName(strAppData)) |> ignore
using(new StreamWriter(strAppData)) ( fun write ->
let xml = new XmlSerializer(data.GetType())
xml.Serialize(write,data)
)
true
with _ -> false

// Load settings from file
let loadSettings (strAppData:string) =
let settingType = typeof<NotepadCloneSettings>
let xml = XmlSerializer(settingType)
try
Console.WriteLine(strAppData)
use reader = new StreamReader(strAppData)
xml.Deserialize(reader)
with _ ->
settingType.GetConstructor(System.Type.EmptyTypes).Invoke(null)

// AboutDialog
type AboutDialog (owner:Window, app:AppAssembly) = class
inherit Window() as base

do
base.Title <- app.Title
base.ShowInTaskbar <- false
base.SizeToContent <-SizeToContent.WidthAndHeight
base.ResizeMode <- ResizeMode.NoResize;
base.Left <- owner.Left + 96.0
base.Top <- owner.Top + 96.0

// Provide content
let stack = new StackPanel()
base.Content <- stack

// Add program name
new TextBlock(Text = app.Title + " Version " + app.Version,
FontFamily = new FontFamily("Times New Roman"),
FontSize = 32.0,
FontStyle = FontStyles.Italic,
Margin = new Thickness(24.0),
HorizontalAlignment = HorizontalAlignment.Center)
|> stack.Children.Add |> ignore

// Add copyright
new TextBlock(Text = app.Copyright,
FontFamily = new FontFamily("Times New Roman"),
FontSize = 20.0,
HorizontalAlignment = HorizontalAlignment.Center)
|> stack.Children.Add |> ignore

// Website link
let run = new Run(app.Website)
let link = new Hyperlink(run)
link.Click.Add(fun _ -> Process.Start(app.Website) |>ignore)
let textblock = new TextBlock(link)
textblock.FontSize <- 20.0
textblock.HorizontalAlignment <- HorizontalAlignment.Center
textblock |> stack.Children.Add |> ignore

// Ok button
let ok = new Button(Content="OK",
IsDefault = true,
IsCancel = true,
HorizontalAlignment = HorizontalAlignment.Center,
Margin = new Thickness(24.0))

ok |> stack.Children.Add |> ignore
let baseref = base
ok.Click.Add( fun _ -> baseref.DialogResult <- new Nullable<bool>(true))
end

// WordWrapMenuItem
let mutable private initWordWrapProperty : DependencyProperty = null

type WordWrapMenuItem() = class
inherit MenuItem() as base

do
base.Header <- "_Word Wrap"


static member WordWrapProperty =
if initWordWrapProperty = null then
initWordWrapProperty <-
DependencyProperty.Register
("WordWrap",
typeof<TextWrapping>,
typeof<WordWrapMenuItem>)
initWordWrapProperty

member this.Initialize () =
// Build submenus
[("_No Wrap",TextWrapping.NoWrap);
("_Wrap",TextWrapping.Wrap);
("Wrap with _Overflow",TextWrapping.WrapWithOverflow); ]
|> Seq.iter (fun (label,wrapping) ->
let item = new MenuItem(Header=label)
item |> this.Items.Add |> ignore
// No need to muck around with MenuItem.Tag!
item.Tag <- wrapping
item.Click.Add( fun _ -> this.WordWrap <- wrapping)
)

member this.WordWrap
with get() = this.GetValue(WordWrapMenuItem.WordWrapProperty) :?> TextWrapping
and set (value:TextWrapping) = this.SetValue(WordWrapMenuItem.WordWrapProperty,value)

override this.OnSubmenuOpened args =
base.OnSubmenuOpened(args)

this.Items
|> Seq.untyped_to_typed
|> Seq.iter (fun (item:MenuItem) ->
let wrap = item.Tag
match item.Tag with
| :? TextWrapping as tag ->
item.IsChecked <- (tag = this.WordWrap)
| _ -> item.IsChecked <- false)

end

// FindReplaceDialog
type FindReplaceDialog (owner:Window,txtbox:TextBox) = class
inherit Window() as base

// Public events
let triggerFindNext,findNextEvent = IEvent.create<EventArgs>()
let triggerReplace,replaceEvent = IEvent.create<EventArgs>()
let triggerReplaceAll,replaceAllEvent = IEvent.create<EventArgs>()

let lblReplace = new Label(Content="Re_place with:",
VerticalAlignment = VerticalAlignment.Center,
Margin = new Thickness(12.0))

let findTextBox = new TextBox(Margin = new Thickness(12.0))

let replaceTextBox = new TextBox(Margin = new Thickness(12.0))

let checkMatch = new CheckBox()
let groupDirection = new GroupBox()

let radioDown = new RadioButton(Content="_Down",Margin = new Thickness(6.0))

let radioUp = new RadioButton(Content="_Up",Margin = new Thickness(6.0))

let btnFind = new Button()
let btnReplace = new Button()
let btnReplaceAll = new Button()

let mutable (search:SearchReplaceParameters) = {What=null;
Direction=Direction.Down;
Comparison=StringComparison.Ordinal;
ReplaceWith=null}

do
let baseref = base
base.ShowInTaskbar <- false
base.WindowStyle <- WindowStyle.ToolWindow
base.SizeToContent <- SizeToContent.WidthAndHeight
base.WindowStartupLocation <- WindowStartupLocation.CenterOwner
base.Owner <- owner

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

[1..3] |> Seq.iter (fun _ ->
new RowDefinition(Height=GridLength.Auto) |> grid.RowDefinitions.Add
new ColumnDefinition (Width =GridLength.Auto) |> grid.ColumnDefinitions.Add)

[(findTextBox,new Label(Content="Fi_nd what:",
VerticalAlignment = VerticalAlignment.Center,
Margin = new Thickness(12.0)),0);
(replaceTextBox,lblReplace,1)]
|> Seq.iter (fun (textbox,lbl,i) ->
Grid.SetRow(lbl,i)
Grid.SetColumn(lbl,0)
lbl |> grid.Children.Add |> ignore

Grid.SetRow(textbox,i)
Grid.SetColumn(textbox,1)
textbox |> grid.Children.Add |> ignore)

checkMatch.Content <- "Match _case"
checkMatch.VerticalAlignment <- VerticalAlignment.Center
checkMatch.Margin <- new Thickness(12.0)
Grid.SetRow(checkMatch,2)
Grid.SetColumn(checkMatch,0)

groupDirection.Header <- "Direction"
groupDirection.Margin <- new Thickness(12.0)
groupDirection.HorizontalAlignment <- HorizontalAlignment.Left

Grid.SetRow(groupDirection,2)
Grid.SetColumn(groupDirection,1)


// Stack panel for radio buttons
let stack = new StackPanel(Margin=new Thickness(6.0),
Orientation=Orientation.Horizontal)

groupDirection.Content <-
(let stack = new StackPanel(Margin=new Thickness(6.0),
Orientation=Orientation.Horizontal)
radioUp |> stack.Children.Add |> ignore
radioDown |> stack.Children.Add |> ignore
stack)

checkMatch |> grid.Children.Add |> ignore
groupDirection |> grid.Children.Add |> ignore

// Put buttons in stack panel
let btnCancel = new Button()
grid.Children.Add
(let stack = new StackPanel(Margin=new Thickness(6.0))

[(btnFind,"_Find Next");(btnReplace,"_Replace");
(btnReplaceAll,"Replace _All");(btnCancel,"Cancel");]
|> Seq.iter ( fun (button,label) ->
button.Content <- label
button.Margin <-new Thickness(6.0)
button |> stack.Children.Add |> ignore)

Grid.SetRow(stack,0)
Grid.SetColumn(stack,2)
Grid.SetRowSpan(stack,3)
stack) |> ignore

findTextBox.TextChanged.Add(fun args ->
let txtbox = args.Source :?> TextBox
[btnFind;btnReplace;btnReplaceAll]
|> Seq.iter (fun item -> item.IsEnabled <- (txtbox.Text.Length > 0)))

replaceTextBox.TextChanged.Add(fun _ ->
let flag = txtbox.Text.Length > 0
btnFind.IsEnabled <- flag
btnReplace.IsEnabled <- flag
btnReplaceAll.IsEnabled <- flag)

findTextBox.Focus() |> ignore

// Set button behaviors
btnFind.IsDefault <- true
btnCancel.IsCancel <- true
btnCancel.Click.Add(fun _ -> baseref.Close())
btnFind.Click.Add(fun _ -> triggerFindNext(new EventArgs()))
btnReplace.Click.Add(fun _ -> triggerReplace(new EventArgs()))
btnReplaceAll.Click.Add(fun _ -> triggerReplaceAll(new EventArgs()))


// public events
member x.FindNext = findNextEvent
member x.Replace = replaceEvent
member x.ReplaceAll = replaceAllEvent

member x.SearchParameters
with get() =
let cmp =
if checkMatch.IsChecked =?! true then
StringComparison.Ordinal
else
StringComparison.OrdinalIgnoreCase

search <- {What=findTextBox.Text;
Direction=Direction.Down;
Comparison=cmp;
ReplaceWith=replaceTextBox.Text}
search

and set value =
search <- value
findTextBox.Text <- search.What
replaceTextBox.Text <- search.ReplaceWith
checkMatch.IsChecked <- new Nullable<bool>((search.Comparison = StringComparison.Ordinal))
match search.Direction with
| Direction.Down -> radioDown.IsChecked <- new Nullable<bool>(true)
| Direction.Up -> radioUp.IsChecked <- new Nullable<bool>(true)


member x.HideReplaceControls () =
lblReplace.Visibility <- Visibility.Collapsed
replaceTextBox.Visibility <- Visibility.Collapsed
btnReplace.Visibility <- Visibility.Collapsed
btnReplaceAll.Visibility <- Visibility.Collapsed

end


type PrintLine = {text:string;flag:bool}

// PlainTextDocumentPaginator
// Rewriting this so all the public properties are passed in and immutable instead of
// being exposed by public properties. This ensures that the format runs once and is
// not invalidated when the public properties are set after format ran.
type PlainTextDocumentPaginator (txt,
txtwrap:TextWrapping,
margins:Thickness,
face:Typeface,
em,
prntkt:PrintTicket,
txtHeader) = class
inherit DocumentPaginator() as base


let mutable sizePage = new Size(8.5*96.0,11.0*96.0)
let pages = new ResizeArray<DocumentPage>()
let charsBreak = [|' ';'-';|]
let lineBreak = ['\n';'\r';]



let formatText text =
new FormattedText(text, CultureInfo.CurrentCulture,
FlowDirection.LeftToRight,
face, em, Brushes.Black)


// Find the length of the substring of the formatted text that will
// fit within the line
let rec linefit width text (start:int) (checkLength:int->int) =
let length = checkLength start
let checkText = String.sub text 0 length
let formattedText = formatText checkText
if formattedText.Width < width then
linefit width text length checkLength
else
start

let fitNoWrapLine width text start =
linefit width text start (fun x -> x+1)

let fitWrapLine width text start =
linefit width text start (fun x -> text.IndexOfAny(charsBreak,x))


// Processing each line
let rec processLine width isEndOfLine lineText =
let formattedText = formatText lineText
if formattedText.Width < width then
[{text=lineText;flag=isEndOfLine}]
else
let indexLine =
match txtwrap with
| TextWrapping.NoWrap -> fitNoWrapLine width lineText
| _ -> fitWrapLine width lineText
let lineBreakIndex = indexLine 0
let linefit = String.sub lineText 0 lineBreakIndex
let remainder = String.sub lineText lineBreakIndex (lineText.Length-lineBreakIndex)
List.append (processLine width false linefit )
(processLine width true remainder )

let format () =
let width = sizePage.Width - margins.Left - margins.Right

let pen = new Pen(Brushes.Black,2.0)

let displayLineContinuation (dc:DrawingContext) y =
let x = sizePage.Width - margins.Right + 6.0
let len = face.CapsHeight * em
printf "\n"
[new Point(x+len,y-len);
new Point(x,y-len/2.0);
new Point(x+len/2.0,y);]
|> Seq.iter (fun pt ->
//printf "(%5.2f,%5.2f) -> (%5.2f,%5.2f)\n" x y pt.X pt.Y
(pen, new Point(x,y),pt) |> dc.DrawLine)


let displayHeader (dc:DrawingContext) =
let fmtText = formatText txtHeader
FontWeights.Bold |> fmtText.SetFontWeight
(fmtText, new Point(margins.Left,
margins.Top - 2.0 *fmtText.Height))
|> dc.DrawText


let displayFooter (dc:DrawingContext) pageno totalPages =
let fmtText = formatText (sprintf "Page %i of %i " pageno totalPages)
FontWeights.Bold |> fmtText.SetFontWeight
(fmtText, new Point((sizePage.Width + margins.Left
- margins.Right - fmtText.Width)/2.0,
sizePage.Height - margins.Bottom
+ fmtText.Height))
|> dc.DrawText

// Start drawing page from page 1....
let rec displayPage (printlines:PrintLine list) linesPerPage pageno numPages =
let vis = new DrawingVisual()
use dc = vis.RenderOpen()

// take n items from list
let take n x = x |> Seq.take n

// drop the first n items from list
let drop n x = x |> List.rev |> Seq.take ((List.length x) - n) |> List.rev

let headerHeight = displayHeader dc

// Grab just the lines for this page
let lines2take = min (List.length printlines) linesPerPage

let lines2print =
printlines |> take lines2take
|> List.mapi (fun i line ->
let fmtText = formatText line.text
(fmtText,new Point(margins.Left,margins.Top+(Int32.to_float i)*fmtText.Height),line.flag))

// Drop what's not taken to be processed for next page
let remaininglines = printlines |> drop lines2take

displayHeader dc

// Print each line with optional line continuation
lines2print |> Seq.iteri (fun i (line,origin,eol) ->
(line,origin) |> dc.DrawText
let y = margins.Top + (Int32.to_float i)*line.Height + line.Baseline
if eol=false then (displayLineContinuation dc y))

displayFooter dc pageno numPages

dc.Close()

// Mutating state
pages.Add(new DocumentPage(vis))

if (List.length remaininglines > 0) then
displayPage remaininglines linesPerPage (pageno+1) numPages

// Sanity check
let referenceText = formatText "W"


if (width > referenceText.Width) then
let pen = new Pen(Brushes.Black,2.0)
let lines = String.split lineBreak txt
let printlines = List.flatten (List.map (processLine width true) lines)
let lineHeight = referenceText.LineHeight + referenceText.Height
let height = sizePage.Height - margins.Top - margins.Bottom
let linesPerPage = Int32.of_float(height/lineHeight)
let numPages = printlines.Length/linesPerPage + 1
displayPage printlines linesPerPage 1 numPages
()
else
()

do
Console.WriteLine("Start = {0}",DateTime.Now)
if txt.Length > 0 then format()
Console.WriteLine("End = {0}",DateTime.Now)

override x.IsPageCountValid
with get() = true

override x.PageCount
with get() = pages.Count


override x.PageSize
with get() = sizePage
and set value = sizePage <-value

override x.GetPage (page:int) = pages.[page]

override x.Source
with get() = null

end


// Other utility functions
let GetTypeFace (txtbox:TextBox) =
new Typeface(txtbox.FontFamily,txtbox.FontStyle,txtbox.FontWeight,txtbox.FontStretch)


type NotepadClone(txtbox:TextBox,assembly:AppAssembly) = class
inherit Window() as base

let fileFilter = "Text Documents(*.txt)|*.txt|All Files(*.*)|*.*"

let mutable isDirty = false
let mutable settings = new NotepadCloneSettings()
let mutable loadedFile = null
let mutable (search:SearchReplaceParameters) = {What=null;
Direction=Direction.Down;
Comparison=StringComparison.Ordinal;
ReplaceWith=null}
let mutable margins = new Thickness(96.0)
let mutable printticket:PrintTicket = null
let mutable printqueue:PrintQueue = null

let appDataFile =
let product = getAssemblyAttr (typeof<AssemblyProductAttribute>) :?> AssemblyProductAttribute

(Environment.SpecialFolder.LocalApplicationData |> Environment.GetFolderPath,
"Petzold\\" + product.Product + "\\" +product.Product + ".Settings.xml")
|> Path.Combine


// Implement SaveFile & DisplaySaveDialog

do

// load settings
settings <- ((loadSettings appDataFile) :?> NotepadCloneSettings)
base.WindowState <- settings.windowState

member x.OkToTrash() =
if isDirty then
let result = MessageBox.Show("The text in the file " + loadedFile +
" has changed\n\n" +
"Do you want to save the changes?" ,
base.Title,
MessageBoxButton.YesNoCancel,
MessageBoxImage.Question,
MessageBoxResult.Yes)

match result with
| MessageBoxResult.Cancel -> false
| MessageBoxResult.No -> true
| _ ->
if loadedFile <> null && (String.length loadedFile) > 0 then
x.SaveFile x.LoadedFile
else
x.DisplaySaveDialog x.LoadedFile
else true

member x.SearchParameters
with get() = search
and set value = search <- value

member x.PrintTicket
with get() = printticket
and set value = printticket <- value

member x.PrintQueue
with get() = printqueue
and set value = printqueue <- value

member x.PageMargins
with get() = margins
and set value = margins <- value

member x.LoadFile filename =
try
txtbox.Text <- File.ReadAllText(filename)
loadedFile <- filename
txtbox.SelectionStart <- 0
txtbox.SelectionLength <- 0
isDirty <- false
with exc ->
MessageBox.Show("Error on FileOpen " + exc.Message,
assembly.Title,
MessageBoxButton.OK,
MessageBoxImage.Asterisk) |> ignore

member x.SaveFile filename =
try
File.WriteAllText(filename,txtbox.Text)
loadedFile <- filename
x.UpdateTitle()
isDirty <- false
true
with exc ->
MessageBox.Show("Error on File Save " + exc.Message,
assembly.Title,
MessageBoxButton.OK,
MessageBoxImage.Asterisk) |> ignore
false

member x.DisplaySaveDialog filename =
let dlg = SaveFileDialog()
dlg.Filter <- fileFilter
dlg.FileName <- loadedFile

if dlg.ShowDialog() =?! true then
let filename = dlg.FileName
x.SaveFile filename
else false

member x.LoadedFile
with get() = loadedFile
and set value = loadedFile <- value

member x.Settings
with get() = settings

member x.UpdateTitle() =
if loadedFile = null then
x.Title <- "Untitled - " + assembly.Title
else
x.Title <- Path.GetFileName(loadedFile) + " - " + assembly.Title

member x.IsFileDirty
with get() = isDirty
and set value = isDirty <- value

override x.OnClosing args =
base.OnClosing(args)
args.Cancel <- (x.OkToTrash()=false)
settings.restoreBounds <- x.RestoreBounds


override x.OnClosed args =
base.OnClosed(args)
settings.windowState <- x.WindowState
settings.textWrapping <- txtbox.TextWrapping
settings.fontFamily <- txtbox.FontFamily.ToString()
settings.fontStyle <- (new FontStyleConverter()).ConvertToString(txtbox.FontStyle)
settings.fontWeight <- (new FontWeightConverter()).ConvertToString(txtbox.FontWeight)
settings.fontStretch <- (new FontStretchConverter()).ConvertToString(txtbox.FontStretch)
settings.fontSize <- txtbox.FontSize

saveSettings appDataFile settings |> ignore
end

let assembly =
{ Title = (getAssemblyAttr (typeof<AssemblyTitleAttribute>)
:?> AssemblyTitleAttribute).Title;
Version = (getAssemblyAttr (typeof<AssemblyFileVersionAttribute>)
:?> AssemblyFileVersionAttribute).Version.Substring(0,3);
Copyright = (getAssemblyAttr (typeof<AssemblyCopyrightAttribute >)
:?> AssemblyCopyrightAttribute).Copyright;
Company = (getAssemblyAttr (typeof<AssemblyCompanyAttribute >)
:?> AssemblyCompanyAttribute).Company;
Website = @"http://" + (getAssemblyAttr (typeof<AssemblyCompanyAttribute >)
:?> AssemblyCompanyAttribute).Company;
}

UI

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


open System.Windows
open System.Windows.Controls
open System.Windows.Controls.Primitives
open NotepadCloneLib

let dock = new DockPanel()
let menu = new Menu()

// Create TextBox to fill remainder of client area
let txtbox = new TextBox(AcceptsReturn = true,
AcceptsTab = true,
VerticalScrollBarVisibility = ScrollBarVisibility.Auto,
HorizontalScrollBarVisibility = ScrollBarVisibility.Auto)

let window = new NotepadClone(txtbox,assembly)

// Status line
let statLineCol = new StatusBarItem(HorizontalAlignment = HorizontalAlignment.Right)
let status = new StatusBar()

// Build and layout components!
let doLayout() =

window.Title <- "Print Better Banner"
window.Content <- dock

dock.Children.Add(menu) |> ignore
DockPanel.SetDock(menu,Dock.Top)

dock.Children.Add(status) |> ignore
DockPanel.SetDock(status,Dock.Bottom)

status.Items.Add(statLineCol) |> ignore
DockPanel.SetDock(statLineCol, Dock.Right)

dock.Children.Add(txtbox) |> ignore

Commands

#light
module Commands

#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"
#r @"ReachFramework.dll"
#r @"System.Printing.dll"
#r @"bookcontrols.dll" // PageMarginsDialog & FontDialog in this dll

open Microsoft.Win32
open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open NotepadCloneLib
open ExampleControls // For PageMarginsDialog & FontDialog

let mutable fileFilter = ""

let findNextCommand (win:#Window) =
let coll = new InputGestureCollection()
coll.Add(new KeyGesture(Key.F3)) |> ignore
new RoutedUICommand("Find _Next","FindNext",win.GetType(),coll)

let timeDateCommand (win:#Window) =
new RoutedUICommand("Time/_Date","TimeDate",win.GetType(),null)


let findNext (search:SearchReplaceParameters) =
let index =
match search.Direction with
| Direction.Down ->
let start = UI.txtbox.SelectionStart + UI.txtbox.SelectionLength
UI.txtbox.Text.IndexOf(search.What,start,search.Comparison)
| _ ->
let start = UI.txtbox.SelectionStart
UI.txtbox.Text.LastIndexOf(search.What,start,search.Comparison)


if index = -1 then
("Cannot find \"" + search.What + "\"",
UI.window.Title,MessageBoxButton.OK,
MessageBoxImage.Information)
|> MessageBox.Show |> ignore
else
UI.txtbox.Select(index,search.What.Length)
UI.txtbox.Focus() |> ignore

let displaySaveDialog filename =
let dlg = new SaveFileDialog()
dlg.Filter <- fileFilter
dlg.FileName <- UI.window.LoadedFile
if (dlg.ShowDialog(UI.window) =?! true) then
UI.window.SaveFile dlg.FileName
else false

let CanRedo (args:CanExecuteRoutedEventArgs) =
args.CanExecute <- UI.txtbox.CanRedo

let CanUndo (args:CanExecuteRoutedEventArgs) =
args.CanExecute <- UI.txtbox.CanUndo

let CanCut (args:CanExecuteRoutedEventArgs) =
args.CanExecute <- (UI.txtbox.SelectedText.Length > 0)

let CanPaste (args:CanExecuteRoutedEventArgs) =
args.CanExecute <- Clipboard.ContainsText()

let CanFind (args:CanExecuteRoutedEventArgs) =
args.CanExecute <- ((UI.txtbox.Text.Length >0) && (UI.window.OwnedWindows.Count = 0))

let CanFindNext (strFindWhat:string) (args:CanExecuteRoutedEventArgs) =
args.CanExecute <- ((UI.txtbox.Text.Length >0) && (strFindWhat.Length = 0))

let Redo _ = UI.txtbox.Redo() |> ignore
let Undo _ = UI.txtbox.Undo() |> ignore
let Cut _ = UI.txtbox.Cut()
let Copy _ = UI.txtbox.Copy()
let Delete _ = UI.txtbox.SelectedText <- ""
let Paste _ = UI.txtbox.Paste()
let SelectAll _ = UI.txtbox.SelectAll()
let TimeDate _ = UI.txtbox.SelectedText <- DateTime.Now.ToString()

let Find _ =
let dlg = new FindReplaceDialog(UI.window,UI.txtbox)
let search = UI.window.SearchParameters
dlg.HideReplaceControls()
dlg.SearchParameters <- search

dlg.FindNext.Add(fun _ ->
UI.window.SearchParameters <- dlg.SearchParameters
findNext dlg.SearchParameters )
dlg.Show()

let FindNext args =
let search = UI.window.SearchParameters
if (search.What = null || (String.length search.What) = 0) then
Find args
else
findNext search

let Replace _ =
let search = UI.window.SearchParameters
let dlg = new FindReplaceDialog(UI.window,UI.txtbox)
dlg.SearchParameters <- search

dlg.FindNext.Add(fun _ ->
UI.window.SearchParameters <- dlg.SearchParameters
findNext dlg.SearchParameters )

// ReplaceDialogOnReplace
dlg.Replace.Add(fun _ ->
UI.window.SearchParameters <- dlg.SearchParameters
let search = UI.window.SearchParameters

if search.What.Equals(UI.txtbox.SelectedText,search.Comparison) then
UI.txtbox.SelectedText <- search.ReplaceWith
findNext search)

dlg.ReplaceAll.Add(fun _ ->
UI.window.SearchParameters <- dlg.SearchParameters
let search = UI.window.SearchParameters
// Replace function
let rec replace (text:string) =
let index = text.IndexOf(search.What,0,search.Comparison)
if index = -1 then
text
else
let textRemoved = text.Remove(index,search.What.Length)
let newtext = textRemoved.Insert(index,search.ReplaceWith)
replace newtext

UI.txtbox.Text <- replace (UI.txtbox.Text) )

dlg.Show()

let New _ =
if (UI.window.OkToTrash()) then
UI.txtbox.Text <- ""
UI.window.IsFileDirty <- false
UI.window.LoadedFile <- null
UI.window.UpdateTitle()

let Open _ =
if (UI.window.OkToTrash()) then
let dlg = new OpenFileDialog()
dlg.Filter <- fileFilter
if (dlg.ShowDialog(UI.window) =?! true) then
UI.window.LoadFile dlg.FileName
UI.window.LoadedFile <- dlg.FileName
UI.window.UpdateTitle()
UI.txtbox.SelectionStart <- 0
UI.txtbox.SelectionLength <- 0
UI.window.IsFileDirty <- false

let Save _ =
if (UI.window.LoadedFile = null || UI.window.LoadedFile.Length = 0) then
displaySaveDialog "" |> ignore
else
UI.window.SaveFile UI.window.LoadedFile |> ignore

UI.window.UpdateTitle()
UI.window.IsFileDirty <- false

let SaveAs _ = displaySaveDialog UI.window.LoadedFile |> ignore

let Print _ =
let dlg = new PrintDialog()
if UI.window.PrintQueue <> null then
dlg.PrintQueue <- UI.window.PrintQueue

if UI.window.PrintTicket <> null then
dlg.PrintTicket <- UI.window.PrintTicket

if dlg.ShowDialog() =?! true then
UI.window.PrintQueue <-dlg.PrintQueue
UI.window.PrintTicket <- dlg.PrintTicket
let typeface = GetTypeFace UI.txtbox
let paginator = new PlainTextDocumentPaginator (UI.txtbox.Text,
UI.txtbox.TextWrapping,
UI.window.PageMargins,
typeface,
UI.txtbox.FontSize,
dlg.PrintTicket,
UI.window.LoadedFile)
dlg.PrintDocument(paginator,UI.window.Title)

let PageSetup _ =
let dlg = new PageMarginsDialog()
dlg.Owner <- UI.window
dlg.PageMargins <- UI.window.PageMargins

if dlg.ShowDialog() =?! true then
UI.window.PageMargins <- dlg.PageMargins

let Font _ =
let dlg = new FontDialog()
dlg.Owner <- UI.window

let typeface = GetTypeFace UI.txtbox
dlg.Typeface <- typeface

dlg.FaceSize <- UI.txtbox.FontSize
if dlg.ShowDialog() =?! true then
UI.txtbox.FontFamily <- dlg.Typeface.FontFamily
UI.txtbox.FontSize <- dlg.FaceSize
UI.txtbox.FontStyle <- dlg.Typeface.Style
UI.txtbox.FontWeight <- dlg.Typeface.Weight
UI.txtbox.FontStretch <- dlg.Typeface.Stretch

let bindCommands () =

let commands =
//
[// File commands
(ApplicationCommands.New,New,None);
(ApplicationCommands.Open,(Open),None);
(ApplicationCommands.Save,(Save),None);
(ApplicationCommands.SaveAs,(SaveAs),None);
(ApplicationCommands.Print,(Print),None);
// Edit Commands
(ApplicationCommands.Undo,(Undo),Some(CanUndo));
(ApplicationCommands.Redo,(Redo),Some(CanRedo));
(ApplicationCommands.Cut,(Cut),Some(CanCut));
(ApplicationCommands.Copy,(Copy),Some(CanCut));
(ApplicationCommands.Delete,(Delete),Some(CanCut));
(ApplicationCommands.Paste,(Paste),Some(CanPaste));
(ApplicationCommands.SelectAll,(SelectAll),None);
// Find Commands
(ApplicationCommands.Find,(Find),Some(CanFind));
((findNextCommand UI.window),(FindNext),Some(CanFind));
(ApplicationCommands.Replace,(Replace),Some(CanFind));
((timeDateCommand UI.window),(TimeDate),None);
]

commands |> Seq.iter (fun parameters ->
match parameters with
| (command,handler,None) ->
new CommandBinding(command,(fun _ args -> handler args))
|> UI.window.CommandBindings.Add |> ignore
| (command,handler,Some(checker)) ->
new CommandBinding(command,
(fun _ args -> handler args),
(fun _ args -> checker args))
|> UI.window.CommandBindings.Add |> ignore)
()

Menus

#light
module Menus

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

open System.Windows
open System.Windows.Controls
open System.Windows.Data
open System.Windows.Input
open NotepadCloneLib

// Using discriminated unions to build menus

type MenuClick =
{ Label:string;
Click:(RoutedEventArgs -> unit)}

type MenuCommand =
{ Label:string;
Command:RoutedUICommand;}

type MenuNoHeader =
{ NoLabelCommand:RoutedUICommand;}


type MenuParameter =
| WithSeparator
| WithCommand of MenuCommand
| WithClick of MenuClick
| WithNoHeader of MenuNoHeader

let addMenuItem (parent:MenuItem) (param:MenuParameter) =
match param with
| WithSeparator -> parent.Items.Add(new Separator()) |> ignore
| WithCommand c ->
new MenuItem(Header=c.Label,Command=c.Command)
|> parent.Items.Add |> ignore
| WithClick c ->
let item = new MenuItem(Header=c.Label)
item |> parent.Items.Add |> ignore
item.Click.Add(c.Click)
| WithNoHeader c ->
new MenuItem(Command=c.NoLabelCommand) |> parent.Items.Add |> ignore

let buildMenu header menulist =
let item = new MenuItem(Header=header)
menulist |> Seq.iter (addMenuItem item)

let fileMenuItems =
[WithCommand({Label="_New";Command=ApplicationCommands.New});
WithCommand({Label="_Open...";Command=ApplicationCommands.Open});
WithCommand({Label="_Save";Command=ApplicationCommands.Save});
WithCommand({Label="Save _As ...";Command=ApplicationCommands.SaveAs});
WithSeparator;
WithClick({Label="Page Set_up...";Click=Commands.PageSetup});
WithCommand({Label="_Print...";Command=ApplicationCommands.Print});
WithSeparator;
WithClick({Label="E_xit";Click=(fun _ -> UI.window.Close())});]

let editMenuItems =
[WithCommand({Label="_Undo";Command=ApplicationCommands.Undo});
WithCommand({Label="_Redo";Command=ApplicationCommands.Redo});
WithSeparator;
WithCommand({Label="Cu_t";Command=ApplicationCommands.Cut});
WithCommand({Label="_Copy";Command=ApplicationCommands.Copy});
WithCommand({Label="_Paste";Command=ApplicationCommands.Paste});
WithCommand({Label="De_lete";Command=ApplicationCommands.Delete});
WithSeparator;
WithCommand({Label="_Find";Command=ApplicationCommands.Find});
WithNoHeader({NoLabelCommand=Commands.findNextCommand UI.window});
WithSeparator;
WithCommand({Label="Select _All";Command=ApplicationCommands.SelectAll});
WithNoHeader({NoLabelCommand=Commands.timeDateCommand UI.window});]

let buildFileMenu () =
let item = new MenuItem(Header="_File")
fileMenuItems |> Seq.iter (addMenuItem item)
item

let buildEditMenu () =
let item = new MenuItem(Header="_Edit")
editMenuItems |> Seq.iter (addMenuItem item)
item

let buildFormatMenu () =
let item = new MenuItem(Header="F_ormat")
let wrap = new WordWrapMenuItem()
wrap.Initialize()
item.Items.Add(wrap)|> ignore

let bind = new Binding(Path=new PropertyPath(TextBox.TextWrappingProperty),
Source=UI.txtbox,
Mode=BindingMode.TwoWay)
wrap.SetBinding(WordWrapMenuItem.WordWrapProperty, bind) |> ignore
addMenuItem item (WithClick({Label="_Font...";Click=Commands.Font}))
item

let buildViewMenu () =
let item = new MenuItem(Header="_View")

let statusItem = new MenuItem(Header="_Status Bar",
IsCheckable=true)
statusItem.Checked.Add(fun _ ->
UI.status.Visibility <- Visibility.Visible)

statusItem.Unchecked.Add(fun _ ->
UI.status.Visibility <- Visibility.Collapsed)

item.Items.Add(statusItem) |> ignore

item.SubmenuOpened.Add(fun _ ->
statusItem.IsChecked <- (UI.status.Visibility = Visibility.Visible))

// Seems like a kludge...
(item,statusItem)

let buildHelpMenu (statusItem:MenuItem) =
let item = new MenuItem(Header="_Help")
let label = "_About " + assembly.Title + "..."
let openAbout _ =
let dlg = new AboutDialog (UI.window,assembly)
dlg.ShowDialog()|>ignore
addMenuItem item (WithClick({Label=label;Click=openAbout}))
item.SubmenuOpened.Add(fun _ ->
statusItem.IsChecked <- (UI.status.Visibility = Visibility.Visible))
item

// Build menus!
let buildMenus (root:Menu) =
root.Items.Add(buildFileMenu()) |> ignore
root.Items.Add(buildEditMenu()) |> ignore
root.Items.Add(buildFormatMenu()) |> ignore
let (viewMenu,statusItem)=buildViewMenu()
root.Items.Add(viewMenu) |> ignore
root.Items.Add(buildHelpMenu statusItem) |> ignore

NotepadClone

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

open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
open NotepadCloneLib
open UI

//
// From Chapter 18 - NotepadClone
//
txtbox.Focus()
doLayout()
Menus.buildMenus menu
Commands.bindCommands()

// TextBoxOnTextChanged
txtbox.TextChanged.Add(fun _ -> window.IsFileDirty <- true)

// TextBoxOnSelectionChanged
txtbox.SelectionChanged.Add(fun _ ->
let start = txtbox.SelectionStart
let length = txtbox.SelectionLength
let line = txtbox.GetLineIndexFromCharacterIndex(start)

if line = -1 then
let status = ""
statLineCol.Content <- status
else if length > 0 then
let startCol = start - txtbox.GetCharacterIndexFromLineIndex(line)
let endpos = start + length
let endLine = txtbox.GetLineIndexFromCharacterIndex(endpos)
let endCol = endpos - txtbox.GetCharacterIndexFromLineIndex(endLine)
let status = Printf.sprintf "Line %i %i - Line % i % i" (line+1) (startCol+1) (endLine+1) (endCol+1)
statLineCol.Content <- status
else
let startCol = start - txtbox.GetCharacterIndexFromLineIndex(line)
let status = String.Format("Line {0} {1}", line+1,startCol+1)
statLineCol.Content <- status
())

if window.Settings.restoreBounds <> Rect.Empty then
window.Left <- window.Settings.restoreBounds.Left
window.Top <- window.Settings.restoreBounds.Top
window.Width <- window.Settings.restoreBounds.Width
window.Height <- window.Settings.restoreBounds.Height

txtbox.TextWrapping <- window.Settings.textWrapping
txtbox.FontFamily <- new FontFamily(window.Settings.fontFamily)
txtbox.FontStyle <- ((new FontStyleConverter()).ConvertFromString(window.Settings.fontStyle) :?> FontStyle)
txtbox.FontWeight <- ((new FontWeightConverter()).ConvertFromString(window.Settings.fontWeight) :?> FontWeight)
txtbox.FontSize <- window.Settings.fontSize

window.Loaded.Add(fun _ ->
ApplicationCommands.New.Execute(null,window)
let args = Environment.GetCommandLineArgs()

if args.Length > 1 then
if File.Exists(args.[1]) then
()
// load file
else
let msg =
["Cannot find the ";
Path.GetFileName(args.[1]);
" file.\r\n\r\n";
"Do you want to create a new file?"]
|> Seq.fold1 (+)

let result = MessageBox.Show(msg,assembly.Title,
MessageBoxButton.YesNoCancel,
MessageBoxImage.Question)
match result with
| MessageBoxResult.Cancel -> window.Close()
| MessageBoxResult.Yes ->
try
window.LoadedFile <- args.[1]
(File.Create(window.LoadedFile)).Close()
with e ->
MessageBox.Show("Error on File Creation: " + e.Message, assembly.Title,
MessageBoxButton.OK,
MessageBoxImage.Asterisk) |> ignore
| _ -> ()
()

)
txtbox.Focus()


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