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

• Arbituary Length of Name

• Autoresizing of Character Size

• Choice of Fonts

• Arbiturary Character Width

• Choice of Coloring