(* :Title: ContourLines3D *)
(* :Author: Allan Hayes, hay@leicester.ac.uk *)
(* :Summary:
ContourLines3D has three functions:\n
- ParametricPlot3DContoured and Plot3DContoured, that allow contour lines
to be drawn on 3D plots.\n
- RePlot, that allows the replotting of Graphics3DContoured objects.\n
Show is extended.\n
There are three special options:ContourLift, ContourColorFunction and
Surface.
Graphics3D[Graphics3DContoured[...]] gives a Graphics3D object.
*)
(* :Context: haypacks`ContourLines3D` *)
(* :Package Version: 1.2 *)
(* :Copyright: Copyright 1994 Allan Hayes. *)
(* :History:
Version 1.1 by Allan Hayes, March 1994.
Version 1.2 by Allan Hayes, May 1994.
*)
(* :Warning: Show is extended to deal with the
object that is returned by the function PlotContoured.
Color directives given in ContourStyles are usually not operative; they must
usually be given separately by the option ContourColorFunction (but see the
entry for ContourColorFunction).
*)
(* :Keywords: Contour *)
(* :Mathematica Version: 2.2 *)
(* :Limitation: The Graphics3DContoured object that is output is
not yet combining with other graphics and does not respond to
FullOptions and FullGraphics
*)
(**Begin Package**)
BeginPackage["haypacks`ContourLines3D`", "Utilities`FilterOptions`"];
Unprotect["`*"];
ClearAll["`*"];
(**Usage messages**)
ContourLines3DInfo::usage =
"ContourLines3D is a package with three functions,\n
Plot3DContoured,gives a Plot3D surface with contour lines added,\n
ParametricPlot3DContoured, gives a ParametricPlot3D surface with contour lines added;\n
extensive options allow variations to be made.\n
RePlot: extends Show so as to allow the options PlotPoints and Compiled that are not allowed in Show.It should be used only if these options are added since, because a complete replot is made, it will be slower than Show.
Please see the separate entry for more information and examples.
";
ParametricPlot3DContoured::usage =
"ParametricPlot3DContoured[{x,y,z},{u,umin,umax},{v,vmin,vmax}, opts],
for expressions x,y,z in u,v, adds the contour lines to the surface given by ParametricPlot3D[{x,y,z},{u,umin,umax},{v,vmin,vmax}, opts].\n
The contour styles are controlled by the options ContourStyles (as for ContourPlot) and a new option, ContourColorFunction except that color directives must usually be given separately by the option ContourColorFunction (but see the entry for ContourColorFunction). The amount by which contours are moved towards the viewpoint to avoid parts of them being hidden by the surface is controlled by the option ContourLift.
.\n\n
Options:\n
ParametricPlot3DtContoured has the union of the options of ParametricPlot3D, ContourPlot as options, together with three new options ContourLift, ContourColorFunction and Surface.\n\n
Example:\n
ParametricPlot3DContoured[{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t]},
{s,0,2Pi},{t,-Pi/2, Pi/2}
]\n\n
For more examples please see ParametricPlot3DtContouredExamples.
";
Plot3DContoured::usage =
"Plot3DContoured[z,{u,umin,umax},{v,vmin,vmax}, opts], for expression z in u,v, adds contour lines to the surface given by Plot3D[z,{u,umin,umax},{v,vmin,vmax}, opts].\n
Options:\n
Plot3DtContoured has the union of the options of Plot3D and ContourPlot as options, together with three new options ContourLift, ContourColorFunction and Surface.\n
The contour styles are controlled by the options ContourStyles (as for ContourPlot) except that color directives must usually be given separately by the new option ContourColorFunction (but see the entry for ContourColorFunction). The amount by which contours are moved towards the viewpoint to avoid parts of them being hidden by the surface is controlled by the option ContourLift.\n\n
Example:\n
Plot3DContoured[2x^4 - y^4, {x,-1,1},{y,-1,1},Axes -> True]\n\n
For more examples please see Plot3DtContouredExamples.
";
ContourLift::usage = "ContourLift is an option for Plot3DContoured, ParametricPlot3DContoured and Graphics3DContoured.\n
For a number r, ContourLift ->r, causes each contour to be moved towards the viewpoint by r times the length of the bounding box in the direction of the view point. This is used to avoid some parts being covered by the surface.\n
The default is ContourLift ->Automatic.
";
ContourColorFunction::usage = "ContourColorFunction is an option for Plot3DContoured, ParametricPlot3DContoured and Graphics3DContoured. \n
ContourColorFunction ->cf, causes each contour to assigned the color cf[scaledz] where scaledz runs from 0 at the lower end of the range of plotted values of z up to 1 at the top of the range.\n
The default is ContourColorFunction ->Hue.\n\n
NOTE:\n
Directives set by ContourColorFunction will shadow any coresponding ones set by ContourStyles, but ContourColorFunction -> ({}&) will allow all ContourStyles set directives to function.
ContourColorFunction can be used to modify more than the color of the contour lines. ContourColorFunction -> (Thickness[#/100]&) will set the thickness;
ContourColorFunction -> ((Sequence@@{Hue[#], Thickness[#/100]})&) will set both color and thickness in.\n
ColorFunction -> Transparent gives a wire frame picture.
";
Surface::usage = "Surface is an option for Plot3DContoured, ParametricPlot3DContoured and Graphics3DContoured.\n
With Surface -> True, the surface on which the contours are to be
drawn is displayed; with Surface -> False the surface is not displayed (the edges of the surface patches are not shown) ;
with Surface -> Transparent a wire frame version is displayed (the style of the mesh is then controlled by the option ColorFunction).\n
The default is Surface -> True.
";
Graphics3DContoured::usage = "Graphics3DContoured[primitives list, options] is the kind of graphic object returned by ParametricPlot3DContoured and Plot3DContoured\n\n
Options:\n
Graphics3DContoured has the union of the options of ContourGraphics, SurfaceGraphics and Graphics3D as options, together with three new options ContourLift, ContourColorFunction and Surface.
";
Transparent::usage = "Transparent is a setting for the option Surface in
ContourLines3D which specifies that a wire frame version be displayed."
RePlot::usage = "Replot[graphics, opts], for a Graphics3DContoured object graphics, replots the with extra options opts, which may include PlotPoints and Compiled (these are not allowed by Show).It should be used only if these options are added since it will be slower than Show, because a complete replot is made.";
ParametricPlot3DContouredExamples::usage ="
(***\n
You can evaluate these examples by converting the print cell in which they are
generated to an input cell and then evaluatiing the cell.\n
***)\n
ppc =
ParametricPlot3DContoured[{t Sin[s] Cos[t], t Cos[s] Cos[t], Sin[t]},
{s,0,2Pi},{t,-Pi/2, Pi/2}];\n\n
Show[ppc,
PlotRange -> {All, {-.2,1.1},All},
ViewPoint->{1.393, -2.988, -0.764}
];\n\n
Show[ppc, Lighting -> False, ColorFunction -> GrayLevel];\n\n
Show[ppc,
Surface -> False,
Contours -> 24,
ContourColorFunction -> (Hue[1-#]&)
];\n\n
ppc2 =
RePlot[ppc,
PlotPoints -> 7,
ContourLines -> False,
ColorFunction ->
((Sequence@@{EdgeForm[Thickness[.01],Hue[0]],Hue[1-#]})&),
Lighting -> False
];\n\n
Show[ppc2,
Surface->Transparent,
ColorFunction -> Hue,
(*controls mesh color when Surface->Transparent is set*)
Boxed -> False,
Axes -> False
];\n\n
Show[ppc,
ContourStyle -> Thickness[.007],
ContourColorFunction->(GrayLevel[0]&),
Mesh -> True,
MeshStyle -> GrayLevel[.5],
Shading -> False
];\n\n
ball =
ParametricPlot3DContoured[
{Sin[s] Cos[t], Cos[s] Cos[t], Sin[t]},
{s,0,2Pi},{t,-Pi/2, Pi/2},
ContourLift -> .7,
AmbientLight -> GrayLevel[.2],
Boxed -> False,
Axes -> False
];\n\n
Show[Graphics3D[ball], ViewPoint->{3.265, 0.888, 0.042}];
";
Plot3DContouredExamples::usage =
"
(***\n
You can evaluate these examples by converting the print cell in which they are
generated to an input cell and then evaluatiing the cell.\n
***)\n
pc =
Plot3DContoured[2x^4 - y^4, {x,-1,1},{y,-1,1},Axes -> True];\n\n
Show[pc,
PlotRange -> {All, {-.2,1.1},All},
ViewPoint->{1.393, -2.988, -0.764}
];\n\n
Show[pc, Lighting -> False, ColorFunction -> GrayLevel];\n\n
Show[pc,
Surface -> False,
ContourColorFunction -> (Hue[1-#]&)
];\n\n
pc2 =
RePlot[pc,
PlotPoints -> 7,
ContourLines -> False,
ColorFunction ->
((Sequence@@{EdgeForm[Thickness[.01],Hue[0]],Hue[1-#]})&),
Lighting -> False
];\n\n
Show[pc2,
Surface->Transparent,
ColorFunction -> Hue,\n
(*controls mesh color when Surface->Transparent is set*)
Boxed -> False,
Axes -> False,
PlotRange -> All\n
(*stops clipping of polygons -- compare earlier pictures*)
];\n\n
Show[pc,
ContourStyle -> Thickness[.007],
ContourColorFunction->(GrayLevel[0]&),
Mesh -> True,
MeshStyle -> GrayLevel[.5],
Shading -> False
];
";
(**Code**)
Begin["`Private`"];
Clear["`*"];
Format[Graphics3DContoured[x___]] := "-Graphics3DContoured-";
(* In defining the options I have used Union to avoid the duplication that
would result if I used Join.
*)
Options[Graphics3DContoured] =
Union@@(
{
Options[ContourGraphics],
Options[SurfaceGraphics],
Options[Graphics3D],
{ ContourLift -> Automatic,
ContourColorFunction -> Hue,
Surface -> True
}
}/.
{
(AspectRatio-> _ ) -> (AspectRatio-> Automatic),
(AmbientLight -> _) -> (AmbientLight -> GrayLevel[0.]),
(Axes -> _) -> (Axes -> True),
(BoxRatios ->_) -> (BoxRatios -> Automatic),
(ColorFunction -> _) -> (ColorFunction -> Automatic),
(ContourShading -> _) -> (ContourShading -> False),
(ContourSmoothing -> _) -> (ContourSmoothing -> None),
(ContourStyle -> _) -> (ContourStyle-> {}),
(Mesh -> _) -> (Mesh ->False),
(MeshStyle -> _) -> (MeshStyle -> GrayLevel[0])
}
);
Options[ParametricPlot3DContoured] =
Union[{Compiled -> True, PlotPoints -> 25}, Options[Graphics3DContoured]]
Options[Plot3DContoured] =
Options[ParametricPlot3DContoured]/.
(BoxRatios -> _) -> (BoxRatios -> {1,1,0.4}) ;
(* UVP, below, converts the viewpoint, vp, from viewpoint coordinates
to user coordinates. VP converts from user coordinates to viewpoint
coordinates
*)
UVP[vp_,br_,pr_] :=
pr.{1,1}/2 + pr.{-1,1} Max[br]/br vp;
VP[uvp_, br_,pr_] :=
(uvp - pr.{1,1}/2 )br/Max[br]/pr.{-1,1};
zscaler = Compile[{n1,n2,n3,n4,m,h}, ((n1+n2+n3+n4)/4 -m)/h];
ParametricPlot3DContoured[
{x_,y_,z_},{u_,umin_,umax_},{v_,vmin_,vmax_}, opts___?OptionQ
] :=
Module[
{px,py,pz,defopts,ppts,polydat,zdat,mr, graphicsobject},
(**
STEP1: construct the basic data that depends only on the
the parametric formulas x,y,z, the u and v ranges and the
"plot" option PlotPoints. This will be passed on unchanged
through any uses of Show.
**)
(* Find the current default options -- to allow control
by the SetOptions function.
*)
defopts = Sequence@@Options[ParametricPlot3DContoured];
ppts = PlotPoints/. {opts} /.{defopts};
(* Make compiled or pure functions {px,py,pz} out of
{x,y,z}: these are convenient for passing.
*)
{px,py,pz} =
If[
Compiled/.{opts,defopts},
Thread[comp[{u,v},{x,y,z}], List,-1]/.comp -> Compile,
Function/@({x,y,z}/.{u:>#1,v:>#2})
];
(* Find the polygons, polydat, for surface on which the
contours will be drawn. The extra brackes are to
conform to the pattern when directives are added.
*)
polydat =
{
List/@
( ParametricPlot3D[
{x,y,z},
{u,umin,umax},{v,vmin,vmax},
DisplayFunction -> Identity,
PlotPoints -> ppts
][[1]]
)
};
(* Find matrix of heights, zdat, as a function of u,v --
the x,y coordinates will be adjusted later. We also
need the meshrange mr so that the original vlaues of
u and v can be reconstructed.
*)
zdat =
Plot3D[
z, {u,umin,umax},{v,vmin,vmax},
DisplayFunction -> Identity,
PlotPoints -> ppts
][[1]];
mr = {{umin,umax},{vmin,vmax}};
(* Pass data on to makegraphics to make a Graphics3DContoured
object
The {}'s holds places data that depends on
Graphics3DContoured options to be added
metdat will be the value of {Boxratios, PlotRange} that
have actually been used in a plot. These will be obtained
using the function FullOptions and need not be the values
assigned by the options (because, for example, PlotRange ->
Automatic is a default setting).
cdat will be the data from which the contour lines will be
constructed once their number and other properties have been
specified.
*)
(**
STEP2: Use the function makegraphics ,defined separately, to construct
a graphics object with new head Graphics3DContoured. This contains all
the data, including all the options given, from which to display the
result by means of a suitably extended version of the function Show.
**)
graphicsobject =
makegraphics[
{ {px,py,pz}, zdat,
polydat,{}(*for metdat*), {}(*for cdat*)
},
FilterOptions[
Graphics3DContoured,
MeshRange -> mr,
opts,
defopts
]
];
(* Show the graphics just constructed. *)
(**
STEP3: display the result by means of a suitably extended version
of the function Show, defined separately.
**)
Show[graphicsobject]
];
(* The function makegraphics, defined below, gives a
ContouredSurfaceGraphics object. A principle aim in designing
the code has been to keep recomputation as close as sensible
to the minimum required by new option settings introduced by
when using Show.
*)
makegraphics[
{ {px_,py_,pz_}, zdat_,
oldpolydat_, oldmetdat_, oldcdat_,
oldopts___
},
newopts___
] :=
Module[
{ optsset, opts,vp,br,cl,ccf,pcf,clnsQ,edgfm, msh,
mshs, cs,sur,ppts,lftrat,pr,
cln,cplot,cplot2D, uvp,center,ucp,maxs,tmin,thbx,zpr,zmin,
hbx, newcdat,clines, us,vs,zav,xyz,vecs,unitvecs,cyclestyles,
csc,clip,nearpt,lift,lftpt,dpr,dvp
},
(* Find the list of options that are set in newopts *)
optsset = First/@{newopts};
(* Join newopts and oldopts for convenience.*)
opts = Sequence[newopts,oldopts];
(* Find the settings of some of the options.*)
{ br, ccf, cl, clnsQ, cs, mshQ, mshs, pcf, vp} =
{ BoxRatios, ContourColorFunction, ContourLift,
ContourLines, ContourStyle, Mesh, MeshStyle,
ColorFunction,ViewPoint
}/.{opts};
edgfm = If[!mshQ, EdgeForm[], EdgeForm[mshs]];
newpolydat = {edgfm, Last[oldpolydat]};
(* If newopts change plotrange or box ratios find their
new values.
*)
If[
MemberQ[optsset, BoxRatios|PlotRange ],
{newfbr,newfpr} =
FullOptions[
Graphics3D[
newpolydat,
FilterOptions[Graphics3D, opts]
],
{BoxRatios,PlotRange}
],
{newfbr,newfpr} = oldmetdat
];
(* Find the thickness of the box, thbx, (in user coordinates)
along the line through the center and the viewpoint.
*)
uvp = UVP[vp,newfbr,newfpr]; (*Viewpoint in user coordinates.*)
center = newfpr.{1,1}/2;
ucp = uvp - center;
maxs = Max/@newfpr;
Off[Power::infy];
tmin = Min[Abs[(maxs - center)/ucp]];
On[Power::infy];
thbx = 2 tmin Sqrt[ucp.ucp]//N;
(* Find the ratio lftrat of the thickness of the box in
the direction of the view point by which the contours
will be lifted
*)
ppts = Dimensions[zdat];
lftrat := If[cl === Automatic, 0.5/(Plus@@ppts), cl];
(* Find a display plotrange, dpr, which will include the lifted
contours. Calculate the corresponding display box ratio dbr
and display ViewPoint, dvp, the position of the latter in user
coordinates relative to br and dpr is still uvp (this will keep
the lifted contours in line with the unlifted ones as seen from
the view point used in the display).
*)
clip[x_, {a_,b_}] := Which[ xb,b, True,x ];
nearpt[uvp_, newfpr_] := Thread[clip[uvp,newfpr]];
lift[uvp_,pr_, d_] :=
Module[{np},
np = nearpt[uvp,pr];
(np + d #/Sqrt[#.#])&[uvp - np]
];
lftpt = lift[uvp, newfpr, lftrat thbx];
dpr = {Min[#],Max[#]}&/@MapThread[List,{lftpt,newfpr}];
dbr = If[ br === Automatic, dpr.{-1,1}, br];
dvp = VP[uvp,dbr,dpr];
(* Find the height, hbx, of the box in user coordinates,
needed to find the scaled height used for ContourColorFunction.
*)
znewfpr = newfpr[[-1]];
zmin = Min[znewfpr];
zmax = Max[znewfpr];
hbx = zmax - zmin;
(*
Find the 2D contour lines from zdat by using ContourGraphics
and converting to a Graphics object. The heights will be added
later and the u,v coordinates will be mapped to the
corresponding x,y values. The split into styles and lines is
for efficiency in making changes by options.
*)
{styles, lines} =
(
Graphics[ContourGraphics[
zdat,
ContourShading -> False,
FilterOptions[
ContourGraphics,
PlotRange -> newfpr[[-1]], (* Not newfpr, which is
in terms of x,y and z
*)
opts
]
]][[1]]/.{dirs__,ln_Line} -> {{dirs}, ln}
)//Transpose;
(* Do those calculations for lifting the contours that depend
on the "metric" options BoxRatios, Contours, PlotRange,
ViewPoint, ContourSmoothing. Store the data as newcdat.
The full code for the contour lines is constructed later from
newcdat and styles.
*)
If[
clnsQ&&
MemberQ[
optsset,
BoxRatios|ViewPoint|PlotRange|Contours|ContourSmoothing
],
newcdat =
lines/.Line[ps_] :>
( {us, vs} = Transpose[ps];
zav = Inner[pz,us,vs]/Length[ps];(*av ht of contour*)
zs = Table[zav,{Length[ps]}];
xyz =
{ MapThread[px,{us,vs}],
MapThread[py,{us,vs}],
zs
};
vecs = Transpose[uvp - xyz];
unitvecs =
Block[{Dot},
vecs/Sqrt[Thread[Dot[vecs,vecs]]]
]; (* unit vecs in direction of viewpoint*)
{
(zav-zmin)/hbx,
Transpose[xyz],
thbx unitvecs
}
),
(* else - if no changes are needed to cdat. *)
newcdat = oldcdat
];
(* Insert the directives for the polygons *)
If[pcf =!= Automatic && MemberQ[optsset, ColorFunction],
newpolydat =
newpolydat/.{___,poly:Polygon[pts_]} :>
{pcf[zscaler[Sequence@@(Last/@pts), zmin, hbx]], poly}
];
(* Complete the code for the contour lines using lftrat (derived
from the option ContourLift) and ccf (from ContourColourFunction).
*)
clines =
If[clnsQ,
Apply[
{ Sequence@@Flatten[{##4}],
ccf[#1],
Line[#2 + lftrat #3]
}&,
MapThread[Join,{newcdat,styles}],
{1}
],
{}
];
(* Return the data and options as a Graphics3DContoured object.*)
Graphics3DContoured[
{
{px, py, pz}, zdat,
newpolydat, {newfbr, newfpr}, newcdat, clines,
{dpr,dvp}
},
opts
]
];
(* Extend Show to deal with Graphics3DContoured objects. *)
Graphics3DContoured/:
Show[
Graphics3DContoured[
{ fn_, zdat_,
polydat_,{fbr_,fpr_}, cdat_, clines_,
{dpr_, dvp_}
},
oldopts___?OptionQ
],
newopts___?OptionQ
] :=
If[
MemberQ[
First/@{newopts},
BoxRatios|ColorFunction|ContourColorFunction|ContourLift|
Contours|ContourLines|ContourSmoothing|ContourStyle|
Mesh|MeshStyle|PlotRange|Surface|ViewPoint
],
Show[
makegraphics[
{ fn, zdat,
polydat, {fbr,fpr}, cdat,
oldopts
},
newopts
]
],
Show[
Graphics3D[{
Switch[Surface/.{newopts, oldopts},
True,
polydat,
Transparent,
polydat/.
Polygon[z_] :> Line[Append[z,First[z]]],
_,
{}
],
If[ContourLines/.{newopts, oldopts},clines,{}]
}],
PlotRange -> dpr, ViewPoint -> dvp,
FilterOptions[
Graphics3D, newopts,oldopts
]
];
Graphics3DContoured[
{ fn, zdat,
polydat,{fbr,fpr},cdat, clines,
{dpr,dvp}
},
newopts,oldopts
]
];
(* Provide for conversion of Graphics3DContoured objects to
Graphics3D objects
*)
Graphics3DContoured/:
Graphics3D[
Graphics3DContoured[
{ fn_, zdat_,
polydat_,{fbr_,fpr_}, cdat_, clines_,
{dpr_, dvp_}
},
oldopts___?OptionQ
],
newopts___?OptionQ
] :=
Graphics3D[
{ Switch[ Surface/.{newopts, oldopts},
True, polydat,
Transparent,
polydat/.
Polygon[z_] :> Line[Append[z,First[z]]],
_, {}
],
If[ContourLines/.{newopts, oldopts},clines,{}]
},
PlotRange -> dpr, ViewPoint -> dvp,
FilterOptions[Graphics3D, newopts, oldopts]
];
(* Provide for replotting - allows PlotPoints and Compile
options to be chsnged. The system function Show does not allow
for this because system graphics objects do not carry the plotted
functions.
*)
RePlot[
Graphics3DContoured[
{ fn_, zdat_,
polydat_,{fbr_,fpr_}, cdat_, clines_,
{dpr_, dvp_}
},
oldopts___?OptionQ
],
newopts___?OptionQ
] :=
Module[{u,v,m,gr},
mr = MeshRange/.{oldopts};
Off[CompiledFunction::cfr];
gr =
If[
Head[fn] === List,
ParametricPlot3DContoured[
Through[fn[u,v]],
Sequence@@Flatten/@Thread[List[{u,v}, mr]],
newopts, oldopts
],
Plot3DContoured[
fn[u,v],
Sequence@@Flatten/@Thread[List[{u,v}, mr]],
newopts, oldopts
]
];
On[CompiledFunction::cfr];
gr
];
(**
The next two functions are Plot3DContoured and an appropriate
version of make graphics. The development is quite close to that
above so I have omitted the comments.
**)
Plot3DContoured[
z_,{u_,umin_,umax_},{v_,vmin_,vmax_}, opts___?OptionQ
] :=
Module[
{defopts,ppts,pz,surface, polydat,zdat,mr, graphicsobject},
defopts = Sequence@@Options[Plot3DContoured];
ppts = PlotPoints/. {opts} /.{defopts};
pz =
If[
Compiled/.{opts,defopts},
Compile@@{{u,v},Evaluate[z]},
Function@@({z}/.{u:>#1,v:>#2})
];
zdat =
Plot3D[
z, {u,umin,umax},{v,vmin,vmax},
DisplayFunction -> Identity,
PlotPoints -> ppts
][[1]];
mr = {{umin,umax},{vmin,vmax}};
graphicsobject =
makegraphics[
{ pz, zdat,
{}(*for polydat*),{}(*for metdat*), {}(*for cdat*)
},
FilterOptions[
Graphics3DContoured,
MeshRange -> mr,
opts,
defopts
]
];
Show[graphicsobject]
];
makegraphics[
{ pz_, zdat_,
oldpolydat_, oldmetdat_, oldcdat_,
oldopts___
},
newopts___
] :=
Module[
{ optsset, opts,vp,br,cl,ccf,clnsQ,cs,sur,ppts,lftrat,pr,
cln,cplot, uvp,center,ucp,maxs,tmin,thbx,zpr,zmin,
hbx, newcdat,clines, us,vs,zav,xyz,vecs,unitvecs,cyclestyles,
csc,clip,nearpt,lift,lftpt,dpr,dvp,styles,lines
},
optsset = First/@{newopts};
opts = Sequence[newopts,oldopts];
{ br, ccf, cl, clnsQ, cs, vp} =
{ BoxRatios, ContourColorFunction, ContourLift,
ContourLines, ContourStyle, ViewPoint
}/.{opts};
newpolydat =
If[
MemberQ[
optsset,
ColorFunction|Mesh|MeshRange
],
Graphics3D[
SurfaceGraphics[
zdat,
FilterOptions[
SurfaceGraphics,
Sequence@@DeleteCases[{opts}, ColorFunction->_]
]
]
][[1]],
oldpolydat
];
{newfbr,newfpr} =
If[
MemberQ[optsset, BoxRatios|PlotRange ],
FullOptions[
Graphics3D[
newpolydat,
FilterOptions[Graphics3D, opts]
],
{BoxRatios,PlotRange}
],
oldmetdat
];
uvp = UVP[vp,newfbr,newfpr]; (*Viewpoint in user coordinates.*)
center = newfpr.{1,1}/2;
ucp = uvp - center;
maxs = Max/@newfpr;
Off[Power::infy];
tmin = Min[Abs[zzz = (maxs - center)/ucp]];
On[Power::infy];
thbx = 2 tmin Sqrt[ucp.ucp]//N;
ppts = Dimensions[zdat];
lftrat := If[cl === Automatic, 0.5/(Plus@@ppts), cl];
clip[x_, {a_,b_}] := Which[ xb,b, True,x ];
nearpt[uvp_, newfpr_] := Thread[clip[uvp,newfpr]];
lift[uvp_,pr_, d_] :=
Module[{np},
np = nearpt[uvp,pr];
(np + d #/Sqrt[#.#])&[uvp - np]
];
lftpt = lift[uvp, newfpr, lftrat thbx];
dpr = {Min[#],Max[#]}&/@MapThread[List,{lftpt,newfpr}];
dbr = If[ br === Automatic, dpr.{-1,1}, br];
dvp = VP[uvp,dbr,dpr];
znewfpr = newfpr[[-1]];
zmin = Min[znewfpr];
zmax = Max[znewfpr];
hbx = zmax - zmin;
{styles, lines} =
(Graphics[ContourGraphics[
zdat,
ContourShading -> False,
FilterOptions[
ContourGraphics,
PlotRange -> newfpr[[-1]],
opts
]
]][[1]]/.{dirs___,ln_Line} -> {{dirs}, ln})//Transpose;
If[
MemberQ[
optsset,
BoxRatios|ViewPoint|PlotRange|Contours|ContourSmoothing
],
newcdat =
lines/.Line[ps_] :>
( {us, vs} = Transpose[ps];
zav = Inner[pz,us,vs]/Length[ps];(*av ht of contour*)
zs = Table[zav,{Length[ps]}];
xyz = {us,vs,zs};
vecs = Transpose[uvp - xyz];
unitvecs =
Block[{Dot},
vecs/Sqrt[Thread[Dot[vecs,vecs]]]
]; (*unit vecs in direction of viewpoint*)
{
(zav-zmin)/hbx,
Transpose[xyz],
thbx unitvecs
}
),
newcdat = oldcdat
];
(******)
(* Insert the directives for the polygons *)
pcf = ColorFunction/.{opts};
If[pcf =!= Automatic && MemberQ[optsset, ColorFunction],
newpolydat =
newpolydat/.poly:Polygon[pts_] :>
{pcf[zscaler[Sequence@@(Last/@pts), zmin, hbx]], poly}
];
(******)
clines =
If[clnsQ,
Apply[
{ Sequence@@Flatten[{##4}],
ccf[#1],
Line[#2 + lftrat #3]
}&,
MapThread[Join,{newcdat,styles}],
{1}
],
{}
];
Graphics3DContoured[
{
pz, zdat,
newpolydat, {newfbr, newfpr}, newcdat, clines,
{dpr,dvp}
},
opts
]
];
End[];
Protect["`*"];
EndPackage[];