11
$\begingroup$

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!

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

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

enter image description here

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

enter image description here

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

enter image description here

It can also work for the negative of the image:

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

enter image description here

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

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

enter image description here

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

enter image description here

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

enter image description here

$\endgroup$

Your Answer

By clicking "Post Your Answer", you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.