Computing maximal FontSize to fill a rectangle?

Question

I'd like to compute the proper FontSize for a given piece of text to fill a given Rectangle.

size={200,50};
style={FontColor->Black,FontSize->Automatic,TextAlignment -> Left, LineIndentMaxFraction -> 0};
img=ConstantImage[RandomColor[],size]
text = ResourceFunction["RandomText"][#]&/@{1,3,10}

In this example, we want the text to neatly fill the image over which it is inset:

Overlay[{img, Pane[Style[#, FontSize->#2, Sequence@@style], size/2]}]& @@@ Thread[{text,
   {13, 8, 4.5} (* how to find these 3 numbers? *)}]

So how does one compute the filling font size?

Details:

Here's one clunky way to do this in javascript with a loop: https://codepen.io/LukeXF/pen/yOQWNb

Answer 1

To prevent confusion, I will provide a new answer rather than edit my previous one. It is using elements of my previous answers with several important modifications.

1. The text is always centered.
2. Use of Image Crop on the text to get a tighter fit.
3. There are different ways of arranging multiword text (less lines with smaller font versus more lines with larger font). I now use another function (adjustToRatio[]) to insert carriage returns between selected words to get a ratio of width over height that is closest to the background image.

adjustToRatio[text_String, {x_, y_}] := 
 Module[{split, tup, dropSplit, rif, finText, id, ratios, targetRatio,
    near, p},
  split = StringSplit[text];
  tup = Tuples[{" ", "\n"}, Length[split] - 1];
  dropSplit = Drop[split, -1];
rif = Riffle[dropSplit, #] & /@ tup;
  finText = (StringJoin @@ #) ~~ Last[split] & /@ rif;
  id = ImageDimensions[ImageCrop[
       Rasterize[
        pp = 
         Pane[Text[Style[#, TextAlignment -> Center]], 
          ImageSize -> {Automatic, x/2}, 
          ContentPadding -> False, FrameMargins -> None, 
          Appearance -> "InputField"], "Image"], Padding -> None]] & /@
     finText;
ratios = #[[1]]/#[[2]] & /@ id;
  targetRatio = x/y;
  near = Nearest[ratios, targetRatio];
  p = Position[ratios, near[[1]]];
  finText[[First@Flatten@p]]
  ]
fitText[] := 
 Module[{fontSizes, size, style, text, lowVal, hiVal, lastTrials, 
   escape, possibilities, trialIndex, trialFont, result},
  fontSizes = Table[i, {i, 4, 100, .1}];
  size = {300, 120};
  img = ConstantImage[Green, size];
  style = {TextAlignment -> Center, FontColor -> Black, 
    FontWeight -> RandomChoice[{Bold, Plain}], 
    FontSlant -> RandomChoice[{Plain, Italic}], FontSize -> Automatic,
     FontFamily -> (ff = RandomChoice[$FontFamilies])};
  text = 
   ResourceFunction["RandomText"][RandomChoice[Range[1, 5]], "Word"];
  text = adjustToRatio[text, size];
  lowVal = 1;
  hiVal = Length[fontSizes];
  lastTrial = 0;
  escape = False;
  Do[
   possibilities = hiVal + lowVal - 1;
   trialIndex = Ceiling[possibilities/2.];
   trialFont = fontSizes[[trialIndex]];
   dim = 
    ImageDimensions[
     ImageCrop[
      Rasterize[
       pp = 
        Pane[
         Text[
          Style[text, FontSize -> trialFont, TextAlignment -> Center, 
           Sequence @@ style]], ImageSize -> {Automatic, size[[1]]/2},
          ContentPadding -> False, FrameMargins -> None, 
         Appearance -> "InputField"], "Image"], Padding -> None]];
   d = dim[[1]];
If[d >= ImageDimensions[img][[1]] - 6, hiVal = trialIndex - 1; 
    lastTrial = trialFont; Continue[]];
If[lastTrial == trialFont, escape = True];
   lastTrial = trialFont;
   rast = 
    ColorReplace[
     ImageCrop[
      Rasterize[
       p = 
        Pane[
         Style[text, FontSize -> trialFont, 
          LineSpacing -> {0, trialFont}, Sequence @@ style], size/2, 
         ImageSize -> {size[[1]]/2, Automatic}], "Image"], 
      Padding -> None], White -> Transparent];
   result = 
    If[ImageDimensions[rast][[2]] < ImageDimensions[img][[2]], True, 
     False];
If[result, lowVal = trialIndex + 1, hiVal = trialIndex - 1];
   If[escape, Break[]];
   , 100];
{trialFont, 
   Overlay[{ImageResize[img, size/2], rast}, 
    Alignment -> {Center, Center}, ContentPadding -> False]}
  ]

Here is a test with 100 different texts. Only images are shown, but each result comes with the font size. In the version given by the above function, the maximum font size is 100 (subdivided in 0.1 increments).

Answer 2

size = {200, 50};
style = {FontColor -> Black, FontSize -> Automatic, 
   TextAlignment -> Left, LineIndentMaxFraction -> 0};
img = ConstantImage[LightYellow, size];
text = ResourceFunction["RandomText"][#] & /@ {1, 3, 5, 10};
First[If[
      Rasterize[
         p = 
          Pane[Style[#, FontSize -> #2, Sequence @@ style], size/2, 
           ImageSize -> {size[[1]]/2, Automatic}], 
         "RasterSize"][[2]] <= ImageDimensions[img][[2]], {#2, 
       Overlay[{ImageResize[img, size/2], p}]}, Nothing] & @@@ 
    Thread[{#, Table[i, {i, 20, 4, -0.5}]}]] & /@ text

Response from OP:

So this is a great start but a few things before I accept:

1. Not always is the maximal value being computed (see below). There should be no margin space between the glyph and rectangle edge.
2. Handle any font family and font styling.
3. Should work for any length text, even single characters, so the search should start from a much high number (I put 70 below) and so it needs to be much faster.

Improved test example generator:

size = {300, 120};
style = {FontColor -> Black, FontWeight -> RandomChoice[{Bold,Plain}], FontSlant -> RandomChoice[{Plain,Italic}] , FontSize -> Automatic, FontFamily->RandomChoice[$FontFamilies], 
   TextAlignment -> Center};
text = ResourceFunction["RandomText"][#] & /@ {1, 3, 5, 10};
{Slider2D[Dynamic@size,{{100,50},{500,200},{10,10}},ImageSize->{100,50}],Dynamic[size]}
img = ConstantImage[Green, size];
AbsoluteTiming@First[If[
      Rasterize[
         p = 
          Pane[Style[#, FontSize -> #2, Sequence @@ style], size/2, 
           ImageSize -> {size[[1]]/2, Automatic}(FrameMargins->{0,0})], 
         "RasterSize"][[2]] <= ImageDimensions[img][[2]], {#2, 
       Overlay[{ImageResize[img, size/2], p}]}, Nothing] & @@@ 
    Thread[{#, Table[i, {i, 70, 4, -.5}]}]] & /@ text

Running this gives many examples, the first one I tried didn't choose a maximal size to fill the rect exactly: see the word "pottage" below, the loop gave 42, but 44 works too as you can see.

==========================================

Thank you for your comments. Here is a much faster version using a precision of 0.25 points. Italics are a pain sometimes. I also played with the alignment of the overlay itself. This version picks one random text (between 1 and 10 words) every time.

fitText[] := 
 Module[{fontSizes, size, style, text, lowVal, hiVal, lastTrials, 
   escape, possibilities, trialIndex, trialFont, result, img},
  fontSizes = Table[i, {i, 4, 70, .25}];
  size = {300, 120};
  img = ConstantImage[Green, size];
  style = {FontColor -> Black, 
    FontWeight -> RandomChoice[{Bold, Plain}], 
    FontSlant -> RandomChoice[{Plain, Italic}], FontSize -> Automatic,
     FontFamily -> RandomChoice[$FontFamilies], 
    TextAlignment -> Center};
  text = ResourceFunction["RandomText"][RandomChoice[Range[1, 10]]];
lowVal = 1;
  hiVal = Length[fontSizes];
  lastTrials = {};
  escape = False;
  Do[
   possibilities = hiVal + lowVal - 1;
   trialIndex = Ceiling[possibilities/2.];
   trialFont = fontSizes[[trialIndex]];
   If[MemberQ[lastTrials, trialFont], escape = True];
   AppendTo[lastTrials, trialFont];
   result = 
    If[Rasterize[
        p = 
         Pane[Style[text, FontSize -> trialFont, Sequence @@ style], 
          size/2, ImageSize -> {size[[1]]/2, Automatic}], 
        "RasterSize"][[2]] <= ImageDimensions[img][[2]], True, 
     False];
   If[result, lowVal = trialIndex + 1, hiVal = trialIndex - 1];
   If[escape, Break[]];
   , 100];
{trialFont, 
   Overlay[{ImageResize[img, size/2], p}, 
    Alignment -> {Center, Center}]}
  ]

Here is the result of calling Table[fitText[], 30]

Final Response from OP:

That is an improvement! I'm still seeing many cases like this where the font could easily be bigger:

The results should all be "tighter fits" and have less marginal space (e.g. look like the pink boxes I drew).