
(* :Title: Graphics3D *)

(* :Author: Wolfram Research, Inc. *)

(* :Summary: Additional 3D Graphics functions *)

(* :Context: Graphics`Graphics3D` *)

(* :Package Version 1.0 *)

(* :Mathematica Version 2.0 *)

(* :History:
	Created March, 1991 by John M. Novak. A collection of functions
	originally intended for Graphics.m by Michael Chan and Kevin McIsaac,
	with modifications by Bruce Sawhill and ECM.  Modifications to Project
	and Shadow by John M. Novak.
*)

(* :Keywords:
	Graphics, 3D, Surface, Project, Shadow
*)

(* :Warning: Adds definition to the function Graphics3D. *)

BeginPackage["Graphics`Graphics3D`",
		"Calculus`VectorAnalysis`",
		"Utilities`FilterOptions`"]

ScatterPlot3D::usage = 
"ScatterPlot3D[{{x1, y1, z1}, ...}, (options)] plots points in three 
dimensions as a scatter plot.";

ListSurfacePlot3D::usage =
"ListSurfacePlot3D[{{{x11, y11, z11}, ...},{{x12, y12, z12}, ...}, (options)]
plots a matrix of points in three dimensions as a surface." ;

ShadowPlot3D::usage =
"ShadowPlot3D[f, {x, xmin, xmax}, {y, ymin, ymax}] plots the function f over
the the x and y ranges with polygons shaded according to the height of the
surface, with a projection of the surface onto the xy plane.";

(* The Color option determines whether the plot is in color or gray scale.
SurfaceMesh determines whether a mesh is drawn on the surface.
ShadowMesh determines whether a mesh is drawn on the projection.
SurfaceMeshStyle determines the style of the mesh on the surface.
ShadowMeshStyle determines the style of the mesh on the projection.
ShadowPosition determines the location of the projection. *)

Color::usage = 
"Color is an option for ShadowPlot3D and ListShadowPlot3D, which determines
whether the plot should be drawn in color.";

SurfaceMesh::usage =
"SurfaceMesh is an option for ShadowPlot3D and ListShadowPlot3D, which
determines whether a mesh is drawn on the surface.";

ShadowMesh::usage =
"ShadowMesh is an option for ShadowPlot3D and ListShadowPlot3D, which determines
whether a mesh is drawn on the projection.";

SurfaceMeshStyle::usage =
"SurfaceMeshStyle is an option for ShadowPlot3D and ListShadowPlot3D, which
defines the style of the mesh on the surface.";

ShadowMeshStyle::usage =
"ShadowMeshStyle is an option for ShadowPlot3D and ListShadowPlot3D, which
defines the style of the mesh on the projection.";

ShadowPosition::usage =
"ShadowPosition is an option for ShadowPlot3D and ListShadowPlot3D, which
determines whether the projection is above or below the surface (in the
positive or negative z direction).";

ListShadowPlot3D::usage =
"ListShadowPlot3D[array, (opts)] generates a surface representing an array of
height values with polygons shaded according to the height of the surface and a
projection of the surface onto the xy plane.";

Project::usage = 
"Project[graphic, point] projects an image of the graphic onto a plane
perpendicular to the line from the center of the graphic to point.
Project[graphic, {e1, e2}, point] projects an image of the graphic onto a plane
with basis vectors {e1, e2} at point, along the line from the origin to point.
Project[graphic, {e1,e2},point,center] project as before, except along the
line from center to point.  The projection is as seen from Infinity.";

Shadow::usage = 
"Shadow[graphic, (opts)] projects images of the graphic onto the xy, xz, and yz
planes.  Options XShadow, YShadow, ZShadow, XShadowPosition, YShadowPosition,
and ZShadowPosition determine which projections are shown and where they are
located.  The magnitude of the positions is scaled so that 1 is the width
of the plot on the given axis; it is measured from the center of the
plot.";

XShadow::usage =
"XShadow is an option for Shadow that determines whether to draw a
projection of the graphic in the x direction.";

YShadow::usage =
"YShadow is an option for Shadow that determines whether to draw a
projection of the graphic in the y direction.";

ZShadow::usage =
"ZShadow is an option for Shadow that determines whether to draw a
projection of the graphic in the z direction.";

XShadowPosition::usage = 
"XShadowPosition is an option for Shadow that determines whether the
projection of the graphic in the x directions is in the positive or negative x
direction.";

YShadowPosition::usage = 
"YShadowPosition is an option for Shadow that determines whether the
projection of the graphic in the y directions is in the positive or negative y
direction.";

ZShadowPosition::usage = 
"ZShadowPosition is an option for Shadow that determines whether the
projection of graphic in the z directions is in the positive or negative z
direction.";

BarChart3D::usage =
"BarChart3D[list, opts] creates a three-dimensional bar graph of the 
rectangular matrix list.  BarChart3D[{{{z, style},..}..},opts] creates a bar
graph with a specific style for each bar.  BarChart3D[{{{x, y, z}, style}..}] 
creates a bar graph of bars scattered at specific x and y coordinates with
height z and a specific style.";

(* The XSpacing and YSpacing options control the space between bars in the
X and Y directions respectively.  SolidBarEdges and SolidBarEdgeStyle are
options determining the style of the edges of the cuboids making up the bars
of the bar chart.  SolidBarStyle is a style for the faces of the cuboids.
The odd naming convention is to avoid shadowing similar options in Graphics.m.
BarChart3D also accepts all options valid for Graphics3D. *)

XSpacing::usage =
"XSpacing is an option for BarChart3D, which determines the amount of space
between bars in the X direction.  XSpacing may be set to any real number
between 0 and 1.";

YSpacing::usage =
"YSpacing is an option for BarChart3D, which determines the amount of space
between bars in the Y direction.  YSpacing may be set to any real number
between 0 and 1.";

SolidBarEdges::usage =
"SolidBarEdges is an option for BarChart3D, which determines whether the edges
of the bars are drawn.";

SolidBarEdgeStyle::usage =
"SolidBarEdgeStyle is an option for BarChart3D, which determines the style of
the edges of the bars.";

SolidBarStyle::usage = 
"SolidBarStyle is an option for BarChart3D, which determines the style of the
faces of the bars.";

StackGraphics::usage =
"StackGraphics[{g1, g2, ...}] generates a Graphics3D object corresponding to a
\"stack\" of two-dimensional graphics objects.";

TransformGraphics3D::usage =
"TransformGraphics3D[graphics3d, f] applies the function f to all lists of
coordinates in graphics3d.";

SkewGraphics3D::usage = 
"SkewGraphics3D[graphics, m] applies the matrix m to all coordinates in graphics.";

Graphics3D::usage =
"Graphics3D[primitives, options] represents a three-dimensional graphic
image.  Graphics3D[graphics] projects a two-dimensional graphic image into
a three-dimensional graphic image."; 

Begin["`Private`"]

(* Define a better NumberQ *)

numberQ[x_] := NumberQ[N[x]]

(* Unit vector in the vec direction *)

normalize[vec:{_,_,_}] :=
	vec/Sqrt[Apply[Plus,vec^2]]

(* BarChart3D *)

BarChart3D::badxspacing = "XSpacing must be between 0 and 1.";

BarChart3D::badyspacing = "YSpacing must be between 0 and 1.";

Options[BarChart3D] =  {XSpacing -> 0, YSpacing -> 0,SolidBarEdges->True,
	SolidBarEdgeStyle->Graylevel[0],SolidBarStyle->GrayLevel[.5]} ~Join~
	Options[Graphics3D];

BarChart3D[list:{{_?numberQ..}..}, opts___] :=
	BarChart3D[Flatten[Table[{{x,y,list[[x,y]]},
				  SolidBarStyle/.{opts}/.Options[BarChart3D]},
				 {x,Length[list]},
				 {y,Length[Transpose[list]]}
				],1],opts]

BarChart3D[list:{{{_?numberQ,_}..}..}, opts___] :=
	BarChart3D[Flatten[Table[{{x,y,list[[x,y,1]]},
				  list[[x,y,2]]},
				 {x,Length[list]},
				 {y,Length[Transpose[list]]}
				],1],opts]

BarChart3D[list:{{{_?numberQ,_?numberQ,_?numberQ},_}...},opts___] :=
	Module[{x,y,xs,ys,xspacing,yspacing,boxopts,g3dopts,list1},
		xspacing = XSpacing /. {opts} /. Options[BarChart3D];
		If[xspacing>1 || xspacing<0,
			(Message[BarChart3D::badxspacing];xspacing=0)];
		yspacing = YSpacing /. {opts} /. Options[BarChart3D];
		If[yspacing>1 || yspacing<0,
			(Message[BarChart3D::badyspacing];yspacing=0)];
		If[TrueQ[SolidBarEdges/.{opts}/.Options[BarChart3D]],
			edges = EdgeForm[SolidBarEdgeStyle/.{opts}/.Options[BarChart3D]],
			edges = EdgeForm[]];
  g3dopts = Select[Flatten[{opts}],
			(MemberQ[Map[First, Options[Graphics3D]], First[#]])&];
  xs = (1-xspacing)/2;
  ys = (1-yspacing)/2;
  list1 = Transpose[Map[#[[1]]&,list]];
  Show[
   		Graphics3D[Map[Flatten[{#[[2]],edges,
   				Cuboid[{#[[1,1]]-xs, #[[1,2]]-ys, 0},
				   	{#[[1,1]]+xs, #[[1,2]]+ys, #[[1,3]]}]
				      }]&,
			    list]],
		   Flatten[{g3dopts,
			   BoxRatios->{1,1,1},
			   PlotRange->{{Min[list1[[1]]]-.5, Max[list1[[1]]]+.5},
				       {Min[list1[[2]]]-.5, Max[list1[[2]]]+.5},
				       All},
			   Axes->Automatic,
			  	Ticks->{Automatic,Automatic,Automatic}}]
		]
	]                                        

(* ScatterPlot3D *)

Options[ScatterPlot3D] = {PlotJoined->False}

ScatterPlot3D[l3:{{_, _, _}..}, opts___] :=
	If[(PlotJoined /. {opts} /. Options[ScatterPlot3D]),
		Show[Graphics3D[Line[l3]], FilterOptions[ Graphics3D, opts]],
		Show[Graphics3D[Map[Point,l3]], FilterOptions[ Graphics3D, opts]]
	]

(* Make Polygons from ParametricPlot3D.m by Roman Maeder.
		Used in ListSurfacePlot. *)

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

(* ListSurfacePlot3D *)

ListSurfacePlot3D[t3_List, opts___] :=
	Show[Graphics3D[MakePolygons[t3]], opts] 

(* Modified MakePolygon, used in ShadowPlot3D *)

MakePolygonCoords[vl_List] :=
    Module[{l = vl,
    	   l1 = Map[RotateLeft, vl],
    	   mesh},
	mesh = {l, l1, RotateLeft[l1], RotateLeft[l]};
	mesh = Map[Drop[#, -1]&, mesh, {1}];
	mesh = Map[Drop[#, -1]&, mesh, {2}];
	Transpose[ Map[Flatten[#, 1]&, mesh] ]
    ]

(* ShadowPlot3D *)

Options[ShadowPlot3D] = 
	{PlotPoints->15, Color->True, SurfaceMesh->True,
		SurfaceMeshStyle -> RGBColor[0,0,0],
		ShadowMesh -> True, 
		ShadowMeshStyle -> RGBColor[0,0,0],
		ShadowPosition -> -1};

ShadowPlot3D[func_, {u_, umin_, umax_},  {v_, vmin_, vmax_}, opts___] :=
	Module[{plotpoints = PlotPoints /. {opts} /. Options[ShadowPlot3D]},
		SP0[MakePolygonCoords[
			Table[N[{u, v, func}],
				{u,umin,umax,(umax-umin)/plotpoints},
				{v,vmin,vmax,(vmax-vmin)/plotpoints}]],
			Flatten[{{opts},Options[ShadowPlot3D]}]]]
		

(* ListShadowPlot3D *)

Options[ListShadowPlot3D] = 
	{Color -> True, SurfaceMesh->True, 
	SurfaceMeshStyle -> RGBColor[0,0,0],
	ShadowMesh -> True,
	ShadowMeshStyle -> RGBColor[0,0,0],
	ShadowPosition -> -1};

ListShadowPlot3D[list_, opts___] :=
	SP0[MakePolygonCoords[
			Table[{x, y, N[list[[x,y]]]},
				{x,Length[Transpose[list]]},
				{y,Length[list]}]],
		Flatten[{{opts},Options[ListShadowPlot3D]}]]

SP0[list_, opts___] :=
	Module[{gopts, z, zmin, zmax, zrange, zshadow, shades,
			color, surfacemesh, surfacemeshstyle, 
			shadowmesh, shadowmeshstyle, pos, g},
		gopts = Select[Flatten[{opts}], 
			(MemberQ[Map[First, Options[Graphics3D]], 
				First[#]])&];
		{color, surfacemesh, surfacemeshstyle, shadowmesh,
			 shadowmeshstyle, pos} = 
			{Color, SurfaceMesh, SurfaceMeshStyle, 
				ShadowMesh, ShadowMeshStyle, 
				ShadowPosition} /. opts;
		z = Map[#[[3]]&,list,{-2}];
		{zmin, zmax} = {Min[z], Max[z]};
		zrange = zmax - zmin;
		zshadow = If[!TrueQ[pos == -1],
					zmax + zrange/2,
					zmin - zrange/2];
		shades = 
		   If[color,
			Map[Hue[#]&,
		  		(Apply[Plus,z,{-2}]/4 - zmin)/zrange],
		  	Map[GrayLevel[#]&,
		  		(Apply[Plus,z,{-2}]/4 - zmin)/zrange]];
		g = Transpose[{shades,Polygon /@ list}];
		Show[
			Graphics3D[
				{If[TrueQ[surfacemesh],
					EdgeForm[surfacemeshstyle],EdgeForm[]],
				 g,
				 If[TrueQ[shadowmesh],
					EdgeForm[shadowmeshstyle],EdgeForm[]]}
				  ],
			TransformGraphics3D[ Graphics3D[g],
				             {#[[1]],#[[2]],zshadow}& ],
			Flatten[{gopts, Lighting->False, BoxRatios->{1,1,1}}]
		    ]
	 ]

(* TransformGraphcs3D *)

TransformGraphics3D[Graphics3D[list_, opts___], f_] :=
	Graphics3D[
		list /. {Line[x_] :> Line[Map[f, x]],
			Polygon[x_] :> Polygon[Map[f, x]],
			Point[x_] :> Point[f[x]]}, {opts}]

(* SkewGraphics3D *)

SkewGraphics3D[g_Graphics3D, m_?MatrixQ] :=
	TransformGraphics3D[g, (m . #)&]

(* Project *)

Project[g_Graphics3D, point:{_,_,_}] :=
	Module[{p1, p2, t1, t2, t3, b1, b2,c},
		p1 = PlotRange[g];
		c = Map[((#[[1]] + #[[2]])/2)&,p1];
		p2 = point-c;
		t1 = If[TrueQ[(t2 = CrossProduct[{0,0,1},p2]) == {0,0,0}],
				CrossProduct[{0,1,0},p2],t2];
		b1 = normalize[t1];
		t3 = CrossProduct[p2,b1];
		b2 = normalize[t3];
		Project[g,{b1,b2},point,c]]

Project[g_Graphics3D, basis:{{_,_,_},{_,_,_}}, location:{_,_,_},
          Optional[center:{_,_,_},{0,0,0}]] :=
	TransformGraphics3D[g,
		(Apply[Plus, (basis.(# - center)) basis] + location)&]

Project[g_,everything___] := Project[Graphics3D[g],everything]

(* Shadow *)

Options[Shadow] = 
	{XShadow -> True, YShadow -> True, ZShadow -> True,
	XShadowPosition -> -1, YShadowPosition -> 1,
	ZShadowPosition -> -1};

Shadow[g_Graphics3D, opts___] :=
	Module[{xmin, xmax, ymin, ymax, zmin, zmax, xshadow, 
			yshadow, zshadow, xshadowposition, 
			yshadowposition, zshadowposition,
			image,br},
		{xshadow, yshadow, zshadow, xshadowposition, 
			yshadowposition, zshadowposition} = 
			{XShadow, YShadow, ZShadow, XShadowPosition,
			 YShadowPosition, ZShadowPosition} /. {opts} /.
			 	Options[Shadow];
		gopts = Select[Flatten[{opts}], 
			(MemberQ[Map[First, Options[Graphics3D]], 
				First[#]])&];
		{xmin, xmax, ymin, ymax, zmin, zmax} = 
			Flatten[PlotRange[g]];
		br = FullOptions[g,BoxRatios];
		image = {g};
		If[xshadow, 
			AppendTo[image,
				Project[g,
					{(xmax+xmin)/2 + xshadowposition (xmax - xmin),
						(ymax+ymin)/2,
						(zmax+zmin)/2}]];
			If[Abs[xshadowposition] > 1/2,
				br = br {(Abs[xshadowposition] + 1/2),1,1}]];
		If[yshadow, 
			AppendTo[image,
				Project[g,
					{(xmax+xmin)/2,
					(ymax+ymin)/2 + yshadowposition (ymax - ymin),
					(zmax+zmin)/2}]];
			If[Abs[yshadowposition] > 1/2,
				br = br {1, (Abs[yshadowposition] + 1/2),1}]];
		If[zshadow, 
			AppendTo[image,
				Project[g,
					{(xmax+xmin)/2,
					(ymax+ymin)/2,
					(zmax+zmin)/2 + zshadowposition (zmax - zmin)}]];
			If[Abs[zshadowposition] > 1/2,
				br = br {1,1, (Abs[zshadowposition] + 1/2)}]];
		Show[image,Flatten[{gopts,BoxRatios->br}]]]

Shadow[g_,opts___] := Shadow[Graphics3D[g],opts] (* handle other graphics *)

(* Graphics3D *)
Unprotect[Graphics3D];

Graphics3D[Graphics[primitives_,options___]] :=
	Graphics3D[ZTG[primitives, 0], BoxRatios->{1,1,1},
        Axes->{True, False, True},
        PlotRange->{Automatic, {-1,1}, Automatic},
        ViewPoint->{0, -1, -3}
	]

Protect[Graphics3D];


(* StackGraphics *)

StackGraphics[list:{__Graphics}, zrange_:{0, 1}] :=
	Module[{i},
	Graphics3D[ Table[ZTG[First[ list[[i]] ], i/Length[list]], 
		{i, Length[list]}], BoxRatios->{1,1,1},
		Axes->{True, False, True} ]
	]

ZTG[d_List, z_] := Map[ ZTG[#, z]& , d ]

ZTG[Point[{x_, y_}], z_] := Point[{x, z, y}]

ZTG[Line[d:{{_,_}...}], z_] := Line[ Map[Insert[#, z, 2]&, d] ]

ZTG[Polygon[d:{{_,_}...}], z_] := Polygon[ Map[Insert[#, z, 2]&, d] ]

ZTG[Text[d_String, {x_, y_}, dd___], z_] := Text[d, {x,z,y}, dd]

ZTG[expr_, z_] := expr

End[] (* Private` *)

EndPackage[] (* Graphics`Graphics3D` *)

(* :Examples:
	<<Graphics/ParametricPlot3D.m
	g1 = CylindricalPlot3D[ r^2,{r,0,1},{phi,0,2 Pi}];
	Show[ TransformGraphics3D[ g1, Cos[#] & ] ]

	Show[ Graphics3D[ Plot[ Sin[t],{t,0,Pi}]]]

	g1 = CylindricalPlot3D[ r^2,{r,0,1},{phi,0,2 Pi}];

	Show[ SkewGraphics3D[ g1, {{1,2,0},{0,1,0},{0,0,1}}] ]

	g1 = Table[ Plot[x^n, {x,0,5}], {n,5}]; Show[ StackGraphics[ g1]] 
	
	g1 = Plot[ Sin[x],{x,0,Pi}];
	g2 = Plot[ Sin[x+0.5],{x,0,Pi}];
	g3 = Plot[ Sin[x+1],{x,0,Pi}];
	Show[ StackGraphics[{g1,g2,g3}] ]
	
	BarChart3D[ { { 1,2,3},{4,5,6}}]
	
	ScatterPlot3D[ Table[ { t,Sin[t],Cos[t]},{t,0,10,0.1}]]

	ScatterPlot3D[ Table[ { t,Sin[t],Cos[t]},{t,0,10,0.1}],PlotJoined->True]

	ListSurfacePlot3D[ Table[ {i,j, Sin[i j] },{i,1,10},{j,1,10}]]

	graphics = Plot3D[Sin[x y],{x,0,Pi},{y,0,Pi}];
	Show[ Project[ graphics, {1,1,0}] ]

	Shadow[ graphics, ZShadow -> False ]

*)

