Converting a Text into a list of points

Question

How can i convert a text/font into a list of Points? For example,I have this letter h,

Graphics[Text[Style["h", FontFamily -> "Courier", 300]]]

I want to obtain all the list of points such that when i put it in

Graphics[{Point[{{},{},...}]}]

I get the letter "h" made from points.

Answer 1

Graphics[MeshPrimitives[
  BoundaryDiscretizeGraphics[
   Text[Style["h", FontFamily -> "Courier", 300]], _Text], 0]]

Point /@ RandomPoint[
   DiscretizeGraphics[
    Text[Style["h", FontFamily -> "Courier", 300]], _Text], 
   600] // Graphics

Or

text = Text[Style["h", FontFamily -> "Courier", 300]]; 
reg = 
 BoundaryDiscretizeGraphics[
  ImportString[ExportString[text, "PDF"], {"PDF", "PageGraphics"}, 
    "TextOutlines" -> True][[1, 1]]]
Point /@ RandomPoint[reg, 600] // Graphics

Edit

region = DiscretizeGraphics[
   Text[Style["h", FontFamily -> "Courier", 300]], _Text];
e1 = AngleVector[π/6];
e2 = AngleVector[π/2];
c = 2;
pts = Table[c*{x, y} . {e1, e2}, {x, -100, 100, 1}, {y, -100, 100, 1}];
(*Show[Graphics[Point/@pts],region]*)
Graphics[{AbsoluteThickness[1], 
  Blue, Point /@ Pick[pts, RegionMember[region][pts]]}]

use Pick according to How to speed up process with DeleteCases?

Answer 2

I would define the letter as a discretised 2D region and plot it with axes in order to get a rough idea about its area:

letterRegion = BoundaryDiscretizeGraphics[Text[Style["h", FontFamily -> "Courier",300]], _Text, MaxCellMeasure -> 0.1, Axes -> True]

Then, I would create a grid of equidistant points (if this is what you want!)

points = Flatten[CoordinateBoundsArray[{{-100, 100}, {-100, 100}}], 1];

and select those points within the letter region:

letterPoints = Select[points, RegionMember[letterRegion]];
ListPlot[letterPoints, PlotStyle -> PointSize[0.005], Frame -> False, Axes -> False]

For better resolution you can produce more points (by decreasing the grid step, now it is 1). Also for complicated letters you can define a better discretised region by decreasing even more the MaxCellMeasure parameter.

Answer 3

graphics = Graphics[Text[Style["h", FontFamily -> "Courier", 300]]];
pts = PixelValuePositions[ColorNegate[Binarize[Image[graphics, ImageSize -> 100]]], 1];

{{144, 378}, {145, 378}, {146, 378}, {147, 378}, {148, 378}, {149,
378}, {150, 378}, ..., {333, 134}, {334, 134}, {335, 134}, {336, 134}}

you can plot these points:

Graphics[Point[pts]]

Answer 4

BoundaryDiscretizeGraphics[Text[Style["h", FontFamily -> "Courier", 300]], 
 _Text, 
 MeshCellStyle -> 
  {1 -> None, 
  2 -> PatternFilling[{"HalftoneGrid", 
         Directive[AbsolutePointSize @ 25, Red]}, ImageScaled[1/15]]}]

Replace "HalftoneGrid" with "Halftone" to get

Use PatternFilling[{"HalftoneGrid", Directive[AbsolutePointSize[15], Red]}, ImageScaled[1/30]] to get

Use PatternFilling[{"Halftone", Directive[AbsolutePointSize[30], Red]}, ImageScaled[1/50]] to get