Source

progressive-fsharp-tutorials-2012 / Tutorial / AsciiArt.fs

Full commit
namespace Tutorial

open System.Drawing
open System.IO

module AsciiArt =

    type AsciiLine = List<string>

    type AsciiArt  = List<AsciiLine>

    let asciiMap = 
        [
            (230, " ")
            (200, ".")
            (180, "*")
            (160, ":")
            (130, "o")
            (100, "&")
            ( 70, "8")
            ( 50, "#")
            (  0, "@")
        ]

    // Fade functions.

    let asciiChars = 
        List.unzip asciiMap 
        |> snd

    let shift list = 
        " " :: list
        |> Seq.take (List.length list)
        |> Seq.toList

    let rec repeat n f x =
        match n with
        | 0 -> x
        | n -> repeat (n - 1) f (f x)

    let getFadeMap n =
        repeat n shift asciiChars
        |> List.zip asciiChars 

    // Coordinate functions.

    let coordinates maxX maxY = [
            for y in 0 .. maxY -> 
                [ for x in 0 .. maxX -> x, y ]
        ]

    let bitmapCoordinates (bmp:Bitmap) =
        coordinates (bmp.Width - 1) (bmp.Height - 1)

    // ASCII art functions

    let toGreyScale (c:Color) =
        (int c.R + int c.G + int c.B) / 3

    let toCharacter greyScale =
        List.find (fun (scale, _) -> greyScale >= scale) asciiMap
        |> snd
    
    let processPixel (bmp:Bitmap) (x, y) =
        bmp.GetPixel(x, y)
        |> toGreyScale
        |> toCharacter

    let toAsciiArt bmp =
        bmp
        |> bitmapCoordinates
        |> List.map (List.map (processPixel bmp))

    // Output format functions

    let formatLine (line:AsciiLine) =
        System.String.Join("", line)

    let toString (art:AsciiArt) =
        System.String.Join("\n", List.map formatLine art)

    // Append functions

    let (@@@) a b = 
        List.map2 (@) a b 

    let (^^^) a b =
        a @ b

    let fadeCell fadeMap cell =
        List.find (fun (ch, fadedCh) -> ch = cell) fadeMap
        |> snd

    let fadeLine fadeMap line =
        List.map (fadeCell fadeMap) line
    
    let fadeLinei i line =
        fadeLine (getFadeMap (i / 10)) line

    //
    // Transforms
    //

    let upsideDown art =
        List.rev art
     
    let flip art =
        List.map List.rev art
    
    let mirror art =
        art @@@ flip art 

    let reflect art =
        art ^^^ upsideDown art

    let fade art =
        List.mapi (fun i line -> fadeLine (getFadeMap (i / 10)) line) art

    let fadeReflect (art:AsciiArt) =
        art ^^^ (art |> upsideDown |> fade)

    let lighter n art =
        let fadeMap = getFadeMap n
        List.map (fadeLine fadeMap) art

    let lighterReflect n art =
        art ^^^ (art |> upsideDown |> lighter n)

    // Art pipeline

    let asciify transform bmp =
        bmp
        |> toAsciiArt
        |> transform
        |> toString