Make a text string fill a rectangle

Question

Suppose I want a string, say "123", to fill a given rectangle, like so:

Show[Plot[x, {x, 0, 1}], 
     Graphics[{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]}], 
     Graphics[Text[Style["123", Red, Bold, 67], {.1, .5}, {-1, -1}]]]

But I hand-tuned the font size there (67) so that it would fill up the rectangle. How would you make an arbitrary string fill up an arbitrary rectangle?

Answer 1

I believe that this is a known difficult problem. The best answer I could find is from John Fultz.

TextRect[text_, {{left_, bottom_}, {right_, top_}}] := 
 Inset[
  Pane[text, {Scaled[1], Scaled[1]},
   ImageSizeAction -> "ResizeToFit", Alignment -> Center],
  {left, bottom}, {Left, Bottom}, {right - left, top - bottom}]

Show[
 Plot[x, {x, 0, 1}],
 Graphics[{
   {EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]},
   TextRect[Style["123", Red, Bold], {{.1, .5}, {.4, .9}}]
 }]
]

Answer 2

Here's an alternate approach that converts the text to a texture that gets mapped to a polygon. This has the feature of stretching the text to fit the region (since it's not really text anymore.)

Show[Plot[x, {x, 0, 1}], 
   Graphics[{EdgeForm[Thick], Yellow, Rectangle[{.1, .5}, {.4, .9}]}], 
   Graphics[{Texture[ImageData[
      Rasterize[Style["123", Red, Bold], "Image", RasterSize -> 300, 
         Background -> None]]], 
      Polygon[{{0.1, 0.5}, {0.4, 0.5}, {0.4, 0.9}, {0.1, 0.9}}, 
         VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]}]]

As a function for easier comparison:

(* Render string/style s to fill a rectangle with left/bottom corner {l,b} and 
   right/top corner {r,t}. *)
textrect[s_, {{l_,b_},{r_,t_}}] := Graphics[{
  Texture[ImageData[Rasterize[s, "Image", RasterSize->300, Background->None]]], 
  Polygon[{{l,b}, {r,b}, {r,t}, {l,t}}, 
          VertexTextureCoordinates->{{0,0},{1,0},{1,1},{0,1}}]}]

Answer 3

The suggested solution didn't work when the Plot wasn't there, I used the PlotRange option to solve it. I wrapped it in a function; Opacity, text color, etc; should be made into options;

textBox[text_, color_, position_: {0, 0}, width_: 2, height_: 1] := 
  Graphics[{
    {
     color, Opacity[.1],
     Rectangle[position, position + {width, height}, 
      RoundingRadius -> 0.1]
     }
    ,
    Inset[
     Pane[text, {Scaled[1], Scaled[1]}, 
      ImageSizeAction -> "ResizeToFit", Alignment -> Center], 
     position, {Left, Bottom}, {width, height}]
    }, PlotRange -> 
    Transpose[{position, position + {width, height}}]];