oftenpaper.net

When I was young my parents bought me a Spirograph set at the flea market. I wasted lots and lots of paper with it. A modern tree-friendly rendition:

1. 
2. 
3. 
4. 
5. 
6. 

7. 
   
   
   
   
   Manipulate[
    Module[{
      (* non-integer values of \[Zeta] give progressively more entwined paths, 
      but require smaller cycle widths to keep the plot from looking scrambled *)
      \[Psi] = Round[Abs[FractionalPart[\[Zeta]]]*1., .25] /. {
         0. -> y,
         .5 -> y/2,
         .25 | .75 -> y/4}},
   
     ParametricPlot[
   
      (1. + spirality*(Log[\[Theta] + 1.] - 1.))*
       {\[Psi] Cos[\[Theta]] + x  Cos[64. \[Theta]] + (1 - effect*RandomReal[])*\[Zeta]* (Cos[512. \[Theta]] + Cos[64. \[Zeta] \[Theta]]),
        \[Psi] Sin[\[Theta]] - x Sin[64. \[Theta]] + (1 - effect*RandomReal[])* inflection*\[Zeta]* (Sin[512. \[Theta]] + Sin[64. \[Zeta] \[Theta]])}
   
      , {\[Theta], 0, 2 \[Pi]},
   
      ImageSize -> {470, 410},
      PerformanceGoal -> "Quality",
   
      (* reduced opacity helps bring the shape out and gives an elegant tone *)
      PlotStyle -> {{color, Opacity[.43], AbsoluteThickness[thickness]}},
      PlotRange -> Full,
       PlotPoints -> 270,(* increase for higher-resolution images *)
      Axes -> None]],
   
    OpenerView[{"Style", Column[{
        Control@{{color, Black, "line color"}, ColorSlider},
        Column@{
          (* these controls are smallerized for consistency *)
          Control@{{thickness, 0., "line thickness"}, 0, 20, Appearance -> "Labeled", ImageSize -> Small},
          Control@{{effect, 0., "charcoal effect"}, 0, .25, Appearance -> "Labeled", ImageSize -> Small}}}]}],
   
    Row[{
      Control@{{inflection, 1}, {1 -> " concave ", -1 -> " convex "}, Appearance -> "Vertical"},
   
      Spacer[30],
   
      Column@{
        Control@{{\[Zeta], 2., "angularity"}, -7.5, 7.5, .5, Appearance -> "Labeled", ImageSize -> Small},
        Control@{{x, 8., "tension"}, 0, 12, Appearance -> "Labeled", ImageSize -> Small}},
   
      Column@{
        Control@{{y, 2., "cycle width"}, 0, 2, ImageSize -> Tiny},
        Control[{{spirality, 0.}, 0, 1, ImageSize -> Tiny}]}
   
      }],
   
    Alignment -> Center,
    SynchronousUpdating -> False,
    AppearanceElements -> "ManipulateMenu",
   
    Bookmarks -> {
   
      (* this bookmark assigns random values to the factors.
      I intentionally didn't make this feature rapid-fireable *)
      "Random" :> (
        color = RGBColor[RandomReal[], RandomReal[], RandomReal[]];
        inflection = RandomChoice[{1, -1}];
   
        (* effect, thickness, and spirality have distributions that make
        small values smaller and large values rarer [you mean "power law" -- future version of myself]*)
        effect = .25*RandomReal[]^8;
        thickness = 10*RandomReal[]^8;
        spirality = RandomReal[]^3;
   
        If[spirality < .035, spirality = 0];
   
        x = RandomReal[]*12;
        y = RandomReal[]*2;
   
        Module[{
          (* +/- .5 are generally not interesting when x > 3 *)
          weights = If[x > 3, {.1, .03, .87}, {.1, .07, .83}]},
         \[Zeta] = RandomChoice[{-1, 1}]*RandomChoice[weights ->
             {RandomReal[7.5], (* small chance to fall on non-integral \[Zeta] *)
              RandomChoice[{0, .5, .5}],(* multiple .5 isn't a typo *)
              Round[RandomReal[{1, 7.5}], .5]}]];
        ),
   
      "Rose" :> {thickness = 0, color = Red, effect = 0, inflection = -1, x = 0, y = 1.1343, spirality = 0, \[Zeta] = 3},
      "Glyph" :> {thickness = 0, color = Black, effect = 0.198, inflection = 1, x = 5.2, y = 0., spirality = 0, \[Zeta] = 2},
      "Mass Atomic" :> {thickness = 0, effect = 0, inflection = -1, x = 5.84, y = 0.412, spirality = 0, \[Zeta] = -4.2504},
      "Jello" :> {thickness = 0, color = Red, effect = 0, inflection = -1, x = 12., y = 0.846, spirality = 1., \[Zeta] = -1.},
      "Grim" :> {thickness = 3.35, color = Black, effect = 0.0675, inflection = 1, x = 8., y = 0.296, spirality = 1., \[Zeta] = -1.},
      "Angelwings" :> {color = RGBColor[0.07693598840314336, 0.39046311131456474, 1], effect = 0, inflection = 1, spirality = 1.`, thickness = 0, x = 12, y = 0, \[Zeta] = -5.4946511679431715`},
      "Rollers" :> {color = RGBColor[0.`, 0.`, 0.`], effect = 0.`, inflection = -1, spirality = 0.`, thickness = 0.`, x = 5.5`, y = 0.1`, \[Zeta] = -0.984032039033508`},
      "Lifespark" :> {color = RGBColor[0.1026, .9878, .0201], effect = 0, inflection = 1, spirality = .0995, x = 3.2757, y = .2002, \[Zeta] = -5.5}
      }
    ]
   
   
   
   
   
   

I'm particularly proud of this program because it can produce a wide variety of images from just a few parameters. Though that's not an accident. A lot of fine-tuning and experimentation was involved. For the "Super Mario 64" to this program's "Super Mario," see my Cycowtron 4800 Deluxe.