(* :Name: Graphics`ThreeScript *)

(* :Title: 3-Script File Format *)

(* :Author: *)

(* :Summary:
This package provides a utility for converting three-dimensional
graphical objects from Mathematica to the 3-Script file format
and writing them into files (or suitable operating systems pipes).
*)

(* :Context: Graphics`ThreeScript *)

(* :Package Version: 2.0 *)

(* :Copyright: Copyright 1991-1999,  Wolfram Research, Inc.
*)

(* :History:
        Version 1.0 by Stephen Wolfram, 1988.
        Extensively revised by C. Tom Wickham-Jones, May 1991.
*)

(* :Source:
	3-Script File Format, Technical Report Number T3100,
		Wolfram Research, Inc., 1991.
*)
 
(* :Mathematica Version: 2.0 *)
 
(* :Limitation:
	Output is generated only for three-dimensional graphics
	objects.  Two-dimensional objects are left unevaluated.
*)


	(***  ThreeScript Output Generator  ***)

BeginPackage["Graphics`ThreeScript`"]

ThreeScript::usage =
"ThreeScript[file, graphics] writes 3D graphics to a file in ThreeScript
format and returns the filename.
ThreeScript[ graphics] opens a temporary file, writes to that file, and
returns the file name."

Begin["`Private`"]

ThreeScript::nodata = "ThreeScript has received an object with no graphical
primitives to render."

(** Graphics3D output **)

ThreeScript[ g_] :=
	Block[{stm},
		stm = OpenTemporary[] ;
		ThreeScript[ stm, g];
		Close[stm]
	]

ThreeScript[ file_String, g_]  := 
	Block[{stm},
		stm = OpenWrite[ file] ;
		ThreeScript[ stm, g];
		Close[stm]
	]


ThreeScript[stream_OutputStream, gg:Graphics3D[g_, ___]] :=
	(
	WriteName[stream, "% Graphics3D objects"] ;
	If[ TSBounding[stream, g],
		TSOptions[stream, Flatten[Options[gg]], Options[Graphics3D]] ;
		TS0[stream, g] ;
	] ;
	StreamToFile[ stream]
	)

TSBounding[file_, g_] :=
	Block[{min, max, mini, maxi},
		mini = min = {Infinity,Infinity,Infinity};
		maxi = max = -min;
		Scan[TSBounding0[#,min,max]&, Flatten[{g}]] ;
		If[min==mini || max==maxi,
			Message[ThreeScript::nodata]; Return[False] ]; 
		WriteName[file, "boundingbox"] ;
		WriteTriple[file, min] ;
		WriteTriple[file, max] ;
		Return[True]
	]

SetAttributes[{TSBounding0, TSBounding1}, HoldRest]

TSBounding0[Polygon[g_List], min_, max_] :=
	Scan[TSBounding1[#, min, max]&, g]

TSBounding0[Line[g_List], min_, max_] :=
	Scan[TSBounding1[#, min, max]&, g]

TSBounding0[Point[g_List], min_, max_] :=
	TSBounding1[g, min, max]

TSBounding0[ Cuboid[g_List], min_, max_] :=
        (TSBounding1[g, min, max];
         TSBounding1[g+{1,1,1}, min, max])

TSBounding0[Cuboid[g_List, h_List], min_, max_] :=
        (TSBounding1[g, min, max];
         TSBounding1[ h, min, max])


TSBounding1[l:{_,_,_}, min, max] :=
	(
	min = Map[Min, Transpose[{l, min}]] ;
	max = Map[Max, Transpose[{l, max}]] ;
	)

TSOptions[file_, opts_, dopts_] :=
	(
	WriteViewPoint[file, ViewPoint /. opts /. dopts] ;
	If[Lighting /. opts /. dopts, 
		WriteAmbientLight[file, AmbientLight /. opts /. dopts] ;
		WriteLightSources[file, LightSources /. opts /. dopts] ;
	]
	)

WriteViewPoint[file_,v:{_,_,_}] :=
	(
	WriteName[file, "viewpoint"] ;
	WriteTriple[file, v] 
	)

WriteAmbientLight[file_,a_] :=
	(
	WriteName[file, "ambientlight"] ;
	WriteColor[file, a]
	)
	
WriteColor[file_, RGBColor[r_,g_,b_]] :=
	WriteTriple[file, {r,g,b}]

WriteColor[file_, GrayLevel[x_]] :=
	WriteTriple[file, {x,x,x}]

WriteColor[file_, {x_}] := WriteColor[file, x]

WriteLightSources[file_,s_List] :=
	(
	WriteName[file, "lightsources"] ;
	Scan[WriteLS0[file, #]&, s] 
	)

WriteLS0[file_, {dir:{_,_,_}, c_}] :=
	(
	WriteTriple[file, dir] ;
	WriteColor[file, c]
	)

TS0[file_, g_List] := Scan[TS0[file, #]&, g]

WriteName[file_, name_String] :=
	Write[file, TextForm[name]]

TS0[file_, Cuboid[g_List]] :=
	TS0[file, Cuboid[g, g + {1,1,1}]]

TS0[file_, Cuboid[g1_List, h1_List]] :=
	Block[ {a,b,c,d,e,f,g,h, rs},
		a = g1 ;
		b = CuboidAux[ g1, h1, {1,0,0}] ;
		c = CuboidAux[ g1, h1, {1,1,0}] ;
		d = CuboidAux[ g1, h1, {0,1,0}] ;
		e = CuboidAux[ g1, h1, {0,0,1}] ;
		f = CuboidAux[ g1, h1, {1,0,1}] ;
		g = h1 ;
		h = CuboidAux[ g1, h1, {0,1,1}] ;
		res = {Polygon[ {a,b,c,d}], Polygon[ {a,b,f,e}],
		       Polygon[ {a,d,h,e}], Polygon[ {b,c,g,f}],
		       Polygon[ {e,f,g,h}], Polygon[ {d,c,g,h}]};
		TS0[ file, res]
	]

CuboidAux[ g_List, h_List, vec_List] :=
	(g ({1,1,1} - vec) + h vec)

TS0[file_, Polygon[g_List]] :=
	(
	WriteName[file, "polygon"] ;
	Scan[WriteTriple[file, #]&, g] 
	)

TS0[file_, Line[g_List]] :=
	(
	WriteName[file, "line"] ;
	Scan[WriteTriple[file, #]&, g]
	)

TS0[file_, Point[g_List]] :=
	(
	WriteName[file, "point"] ;
	WriteTriple[file, g]
	)

TS0[file_, g:RGBColor[_,_,_]] :=
	(
	WriteName[file, "color"] ;
	WriteTriple[file, Apply[List, g]]
	)

TS0[file_, GrayLevel[x_]] :=
	(
	WriteName[file, "color"] ;
	WriteTriple[file, {x, x, x}]
	)


WriteTriple[file_, g:{_,_,_}] :=
	Apply[Write[file, CForm[#1], TextForm[" "], 
				CForm[#2], TextForm[" "], CForm[#3]]&, g]

	


(** SurfaceGraphics output **)

ThreeScript[stream_OutputStream, gg:SurfaceGraphics[g_, gc:{__List}, ___]] :=
        Block[{d1, d2, t},
                WriteName[stream, "% SurfaceGraphics objects"] ;
		SurfaceBounding[stream, g, PlotRange[gg]] ; 
                TSOptions[stream, Flatten[Options[gg]], 
					Options[SurfaceGraphics]] ;
                {d1, d2} = Dimensions[g] ;
                Write[stream, TextForm["colormesh "], CForm[d1], TextForm[" "],
                        CForm[d2]] ;
		WriteName[stream, "% z values"] ;
                Scan[Write[stream, CForm[#]]&, g, {2}];
		WriteName[stream, "% color values"] ;
		Scan[TSShade[stream, #]&, gc, {2}];
		StreamToFile[ stream]
        ]

(** Assumes BoxRatios -> { 1, 1, 0.4}  **)

SurfaceBounding[file_, g_List, { _, _,{zmin_, zmax_}}] :=
        Block[{dim},
                dim = (zmax - zmin) / 0.4;
                WriteName[file, "boundingbox"] ;
                WriteTriple[file, {0, 0, zmin}] ;
                WriteTriple[file, {dim, dim, zmax}]
        ]

SurfaceBounding[file_, g_List, _Symbol] :=
        SurfaceBounding[file, g,
        {Apply[Min, Flatten[g]], Apply[Max, Flatten[g]]}
        ]

TSShade[file_, g_RGBColor] :=
	WriteTriple[file, Apply[List, g]]

TSShade[file_, GrayLevel[g_]] :=
	WriteTriple[file, {g, g, g}]

ThreeScript[stream_OutputStream, gg:SurfaceGraphics[g_, ___]] :=
	Block[{d1, d2, t}, 
        	WriteName[stream, "% SurfaceGraphics objects"] ; 
		SurfaceBounding[stream, g, PlotRange[ gg]] ;
        	TSOptions[stream, Flatten[Options[gg]], 
					Options[SurfaceGraphics]] ;
		{d1, d2} = Dimensions[g] ;
		Write[stream, TextForm["mesh "], CForm[d1], TextForm[" "],
			CForm[d2]] ;
		Scan[Write[stream, CForm[#]]&, g, {2}];
		StreamToFile[ stream]
	]

StreamToFile[ stm_OutputStream] := First[stm]

End[ ]
EndPackage[ ]

