Ray Diagrams for Microscope and Telescope

Manipulate[
Module[{h=2.0,h2=2.5,head,radius,radius2,lfocusloc,rfocusloc,lfocusloc2,rfocusloc2,imgloc,img2loc,objdist,obj2dist},
            (*Опис*)
imagedistance[focus_,objdistance_]:=
If[ptobj[[1]]==rfocusloc[[1]]||ptobj[[1]]==lfocusloc[[1]]||objdistance==0,0,Solve[1/focus == 1/objdistance + 1/q,q][[1,1,2]]];
image2distance[focus2_,objdistance_]:=
If[imgloc[[1]]==rfocusloc2[[1]]||ptobj[[1]]==lfocusloc2[[1]]||objdistance==0,0,Solve[1/focus2 == 1/objdistance + 1/q,q][[1,1,2]]];

magnification[imgdistance_,objdistance_]:=If[ptobj[[1]]==rfocusloc[[1]]||ptobj[[1]]==lfocusloc[[1]]||objdistance==0||imgdistance==0,0,imgdistance/objdistance];
magnification2[imgdistance_,objdistance_]:=If[imgloc[[1]]==rfocusloc2[[1]]||imgloc[[1]]==lfocusloc2[[1]]||objdistance==0||imgdistance==0,0,imgdistance/objdistance];
            (*Розрахунок*)
radius =4focus;(*кривизна лінзи*)
radius2 =10focus2;(*кривизна лінзи2*)
lfocusloc = {-focus+location[[1]],0};
rfocusloc = {focus+location[[1]],0};
lfocusloc2 = {-focus2+location2[[1]],0};
rfocusloc2 = {focus2+location2[[1]],0};
objdist =Abs[location[[1]]-ptobj[[1]]];
imgloc = If[ptobj[[1]]<location[[1]],{location[[1]]+imagedistance[focus,objdist],magnification[-1*imagedistance[focus,objdist],objdist]*ptobj[[2]]},{location[[1]]-imagedistance[focus,objdist],magnification[-1*imagedistance[focus,objdist],objdist]*ptobj[[2]]}];
obj2dist =Abs[location2[[1]]-imgloc[[1]]];
img2loc ={location2[[1]]+image2distance[focus2,obj2dist],magnification2[-1*image2distance[focus2,obj2dist],obj2dist]*imgloc[[2]]};
head=Graphics[Line[{{-1/2,1/4},{0,0},{-1/2,-1/4}}]];
source[{x0_,y0_},r0_]:={Orange,Disk[{x0,y0},r0],Line[{{x0,y0},{x0+2r0,y0}}],Line[{{x0,y0},{x0-2r0,y0}}],Line[{{x0,y0},{x0,y0+2r0}}],Line[{{x0,y0},{x0,y0-2r0}}],Line[{{x0,y0},{x0-1.6r0,y0-1.6r0}}],Line[{{x0,y0},{x0+1.6r0,y0-1.6r0}}],Line[{{x0,y0},{x0-1.6r0,y0+1.6r0}}],Line[{{x0,y0},{x0+1.6r0,y0+1.6r0}}]};
line2[{{x1_,y1_},{x2_,y2_}},{x3_,x4_}]:=Line[{{x3,(y2-y1)/(x2-x1)x3+(x2 y1-x1 y2)/(x2-x1)},{x4,(y2-y1)/(x2-x1)x4+(x2 y1-x1 y2)/(x2-x1)}}];(*лінія з початком в т.3, закінченням в т.4  і проходить через точки 1 і 2*)
arrow2[{{x1_,y1_},{x2_,y2_}},{x3_,x4_}]:=Arrow[{{x3,(y2-y1)/(x2-x1)x3+(x2 y1-x1 y2)/(x2-x1)},{x4,(y2-y1)/(x2-x1)x4+(x2 y1-x1 y2)/(x2-x1)}}];(*стрілка з початком в т.3, закінченням в т.4  і проходить через точки 1 і 2*)

(*Побудова Графічного зображення*)
y31:=(imgloc[[2]]-ptobj[[2]])/(imgloc[[1]]-location[[1]])location2[[1]]+(imgloc[[1]] ptobj[[2]]-location[[1]] imgloc[[2]])/(imgloc[[1]]-location[[1]]);(* у-координата точки  для променя 1 за формулою (y2-y1)/(x2-x1)x31+(x2 y1-x1 y2)/(x2-x1)*)
y32:=(imgloc[[2]]-ptobj[[2]])/(imgloc[[1]]-ptobj[[1]])location2[[1]]+(imgloc[[1]] ptobj[[2]]-ptobj[[1]] imgloc[[2]])/(imgloc[[1]]-ptobj[[1]]);(* у-координата точки  для променя 1 за формулою (y2-y1)/(x2-x1)x32+(x2 y1-x1 y2)/(x2-x1)*)
Graphics[
{(*ліва частина збир.лінзи*)
{Thick,Gray,Circle[{location[[1]]+Sqrt[radius^2-h^2],0},radius,{Pi - ArcTan[h/Sqrt[radius^2-h^2]],Pi + ArcTan[h/Sqrt[radius^2-h^2]]}]},
(*права частина збир.лінзи*)
{Thick,Gray,Circle[{location[[1]]-Sqrt[radius^2-h^2],0},radius,{-ArcTan[h/Sqrt[radius^2-h^2]],ArcTan[h/Sqrt[radius^2-h^2]]}]},
(*ліва частина збир.лінзи2*)
{Thick,Gray,Circle[{location2[[1]]+Sqrt[radius2^2-h2^2],0},radius2,{Pi - ArcTan[h2/Sqrt[radius2^2-h2^2]],Pi + ArcTan[h2/Sqrt[radius2^2-h2^2]]}]},
(*права частина збир.лінзи2*)
{Thick,Gray,Circle[{location2[[1]]-Sqrt[radius2^2-h2^2],0},radius2,{-ArcTan[h2/Sqrt[radius2^2-h2^2]],ArcTan[h2/Sqrt[radius2^2-h2^2]]}]},
 (*схематичне зображення збир.лінзи*)
{Arrowheads[{{Automatic,Automatic,head}}],Thick,Arrow[{{location[[1]],0},{location[[1]],1.3h}}]},
{Arrowheads[{{Automatic,Automatic,head}}],Thick,Arrow[{{location[[1]],0},{location[[1]],-1.3h}}]},
{PointSize[Medium],Red,Point[rfocusloc]},(*точка правого фокуса*)
Text[Style["F",FontSize->14,Italic,FontColor->Red],rfocusloc+.3],
{PointSize[Medium],Red,Point[lfocusloc]},(*точка лівого фокуса*)
(*схематичне зображення збир.лінзи2*)
{Arrowheads[{{Automatic,Automatic,head}}],Thick,Arrow[{{location2[[1]],0},{location2[[1]],1.3h}}]},
{Arrowheads[{{Automatic,Automatic,head}}],Thick,Arrow[{{location2[[1]],0},{location2[[1]],-1.3h}}]},
{PointSize[Medium],Darker[Red,.7],Point[rfocusloc2]},(*точка правого фокуса2*)
Text[Style["F'",FontSize->14,Italic,FontColor->Darker[Red,.7]],lfocusloc2+.3],
{PointSize[Medium],Darker[Red,.7],Point[lfocusloc2]},(*точка лівого фокуса2*)
(*предмет*)
{Arrowheads[Medium],Thick,Blue,Arrow[{{ptobj[[1]],0},ptobj}]},

{Thin,Line[{{-10,0},{8,0}}]},
Line[{{location[[1]],-h},{location[[1]],h}}],(*оптична вісь*)
{
If [ray1,(*промінь від предмета до лінзи паралельний оптичній осі*)
{{Arrowheads[Medium],Brown,Line[{ptobj,{location[[1]],ptobj[[2]]}}]},
{Arrowheads[Medium],Brown,line2[{{location[[1]],ptobj[[2]]},imgloc},{location[[1]],location2[[1]]}]},Arrowheads[Medium],Brown,arrow2[{img2loc,{location2[[1]],y31}},{location2[[1]],rfocusloc2[[1]]+focus2}],
Brown,Dashed,Line[{{location2[[1]],y31},img2loc}]},
{}],

If [ray2,(*лінія від предмета до зображення через центр лінзи*)
{Arrowheads[Medium],Pink,line2[{ptobj,imgloc},{ptobj[[1]],location2[[1]]}],
Arrowheads[Medium],Pink,arrow2[{img2loc,{location2[[1]],y32}},{location2[[1]],rfocusloc2[[1]]+focus2}],
{Pink,Dashed,Line[{{location2[[1]],y32},img2loc}]}},
{}],

If [ray3,(*лінія від предмета до лінзи через фокус ,{location2[[1]],2*rfocusloc2[[1]]}*)
{
{Arrowheads[Medium],Darker[Green,.6],Line[{{location[[1]],imgloc[[2]]},{location2[[1]],imgloc[[2]]}}]},
{Arrowheads[Medium],Darker[Green,.6],Line[{ptobj,{location[[1]],imgloc[[2]]}}]},{Arrowheads[Medium],Darker[Green,.6],arrow2[{{location2[[1]],imgloc[[2]]},rfocusloc2},{location2[[1]],rfocusloc2[[1]]+focus2}]},
{Darker[Green,.6],Dashed,Line[{{location2[[1]],imgloc[[2]]},img2loc}]}
},
{}],
(*зображення*)
If[Abs[ptobj[[1]]-location[[1]]]<Abs[focus],{Arrowheads[Medium],Thick,Dashed,Blue,Arrow[{{imgloc[[1]],0},imgloc}]},{Arrowheads[Medium],Thick,Blue,Arrow[{{imgloc[[1]],0},imgloc}]}],
(*зображення2*)
If[Abs[imgloc[[1]]-location2[[1]]]<Abs[focus2],{Arrowheads[Large],Thick,Dashed,Blue,Arrow[{{img2loc[[1]],0},img2loc}]},{Arrowheads[Large],Thick,Blue,Arrow[{{img2loc[[1]],0},img2loc}]}]
}

},

(*Опції Графіка*)
ImageSize->{550,350},Axes->axes,PlotRange->{{-10,10},{-10,3.5}},ImagePadding->{{10,10},{0,40}},
PlotLabel->Style[Column[{If[ptobj[[2]]==0,"  ",Text["                         Linear magnification\nan eyepiece: "<>ToString[k1=Abs[Round[magnification[-1*imagedistance[focus,objdist],objdist],.01]]]<>", an ocular lense: "<>ToString[k2=Abs[Round[magnification2[-1*image2distance[focus2,obj2dist],obj2dist],.01]]]<>", a microscope: "<>ToString[k1*k2]]]}],FontSize->14]

](*End Graphics*)
],(*End Module*)

(*інструменти для керування*)

{{focus,3,"left lens focal length"},2.0,3.5,Appearance->"Labeled"},
{{focus2,1.4,"right lens focal length"},0.5,2.0,Appearance->"Labeled"},
{{ptobj,{-9,1}},{-10,-2},{0,2},Locator},
{{location,{-4,0}},{-8,0},{location2[[1]]-focus-focus2,0},Locator},
{{location2,{4.67,0}},{location[[1]]+focus+focus2,0},{8,0},Locator},
{{axes,False,"coordinates"},{True,False}},
{{ray1,True,"ray 1"},{True,False}},
{{ray2,True,"ray 2"},{True,False}},
{{ray3,True,"ray 3"},{True,False}},
Button["Reset to initial values.",focus = 3;focus2=1.4;ptobj = {-9,1};location = {-4,0};location2= {4.67,0}],
ControlPlacement->Top,
TrackedSymbols:>Manipulate
]

CAPTION

This Demonstration shows the linear magnification for a pair of lenses such as in a microscope or telescope.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Ray Diagrams for Microscope and Telescope" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/RayDiagramsForMicroscopeAndTelescope/

Contributed by: Volodymyr Holovatsky (Chernivtsi National University, Ukraine)

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 »