(* :Title: Stereo Imagery *)

(* :Package Name: StereoImagery.m *)

(* :Author: Mark Fisher *)

(* :Summary: Produce stereo images and anaglyphs for
	binocular steropsis.
*)

(* :Mathematica Version: 4.1 *)

(* :Package Version: 1.0 April 2001 *)

(* :Package History:
	MakeStereo was modified from ShowStero by Larry Calmer.
	His version was designed to work with external graphics device.
	I modified (and simplified and updated) the code to produce a
	GraphicsArray in a notebook.
*)

(* :Discussion:
	The package contains two main functions, MakeStereo and MakeAnaglyph.
	MakeStereo takes a Graphics3D object (or SurfaceGraphics object) and
	returns a pair of Graphics3D objects viewed from slightly different
	angles in a GraphicsArray. Positive values of the option AngularSeparation
	correspond to parrallel viewing (as opposed to cross-eyed viewing).
	MakeAnaglyph takes a pair of Graphics3D objects (such as the output
	of ShowStereo) or a pair of Graphics objects, converts them to
	bitmaps (using Rasterize, which uses on the portable bitmap format),
	removes (1) the green and blue from the left image and (2) the
	red from the right image, and combines the two images into one.

*)

BeginPackage["StereoImagery`", {"Utilities`FilterOptions`"}]

MakeStereo::usage = "MakeStereo['Graphic3D'] returns a stereoscopic
pair of Graphics3D images in a GraphicsArray. MakeStereo takes the
option AngularSeperation in addition to any GraphicsArray options, in
particular GraphicsSpacing, which can be used to adjust the spacing
between the images."

AngularSeperation::usage = "Angular Seperation is an option for ShowStereo.
It controls the angular seperation of the two view points in radians.
The default setting is AngularSeperation -> (.06)."

MakeAnaglyph::usage = "MakeAnaglyph[GraphicsArray[{L, R}]] takes
a GraphicsArray of left and right stereo images (Graphics3D objects)
and produces a single color-separated anaglyph (Graphics object containing
a Raster of red-green-blue triples). The option ImageResolution controls
size of the raster. The default ImageResolution -> 100 produces a raster
4 * 100 = 400 pixels wide.  The default ImageSize -> 288 induces Mathematica
to display the image at the default size. MakeAnaglyph['Graphics3D'] calls
MakeStereo to produce the two images first."

MakeRasterGraphics::usage = "MakeRasterGraphics[RGBmatrix] constructs
a Graphics object containing a Raster object containing the RGBmatrix
along with appropriate Graphics and Raster settings."

Rasterize::usage = "Rasterize[graphics] takes a graphics object
(Graphics or Graphics3D) and returns a Graphics object containing a
Raster of red-green-blue triples). The option ImageResolution controls
size of the raster. The default ImageResolution -> 100 produces a
raster 4 * 100 = 400 pixels wide (4 \"inches\" being the default image
size)."

GetRasterData::usage = "GetRasterData[Graphics[Raster[mat, ___]]] returns
the matrix of R-G-B tripes (mat). If mat is a matrix of GrayLevels,
GetRasterData multiplies each element by {255, 255, 255} to facilitate
color separation for anaglyphs."

KeepRed::usage = "KeepRed[RGBmatrix] returns a matrix of R-G-B triples
where the green and blue coordinates have been set to zero."

DropRed::usage = "DropRed[RGBmatrix] returns a matrix of R-G-B triples
where the red coordinates have been set to zero."

Begin["`Private`"]

(***** MakeStereo *****)

Options[MakeStereo] = {AngularSeperation -> .06}

MakeStereo[the3DGraphic_Graphics3D, opts___?OptionQ] :=
	Module[{angsep, gopts, vp, vv, vline, offset,
		vpleft, vpright, left, right},
	angsep = AngularSeperation /. {opts} /. Options[MakeStereo];
	gopts = FilterOptions[GraphicsArray, opts];
	{vp, vv} = {ViewPoint, ViewVertical} /.
		AbsoluteOptions[the3DGraphic, {ViewPoint, ViewVertical}];
	vline = #/Sqrt[#.#]& @ Cross[vp, vv];
	offset  = vline * Tan[angsep/2] * Sqrt[vp.vp];
	vpleft  = vp + offset;
	vpright = vp - offset;
	right = Show[the3DGraphic, ViewPoint -> vpright,
		SphericalRegion -> True, DisplayFunction -> Identity];
	left  = Show[the3DGraphic, ViewPoint -> vpleft,
		SphericalRegion -> True, DisplayFunction -> Identity];
	Show[GraphicsArray[{left, right}, gopts]]
	]

MakeStereo[gr_SurfaceGraphics, opts___?OptionQ] :=
	MakeStereo[Graphics3D[gr], opts]

(***** MakeAnaglyph *****)

Options[MakeAnaglyph] = {Offset -> 0}

MakeAnaglyph[views:({_Graphics3D, _Graphics3D}|{_Graphics, _Graphics}),
		opts___?OptionQ] :=
	Module[{exopts, offset, left, right, L, R, comb},
	exopts = FilterOptions[ExportString, opts];
	gopts = FilterOptions[Graphics, opts];
	offset = Offset /. {opts} /. Options[MakeAnaglyph];
	{left, right} =
		GetRasterData[Rasterize[#, exopts, ImageResolution -> 100]]& /@ views;
	L = Map[{1, 0, 0} * # &, left, {2}];  (* keep red *)
	R = Map[{0, 1, 1} * # &, right, {2}]; (* drop red *)
	comb =
		If[offset == 0,
			L + R,
			(Drop[#, offset]& /@ L) + (Drop[#, -offset]& /@ R)
		];
	Show[MakeRasterGraphics[comb], gopts, ImageSize -> 288]
	]

MakeAnaglyph[GraphicsArray[
	views:({_Graphics3D, _Graphics3D}|{_Graphics, _Graphics}), ___],
		opts___?OptionQ] := MakeAnaglyph[views, opts]

MakeAnaglyph[g:(_Graphics3D|_SurfaceGraphics), opts___?OptionQ] :=
	MakeAnaglyph[MakeStereo[g, DisplayFunction -> Identity, opts], opts]

GetRasterData[Graphics[Raster[mat_, ___,
		ColorFunction -> GrayLevel, ___], ___]] :=
	Map[{255, 255, 255} * # &, mat, {2}]

GetRasterData[Graphics[Raster[mat_, ___], ___]] := mat

(* PBM (portable bitmap format) seems to be most efficient *)
Rasterize[g_, opts___?OptionQ] :=
	ImportString[ExportString[g, "PBM", opts], "PBM"]

MakeRasterGraphics[mat_] :=
	With[{size = Dimensions[mat][[{2, 1}]]},
	Graphics[Raster[mat, {{0, 0}, size}, {0, 255},
		ColorFunction -> RGBColor],
		ImageSize -> size, AspectRatio -> Automatic]
	]

(* not used by other code *)
KeepRed[mat_] := Map[{1, 0, 0} * # &, mat, {2}]

DropRed[mat_] := Map[{0, 1, 1} * # &, mat, {2}]

End[]
EndPackage[]