12

Charles Demuth (1883 - 1935) was an American painter who developed a style of painting known as Precisionism. Precisionist artists reduced subjects to their essential geometric shapes and were fascinated by the sleekness and sheen of machine forms.

enter image description here

Demuth's most famous painting, I Saw the Figure 5 in Gold (1928), was inspired by a poem of his friend William Carlos Williams about a firetruck rumbling through a dark city. More at The Met Fifth Avenue

Since ChatGPT told me that

"the New York City Fire Department uses a custom-designed font called FDNY Standard",

I tried to find similar fonts with

{#, Style["5", 16, FontFamily -> #]} & /@ $FontFamilies // Short

enter image description here

(13.3.0 for Mac OS X ARM (64-bit) (June 3, 2023))

five[font_] :=
  Graphics[{
    RGBColor[0.8, 0.5, 0.0],
    BoundaryDiscretizeGraphics[
     Text[Style["5", FontFamily -> font]], _Text]},
   AspectRatio -> 1.5,
   Background -> GrayLevel[0.3]]

I found two fonts which could be used for a reproduction of the Demuth 5:

Row[{five["Bodoni 72"], Spacer[10], five["Bangla MN"]}]

enter image description here

I also found this badge at the

New York City Fire Museum

enter image description here

My Request

I don't want to reproduce the complicated background, but would like to know how I can place the three diminishing fives one behind the other. If possible, also include the No. and a reddish middle bar to symbolize the firetruck.

eldo
  • 67,911
  • 5
  • 60
  • 168
  • You can delete the poem, which adds nothing here. – David G. Stork Dec 18 '23 at 01:14
  • 1
    Done, one can easily find it in the net. – eldo Dec 18 '23 at 07:03
  • 7
    I liked the poem. Sure it did not add to the question, but these artistic questions by eldo are not only for the shake of coding. At least that's my point of view – bmf Dec 18 '23 at 07:04
  • 1
    @bmf: First, I should point out that I'm an art scholar (see my recent book *Pixels & paintings*), and know that painting (in the Art Institute of Chicago) and poem well. But I don't believe the poem belongs here because it takes time away from potential question answerers. There are far better venues for discussing that matter. – David G. Stork Dec 18 '23 at 11:46
  • @DavidG.Stork hey David, thanks for sharing your thoughts. I did not know that you were an art scholar. Quite frankly I don't see how it relates to my previous comment. I never tried to offend anyone and definitely did not question what you wrote. My remark had to exclusively with the fact that without this post I would have never known Charles Demuth and his work. Same goes for the poem. So it was only from this point of view that I wrote what I wrote. Anyway, I just thought to make this perfectly clear. – bmf Dec 19 '23 at 02:58
  • That I'm an art scholar (have lectured at pretty much every major museum, from the Louvre to National Gallery London to National Gallery Washington, ....) is to say I appreciate the painting so when I say the poem doesn't belong it is for Stack Exchange reasons... not "culture." It had nothing to do with the SOLUTION to your problem. The fact that the poem led you to the problem had nothing to do with the problem and its solutions. I wrote an entry to "How to ask good questions" in Math.SE that parodied a verbose question of the form... "I was thinking the other day about how when..." – David G. Stork Dec 19 '23 at 04:51
  • 2
    @DavidG.Stork as I said earlier, my only concern is to maintain a positive atmosphere here. So, I hope all is well and there are no misunderstandings. As for your remark poem doesn't belong it is for Stack Exchange reasons I can definitely see the merit and the point you are making. – bmf Dec 19 '23 at 05:22

1 Answers1

17
  • We using Scaling Transform according to a proper center.
  • pt is the upper right corner point.
  • We draw line from pt and go to some boundary point qt of the region.
  • Extend the line pt,qt to a point center,and set the center as the center of the scaling transformation.
  • The scaling tranformation tranlate the pt to qt, that is ScalingTransform[{1, 1}*x, center]@pt == qt.
Clear["Global`*"];
reg = BoundaryDiscretizeGraphics[
   Text[Style["5", FontFamily -> "Bell MT"]], _Text];
pt = {x, y} /. 
   Last@NMaximize[{x + y, {x, y} ∈ reg}, {x, y}];
dist = SignedRegionDistance@BoundaryDiscretizeRegion@reg;
dir = AngleVector[-110 Degree];
sol = NDSolve[{r'[s] == dir, r[0] == pt, 
     WhenEvent[dist[r[s]] == 0, Sow@s]}, r, {s, 0, 20}, 
    MaxStepSize -> .01] // Reap;
index = 4;
s0 = sol[[2, 1]][[index]];
qt = pt + s0*dir;
center = pt + 1.5 (qt - pt);
scalingfactor = 
  First@SolveValues[ScalingTransform[{1, 1}*x, center]@pt == qt, x, 
    Reals];
(* scalingfactor=Norm[qt-center]/Norm[pt-center]; *)
Graphics[{RGBColor[0.8, 0.5, 0.0], reg, 
  ScalingTransform[{1, 1}*scalingfactor, center]@reg, 
  ScalingTransform[{1, 1}*scalingfactor^2, center]@reg, 
  ScalingTransform[{1, 1}*scalingfactor^3, center]@
   reg, {AbsolutePointSize[8], Red, Point@pt, Point@qt}, {Cyan, 
   Point[center]}, Cyan, Dashed, Line[{pt, center}]}, 
 Background -> GrayLevel[0.2]]

enter image description here

Region`Mesh`FindSegmentIntersections[......,"ReturnSegmentIndex" -> True, "Ignore" -> {"EndPointsTouching"}]

We can find the intersection of boundary lines and one extra line ,avoid using the NDSolve.

Clear["Global`*"];
reg = BoundaryDiscretizeGraphics[
   Text[Style["5", FontFamily -> "Bell MT"]], _Text];
{{x1, x2}, {y1, y2}} = RegionBounds[reg];
pt = {x, y} /. 
   Last@NMaximize[{x + y, {x, y} ∈ reg}, {x, y}];
dist = SignedRegionDistance@BoundaryDiscretizeRegion@reg;
dir = AngleVector[-110 Degree];
lines = MeshPrimitives[RegionBoundary@reg, 1];
intersections = 
  Region`Mesh`FindSegmentIntersections[
   Join[lines, {Line[{pt, pt + 10*dir}]}], 
   "ReturnSegmentIndex" -> True, "Ignore" -> {"EndPointsTouching"}];
index = -4;
qt = intersections[[1, index]];
center = pt + 1.5 (qt - pt);
scalingfactor = 
  First@SolveValues[
    ScalingTransform[{1, 1}*scalingfactor, center]@pt == qt, 
    scalingfactor, Reals];
Graphics[{RGBColor[0.8, 0.5, 0.0], reg, 
  Lighter[RGBColor[0.8, 0.5, 0.0]], Lighter[RGBColor[0.8, 0.5, 0.0]], 
  ScalingTransform[{1, 1}*scalingfactor, center]@reg, 
  Lighter@Lighter[RGBColor[0.8, 0.5, 0.0]], 
  ScalingTransform[{1, 1}*scalingfactor^2, center]@reg, 
  ScalingTransform[{1, 1}*scalingfactor^3, center]@
   reg, {AbsolutePointSize[8], Red, Point@pt, Point@qt}, {Cyan, 
   Point[center]}, Cyan, Dashed, Line[{pt, center}], 
  Text[Style["No.", 30, RGBColor[0.8, 0.5, 0.0]], Scaled[{.36, .4}]]},
  Background -> GrayLevel[0.2]]

enter image description here

cvgmt
  • 72,231
  • 4
  • 75
  • 133