20
$\begingroup$

I want to produce with Mathematica something like this

enter image description here

Or this

enter image description here

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."

$\endgroup$
  • 3
    $\begingroup$ You're late stackoverflow.com/q/8187378/353410 $\endgroup$ – Dr. belisarius Sep 26 '14 at 20:03
  • 1
    $\begingroup$ @belisarius But my question concerns "rectangular clocks", not the "trivial" round ones. Should I delete it? $\endgroup$ – eldo Sep 26 '14 at 20:14
  • $\begingroup$ Yup. Twas a joke :) $\endgroup$ – Dr. belisarius Sep 26 '14 at 20:33
  • 5
    $\begingroup$ This seems to work: Import["http://i.stack.imgur.com/6ErpY.jpg"] -- :D ;P $\endgroup$ – Michael E2 Sep 26 '14 at 21:00
  • 2
    $\begingroup$ 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. $\endgroup$ – Michael E2 Sep 26 '14 at 21:17
21
$\begingroup$

A square clock in base 12:

enter image description here

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]

Mathematica graphics

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]

ImageCompose[sqc, ImageResize[ImagePad[i, 1], 140]]

Mathematica graphics


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}];
StartScheduledTask[t];
While[MatchQ[ ScheduledTasks[], {ScheduledTaskObject[_, _, _, _, True]}], Pause[1]];
RemoveScheduledTask[ScheduledTasks[]];
Export["c:\\test.gif", b, "DisplayDurations" -> 1]

The resulting file is the first gif in the post.

$\endgroup$
  • $\begingroup$ 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 :) $\endgroup$ – eldo Sep 27 '14 at 18:49
  • $\begingroup$ @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 ... $\endgroup$ – Dr. belisarius Sep 28 '14 at 4:36
  • $\begingroup$ "A blasphemous man suggested that all men should juggle letters and symbols until they constructed, by an improbable gift of chance, these canonical books." $\endgroup$ – eldo Sep 28 '14 at 10:13
  • $\begingroup$ @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). $\endgroup$ – Robert Jul 13 '17 at 2:27
19
$\begingroup$

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

enter image description here

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}] &) /@
  MapThread[
   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)]

Blockquote

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

Blockquote

$\endgroup$
  • 2
    $\begingroup$ Very very nice - Almost like a Cartier :) $\endgroup$ – eldo Sep 27 '14 at 13:43
  • $\begingroup$ @eldo the problem with multichar hour marks is the difficulty in getting the right angular position. Hence my "base12" clock :) $\endgroup$ – Dr. belisarius Sep 29 '14 at 17:15
18
$\begingroup$

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

enter image description here

Some stuff is stolen from this terrible article.

$\endgroup$
7
$\begingroup$

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;
radiusX = 1;
radiusY = 0.7;
thetaList = Rest@Range[2 Pi, 0, -2 Pi/hours] + Pi/2;
coordinateList = {radiusX*Cos@#, radiusY*Sin@#} & /@ thetaList;
Graphics[{
  FontFamily -> "Times New Roman", FontSize -> 30, 
  Rotate~MapThread~{Text~
     MapThread~{IntegerString[Range@hours, "Roman"], coordinateList}, 
    Abs[-Pi/2 + thetaList]},
  Black, Thickness[0.008], Arrowheads[Large], 
  Arrow[{{0, 0}, 0.75*coordinateList[[1]]}],
  Black, Thickness[0.008], Arrowheads[Large], 
  Arrow[{{0, 0}, 0.6*coordinateList[[12]]}],
  Transparent, EdgeForm[Directive[Thick]], 
  Rectangle[{-1.2*radiusX, -1.2*radiusY}, {1.2*radiusX, 1.2*radiusY}]
}]

Which produces:

enter image description here

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;
radiusX = 1;
radiusY = 0.7;
thetaList = Rest@Range[2 Pi, 0, -2 Pi/hours] + Pi/2;
coordinateList = {radiusX*Cos@#, radiusY*Sin@#} & /@ thetaList;

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, 
   Rotate~MapThread~{GeometricTransformation~
      MapThread~{Text~
        MapThread~{IntegerString[Range@hours, "Roman"], 
         coordinateList}, shearingList}, Abs[-Pi/2 + thetaList]}};

Graphics[{rotatedText, Black, Thickness[0.008], Arrowheads[Large], 
  Arrow[{{0.0, 0.0}, 0.75*coordinateList[[1]]}],
  Black, Thickness[0.008], Arrowheads[Large], 
  Arrow[{{0.0, 0.0}, 0.6*coordinateList[[12]]}],
  Transparent, EdgeForm[Directive[Thick]], 
  Rectangle[{-1.2*radiusX, -1.2*radiusY}, {1.2*radiusX, 
    1.2*radiusY}]}]

enter image description here

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

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

dial rectangle

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

$\endgroup$
  • $\begingroup$ Haven't see you around for a long time! Welcome back! $\endgroup$ – Dr. belisarius Sep 27 '14 at 3:00
  • $\begingroup$ @belisarius I'll be back! :D $\endgroup$ – Silvia Sep 27 '14 at 3:30
3
$\begingroup$

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"] //
 ImageTransformation[gnum, #[[2]], 300, Padding -> padcolor] &,
 {{c1,0.346}, 0., 0.9}, {{c2, 0.882}, 0.50, 1}, {{c3, 0.75}, 0., 1}, {{c4, 0}, 0.0, 1}, 
{{h, 0.875}, -1, 2}, {padcolor, {0, 1}}]

enter image description here

You can play with the slider to change the shape.

You just need to modify the initialisation to try with some other number.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.