A Mathematica function for generating beautiful ASCII art out of any image.

Mathematica - ASCII

(*ASCIIrange = { "  ","` ",". "," .","..",".:",":.","::",":#","##","#@","x@","o@","@@","@X","XX"};*)
(*ASCIIrange = { " ","  ",".","..",".:","::",":i","io","ex","pq","Xq","AG","ZY","VW"};*)

(* Produces the best results by randomizing letters using a held random choice call *)
ASCIIrange = {"  ", Hold[RandomChoice[{"  ", " `"}]], ". ", "..", 
   Hold[RandomChoice[{".:", ":."}]], 
   Hold[RandomChoice[{"::", ";:", ":;", ";;"}]], 
   Hold[RandomChoice[{":x", "x:"}]], 
   Hold[RandomChoice[{"io", "ae", "oc"}]], 
   Hold[RandomChoice[{"yj", "tp", "qw"}]], 
   Hold[RandomChoice[{"IL", "02", "JC"}]], 
   Hold[RandomChoice[{"GP", "ZY", "VW"}]], 
   Hold[RandomChoice[{"#@", "&%", "8#"}]]};
maxthreshold = Length[ASCIIrange] - 2;

ASCIIart[image_, adjust_: {0.2, 1.5}, resolution_: 200, 
   threshold_: maxthreshold] := StringJoin[(StringJoin[#] <> "\n" & /@ (ReleaseHold /@ (Round /@ (threshold*
             Rescale /@ Map[Mean[#] & /@ # &, ImageData[
                ImageResize[ImageAdjust[image, adjust], resolution], 
                "Byte"]]) /. MapThread [#1 -> #2 &, {Reverse[Range[0, threshold + 1]],Take[ASCIIrange, threshold + 2]}])))] /; (2 <= threshold <= maxthreshold && ImageQ[image]);

ASCIIimage[image_, adjust_: {0.2, 1.5}, resolution_: 200, 
  threshold_: maxthreshold] := Rasterize[Style[ASCIIart[image, adjust, resolution, threshold], Bold,FontFamily -> "Courier", FontSize -> 5]]