Lens Lab 3-D

by Donald Barnhard

Documentation

Introduction

This notebook is an example of using Mathematica for doing geometric ray-tracing.  LensLab defines a set of functions for designing optical systems, including lenses, mirrors, prisms, and other elements.  The notebook can compute ray paths through the elements and plot the results in two and three dimensions.  A commercial package, Optica, is now available.  Any inquiries regarding this notebook should be forwarded to the address below:  Inquiries concerning the purchase of Optica should be directed to info@wri.com, or 1-800-441-MATH.

Donald Barnhart
1413 E. Old Church Rd.
Urbana, Il. 61801
USA
email: barnhart@wri.com
(217) 684 - 2428 Home
(217) 333 - 4264 Work

LensLab isn't intended for use in actual optical design, but is meant only to demonstrate the potential of using Mathematica to perform optical modeling.  For a description of Optica, a complete system for optical design, see MathSource item 0207-605.  As a disclaimer: There is no guarantee, written or implied, that this notebook accurately models optical systems.  The use of this notebook is strictly the responsibility of the user.  Use this at your own risk.  We assume no liability.

Note: The commercial version (Optica) contains a complete descriptive listing of all the features, as well as a written analysis of this Notebook's programming structure, so that existing features can be easily added to and modified by the individual user.  (One of the main strengths of the Mathematica programming language is the ability of the user to get in and modify the source code for their own benefit.  In the long run, I hope that this notebook can evolve by users adding to and improving on its structure.  I hope to incorporate the best of these modifications back into the commercially distributed version.)

Examples

The best way to understand the use of this notebook is by examples.  To get started, let's draw a simple lens element.  Before drawing the lens, we must decide what kind of lens to draw, starting with the general lens shape. We will start with a PlanoConvexLens element.  PlanoConvex  refers to the planer surface on one side of the lens and the bulging (convex) surface on the other side of the lens.  This is a spherical lens since the convex surface is a spherical in shape.  Nearly all commercially available lenses use spherical shapes, since it is easiest to manufacture.  This lense will have a focal length of 100, a diameter of 50, and a lens center thickness of 10.  Note that the values of focal length , diameter, and thickness must be realistically chosen or imaginary numbers will  result.  We must place the lens in a physical location in space.  This is done by imbedding the lens function within the Place[] command.  For this example, we will put it at x=100, y=0, with no rotation (theta = 0 Degrees).  Note that the distance units are arbitrary: they could be mm, feet, or miles.  Finally, everything is embedded within the DrawSystem[] command, which performs the graphical calculations.  (Before these examples can be executed, the Implementation section of this Notebook must be selected and evaluated.)
We type the following:

DrawSystem[
	{},	(* No rays in this example *)
	{
	Place[PlanoConvexLens[100,50,10],{100,0,0}]
	}
]

Now, if we would like to see a two-dimensional top overview of the lense, we can do so by two methods.  Using the first method:

ShowSystem[PlotType->TopView]

Or the second method:

DrawSystem[
	{},
	{
		Place[PlanoConvexLens[100,50,10],{0,0,0}]
	},
	PlotType->TopView
]

The difference between these two methods are that ShowSystem[] does not actually recalculate any of the optical parameters, but simply converts the graphics into a different format.  However, DrawSystem[] must be executed at least once before ShowSystem[] will work.  Therefore, ShowSystem[] is good for rerendering the same system from different perspectives.  Note that ShowSystem[] does not directly use lens design parameters, but only uses options such as PlotType.  There are six different PlotType settings which can be used:

1) PlotType -> 3D is the default setting in which the objects are rendered in 3-dimensions.
2) PlotType -> TopView is the setting just demonstrated, showing the 2-D top overview.
3) PlotType -> SideView shows the 2-D side overview of the system.
4) PlotType -> FrontView shows the 2-D front overview of the system.
5) PlotType -> Screen is a special setting which displays the ray intersections with a Screen.
6) PlotType -> Off turns off the graphics output.  This is useful in non-graphical calculations.

Next, we will propagate some rays through the lens.  First, we must select a ray source function. In this example, we will use the function

ConicPointSource[
	{xpos,ypos,zpos},
	{rayanglexy, rayanglexz},
	ConicAngle, options],

which emits a set of rays in a cone like direction, from a single point in space. Second, we must set up a boundary such that the rays are contained within this volume.  Otherwise, Mathematica might be tempted to make a plot of infinite size.  This is done using the Boundary[{xmin,ymin,zmin},{xmax,ymax,zmax}] function which describes a box having the two assigned opposite corners.

DrawSystem[
	{
		ConicPointSource[{0,0,0}, {0, 0}, 20,
			NumberOfRays->7]
	},
	{
		Place[PlanoConvexLens[100,50,10],{100,0,0}],
		Boundary[{-100,-100,-100},{200,200,200}]
	}
]

ShowSystem[PlotType->SideView]

ShowSystem[PlotType->FrontView]

We could now place a cylindrical lens directly behind the plano-convex lens, for some additional interest.

DrawSystem[
	{
		ConicPointSource[{0,0,0}, {0, 0}, 20,
			NumberOfRays->7]
	},
	{
		Place[PlanoConvexLens[100,50,10],{100,0,0}],
		Place[PlanoConvexLensCylindrical[100, {50,50}, 10],
			{130,0,0}],
		Boundary[{-100,-100,-100},{250,200,200}]
	}
]

ShowSystem[PlotType->TopView]

ShowSystem[PlotType->SideView]

One can make exact positional measurements in the 2-D fields by clicking on the graphics output box with the mouse and then holding the command key down while moving the cursure.  In this way we can can check the focal point positions from the lense center, for example.  By doing this, I measure the focal plane to be 218 in the TopView.  I will now demonstrate the use of a Screen object in this system.  We will place the Screen object at x=218, y=0, following the cylindrical lens in order.

DrawSystem[
	{
		ConicPointSource[{0,0,0}, {0, 0}, 20,
			NumberOfRays->7]
	},
	{
		Place[PlanoConvexLens[100,50,10],{100,0,0}],
		Place[PlanoConvexLensCylindrical[100, {50,50}, 10],
		{130,0,0}],
		Place[Screen[50,50],{218,0,0}],
		Boundary[{-100,-100,-100},{250,200,200}]
	}
]

Note that this graphical output shows no indication of a screen being placed in the system.  However, if we change PlotType -> Screen, then we see something different.

ShowSystem[PlotType->Screen]

Here, we can see the exact intersection points that each ray made with the Screen object.  More advanced screens can be spherical surfaces and have circular boundaries.  There are many advanced features about this Notebook which will not be discussed in detail at this time, but will be explained in depth for the commercial version.

If we are intending to use a lense which is available from a specefic manufacturer, it is not necesseary to type in the exact lens parameter descriptions if we have electronically filed the various lens designs from the catalog in advance.  This was done for selected lenses from the Melles Griot catalog in this Notebook.  Begin this example by selecting and evaluating the Melles Griot Catalog Singlet Lenses section of this notebook.  We can then, for example, use the Catalog number Cat01LDX223 instead of typing SymmetricConvexLens[200.0 ,100.0, 16.3 ,DesignIndex ->1.5187 , GlassType->BK7]

DrawSystem[
	{
		ConicPointSource[{0,0,0}, {0, 0}, 20,
			NumberOfRays->7]
	},
	{
		Place[Cat01LDX223,{100,0,30}],
		Boundary[{-100,-100,-100},{200,200,200}]
	}
]

ShowSystem[PlotType->TopView]

Note that this time we included a rotation on the lens angle of 30 degrees, just to be different.  Also note that the Place[] command does not support full three-dimensional positioning and rotations.  This will be supported with Place3D[] in the commercial version.

We will next work with some prisms.  The prism is capable of both reflecting and refracting light.  These examples highlight the prism capabities.

DrawSystem[
	{
		HorizontalPointSource[{0,0,0}, {-5, 5}]
	},
	{
		Place[Prism[{60 ,135, 60}, 100],
			{300,-60,0}],
		Boundary[{-110,-250,-250},{850,250,250}]
	},
	PlotType->3D
]

ShowSystem[PlotType->TopView]

DrawSystem[
	{
		HorizontalPointSource[{0,0,0}, {-5, 5}]
	},
	{
		Place[Prism[{60 ,135, 60}, 100],
			{300,-30,-30}],
		Boundary[{-110,-250,-250},{850,250,250}]
	},
	PlotType->3D
]

ShowSystem[PlotType->TopView]

DrawSystem[
	{
		HorizontalPointSource[{0,0,0}, {-10, 10}]
	},
	{
		Place[Prism[{60 ,135, 60}, 100],
			{300,-30,30}],
		Boundary[{-110,-250,-250},{500,250,250}]
	},
	PlotType->3D
]

ShowSystem[PlotType->TopView]

Another type of component is the mirror. We will leave the ordinary mirror up to the user to figure out. Instead, we will show some examples of the PolygonalMirror object.

DrawSystem[
	{
		HorizontalParallelRays[{0,0,0}, {0,0}, 90,
			NumberOfRays->5]
	},
	{
		Place[PolygonalMirror[6,100,50], {100,0,15}],
		Boundary[{-100,-300,-100},{300,200,100}]
	}
]

ShowSystem[PlotType->TopView]

DrawSystem[
	{
		HorizontalParallelRays[{0,0,0}, {0,0}, 60,
			NumberOfRays->3]
	},
	{
		Place[PolygonalMirror[3,100,50],{100,0,0}],
		Boundary[{-100,-300,-100},{300,200,100}]
	}
]

ShowSystem[PlotType->TopView]

We conclude the examples section with an animation.

Do[
	DrawSystem[
		{
			HorizontalPointSource[{0,0,0}, {-5, 5}]
		},
		{
			Place[Prism[{60 ,135, 60}, 100],
				{300,-30,theta}],
			Boundary[{-110,-250,-250},{850,250,250}]
		},
		PlotType -> TopView,
		PlotRange -> {{0,500},{-250,250}}
	],
	{theta,0,120,5}
]

Component Name Listings

The following is a list of the various components defined in this Notebook.  The options section describes the options which are available to various components.

Rays Sources

HorizontalParallelRays[
	{xpos,ypos,zpos},
	{rayanglex,rayanglez},
	width,
	options]

VerticalParallelRays[
	{xpos,ypos,zpos},
	{rayanglex,rayanglez},
	width,
	options]

ParallelCircleRays[
	{xpos,ypos,zpos},
	{rayanglex, rayanglez},
	radius,
	options]

HorizontalPointSource[
	{xpos,ypos,zpos},
	{anglemin, anglemax},
	options]

VerticalPointSource[
	{xpos,ypos,zpos},
	{anglemin, anglemax},
	options]

ConicPointSource[
	{xpos,ypos,zpos},
	{rayanglexy, rayanglexz},
	ConicAngle,
	options]

DirectedConicPointSource[
	{axisAnglexy, axisAnglexz, convergenceDistance},
	{xcoord, ycoord, zcoord},
	ConicAngle,
	options]

DirectedScatterVolume[
	{axisAnglexy, axisAnglexz, convergenceDistance},
	ConicAngle,
	BoxSize,
	options]

Glasses

Some typical glass types, from the Melles Griot catalog, whose index of refraction is a function of wavelength:

BK7
SF11
LaSF9

Lenses

RoundWindow[aperture, thickness, options]

PlanoConvexLens[signedFocalLength, aperture,
	thickness, options]

PlanoConcaveLens[signedFocalLength, aperture,
	thickness, options]

SymmetricConvexLens[signedFocalLength, aperture,
	thickness, options]

SymmetricConcaveLens[signedFocalLength, aperture,
	thickness, options]

PositiveMeniscusLens[sf, aperture, tc, options]

NegativeMeniscuslens[sf, aperture, tc, options]

Window[{width,height}, thickness, options]

PlanoConvexLensCylindrical[signedFocalLength,
	{width,height}, thickness, options]

PlanoConcaveLensCylindrical[signedFocalLength,
	{width,height}, thickness, options]

SymmetricConvexLensCylindrical[signedFocalLength,
	{width,height}, thickness, options]

SymmetricConcaveLensCylindrical[signedFocalLength,
	{width,height}, thickness, options]

Prisms

Prism[{alpha ,side, beta},height,options]

Mirrors

FirstSurfacedMirror[width, thickness, height]

Mirror[{x1,y1},{x2,y2},thickness, height]

DirectedMirror[width,thickness,height,{xbegin,ybegin},
			{xposition,yposition},{xend,yend},options]

PolygonalMirror[NumberOfSides,Diameter,Height]

Absorbers

Baffle[width, thickness, height]

LightBlock[{x1,y1},{x2,y2},thickness,height,options]

SquarePinHole[HoleDimension, Width, Height {x, y, theta}]

RoundPinHole[HoleDiameter, OuterDiameter, {x, y, theta}]

Screens

Screen[width,height]

CircularScreen[width,height]

Boundary of System

Boundary[{x1,y1,z1},{x2,y2,z2}]

Options

GlassType in Options[Glasses] sets the Glass index function type which is used in determining the ray trace bend angles.  The default GlassType is BK7, and the glasses listed below can be subsituted.  In addition, new glass functions can be defined and used.  DesignIndex in Options[Glasses] sets the design index value used in calculating the lense curvatures from the focal length specified.  These options are jointly used inside the various lenses and prism commands, although Prisms don't need a design index to be specified.

Options[Glasses] =
	{
		GlassType -> BK7,
		DesignIndex -> 1.5187
	};

NumberOfRays in Options[Rays] is used to set the preferred number of rays to be executed by Rays Sources Basic Functions.  The complex ray source functions use a multiplicity of Basic Functions.  WaveLength, of course, specifies the wavelength of the ray.  The value has units of microns.  The defalt value, .532 microns, corresponds with the green wavelength of a frequency doubled YAG laser.

Options[Rays] =
	{
		NumberOfRays -> 6,
		WaveLength -> .532
	};

Options[Lenses] contains the preferred CurvatureDirection for all asymetric lenses and CylindricalOrientation for cylindrical lenses.  The CurvatureDirection can either be Front or Back, which refers to the side of the lens curved surface to be positioned relative to the light source.  If Front is used, then the curved side is closest to the light source position.  The light source position is set using the Source options, mentioned above.  The CylindricalOrientation can either be Horizontal or Vertical,indicating which direction the cylindrical lense curvature is oriented.  SourcePosition in Options[Lenses] sets the position of a light source which is then used to guide the orientation of the optical elements.  SourcePosition gets passed to a global variable called Source, which can be dynamicaly changed by using ChangeSourcePosition[x,y,z] within the DrawSystem function.

Options[Lenses] =
	{
		CurvatureDirection -> Front,
		CylindricalOrientation -> Horizontal,
		SourcePosition -> {0,0,0}
	};

There are six types of graphics available to PlotType in Options[DrawSystem]:
 PlotType -> 3D, TopView, SideView, FrontView, Screen, Off.  PlotType -> 3D shows the full 3-Dimensional perspective of the optical system, while the other types show two-dimensional orthogonal projections of the corresponding views.  Selecting Screen  plots only the points of intersection between the rays and an object called Screen. PlotType -> Off does the raytracing calculations without returning a graphics output.  This is useful when performing lens parameter optimizations, since the graphics slows down the calculation speeds.

Options[DrawSystem] =
	{
		PlotType -> 3D
	};

Conclusions

In conclusion, this Notebook is a work in progress.  As far as I know, all of the functions featured in the Notebook are working.  However, I am also certain that some bugs may be found and that better routines may replace some of the old routines.  The two major problems with this system are its lack of speed and large consumption of memory.  For even moderate sized calculations, 8 Mbytes of RAM will not be enough.  This notebook is best run on a NeXT computer or a fast Macintosh.  However, simpler demonstrations can be run on lesser sized machines.  Any 8 Mbyte platform may serve well for basic ray tracing of two or three elements.

The commercial version of this Notebook will include expanded three-dimensional element positioning capabilities as well as lens system optimization routines.

If you like this demonstration notebook, feel free to use it.  However, I strongly request that you buy the commercial version when it becomes available.  I would like to hear any comments that you may have about this notebook.  If you come up with some new exciting routines based on this Notebook, please send them to me, and I will make available routines collected from others as they become available.

I look forward to hearing from you all.

Donald Barnhart
Urbana, Illinois.

Implementation

Off[General::spell]
Off[General::spell1]

Basic Math Functions

Clear[InverseTan];
InverseTan[y_,x_]:=
	Module[{tempAngle},
		
		tempAngle=If[x!=0,N[Chop[ArcTan[Abs[y/x]]/Degree]],If[y>0,90,-90]];
		
		If[x>0&&y>0,tempAngle,
			If[x<0&&y<0,-180 + tempAngle,
				If[x<0&&y>=0,-180 - tempAngle,
					If[x!=0,-tempAngle,tempAngle]]]]
	];

Clear[fx, fy, fz];
fx[f_, x_, theta_] := Function[{tx,tz},Evaluate[Chop[N[Cos[theta Degree] f[tx,tz] - Sin[theta Degree] tx + x]]]];
fy[f_, y_, theta_] := Function[{tx,tz},Evaluate[Chop[N[Sin[theta Degree] f[tx,tz] + Cos[theta Degree] tx + y]]]];
fz[f_, z_, theta_] := Function[{tx,tz},Evaluate[Chop[N[Sin[theta Degree] f[tx,tz] + Cos[theta Degree] tz + z]]]];
Clear[fxx, fyy];
fxx[xx_, yy_, x_, theta_] := Function[{tx,tz},Evaluate[Chop[N[Cos[theta Degree] xx[tx,tz] - Sin[theta Degree] yy[tx,tz] + x]]]];
fyy[xx_, yy_, y_, theta_] := Function[{tx,tz},Evaluate[Chop[N[Sin[theta Degree] xx[tx,tz] + Cos[theta Degree] yy[tx,tz] + y]]]];

Clear[Magnitude];
Magnitude[x_,y_,z_] := Chop[N[Sqrt[x^2+y^2+z^2]]];

Clear[DirectionFunction];

DirectionFunction[{f1x_,f1y_,f1z_},{f2x_,f2y_,f2z_}] :=
	Module[{xsource,ysource,zsource,r1x,r1y,r1z,r2x,r2y,r2z},
	{xsource,ysource,zsource} = Source;
	
	r1x = Chop[N[f1x[0,0]]];
	r1y = Chop[N[f1y[0,0]]];
	r1z = Chop[N[f1z[0,0]]];
	r2x = Chop[N[f2x[0,0]]];
	r2y = Chop[N[f2y[0,0]]];
	r2z = Chop[N[f2z[0,0]]];
	
		If[Magnitude[r1x-xsource,r1y-ysource,r1z-zsource]>
			Magnitude[r2x-xsource,r2y-ysource,r2z-zsource],
				Reverse,
				Forward
		]
	];

Clear[ChangeSourcePosition];

ChangeSourcePosition[x_,y_,z_]:= (Source = {x,y,z};)

Options

GlassType in Options[Glasses] sets the Glass index function type which is used in determining the ray trace bend angles.  The default GlassType is BK7, and the glasses listed below can be subsituted.  In addition, new glass functions can be defined and used.  DesignIndex in Options[Glasses] sets the design index value used in calculating the lense curvatures from the focal length specified.  These options are jointly used inside the various lenses and prism commands, although Prisms don't need a design index to be specified.

Options[Glasses] =
	{
		GlassType -> BK7,
		DesignIndex -> 1.5187
	};

NumberOfRays in Options[Rays] is used to set the preferred number of rays to be executed by Rays Sources Basic Functions.  The complex ray source functions uses a multiplicity of Basic Functions.  WaveLength, of course, specifies the wavelength of the ray.  The value has units of microns.  The defalt value, .532 microns, corresponds with the green wavelength of a frequency doubled YAG laser.

Options[Rays] =
	{
		NumberOfRays -> 6,
		WaveLength -> .532
	};

Options[Lenses] contains the preferred CurvatureDirection for all assymetric lenses and CylindricalOrientation for cylindrical lenses.  The CurvatureDirection can either be Front or Back, which refers to the side of the lens curved surface to be positioned relative to the light source.  If Front is used, then the curved side is closest to the light source position.  The light source position is set using the Source options, mentioned above.  The CylindricalOrientation can either be Horizontal or Vertical,indicating which direction the cylindrical lense curvature is oriented.  SourcePosition in Options[Lenses] sets the position of a light source which is then used to guide the orientation of the optical elements.  SourcePosition gets passed to a global variable called Source, which can be dynamicaly changed by using ChangeSourcePosition[x,y,z] within the DrawSystem function.

Options[Lenses] =
	{
		CurvatureDirection -> Front,
		CylindricalOrientation -> Horizontal,
		SourcePosition -> {0,0,0}
	};

There are six types of graphics available to PlotType in Options[DrawSystem]:
 PlotType -> 3D, TopView, SideView, FrontView, Screen, Off.  PlotType -> 3D shows the full 3-Dimensional perspective of the optical system, while the other types show two-dimensional orthogonal projections of the corresponding views.  Selecting Screen  plots only the points of intersection between the rays and an object called Screen. PlotType -> Off does the raytracing calculations without returning a graphics output.  This is useful when performing lense parameter optimizations, since the graphics slows down the calculation speeds.

Options[DrawSystem] =
	{
		PlotType -> 3D
	};

The following command is used internally by various functions to pass only the options which are useful to a particular routine.

FilterOptions[command_Symbol, opts___]:=
Module[{keywords = First /@ Options[command]},
	Sequence @@ Select[{opts},MemberQ[keywords, First[#]]&]
]

Rays Sources

Clear[HorizontalParallelRays];
HorizontalParallelRays[{xpos_,ypos_,zpos_}, {rayanglex_,rayanglez_}, width_, options___] :=
	Module[
		{rays, h, wavelength},
		rays = N[NumberOfRays /. {options} /. Options[Rays]];
		wavelength = N[WaveLength /. {options} /. Options[Rays]];
		Table[
			Chop[N[Ray[{xpos + h Sin[rayanglex Degree],
				ypos + h Cos[rayanglex Degree], zpos},
				{rayanglex, rayanglez}, wavelength]]],
			{h, -width/2, width/2, width/rays}
		]
	]

Clear[VerticalParallelRays];
VerticalParallelRays[{xpos_,ypos_,zpos_}, {rayanglex_,rayanglez_}, width_, options___] :=
	Module[
		{rays, h, wavelength},
		rays = N[NumberOfRays /. {options} /. Options[Rays]];
		wavelength = N[WaveLength /. {options} /. Options[Rays]];
		Table[
			Chop[N[Ray[{xpos + h Sin[rayanglez Degree],
				ypos, zpos + h Cos[rayanglez Degree]},
				{rayanglex, rayanglez}, wavelength]]],
			{h, -width/2, width/2, width/rays}
		]
	]

Clear[ParallelCircleRays];
ParallelCircleRays[{xpos_,ypos_,zpos_}, {rayanglex_, rayanglez_}, radius_, options___] :=
	Module[
		{rays, wavelength,h},
		rays = N[NumberOfRays /. {options} /. Options[Rays]];
		wavelength = N[WaveLength /. {options} /. Options[Rays]];
		Table[
			Chop[N[Ray[{xpos + radius Sin[h] Sin[rayanglex Degree],
			 ypos + radius Sin[h] Cos[rayanglex Degree],
			 zpos + radius Cos[h]} , {rayanglex, rayanglez}, wavelength]]],
			{h, 0, 2 Pi, 2 Pi/rays}
		]
	]

Clear[HorizontalPointSource];
HorizontalPointSource[{xpos_,ypos_,zpos_}, {anglemin_, anglemax_}, options___] :=
	Module[
		{rays, wavelength, angle},
		rays = N[NumberOfRays /. {options} /. Options[Rays]];
		wavelength = N[WaveLength /. {options} /. Options[Rays]];
		Table[
			N[Ray[{xpos, ypos, zpos}, {angle,0}, wavelength]],
			{angle, anglemin, anglemax, (anglemax-anglemin)/rays}
		]
	]

Clear[VerticalPointSource];
VerticalPointSource[{xpos_,ypos_,zpos_}, {anglemin_, anglemax_}, options___] :=
	Module[
		{angle,rays, wavelength},
		rays = N[NumberOfRays /. {options} /. Options[Rays]];
		wavelength = N[WaveLength /. {options} /. Options[Rays]];
		Table[
			N[Ray[{xpos, ypos, zpos}, {0,angle}, wavelength]],
			{angle, anglemin, anglemax, (anglemax-anglemin)/rays}
		]
	]

Clear[ConicPointSource];
ConicPointSource[{xpos_,ypos_,zpos_}, {rayanglexy_, rayanglexz_}, ConicAngle_, options___] :=
	Module[
		{rays, wavelength, angle},
		rays = N[NumberOfRays /. {options} /. Options[Rays]];
		wavelength = N[WaveLength /. {options} /. Options[Rays]];
		Table[
			Chop[N[Ray[{xpos, ypos, zpos}, {rayanglexy + ConicAngle/2 Cos[angle],rayanglexz + ConicAngle/2 Sin[angle]}, wavelength]]],
			{angle, 0, 2 Pi, 2 Pi/rays}
		]
	]

Clear[DirectedConicPointSource];
DirectedConicPointSource[{axisAnglexy_, axisAnglexz_, convergenceDistance_}, {xcoord_, ycoord_, zcoord_}, ConicAngle_,
					 options___]:=
	Module[
			{angletempxy, angletempxz, xpos,ypos,zpos},
			xpos = N[convergenceDistance Cos[axisAnglexy Degree]];
			ypos = N[convergenceDistance Sin[axisAnglexy Degree]];
			zpos = N[convergenceDistance Sin[axisAnglexz Degree]];
			angletempxy = InverseTan[(ypos-ycoord),(xpos-xcoord)];
			angletempxz = InverseTan[(zpos-zcoord),(xpos-xcoord)];
		ConicPointSource[{xcoord, ycoord, zcoord}, {angletempxy, angletempxz}, ConicAngle, options]
	];

Clear[DirectedScatterVolume];
DirectedScatterVolume[{axisAnglexy_, axisAnglexz_, convergenceDistance_}, ConicAngle_,
					 BoxSize_,options___]:=
	Module[{nbox},
		nBox = Chop[N[BoxSize/2]];
		{
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {0, 0, 0}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {nBox, nBox, nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {nBox, nBox, -nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {nBox, -nBox, nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {nBox, -nBox, -nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {-nBox, -nBox, -nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {-nBox, -nBox, nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {-nBox, nBox, nBox}, N[ConicAngle],
					options],
		DirectedConicPointSource[{axisAnglexy, axisAnglexz, convergenceDistance}, {-nBox, nBox, -nBox}, N[ConicAngle],
					options]
		}
	];

Glasses

Some typical glass types, from the Melles Griot catalog, whose index of refraction is a function of wavelength:

glass[a0_, a1_, a2_, a3_, a4_, a5_] :=
	Function[l, N[Sqrt[a0+a1 l^2+a2 l^-2+a3 l^-4+a4 l^-6+a5 l^-8]]];

BK7 = glass[2.2718929, -1.0108077 10^-2, 1.0592509 10^-2,
		 2.0816965 10^-4, -7.6472538 10^-6, 4.9240991 10^-7];
SF11 = glass[3.0539614, -1.1580432 10^-2, 3.9199816 10^-2,
		 2.9462812 10^-3, -2.0371019 10^-4, 2.7633569 10^-5];
LaSF9 = glass[3.3051830, -1.3857059 10^-2, 3.5921736 10^-2,
		 2.6740381 10^-3, -1.9764177 10^-4, 1.9381052 10^-5];

Lenses

Spherical Lenses:

Lens takes a lens specification in terms of two radii (either or both can be Infinity), and returns a RawLens object that has the following arguments:
	1) Function x(y)  for the left surface,
	2) Function  x(y) for the right surface,
	3) Thickness at center,
	4) Aperture (diameter),
	5) Index of refraction (a function of wavelength).

Clear[Lens];

Lens[r1_, r2_, thickness_, aperture_, index_] :=
	Module[
		{nr1, nr2, nthickness},
		nr1 = N[r1];
		nr2 = N[r2];
		nthickness = N[thickness];
		RawLens[
			If[nr1 === Infinity,
				0&,
				Function[{x,z},Evaluate[-Sign[nr1] Sqrt[nr1^2 - x^2 - z^2] + nr1]]
			],
			If[nr2 === Infinity,
				Evaluate[nthickness]&,
				Function[{x,z},Evaluate[-Sign[nr2] Sqrt[nr2^2 - x^2 - z^2] + nr2 + nthickness]]
			],
			nthickness,
			N[aperture],
			index
		]
	];

Function to reverse the direction of a lens:

Clear[ReverseFunction];
ReverseFunction[RawLens[f1_, f2_, thickness_, aperture_, index_]] :=
	RawLens[
		Function[{x,z},Evaluate[-f2[x,z]+thickness]],
		Function[{x,z},Evaluate[-f1[x,z]+thickness]],
		thickness, aperture, index
	];

Clear[Place];
Place[RawLens[f1_, f2_, thickness_, aperture_, index_], {x_, y_, thetax_},options___] :=
	Module[{f1new,f2new},
		If[DirectionFunction[{fx[f1, x, thetax], fy[f1, y, thetax], fz[f1, 0, 0]},
			{fx[f2, x, thetax], fy[f2, y, thetax], fz[f2, 0, 0]}]
			=== Reverse,
				f1new = Function[{tx,tz},Evaluate[-f2[tx,tz]]];
				f2new = Function[{tx,tz},Evaluate[-f1[tx,tz]]],
				f1new = f1;
				f2new = f2
		];
		PlacedLens[
			{fx[f1new, x, thetax], fy[f1new, y, thetax], fz[f1new, 0, 0]},
			{fx[f2new, x, thetax], fy[f2new, y, thetax], fz[f2new, 0, 0]},
			f1new, f2new, {thetax, 0},
		 	{-aperture,-aperture},index
		 ]
	];

Clear[DirectedLens];
DirectedLens[RawLens[f1_, f2_, thickness_, aperture_, index_], {xlens_,ylens_},
			{xaxis_,yaxis_},SideofLens_,options___]:=
			
		Module[{lensAngle},
		If[SideofLens===Front,
			lensAngle = InverseTan[(ylens-yaxis),(xlens-xaxis)],
			lensAngle = InverseTan[(yaxis-ylens),(xaxis-xlens)]
		];
	
		Place[RawLens[f1, f2, thickness, aperture, index], {xlens, ylens, lensAngle},options]
	];

Cylindrical Lenses:

CylindricalLens is similar to the lens function, except it returns a RawCylindricalLens function which passes a square aperture {width,height} and it uses a lense orientation term which carries a "horizontal" or "vertical" label.

Clear[CylindricalLens];
CylindricalLens[r1_, r2_, thickness_, {width_, height_}, index_, orientation_] :=
	Module[
		{nr1, nr2, nthickness},
		nr1 = N[r1];
		nr2 = N[r2];
		nthickness = N[thickness];
		RawCylindricalLens[
			If[nr1 === Infinity,
				0&,
				If[orientation===Horizontal||orientation===horizontal,
				Function[{x,z},Evaluate[-Sign[nr1] Sqrt[nr1^2 - x^2] + nr1]],
				Function[{x,z},Evaluate[-Sign[nr1] Sqrt[nr1^2 - z^2] + nr1]]
				]
			],
			If[nr2 === Infinity,
				nthickness&,
				If[orientation===Horizontal||orientation===horizontal,
				Function[{x,z},Evaluate[-Sign[nr2] Sqrt[nr2^2 - x^2] + nr2 + nthickness]],
				Function[{x,z},Evaluate[-Sign[nr2] Sqrt[nr2^2 - z^2] + nr2 + nthickness]]
				]
			],
			nthickness,
			{N[width], N[height]},
			index
		]		
	];

Function to reverse the direction of a lens:

ReverseFunction[RawCylindricalLens[f1_, f2_, thickness_, {width_, height_}, index_]] :=
	RawCylindricalLens[
		Function[{x,z},Evaluate[-f2[x,z]+thickness]],
		Function[{x,z},Evaluate[-f1[x,z]+thickness]],
		thickness, {width, height}, index
	];

Place[RawCylindricalLens[f1_, f2_, thickness_, {width_, height_}, index_], {x_, y_, thetax_},options___] :=
	Module[{f1new,f2new},
		If[DirectionFunction[{fx[f1, x, thetax], fy[f1, y, thetax], fz[f1, 0, 0]},
			{fx[f2, x, thetax], fy[f2, y, thetax], fz[f2, 0, 0]}]
			=== Reverse,
				f1new = Function[{tx,tz},Evaluate[-f2[tx,tz]]];
				f2new = Function[{tx,tz},Evaluate[-f1[tx,tz]]],
				f1new = f1;
				f2new = f2
		];
		PlacedLens[
			{fx[f1new, x, thetax], fy[f1new, y, thetax], fz[f1new, 0, 0]},
			{fx[f2new, x, thetax], fy[f2new, y, thetax], fz[f2new, 0, 0]},
			f1new, f2new, {thetax, 0},
			{width, height}, index
		]
	];

DirectedLens[RawCylindricalLens[f1_, f2_, thickness_, {width, height}, index_], {xlens_,ylens_},
			{xaxis_,yaxis_},SideofLens_,options___]:=
			
		Module[{lensAngle},
		If[SideofLens===Before,
			lensAngle = InverseTan[(ylens-yaxis),(xlens-xaxis)],
			lensAngle = InverseTan[(yaxis-ylens),(xaxis-xlens)]
		];
	
		Place[RawCylindricalLens[f1, f2, thickness, {width, height}, index], {xlens, ylens, lensAngle},options]
	];

Basic lens types:

Spherical Lense Definitions

Clear[RoundWindow];
RoundWindow[aperture_, thickness_, options___] :=
	Module[{index},
		index = GlassType /. {options} /. Options[Glasses];
		Lens[Infinity, Infinity, thickness, aperture, index]
	];

Clear[PlanoConvexLens];
PlanoConvexLens[signedFocalLength_, aperture_, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],curvature,index,designIndex},
		curvature = CurvatureDirection /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		If[curvature===Front,
			Lens[focalLength (designIndex - 1), Infinity, thickness, aperture, index],
			Lens[Infinity, -focalLength (designIndex - 1), thickness, aperture, index]
		]
	];

Clear[PlanoConcaveLens];
PlanoConcaveLens[signedFocalLength_, aperture_, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],curvature,index,designIndex},
		curvature = CurvatureDirection /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		If[curvature===Front,
			Lens[-focalLength (designIndex - 1), Infinity, thickness, aperture, index],
			Lens[Infinity, focalLength (designIndex - 1), thickness, aperture, index]
		]
	];

Clear[SymmetricConvexLens];
SymmetricConvexLens[signedFocalLength_, aperture_, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],index,designIndex},
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		Lens[focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex focalLength))]),
		-focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex focalLength))]),
		thickness, aperture, index]
	];

Clear[SymmetricConcaveLens];
SymmetricConcaveLens[signedFocalLength_, aperture_, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],index,designIndex},
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		Lens[-focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex (-focalLength)))]),
		focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex (-focalLength)))]),
		thickness, aperture, index]
	];

Clear[PositiveMeniscusLens];
PositiveMeniscusLens[sf_, aperture_, tc_, options___] :=
	Module[{f = Abs[sf],curvature,index,n},
		curvature = CurvatureDirection /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		n = DesignIndex /. {options} /. Options[Glasses];
		If[curvature===Front,
			Lens[(-f + f*n + n*tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc - 2*f*n*tc -
        2*f*n^2*tc + n^2*tc^2)^(1/2))/(2*(1 + n)), (f - f/n - tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc -
           2*f*n*tc - 2*f*n^2*tc + n^2*tc^2)^(1/2)/n)/2, tc, aperture, index],
			Lens[-(f - f/n - tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc -
           2*f*n*tc - 2*f*n^2*tc + n^2*tc^2)^(1/2)/n)/2,
          -(-f + f*n + n*tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc - 2*f*n*tc -
        2*f*n^2*tc + n^2*tc^2)^(1/2))/(2*(1 + n)), tc, aperture, index]
		]
	];

Clear[NegativeMeniscusLens];
NegativeMeniscuslens[sf_, aperture_, tc_, options___] :=
	Module[{f = -Abs[sf],curvature,index,n},
		curvature = CurvatureDirection /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		n = DesignIndex /. {options} /. Options[Glasses];
		If[curvature===Front,
			Lens[(f - f*n + n*tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc -
          2*f*n*tc - 2*f*n^2*tc + n^2*tc^2)^(1/2))/(2*n),
          (f - f*n - n*tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc - 2*f*n*tc -
        2*f*n^2*tc + n^2*tc^2)^(1/2))/(2*(1 + n)), tc, aperture, index],
			Lens[-(f - f*n - n*tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc - 2*f*n*tc -
        2*f*n^2*tc + n^2*tc^2)^(1/2))/(2*(1 + n)),
        -(f - f*n + n*tc + (f^2 - 2*f^2*n + f^2*n^2 + 4*f*tc -
          2*f*n*tc - 2*f*n^2*tc + n^2*tc^2)^(1/2))/(2*n), tc, aperture, index]
		]
	];

Cylindrical Lens Definitions:

Clear[Window];
Window[{width_,height_}, thickness_, options___] :=
	Module[{index},
		index = GlassType /. {options} /. Options[Glasses];
		CylindricalLens[Infinity, Infinity, thickness, {width,height}, index, horizontal]
	];

Clear[PlanoConvexLensCylindrical];
PlanoConvexLensCylindrical[signedFocalLength_, {width_,height_}, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],curvature,orientation,index,designIndex},
		orientation = CylindricalOrientation /. {options} /. Options[Lenses];
		curvature = CurvatureDirection /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		If[curvature===Front,
			CylindricalLens[focalLength (designIndex - 1), Infinity, thickness, {width,height}, index, orientation],
			CylindricalLens[Infinity, -focalLength (designIndex - 1), thickness, {width,height}, index, orientation]
		]
	];

Clear[PlanoConcaveLensCylindrical];
PlanoConcaveLensCylindrical[signedFocalLength_, {width_,height_}, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],curvature,orientation,index,designIndex},
		orientation = CylindricalOrientation /. {options} /. Options[Lenses];
		curvature = CurvatureDirection /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		If[curvature===Front,
			CylindricalLens[-focalLength (designIndex - 1), Infinity, thickness, {width,height}, index, orientation],
			CylindricalLens[Infinity, focalLength (designIndex - 1), thickness, {width,height}, index, orientation]
		]
	];

Clear[SymmetricConvexLensCylindrical];
SymmetricConvexLensCylindrical[signedFocalLength_, {width_,height_}, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],orientation,index,designIndex},
		orientation = CylindricalOrientation /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		CylindricalLens[focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex focalLength))]),
		-focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex focalLength))]),
		thickness, {width,height}, index, orientation]
	];

Clear[SymmetricConcaveLensCylindrical];
SymmetricConcaveLensCylindrical[signedFocalLength_, {width_,height_}, thickness_, options___] :=
	Module[{focalLength = Abs[signedFocalLength],orientation,index,designIndex},
		orientation = CylindricalOrientation /. {options} /. Options[Lenses];
		index = GlassType /. {options} /. Options[Glasses];
		designIndex = DesignIndex /. {options} /. Options[Glasses];
		CylindricalLens[-focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex (-focalLength)))]),
		focalLength (designIndex - 1)
		(1 + Sqrt[1-(thickness/(designIndex (-focalLength)))]),
		thickness, {width,height}, index, orientation]
	];

Prisms

Clear[Prism];
Prism[{alpha_ ,side_, beta_},height_,options___]:=
	Module[{aperture1, aperture2, aperture3,
			theta1, theta2, theta3,
			x1,x2,x3,y1,y2,y3,x0,y0,xx,index},
			aperture1 = side;
			theta1 = -90;
			x1 = 0;
			y1 = 0;
			index = GlassType /. {options} /. Options[Glasses];
			If[beta==90,
					x0 = side/2;
					y0 = Chop[N[Tan[alpha Degree] (x0 + side/2)]]
			];
			If[alpha==90,
					x0 = -side/2;
					y0 = Chop[N[-Tan[beta Degree] (x0 - side/2)]]
			];
			If[beta!=90&&alpha!=90,
					x0 = xx /.Solve[Chop[N[Tan[alpha Degree] (xx + side/2) == -Tan[beta Degree] (xx - side/2)]],xx];
					y0 = Chop[N[Tan[alpha Degree] (x0 + side/2)]]
			];
			aperture2 = Chop[N[Sqrt[(y0^2 + (side/2 - x0)^2)]]];
			aperture3 = Chop[N[Sqrt[(y0^2 + (x0 + side/2)^2)]]];
			x2 = N[side/2 - (side/2 - x0)/2];
			y2 = N[y0/2];
			x3 = N[-side/2 + (x0 + side/2)/2];
			y3 = N[y0/2];
			theta2 =90 - beta;
			theta3 =-90 + alpha;
			RawPrism[
				Flatten[{aperture1, theta1, x1, y1}],
				Flatten[{aperture2, theta2, x2, y2}],
				Flatten[{aperture3, theta3, x3, y3}],
				index,
				alpha,
				beta,
				height
					]
	];

Place[RawPrism[
			{aperture1_, theta1_, x1_, y1_},
			{aperture2_, theta2_, x2_, y2_},
			{aperture3_, theta3_, x3_, y3_},
			index_,
			alpha_,
			beta_,
			height_
				],
			{x_, y_, thetaxRotation_}]:= PlacedPrism[
				{fxx[fx[0&, x1, theta1], fy[0&, y1, theta1],x,thetaxRotation],
				fyy[fx[0&, x1, theta1], fy[0&, y1, theta1],y,thetaxRotation],
				fz[0&,0,0]},
				{fxx[fx[0&, x2, theta2], fy[0&, y2, theta2],x,thetaxRotation],
				fyy[fx[0&, x2, theta2], fy[0&, y2, theta2],y,thetaxRotation],
				fz[0&,0,0]},
				{fxx[fx[0&, x3, theta3], fy[0&, y3, theta3],x,thetaxRotation],
				fyy[fx[0&, x3, theta3], fy[0&, y3, theta3],y,thetaxRotation],
				fz[0&,0,0]},
				aperture1,
				aperture2,
				aperture3,
				{thetaxRotation, 0},
				alpha,
				beta,
				index,
				height
		];

Mirrors

Clear[FirstSurfacedMirror];
FirstSurfacedMirror[width_, thickness_, height_]:=
	RawMirror[0&, -thickness&, thickness, {width, height}, 1.5&, FirstSurface];

Place[RawMirror[f1_, f2_, thickness_, {width_, height_}, index_, mirrorType_], {x_, y_, thetax_},options___] :=
	Module[{f1new,f2new},
		If[DirectionFunction[{fx[f1, x, thetax], fy[f1, y, thetax], fz[f1, 0, 0]},
			{fx[f2, x, thetax], fy[f2, y, thetax], fz[f2, 0, 0]}]
			=== Reverse,
				f1new = Function[{tx,tz},Evaluate[-f2[tx,tz]]];
				f2new = Function[{tx,tz},Evaluate[-f1[tx,tz]]],
				f1new = f1;
				f2new = f2
		];	
		PlacedMirror[
			{fx[f1new, x, thetax], fy[f1new, y, thetax], fz[f1new, 0, 0]},
			{fx[f2new, x, thetax], fy[f2new, y, thetax], fz[f2new, 0, 0]},
			f1new, f2new, {thetax, 0},
			{width, height}, index, mirrorType
		]
	];

Clear[Mirror];
Mirror[{x1_,y1_},{x2_,y2_},thickness_, height_]:=

	Module[{width, mirrorAngle, xpos, ypos},
	
		width = Chop[N[Sqrt[(x2-x1)^2 + (y2 - y1)^2]]];
	
		xpos = Chop[N[(x2 + x1)/2]];
	
		ypos = Chop[N[(y2 + y1)/2]];
		
		Clear[mirrorAngle];
		
		mirrorAngle = InverseTan[(y2 - y1),(x2 - x1)]+90.;
	
		Place[FirstSurfacedMirror[width, thickness, height],{xpos,ypos,mirrorAngle}]

	];

Clear[DirectedMirror];

DirectedMirror[width_,thickness_,height_,{xbegin_,ybegin_},
			{xposition_,yposition_},{xend_,yend_},options___]:=
				
	Module[{incomingAngle,outgoingAngle,mirrorAngle},
		incomingAngle = InverseTan[(yposition-ybegin),(xposition-xbegin)];
				
		outgoingAngle = InverseTan[(yend-yposition),(xend-xposition)];
			
		mirrorAngle = -N[Chop[90-(incomingAngle+outgoingAngle)/2]];
	
		Place[FirstSurfacedMirror[width, thickness, height],{xposition,yposition,mirrorAngle},options]
	];

Polygonal Mirrors

Clear[PolygonalMirror];

Place[PolygonalMirror[NumberOfSides_,Diameter_,Height_], {x_, y_, thetax_},options___]:=
	
	PlacedPolygonalMirror[NumberOfSides,Diameter,Height, {x, y, thetax}];

Absorbers

Clear[Baffle];
Baffle[width_, thickness_, height_]:=
	RawBaffle[0&, -thickness&, thickness, {width, height}, 0];

Place[RawBaffle[f1_, f2_, thickness_, {width_, height_}, centerhole_], {x_, y_, thetax_},options___] :=
	Module[{f1new,f2new},
		If[DirectionFunction[{fx[f1, x, thetax], fy[f1, y, thetax], fz[f1, 0, 0]},
			{fx[f2, x, thetax], fy[f2, y, thetax], fz[f2, 0, 0]}]
			=== Reverse,
				f1new = Function[{tx,tz},Evaluate[-f2[tx,tz]]];
				f2new = Function[{tx,tz},Evaluate[-f1[tx,tz]]],
				f1new = f1;
				f2new = f2
		];
		PlacedBaffle[
			{fx[f1new, x, thetax], fy[f1new, y, thetax], fz[f1new, 0, 0]},
			{fx[f2new, x, thetax], fy[f2new, y, thetax], fz[f2new, 0, 0]},
			f1new, f2new, {thetax, 0},
			{N[width], N[height]}, centerhole
		]
	];

Clear[LightBlock];
LightBlock[{x1_,y1_},{x2_,y2_},thickness_,height_,options___]:=

	Module[{width, baffleAngle, xpos, ypos, shift},
	
		width = Chop[N[Sqrt[(x2-x1)^2 + (y2 - y1)^2]]];
	
		xpos = Chop[N[(x2 + x1)/2]];
	
		ypos = Chop[N[(y2 + y1)/2]];
		
		Clear[baffleAngle];
		
		baffleAngle = Chop[N[ArcTan[(y2 - y1)/(x2 - x1)]/Degree + 90]];
	
		Place[Baffle[width, thickness,height],{xpos,ypos,baffleAngle},options]

	];

By using a negative holediameter, the pinhole function indicates circular symmetry, otherwise the pinhole is presumed square.  Negative values for width indicates circular symmetry for outer boundaries

Clear[SquarePinHole];
SquarePinHole[HoleDimension_, Width_, Height_ {x_, y_, theta_}]:=
	Place[RawBaffle[0&, 0&, Width, Height, HoleDimension], {x, y, theta}];
	
Clear[RoundPinHole];
RoundPinHole[HoleDiameter_, OuterDiameter_, {x_, y_, theta_}]:=
	Place[RawBaffle[0&, 0&, -Abs[OuterDiameter], -Abs[OuterDiameter],
	-Abs[HoleDiameter]], {x, y, theta}];

Screens

Clear[GeneralScreen];
GeneralScreen[r_, width_, height_] :=
	Module[
		{nr},
		nr = N[r];
		ScreenWidth = N[width];
		ScreenHeight = N[height];
		RawScreen[
			If[nr === Infinity,
				0&,
				Function[{x,z},Evaluate[Sign[nr] Sqrt[nr^2 - x^2 - z^2] + nr]]
			],
			{N[width],
			N[height]}
		]
	];

Place[RawScreen[fraw_, {width_,height_}], {x_, y_, thetax_}] :=
		PlacedScreen[
			{fx[fraw, x, thetax], fy[fraw, y, thetax], fz[fraw, 0, 0]},
			fraw, {thetax, 0},
			{width, height}
	];

Clear[Screen];
Screen[width_,height_] := GeneralScreen[Infinity,width,height];

Clear[CircularScreen];
CircularScreen[width_,height_] := GeneralScreen[Infinity,-Abs[width],height];

Boundary of System

Clear[Boundary];
Boundary[{x1_,y1_,z1_},{x2_,y2_,z2_}]:=
	PlacedBoundary[
		{fx[0&, x2, 0], fy[0&, (y2 + y1)/2, 0], fz[0&,0,0]},
		{fx[0&, (x2 + x1)/2, 90], fy[0&, y2, 90], fz[0&,0,0]},
		{fx[0&, x1, 0], fy[0&, (y2 + y1)/2, 0], fz[0&,0,0]},
		{fx[0&, (x2 + x1)/2, 90], fy[0&, y1, 90], fz[0&,0,0]},
		0&, 0&, 0&, 0&,
		0, 90, 0, 90,
		y2-y1, x2-x1, y2-y1, x2-x1, z2-z1
	];

Propagation

System Functions

Propagate a single ray through a list of surfaces:

Clear[doRay];
doRay[Ray[{positionx_,positiony_,positionz_} , {anglex_, anglez_}, wavelength_], surfaces_] :=
	FoldList[
		propagateRay[#1, #2]&,
		{
			Ray[{positionx, positiony, positionz}, {anglex, anglez}, wavelength],
			1&
		},
		surfaces
	];

DrawSystem is the highest command used by this notebook.  DrawSystem calculates the ray/component interactions and subsequently plots these interactions according to the PlotType selected in the DrawSystem options..

Clear[DrawSystem];

SetAttributes[DrawSystem,HoldAll];

DrawSystem[rays_, components_, options___] :=
Module[
	{placedComponents, placedSurfaces, placedRays, plottype},
	
	Source = SourcePosition /. Options[Lenses];
	
	ScreenPoints = {};
	
	placedComponents = Flatten[components];
	
	placedSurfaces = Flatten[Map[componentToSurfaces, placedComponents]];
	
	placedRays = Map[doRay[#, placedSurfaces]&, Flatten[rays]];
	
	plottype = PlotType /. {options} /. Options[DrawSystem];
	
	If[plottype =!= Off,
		If[plottype===Screen,
			graphicaloutput = {},
				graphicaloutput =
					{
						Thickness[0.003],
						Map[renderComponent, placedComponents],
						Thickness[0.0005],
						Map[renderRay, placedRays]
					}
		];
		ShowSystem[options]
	]
];

ShowSystem redraws a previously calculated system.  By changing the PlotType, the system can be redisplayed from different perspectives without having to recalculate the ray-component interactions.

Clear[ShowSystem];

ShowSystem[options___] :=
Module[
	{plottype,c1,c2,opts},
	
	plottype = PlotType /. {options} /. Options[DrawSystem];
	
	Show[
	If[plottype===3D,
		opts = FilterOptions[Graphics3D,options];
		Graphics3D[graphicaloutput],
			opts = FilterOptions[Graphics,options];
			If[plottype===Screen,
			DrawScreen[opts],
				If[plottype===TopView,
					c1 = 1;
					c2 = 2,
						If[plottype===SideView,
							c1 = 1;
							c2 = 3,
								c1 = 2;
								c2 = 3
						]
				];
				turnAGraphics3DIntoAGraphics2DObject[Graphics3D[graphicaloutput], {c1, c2}]
			]
	],
		opts,
		AspectRatio -> Automatic,
		PlotRange -> All
	]
];

Clear[turnAGraphics3DIntoAGraphics2DObject];

turnAGraphics3DIntoAGraphics2DObject[Graphics3D[gr_, ___], {c1_, c2_}] :=
	Graphics[gr /. {
		Line[l_] :> Line[Map[{#[[c1]], #[[c2]]}&, l]],
		Polygon[l_] :> Polygon[Map[{#[[c1]], #[[c2]]}&, l]],
		Point[l_] :> Point[{l[[c1]], l[[c2]]}]
	}];

DrawScreen is used within the DrawSystem and the ShowSystem command, and is a command which plots only the points of intersection between the rays and an object called Screen.

Clear[DrawScreen];

DrawScreen[options___] :=

	Graphics[
		{
		AbsolutePointSize[3],
		Map[Point,ScreenPoints],
		Thickness[0.0002],
		If[ScreenWidth==Abs[ScreenWidth],
			Line[
				{
					{-ScreenWidth/2,-ScreenHeight/2},
					{ScreenWidth/2,-ScreenHeight/2},
					{ScreenWidth/2,ScreenHeight/2},
					{-ScreenWidth/2,ScreenHeight/2},
					{-ScreenWidth/2,-ScreenHeight/2}
				}
			],
			Join[	
				Table[
				{N[Abs[ScreenWidth] Cos[t]/2], N[Abs[ScreenWidth] Sin[t]/2]},
				{t, 0, 2 Pi, Pi/20}
				]
			]
		]
		}
	];

Turn a component into surfaces:

Clear[componentToSurfaces];

componentToSurfaces[Null] := {};

componentToSurfaces[PlacedPolygonalMirror[NumberOfSides_,Diameter_,Height_, {x_, y_, thetax_}]] :=
	Module[{subwidth,subtheta,offsettheta,sourcex,sourcey,sourcez,newthetax,
			unitangle,x1,x2,y1,y2,thetaT,thetaT1,thetaT2,xpos,ypos,PrimeAngle},
		subwidth = Abs[Chop[N[Diameter Sin[Pi/NumberOfSides]]]];
		{sourcex,sourcey,sourcez} = Source;
		unitangle = N[360/NumberOfSides];
		PrimeAngle[theta_] := If[theta>180,theta - 360,If[theta<-180,theta + 360,theta]];
		offsettheta = Chop[N[Round[InverseTan[(sourcey - y),(sourcex - x)]/unitangle] unitangle]];
		newthetax = Chop[N[thetax - Round[thetax/unitangle] unitangle]];
		x1 := Diameter Cos[(thetaT - unitangle/2) Degree]/2;
		y1 := Diameter Sin[(thetaT - unitangle/2) Degree]/2;
		x2 := Diameter Cos[(thetaT + unitangle/2) Degree]/2;
		y2 := Diameter Sin[(thetaT + unitangle/2) Degree]/2;
		xpos := Chop[N[(x2 + x1)/2]] + x;
		ypos := Chop[N[(y2 + y1)/2]] + y;
		Flatten[{
			thetaT = PrimeAngle[newthetax + offsettheta];
			Surface[{fx[0&, xpos, thetaT], fy[0&, ypos, thetaT], fz[0&, 0, 0]},
				0&, {thetaT,0}, {subwidth, Height}, 1&, 1&, Reflective],
		Table[{
			thetaT1 = newthetax - subtheta + offsettheta;
			thetaT2 = newthetax + subtheta + offsettheta;
			If[Abs[thetaT1-offsettheta]<Abs[thetaT2-offsettheta],
				thetaT=PrimeAngle[thetaT1];
				thetaT2=PrimeAngle[thetaT2],
					thetaT=PrimeAngle[thetaT2];
					thetaT2=PrimeAngle[thetaT1]
			];
			Surface[{fx[0&, xpos, thetaT], fy[0&, ypos, thetaT], fz[0&, 0, 0]},
				0&, {thetaT,0}, {subwidth, Height}, 1&, 1&, Reflective],
			thetaT = thetaT2;
			Surface[{fx[0&, xpos, thetaT], fy[0&, ypos, thetaT], fz[0&, 0, 0]},
				0&, {thetaT,0}, {subwidth, Height}, 1&, 1&, Reflective]
			},
			{subtheta, unitangle, Round[NumberOfSides/4] unitangle, unitangle}
		]}
		]
	];

componentToSurfaces[PlacedLens[f1_, f2_, fraw1_, fraw2_, {lensxtheta_, lensztheta_}, {width_, height_}, index_]] :=
{
	Surface[f1, fraw1, {lensxtheta, lensztheta}, {width, height}, 1&, index, Refractive],
	Surface[f2, fraw2, {lensxtheta, lensztheta}, {width, height}, index, 1&, Refractive]
};

componentToSurfaces[PlacedScreen[f_,fraw_,{thetax_, thetaz_},{width_,height_}]] :=
{
	Surface[f, fraw, {thetax, thetaz}, {width, height}, 1&, 1&, Screen]
};

componentToSurfaces[PlacedMirror[f1_, f2_, fraw1_, fraw2_, {thetax_, thetaz_}, {width_, height_}, index_, mirrortype_]] :=

	If[mirrortype==FirstSurface,
		{Surface[f1, fraw1, {thetax, thetaz}, {width, height}, 1&, 1&, Reflective]},
		{Surface[f1, fraw1, {thetax, thetaz}, {width, height}, 1&, index, Refractive],
		Surface[f2, fraw2, {thetax, thetaz}, {width, height}, 1&, 1&, Reflective],
		Surface[f1, fraw1, {thetax, thetaz}, {width, height}, index, 1&, Refractive]}];

componentToSurfaces[PlacedBaffle[f1_, f2_, fraw1_, fraw2_, {thetax_, thetaz_}, {width_, height_}, CenterHole_]] :=
{
	Surface[f1, fraw1, {thetax, thetaz}, {width, height}, CenterHole, 1&, Absorptive],
	Surface[f2, fraw2, {thetax, thetaz}, {width, height}, CenterHole, 1&, Absorptive]
};

componentToSurfaces[PlacedBoundary[f1_, f2_, f3_, f4_,
	 fraw1_, fraw2_, fraw3_, fraw4_, theta1_,theta2_, theta3_, theta4_,
	 width1_, width2_, width3_, width4_, height_]] :=
{
	Surface[f1, fraw1, {theta1,0}, {width1, height}, 0&, 1&, Absorptive],
	Surface[f2, fraw2, {theta2,0}, {width2, height}, 0&, 1&, Absorptive],
	Surface[f3, fraw3, {theta3,0}, {width3, height}, 0&, 1&, Absorptive],
	Surface[f4, fraw4, {theta4,0}, {width4, height}, 0&, 1&, Absorptive]
};

componentToSurfaces[PlacedPrism[f1_,f2_,f3_,
		width1_, width2_, width3_,
		 {thetax_, thetaz_}, alpha_, beta_, index_, height_, options___]] :=
	Module[{next,emtranceFace},
		If[DirectionFunction[f1,f2,options]===Forward &&
			DirectionFunction[f1,f3,options]===Forward,
				entranceFace = FirstFace;
				If[DirectionFunction[f2,f3,options]===Forward,
					next = Surface[f2, 0&, {-90 - beta + thetax,thetaz}, {width2, height}, 1&, index, Refractive],
					next = Surface[f3, 0&, {-90 + alpha + thetax,thetaz}, {width3, height}, 1&, index, Refractive]
				],
			If[DirectionFunction[f2,f3,options]===Forward &&
				DirectionFunction[f2,f1,options]===Forward,
					entranceFace = SecondFace;
					If[DirectionFunction[f1,f3,options]===Forward,
						next = Surface[f1, 0&, {90 + thetax,thetaz}, {width1, height}, 1&, index, Refractive],
						next = Surface[f3, 0&, {-90 + alpha + thetax,thetaz}, {width3, height}, 1&, index, Refractive]
					],
				entranceFace = ThirdFace;
				If[DirectionFunction[f1,f2,options]===Forward,
						next = Surface[f1, 0&, {90 + thetax,thetaz}, {width1, height}, 1&, index, Refractive],
						next = Surface[f2, 0&, {-90 - beta + thetax,thetaz}, {width2, height}, 1&, index, Refractive]
				]
			]
		];
		If[entranceFace===FirstFace,
		{
		Surface[f1, 0&, {90 + thetax,thetaz}, {width1, height}, 1&, index, Refractive],
		next,
		Surface[f3, 0&, {90 + alpha + thetax,thetaz}, {width3, height}, index, 1&, Refractive],
		Surface[f2, 0&, {90 - beta + thetax,thetaz}, {width2, height}, index, 1&, Refractive],
		Surface[f3, 0&, {-90 + alpha + thetax,thetaz}, {width3, height}, index, 1&, Refractive],
		Surface[f1, 0&, {-90 + thetax,thetaz}, {width1, height}, index, 1&, Refractive]
		},
			If[entranceFace===SecondFace,
			{
			Surface[f2, 0&, {-90 - beta + thetax,thetaz}, {width2, height}, 1&, index, Refractive],
			next,
			Surface[f1, 0&, {-90 + thetax,thetaz}, {width1, height}, index, 1&, Refractive],
			Surface[f3, 0&, {90 + alpha + thetax,thetaz}, {width3, height}, index, 1&, Refractive],
			Surface[f1, 0&, {-90 + thetax,thetaz}, {width1, height}, index, 1&, Refractive],
			Surface[f2, 0&, {90 - beta + thetax,thetaz}, {width2, height}, index, 1&, Refractive]
			},
				If[entranceFace===ThirdFace,
				{
				Surface[f3, 0&, {-90 + alpha + thetax,thetaz}, {width3, height}, 1&, index, Refractive],
				next,
				Surface[f2, 0&, {90 - beta + thetax,thetaz}, {width2, height}, index, 1&, Refractive],
				Surface[f1, 0&, {-90 + thetax,thetaz}, {width1, height}, index, 1&, Refractive],
				Surface[f2, 0&, {90 - beta + thetax,thetaz}, {width2, height}, index, 1&, Refractive],
				Surface[f3, 0&, {90 + alpha + thetax,thetaz}, {width3, height}, index, 1&, Refractive]
				}]
			]
		]
	];

Propagate a single ray through a single surface:

Clear[propagateRay]

Off[MainSolve::elist];

propagateRay[{}, _] := {};

propagateRay[{Ray[], _}, _] := {};

propagateRay[{Ray[{rx1_, ry1_, rz1_}, {thetax1_, thetaz1_}, wavelength_], index_},
			 Surface[{fx_, fy_, fz_}, fraw_, {lensxtheta_, lensztheta_}, {width_, height_}, indexL_, indexR_, componentType_]]:=
			
Module[{tx, tz, txx, tzz, tl,t1, tl1, rx2, ry2, rz2, thetax2, thetaz2, df, thetaxsurface, thetazsurface, ignored, intersections},
	
	If[componentType===Refractive && indexL!=index && indexR == index, 	
		indexR = indexL;
		indexL = index
	];
	If[(componentType === Absorptive && Abs[thetax1-lensxtheta] == 90) || (wavelength == 0&&componentType=!=Absorptive),
		Return[{Ray[{rx1, ry1, rz1}, {thetax1, thetaz1}, wavelength], index}]];
	
	intersections = Chop[N[
		{tl, tx, tz} /.
			Solve[
				Chop[N[{
					rx1 + tl Cos[thetax1 Degree] == fx[tx,tz],
					ry1 + tl Sin[thetax1 Degree] == fy[tx,tz],
					rz1 + tl Sin[thetaz1 Degree] == fz[tx,tz]
				}]],
				{tl, tx, tz}
			]
	]];
	
	If[width==Abs[width],
		intersections = Select[
			intersections,
			Apply[
				Function[{tl,tx,tz},(Abs[tx] <= width/2)
					&& (Abs[tz] <= height/2)
					&& (Im[tx]==0)&&(Im[tl]==0)&&(Im[tz]==0)
					&& (tl>0)
					&& (Abs[N[rx1 + tl Cos[thetax1 Degree] - fx[tx,tz]]] < 10^-5)
					&& (Abs[N[ry1 + tl Sin[thetax1 Degree] - fy[tx,tz]]] < 10^-5)
					&& (Abs[N[rz1 + tl Sin[thetaz1 Degree] - fz[tx,tz]]] < 10^-5)
				],
				#
			]&
		]
	(*else*),
		intersections = Select[
			intersections,
			Apply[
				Function[{tl,tx,tz},(tx^2 + tz^2 <= (width/2)^2)
					&& (Im[tx]==0)&&(Im[tl]==0)&&(Im[tz]==0)
					&& (tl>0)
					&& (Abs[N[rx1 + tl Cos[thetax1 Degree] - fx[tx,tz]]] < 10^-5)
					&& (Abs[N[ry1 + tl Sin[thetax1 Degree] - fy[tx,tz]]] < 10^-5)
					&& (Abs[N[rz1 + tl Sin[thetaz1 Degree] - fz[tx,tz]]] < 10^-5)
				],
				#
			]&
		]
	];
	
	If[Length[intersections] == 0, Return[{Ray[{rx1, ry1, rz1}, {thetax1, thetaz1}, wavelength], index}]];
	
	{tl1, tx1, tz1} = First[Sort[intersections]];
	
	If[componentType===Screen,
		ScreenPoints = AppendTo[ScreenPoints,{tx1, tz1}];
		Return[{Ray[{rx1, ry1, rz1}, {thetax1, thetaz1}, wavelength], index}]
	];
	
	dfx = D[fraw[txx,tzz],txx]/.{txx->tx1,tzz->tz1};
	
	dfz = D[fraw[txx,tzz],tzz]/.{txx->tx1,tzz->tz1};
	
	thetaxsurface = N[ArcTan[dfx]/Degree];
	
	thetazsurface = N[ArcTan[dfz]/Degree];
	
	rx2 = N[rx1 + tl1 Cos[thetax1 Degree]];
	
	ry2 = N[ry1 + tl1 Sin[thetax1 Degree]];
	
	rz2 = N[rz1 + tl1 Sin[thetaz1 Degree]];
	
	If[componentType === Refractive,
		{thetax2 = Chop[N[ArcSin[N[indexL[wavelength]*Sin[(thetax1 - lensxtheta + thetaxsurface) Degree]]/
					N[indexR[wavelength]]]/Degree + lensxtheta - thetaxsurface]],
		thetaz2 = Chop[N[ArcSin[N[indexL[wavelength]*Sin[(thetaz1 - lensztheta + thetazsurface) Degree]]/
					N[indexR[wavelength]]]/Degree + lensztheta - thetazsurface]]},
		
		If[componentType === Reflective,
			{thetax2 = N[180 - thetax1 + 2 (lensxtheta + thetaxsurface)],
			thetaz2 = N[180 - thetaz1 + 2 (lensztheta + thetazsurface)]},
		]
	];
	
	If[componentType === Absorptive && indexL==-Abs[indexL],
		If[(tx1^2 + tz1^2<(indexL/2)^2),
			Return[{Ray[{rx1, ry1, rz1}, {thetax1, thetaz1}, wavelength], index}]
		],
		If[componentType === Absorptive && indexL==Abs[indexL],
			If[Abs[tx1/2]<Abs[indexL/2]&&Abs[tz1/2]<Abs[indexL/2],
				Return[{Ray[{rx1, ry1, rz1}, {thetax1, thetaz1}, wavelength], index}]
			]
		]
	];
	
	If[componentType === Absorptive,
		Return[{Ray[{rx2, ry2, rz2}, {I ,I}, wavelength], index}]
	];
	
	If[Im[thetax2] != 0 && Im[thetaz2] == 0 && componentType === Refractive,
		{thetax2 = N[-180 + 2*(lensxtheta + thetaxsurface) - thetax1],
		thetaz2 = thetaz1}
	];
	
	If[Im[thetax2] != 0 && Im[thetaz2] != 0 && componentType === Refractive,
		{thetax2 = N[-180 + 2*(lensxtheta + thetaxsurface) - thetax1],
		thetaz2 = N[-180 + 2*(lensztheta + thetazsurface) - thetaz1]}
	];
	
	If[Im[thetax2] == 0 && Im[thetaz2] != 0 && componentType === Refractive,
		{thetaz2 = N[-180 + 2*(lensztheta + thetazsurface) - thetaz1],
		thetax2 = thetax1}
	];
	
	{Ray[{rx2, ry2, rz2}, {thetax2, thetaz2}, wavelength], indexR}
];

Render Components

Clear[renderComponent];

Lenses

renderComponent[PlacedLens[{f1x_, f1y_, f1z_}, {f2x_, f2y_, f2z_}, fraw1_, fraw2_, {lensxtheta_, lensztheta_}, {width_, height_}, index_]] :=
Module[
	{outline1,outline2,outline3,outline4, t,abswidth},
		abswidth = Abs[width];
		If[width==-Abs[width],
	
		outline1 = Join[
				Table[{f1x[t,0], f1y[t,0], f1z[t,0]},
				{t, -abswidth/2, abswidth/2, abswidth/20}],
				Table[{f2x[t,0], f2y[t,0], f2z[t,0]},
				{t, abswidth/2, -abswidth/2, -abswidth/20}],
				{{f1x[-abswidth/2,0], f1y[-abswidth/2,0], f1z[-abswidth/2,0]}}
			];
		outline2 = Join[	
				Table[{f1x[0,t], f1y[0,t], f1z[0,t]},
				{t, -abswidth/2, abswidth/2, abswidth/20}],
				Table[{f2x[0,t], f2y[0,t], f2z[0,t]},
				{t, abswidth/2, -abswidth/2, -abswidth/20}],
				{{f1x[0,-abswidth/2], f1y[0,-abswidth/2], f1z[0,-abswidth/2]}}
			];
		outline3 = Join[	
				Table[{
				f1x[Abs[abswidth/2] Cos[t], Abs[abswidth/2] Sin[t]],
				f1y[Abs[abswidth/2] Cos[t], Abs[abswidth/2] Sin[t]],
				f1z[Abs[abswidth/2] Cos[t], Abs[abswidth/2] Sin[t]]},
				{t, 0, 2 Pi, Pi/20}]
			];
		outline4 = Join[	
				Table[{
				f2x[Abs[abswidth/2] Cos[t], Abs[abswidth/2] Sin[t]],
				f2y[Abs[abswidth/2] Cos[t], Abs[abswidth/2] Sin[t]],
				f2z[Abs[abswidth/2] Cos[t], Abs[abswidth/2] Sin[t]]},
				{t, 0, 2 Pi, Pi/20}]
			],
	If[width === Infinity,
		{},
		outline1 = Join[
				Table[{f1x[t,0], f1y[t,0], f1z[t,0]},
				{t, -width/2, width/2, width/20}],
				Table[{f2x[t,0], f2y[t,0], f2z[t,0]},
				{t, width/2, -width/2, -width/20}],
				{{f1x[-width/2,0], f1y[-width/2,0], f1z[-width/2,0]}}
			];
		outline2 = Join[	
				Table[{f1x[0,t], f1y[0,t], f1z[0,t]},
				{t, -height/2, height/2, height/20}],
				Table[{f2x[0,t], f2y[0,t], f2z[0,t]},
				{t, height/2, -height/2, -height/20}],
				{{f1x[0,-height/2], f1y[0,-height/2], f1z[0,-height/2]}}
			];
		outline3 = Join[
				Table[{f1x[t,height/2], f1y[t,height/2], f1z[t,height/2]},
				{t, -width/2, width/2, width/20}],
				Table[{f1x[width/2,t], f1y[width/2,t], f1z[width/2,t]},
				{t, height/2, -height/2, -height/20}],
				Table[{f1x[t,-height/2], f1y[t,-height/2], f1z[t,-height/2]},
				{t, width/2, -width/2, -width/20}],
				Table[{f1x[-width/2,t], f1y[-width/2,t], f1z[-width/2,t]},
				{t, -height/2, height/2, height/20}]
			];
		outline4 = Join[
				Table[{f2x[t,height/2], f2y[t,height/2], f2z[t,height/2]},
				{t, -width/2, width/2, width/20}],
				Table[{f2x[width/2,t], f2y[width/2,t], f2z[width/2,t]},
				{t, height/2, -height/2, -height/20}],
				Table[{f2x[t,-height/2], f2y[t,-height/2], f2z[t,-height/2]},
				{t, width/2, -width/2, -width/20}],
				Table[{f2x[-width/2,t], f2y[-width/2,t], f2z[-width/2,t]},
				{t, -height/2, height/2, height/20}]
			];
			]
			];
	{
			GrayLevel[1 - (index[.546] - 1) / 2],
			Polygon[outline1],
			Polygon[outline2],
			GrayLevel[0],
			Thickness[0.0002],
			Line[outline1],
			Line[outline2],
			Line[outline3],
			Line[outline4]
		}

];

Mirrors

renderComponent[PlacedMirror[{f1x_, f1y_, f1z_}, {f2x_, f2y_, f2z_}, fraw1_, fraw2_, {thetax_, thetaz_}, {width_, height_}, index_, mirrortype_]] :=
Module[
	{outline1,outline2,outline3,outline4, t},
	If[width==-Abs[width],
	
		outline1 = Join[	
				Table[{f1x[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f1y[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f1z[Abs[width/2] Cos[t], Abs[width/2] Sin[t]]},
				{t, 0, 2 Pi, Pi/10}]
			];
		outline2 = Join[	
				Table[{f2x[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f2y[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f2z[Abs[width/2] Cos[t], Abs[width/2] Sin[t]]},
				{t, 0, 2 Pi, Pi/10}]
			];
		outline3 = Join[{{f1x[-width/2,0], f1y[-width/2,0], f1z[-width/2,0]},
			{f1x[width/2,0], f1y[width/2,0], f1z[width/2,0]},
			{f2x[width/2,0], f2y[width/2,0], f2z[width/2,0]},
			{f2x[-width/2,0], f2y[-width/2,0], f2z[-width/2,0]},
			{f1x[-width/2,0], f1y[-width/2,0], f1z[-width/2,0]}
			}];
		outline4 = Join[{{f1x[-width/2], f1y[-width/2], f1z[-width/2]},
			{f1x[0,width/2], f1y[0,width/2], f1z[0,width/2]},
			{f2x[0,width/2], f2y[0,width/2], f2z[0,width/2]},
			{f2x[0,-width/2], f2y[0,-width/2], f2z[0,-width/2]},
			{f1x[0,-width/2], f1y[0,-width/2], f1z[0,-width/2]}
			}];
		{
			GrayLevel[0.5],
			Polygon[outline3],
			Polygon[outline4],
			If[mirrortype===FirstSurface,
					Polygon[outline1],
					Polygon[outline2]],
			GrayLevel[0],
			Thickness[0.0002],
			Line[outline3],
			Line[outline4],
			Line[outline1],
			Line[outline2]
		},
		If[width === Infinity,
			{},
			outline1 = Join[{{f1x[-width/2,-height/2], f1y[-width/2,-height/2], f1z[-width/2,-height/2]},
				{f1x[width/2,-height/2], f1y[width/2,-height/2], f1z[width/2,-height/2]},
				{f1x[width/2,height/2], f1y[width/2,height/2], f1z[width/2,height/2]},
				{f1x[-width/2,height/2], f1y[-width/2,height/2], f1z[-width/2,height/2]},
				{f1x[-width/2,-height/2], f1y[-width/2,-height/2], f1z[-width/2,-height/2]}
				}];
			outline2 = Join[{{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]},
				{f2x[width/2,-height/2], f2y[width/2,-height/2], f2z[width/2,-height/2]},
				{f2x[width/2,height/2], f2y[width/2,height/2], f2z[width/2,height/2]},
				{f2x[-width/2,height/2], f2y[-width/2,height/2], f2z[-width/2,height/2]},
				{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]}
				}];
			outline3 = Join[{{f1x[-width/2,0], f1y[-width/2,0], f1z[-width/2,0]},
				{f1x[width/2,0], f1y[width/2,0], f1z[width/2,0]},
				{f2x[width/2,0], f2y[width/2,0], f2z[width/2,0]},
				{f2x[-width/2,0], f2y[-width/2,0], f2z[-width/2,0]},
				{f1x[-width/2,0], f1y[-width/2,0], f1z[-width/2,0]}
				}];
			outline4 = Join[{{f1x[0,-height/2], f1y[0,-height/2], f1z[0,-height/2]},
				{f1x[0,height/2], f1y[0,height/2], f1z[0,height/2]},
				{f2x[0,height/2], f2y[0,height/2], f2z[0,height/2]},
				{f2x[0,-height/2], f2y[0,-height/2], f2z[0,-height/2]},
				{f1x[0,-height/2], f1y[0,-height/2], f1z[0,-height/2]}
				}];
			{
				GrayLevel[0.5],
				Polygon[outline3],
				Polygon[outline4],
				If[mirrortype===FirstSurface,
					Polygon[outline1],
					Polygon[outline2]],
				GrayLevel[0],
				Thickness[0.0002],
				Line[outline3],
				Line[outline4],
				Line[outline1],
				Line[outline2]
			}
		]
	]
];

renderComponent[PlacedPolygonalMirror[NumberOfSides_,Diameter_,Height_, {x_, y_, thetax_}]] :=
Module[{subtheta,topside,bottomside,box},
	box[theta_] := Module[{outline,x1,y1,x2,y2},
		x1 = N[Diameter Cos[(theta - 180/NumberOfSides)Degree]/2+x];
		y1 = N[Diameter Sin[(theta - 180/NumberOfSides)Degree]/2+y];
		x2 = N[Diameter Cos[(theta + 180/NumberOfSides)Degree]/2+x];
		y2 = N[Diameter Sin[(theta + 180/NumberOfSides)Degree]/2+y];
		outline = Join[{{x1,y1,-Height/2},{x2,y2,-Height/2},
					{x2,y2,Height/2},{x1,y1,Height/2},{x1,y1,-Height/2}}]//N;
		{GrayLevel[0.5],
		Polygon[outline],
		GrayLevel[0],
		Line[outline]
		}];
	topside = Join[Table[
			{Chop[N[x + Diameter Cos[(subtheta + thetax) Degree]/2]],
			Chop[N[y + Diameter Sin[(subtheta + thetax) Degree]/2]],-N[Height/2]},
			{subtheta, N[180/NumberOfSides], N[180/NumberOfSides+360],N[360/NumberOfSides]}
		]];
	bottomside = Join[Table[
			{Chop[N[x + Diameter Cos[(subtheta + thetax) Degree]/2]],
			Chop[N[y + Diameter Sin[(subtheta + thetax) Degree]/2]],N[Height/2]},
			{subtheta, N[180/NumberOfSides], N[180/NumberOfSides+360],N[360/NumberOfSides]}
		]];
	Join[Flatten[{
		GrayLevel[0.5],
		Polygon[topside],
		Polygon[bottomside],
		GrayLevel[0],
		Line[topside],
		Line[bottomside],
		Table[box[subtheta + thetax],{subtheta,0,360,360/NumberOfSides}]
		}
	]]
];

Prisms

renderComponent[PlacedPrism[{f1x_, f1y_, f1z_}, {f2x_, f2y_, f2z_},{f3x_, f3y_, f3z_},
		width1_, width2_, width3_,
		 {thetax_, thetaz_}, alpha_, beta_, index_, height_]] :=
Module[
	{outline1,outline2,outline3,outline4,outline5},
	If[height === Infinity,
		{},
		outline1 = {{Chop[N[f1x[width1/2,-height/2]]], Chop[N[f1y[width1/2,-height/2]]], Chop[N[f1z[width1/2,-height/2]]]},
					{Chop[N[f1x[-width2/2,-height/2]]], Chop[N[f1y[-width2/2,-height/2]]], Chop[N[f1z[-width2/2,-height/2]]]},
					{Chop[N[f2x[width3/2,-height/2]]], Chop[N[f2y[width3/2,-height/2]]], Chop[N[f2z[width3/2,-height/2]]]},
					{Chop[N[f1x[width1/2,-height/2]]], Chop[N[f1y[width1/2,-height/2]]], Chop[N[f1z[width1/2,-height/2]]]}
				};
		outline2 = {{Chop[N[f1x[width1/2,height/2]]], Chop[N[f1y[width1/2,height/2]]], Chop[N[f1z[width1/2,height/2]]]},
					{Chop[N[f1x[-width2/2,height/2]]], Chop[N[f1y[-width2/2,height/2]]], Chop[N[f1z[-width2/2,height/2]]]},
					{Chop[N[f2x[width3/2,height/2]]], Chop[N[f2y[width3/2,height/2]]], Chop[N[f2z[width3/2,height/2]]]},
					{Chop[N[f1x[width1/2,height/2]]], Chop[N[f1y[width1/2,height/2]]], Chop[N[f1z[width1/2,height/2]]]}
				};
		outline3 = {{Chop[N[f1x[-width1/2,-height/2]]], Chop[N[f1y[-width1/2,-height/2]]], Chop[N[f1z[-width1/2,-height/2]]]},
					{Chop[N[f1x[-width1/2,height/2]]], Chop[N[f1y[-width1/2,height/2]]], Chop[N[f1z[-width1/2,height/2]]]},
					{Chop[N[f1x[width1/2,height/2]]], Chop[N[f1y[width1/2,height/2]]], Chop[N[f1z[width1/2,height/2]]]},
					{Chop[N[f1x[width1/2,-height/2]]], Chop[N[f1y[width1/2,-height/2]]], Chop[N[f1z[width1/2,-height/2]]]},
					{Chop[N[f1x[-width1/2,-height/2]]], Chop[N[f1y[-width1/2,-height/2]]], Chop[N[f1z[-width1/2,-height/2]]]}
				};
		outline4 = {{Chop[N[f2x[-width2/2,-height/2]]], Chop[N[f2y[-width2/2,-height/2]]], Chop[N[f2z[-width2/2,-height/2]]]},
					{Chop[N[f2x[-width2/2,height/2]]], Chop[N[f2y[-width2/2,height/2]]], Chop[N[f2z[-width2/2,height/2]]]},
					{Chop[N[f2x[width2/2,height/2]]], Chop[N[f2y[width2/2,height/2]]], Chop[N[f2z[width2/2,height/2]]]},
					{Chop[N[f2x[width2/2,-height/2]]], Chop[N[f2y[width2/2,-height/2]]], Chop[N[f2z[width2/2,-height/2]]]},
					{Chop[N[f2x[-width2/2,-height/2]]], Chop[N[f2y[-width2/2,-height/2]]], Chop[N[f2z[-width2/2,-height/2]]]}
				};
		outline5 = {{Chop[N[f3x[-width3/2,-height/2]]], Chop[N[f3y[-width3/2,-height/2]]], Chop[N[f3z[-width3/2,-height/2]]]},
					{Chop[N[f3x[-width3/2,height/2]]], Chop[N[f3y[-width3/2,height/2]]], Chop[N[f3z[-width3/2,height/2]]]},
					{Chop[N[f3x[width3/2,height/2]]], Chop[N[f3y[width3/2,height/2]]], Chop[N[f3z[width3/2,height/2]]]},
					{Chop[N[f3x[width3/2,-height/2]]], Chop[N[f3y[width3/2,-height/2]]], Chop[N[f3z[width3/2,-height/2]]]},
					{Chop[N[f3x[-width3/2,-height/2]]], Chop[N[f3y[-width3/2,-height/2]]], Chop[N[f3z[-width3/2,-height/2]]]}
				};
			];
		{
			GrayLevel[0],
			Thickness[0.0002],
			Line[outline1],
			Line[outline2],
			Line[outline3],
			Line[outline4],
			Line[outline5]
		}
]

Absorbers

renderComponent[PlacedBaffle[{f1x_, f1y_, f1z_}, {f2x_, f2y_, f2z_}, fraw1_, fraw2_, {thetax_, thetaz_}, {width_, height_}, CenterHole_]] :=
Module[
	{outline1,outline2,outline3,outline4,
	 outline5,outline6,t},
	If[aperture === Infinity,
		{},
		If[width==-Abs[width],
	
		outline1 = Join[	
				Table[{f1x[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f1y[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f1z[Abs[width/2] Cos[t], Abs[width/2] Sin[t]]},
				{t, 0, 2 Pi, Pi/10}]
			];
		outline2 = Join[	
				Table[{f2x[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f2y[Abs[width/2] Cos[t], Abs[width/2] Sin[t]],
				f2z[Abs[width/2] Cos[t], Abs[width/2] Sin[t]]},
				{t, 0, 2 Pi, Pi/10}]
			];
		outline3 = Join[{{f1x[-Abs[width/2],0], f1y[-Abs[width/2],0], f1z[-Abs[width/2],0]},
			{f1x[Abs[width/2],0], f1y[Abs[width/2],0], f1z[Abs[width/2],0]},
			{f2x[Abs[width/2],0], f2y[Abs[width/2],0], f2z[Abs[width/2],0]},
			{f2x[-Abs[width/2],0], f2y[-Abs[width/2],0], f2z[-Abs[width/2],0]},
			{f1x[-Abs[width/2],0], f1y[-Abs[width/2],0], f1z[-Abs[width/2],0]}
			}];
		outline4 = Join[{{f1x[-Abs[width/2]], f1y[-Abs[width/2]], f1z[-Abs[width/2]]},
			{f1x[0,Abs[width/2]], f1y[0,Abs[width/2]], f1z[0,Abs[width/2]]},
			{f2x[0,Abs[width/2]], f2y[0,Abs[width/2]], f2z[0,Abs[width/2]]},
			{f2x[0,-Abs[width/2]], f2y[0,-Abs[width/2]], f2z[0,-Abs[width/2]]},
			{f1x[0,-Abs[width/2]], f1y[0,-Abs[width/2]], f1z[0,-Abs[width/2]]}
			}];
		{
			GrayLevel[0.5],
			Polygon[outline1],
			Polygon[outline2],
			Polygon[outline3],
			Polygon[outline4],
			GrayLevel[0],
			Thickness[0.0002],
			Line[outline1],
			Line[outline2],
			Line[outline3],
			Line[outline4]
		},
		If[width === Infinity,
			{},
			outline1 = Join[{{f1x[-width/2,-height/2], f1y[-width/2,-height/2], f1z[-width/2,-height/2]},
				{f1x[width/2,-height/2], f1y[width/2,-height/2], f1z[width/2,-height/2]},
				{f1x[width/2,height/2], f1y[width/2,height/2], f1z[width/2,height/2]},
				{f1x[-width/2,height/2], f1y[-width/2,height/2], f1z[-width/2,height/2]},
				{f1x[-width/2,-height/2], f1y[-width/2,-height/2], f1z[-width/2,-height/2]}
				}];
			outline2 = Join[{{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]},
				{f2x[width/2,-height/2], f2y[width/2,-height/2], f2z[width/2,-height/2]},
				{f2x[width/2,height/2], f2y[width/2,height/2], f2z[width/2,height/2]},
				{f2x[-width/2,height/2], f2y[-width/2,height/2], f2z[-width/2,height/2]},
				{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]}
				}];
				outline3 = Join[{{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]},
				{f2x[width/2,-height/2], f2y[width/2,-height/2], f2z[width/2,-height/2]},
				{f1x[width/2,-height/2], f1y[width/2,-height/2], f1z[width/2,-height/2]},
				{f1x[-width/2,-height/2], f1y[-width/2,-height/2], f1z[-width/2,-height/2]},
				{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]}
				}];
				outline4 = Join[{{f2x[width/2,height/2], f2y[-width/2,height/2], f2z[-width/2,height/2]},
				{f2x[width/2,height/2], f2y[width/2,height/2], f2z[width/2,height/2]},
				{f1x[width/2,height/2], f1y[width/2,height/2], f1z[width/2,height/2]},
				{f1x[-width/2,height/2], f1y[-width/2,height/2], f1z[-width/2,height/2]},
				{f2x[-width/2,height/2], f2y[-width/2,height/2], f2z[-width/2,height/2]}
				}];
				outline5 = Join[{{f2x[width/2,-height/2], f2y[width/2,-height/2], f2z[width/2,-height/2]},
				{f2x[width/2,height/2], f2y[width/2,height/2], f2z[width/2,height/2]},
				{f1x[width/2,height/2], f1y[width/2,height/2], f1z[width/2,height/2]},
				{f1x[width/2,-height/2], f1y[width/2,-height/2], f1z[width/2,-height/2]},
				{f2x[width/2,-height/2], f2y[width/2,-height/2], f2z[width/2,-height/2]}
				}];
				outline6 = Join[{{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]},
				{f2x[-width/2,height/2], f2y[-width/2,height/2], f2z[-width/2,height/2]},
				{f1x[-width/2,height/2], f1y[-width/2,height/2], f1z[-width/2,height/2]},
				{f1x[-width/2,-height/2], f1y[-width/2,-height/2], f1z[-width/2,-height/2]},
				{f2x[-width/2,-height/2], f2y[-width/2,-height/2], f2z[-width/2,-height/2]}
				}];
		{
			GrayLevel[0.5],
			Polygon[outline1],
			Polygon[outline2],
			Polygon[outline3],
			Polygon[outline4],
			Polygon[outline5],
			Polygon[outline6],
			GrayLevel[0],
			Thickness[0.0002],
			Line[outline1],
			Line[outline2],
		 Line[outline3],
			Line[outline4],
		 Line[outline5],
			Line[outline6]
		}
		]
	]
	]
]

Invisible Objects

renderComponent[PlacedBoundary[_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_,_]] :=
Return[{}];

renderComponent[PlacedScreen[_,_,_,_]] :=
Return[{}];

renderComponent[Null] :=
Return[{}];

Rays

Draw a single (possibly bent several times) ray:

Clear[renderRay];
renderRay[rays_] :=
	Map[
		twoRaysToLine,
		Partition[rays, 2, 1]
	];

Clear[twoRaysToLine];
twoRaysToLine[{{}, _}] := {};
twoRaysToLine[{_, {}}] := {};

twoRaysToLine[{
		{Ray[{rx1_, ry1_, rz1_}, {thetax1_, thetaz1_}, wavelength1_], _},
		{Ray[{rx2_, ry2_, rz2_}, {thetax2_, thetaz2_}, wavelength2_], _}
		}] :=
	{
		wavelengthToColor[wavelength1],
		Line[{{rx1, ry1, rz1}, {rx2, ry2, rz2}}],
		Hue[1],
		AbsolutePointSize[2],
		Point[{rx2, ry2, rz2}]
	};

Clear[wavelengthToColor];
wavelengthToColor[w_] :=
If[w<.500, Hue[.65], If[w>.500&&w<.600, Hue[.35], If[w>.600, Hue[0]]]];

Melles Griot Catalog Singlet Lenses

Plano-Convex Glass Lenses

Cat01LPX003 = PlanoConvexLens[10.0 ,5.0 , 2.6 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX011 = PlanoConvexLens[15.0 ,10.0, 3.8 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX021 = PlanoConvexLens[20.0 ,12.0, 3.9 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX023 = PlanoConvexLens[21.0 ,15.0,5.0 , DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX041 = PlanoConvexLens[25.4 ,25.4, 11.4 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX064 = PlanoConvexLens[35.0 ,30.0,9.9 , DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX084 = PlanoConvexLens[40.0 ,30.0, 8.4 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX111 = PlanoConvexLens[50.0 ,40.0, 11.3 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX129 = PlanoConvexLens[60.0 ,47.0, 12.6 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX141 = PlanoConvexLens[70.0 ,60.0, 18.6 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX157 = PlanoConvexLens[80.0 ,50.0, 10.4 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX165 = PlanoConvexLens[90.0 ,60.0, 13.8 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX187 = PlanoConvexLens[100.0 ,80.0, 21.6 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX215 = PlanoConvexLens[120.8 ,100.0, 28.8 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX227 = PlanoConvexLens[130.0 ,95.0, 22.3 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX235 = PlanoConvexLens[140.0 ,77.0, 13.9 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX245 = PlanoConvexLens[150.0 ,105.0, 24.2 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX263 = PlanoConvexLens[185.0 ,75.0, 10.6 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX281 = PlanoConvexLens[200.0 ,130.0, 26.6 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX289 = PlanoConvexLens[250.0 ,145.0, 25.9 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX311 = PlanoConvexLens[330.0 ,145.0, 20.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX336 = PlanoConvexLens[450.0 ,145.0, 15.5 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPX337 = PlanoConvexLens[1000.0 ,145.0, 9.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Symmetric-Convex Glass Lenses

Cat01LDX117 = SymmetricConvexLens[50.8 ,60.0, 23.7 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDX171 = SymmetricConvexLens[100.0 ,50.0, 8.2 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDX213 = SymmetricConvexLens[150.0 ,100.0, 20.8 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDX223 = SymmetricConvexLens[200.0 ,100.0, 16.3 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDX235 = SymmetricConvexLens[250.0 ,100.0, 13.7 ,DesignIndex ->1.5187 , GlassType->BK7];

Plano-Concave Glass Lenses

Cat01LPK002 = PlanoConcaveLens[-10.0 ,5.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPK003 = PlanoConcaveLens[-25.0 ,25.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPK023 = PlanoConcaveLens[-50.0 ,47.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPK047 = PlanoConcaveLens[-100.0 ,50.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPK061 = PlanoConcaveLens[-150.0 ,50.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPK064 = PlanoConcaveLens[-200.0 ,50.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LPK065 = PlanoConcaveLens[-600.0 ,95.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Symmetric-Concave Glass Lenses

Cat01LDK001 = SymmetricConcaveLens[-5.0 ,5.0,2.0 , DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDK009 = SymmetricConcaveLens[-25.0 ,25.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDK021 = SymmetricConcaveLens[-50.0 ,42.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDK026 = SymmetricConcaveLens[-100.0 ,50.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDK033 = SymmetricConcaveLens[-150.0 ,95.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LDK045 = SymmetricConcaveLens[-600.0 ,50.0, 2.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Meniscus Glass Lenses

Positive Meniscus

Cat01LMP003 = PositiveMeniscusLens[100.0 ,50.0, 10.3 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP007 = PositiveMeniscusLens[125.0 ,50.0, 8.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP011 = PositiveMeniscusLens[150.0 ,50.0, 7.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP015 = PositiveMeniscusLens[175.0 ,50.0, 7.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP019 = PositiveMeniscusLens[200.0 ,50.0, 6.5 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP023 = PositiveMeniscusLens[250.0 ,50.0, 4.8 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP027 = PositiveMeniscusLens[300.0 ,50.0, 4.8 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP031 = PositiveMeniscusLens[350.0 ,50.0, 4.5 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP035 = PositiveMeniscusLens[400.0 ,50.0, 4.5 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP039 = PositiveMeniscusLens[500.0 ,50.0, 4.5 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP043 = PositiveMeniscusLens[600.0 ,50.0, 4.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP047 = PositiveMeniscusLens[800.0 ,50.0, 4.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP051 = PositiveMeniscusLens[1000.0 ,50.0, 4.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP059 = PositiveMeniscusLens[2000.0 ,50.0, 4.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMP063 = PositiveMeniscusLens[4000.0 ,50.0, 4.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Negative Meniscus

Cat01LMN001 = NegativeMeniscusLens[-100.0 ,25.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMN011 = NegativeMeniscusLens[-150.0 ,50.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMN019 = NegativeMeniscusLens[-200.0 ,50.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMN027 = NegativeMeniscusLens[-300.0 ,50.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMN039 = NegativeMeniscusLens[-500.0 ,50.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMN051 = NegativeMeniscusLens[-1000.0 ,50.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];

Cat01LMN063 = NegativeMeniscusLens[-4000.0 ,50.0, 3.0 ,DesignIndex ->1.5187 , GlassType->BK7];