Around the Clock
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]
ImageCompose[sqc, ImageResize[ImagePad[i, 1], 140]]
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}}]
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}] &) /@
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)]
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]
]