(*.Net Framework
Assemblies System.Drawing*)
namespace ExpandablePrinter

module FsharpPrinting =
    open System
    open System.Xml
    open System.Drawing.Printing
    open System.Drawing
    let private Document = new PrintDocument()
    let private printerSettings = new PrinterSettings()

    /// Converts a Rectangle to a RectangleF
    let RectangleToRectangleF(r: Rectangle) = RectangleF(float32(r.X), float32(r.Y), float32(r.Width), float32(r.Height))

    /// Converts a RectangleF to a Rectangle
    let RectangleFtoRectangle(r: RectangleF) = Rectangle(int(r.X), int(r.Y), int(r.Width), int(r.Height))

    /// Size of the four margins
    let Margins = Document.PrinterSettings.DefaultPageSettings.Margins

    /// RectangleF giving the size of the paper in most cases equal to PageBounds
    let Bounds = RectangleToRectangleF(Document.PrinterSettings.DefaultPageSettings.Bounds)

    /// RectangleF giving the bounds of the page including margins.
    let PageBounds = RectangleF(Bounds.Left, Bounds.Top, Bounds.Right - Bounds.Left, Bounds.Bottom - Bounds.Top)

    /// RectangleF giving the bounds of the page excluding margins equals the size of the page container.
    let PageContainer = RectangleF(float32(Margins.Left), float32(Margins.Top), Bounds.Right - float32(Margins.Left + Margins.Right), Bounds.Bottom  - float32(Margins.Top + Margins.Bottom))

    /// <summary>Read the string value from n's attribute with the name "name".
    /// If "name" is not defined Some(Value) is returns or if defaultValue is None an exception is thrown</summary>
    /// <exception cref="Attribure is missing">If "name" is not defined and defaultValue is None </exception>
    /// <param name="n">XmlNode</param>
    /// <param name="name">Attribute name</param>
    /// <param name="defaultValue">Option type. None is used when a value has to be specified.</param>
    let readString(n: XmlNode, name, defaultValue) =
        let value = (n  :?> XmlElement).GetAttribute(name)
        match defaultValue with
        | None when value = ""      -> failwith($"Attribute {name} in tag <{(n  :?> XmlElement).Name}> missing")
        | None                      -> value
        | Some(v) when value = ""   -> v
        | Some(_)                   -> value

    /// <summary> Visual Basic and Csharp version of readString
    /// Read the string value from n's attribute with the name "name".
    /// If "name" is not defined defaultValue is returns or if defaultValue is (null or Nothing) an exception is thrown</summary>
    /// <exception cref="Attribure is missing">If "name" is not defined and defaultValue is (null or Nothing) </exception>
    /// <param name="n">XmlNode</param>
    /// <param name="name">Attribute name</param>
    /// <param name="defaultValue">Single. (null or Nothing) is used when a value has to be specified.</param>
    let readStringVisualBasicCsharp(n: XmlNode, name, defaultValue) =
        let value = (n  :?> XmlElement).GetAttribute(name)
        match defaultValue with
        | null when value = ""      -> failwith($"Attribute {name} in tag <{(n  :?> XmlElement).Name}> missing")
        | null                      -> value
        | v when value = ""         -> v
        | _                         -> value

    /// Read the string value from string element n
    let readText(n: XmlNode) = (n  :?> XmlElement).InnerText

    /// <summary>Read the float32 (Single) value from n's attribute with the name "name".
    /// If "name" is not defined Some(Value) is returns or if defaultValue is None an exception is thrown</summary>
    /// <exception cref="Attribure is missing">If "name" is not defined and defaultValue is None </exception>
    /// <exception cref="Not a float value">If value is not a float number</exception>
    /// <param name="n">XmlNode</param>
    /// <param name="name">Attribute name</param>
    /// <param name="defaultValue">Option type. None is used when a value has to be specified.</param>
    let readFloat(n: XmlNode, name, defaultValue) =
        let value = (n  :?> XmlElement).GetAttribute(name)
        let i = ref 0.0f
        match (defaultValue, Single.TryParse(value, System.Globalization.NumberStyles.Float, System.Globalization.CultureInfo.InvariantCulture, i)) with
        | (_, true)                     -> !i
        | (_, false) when value <> ""   -> failwith($"Attribute {name} in tag <{(n  :?> XmlElement).Name}> not a float number")
        | (None, false)                 -> failwith($"Attribute {name} in tag <{(n  :?> XmlElement).Name}> not a float number")
        | (Some(v), false)              -> v

    /// <summary> Visual Basic and Csharp version of readFloat
    /// Read the float32 (Single) value from n's attribute with the name "name".
    /// If "name" is not defined defaultValue is returns or if defaultValue is (null or Nothing) an exception is thrown</summary>
    /// <exception cref="Attribure is missing">If "name" is not defined and defaultValue is (null or Nothing) </exception>
    /// <exception cref="Not a float value">If value is not a float number</exception>
    /// <param name="n">XmlNode</param>
    /// <param name="name">Attribute name</param>
    /// <param name="defaultValue">(null or Nothing) is used when a value has to be specified.</param>
    let readFloatVisualBasicCsharp(n: XmlNode, name, defaultValue: Nullable<float32>) =
        let value = (n  :?> XmlElement).GetAttribute(name)
        let i = ref 0.0f
        match (defaultValue, Single.TryParse(value, System.Globalization.NumberStyles.Float, System.Globalization.CultureInfo.InvariantCulture, i)) with
        | (_, true)                     -> !i
        | (_, false) when value <> ""   -> failwith($"Attribute {name} in tag <{(n  :?> XmlElement).Name}> not a float number")
        | (v, false) when v = System.Nullable() -> failwith($"Attribute {name} in tag <{(n  :?> XmlElement).Name}> not a float number")
        | (v, false)                    -> v.Value

    ///  Read the Font from n's attribute with the name "Font", "Size" and "Style".
    let readFont(n: XmlNode, f: Font) = new Font(readString(n, "Font", Some(f.Name)), readFloat(n, "Size", Some(f.Size)), Enum.Parse(typeof<FontStyle>, readString(n, "Style", Some("Regular"))) :?> FontStyle)

    ///  Read the PointF from n's attribute with the names "Tab" and "VerticalTab".
    let readTab(n: XmlNode, p: PointF) = PointF(readFloat(n, "Tab", Some(p.X)), readFloat(n, "VerticalTab", Some(p.Y)))

    ///  Read the Color from n's attribute with the name "Colour".
    let readColour(n: XmlNode) = Color.FromName(readString(n, "Colour", Some("Black")))

    ///  Read the PointF from n's attribute with the names "X" and "Y".
    let read1PointF(n: XmlNode, xOffset, yOffset) = PointF(readFloat(n, "X", None) + xOffset, readFloat(n, "Y", None) + yOffset)

    ///  Read a second PointF from n's attribute with the names "X2" and "Y2".
    let read2PointF(n: XmlNode, xOffset, yOffset) = PointF(readFloat(n, "X2", None) + xOffset, readFloat(n, "Y2", None) + yOffset)

    ///  Read a readRRectangleF from n's attribute with the names "X", "Y", "Width" and "Height".
    let readRRectangleF(n: XmlNode, xOffset, yOffset) =
        let p = read1PointF(n, 0.0f, 0.0f)
        RectangleF(p.X + xOffset, p.Y + yOffset, readFloat(n, "Width", None), readFloat(n, "Height", None) )

    ///  Read a font size from n's attribute with the name "Size" and return Font f with this new size.
    let setFontSize(n : XmlNode, f : Font) = new Font(f.Name, readFloat(n, "Size", Some(10.0f)))

    let offsetRectangleF(r: RectangleF, x, y, w, h) = RectangleF(r.X + x, r.Y + y, r.Width + w, r.Height + h)

    let offsetRectangle(r: RectangleF, x, y, w, h) = Rectangle(int(r.X + x), int(r.Y + y), int(r.Width + w), int(r.Height + h))

    let private PahragraphPrint(g: Graphics, container : RectangleF, p : PointF, f: Font, flag: StringFormatFlags, n: XmlNode) =
        if n.Name <> "Format" then failwith($"Wrong tag <{n.Name}> after <Line>, <FreeLine> and <Paragraphs> has to be <Format>")
        let fStyle = Enum.Parse(typeof<FontStyle>, readString(n, "Style", Some("Regular"))) :?> FontStyle
        use font = readFont(n, f)
        let tabs = readTab(n, p)
        let drawRect = offsetRectangleF(container, tabs.X, tabs.Y, -tabs.X, -tabs.Y)
        let remainingSpace = SizeF(container.Width - tabs.X, container.Height - tabs.Y)
        let paragraphs = readText(n)
        let sizeParagraphs = g.MeasureString(paragraphs, font, remainingSpace, new StringFormat(flag))
        if remainingSpace.Width < sizeParagraphs.Width || remainingSpace.Height < sizeParagraphs.Height then failwith($"Text in <Format> out of container")
        g.DrawString(paragraphs, font, new SolidBrush(readColour(n)), drawRect, new StringFormat(flag))
        sizeParagraphs

    let rec private runContainers(g: Graphics, printFont: Font, n:XmlNode, functions: Object, container: RectangleF) =
        let mutable yCurrent = 0.0f
        let graphicalElements = n.ChildNodes
        for e in graphicalElements do
            match e.Name with
            | "Container"   ->  let r = readRRectangleF(e, container.X, container.Y)
                                let eWidth = readFloat(e, "Draw", Some(0.0f))
                                if eWidth  > 0.0f then g.DrawRectangle( new Pen(readColour(e), eWidth),
                                                            offsetRectangle(r, eWidth / 2.0f, eWidth / 2.0f, -eWidth, -eWidth))
                                let r2 = if eWidth  > 0.0f then offsetRectangleF(r, eWidth, eWidth, -eWidth * 2.0f, -eWidth * 2.0f) else r
                                runContainers(g, printFont, e, functions, r2)
            | "Line"        ->  let mutable xCurrent = 0.0f
                                let mutable usedHeight = 0.0f
                                for item in e.ChildNodes do
                                    let usedSize = PahragraphPrint(g, container, PointF(xCurrent, yCurrent), printFont, StringFormatFlags.NoWrap, item)
                                    xCurrent <- xCurrent + usedSize.Width
                                    usedHeight <- float32(Math.Max(usedHeight, usedSize.Height))
                                yCurrent <- yCurrent + usedHeight
            | "FreeLine"    ->  let mutable xCurrent = 0.0f
                                for item in e.ChildNodes do
                                    xCurrent <- xCurrent + PahragraphPrint(g, Bounds, PointF(xCurrent, 0.0f), printFont, StringFormatFlags.NoWrap, item).Width
            | "Paragraphs"  ->  yCurrent <- yCurrent + PahragraphPrint(g, container, PointF(0.0f, yCurrent), setFontSize(e, printFont), 
                                    StringFormatFlags.NoClip, e.FirstChild).Height
            | "Point"       ->  let width = readFloat(e, "Width", Some(1.0f))
                                let p = read1PointF(e, container.X - width / 2.0f, container.Y - width / 2.0f)
                                g.FillEllipse(new SolidBrush(readColour(e)), RectangleF(p.X , p.Y, width, width))
            | "SolidLine"   ->  g.DrawLine(new Pen(readColour(e), readFloat(e, "Width", Some(2.0f))), read1PointF(e, container.X,  container.Y), read2PointF(e, container.X,  container.Y))
            | "Function"    ->  if  isNull  functions then failwith($"Tag name <Functions> detected, but functions is (null or Nothing)>")
                                let qqq = functions.GetType().GetMethods()
                                let MetodInf = functions.GetType().GetMethod(readString(e, "Name", None))
                                MetodInf.Invoke(functions, [|g; container; e.Attributes|]) |> ignore
            | "FunctionXML" ->  if  isNull  functions then failwith($"Tag name <Functions> detected, but functions is(null or Nothing)>")
                                let MetodInf = functions.GetType().GetMethod(readString(e, "Name", None))
                                MetodInf.Invoke(functions, [|g; container; e.InnerXml|]) |> ignore
            | "#comment"     -> ()
            | _              -> failwith($"Ilegal tag name in <container> <{e.Name}>")

    let mutable paragraphCount = 0
    let mutable paragraphs = Array.empty
    let printPages(g: Graphics, font: Font, container: RectangleF, text: string)=
        if paragraphCount = 0 then paragraphs <- text.Replace("\n", "").Split([|'\r'|], StringSplitOptions.None) 
        let textFit: string = ""
        let rec addLine (s: string, l : string, index : int) =
            let textArea = SizeF(container.Width, Single.MaxValue)
            let sPlus = s + l
            let z = g.MeasureString(sPlus, font, textArea,  new StringFormat(StringFormatFlags.NoClip))
            match (z.Height > container.Height, index < paragraphs.Length - 1) with
            | (false, true)     -> addLine(sPlus + "\r\n", paragraphs.[index + 1], index + 1)
            | (false, false)    -> (index, sPlus)
            | (true, _)         -> (index - 1, s)
        let index, s = addLine(textFit, paragraphs.[paragraphCount], paragraphCount)
        paragraphCount <- index + 1
        g.DrawString(s, font, new SolidBrush(Color.Black), container, new StringFormat(StringFormatFlags.NoClip))
        paragraphCount < paragraphs.Length

    let mutable private pageCount = 0

    let private documentPrintPage2 (xmlDoc: XmlDocument, functions: Object) (sender: Object)  (ev: PrintPageEventArgs) =
        let leftMargin = ev.MarginBounds.Left |> float32
        let rightMargin = ev.MarginBounds.Right |> float32
        let totalWidth = rightMargin - leftMargin |> float32
        let topMargin = ev.MarginBounds.Top |> float32
        let bottomMargin = ev.MarginBounds.Bottom |> float32
        let totalHight = bottomMargin - topMargin |> float32

        let print = xmlDoc.FirstChild.NextSibling
        if print.Name <> "Print" then failwith("Root tag has to be <Print>")
        let printFont = readFont(print, new Font("Areal", 10.0f))
        let pages = print.ChildNodes
        match pages.[pageCount].Name with
        | "Page"            -> runContainers(ev.Graphics, printFont, pages.[pageCount], functions, RectangleF(leftMargin, topMargin, totalWidth, totalHight))
                               pageCount <- pageCount + 1
                               if pageCount < pages.Count then ev.HasMorePages <- true
                               else ev.HasMorePages <- false
        | "MultiplePages"   -> let f = readFont(pages.[pageCount].FirstChild, printFont)
                               let text = readText(pages.[pageCount].FirstChild)
                               let ended = not(printPages(ev.Graphics, f, RectangleF(leftMargin, topMargin, totalWidth, totalHight), text))
                               if ended then paragraphCount <- 0; pageCount <- pageCount + 1
                               ev.HasMorePages <- not ended || pageCount < pages.Count
        | _                 -> failwith("After root tag <Print> the children tags has to be <Page> og <MultiplePages>")
        
    let private printing2(source: string, functions: Object) =
        Document.PrinterSettings <- printerSettings
        let XMLdoc = new XmlDocument()
        XMLdoc.LoadXml(source)
        let documentPrintPage = documentPrintPage2(XMLdoc, functions)
        let printPageEventHandler = new PrintPageEventHandler(documentPrintPage)
        Document.PrintPage.AddHandler(printPageEventHandler)
        Document.Print()
        Document.PrintPage.RemoveHandler(printPageEventHandler)
        pageCount <- 0; paragraphCount <- 0

    /// <summary>Start printing the XML document source to the file
    /// functions can be (null or Nothing) if no special printing functions is used
    /// functions is a referance to an object O with the special printing functions called by either XML tag 
    /// &lt;Functions Name = "O method name" attr1 = "Value1" attr2 = "Value2" ... attrN = "ValueN"/&gt; or
    /// &lt;Function2 Name = "O method name" /&gt;
    /// inner XML tags
    /// &lt;/Function2&gt;
    /// </summary>
    /// <exception cref="Wrong tag after &lt;Line&gt; or &lt;Paragraphs&gt; has to be &lt;Format&gt;">Tag after &lt;Paragraphs&gt; has to be &lt;Format&gt;&lt;Format&gt;</exception>
    /// <exception cref="Text in &lt;Format&gt; out of container">Text starts outside the container</exception>
    /// <exception cref="Tag name &lt;Functions&gt; detected, but functions is (null or Nothing)>">Function is not existing</exception>
    /// <exception cref="Ilegal tag name in &lt;container&gt;">Unknown tag name in container</exception>
    /// <exception cref="Root tag has to be &lt;Print&gt;">Wrong root tag</exception>
    /// <exception cref="After root tag &lt;Print&gt; the children tags has to be &lt;Page&gt;">description</exception>
    /// <param name = "source">XML document defining the print</param>
    /// <param name = "functions">object O with the special printing functions</param>
    /// <param name = "file">full path to *.pdf output file</param>
    let printingPDF(source: string, functions: Object, file) =
        printerSettings.PrinterName <- "Microsoft Print to PDF"
        printerSettings.PrintToFile <- true
        Document.PrinterSettings <- printerSettings
        printerSettings.PrintFileName <- file
        printing2(source, functions)

    /// <summary>Start printing the XML document source
    /// functions can be (null or Nothing) if no special printing functions is used
    /// functions is a referance to an object O with the special printing functions called by either XML tag 
    /// &lt;Functions Name = "O method name" attr1 = "Value1" attr2 = "Value2" ... attrN = "ValueN"/&gt; or
    /// &lt;Function2 Name = "O method name" /&gt;
    /// inner XML tags
    /// &lt;/Function2&gt;
    /// </summary>
    /// <exception cref="Wrong tag after &lt;Line&gt; or &lt;Paragraphs&gt; has to be &lt;Format&gt;">Tag after &lt;Paragraphs&gt; has to be &lt;Format&gt;&lt;Format&gt;</exception>
    /// <exception cref="Text in &lt;Format&gt; out of container">Text starts outside the container</exception>
    /// <exception cref="Tag name &lt;Functions&gt; detected, but functions is (null or Nothing)>">Function is not existing</exception>
    /// <exception cref="Ilegal tag name in &lt;container&gt;">Unknown tag name in container</exception>
    /// <exception cref="Root tag has to be &lt;Print&gt;">Wrong root tag</exception>
    /// <exception cref="After root tag &lt;Print&gt; the children tags has to be &lt;Page&gt;">description</exception>
    /// <param name = "source">XML document defining the print</param>
    /// <param name = "functions">object O with the special printing functions</param>
    /// <param name = "printerName">Selected printers name sting</param>
    let printingPaper(source: string, functions: Object, printerName) =
        printerSettings.PrinterName <- printerName
        printing2(source, functions)

    /// <summary>Split text to multiple containers</summary>
    /// <param name = "text">text to split. Keep paragraphs together.</param>
    /// <param name = "containers">Array of containers</param>
    /// <param name = "font">Font used in all containers</param>
    let split(text: string, containers: RectangleF[], font: Font) =
        let mutable textFitContainers: string[] = Array.empty
        let splitStringToFit (g: Graphics, font: Font, containers: RectangleF[], text: string) =
            let paragraphs = text.Split([|'\r'|], StringSplitOptions.None) 
                                |> Array.map (fun (item: string) -> item.Replace("\n", ""))
            let textFit: string[] = Array.zeroCreate containers.Length
            let rec addLine (s: string, l : string, index : int, contanier : int) =
                let textArea = SizeF(containers.[contanier].Width, Single.MaxValue)
                let sPlus = s + l
                let z = g.MeasureString(sPlus, font, textArea,  new StringFormat(StringFormatFlags.NoClip))
                match (z.Height > containers.[contanier].Height, index < paragraphs.Length - 1) with
                | (false, true)     -> addLine(sPlus + "\r\n", paragraphs.[index + 1], index + 1, contanier)
                | (false, false)    -> (index, sPlus)
                | (true, _)         -> (index - 1, s)
            let mutable j = 0
            for i in 0 .. containers.Length - 1 do
                if j  < paragraphs.Length - 1 then
                    let index, s = addLine(textFit.[i], paragraphs.[j], j, i)
                    textFit.[i] <- s
                    j <- index + 1
            textFit
        let documentPrintPage (sender: Object)  (ev: PrintPageEventArgs) =
            textFitContainers <- splitStringToFit(ev.Graphics, font, containers, text)
            ev.HasMorePages <- false
        // Find ev.Graphics to calculate text size
        let Document = new PrintDocument()
        let printerSettings = new PrinterSettings()
        printerSettings.PrinterName <- "Microsoft Print to PDF"
        printerSettings.PrintToFile <- true
        printerSettings.PrintFileName <- __SOURCE_DIRECTORY__ + @"\test.pdf"
        Document.PrinterSettings <- printerSettings
        let printPageEventHandler = new PrintPageEventHandler(documentPrintPage)
        Document.PrintPage.AddHandler(printPageEventHandler)
        Document.Print()
        Document.PrintPage.RemoveHandler(printPageEventHandler)
        textFitContainers