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."
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]
]
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:
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}]}]
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.
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}}]
You can play with the slider to change the shape.
You just need to modify the initialisation to try with some other number.
Import["https://i.sstatic.net/6ErpY.jpg"]-- :D ;P $\endgroup$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$