13
$\begingroup$

I have been playing with the RegionPlot3D idea from this question and have been trying to approximate the Gödel, Escher, Bach logo, but I am a little bit stuck on how to improve the rendering of the letter B. Here is the code so far:

Letter[s_String] := 
 ClusteringComponents[
  Rasterize[Style[s, 128, Bold], "Image", RasterSize -> {100, 100}]]

Gödel = Letter["G"];
Escher = Letter["E"];
Bach = Letter["B"];

SetOptions[RegionPlot3D, Axes -> False, Boxed -> False, 
 PlotPoints -> 100, Mesh -> False, Lighting -> "Neutral", 
 Background -> Black, PlotStyle -> Orange];

RegionPlot3D[
 Gödel[[Round[i], Round[j]]] > 1 && 
 Escher[[Round[i], Round[k]]] > 1 &&
 Bach[[Round[j], Round[k]]] > 1, 
 {i, 1, 100}, {j, 1, 100}, {k, 1, 100}]

This works nicely for the letter E and G as can be seen here:

Mathematica graphics

Mathematica graphics

But the letter B is not looking as nice, I think because of the shape of the letter G:

Mathematica graphics

I am wondering if anyone has any good suggestions to correct the rendering of the letter B?

Improve this question
$\endgroup$
2
  • 2
    $\begingroup$ What you need is a font that is as quadratic as possible. Just consider the extreme case of one of the letters being an I. $\endgroup$
    – David
    Commented Jan 26, 2012 at 0:45
  • $\begingroup$ Simply setting the font family to "Helvetica" is a big improvement. $\endgroup$
    – Andy Ross
    Commented Jan 26, 2012 at 1:19

2 Answers 2

Reset to default
6
$\begingroup$

The reason the B appears incorrectly is not because of the shape of G, but rather because the horizontal length of G is less than the vertical length of B, resulting in B being decapitated. Here's how the letters look at present when one is laid on top of the other at 90º:

enter image description here

Notice that in the actual GEB logo, they use a squarish font, which solves this problem. So a possible solution, in the absence of a square font, is to set the aspect ratio of each of the letter shapes to 1, so that they sit well with each other.

Here is a solution that uses Vitaliy's solution for extracting the outlines from letters.

letter[s_String] := ImageData@ Binarize@Graphics[{EdgeForm[None], FaceForm[Black], 
     First[First[ImportString[ExportString[Style[s, FontSize -> 24], "PDF"], 
        "PDF", "TextMode" -> "Outlines"]]]}, AspectRatio -> 1, ImageSize -> 100]

Now you can see that the shapes now line up correctly:

enter image description here

Proceeding with your RegionPlot3D code, but with slight modifications, 

{g, e, b} = letter /@ {"G", "E", "B"};
RegionPlot3D[
 g[[Round[i], Round[j]]] == 0 && e[[Round[i], Round[k]]] == 0 && 
  b[[Round[j], Round[k]]] == 0, {i, 1, 100}, {j, 1, 100}, {k, 1, 100}]

we get a nice and pretty GEB logo that reproduces the B and all the other letters correctly.

enter image description here enter image description here enter image description here

Improve this answer
$\endgroup$
3
$\begingroup$

Some square font from internet:

{Bach, Escher, Gödel} = ClusteringComponents /@

enter image description here

RegionPlot3D[
 Gödel[[Round[i], Round[j]]] > 1 && Escher[[Round[i], Round[k]]] > 1 &&
   Bach[[Round[j], Round[k]]] > 1, {i, 1, 120}, {j, 1, 120}, {k, 1, 
  120}, Axes -> False, Boxed -> False, PlotPoints -> 100, 
 Mesh -> False, Lighting -> "Neutral", Background -> Black, 
 PlotStyle -> Orange, SphericalRegion -> True]

enter image description here

Improve this answer
$\endgroup$

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.