Mathematica code for an interactive julia set explorer

Julia Zoomer

quadrant = Switch[{#2[[1]]-#1[[1]], #2[[2]]-#1[[2]]},
				{_?Positive, _?Positive}, {1, 1},					
				{_?Negative, _?Positive}, {-1, 1},					
				{_?Positive, _?Negative}, {1, -1},					
				_, {-1,-1}
			] * Abs /@ {#2[[1]]-#1[[1]], #2[[1]]-#1[[1]]}&;

julia = Compile[{{z,_Complex}}, 
	Length[FixedPointList[Tan[#^3+2.0625+0.15 I]&, z, 250, SameTest->(Abs[#]>2&)]],
	RuntimeAttributes->{Listable}, Parallelization->True, CompilationTarget->"C"
];

Options[juliaPlot] = Options[DensityPlot];
juliaPlot[{xmin_:-3, xmax_:3}, {ymin_:-3, ymax_:3}, opts:OptionsPattern[]] := 
	DensityPlot[Log @ Julia[x + I y], {x, xmin, xmax}, {y, ymin, ymax},
		##
		]&[opts, {PlotPoints -> 10, Mesh -> False, Frame -> False, ImageSize -> 500,
		ColorFunction -> "AvocadoColors", PerformanceGoal -> "Speed"}]

Options[juliaZoom] = Options[juliaPlot];
juliaZoom[] := Module[
	{g, graph, options, plotrange, rect, sqr},
	
	g = juliaPlot[{-3,3}, {-3,3}];
	graph = First[g]; options = DeleteCases[Options[g], PlotRange->_];
	plotrange = PlotRange /. Options[g, PlotRange];
	rect = {Thickness[Medium], White, Dashing[Small], Line[{#1, 
		{First[#2], Last[#1]}, #2, {First[#1], Last[#2]}, #1}]}&;
	sqr = {EdgeForm[{Thickness[Medium],White, Dashing[Small]}], FaceForm[None], 
		Rectangle[#1, #1 + quadrant[#1, #2]]}&;

	DynamicModule[{drag, first, second, range, sqrQ, plotpoints, performance, stack, color},
		sqrQ = True; drag = False; range = plotrange; performance = "Speed";
		color = "AvocadoColors"; plotpoints = 30; stack = {plotrange};
		Panel @ Column[{
			Row[{"1:1",
				Checkbox[Dynamic[sqrQ]], Spacer[5],
				SetterBar[Dynamic[performance], {"Speed", "Quality"}], Spacer[15],
				Slider[Dynamic[plotpoints], {10, 200, 5}, Appearance -> "Labeled"], Spacer[5],
				PopupMenu[Dynamic[color], Rule[#, 
					ColorData[#, "Image"]]& /@ RotateLeft[ColorData["Gradients"], 5], ImageSize -> 100]
				}],
			EventHandler[
				Dynamic[
					g = juliaPlot[##, ColorFunction -> color, PerformanceGoal -> performance,
						PlotPoints -> plotpoints]& @@ range; graph = First[g];
					Graphics[
						If[drag,
							{graph, If[sqrQ, sqr[first, second], rect[first, second]]},
							graph
						], PlotRange -> range, ImageSize -> 500]
				],
				{
					{"MouseDown", 1} :> (first = MousePosition["Graphics"]),
					{"MouseDragged", 1} :> (drag = True; second = MousePosition["Graphics"]),
					{"MouseUp", 1} :> If[drag, 
						drag = False; 
						If[sqrQ, 
							range = Transpose @ {first, first + quadrant[first, second]},
							range = Transpose @ {first, second};
						]; PrependTo[stack, range];
						, 
						If[Length[stack] != 1, stack = Drop[stack, 1]; range = First[stack]]	
					]
				}
			]
		}]
	]
]

juliaZoom[]