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
Posts
No comments:
Post a Comment