# Converting a Text into a list of points

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.

## 4 Answers

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?

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.

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]]


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