Wolfram Archive
Wolfram Programming Lab is a legacy product.
All the same functionality and features, including access to Programming Lab Explorations, are available with Wolfram|One.
Start programming now. »

# Make a Text Kaleidoscope

Make an interactive interface for exploring kaleidoscopic text designs.

Run the code to make a large a in Times font:

Make a 200-point a (a point is a printers measure equal to 1/72 inch):

Style["a", 200]

Put the a in Times font:

Style["a", 200, FontFamily -> "Times"]

Style["a", 200, FontFamily -> "Times"]

Position a large a in a graphic. Try positions other than {1,0}:

This draws a large a at coordinates {1,0}. PlotRange->2 makes the drawing area extend 2 units in every direction. Axes->True turns on axes so you can see the coordinate positions:

Graphics[ Text[Style["a", 200, FontFamily -> "Times"], {1, 0}], PlotRange -> 2, Axes -> True]

Graphics[ Text[Style["a", 200, FontFamily -> "Times"], {1, 0}], PlotRange -> 2, Axes -> True]

Rotate the a. Try other angles:

Rotate the a by 30° about its center:

Graphics[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {1, 0}], 30 Degree], PlotRange -> 2, Axes -> True]

Graphics[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {1, 0}], 30 Degree], PlotRange -> 2, Axes -> True]

Make copies of the a rotated about the origin:

Use Table to make a list of five even numbers:

Table[2 i, {i, 1, 5}]

Use Table to make a graphic with five evenly spaced as:

Graphics[ Table[Text[Style["a", 200, FontFamily -> "Times"], {i, 0}], {i, 1, 5}] ]

Use Table to make a graphic with five as rotated about the point {0,0}:

Graphics[ Table[Rotate[Text[Style["a", 200, FontFamily -> "Times"], {1, 0}], i 72 Degree, {0, 0}], {i, 1, 5}] ]

Graphics[ Table[Rotate[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {1, 0}], 30 Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2, Axes -> True]

Make it interactive. Drag the slider to change the position of the a:

Make an interactive interface where the position of the a is controlled by a slider.

Wrap the expression with Manipulate, replace the fixed x coordinate 1 with the variable d, and specify that d goes from -2 to 2 with an initial value of 1:

Manipulate[ Graphics[ Table[Rotate[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {d, 0}], 30 Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2} ]

Manipulate[ Graphics[ Table[Rotate[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {d, 0}], 30 Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2} ]

Add a control for the rotation:

Add a control for the rotation of the a:

Manipulate[ Graphics[ Table[Rotate[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {d, 0}], r Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{r, 0, "rotation"}, 0, 360} ]

Manipulate[ Graphics[ Table[Rotate[ Rotate[Text[Style["a", 200, FontFamily -> "Times"], {d, 0}], r Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{r, 0, "rotation"}, 0, 360} ]

Add a control for the font size:

Add a control for the size of the a:

Manipulate[ Graphics[ Table[Rotate[ Rotate[Text[Style["a", s, FontFamily -> "Times"], {d, 0}], r Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{r, 0, "rotation"}, 0, 360}, {{s, 200, "size"}, 0, 400} ]

Manipulate[ Graphics[ Table[Rotate[ Rotate[Text[Style["a", s, FontFamily -> "Times"], {d, 0}], r Degree], i 72 Degree, {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{r, 0, "rotation"}, 0, 360}, {{s, 200, "size"}, 0, 400} ]

Add a control for the text:

Add an input field where you can enter any text:

Manipulate[ Graphics[ Table[Rotate[ Rotate[Translate[ Text[Style[text, s, FontFamily -> "Times"]], {d, 0}], a \[Degree]], i 72 \[Degree], {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{a, 0, "rotation"}, 0, 360}, {{s, 200, "size"}, 0, 400}, {{text, "a", "text"}} ]

With that kind of input field, you have to put quotes around what you type to indicate that its text (and not a symbol). Make the input field automatically treat what you type as text so you dont need to type the quotes:

Manipulate[ Graphics[ Table[Rotate[ Rotate[Translate[ Text[Style[text, s, FontFamily -> "Times"]], {d, 0}], a \[Degree]], i 72 \[Degree], {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{a, 0, "rotation"}, 0, 360}, {{s, 200, "size"}, 0, 400}, {{text, "a", "text"}, InputField[#, String] &} ]

Manipulate[ Graphics[ Table[Rotate[ Rotate[Translate[ Text[Style[text, s, FontFamily -> "Times"]], {d, 0}], a \[Degree]], i 72 \[Degree], {0, 0}], {i, 1, 5}], PlotRange -> 2], {{d, 1, "distance"}, -2, 2}, {{a, 0, "rotation"}, 0, 360}, {{s, 200, "size"}, 0, 400}, {{text, "a", "text"}, InputField[#, String] &} ]