10
$\begingroup$

I'd like to take the text of a novel or whatever and arrange it in a way that forms an image. Essentially recreating these works from Postertext. whale
(source: litstack.com) .

enter image description here

I'm mostly looking for ideas regarding a promising plan of attack for this problem, not necessarily full solutions. Of course, code for smaller pieces of the puzzle are welcome.

ExampleData[{"Text","AliceInWonderland"}] is useful for testing solutions.

Improve this question
$\endgroup$
1
  • 1
    $\begingroup$ The biggest challenge here to getting this right is I think hyphenating the words ( almost certainly required for it to look good ). $\endgroup$
    – george2079
    Commented Oct 20, 2015 at 19:20

2 Answers 2

Reset to default
6
$\begingroup$

Here is a crude attempt, just using a monospace font and arbitrarily breaking the words..

i = 0;
alice = ExampleData[{"Text", "AliceInWonderland"}];
i0 = Binarize@ImageResize[ ExampleData[{"TestImage", "Lena"}] , {100}];
r = {ImageCrop[
      Rasterize[
       Style[StringJoin@#, FontSize -> 20, FontFamily -> "Courier", 
        FontWeight -> "Bold"], RasterSize -> {800, 30}, 
       ImageSize -> {800, 30}], {800, 7}]} & /@ 
   Map[ If[# == 0, StringTake[alice, {++i}] , " " ] & , 
    ImageData@i0 , {2} ] ;
Row[ {Show[i0, ImageSize -> 260], 
   Show[ImageAssemble[r], ImageSize -> 300]}]

enter image description here

 ImageTake[ ImageAssemble[r] , {1, 100}, {1, 300}]

enter image description here

Improve this answer
$\endgroup$
5
$\begingroup$

When I read your title, I thought "I know how to use letters as pixels of an image..." and answered. But then I re-read your question and realized that it was different altogether. Maybe some part of this will be useful...

One approach is to rasterize all the letters, then scan through the picture and find out which letter is closest to the image at each point. Start by generating a collection of rasterized letters (for simplicity later on, make them all the same size).

allChar = Characters[
 "abcdefghijklmnopqrstuvwxyz!@#$%^&*()_+1234567890-=;:'\"/?.>,<~`|\\\\ "]; 
allLetsUnequal = 
 Rasterize[
    Style[#, FontSize -> 20, FontFamily -> "Courier", 
     FontWeight -> "Bold"], RasterSize -> 20] & /@ allChar;
allSizes = ImageDimensions[#] & /@ allLetsUnequal;
maxSize = {Max[allSizes[[All, 1]]], Max[allSizes[[All, 2]]]};
allLetsPos = 
 ImageAdd[Image[ConstantArray[0, RotateRight@maxSize]], #] & /@ 
  allLetsUnequal; allLetsNeg = ColorNegate[#] & /@ allLetsPos;
allLets = Flatten[{allLetsPos, allLetsNeg}];

Now grab an image and partition it. Use a Nearest function to find the best letter for each partition.

enter image description here

img = Import["https://i.sstatic.net/fVXtV.png"];
img2 = ImageResize[img, 900];
imgParts = ImagePartition[img2, maxSize];
dims = Dimensions[imgParts];
nf = Nearest[allLets];
asciiLets = 
  Table[First@nf[imgParts[[i, j]]], {i, 1, First@dims}, {j, 1, 
      Last@dims}]; 
ImageAssemble[asciiLets]

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ I don't think this meets the OP's requirements. The images shown in the question are clearly posterized down to two levels, full black and full white with the black pixels being replaced with lines of vectorized text drawn at a very small font size to get a fairly uniform gray. The text, when the image is sufficiently enlarged, reads line for line as it the original. The kind of ascii art you generate operates on very different principles. $\endgroup$
    – m_goldberg
    Commented Oct 20, 2015 at 19:22

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.