Here is the complete example in chapter 7 in Real-World Functional Programming.
open System.Drawing
type TextContent =
{
Text : string
Font : Font
}
type Rect =
{
Left: float32
Top: float32
Width: float32
Height:float32
}
type ScreenElement =
| TextElement of TextContent * Rect //like TextElement(textContent, Rect)
| ImageElement of string * Rect
let fontFamily = "Calibri"
let textFont = new Font(fontFamily, 12.0f)
let headerFont = new Font(fontFamily, 15.0f)
let elements =
[TextElement(
{
Text="Functional Programming for the Real World";
Font = headerFont
},
{
Left = 10.0f;
Top = 0.0f;
Width= 410.0f;
Height = 30.0f
});
ImageElement("cover.jpg",
{
Left = 120.0f;
Top = 30.0f;
Width= 150.0f;
Height = 200.0f
});
TextElement(
{
Text="In this book, we'll introduce you to the essential " +
"concepts of functional programming, but thanks to the " +
".NET Framework, we won't be limited to theoretical examples. " +
"We'll use many of the rich .NET libraries to show how " +
"functional programming can be used in the real world.";
Font = textFont
},
{
Left = 10.0f;
Top = 230.0f;
Width= 400.0f;
Height = 400.0f
});
]
let toRectangleF rectangle =
RectangleF(rectangle.Left, rectangle.Top,
rectangle.Width, rectangle.Height)
let deflate (original, wspace, hspace) =
{
Left = original.Left + hspace
Top = original.Top + wspace
Width = original.Width - (2.0f * wspace)
Height = original.Height - (2.0f * hspace)
}
let drawElements elements (graphics: Graphics) =
for element in elements do
match element with //do pattern matching on the current element
| TextElement(text, boundingBox) ->
let boxf = toRectangleF(boundingBox)
graphics.DrawString(text.Text, text.Font, Brushes.Black, boxf)
| ImageElement(imagePath, boundingBox) ->
let image = new Bitmap(imagePath)
let wspace, hspace = boundingBox.Width/10.0f, boundingBox.Height/10.f
let d = deflate(boundingBox, wspace, hspace)
let boxF = toRectangleF(d)
graphics.DrawImage(image, boxF)
let drawImage (width: int, height: int) space coreDrawingFunction =
let bitmap = new Bitmap(width, height)
use graphics = Graphics.FromImage(bitmap) //similar to using()
graphics.Clear(Color.White)
graphics.TranslateTransform(space, space)
coreDrawingFunction(graphics)
bitmap
let documentImage = drawImage(450, 400) 20.0f (drawElements elements)
open System.Windows.Forms
let main = new Form(
Text = "Document",
BackgroundImage = documentImage,
Width = documentImage.Width,
Height = documentImage.Height)
main.Show()
main.Close()
type Orientation =
| Vertical
| Horizontal
type DocumentPart =
| SplitPart of Orientation * list
| TitledPart of TextContent * DocumentPart
| TextPart of TextContent
| ImagePart of string
let document =
TitledPart(
{
Text = "Functional Programming for the Read World";
Font = headerFont
},
SplitPart(Vertical, [
ImagePart("cover.jpg");
TextPart(
{
Text="In this book, we'll introduce you to the essential " +
"concepts of functional programming, but thanks to the " +
".NET Framework, we won't be limited to theoretical examples. " +
"We'll use many of the rich .NET libraries to show how " +
"functional programming can be used in the real world.";
Font = textFont
})
]
)
)
let rec documentToScreen(document, bounds) =
match document with
| SplitPart(Horizontal, parts) ->
let width = bounds.Width/ (float32(parts.Length))
parts
|> List.mapi(fun i part ->
let left = bounds.Left + float32(i) * width
let bounds = {bounds with Left = left; Width = width}
documentToScreen(part, bounds))
|> List.concat
| SplitPart(Vertical, parts) ->
let height = bounds.Height/float32(parts.Length)
parts
|> List.mapi(fun i part -> //like List.map, but gives us the index for the current item
let top = bounds.Top + float32(i) * height
let bounds = {bounds with Top = top; Height = height}
documentToScreen(part, bounds))
|> List.concat
| TitledPart(tx, content) ->
let titleBounds = {bounds with Height = 35.0f}
let restBounds = {bounds with Height = bounds.Height - 35.0f; Top = bounds.Top + 35.0f}
let convertedBody = documentToScreen(content, restBounds)
TextElement(tx, titleBounds) :: convertedBody
| TextPart(tx) -> [TextElement(tx, bounds) ]
| ImagePart(im) -> [ImageElement(im, bounds) ]
open System.Xml.Linq
let attr(node:XElement, name, defaultValue) =
let attr = node.Attribute(XName.Get(name))
if(attr <> null) then attr.Value else defaultValue
let parseOrientation(node) =
match attr(node, "orientation", "") with
| "horizontal" -> Horizontal
| "vertical" -> Vertical
| _ -> failwith "Unknown orientation!"
let parseFont(node) =
let style = attr(node, "style", "")
let style =
match style.Contains("bold"), style.Contains("italic") with
| true, false -> FontStyle.Bold
| false, true -> FontStyle.Italic
| true, true -> FontStyle.Bold ||| FontStyle.Italic
| false, false -> FontStyle.Regular
let name = attr(node, "font", "Calibir")
new Font(name, float32(attr(node, "size", "12")), style)
let rec loadPart(node:XElement) =
match node.Name.LocalName with
| "titled" ->
let tx = {Text = attr(node, "title", ""); Font = parseFont(node)}
let body = loadPart(Seq.head(node.Elements()))
TitledPart(tx, body)
| "split" ->
let orientation = parseOrientation(node)
let nodes = node.Elements() |> List.ofSeq |> List.map loadPart
SplitPart(orientation, nodes)
| "text" ->
TextPart({Text = node.Value; Font = parseFont(node)})
| "image" ->
ImagePart(attr(node, "filename", ""))
| name -> failwith ("Unknown node: " + name)
let rec mapDocument f docPart =
let processed =
match docPart with
| TitledPart(tx, content) ->
TitledPart(tx, mapDocument f content)
| SplitPart(orientation, parts) ->
let mappedParts = parts |> List.map (mapDocument f)
SplitPart(orientation, mappedParts)
| _ -> docPart
f(processed)
let isText(part) =
match part with
| TextPart(_) -> true
| _ -> false
let shrinkDocument part =
match part with
| SplitPart(_, parts) when List.forall isText parts ->
let res =
List.fold(fun st (TextPart(tx)) ->
{Text = st.Text + " " + tx.Text
Font = tx.Font})
{Text = ""; Font = null } parts
TextPart(res)
| part -> part
let doc = loadPart(XDocument.Load("document.xml").Root)
let shrinkedDoc = doc |> mapDocument shrinkDocument
let rec aggregateDocument f state docPart =
let state = f state docPart
match docPart with
| TitledPart(_,part) ->
aggregateDocument f state part
| SplitPart(_, parts) ->
List.fold(aggregateDocument f) state parts
| _ -> state
let totalWords =
aggregateDocument(fun count part ->
match part with
| TextPart(tx) | TitledPart(tx, _) ->
count + tx.Text.Split(' ').Length
| _ -> count) 0 doc
open System.Windows.Forms
[]
do
//let doc = loadPart(XDocument.Load("document.xml").Root)
let doc = doc |> mapDocument shrinkDocument
let bounds = {Left = 0.0f; Top = 0.0f; Width = 520.0f; Height = 630.0f}
let parts = documentToScreen(doc, bounds)
let img = drawImage (570, 680) 25.0f (drawElements parts)
let main = new Form(
Text = "Document",
BackgroundImage = img,
ClientSize = Size(570, 680)
)
Application.Run(main)