(* :Title: VRMLConvert *)

(* :Author: H. Edward Donley
  <hedonley@grove.iup.edu> or
  <http://www.ma.iup.edu/people/hedonley.html>
*)

(* :Summary:
  Converts Mathematica Graphics3D objects to Virtual
  Reality Modeling Language 1.0 format.
  ToRotationVector is a Mathematica version of Stephen
  Chenney's <schenney@cs.berkeley.edu> orient.c program
  for calculating a rotation vector for a VRML camera.
*)

(* :Package Version: 1.1.1 *)

(* :Copyright: Copyright 1996  H. Edward Donley. *)

(* :History:
  Version 1.1.1 Corrected a few problems: (March 1998)

  1. Eliminated quote marks around heightAngle by modifying CompactForm
     function (Thanks to Matthias Weber <weber@math.uni-bonn.de> for
     suggesting this solution.)
  2. Only defined Cross function if Mathematica version is < 3.0.
  3. Added missing space in VRML Box node

  Version 1.1 Modifications by Eckhard Hennig <hennig@rhrk.uni-kl.de>
  <http://www.e-technik.uni-kl.de/organizations/itwm/
  people/Hennig/Eckhard.html> May 1996

   1. reduce numerical print precision of point coordinates
   2. remove duplicate polygon point coordinates  
   
  Version 1.0 by H. Edward Donley (Indiana University of Pennsylvania), February 1996.
*)

(* :Keywords: 
  Virtual Reality Modeling Language, VRML, World Wide Web,
  visualization, graphics 
*)

(* :Mathematica Version: 2.2 *)

BeginPackage["VRMLConvert`"]

Unprotect[QuaternionProduct, QuaternionInverse,
  ToUnitQuaternion, ToRotationVector, VRMLConvert, Camera,
  EdgeMaterial, EmissiveColor, FocalDistance, HeightAngle,
  LabelColor, LabelLocation, LabelSize, PointStyle,
  SphereSize, Surface, SurfaceMaterial, Transparency,
  PointPrecision, RemoveDuplicatePoints,
  WWWAnchor];

QuaternionProduct::usage = "QuaternionProduct[q1, q2]
calculates the product of two quaternions, used for combining
two rotations.";

QuaternionInverse::usage = "QuaternionInverse[q] calculates
the inverse of a quaternion, used to reverse a rotation.";

ToUnitQuaternion::usage = "ToUnitQuaternion[theta, v] 
converts a rotation angle, theta, and a rotation axis, v,
to a unit quaternion.";

ToRotationVector::usage = "ToRotationVector[cameraPosition,
objectLocation, upDirection] converts a camera location,
the coordinates of the center of the viewed object, and a
vector pointing in the up direction to a rotation vector for
orienting a VRML camera.  The output should be placed in the
orientation field of a VRML PerspectiveCamera note.";

VRMLConvert::usage = "VRMLConvert[plot, \"file\", options]
converts a Graphics3D object to VRML format and writes it
to a file.  plot is a Graphics3D object or a list of Graphics3D
objects.  \"file\" is a string containing the filename of the
VRML file.  The filename extension should be .wrl.
VRMLConvert returns the name of the file.\n\n
  Example:\n
  sinplot=Plot3D[Sin[x*y],{x,-Pi,Pi},{y,-Pi,Pi}];\n
  VRMLConvert[sinplot,\"sine.wrl\"]";

Camera::usage = "Camera is an option for VRMLConvert.  With
Camera -> True, a camera position is calculated from ViewPoint
ViewCenter, and ViewVertical.  With Camera -> False, no
camera is included.";

EdgeMaterial::usage = "EdgeMaterial is an option for
VRMLConvert.  It specifies the material properties of
the edges of polygons.  It's value should be a SurfaceColor,
None, or a list of these.  If a list is given, the directives
are applied cyclically to the list of Graphics3D objects in
the first argument to VRMLConvert.  The default is None, which
draws no edges on the polygons.  This saves considerable
rendering time for the VRML browser, since the edges are
separate VRML graphics primitives from the polygons.  See
SurfaceColor."; 

EmissiveColor::usage = "EmissiveColor is an option for
VRMLConvert, representing the amount of glow in the material.
It must be a Hue, GrayLevel, or RGBColor color directive, or
a list of these directives.  The directives are applied
cyclically to the list of Graphics3D objects in the first
argument to VRMLConvert. The default is
EmissiveColor -> RGBColor[0.,0.,0.], which means that the
material does not emit any of its own light; it only reflects
the surrounding light.  Thus the default mimics Mathematica
graphics, which do not support emissive color.";

Epilog::usage = "Epilog is an option for VRMLConvert.  It
is a string of VRML text that is inserted at the end of the 
output of VRMLConvert.  You can use this to include Mathematica
graphics into other VRML scenes.  The default is \"\".";

FocalDistance::usage = "FocalDistance is an option for
VRMLConvert.  The default is Automatic, which uses the 
distance from the camera to the center of the graphic.";

HeightAngle::usage = "HeightAngle is an option for
VRMLConvert.  It defines the total height of the viewing
volume.  The default is Pi/4.";

LabelColor::usage = "LabelColor is an option for VRMLConvert.
This is the color used for the PlotLabel.  Hue, GrayLevel,
and RGBColor are supported.  The default is GrayLevel[1],
which is white.";

LabelLocation::usage = "LabelLocation is an option for
VRMLConvert, giving the position of the PlotLabel.  It uses
the same display coordinate system as LightSources.  This is
The default is {0, 1.05, 1}, which is just above the graph.";

LabelSize::usage = "LabelSize is an option for VRMLConvert,
giving the height of the font in PlotLabel relative to the
diameter of the graph's bounding box.  The default is 0.10.";

PointPrecision::usage = "PointPrecision is an option for
VRMLConvert. It sets the numerical precision of point
coordinates which are written to the VRML file. The default is
4, corresponding to a precision of four digits."

PointStyle::usage = "PointStyle is an option for VRMLConvert.
If PointStyle is Sphere, then spheres of size SphereSize are
created for each Mathematica Point primitive.  If PointStyle
is Point, then VRML point primitives are created for each
Mathematica Point primitive.  The default is Sphere.  If
PointStyle is a list of styles, it is applied cyclically to
the Graphics3D objects listed in the first argument to
VRMLConvert.";

RemoveDuplicatePoints::usage = "RemoveDuplicatePoints is an
option for VRMLConvert. With RemoveDuplicatePoints -> True,
duplicate polygon point coordinates are removed before the
Coordinate3 section is written to the VRML file. This
produces significantly smaller file sizes at the expense of
an increased conversion time. With RemoveDuplicatePoints ->
False, all polygon point coordinates from the Mathematica
plot will be written to the VRML file. The default setting
is RemoveDuplicatePoints -> True."

SphereSize::usage = "SphereSize is an option for VRMLConvert.
If PointStyle is set to Sphere, then VRMLConvert displays
Mathematica Point[] primitives as VRML Sphere primitives.
The size of the spheres is specified as a fraction of the
total width of the graph.  The default is 0.01.  If SphereSize
is a list, then it is applied cyclically to the Graphics3D
objects listed in the first argument to VRMLConvert.";

Surface::usage = "Surface is an option for VRMLConvert.  With
Surface -> True, surface properties are incorporated into the
VRML file.  With Surface -> False, no surface properties are
included.  If Surface is a list, it is applied cyclically to
the Graphics3D objects listed in the first argument to
VRMLConvert.";

SurfaceMaterial::usage = "SurfaceMaterial is an option for
VRMLConvert.  Its value must be a SurfaceColor directive or a
list of SurfaceColor directives.  The default is
SurfaceColor[GrayLevel[1],GrayLevel[0],0], which
is a diffuse white surface.  This is also Mathematica's default.
If SurfaceMaterial is a list, then it is applied cyclically
to the Graphics3D objects listed in the first argument to
VRMLConvert.  See SurfaceColor.";

Transparency::usage = "Transparency is an option for
VRMLConvert.  It is a number between 0.0 and 1.0, with 0.0
representing opaque.  The default is 0.0.  Thus the default
mimics Mathematica graphics, which do not support transparency.
If Transparency is a list of numbers, they are applied
cyclically to the Graphics3D objects listed in the first argument
to VRMLConvert.";

WWWAnchor::usage = "WWWAnchor is an option for VRMLConvert
that allows the VRML object to be linked to a URL.  Its value
is either None, or a list of URLs and descriptions
of the URLs, represented as strings.  Lists of URLs and
descriptions are applied cyclically to the Graphics3D objects
listed in the first argument to VMRLConvert.  For example,  
WWWAnchor -> {{\"http://www.mathsource.com/index.wrl\", \"Wolfram's Web Site\"}}
or
WWWAnchor -> {{\"http://www.mysite.edu/anothergraph.wrl\", \"A Related Graph\"},
{\"http://www.mathsource.com/index.wrl\", \"Wolfram's Web Site\"}}.";

AmbientLight::amlt = "Value of option AmbientLight -> `` is
not a valid RGBColor, Hue or GrayLevel nor a list of these.";

BoxRatios::bxrt = "Value of option BoxRatios -> `` is
not a list of 3 numbers.";

Camera::cmra = "Value of option Camera -> `` is neither
True nor False.";

EdgeMaterial::edmt = "Value of option EdgeMaterial is not a
valid SurfaceColor, None, nor a list of these.";

EmissiveColor::eclr = "Value of option EmissiveColor -> `` is
not a valid RGBColor, Hue, or GrayLevel or None nor a list
of these.";

Epilog::eplg = "Value of option Epilog -> `` is not a string.";

FocalDistance::fcdt = "Value of option FocalDistance -> `` is
not a positive number.";

HeightAngle::htan = "Value of option HeightAngle -> `` is not
a number between 0 and Pi/2.";

LabelColor::lclr = "Value of option LabelColor -> `` is not a
valid RGBColor, Hue, or GrayLevel.";

LabelLocation::lblc = "Value of option LabelLocation -> `` is
not a list of three numbers.";

LabelSize::lbsz = "Value of option LabelColor -> `` is not a
valid RGBColor, Hue, or GrayLevel.";

Lighting::ltng = "Value of option Lighting -> `` is neither
True nor False.";

LightSources::ltsr = "Value of option LightSources -> `` is
not a list of direction vectors and Hue[], GrayLevel[] or
RGBColor[,,] colors.  See the Mathematica book.";

PlotLabel::ptlb = "Value of option PlotLabel -> `` is not
a text string.";

PointPrecision::ptpr = "Value of option PointPrecision -> ``
is not a positive integer."

PointStyle::ptst = "Value of option PointStyle -> `` is not
Sphere or Point, nor a list of these.";

RemoveDuplicatePoints::rdpt = "Value of option
RemoveDuplicatePoints -> `` is neither True nor False.";

SphereSize::spsz = "Value of option SphereSize -> `` is not
a positive number nor a list of positive numbers.";

Surface::srfc = "Value of option Surface -> `` is neither
True nor False, nor a list of these.";

SurfaceMaterial::sfmt = "Value of SurfaceMaterial is not a
SurfaceColor, nor a list of SurfaceColors.";

SurfaceColor::dclr = "Value of diffusive color in
SurfaceColor is not a Hue[], GrayLevel[] or RGBColor[,,].";

SurfaceColor::sclr = "Value of specular color in
SurfaceColor is not a Hue, GrayLevel or RGBColor.";

SurfaceColor::spex = "Value of specular exponent in
SurfaceColor is not a non-negative number.";

Transparency::trns = "Value of option Transparency -> `` is
not a number between 0.0 and 1.0, nor a list of such numbers.";

ViewCenter::vwct = "Value of option ViewCenter -> `` is not
a list of 3 numbers.";

ViewPoint::vwpt = "Value of option ViewPoint -> `` is not
Automatic or a list of 3 numbers.";

ViewVertical::vwvt = "Value of option ViewVertical -> `` is
not a list of 3 numbers.";

WWWAnchor::wwwa = "Value of option WWWAnchor -> `` must be
a list of lists of strings containing URLs and descriptions 
of the URLs, or None.";

Options[VRMLConvert] = {
  AmbientLight -> GrayLevel[0],
  BoxRatios -> {1,1,1},
  Camera -> True,
  EdgeMaterial -> None,
  EmissiveColor -> GrayLevel[0],
  Epilog -> "",
  FocalDistance -> Automatic,
  HeightAngle -> Pi/4,
  LabelColor -> GrayLevel[1],
  LabelLocation -> {0, 1.05, 0},
  LabelSize -> 0.1,
  Lighting -> True,
  LightSources -> {{{1.,0.,1.},RGBColor[1,0,0]},
                   {{1.,1.,1.},RGBColor[0,1,0]},
                   {{0.,1.,1.},RGBColor[0,0,1]}},
  PointPrecision -> 4,
  PointStyle -> Sphere,
  PlotLabel -> "",
  RemoveDuplicatePoints -> True,
  SphereSize -> 0.01,
  Surface -> True,
  SurfaceMaterial ->
    SurfaceColor[GrayLevel[1], GrayLevel[0], 0],
  Transparency -> 0,
  ViewCenter -> Automatic,
  ViewPoint -> {1.3, -2.4, 2},
  ViewVertical -> {0, 0, 1},
  WWWAnchor -> None
};

Begin["`Private`"]

(* ======================================================= *)
(* Cross product *)
If[$VersionNumber < 3.0,
  Cross[a_,b_] := {a[[2]]b[[3]]-a[[3]]b[[2]],
				             a[[3]]b[[1]]-a[[1]]b[[3]],
		              	a[[1]]b[[2]]-a[[2]]b[[1]]}
];
(* ======================================================= *)
(* Product of two quaternions, used for combining two
   rotations *)
QuaternionProduct[q1_List,q2_List] := 
  Module[{v1,v2},
    v1 = Drop[q1,1];
    v2 = Drop[q2,1];
    Prepend[
      q1[[1]] v2 + q2[[1]] v1 + Cross[v1,v2],
      q1[[1]] q2[[1]] - v1.v2
    ]
  ]
(* ======================================================= *)
(* Inverse of a quaternion, used to reverse a rotation *)
QuaternionInverse[q_List] :=
  N[Prepend[- Drop[q,1], q[[1]]]/(q.q)];
(* ======================================================= *)
(* Converts a rotation angle, theta, and a rotation axis, v,
   to a unit quaternion *)
ToUnitQuaternion[theta_, v_List] :=
  N[Prepend[Sin[theta/2] v/Sqrt[v.v], Cos[theta/2]]];
(* ======================================================= *)
(* Convert a camera location, center of viewed object, and
   up direction to a rotation vector for orienting a VRML
   camera.  This is a translation of Stephen Chenney's
   <schenney@cs.berkeley.edu> orient.c program, available
   at ftp://ftp.cs.su.oz.au/stephen/vrml/orient.c.  Used by
   permission of the author. *)
ToRotationVector[camera_List, center_List, up_List] :=
  Module[{zdisplay,ydisplay,cameraRotationAxis,yNew,
          eyeRotation,totalRotation,totalRotationAxis,
          totalAxisLength},
    zdisplay = center - camera;
    zdisplay = zdisplay/Sqrt[zdisplay.zdisplay];
    ydisplay = up - (up.zdisplay) zdisplay;
    ydisplay = ydisplay/Sqrt[ydisplay.ydisplay];
    cameraRotationAxis = Cross[zdisplay, {0,0,1}];
    If[cameraRotationAxis.cameraRotationAxis < 10^-8,
      If[zdisplay[[3]] > 0, (* Camera facing opposite direction *)
        cameraRotation = {0.0, 0.0, 1.0, 0.0},
      (* Else *)        (* Camera already aligned *)
        cameraRotation = {1.0, 0.0, 0.0, 0.0}
      ],
    (* Else *)   (* Align sightLine with zdisplay axis *)
      cameraRotationAxis = cameraRotationAxis/
                   Sqrt[cameraRotationAxis.cameraRotationAxis];
      cameraRotation =
        ToUnitQuaternion[ArcCos[-zdisplay[[3]]],cameraRotationAxis]
    ];
    (* Determine how to align y axis with up vector *)
    yNew =
      Drop[QuaternionProduct[
        QuaternionProduct[cameraRotation, {0.0, 0.0 ,1.0 ,0.0}],
        QuaternionInverse[cameraRotation]
      ],1];
    upRotation =
      ToUnitQuaternion[ArcCos[yNew.ydisplay], {0,0,1}];
    totalRotation =
      QuaternionProduct[cameraRotation, upRotation];
    totalRotationAxis = Drop[totalRotation,1];
    totalAxisLength = totalRotationAxis.totalRotationAxis;
    If[totalAxisLength > 10^-8,
      totalRotationAxis =
        totalRotationAxis/Sqrt[totalAxisLength]
    ];
    N[Append[totalRotationAxis, 2 ArcCos[totalRotation[[1]]]]]
  ];
(* ======================================================= *)

(* Write a real number in FortranForm truncated to "digits" *)
(* digits precision.                                        *)
CompactForm[x_, digits_] :=
  SetPrecision[x, digits] // FortranForm // ToString
CompactForm[x_String, digits_] := x (* if already a string, do nothing *)

(* Insert spaces between coordinates of a point, place a    *)
(* comma at the end, and combine into one string.           *)
PointToString[pts_List, prec_Integer, tchar_:","] := 
  StringJoin[ 
    {" ", CompactForm[#, prec]}& /@ pts,
    tchar
  ]

(* Insert commas between indices for points and terminate   *)
(* with a -1 to indicate the end of the IndexedSet.         *)
IndexedSet[a_List] :=
  StringJoin[
    {ToString[# // FortranForm], ", "}& /@ a,
    "-1,\n"
  ]

IndexPolygonPoints[pts_List] :=
  Module[
    {i, j, len, pidx, polygonpts = pts, uniquepts, ptsidx},

    (* Sort the list of points. Add the array index to each    *)
    (* point before sorting to remember its original location. *)
    polygonpts = Sort[
      Table[{polygonpts[[i]], i}, {i, Length[polygonpts]}],
      OrderedQ[{#1[[1]], #2[[1]]}]&
    ];

    (* Find duplicates and make a list of the unique points.   *)
    (* Replace all duplicates by an index to the list of       *)
    (* unique points.                                          *)
    j = 1;
    pidx = 0;
    len = Length[polygonpts];
    uniquepts = Array[0&, len];
    While[ j <= len,
      ++pidx;
      uniquepts[[pidx]] = polygonpts[[j, 1]];
      While[ j <= len && polygonpts[[j, 1]] == uniquepts[[pidx]],
        polygonpts[[j, 1]] = pidx;
        ++j
      ]
    ];

    (* Make an array in which for each original point there is *)
    (* an index to an entry in the list of unique points.      *) 
    ptsidx = Array[0&, len];
    Do[
      j = polygonpts[[i]];
      ptsidx[[ j[[2]] ]] = j[[1]] - 1,
      {i, len}
    ];

    (* Return the list of unique points and the index list *)
    {Take[uniquepts, pidx], ptsidx}
  ]
  

(* ======================================================= *)
(* Convert Hue[], GrayLevel[] or RGBColor[,,] to a list of
   RGB colors between 0 and 1, converted to strings *)
ColorToRGBList[x_Hue] :=
  Module[{y = N[x[[1]] - Floor[x[[1]]]]},
    Which[
      y < .1667, {"1", ToString[6y], "0"},
      y < .3333, {ToString[-6y+2], "1", "0"},
      y < .5   , {"0", "1", ToString[6y-2]},
      y < .6667, {"0",    ToString[-6y+4], "1"},
      y < .8333, {ToString[6y-4], "0", "1"},
      True     , {"1", "0", ToString[-6y+6]}
    ]
  ];
ColorToRGBList[x_GrayLevel] :=
  Table[ToString[Max[0, Min[1,N[x[[1]]]] ]], {3}];
ColorToRGBList[x_RGBColor] :=
  Map[
    (ToString[Max[0.,#]])&,
    Map[(Min[1.,N[#]])&, Apply[List,x]]
  ];

(* ======================================================= *)
ValidColor[color_] :=
  ((Head[color] === GrayLevel || Head[color] === Hue)
    && Length[color] == 1 && NumberQ[N[ color[[1]] ]]) ||
  (Head[color] === RGBColor && Length[color] == 3
    && Apply[And, Map[NumberQ, N[color]]]);

(* ======================================================= *)
(* Convert Scaled coordinates to ordinary coordinates *)
ScaledToOrdinary[coord_List, boundingBox_,
  boxDimensions_] :=
  If[Length[coord] == 1,
    Transpose[boundingBox][[1]] + coord[[1]] boxDimensions,
  (* Else *)
    coord[[1]] + coord[[2]] boxDimensions
  ];

(* ======================================================= *)
(* Generates VRML for one Graphics3D object in the list of
   arguments to VRMLConvert *)
CreateVRMLPlot[plot_Graphics3D, wrlFile_OutputStream,
  plotrange_List, wwwanchor_List, surface_, ambientlight_List,
  diffusecolor_List, specularcolor_List, emissivecolor_List,
  shininess_String, transparency_String, pointstyle_Symbol,
  spheresizeinput_Real, edgeflag_Symbol, edgeshininess_String,
  edgespecularcolor_List, edgediffusecolor_List,
  maxBoxDimension_Real, nplot_Integer, pointprec_Integer, remduppts_
] :=
Module[{boxDimensions,spheresize,polygons,lines,cuboids,points,
        text,somepolygons,somelines,somecuboids,somepoints,
        sometext,polygonpts,linepts,cuboidpts,textpts,center,
        dimensions,lower,upper, i, ptsindex
       },
  boxDimensions = Map[(#[[2]] - #[[1]])&, plotrange];

  (* Extract the coordinates of all graphics primitives
     from plot *)
  
  polygons = N[Cases[InputForm[plot],
                   Polygon[a_,___] -> a, Infinity]];
  lines = N[Cases[InputForm[plot],
                   Line[a_] -> a, Infinity]];
  cuboids = N[Cases[InputForm[plot],
                   Cuboid[a__] -> List[a], Infinity]];
  points = N[Cases[InputForm[plot],
                   Point[a_] -> a, Infinity]];
  text = N[Cases[InputForm[textplot],
           Text[a_,b_,___] -> List[a,b], Infinity]] /. 
           FontForm[a_,b_] -> a;
  
  somepolygons = (Length[polygons] != 0);
  somelines = (Length[lines] != 0);
  somecuboids = (Length[cuboids] != 0);
  somepoints = (Length[points] != 0);
  sometext = (Length[text] != 0);

  polygonpts = If[somepolygons, Flatten[polygons,1]];
  linepts = If[somelines, Flatten[lines,1]];
  cuboidpts = If[somecuboids, Flatten[cuboids,1]];
  (* pointspts = points, so there is no need to assign it *)
  textpts = If[sometext, Transpose[text][[2]]];

  polygons = polygons /. Scaled[a___] :> 
    ScaledToOrdinary[List[a],plotrange,boxDimensions];
  lines = lines /. Scaled[a___] :> 
    ScaledToOrdinary[List[a],plotrange,boxDimensions];
  cuboids = cuboids /. Scaled[a___] :> 
    ScaledToOrdinary[List[a],plotrange,boxDimensions];
  points = points /. Scaled[a___] :> 
    ScaledToOrdinary[List[a],plotrange,boxDimensions];
  text = text /. Scaled[a___] :> 
    ScaledToOrdinary[List[a],plotrange,boxDimensions];

  (* Insert WWWAnchor *)
  
  If[wwwanchor[[1]] =!= "",
    WriteString[wrlFile,
      "  WWWAnchor {\n",
      "    name \"",
        If[Length[wwwanchor]==0, wwwanchor, wwwanchor[[1]] ],
         "\"\n",
      If[Length[wwwanchor]==2,
        StringJoin["    description \"",wwwanchor[[2]],"\"\n"]
      ]
    ]
  ];

  WriteString[wrlFile,
    "  Separator { # graph ", nplot, "\n"
  ];

  (* Print surface properties *)
  
  If[surface === True,
    WriteString[wrlFile,
      "    Material {\n",
      "      ambientColor ", ambientlight[[1]]," ",
         ambientlight[[2]]," ",ambientlight[[3]], "\n",
      "      diffuseColor ", diffusecolor[[1]]," ",
         diffusecolor[[2]]," ",diffusecolor[[3]], "\n",
      "      specularColor ", specularcolor[[1]]," ",
         specularcolor[[2]]," ",specularcolor[[3]], "\n",
      "      emissiveColor ", emissivecolor[[1]]," ",
         emissivecolor[[2]]," ",emissivecolor[[3]], "\n",
      "      shininess ",shininess, "\n",
      "      transparency ",transparency, "\n",
      "    }\n"
    ]
  ];

  (* Create all of the polygons in .wrl file *)
  
  If[somepolygons,
    WriteString[wrlFile,
      "    Group {  # All of the Polygons\n",
      "      Coordinate3 {\n",
      "        point[\n"
    ];
  
    (* Remove duplicate points and generate an index to the *)
    (* set of uniques points.                               *)
    If[ remduppts,
      {polygonpts, ptsindex} = IndexPolygonPoints[polygonpts]
    ];

    (* List the coordinates of all vertices for the polygons.
       These will be referred to in the next section by their 
       indices. *)

    WriteString[wrlFile,
      TableForm[
        Map[PointToString[#, pointprec]&, polygonpts],
      TableSpacing->{0}]
    ];
    WriteString[wrlFile,
      "\n        ]\n",
      "      }\n",
      "      IndexedFaceSet {\n",
      "        coordIndex[\n"
    ];
   
    (* Create the VRML polygons, indexed from the list of
       coordinates above. *)

    If[ remduppts,
      (* If duplicate points have been removed, write *)
      (* the indices to the list of unique points the *)
      (* wrl file.                                    *)
      upper =  0;
      Do[
        lower = upper;
        upper += Length[polygons[[i]]];
        WriteString[
          wrlFile,
          IndexedSet[ ptsindex[[Range[lower+1, upper]]] ]
        ],
        {i, Length[polygons]}
      ],

      (* Otherwise, write the array indices of the    *)
      (* original point list.                         *)
      upper = -1;
      Do[
        lower = upper;
        upper += Length[polygons[[i]]];
        WriteString[
          wrlFile,
          IndexedSet[ Range[lower+1, upper] ]
        ],
        {i, Length[polygons]}
      ]
    ];

    WriteString[wrlFile,
      "        ]\n",
      "      }\n"
    ];

    (* Create edges of polygons *)

    If[edgeflag =!= None,
      WriteString[wrlFile,
        "      Separator {\n",
        "        Material {\n",
        "          diffuseColor ", edgediffusecolor[[1]]," ",
                     edgediffusecolor[[2]]," ",
                     edgediffusecolor[[3]], "\n",
        "          specularColor ", edgespecularcolor[[1]]," ",
                     edgespecularcolor[[2]]," ",
                     edgespecularcolor[[3]], "\n",
        "          shininess ", edgeshininess, "\n",
        "        }\n",
        "        IndexedLineSet {\n",
        "          coordIndex[\n"
      ];
      If[ remduppts,
        upper =  0;
        Do[
          lower = upper;
          upper += Length[polygons[[i]]];
          WriteString[
            wrlFile,
            IndexedSet[ ptsindex[[Range[lower+1, upper]]] ]
          ],
          {i, Length[polygons]}
        ],
      
        upper = -1;
        Do[
          lower = upper;
          upper += Length[polygons[[i]]];
          WriteString[ wrlFile, IndexedSet[Range[lower+1, upper]] ],
          {i, Length[polygons]}
        ]
      ];
      WriteString[wrlFile,
        "          ]\n",
        "        }\n",
        "      }\n"
      ]
    ];

    WriteString[wrlFile,
      "    }\n"
    ]
  ];  (* EndIf for polygons *)

  (* Create all of the lines in .wrl file *)
  
  If[somelines,
    WriteString[wrlFile,
      "    Group {  # All of the Lines\n",
      "      Coordinate3 {\n",
      "        point[\n"
    ];
  
    (* List the coordinates of all endpoints for the line
       segments.  These will be referred to in the next
       section by their indices. *)

    WriteString[wrlFile,
      TableForm[
        Map[PointToString[#, pointprec]&, linepts],
      TableSpacing->{0}]
    ];
    WriteString[wrlFile,
      "\n        ]\n",
      "      }\n",
      "      IndexedLineSet {\n",
      "        coordIndex[\n"
    ];
   
    (* Create the VRML line segments, indexed from the list of
       coordinates above. *)

    upper = -1;
    Do[
      lower = upper;
      upper = lower + Length[lines[[i]]];
      WriteString[wrlFile, IndexedSet[Range[lower+1, upper]]],
    {i,Length[lines]}];

    WriteString[wrlFile,
      "        ]\n",
      "      }\n",
      "    }\n"
    ]
  ];  (* EndIf for lines *)  

  (* Create all of the cuboids in .wrl file *)

  If[somecuboids,
    Do[
      If[Length[cuboids[[i]]] == 2,  
              (* Max & min coords are specified in Cuboid[] *)
        center = Map[((#[[1]] + #[[2]])/2.0)&,
          Transpose[cuboids[[i]]]];
        dimensions = Map[(#[[2]] - #[[1]])&,
          Transpose[cuboids[[i]]]];
        WriteString[wrlFile,
          "    TransformSeparator {\n",
          "      Translation { translation ",center[[1]], " ",
            center[[2]], " ", center[[3]], " }\n",
          "      Cube {\n",
          "        width ",dimensions[[1]], " height ",
            dimensions[[2]], " depth ", dimensions[[3]], "\n",
          "      }\n",
          "    }\n"
        ],
      (* Else If[Length[cuboid[[i]]] == 1 *)
           (* Min coords only are specified in Cuboid[].
           Lengths of sides are 1 by default in Mathematica *)
        center = cuboids[[i,1]] + {0.5, 0.5, 0.5};
        WriteString[wrlFile,
          "    TransformSeparator {\n",
          "      Translation{ translation ",center[[1]], " ",
            center[[2]], " ", center[[3]], " }\n",
          "      Cube {\n",
          "        width 1 height 1 depth 1\n",
          "      }\n",
          "    }\n"
        ];
      ],
    {i,Length[cuboids]}] (* EndDo *)
  ]; (* EndIf *)

  (* Create all of the points in .wrl file *)

  If[somepoints && (pointstyle === Sphere),
    spheresize = ToString[
      FortranForm[N[spheresizeinput maxBoxDimension/2]]
    ];
    Do[
      WriteString[wrlFile,
        "    TransformSeparator {\n",
        "      Translation{ translation ", points[[i,1]], " ",
          points[[i,2]], " ", points[[i,3]], " }\n",
        "      Sphere { radius ", spheresize, " }\n",
        "    }\n"
      ],
    {i,Length[points]}]
  ];
  If[somepoints && (pointstyle === Point),
    WriteString[wrlFile,
      "    Group {  # All of the Points\n",
      "      Coordinate3 {\n",
      "        point [\n"
    ];
    WriteString[wrlFile,
      TableForm[
        Map[PointToString[#, pointprec]&, points],
      TableSpacing->{0}]
    ];
    WriteString[wrlFile,
      "\n        ]\n",
      "      }\n",
      "      PointSet{}\n",
      "    }\n"
    ];
  ];

  (* Create all of the text in .wrl file *)

  If[sometext,
    Do[
      WriteString[wrlFile,
        "    TransformSeparator {\n",
        "      Translation{ translation ", text[[i,2,1]], " ",
          text[[i,2,2]], " ", text[[i,2,3]], " }\n",
        "      AsciiText {\n",
        "        string \"", 
          StringReplace[text[[i,1]], {"\"" -> "\\\""}],
          "\"\n",
        "        justification CENTER\n",
        "      }\n",
        "    }\n"
      ],
    {i,Length[text]}]
  ];
  
  WriteString[wrlFile, "  }\n"];
  If[wwwanchor[[1]] =!= "",
    WriteString[wrlFile, "  }\n"]
  ]
];

(* ======================================================= *)
(* VRMLConvert is the major function in the package *)

VRMLConvert[plot_Graphics3D, filename_String, opts___Rule] := 
  VRMLConvert[List[plot], filename, opts];
VRMLConvert[plot_SurfaceGraphics, filename_String,
                                              opts___Rule] :=
  VRMLConvert[List[Graphics3D[plot]], filename, opts];
VRMLConvert[plotlist_List, filename_String, opts___Rule] :=
Module[{viewpoint,transparency,plotlabel,ambientlight,
        diffusecolor,specularcolor,emissivecolor,shininess,
        center,boundingBox,maxBoxDimension,cameraPosition,
        sightLine,focalDistance,a,i,heightAngle,labelcolor,
        labelposition,labelsize,spheresize,epilog,wrlFile,
        lightsources,pointstyle,viewventer,viewvertical,
        boxDiameter,xdisplay,ydisplay,zdisplay,plotoptions,
        displayTransform,boxDimensions,wwwanchor,plot,
        edgematerial,edgeshininess,edgespecularcolor,edgeflag,
        edgediffusecolor,boxratios,cameraRotation,camera,
        lighting,surface, pointprec, remduppts
       },

  pointprec = PointPrecision /. {opts} /. Options[VRMLConvert];
  If[ !(IntegerQ[pointprec] && Positive[pointprec]),
    Message[PointPrecision::ptpr, pointprec];
    Return[]
  ];

  (* Convert SurfaceGraphics to Graphics3D *)
  
  plot =
  Map[
    (If[Head[#] === SurfaceGraphics, Graphics3D[#], #])&,
    Flatten[plotlist]
  ];

  (* Process options *)

  plotrules =
    {AmbientLight -> FullOptions[plot,AmbientLight],
     BoxRatios    -> FullOptions[Last[plot],BoxRatios],
     Lighting     -> FullOptions[Last[plot],Lighting],
     LightSources -> FullOptions[Last[plot],LightSources],
     PlotRange    -> FullOptions[plot,PlotRange],
     ViewCenter   -> FullOptions[Last[plot],ViewCenter],
     ViewPoint    -> FullOptions[Last[plot],ViewPoint],
     ViewVertical -> FullOptions[Last[plot],ViewVertical]
    };
  
  ambientlight = AmbientLight /.{opts} /. plotrules /.
    Options[VRMLConvert];
  If[Head[ambientlight] =!= List,
    ambientlight = List[ambientlight]
  ];
  ambientlight = Flatten[ambientlight];
  If[Apply[And, Map[ValidColor, ambientlight]],
    ambientlight = Map[ColorToRGBList, ambientlight],
  (* Else *)
    Message[AmbientLight::amlt, ambientlight];
    Return[]
  ];
  boxratios = N[BoxRatios /. {opts} /. plotrules /.
    Options[VRMLConvert]];
  If[Apply[And, Map[NumberQ, boxratios]] &&
          Length[boxratios] == 3, Null,
    Message[BoxRatios::bxrt, boxratios];
    Return[]
  ];
  camera = Camera /. {opts} /. Options[VRMLConvert];
  If[camera =!= True && camera =!= False,
    Message[Camera::cmra, camera];
    Return[]
  ];
  edgematerial = EdgeMaterial /. {opts} /. Options[VRMLConvert];
  If[Head[edgematerial] =!= List,
    edgematerial = List[edgematerial]
  ];
  edgematerial = Flatten[edgematerial];
  If[Apply[And, Map[(Head[#] === SurfaceColor || # === None)&,
      edgematerial]], Null,
    Message[EdgeMaterial::edmt, edgematerial];
    Return[]
  ];
  edgeflag = Map[(If[# ===  None, None, All])&, edgematerial];
  edgeshininess = Table["0", {Length[edgematerial]}];
  edgespecularcolor =
    Table[{"0", "0", "0"}, {Length[edgematerial]}];
  edgediffusecolor =
    Table[{"1", "1", "1"}, {Length[edgematerial]}];
  Do[
    If[edgematerial[[i]] =!= None,
      If[Length[edgematerial[[i]]] >= 3,
        If[NumberQ[N[edgematerial[[i,3]]]]
                            && 0.0 <= N[edgematerial[[i,3]]],
          (* VRML's specular exponent is a normalization of
             openGL's specular exponent, which has a range of 0
             to 128.  Mathematica's specular exponent is 
             truncated to 128 and then normalized. *)
          edgeshininess[[i]] =
            ToString[Min[128., N[edgematerial[[i,3]] ]]/128.],
        (* Else *)
          Message[SurfaceColor::spex, edgematerial[[i,3]]];
          Return[]
        ];
      ];
      If[Length[edgematerial[[i]]] >= 2,
        If[ValidColor[edgematerial[[i,2]]],
          edgespecularcolor[[i]] =
            ColorToRGBList[edgematerial[[i,2]]],
        (* Else *)
          Message[SurfaceColor::sclr, edgematerial[[i,2]]];
          Return[]
        ];
      ];
      If[Length[edgematerial[[i]]] >= 1,
        If[ValidColor[edgematerial[[i,1]]],
          edgediffusecolor[[i]] =
            ColorToRGBList[edgematerial[[i,1]]],
        (* Else *)
          Message[SurfaceColor::dclr, edgematerial[[i,1]]];
          Return[]
        ];
      ]
    ],
  {i,Length[edgematerial]}];
  emissivecolor = EmissiveColor /.{opts} /. Options[VRMLConvert];
  If[Head[emissivecolor] =!= List,
    emissivecolor = List[emissivecolor]
  ];
  emissivecolor = Flatten[emissivecolor];
  If[Apply[And, Map[ValidColor, emissivecolor]],
    emissivecolor = Map[ColorToRGBList, emissivecolor],
  (* Else *)
    Message[EmissiveColor::eclr, emissivecolor];
    Return[]
  ];
  epilog = Epilog /. {opts} /. Options[VRMLConvert];
  If[StringQ[epilog], Null,
    Message[Epilog::eplg, epilog];
    Return[]
  ];
  epilog = StringReplace[epilog, {"\"" -> "\\\""}];
  focalDistance = FocalDistance /. {opts} /. Options[VRMLConvert];
    If[focalDistance == "Automatic" || 
       (NumberQ[N[focalDistance]] && 0.0 < N[focalDistance]), Null,
    Message[FocalDistance::fcdt, focalDistance];
    Return[]
  ];
  focalDistance = CompactForm[N[focalDistance], pointprec];
  heightAngle = HeightAngle /. {opts} /. Options[VRMLConvert];
  If[NumberQ[N[heightAngle]] &&
      0.0 < N[heightAngle] && N[heightAngle] < N[Pi/2], Null,
    Message[HeightAngle::htan, heightAngle];
    Return[]
  ];
  heightAngle = CompactForm[N[heightAngle], pointprec];
  labelcolor = LabelColor /.{opts} /. Options[VRMLConvert];
  If[ValidColor[labelcolor],
    labelcolor = ColorToRGBList[labelcolor],
  (* Else *)
    Message[LabelColor::lclr, labelcolor];
    Return[]
  ];
  labellocation = LabelLocation /. {opts} /. Options[VRMLConvert];
  If[(Apply[And, Map[NumberQ, labellocation]] &&
          Length[labellocation] == 3), Null,
    Message[LabelLocation::lblc, labellocation];
    Return[]
  ];
  labelsize = LabelSize /. {opts} /. Options[VRMLConvert];
    If[(NumberQ[N[labelsize]] && 0.0 < N[labelsize]), Null,
    Message[LabelSize::lbsz, labelsize];
    Return[]
  ];
  lighting = Lighting /. {opts} /. plotrules /.
    Options[VRMLConvert];
  If[ lighting =!= True && lighting =!= False,
    Message[Lighting::ltng, lighting];
    Return[]
  ];  
  lightsources = LightSources /. {opts} /. plotrules /.
    Options[VRMLConvert];
  If[Apply[And,
      Table[
        (Apply[And, Map[NumberQ, lightsources[[i,1]] ]]
            && Length[ lightsources[[i,1]] ] == 3) &&
        ValidColor[lightsources[[i,2]]],
      {i,Length[lightsources]}]], Null,
    Message[LightSources::ltsr, lightsources];
    Return[]
  ];
  plotlabel = PlotLabel /. {opts} /. Options[VRMLConvert];
  If[StringQ[plotlabel], Null,
    Message[PlotLabel::ptlb, plotlabel];
    Return[]
  ];
  plotlabel = StringReplace[plotlabel, {"\"" -> "\\\""}];
  pointstyle = PointStyle /. {opts} /. Options[VRMLConvert];
  If[Head[pointstyle] =!= List,
    pointstyle = List[pointstyle]
  ];
  pointstyle = Flatten[pointstyle];
  If[Apply[And,
      Map[(# === Sphere || # === Point)&, pointstyle]], Null,
    Message[PointStyle::ptst, pointstyle];
    Return[]
  ];
  remduppts = RemoveDuplicatePoints /. {opts}
    /. Options[VRMLConvert];
  If[ remduppts =!= True && remduppts =!= False,
    Message[RemoveDuplicatePoints::rdpt, remduppts];
    Return[]
  ];
  spheresize = SphereSize /. {opts} /. Options[VRMLConvert];
  If[Head[spheresize] =!= List,
    spheresize = List[spheresize]
  ];
  spheresize = Flatten[spheresize];
  If[Apply[And,
      Map[(NumberQ[N[#]] && 0.0 < N[#])&, spheresize]], Null,
    Message[SphereSize::spsz, spheresize];
    Return[]
  ];
  surface = Surface /. {opts} /. Options[VRMLConvert];
  If[Head[surface] =!= List,
    surface = List[surface]
  ];
  surface = Flatten[surface];
  If[Apply[And, Map[(# === True || # === False)&, surface]], Null,
    Message[Surface::srfc, surface];
    Return[]
  ];
  surfacematerial = SurfaceMaterial /. {opts} /. Options[VRMLConvert];
  If[Head[surfacematerial] =!= List,
    surfacematerial = List[surfacematerial]
  ];
  surfacematerial = Flatten[surfacematerial];
  If[Apply[And,
      Map[(Head[#] =!= SurfaceColor)&, surfacematerial]],
    Message[SurfaceMaterial::sfmt, surfacematerial];
    Return[]
  ];
  shininess = Table["0", {Length[surfacematerial]}];
  specularcolor =
    Table[{"0", "0", "0"}, {Length[surfacematerial]}];
  diffusecolor =
    Table[{"1", "1", "1"}, {Length[surfacematerial]}];
  Do[
    If[Length[surfacematerial[[i]]] >= 3,
      If[NumberQ[N[surfacematerial[[i,3]]]]
                            && 0.0 <= N[surfacematerial[[i,3]]],
        (* VRML's specular exponent is a normalization of
           openGL's specular exponent, which has a range of 0
           to 128.  Mathematica's specular exponent is 
           truncated to 128 and then normalized. *)
        shininess[[i]] =
          ToString[Min[128., N[surfacematerial[[i,3]] ]]/128.],
      (* Else *)
        Message[SurfaceColor::spex, surfacematerial[[i,3]]];
        Return[]
      ];
    ];
    If[Length[surfacematerial[[i]]] >= 2,
      If[ValidColor[surfacematerial[[i,2]]],
        specularcolor[[i]] =
          ColorToRGBList[surfacematerial[[i,2]]],
      (* Else *)
        Message[SurfaceColor::sclr, surfacematerial[[i,2]]];
        Return[]
      ];
    ];
    If[Length[surfacematerial[[i]]] >= 1,
      If[ValidColor[surfacematerial[[i,1]]],
        diffusecolor[[i]] =
          ColorToRGBList[surfacematerial[[i,1]]],
      (* Else *)
        Message[SurfaceColor::dclr, surfacematerial[[i,1]]];
        Return[]
      ];
    ],
  {i,Length[surfacematerial]}];
  transparency = Transparency /. {opts} /. Options[VRMLConvert];
  If[Head[transparency] =!= List,
    transparency = List[transparency]
  ];
  transparency = Flatten[transparency];
  If[Apply[And,
      Map[(NumberQ[N[#]] && 0.0 <= N[#] && N[#] <= 1.0)&,
        transparency]
      ], Null,
    Message[Transparency::trns, transparency];
    Return[]
  ];
  transparency = Map[CompactForm[#, pointprec]&, transparency];
  viewcenter = N[ViewCenter /. {opts} /. plotrules /.
    Options[VRMLConvert]];
  If[viewcenter === Automatic ||
         (Apply[And, Map[NumberQ, viewcenter]] &&
          Length[viewcenter] == 3), Null,
    Message[ViewCenter::vwct, viewcenter];
    Return[]
  ];
  viewpoint = N[ViewPoint /. {opts} /. plotrules /.
    Options[VRMLConvert]];
  If[viewpoint === Automatic ||
         (Apply[And, Map[NumberQ, viewpoint]] &&
          Length[viewpoint] == 3), Null,
    Message[ViewPoint::vwpt, viewpoint];
    Return[]
  ];
  viewvertical = N[ViewVertical /. {opts} /. plotrules /.
    Options[VRMLConvert]];
  If[viewvertical === Automatic ||
         (Apply[And, Map[NumberQ, viewvertical]] &&
          Length[viewvertical] == 3), Null,
    Message[ViewVertical::vwvt, viewvertical];
    Return[]
  ];
  wwwanchor = WWWAnchor /. {opts} /. Options[VRMLConvert];
  If[wwwanchor === None,
    wwwanchor = {{""}},
  (* Else *) If[
       (Apply[And, Flatten[Map[StringQ, wwwanchor, {2}]]] &&
       Apply[And, Map[(1 <= Length[#] && Length[#] <= 2)&,
                                                wwwanchor]]), Null,
    Message[WWWAnchor::wwwa, wwwanchor];
    Return[]
  ]];

  (* Calculate position and orientation of camera, lights, and
     PlotLabel using ViewPoint, ViewCenter, and ViewVertical
     *)
  
  plotrange = FullOptions[plot,PlotRange];
  boundingBox =
    Table[
     {
      Min[Table[plotrange[[k,i,1]], {k,Length[plotrange]}]],
      Max[Table[plotrange[[k,i,2]], {k,Length[plotrange]}]]
     },
    {i,3}];
  boxDimensions = Map[(#[[2]] - #[[1]])&, boundingBox];
  maxBoxDimension = Max[boxDimensions];
  boxDiameter = 
    N[Sqrt[Apply[Plus, boxDimensions boxDimensions]]];
  
  (* Position the Camera *)
  
  If[viewcenter === Automatic,
    center = Map[((#[[1]] + #[[2]])/2.0)&, boundingBox],
  (* Else *)
    center = N[ Transpose[boundingBox][[1]] +
                                  viewcenter boxDimensions ];
  ];
  cameraPosition =
    Max[boxratios] boxDimensions/boxratios viewpoint + center;
  sightLine = center - cameraPosition;
  (* Display coordinates, used for positioning camera and
     LightSources *)
  zdisplay = -sightLine/Sqrt[sightLine.sightLine];
  If[Solve[zdisplay == Chop[a viewvertical], a] == {},
    ydisplay = viewvertical - (viewvertical.zdisplay) zdisplay,
  (* Else *)   (* Linearly dependent => pick any ydisplay 
                                     perpendicular to zdisplay *)
    If[zdisplay[[1]] == 0,
      viewvertical = {1, 0, 0};
      ydisplay = {1, 0, 0},
    (* Else *)
      viewvertical = {zdisplay[[2]], - zdisplay[[1]], 0};
      ydisplay = viewvertical
    ]
  ];
  ydisplay = ydisplay/Sqrt[ydisplay.ydisplay];
  xdisplay = Cross[ydisplay, zdisplay];
  cameraRotation = ToRotationVector[cameraPosition, center, viewvertical];
  If[focalDistance == "Automatic",
    focalDistance = Sqrt[sightLine.sightLine];
  ];
  (* labellocation is given in the display coordinate system,
     the same coordinate system used by LightSources *)
  labellocation =
    Map[(ToString[FortranForm[#]])&, labellocation];
  
  (* Open .wrl file for writing *)
  
  wrlFile = OpenWrite[filename];
  SetOptions[wrlFile, PageWidth->Infinity];
  
  (* Write header information *)
    
  WriteString[wrlFile, 
    "#VRML V1.0 ascii\n\n",
    "Group {\n",
    "  Info { string\n",
    "    \"This VRML world was automatically generated from a\n",
    "    Mathematica 3D graphic using the public domain Mathematica\n",
    "    package, VRMLConvert 1.0, written by H. Edward Donley\n",
    "    <http://www.ma.iup.edu/MathDept/Professors/HDonley.html>\"\n",
    "  }\n"
  ];

  (* Print camera properties *)
  If[camera === True,
    WriteString[wrlFile,
      "    PerspectiveCamera {\n",
      "      position ",
      PointToString[cameraPosition, pointprec, " "], "\n",
        
      "      orientation ",
      PointToString[cameraRotation, pointprec, " "], "\n",
        
      "      focalDistance ",
      CompactForm[focalDistance, pointprec], "\n",
        
      "      heightAngle ",
      CompactForm[heightAngle, pointprec], "\n",
      "    }\n"
    ]
  ];

  WriteString[wrlFile, 
    "  ShapeHints {creaseAngle 0.1}\n"
  ];

  If[lighting === True || plotlabel =!= "",
    WriteString[wrlFile, 
      "  TransformSeparator {\n",
      "    Translation { translation ",
      PointToString[center, pointprec, " "], " }\n",
      "    Scale { scaleFactor ",
      PointToString[
        Table[N[boxDiameter]/2., {3}], pointprec, " "
      ], " }\n",
      "    Rotation { rotation ",
      PointToString[cameraRotation, pointprec, " "], " }\n"
    ]
  ];
  
  (* Insert all of the light sources *)
  
  If[lighting === True,
    Do[
      WriteString[wrlFile,
        "    DirectionalLight {\n",
        "      color ", 
           TableForm[ColorToRGBList[lightsources[[i,2]]],
             TableDirections -> Row], "\n",
        "      direction ",
           TableForm[ -lightsources[[i,1]],
             TableDirections -> Row], "\n",
        "    }\n"
      ],
    {i,Length[lightsources]}]
  ];

  (* Print PlotLabel, if there is one *)
  
  If[plotlabel =!= "",
    WriteString[wrlFile, 
      "    Separator {\n",
      "      FontStyle { size ", 
        FortranForm[2.0 N[labelsize]], " }\n",
      "      Material { diffuseColor ", labelcolor[[1]], " ",
        labelcolor[[2]], " ", labelcolor[[3]], " }\n",
      "      Translation { translation ",
        labellocation[[1]], " ",
        labellocation[[2]], " ", labellocation[[3]], " }\n",
      "      AsciiText {\n",
      "        string \"", plotlabel, "\"\n",
      "        justification CENTER\n",
      "      }\n",
      "    }\n"
    ]
  ];
  If[lighting === True || plotlabel =!= "",
    WriteString[wrlFile, "  }\n"]
  ];

  (* Convert and write the plots in plotlist to VRML *)
  Do[
    CreateVRMLPlot[
      plot[[i]],
      wrlFile,
      plotrange[[i]],
      wwwanchor[[ Mod[i-1,Length[wwwanchor]]+1 ]],
      surface[[ Mod[i-1,Length[surface]]+1 ]],
      ambientlight[[ Mod[i-1,Length[ambientlight]]+1 ]],
      diffusecolor[[ Mod[i-1,Length[diffusecolor]]+1 ]],
      specularcolor[[ Mod[i-1,Length[specularcolor]]+1 ]],
      emissivecolor[[ Mod[i-1,Length[emissivecolor]]+1 ]],
      shininess[[ Mod[i-1,Length[shininess]]+1 ]],
      transparency[[ Mod[i-1,Length[transparency]]+1 ]],
      pointstyle[[ Mod[i-1,Length[pointstyle]]+1 ]],
      spheresize[[ Mod[i-1,Length[spheresize]]+1 ]],
      edgeflag[[ Mod[i-1,Length[edgematerial]]+1 ]],
      edgeshininess[[ Mod[i-1,Length[edgeshininess]]+1 ]],
      edgespecularcolor[[ Mod[i-1,Length[edgespecularcolor]]+1 ]],
      edgediffusecolor[[ Mod[i-1,Length[edgediffusecolor]]+1 ]],
      maxBoxDimension, i, pointprec, remduppts
    ],
  {i,Length[plot]}];

  (* Finish up *)
  
  If[epilog != "",
    WriteString[wrlFile, epilog, "\n"]
  ];
  WriteString[wrlFile, "}\n"];

  Close[wrlFile]
] (* EndModule *)

End[]

Protect[QuaternionProduct, QuaternionInverse,
  ToUnitQuaternion, ToRotationVector, VRMLConvert, Camera,
  EdgeMaterial, EmissiveColor, FocalDistance, HeightAngle,
  LabelColor, LabelLocation, LabelSize, PointStyle,
  SphereSize, Surface, SurfaceMaterial, Transparency,
  PointPrecision, RemoveDuplicatePoints, WWWAnchor];

EndPackage[]