Around the Clock

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.


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.


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