Ray Tracing With Lenses

converginglens={Circle[{-1,0},1.3,{-ArcCos[1/1.3],ArcCos[1/1.3]}],Circle[{1,0},1.3,{π-ArcCos[1/1.3],π+ArcCos[1/1.3]}]};
diverginglens={Circle[{-1.5,0},1.3,{-ArcCos[1.02/1.3],ArcCos[1.02/1.3]}],Circle[{1.5,0},1.3,{π-ArcCos[1.02/1.3],π+ArcCos[1.02/1.3]}],Line[{{-.48,.8},{.48,.8}}],Line[{{-.48,-.8},{.48,-.8}}]};

Manipulate[Graphics[{If[lenstype=="converging",({converginglens,converginglens,Dynamic[{Red,Point[{-n,0}]}]}),{diverginglens,diverginglens}],Dynamic[{Red,Point[{n,0}]}],{Thick,Arrowheads[.05 size],Arrow[{{itempos,-(size/2)},{itempos,size/2}}]},Point[{0,0}],If[fromtoppara==True,{RGBColor[0,.5,0],Line[{{itempos,size/2},{0,size/2}}]},Point[{itempos,size/3}]],If[lenstype=="converging",{If[fromtoppara==True,{RGBColor[0,.5,0],Line[{{0,size/2},{-n,0},{(n itempos)/(n-itempos),(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]],If[frombotpara==True,{RGBColor[.4,.4,.8],Line[{{0,-size/2},{-n,0},{(n itempos)/(n-itempos),-(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]],If[fromtopfoc==True,{Purple,Line[{{itempos,size/2},{n,0},{0,(n size/2)/(n-itempos)},{(n itempos)/(n-itempos),(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]],If[frombotfoc==True,{RGBColor[1,.6,0],Line[{{itempos,-size/2},{n,0},{0,-(n size/2)/(n-itempos)},{(n itempos)/(n-itempos),-(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]],If[showanswer==True,{Thick,Arrowheads[-.05 n size/(n-itempos)],Arrow[{{(n itempos)/(n-itempos),-(n size/2)/(n-itempos)},{(n itempos)/(n-itempos),(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]],If[thrucenter==True,{{Black,Dashed,Line[{{itempos,size/2},{0,0},{(n itempos)/(n-itempos),(n size/2)/(n-itempos)}}]},{Black,Dashed,Line[{{itempos,-size/2},{0,0},{(n itempos)/(n-itempos),-(n size/2)/(n-itempos)}}]}},Point[{itempos,size/3}]]},{If[fromtoppara==True,{RGBColor[0,.5,0],Line[{{0,size/2},{2,size/-n+size/2}}],{RGBColor[0,.5,0],Dashed,Line[{{0,size/2},{n,0},{-((itempos n)/(-itempos+n)),(n size/2)/(n-itempos)}}]}},Point[{itempos,size/3}]],If[frombotpara==True,{{RGBColor[.4,.4,.8],Dashed,Line[{{0,-size/2},{n,0},{-((itempos n)/(-itempos+n)),-(n size/2)/(n-itempos)}}]},{RGBColor[.4,.4,.8],Line[{{0,-size/2},{2,size/n-size/2}}]}},Point[{itempos,size/3}]],If[fromtopfoc==True,{{Purple,Line[{{itempos,size/2},{n,0},{0,(n size/2)/(n-itempos)},{2,(n size/2)/(n-itempos)}}]},{Purple,Dashed,Line[{{0,(n size/2)/(n-itempos)},{-((itempos n)/(-itempos+n)),(n size/2)/(n-itempos)}}]}},Point[{itempos,size/3}]],If[frombotfoc==True,{{RGBColor[1,.6,0],Line[{{itempos,-size/2},{n,0},{0,-(n size/2)/(n-itempos)},{2,-(n size/2)/(n-itempos)}}]},RGBColor[1,.6,0],Dashed,Line[{{0,-(n size/2)/(n-itempos)},{-((itempos n)/(-itempos+n)),-(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]],If[thrucenter==True,{{Black,Dashed,Line[{{itempos,size/2},{0,0},{(n itempos)/(n-itempos),(n size/2)/(n-itempos)}}]},{Black,Dashed,Line[{{itempos,-size/2},{0,0},{(n itempos)/(n-itempos),-(n size/2)/(n-itempos)}}]}},Point[{itempos,size/3}]],If[showanswer==True,{Thick,GrayLevel[.5],Arrowheads[-.05 n size/(n-itempos)],Arrow[{{-((itempos n)/(-itempos+n)),-(n size/2)/(n-itempos)},{-((itempos n)/(-itempos+n)),(n size/2)/(n-itempos)}}]},Point[{itempos,size/3}]]}],If[frombotpara==True,{RGBColor[.4,.4,.8],Line[{{itempos,-size/2},{0,-size/2}}]},Point[{itempos,size/3}]],If[showanswer!=True,Point[{itempos,size/3}],{}]},PlotRange-> {{-3.2,3.5},{-1,1}},PlotLabel->If[showanswer==True,If[lenstype=="converging",Style["The image is real.",14,"Label"],Style["The image is virtual.","Label",14]]," "],ImageSize-> {500,234}],{{n,-.85,"focal length"},-.5,-1.05,Appearance->"Labeled"},{{lenstype,"converging","lens type"},{"converging","diverging"}},{{size,.6,"object size"},.3,.8,Appearance->"Labeled"},
{{itempos,-2,"object position"},-2.4,-1.6,Appearance->"Labeled"},{{fromtoppara,True,"parallel from top"},{True,False}},{{frombotpara,True,"parallel from bottom"},{True,False}},{{fromtopfoc,True,"through focal point from top"},{True,False}},{{frombotfoc,True,"through focal point from bottom"},{True,False}},{{thrucenter,True,"rays through lens center"},{True,False}},{{showanswer,False,"show perceived image"},{True,False}},AutorunSequencing->{1,2,3,4},ControlPlacement->Top,SaveDefinitions->True]

CAPTION

Using ray tracing, this demonstrates how a perceived image depends on the various characteristics of a lens. Converging lenses form an image on the opposite side of the lens from the object. A diverging lens creates a virtual image on the same side as the object. Vary the controls to learn how to construct the image.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Ray Tracing With Lenses" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/RayTracingWithLenses/

Contributed by: Brian Van Vertloo

A full-function Wolfram Mathematica system (Version 6 or higher) is required to edit this notebook.
GET WOLFRAM MATHEMATICA »

© Wolfram Demonstrations Project & Contributors   |   Terms of Use   |   Make a new version of this Demonstration »