Skip to content

Instantly share code, notes, and snippets.

@mathias-brandewinder
Last active August 29, 2015 14:11
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save mathias-brandewinder/ec37edfad6bf5a7ca2ff to your computer and use it in GitHub Desktop.
Save mathias-brandewinder/ec37edfad6bf5a7ca2ff to your computer and use it in GitHub Desktop.
Caligramme
open System.Drawing
let brightness (c:Color) = c.GetBrightness ()
let pixels (bmp:Bitmap) =
seq { for x in 0 .. bmp.Width - 1 do
for y in 0 .. bmp.Height - 1 ->
(x,y) |> bmp.GetPixel }
let breakpoint (bmp:Bitmap) =
let pixelsCount = bmp.Width * bmp.Height
let oneThird = pixelsCount / 3
let pixs = pixels bmp
let threshold =
pixs
|> Seq.map brightness
|> Seq.sort
|> Seq.pairwise
|> Seq.skip oneThird
|> Seq.take oneThird
|> Seq.maxBy (fun (b0,b1) -> b1 - b0)
|> snd
let darkPixels =
pixs
|> Seq.map brightness
|> Seq.filter ((>) threshold)
|> Seq.length
(threshold,darkPixels)
let sizeFor (bmp:Bitmap) (text:string) darkPixels =
let width,height = bmp.Width, bmp.Height
let pixels = width * height
let textLength = text.Length
let chars = textLength * pixels / darkPixels
let w = (chars * width / height) |> float |> sqrt |> int
let h = (w * height) / width
(w,h)
let mappedPixels (bmp:Bitmap) (width,height) (x,y) =
// find bounds of intersected pixels
let wScale = float bmp.Width / float width
let hScale = float bmp.Height / float height
let loCol = int (wScale * float x)
let hiCol =
int (wScale * float (x + 1)) - 1
|> min (bmp.Width - 1)
let loRow = int (hScale * float y)
let hiRow =
int (hScale * float (y + 1)) - 1
|> min (bmp.Width - 1)
// covered pixels
seq { for col in loCol .. hiCol do
for row in loRow .. hiRow -> (col,row) }
let reducer (img:Bitmap) pixs =
pixs
|> Seq.map img.GetPixel
|> Seq.averageBy brightness
let simplified (bmp:Bitmap) (width,height) threshold =
let map = mappedPixels bmp (width,height)
let reduce = reducer bmp
let isDark value = value < threshold
let hasLetter = map >> reduce >> isDark
Array2D.init width height (fun col row ->
(col,row) |> hasLetter)
let applyTo (bmp:Bitmap) (width,height) threshold (text:string) =
let chars = text |> Seq.toList
let image = simplified bmp (width,height) threshold
let nextPosition (col,row) =
match (col < width - 1) with
| true -> (col+1,row)
| false -> (0,row+1)
(chars,(0,0))
|> Seq.unfold (fun (cs,(col,row)) ->
let next = nextPosition (col,row)
match cs with
| [] -> Some(' ',(cs,next))
| c::tail ->
if image.[col,row]
then
Some(c,(tail,next))
else Some(' ',(cs,next)))
let rebuild (width,height) (data:char seq) =
seq { for row in 0 .. height - 1 ->
data
|> Seq.map string
|> Seq.skip (row * width)
|> Seq.take width
|> Seq.toArray
|> (String.concat "") }
|> (String.concat "\n")
(* DEMO *)
let path = @"c:/users/mathias/pictures/fsharp-logo.jpg"
let bmp = new Bitmap(path)
let text = """F# is a mature, open source, cross-platform, functional-first programming language. It empowers users and organizations to tackle complex computing problems with simple, maintainable and robust code."""
let threshold,darkPixels = breakpoint bmp
let width,height = sizeFor bmp text darkPixels
text
|> applyTo bmp (width,height) threshold
|> rebuild (width,height)
// Solver version
let countDark (bmp:Bitmap) threshold (w,h) =
let map = mappedPixels bmp (w,h)
let reduce = reducer bmp
let hasLetter value = value < threshold
let isDark = map >> reduce >> hasLetter
seq { for col in 0 .. w - 1 do
for row in 0 .. h - 1 -> (col,row) }
|> Seq.filter isDark
|> Seq.length
let solver (bmp:Bitmap) (text:string) =
let targetLength = text.Length
let targetRatio = float bmp.Width / float bmp.Height
let threshold,dark = breakpoint bmp
let darkCount = countDark bmp threshold
let ratioError (w,h) =
abs((float w / float h) - targetRatio)
let candidate (w,h) d =
if d > targetLength then [ (w-1,h);(w,h-1) ]
elif d < targetLength then [ (w+1,h);(w,h+1) ]
else []
|> List.minBy ratioError
|> fun x -> x, darkCount x
let rec search (w,h) d =
match (d=targetLength) with
| true -> (w,h)
| false ->
let (w',h'), d' = candidate (w,h) d
if (abs (d'-targetLength) >= abs (d-targetLength))
then (w,h)
else search (w',h') d'
let w0,h0 = sizeFor bmp text dark
let d0 = darkCount (w0,h0)
search (w0,h0) d0
let text' =
"""F# is a mature, open source, cross-platform, functional-first programming language. It empowers users and organizations to tackle complex computing problems with simple, maintainable and robust code. F# runs on Linux, Mac OS X, Android, iOS, Windows, GPUs, and browsers. It is free to use and is open source under an OSI-approved license. F# is used in a wide range of application areas and is supported by both an active open community and industry-leading companies providing professional tools."""
|> fun text -> text.Replace(" ","").Replace(",","").Replace(".","")
let width',height' = solver bmp text'
let threshold',_ = breakpoint bmp
text'
|> applyTo bmp (width',height') threshold'
|> rebuild (width',height')
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment