open System

#nowarn "40"

type Parser<'a> = char list -> ('a * char list) option

// Monad
type ParserMonad() =
    member x.Bind(p, f) = fun i ->
        match p i with
        | Some (v, r) -> (f v) r
        | None        -> None
    member x.Delay(f)   = fun i -> f () i
    member x.Return(v)  = fun i -> Some (v, i)
    member x.Zero()     = fun _ -> None

// Builder instance
let parse = new ParserMonad()

// Prioritized choice
let (</>) p1 p2 = fun i ->
    match p1 i with
    | Some (v, r) -> Some (v, r)
    | None        -> p2 i

// Predicates
let notpred p = fun i ->
    match p i with
    | None -> Some ((), i)
    | _    -> None

// Star, plus
let rec many p = many1 p </> parse.Return([])
and many1 p = parse {
    let! x = p
    let! xs = many p
    return x :: xs }

// Sequence
let (.>>) p1 p2 = parse {
    let! r = p1
    let! _ = p2
    return r }
let (>>.) p1 p2 = parse {
    let! _ = p1
    let! r = p2
    return r }

// Epsilon: always matches, consumes no input
let epsilon = fun i -> Some ((), i)

// Skip
let skip p = parse {
    let! _ = p
    return () }

// Characters and strings
let satisfy (pred : char -> bool) = fun i ->
    match i with
    | c :: r when pred c -> Some (c, r)
    | _                  -> None
let whitespace = satisfy Char.IsWhiteSpace
let anychar = satisfy (fun _ -> true)
let pchar c = satisfy ((=) c)
let pchari c = satisfy (fun x -> (Char.ToUpper x) = (Char.ToUpper c))
let pstring s = List.fold (.>>) epsilon [for c in s -> pchar c]
let pstringi s = List.fold (.>>) epsilon [for c in s -> pchari c]

//
// BB code specifics
//

type BBListStyle = Itemized | Numbered | Characters
type BBFormattingStyle = Bold | Italics | Underlined | Monospace | Strikethrough | Spoiler | Quote
type BBEmoticonStyle = Happy | Sad

type BBCode =
    | BBText of string
    | BBEmoticon of BBEmoticonStyle
    | BBFormatting of BBFormattingStyle * BBCode list
    | BBImage of string
    | BBTex of string
    | BBSimpleUrl of string
    | BBUrlWithContent of string * BBCode list      // URL, contents
    | BBList of BBListStyle * BBCode list
    | BBListItem of BBCode list
    | BBProperQuote of int * int * string * BBCode list       // TID, PID, user, contents

// convenience function to create parsers for opening, closing tags
let tags t = pstringi (sprintf "[%s]" t), pstringi (sprintf "[/%s]" t)

// parses plain text up to the next valid BB code statement or until the guard expression matches
let rec bbtext guard = parse {
    let! cs = many1 ((notpred bbtag) >>. (notpred guard) >>. anychar)
    return BBText (new String(List.toArray cs)) }

// parses emoticons
and bbemoticon =
    let emostyle = parse {
        do! pstring ":)"
        return BBEmoticonStyle.Happy } </> parse {
        do! pstring ":("
        return BBEmoticonStyle.Sad }
    parse {
        let! style = emostyle
        return BBEmoticon style }

// parses a simple BB code statement and wraps its contents in an instance of the given type constructor
and bbformatting name style =
    let s, e = tags name
    parse {
        do! s
        let! contents = many (bbelem e)
        do! e
        return BBFormatting (style, contents) }

// parses [img] expressions
and bbimage =
    let s, e = tags "img"
    parse {
        do! s
        let! url = many ((notpred e) >>. anychar)
        do! e
        return BBImage (new string(List.toArray url)) }

// parses [tex] expressions
and bbtex =
    let s, e = tags "tex"
    parse {
        do! s
        let! tex = many ((notpred e) >>. anychar)
        do! e
        return BBTex (new string(List.toArray tex)) }

// parses [url], [url=...] expressions
and bburl =
    let s, e = tags "url"
    let bbsimpleurl = parse {
        do! s
        let! url = many ((notpred e) >>. anychar)
        do! e
        return BBSimpleUrl (new string(List.toArray url)) }
    let bburlwithcontent = parse {
        do! pstringi "[url="
        let! url = many ((notpred (pchar ']')) >>. anychar)
        do! pchar ']' |> skip
        let! contents = many (bbelem e)
        do! e
        return BBUrlWithContent (new string(List.toArray url), contents) }
    bbsimpleurl </> bburlwithcontent

// parses [list], [list=...] expressions
and bblist =
    let s, e = tags "list"
    let bullet = pstring "[*]"
    let listitem = parse {
        do! bullet
        let! contents = many (bbelem (e </> bullet))
        return BBListItem contents }
    let parseliststyle = parse {
        do! s
        return BBListStyle.Itemized } </> parse {
        do! pstringi "[list=1]"
        return BBListStyle.Numbered } </> parse {
        do! pstringi "[list=a]"
        return BBListStyle.Characters }
    parse {
        let! style = parseliststyle
        do! skip (many whitespace)
        let! prelude = many (bbelem (e </> bullet))
        let! properitems = many listitem
        do! e
        return BBList (style, prelude @ properitems) }

// parses quotes
and bbquote =
    let e = tags "quote" |> snd
    parse {
        do! pstringi "[quote="
        let! tid = many1 (satisfy Char.IsDigit)
        do! pchar ',' |> skip
        let! pid = many1 (satisfy Char.IsDigit)
        do! pstring ",\""
        let! user = many1 (satisfy ((<>) '"'))
        do! pstring "\"]"
        let! contents = many (bbelem e)
        do! e
        return BBProperQuote (Int32.Parse(new string(List.toArray tid)),
                              Int32.Parse(new string(List.toArray pid)),
                              new string(List.toArray user),
                              contents) }

// parses any BB code expression except plain text
and bbtag = (bbformatting "b" BBFormattingStyle.Bold) </>
            (bbformatting "i" BBFormattingStyle.Italics) </>
            (bbformatting "u" BBFormattingStyle.Underlined) </>
            (bbformatting "m" BBFormattingStyle.Monospace) </>
            (bbformatting "s" BBFormattingStyle.Strikethrough) </>
            (bbformatting "spoiler" BBFormattingStyle.Spoiler) </>
            (bbformatting "quote" BBFormattingStyle.Quote) </>
            bbimage </>
            bbtex </>
            bburl </>
            bblist </>
            bbquote </>
            bbemoticon

// parses BB code expressions including plain text until guard matches or all input is consumed
and bbelem guard = bbtag </> bbtext guard

let bbparse = many (bbelem (parse.Zero()))

private static Color GetAmbientColor(System.Drawing.Image image)
{
    System.Drawing.Bitmap b = image as System.Drawing.Bitmap;
    if (null == b)
    {
        return Colors.Transparent;
    }

    long red = 0L;
    long green = 0L;
    long blue = 0L;
    for (int x = 0; x < b.Width; x++)
    {
        for (int y = 0; y < b.Height; y++)
        {
            System.Drawing.Color c = b.GetPixel(x, y);
            red += c.R;
            green += c.G;
            blue += c.B;
        }
    }

    long size = b.Width * b.Height;

    return Color.FromRgb((byte)(red / size), (byte)(green / size), (byte)(red / size));
}