January 30, 2012 9:42pm
Real-World Functional Programming, Chapter 7 Example

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)

Blog comments powered by Disqus