
(* :Name: Graphics`ThreeScript *)

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

(* :Author: *)

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

(* :Context: Graphics`ThreeScript *)

(* :Package Version: 2.0 *)

(* :Copyright: Copyright 1991  Wolfram Research, Inc.
        Permission is hereby granted to modify and/or make copies of
        this file for any purpose other than direct profit, or as part
        of a commercial product, provided this copyright notice is left
        intact.  Sale, other than for the cost of media, is prohibited.

        Permission is hereby granted to reproduce part or all of
        this file, provided that the source is acknowledged.
*)

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

(* :Source:
	3-Script File Format, Technical Report Number T3100,
		Wolfram Research, Inc., 1991.
*)
 
(* :Mathematica Version: 2.0 *)
 
(* :Limitation:
	Output is only generated 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_] :=
	ThreeScript[ OpenTemporary[], g]

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[ ]

