
Needs["Graphics`ParametricPlot3D`"]
Needs["Graphics`Shapes`"]
Needs["Graphics`Polyhedra`"]
Needs["Graphics`ArgColors`"]

Needs["Graphics`ComplexMap`"]
Needs["ProgrammingExamples`RungeKutta`"]
Needs["ProgrammingExamples`RandomWalk`"]

(* Moebius transform *)

chapter1 := PolarMap[ (2#-I)/(#-1)&, {0, 5, 0.2}, {0, 2Pi, Pi/15} ]

(* Minimal surface *)

chapter2 :=
	ParametricPlot3D[{r*Cos[phi] - (r^2*Cos[2*phi])/2,
		-(r*Sin[phi]) - (r^2*Sin[2*phi])/2, (4*r^(3/2)*Cos[(3*phi)/2])/3},
		{r, 0.0001, 1, 0.9999/8}, {phi, 0, 4Pi, Pi/12}]

(* rotationally symmetric parametric surface *)

chapter3 :=
    ParametricPlot3D[
	{r Cos[Cos[r]] Cos[psi], r Cos[Cos[r]] Sin[psi], r Sin[Cos[r]]},
	{r, 0.001, 9Pi/2 + 0.001, Pi/16}, {psi, 0, 3Pi/2, Pi/16}]

(* Fractal tile *)

om7 = N[-1+Sqrt[-3]]/2; l7=om7-2
r7 = {0, 1,-1,om7,-om7,om7+1,-om7-1}
g7[x_] := Flatten[Outer[Plus, r7 , l7 x]]

chapter4 := 
	Module[{points, graph4},
		points = Point[{Re[#],Im[#]}]& /@ Nest[g7, {0.}, 5];
		graph4 = Graphics[Prepend[points, PointSize[0.003]]];
		Show[ graph4, AspectRatio -> 1, Axes -> None ]
	]

(* Sphere with random holes *)

chapter5 := Show[ Graphics3D[Select[Sphere[], Random[]>0.5&]] ]

(* Saddle surface *)

chapter6 := CylindricalPlot3D[r^2 Cos[2 phi],
		{r, 0, 1/2, 1/16}, {phi, 0, 2Pi, 2Pi/24}]

(* Van-der-Pol equation *)

chapter7 :=
	Module[{vdp, eps = 1.5, x, xdot},
		vdp = RungeKutta[{xdot, eps (1 - x^2) xdot - x}, {x, xdot},
		                 {2, 0}, {4Pi, 0.05}];
		ListPlot[vdp, PlotJoined -> True, AspectRatio -> Automatic]
	]


(* Fourier approximations of saw-tooth *)

l5 = Table[ Sum[Sin[i x]/i, {i, n}], {n, 5} ];

chapter9 := Plot[ Evaluate[l5], {x, -0.3, 2Pi+0.3} ]

(* spiral with varying radius *)

chapter10 :=
	ParametricPlot3D[{r (1 + phi/2) Cos[phi], r (1 + phi/2) Sin[phi], -phi/2},
		{r, 0.1, 1.1, 0.125}, {phi, 0, 11Pi/2, Pi/12}]

(* diagonally shaded surface *)

chapter11 :=
	SphericalPlot3D[ {Sin[theta],
		FaceForm[GrayLevel[0.05 + 0.9 Sin[2theta + phi]^2],
		         GrayLevel[0.05 + 0.9 Sin[2theta - phi]^2]]},
		{theta, 0, Pi, Pi/36}, {phi, 0, 3Pi/2, Pi/18},
		Lighting->False ]

(* Random walk *)

appendixA := RandomWalk[5000]

(* Minimal Surface II *)

appendixB :=  ParametricPlot3D[
	{(r^2*Cos[2*phi])/2 - Log[r], -phi - (r^2*Sin[2*phi])/2, 2*r*Cos[phi]},
        {r, 0.0004, 2.0004, 2.0/12}, {phi, -2Pi, 3Pi, 4Pi/90},
        ViewPoint->{-2.1, -1.1, 1.2}, PlotRange->All ]

(* Great icosahedron *)

appendixC := Show[ Polyhedron[GreatIcosahedron] ]

(* book cover: exponentially shrinking torus *)

torus[ R_, r_, psi_, phi_, h_ ] :=
	{ (R + r Cos[psi]) Cos[phi],
	  (R + r Cos[psi]) Sin[phi],
	  r Sin[psi],
	  FaceForm[ ColorCircle[h], ColorCircle[h, 0.6] ]
	}

Segment[ {phi0_, phi1_, dphi_}, {psi0_, psi1_, dpsi_} ] :=
	ParametricPlot3D[
		Evaluate[torus[1.2, Exp[-phi/(3Pi)], psi + phi/8, phi, psi-3Pi/4]],
		{phi, phi0, phi1, dphi}, {psi, psi0, psi1, dpsi},
		DisplayFunction->Identity ]

cover :=
 	Module[{glist, dphi = 2Pi/36, dpsi = 2Pi/32},
		glist = {Segment[{-Pi/4,    0, dphi}, {Pi/2, 2Pi, dpsi}],
		         Segment[{  0,  3Pi/2, dphi}, {0, 2Pi, dpsi}],
		         Segment[{3Pi/2,  2Pi, dphi}, {1Pi/4, 7Pi/4, dpsi}],
		         Segment[{2Pi,  7Pi/2, dphi}, {0, 2Pi, 2dpsi}],
		         Segment[{7Pi/2,  4Pi, dphi}, {0, 6Pi/4, 2dpsi}],
		         Segment[{4Pi, 11Pi/2, dphi}, {0, 2Pi, 4dpsi}],
		         Segment[{11Pi/2, 6Pi, dphi}, {-Pi/4, 5Pi/4, 4dpsi}],
		         Segment[{6Pi, 17Pi/2, dphi/2}, {0, 2Pi, 4dpsi}]};
		Show[ glist,
			Boxed -> False, Lighting -> False, PlotRange -> All,
			DisplayFunction -> $DisplayFunction ]
	]

(* cover of first edition: Maeder's shell *)

t0 = 0.001; t1 = N[ Pi - t0 ]
dt = (t1 - t0)/36; dp = N[ Pi/20 ]

part[t0_, phi0_, phi1_] := Block[{theta, phi},
	SphericalPlot3D[{Sin[theta] (2+Cos[phi/2]),
	                 FaceForm[ColorCircle[phi/2, 1], ColorCircle[phi/2, 0.7]]},
	                {theta, t0, t1, dt}, {phi, phi0, phi1, dp},
	                DisplayFunction -> Identity]
	]

cover1 :=
	Module[{glist},
		glist = {part[t0, 0, 3Pi/2],     part[Pi/2, 3Pi/2, 4Pi/2],
		         part[t0, 4Pi/2, 7Pi/2], part[Pi/2, 7Pi/2, 8Pi/2]};
		Show[ glist, Boxed -> False, Lighting -> False,
		      DisplayFunction -> $DisplayFunction ]
	]
