MODERATOR NOTE: a submission to computations art contest, see more: https://wolfr.am/CompArt-22
Word on Circle Logo
Motivation: I have been trying to use Wolfram Technology to produce procedural graphics design for a while. My first attempts were random. I wasn't too familiar with functional programming nor did I study graphics design in detail despite having a concentration in art in college many decades back. However, as I started to teach Wolfram Language many years later I created some challenge questions and demonstrations.
This particular computation arises from the challenge to create circular text logos. My students and I were stumped for a long time. This past month, I took the mini challenge project from my archive disk and decided to give it another try using the mantra of: visualize what troubles your mind and do it step by step. These are the strength of the Wolfram Mathematica computational notebooks. (During those days in between I worked on other things that incidentally gave me more insight to the problem with this challenge question and how to visualize them with Wolfram Language)
The challenge question was: How do you procedurally product text on a circle for any given name.
The strategy : First, I reduce the problem to : How to produce text on a circle for a long name (without typographic considerations of spacing) .
The codes for rotation visualization:
visualizeTextRotationSequence[radlist_] := Module[{letterT},
letterT = Style["T", 24, LightGray, FontFamily -> "Palatino"];
Rotate[letterT, #] & /@ radlist]
visualizeRadianPath[radpathlist_] :=
Graphics[{Red, PointSize@Large, Point[First@radpathlist], Black,
Thickness@.007, Arrowheads[.1],
Arrow[
BezierCurve[Take[radpathlist, Floor[.70 Length@radpathlist]]]]},
ImageSize -> Medium]
The code for procedurally generating circle on text
WordOnCircle16[
word_ /; (StringQ[word] == True && StringLength[word] <= 16)] :=
Module[{wordoncirclechar, cp16, wordoncirclecharRotate, wordoncircle},
wordoncirclechar =
Style[#, 48, FontFamily -> "Palatino"] & /@ Characters@word;
wordoncirclecharRotate =
Rotate[wordoncirclechar[[#]], -1/2 Pi - (# - 1) /8 Pi] & /@
Range[Length@wordoncirclechar];
cpt16 = RotateRight[CirclePoints[{1, 0}, 16] // Reverse, 1];
wordoncircle =
Graphics[{Red, Circle[{0, 0}, .85], Red,
Inset[wordoncirclecharRotate[[#]], cpt16[[#]], Center] & /@
Range@5, Blue,
Inset[wordoncirclecharRotate[[#]], cpt16[[#]], Center] & /@
Range[6, Length@wordoncirclechar]}, ImageSize -> Medium]]
For error checking:
WordOnCircle16[___] := "Input incorrect. Not text or is longer than \
16 characters"
The results:
For details see the attached notebook.
Future work include
Attachments: