How to make a spiroglyphic?

Question

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!

Answer 1

Update

In case your want to get your coloring on:

getColoringLines = 
  ColorNegate@
    GradientFilter[ImportString[ExportString[#, "PNG"], "PNG"], 1] &;
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],
   diskRadius,
   bw = ColorConvert[img, "Grayscale"],
   baseMask,
   mask,
   clipMask,
   mid,
   sampleImage,
   gapMask,
   minMask,
   pr
   },
  diskRadius = Min[baseDims];
  mid = baseDims/2;
  pr =
   {
    {-diskRadius, diskRadius}, 
    {-diskRadius, diskRadius}
    };
  baseMask =
   Binarize@
    Rasterize[
     ParametricPlot[
      (diskRadius/rots) (θ/(2 π)) {Cos[θ], 
        Sin[θ]}, {θ, 0, 2 π*rots},
      Axes -> False,
      PlotStyle -> 
       Directive[AbsoluteThickness[thickGap[[1]]], Black],
      ImageSize -> baseDims,
      PlotRangePadding -> Scaled[.01],
      PlotRange -> pr
      ],
     ops
     ];
  mask = ImageResize[baseMask, baseDims];
  gapMask =
   Binarize@
    Rasterize[
     ParametricPlot[
       ((diskRadius/
           rots) ((θ + π)/(2 π))) {Cos[θ], 
        Sin[θ]}, {θ, 0, 2 π*rots},
      Axes -> False,
      PlotStyle -> 
       Directive[AbsoluteThickness[thickGap[[2]]], Black],
      ImageSize -> baseDims,
      PlotRangePadding -> Scaled[.01],
      PlotRange -> pr
      ],
     ops
     ];
  gapMask = ImageResize[gapMask, baseDims];
  If[mode === "Positive", {mask, gapMask} = {gapMask, mask}];
  sampleImage =
   Blend[
    If[mode === "Positive",
     {bw, ColorNegate@mask},
     {ColorNegate@bw, mask}
     ], 
    .3
    ];
  minMask =
   Binarize@
    Rasterize[
     ParametricPlot[
      Evaluate@
       If[mode === "Positive",
        (diskRadius/rots) (θ/(2 π)) {Cos[θ], 
          Sin[θ]},
        (diskRadius/
           rots) ((θ + π)/(2 π)) {Cos[θ], 
          Sin[θ]}
        ], {θ, 0, 2 π*rots},
      Axes -> False,
      PlotStyle -> Directive[AbsoluteThickness[1], Black],
      ImageSize -> baseDims,
      PlotRangePadding -> Scaled[.01],
      PlotRange -> pr
      ],
     ops
     ];
  minMask = ImageResize[minMask, baseDims];
  (
    MeanFilter[
      Binarize[
       sampleImage,
       clipping
       ],
      3
      ] + gapMask
    )*minMask
  ]

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