# Around the Clock

I want to produce with Mathematica something like this

Or this

12 hours should be arranged in a pleasing ("rotated") style around / within a rectangle. I don't ask for the hands - depending on numerical input - but only for a Graphics to begin with.

• "Have you tried anything ?"

• "Sure, but with non-presentable results."

• You're late stackoverflow.com/q/8187378/353410 Sep 26, 2014 at 20:03
• @belisarius But my question concerns "rectangular clocks", not the "trivial" round ones. Should I delete it?
– eldo
Sep 26, 2014 at 20:14
• Yup. Twas a joke :) Sep 26, 2014 at 20:33
• This seems to work: Import["http://i.stack.imgur.com/6ErpY.jpg"] -- :D ;P Sep 26, 2014 at 21:00
• What I got is a lack of time. I might get a nice font, convert glyphs to FilledCurves, transform, and presto. Trying to do it artistically would take ten times longer. Maybe I'd get lucky. You'll probably get some cool answers, though. Sep 26, 2014 at 21:17

A square clock in base 12:

How to:

(*Too lazy,stolen from@blochwave*)
thetaList = Rest@Range[2 Pi, 0, -2 Pi/12] + Pi/2;
coordinateList = 1/4 {Cos@#, Sin@#} & /@ thetaList;
i = ImagePad[ImageCrop[Image@ImageData@Graphics[{FontFamily -> "Algerian", FontSize -> 100,
Rotate~MapThread~{Text~MapThread~{ToString /@ {1, 2, 3, 4, 5, 6, 7, 8, 9, A, B, C},
coordinateList}, Abs[-Pi/2 + thetaList]}}]], 2, White]


Some Transformation functions. Surely can be shorter, but the real thing isn't easy ...

f[x_] := IntegerPart@Rescale[Mod[ArcTan[x[[1]], x[[2]]], 2 Pi], {0, 2 Pi}, {0, 8}]
s = (321/2 - 82)/(321/2);
s1 = 1/3;

sc[x_] :=   {s  Cos[ArcTan @@ x], Cos[ArcTan @@ x]}
ss[x_] :=   {s  Sin[ArcTan @@ x], Sin[ArcTan @@ x]}
stan[x_] := {s1 Sin[ArcTan @@ x], Tan[ArcTan @@ x]}
scot[x_] := {s1 Cos[ArcTan @@ x], Cot[ArcTan @@ x]}

h[s1_] := If [Norm@# < s, {0, 0},
Which[
1 <= f@# <= 2, {Rescale[#[[1]], sc@#, scot@#],         Rescale[#[[2]], ss@#, {s1, 1}]},
3 <= f@# <= 4, {Rescale[#[[1]], sc@#, {-s1, -1}],      Rescale[#[[2]], ss@#, stan@# {1, -1}]},
5 <= f@# <= 6, {Rescale[#[[1]], sc@#, scot@# {1, -1}], Rescale[#[[2]], ss@#, {-s1, -1}]},
True,          {Rescale[#[[1]], sc@#, {s1, 1}],        Rescale[#[[2]], ss@#, stan@#]}]] &;

sqc = ImagePad[ImageTake[ImageForwardTransformation[i, h[s1], DataRange -> {{-1, 1}, {-1, 1}}],
4 {1, -1}, 4 {1, -1}], 2]



Full code for the working clock:

ic= ColorReplace[ImageCompose[sqc,ImageResize[ImagePad[i, 1], 140]],White -> Lighter@Lighter@Orange]
makeHand[col_, fl_, bl_, fw_, bw_, d_] := {col, EdgeForm[Darker@Orange],
Polygon[{{-bw, -bl, d}, {bw, -bl, d}, {fw, fl, d}, {0, fl + 8 fw, d}, {-fw, fl, d}}/9]};
hourHand = makeHand[Darker@Darker@Green, 5, 5/3, .1, .3, .1];
minuteHand = makeHand[Darker@Darker@Green, 7, 7/3, .1, .3, .2];
secondHand = makeHand[Red, 7, 7/3, .1/2, .2, .3];
g1 = Graphics3D[{{Texture[ic],
Polygon[{{-1, -1, 0}, {1, -1, 0}, {1, 1, 0}, {-1, 1, 0}},
VertexTextureCoordinates -> {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]},
Rotate[hourHand, Dynamic[Refresh[-30 Mod[AbsoluteTime[]/3600, 60] \[Degree],
UpdateInterval -> 60]], {0, 0, 1}],
Rotate[minuteHand, Dynamic[Refresh[-6 Mod[AbsoluteTime[]/60, 60] \[Degree],
UpdateInterval -> 1]], {0, 0, 1}],
Rotate[secondHand,Dynamic[Refresh[-6 Mod[AbsoluteTime[], 60] \[Degree],
UpdateInterval -> 1/20]], {0, 0, 1}]}, Boxed -> False,
Lighting -> "Neutral"]


Now you've your watch going. But still there is an interesting problem to solve: How do you capture it to show a running gif at the site. I found a nice (I believe) way to do it:

b = {};
t = CreateScheduledTask[AppendTo[b, Rasterize@g1], {2, 30}];
Export["c:\\test.gif", b, "DisplayDurations" -> 1]


The resulting file is the first gif in the post.

• Your answer is joyfully accepted. Borges would have loved a clock without fingers: "And yet,and yet..." - Borges, Nueva refutación del tiempo, última frase :)
– eldo
Sep 27, 2014 at 18:49
• @eldo Make the following experiment: Take whatever Borges said about time, mirrors, libraries and labyrinths and permute those substantives in the subject of the sentences ... Sep 28, 2014 at 4:36
• "A blasphemous man suggested that all men should juggle letters and symbols until they constructed, by an improbable gift of chance, these canonical books."
– eldo
Sep 28, 2014 at 10:13
• @Dr.belisarius Indeed, this is a base 13 clock (not 12), you are just not using the 0 symbol. 12 in base 12 is 10 (not C). Jul 13, 2017 at 2:27

It's definitely too slow for a real time clock but it doesn't look too bad so I thought i'd share my work. I simply build a normal clock and distorted it into rectangular shape with ImageTransformation.

b = ContourPlot[Evaluate[Sum[Sin[RandomReal[9, 2].{x, y}], {5}]], {x, -1,  1},
{y, -1, 1}, BoundaryStyle -> {Thick, Black},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 < 1],
Frame -> None, ImageSize -> 600];

clock = Graphics[{Thickness[0.013], Circle[], Thickness[0.003],
Table[Line[{0.9 {Cos[a], Sin[a]}, 0.95 {Cos[a], Sin[a]}}], {a, 0, 2 Pi, 2 Pi/60}],
Thickness[0.013],
Table[Line[{0.9 {Cos[a], Sin[a]}, 0.95 {Cos[a], Sin[a]}}], {a, 0, 2 Pi, 2 Pi/12}],
Table[
Rotate[Style[
Text[IntegerString[i, "Roman"],
1.1 {Cos[-i Pi/6 + Pi/2], Sin[-i Pi/6 + Pi/2]}], Bold, Thick,
35, FontFamily -> "Helvetica"], i*- 30 Degree], {i, 1, 12}],
Rotate[Polygon[{{-0.03, -5/27}, {0.03, -5/27}, {0.01, 5/9},
{0, 0.64}, {-0.01, 5/9}}], 40 Degree, {0, 0}],
Rotate[Polygon[{{-0.03, -7/27}, {0.03, -7/27}, {0.01, 7/9},
{0, 0.86}, {-0.01, 7/9}}], -40 Degree, {0, 0}], RGBColor[1, 0, 0],
EdgeForm[GrayLevel[0]],
Rotate[Polygon[{{-0.016, -7/27}, {0.016, -7/27}, {0.0055, 8/9},
{0, 0.93}, {-0.0055, 8/9}}], -150 Degree, {0, 0}],
Thickness[0.003], White, Disk[{0, 0}, 0.04],
Thickness[0.005], Black, Circle[{0, 0}, 0.04]}];

res = ImageTransformation[Show[b, clock, PlotRangePadding -> 0.2],
{#[[1]]*Sqrt[1 - #[[2]]^2/2], #[[2]]*Sqrt[1 - #[[1]]^2/2]} &,
DataRange -> {{-1.0, 1.0}, {-1.0, 1.0}},
PlotRange -> {{-1, 1}, {-1, 1}}]


Some stuff is stolen from this terrible article.

Using ImageTransformation

tf[{x_, y_}] := {(2 x)/(1 + y), (2 y)/(1 + y)};
{" XI  XII    I  ", " II   III  IV ", " V    VI  VII ", " VIII IX   X  "};
im = Graphics[Text[
Style[#, Bold, 100, FontFamily -> "Times",
FontTracking -> "Narrow"]], ImageSize -> {450, 70}] & /@ %;
tr = ImageTransformation[#, tf, DataRange -> {{-1, 1}, {0, 1}},
Padding -> White] & /@ im;
Graphics[Table[Rotate[{Texture[tr[[i]]],
r = 1/2; Polygon[{{-r, r}, {r, r}, {1, 1}, {-1, 1}},
VertexTextureCoordinates -> {{.25, 0}, {.75, 0}, {1, 1}, {0, 1}}]},
-π/2 (i - 1), {0, 0}], {i, 4}]]


Using FindGeometricTransform, ParametricPlot

pts[t_, r_] := # {t, r t} & /@ {{-1, 1}, {1, 1}, {1, -1}, {-1, -1}}
tf2[{u_, v_}, t_, r_] := (FindGeometricTransform[#,
{{0, 0}, {1, 0}, {1, 1}, {0, 1}}][[2]][{u, v}] &) /@
Join, {Partition[pts[t, r], 2, 1, 1],
Reverse /@ Partition[pts[2 r, r], 2, 1, 1]}]
ParametricPlot[Evaluate[tf2[{u, v}, 1, 1]], {u, 0, 1}, {v, 0, 1},
PlotStyle -> ({Opacity[1], Texture[#]} & /@ im)]


Image-Manipulate Version

Clear[r]; DynamicModule[{t, r, hour, min, sec, ht, mt, st},
Manipulate[
{hour, min, sec} = Take[DateList[], -3];
ht = π/2 - (hour π)/6 - (min π)/360;
mt = π/2 - (min π)/30; st = π/2 - π/30  Floor[sec];
ParametricPlot[Evaluate[tf2[{u, v}, t r, r]],{u, 0, 1}, {v, 0, 1},
PlotStyle -> ({Opacity[.9], Texture[#]} & /@ im),
AspectRatio -> Automatic,
ImageSize -> 300, Axes -> False, Frame -> False, Mesh -> None,
BoundaryStyle -> None,
Epilog -> {AbsoluteThickness[5],
Line[{{0, 0}, .7 t r {Cos[ht], r Sin[ht]}}],
Gray, Line[{{0, 0}, t r {Cos[mt], r Sin[mt]}}],
Red, AbsoluteThickness[Large],
Line[{{0, 0}, .9 t r {Cos[st], r Sin[st]}}]}],
{{t, 1.2}, .6, 1.5}, {{r, .7}, .5, 1},
SaveDefinitions -> True]
]


• Very very nice - Almost like a Cartier :)
– eldo
Sep 27, 2014 at 13:43
• @eldo the problem with multichar hour marks is the difficulty in getting the right angular position. Hence my "base12" clock :) Sep 29, 2014 at 17:15

Here's my first attempt - no styling (so not very artistic), but it does put the numbers at the right angle.

It makes use of IntegerString[number, "Roman"].

hours = 12;
thetaList = Rest@Range[2 Pi, 0, -2 Pi/hours] + Pi/2;
Graphics[{
FontFamily -> "Times New Roman", FontSize -> 30,
Abs[-Pi/2 + thetaList]},
Arrow[{{0, 0}, 0.75*coordinateList[[1]]}],
Arrow[{{0, 0}, 0.6*coordinateList[[12]]}],
Transparent, EdgeForm[Directive[Thick]],
}]


Which produces:

I had a go at using GeometricTransformation to distort the text too, but didn't get far...I've certainly not thought this through fully, so hopefully someone might jump in and correct my mistakes! This gives a suitable text-shearing, but doesn't place them in the right position.

hours = 12;
thetaList = Rest@Range[2 Pi, 0, -2 Pi/hours] + Pi/2;

shearingList =
If[Mod[#, Pi/4] != 0,
ShearingTransform[-Abs[-Pi/2 - #], {0, 1}, {1, 0}],
ShearingTransform[0, {1, 0}, {0, 1}]] & /@ thetaList;

rotatedText = {FontFamily -> "Times New Roman", FontSize -> 30,
coordinateList}, shearingList}, Abs[-Pi/2 + thetaList]}};

Arrow[{{0.0, 0.0}, 0.75*coordinateList[[1]]}],
Arrow[{{0.0, 0.0}, 0.6*coordinateList[[12]]}],
Transparent, EdgeForm[Directive[Thick]],


• so creative =D (+1)
– paw
Sep 27, 2014 at 0:12
• It's the new smartwatch. The numbers slither by your wrist ;D Sep 27, 2014 at 0:15
• @belisarius for it to be a smartwatch we need it to send personal data to Wolfram. Sep 27, 2014 at 14:50

For a constant angular speed watch, if you want some specific figures being placed at the corners, you have to adjust the aspect ratio of the dial rectangle.

A Graphics to begin with:

Manipulate[
{
Dashed, GrayLevel[.7],
InfiniteLine[{0, 0}, Through[{Cos, Sin}[π/6 #]]],
Dashing[{}], Black, Thick,
InfiniteLine[{0, 0}, Through[{Cos, Sin}[π/12 + π/6 #]]]
} & /@ Range[0, 5] //
Graphics[{#,
EdgeForm[{Black, Thick}], FaceForm[White],
Rectangle[##] & @@ (1/
2 {{-1, 1}, (Tan[π/6] + ε) {-1,
1}})
},
PlotRange -> {{-1, 1}, (Tan[π/6] + ε) {-1, 1}},
Frame -> True, FrameStyle -> Thick, FrameTicks -> None] &,
{{ε, 0}, -0.5, 10}]


With a proper grid, you can then use the transformation method from other answers to fill in good-looking figures.

• Haven't see you around for a long time! Welcome back! Sep 27, 2014 at 3:00
• @belisarius I'll be back! :D Sep 27, 2014 at 3:30

I think that the main problem here is the characteristic deformations of the numbers due to the square clock.

Here is my attempt to reproduce the shape of the "XI" in the first square clock !

First some initialisation :

num = Text[ Style["XI", FontFamily -> "Times New Roman", FontWeight -> Bold, FontSize -> 120]];
gnum = Rasterize[num, RasterSize -> 400];


then my interactive tool :

Manipulate[FindGeometricTransform[{{0, 0}, {1, 0}, {1, 1}, {0, 1}},
{{c1, 0}, {c2, 0}, {c3, h}, {c4, h}}, TransformationClass -> "Perspective"] //