# How to make a spiroglyphic?

Some (older) members of this group might remember playing vinyl LP records. Recently, at the Abbey Road studio there was a spiroglyphics coloring book for sale. It looks like a nice programming exercise using image processing—but I was wondering if anyone had already written code to turn pictures into a spiroglyphic? Indeed, it would be a nice built-in command!

• A start: r[θ_] := (.05 + .02 Sin[20 θ]); ParametricPlot[{(.1 θ - r[θ]) {Cos[θ], Sin[θ]}, {(.1 θ + r[θ]) {Cos[θ], Sin[θ]}}}, {θ], 0, 22 \[Pi]}] – David G. Stork Dec 19 '18 at 6:37
• mathematica.stackexchange.com/a/8693/219 – faleichik Dec 24 '18 at 13:37

### Update

getColoringLines =
ColorNegate@

getColoringLines@spiroglyph[testImg, .36, 25, {6, 2}]


### Original

Here's my initial attempt:

Clear[spiroglyph];
Options[spiroglyph] = Options[Rasterize];
spiroglyph[img_,
clipping : _?(0 < # < 1 &) : .1,
rots_Integer: 25,
thickGap : {_Integer, _Integer} : {10, 5},
mode : "Positive" | "Negative" : "Positive",
ops : OptionsPattern[]] :=
Module[
{
baseDims = ImageDimensions[img],
bw = ColorConvert[img, "Grayscale"],
mid,
sampleImage,
pr
},
mid = baseDims/2;
pr =
{
};
Binarize@
Rasterize[
ParametricPlot[
Sin[θ]}, {θ, 0, 2 π*rots},
Axes -> False,
PlotStyle ->
Directive[AbsoluteThickness[thickGap[[1]]], Black],
ImageSize -> baseDims,
PlotRange -> pr
],
ops
];
Binarize@
Rasterize[
ParametricPlot[
rots) ((θ + π)/(2 π))) {Cos[θ],
Sin[θ]}, {θ, 0, 2 π*rots},
Axes -> False,
PlotStyle ->
Directive[AbsoluteThickness[thickGap[[2]]], Black],
ImageSize -> baseDims,
PlotRange -> pr
],
ops
];
sampleImage =
Blend[
If[mode === "Positive",
],
.3
];
Binarize@
Rasterize[
ParametricPlot[
Evaluate@
If[mode === "Positive",
Sin[θ]},
rots) ((θ + π)/(2 π)) {Cos[θ],
Sin[θ]}
], {θ, 0, 2 π*rots},
Axes -> False,
PlotStyle -> Directive[AbsoluteThickness[1], Black],
ImageSize -> baseDims,
PlotRange -> pr
],
ops
];
(
MeanFilter[
Binarize[
sampleImage,
clipping
],
3
]


I basically use a bunch of tricks with ParametricPlot masks to try to get an image to imprint. It doesn't really pick up details well:

testImg = ExampleData[{"TestImage", "Mandrill"}]


spiroglyph[testImg, .36, 25, {6, 2}]


It can also work for the negative of the image:

spiroglyph[
ExampleData[{"TestImage", "F16"}], .35, 40, {8, 5}, "Negative"]


And you can play with all the parameters to try to improve things:

spiroglyph[
ExampleData[{"TestImage", "F16"}], .32, 60, {10, 3}, "Negative",
ImageResolution -> 200]


Oh and here's Elvis:

elvis =
ImageTake[#, ImageDimensions[#][[1]]] &@
Import[
"http://www.gstatic.com/tv/thumb/persons/1382/1382_v9_ba.jpg"];

spiroglyph[elvis, .2, 85, {4, 2}]


And another example on a much simpler test case:

spiroglyph[
ImageCrop[#, {Min@ImageDimensions[#], Min@ImageDimensions[#]}] &@
Import["https://i.etsystatic.com/13221305/r/il/e04597/1390417240/il_\
570xN.1390417240_lnh7.jpg"],
35,
{5, 1}
]


• Hello everyone I really want to make my own images, but I don't understand where to insert the code in the program! Write a sequence of actions for beginners 🙏 – Ирун Глупопун Apr 2 at 8:26