(* Copyright 1988 Wolfram Research Inc. *)

(* One and Two Parameter 3D Plots *)

(* by Roman Maeder, modified by Yossi Friedman, Sha Xin Wei *)

BeginPackage["mma`utilities`ParametricPlot3D`"]

ParametricPlot3D::usage =
     "ParametricPlot3D[{x,y,z}, {u,u0,u1,(du)}, {v,v0,v1,(dv)}, (options..)]
	plots a 3D parametric surface. Options are passed to Show[]"

PointParametricPlot3D::usage =
  "PointParametricPlot3D[{x,y,z}, {u,u0,u1,(du)}, {v,v0,v1,(dv)}, (options..)]
	plots a two-parameter set of points in space.
	Options are passed to Show[]"

SpaceCurve::usage =
     "SpaceCurve[{x,y,z}, {u,u0,u1,(du)}, (options..)]
	plots a 3D parametric curve. Options are passed to Show[]"

PointSpaceCurve::usage =
     "PointSpaceCurve[{x,y,z}, {u,u0,u1,(du)}, (options..)]
	plots a one-parameter set of points in space.
	Options are passed to Show[]"

SphericalPlot3D::usage = "SphericalPlot3D[r, {theta-range}, {phi-range},
	(options...)] plots r as a function of the angles theta and phi."

CylindricalPlot3D::usage = "CylindricalPlot3D [r, {theta-range}, {z-range},
	(options...)] plots r as a function of the angle theta and height z."


Begin["`Private`"]

MakePolygons[vl_List] :=
    Block[{l = vl,
    	   l1 = Map[RotateLeft, vl],
    	   mesh},
	mesh = {l, RotateLeft[l], RotateLeft[l1], l1};
	mesh = Map[Drop[#, -1]&, mesh, {1}];
	mesh = Map[Drop[#, -1]&, mesh, {2}];
	Polygon /@ Transpose[ Map[Flatten[#, 1]&, mesh] ]
    ]


Attributes[ParametricPlot3D] = {HoldFirst}

ParametricPlot3D[ fun_,
		  ul:{_, u0_, u1_, du_},
		  vl:{_, v0_, v1_, dv_},
		  opts___] :=
	Show[Graphics3D[MakePolygons[Table[N[fun], ul, vl]]], opts] /;
			NumberQ[N[u0]] && NumberQ[N[u1]] && NumberQ[N[du]] &&
    			NumberQ[N[v0]] && NumberQ[N[v1]] && NumberQ[N[dv]]

ParametricPlot3D[fun_, {u_, u0_, u1_}, {v_, v0_, v1_}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	ParametricPlot3D[ fun,
			  {u, u0, u1, (u1-u0)/(plotpoints-1)},
			  {v, v0, v1, (v1-v0)/(plotpoints-1)},
			  opts ]
    ]

ParametricPlot3D[fun_, ulim:{_, _, _, _}, {v_, v0_, v1_}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	ParametricPlot3D[ fun,
			  ulim,
			  {v, v0, v1, (v1-v0)/(plotpoints-1)},
			  opts ]
    ]

ParametricPlot3D[fun_, {u_, u0_, u1_}, vlim:{_, _, _, _}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	ParametricPlot3D[ fun,
			  {u, u0, u1, (u1-u0)/(plotpoints-1)},
			  vlim,
			  opts ]
    ]


Attributes[PointParametricPlot3D] = {HoldFirst}

PointParametricPlot3D[ fun:{_, _, _},
		  ul:{_, u0_, u1_, du_},
		  vl:{_, v0_, v1_, dv_},
		  opts___] :=
	Show[ Graphics3D[Table[Point[N[fun]], ul, vl]], opts ] /;
			NumberQ[N[u0]] && NumberQ[N[u1]] && NumberQ[N[du]] &&
    			NumberQ[N[v0]] && NumberQ[N[v1]] && NumberQ[N[dv]]

PointParametricPlot3D[fun_, {u_, u0_, u1_}, {v_, v0_, v1_}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	PointParametricPlot3D[ fun,
		     {u, u0, u1, (u1-u0)/(plotpoints-1)},
		     {v, v0, v1, (v1-v0)/(plotpoints-1)},
		     opts ]
    ]

PointParametricPlot3D[fun_, ulim:{_, _, _, _}, {v_, v0_, v1_}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	PointParametricPlot3D[ fun,
		     ulim,
		     {v, v0, v1, (v1-v0)/(plotpoints-1)},
		     opts ]
    ]

PointParametricPlot3D[fun_, {u_, u0_, u1_}, vlim:{_, _, _, _}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	PointParametricPlot3D[ fun,
		     {u, u0, u1, (u1-u0)/(plotpoints-1)},
		     vlim,
		     opts ]
    ]


Attributes[SpaceCurve] = {HoldFirst}

SpaceCurve[ fun:{_, _, _}, ul:{_, u0_, u1_, du_}, opts___] :=
	Show[ Graphics3D[Line[Table[N[fun], ul]]], opts ] /;
			NumberQ[N[u0]] && NumberQ[N[u1]] && NumberQ[N[du]]

SpaceCurve[fun_, {u_, u0_, u1_}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	SpaceCurve[ fun, {u, u0, u1, (u1-u0)/(plotpoints-1)}, opts ]
    ]


Attributes[PointSpaceCurve] = {HoldFirst}

PointSpaceCurve[ fun:{_, _, _}, ul:{_, u0_, u1_, du_}, opts___] :=
	Show[ Graphics3D[Table[Point[N[fun]], ul]], opts ] /;
			NumberQ[N[u0]] && NumberQ[N[u1]] && NumberQ[N[du]]

PointSpaceCurve[fun_, {u_, u0_, u1_}, opts___] :=
    Block[{plotpoints},
    	plotpoints = PlotPoints /. {opts} /. Options[Plot3D];
	PointSpaceCurve[ fun, {u, u0, u1, (u1-u0)/(plotpoints-1)}, opts ]
    ]


Attributes[SphericalPlot3D] = {HoldFirst}

SphericalPlot3D[ r_, tlist:{theta_, __}, plist:{phi_, __}, opts___ ] :=
    Block[{rs},
      ParametricPlot3D[{(rs = r) Sin[theta] Cos[phi],
    			rs Sin[theta] Sin[phi],
    			rs Cos[theta]},
    		       tlist, plist, opts]
    ]

Attributes[CylindricalPlot3D] = {HoldFirst}

CylindricalPlot3D [ r_, tlist:{theta_, __}, zlist:{z_, __}, opts___ ] :=
    Block[{rs},
      ParametricPlot3D[{(rs = r) Cos[theta],
    			rs Sin[theta],
    			z},
    		       tlist, zlist, opts]
    ]

End[]

Protect[ParametricPlot3D, PointParametricPlot3D, SpaceCurve,
	PointSpaceCurve, SphericalPlot3D, CylindricalPlot3D]

EndPackage[]

Null
