(** m2wrl.m -- functions to convert Mathematica 3D graphics objects
 * to virtual reality modeling language (VRML) version 1.0 documents.
 * @author Eric Laroche
 * @version @(#)$Id: m2wrl.m,v 1.4 1998/04/04 16:49:43 laroche Exp $
 **)
(* m2wrl.m -- functions to convert Mathematica 3D graphics objects
 * to virtual reality modeling language (VRML) version 1.0 documents.
 * Copyright (C) 1998 Eric Laroche.
 *
 * This program is free software;
 * you can redistribute it and/or modify it.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 *)

(*:Name: m2wrl` *)
(*:Author: Eric Laroche *)
(*:Context: m2wrl` *)
(*:Package Version: 1.4 *)
(*:Copyright: Copyright (C) 1998 Eric Laroche *)
(*:History: none. *)
(*:Keywords:
	virtual reality modeling language, VRML 1.0, graphics objects *)
(*:Requirements: none. *)
(*:Warnings:
	There are severe limitations in these functions, e.g. number
	output is deliberately limited to non-exponential representation,
	which may return unusable results depending on the input
	scale. *)
(*:Source: VRML 1.0 specification. *)
(*:Limitations:
	Currently, only Polygon primitives are supported, but it's easy
	to extend the functions to process the other 3D primitives, since
	most of them are also present in VRML 1.0.
	The functions consider only the first argument of a Graphics3D
	object, i.e. the list of graphic primitives; plot options
	(PlotRange, Boxed, ViewPoint, LightSources, etc.) are not
	considered.
	The VRML output is not optimized for minimal size; gzip it after
	conversion; VRML browsers usually handle gzipped wrl data. *)
(*:Summary:
	This package provides simple functions to convert Mathematica 3D
	graphics objects to virtual reality modeling language (VRML)
	version 1.0 documents.
	The polygons are constructed by using a shared set of points,
	which makes the rendering faster and gives the VRML browser
	better hints how to shade the polygons. *)
(*:Discussion: none. *)

(* package m2wrl` *)
BeginPackage["m2wrl`"]

(* exported variables and functions *)
m2wrl::usage =
	"m2wrl[g]: converts a Graphics3D object to a string representing
	the object as VRML 1.0 document.
	Use WriteString[] to write it to a file."

(* internal part *)
Begin["`Private`"]

(* disclaimer *)
m2wrl::disclaimer =
	"m2wrl.m -- functions to convert Mathematica 3D graphics objects
	to virtual reality modeling language (VRML) version 1.0 documents.
	Copyright (C) 1998 Eric Laroche.\n
	This program is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE."
Message[m2wrl::disclaimer]

m2wrl::unsupl =
	"List of Graphics3D objects required as input"

(* convert a Graphics3D object to a VRML 1.0 object. *)
m2wrl[g_Graphics3D] :=
	m2wrl[List[g]]
m2wrl[gl_List] :=
	If[Select[gl, (Head[#] =!= Graphics3D)&] != {}, Message[m2wrl::unsupl]; "",
	StringJoin[
		(* document layer *)

		(* required VRML header *)
		"#VRML V1.0 ascii\n",

		(* comment about this *)
		"# graphics data converted by m2wrl.m (lr)\n",
		"\n",

		(* root object *)
		"# root collection of graphic objects\n",
		"Separator\n",
		"{\n",

		" # turn 'z coordinate up to 'y\n",
		" MatrixTransform\n",
		" {\n",
		"  matrix\n",
		"   1 0 0 0\n",
		"   0 0 -1 0\n",
		"   0 1 0 0\n",
		"   0 0 0 1\n",
		" }\n",
		"\n",

		(* use the pointlist implementation of m2wrlGraphics3D[],
		 * which makes the rendering faster and gives the VRML browser
		 * better hints how to shade the polygons.
		 *)
		Apply[StringJoin, Map[Function[g,
			m2wrlGraphics3D[g, PointList[g]]],
			gl]],

		"}\n",
		"\n"]]

m2wrlGraphics3D::usage =
	"m2wrlGraphics3D[g]: converts a graphic object to a string
	representing a VRML 1.0 object, without shared points.\n
	m2wrlGraphics3D[g,pl]: same thing witht shared points from pl."
m2wrlGraphics3D::unsupgp =
	"Unsupported graphics primitive `1`"

(* convert a Graphics3D object to a VRML 1.0 object, without shared points. *)
m2wrlGraphics3D[g_Graphics3D] :=
	StringJoin[
		(* graphic object layer. *)
		" Separator\n",
		" {\n",

		Apply[StringJoin, Map[Function[p,
			Which[
				Head[p] === Polygon,
					m2wrlPolygon[p],
				True,
					Message[m2wrlGraphics3D::unsupgp, Head[p]]; ""]],
			If[ListQ[First[g]], First[g], List[First[g]]]]],

		" }\n",
		"\n"]

(* convert a Graphics3D object to a VRML 1.0 object, using a point list. *)
m2wrlGraphics3D[g_Graphics3D, pl_List] :=
	StringJoin[
		(* graphic object layer. *)
		" Separator\n",
		" {\n",

		"  Separator {\n",

		(* list of 3D points *)
		m2wrlPoint[pl],

		(* list of faces *)
		"   IndexedFaceSet {coordIndex [\n",
		Apply[StringJoin, Map[Function[p,
			StringJoin[
				"   ",
				Which[
					Head[p] === Polygon,
						m2wrlPolygon[p, pl],
					True,
						Message[m2wrlGraphics3D::unsupgp, Head[p]]; ""],
				"\n"]],
			(* graphics primitives list *)
			If[ListQ[First[g]], First[g], List[First[g]]]]],
		"   ]}\n",

		"  }\n",

		" }\n",
		"\n"]

PointList::usage =
	"PointList[g]: get the unique points from a graphics object."
PointList::unsupgp =
	"Unsupported graphics primitive `1`"

(* get the unique points from a graphics object. *)
PointList[g_Graphics3D] :=
	Union[Flatten[
		Map[Function[p,
			Which[
				Head[p] === Polygon,
					First[p],
				True,
					Message[PointList::unsupgp, Head[p]]; {}]],
			(* graphics primitives list *)
			If[ListQ[First[g]], First[g], List[First[g]]]],
		1]]

m2wrlPolygon::usage =
	"m2wrlPolygon[p]: converts a Polygon graphic primitive to a
	string representing a VRML 1.0 object.\n
	m2wrlPolygon[p,pl]: same thing, but using a list of 3D points
	to index."

(* convert a Polygon graphic primitive to a VRML 1.0 object.
 * each polygon has its own points.
 *)
m2wrlPolygon[p_Polygon] :=
	StringJoin[
		"  Separator {\n",

		(* list of 3D points *)
		m2wrlPoint[First[p]],

		(* list of faces *)
		StringJoin[
			"   IndexedFaceSet {coordIndex [",
			Apply[StringJoin, Map[Function[i,
				StringJoin[ToString[i], ", "]],
				Range[0, Length[First[p]] - 1]]],
			"-1,]}"],

		"}\n"]

(* convert a Polygon graphic primitive to a VRML 1.0 object.
 * the polygons share the points.
 *)
m2wrlPolygon[p_Polygon, pl_List] :=
	StringJoin[
		Apply[StringJoin, Map[Function[c,
			StringJoin[
				" ",
				ToString[First[First[Position[pl, c]]] - 1],
				","]],
			First[p]]],
		" -1,"]

m2wrlPoint::usage =
	"m2wrlPoint[p]: converts a point or a list of points to a VRML
	1.0 representation."

(* convert a list of points to a VRML 1.0 representation. *)
m2wrlPoint[pl_List /; ListQ[First[pl]]] :=
	StringJoin[
		"   Coordinate3 {point [\n",
		Apply[StringJoin, Map[Function[c,
			StringJoin[
				"   ",
				m2wrlPoint[c],
				",\n"]],
			pl]],
		"   ]}\n"]

(* convert a point to a VRML 1.0 representation.
 * a leading blank is added.
 *)
m2wrlPoint[p_List] :=
	Apply[StringJoin, Map[Function[x,
		StringJoin[" ", ToString[Chop[x]]]],
		p]]

(* package end *)
End[]
EndPackage[]