(* :Title: Stereo Imagery *)

(* :Package Name: StereoImagery.m *)

(* :Author: Mark Fisher *)

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

(* :Mathematica Version: 7.0 *)

(* :Package Version: 2.0 July 2009 *)

(* :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.
	
	Modified to take advantage of Image-related features in Version 7.0.
*)

(* :Discussion:
	The package contains two main functions, MakeStereo and MakeAnaglyph.
	MakeStereo takes a Graphics3D object and returns a GraphicsRow containing 
	a pair of Graphics3D objects viewed from slightly different
	angles. 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 Image), 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`"]

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[{L, R}] takes \
a pair of left and right stereo images (Graphics3D objects) \
and produces a single color-separated anaglyph (RGB Image). \
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 \
can be given a Graphics3D object, in which case it calls MakeStereo \
to produce the two images first."

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];
	{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];
	left  = Show[the3DGraphic, ViewPoint -> vpleft,
		SphericalRegion -> True];
	GraphicsRow[{left, right}, FilterRules[{opts}, Options[GraphicsRow]]]
	]

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

MakeAnaglyph[views:({_Graphics3D, _Graphics3D}|{_Graphics, _Graphics}),
		opts___?OptionQ] :=
	Module[{left, right, csl, dim, csr},
	{left, right} = Image[#, FilterRules[{opts}, Options[Image]]] & /@ views;
	csl = ColorSeparate[left];
	dim = ImageDimensions[csl[[1]]];
	csr = ImageResize[#, dim] & /@ ColorSeparate[right];
	csr[[1, 1]] = csl[[2, 1]] = csl[[3, 1]] = ConstantArray[0, Reverse[dim]];
	ImageAdd[ColorCombine[csl], ColorCombine[csr]]
	]

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

MakeAnaglyph[g:_Graphics3D, opts___?OptionQ] := 
	MakeAnaglyph[MakeStereo[g, opts], opts]

MakeAnaglyph[g:_Graphics, opts___?OptionsQ] :=
	MakeAnaglyph[Cases[g, _Graphics3D, Infinity], opts]

End[]
EndPackage[]