Light Ray in a Prism

Manipulate[
(*розрахунок кута між векторами з їх скалярного добутку*)angle[{x1_,y1_},{x0_,y0_},{x2_,y2_}] :=ArcCos[((({x1,y1}-{x0,y0}).({x2,y2}-{x0,y0}))/((Sqrt[(((x1-x0))^2)+(((y1-y0))^2)])(Sqrt[(((x2-x0))^2)+(((y2-y0))^2)])))];
(*розрахунок точки перетину 2 прямих*)
pcros[k1_,b1_,k2_,b2_]:={x,y}/.Solve[{y==k1 x+b1,y==k2 x+b2},{x,y}][[1]];
k[{x1_,y1_},{x2_,y2_}]:=(y2-y1)/(x2-x1);
b[{x1_,y1_},{x2_,y2_}]:=(y1 x2 - y2 x1)/(x2-x1);
refangle[θ1_,n_]:=If [(1/n)Sin[θ1 ]≥1,π/2,ArcSin[(1/n)Sin[θ1 ]]]//N ;  (*Angle of Refraction at the 1st interface*)
Module[{pnt,pcr,k2,prleft={-5,0},prright={5,0}, x1norm=-9,x2norm=9,x2ray=9,rainbow={Red,Orange,Yellow,Green,LightBlue,Blue,Purple}},  
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*)
Graphics[
{(*призма*)
{Thick,Darker[Gray,.7],Line[{prtop,prleft}],Line[{prleft,prright}],Line[{prtop,prright}],Lighter[Blue,.85],Polygon[{prtop,prleft,prright}]},
(*білий промінь, що падає на призму*)
{source[sunloc,0.3],Thick,White,Line[{sunloc,pnt=(prtop+prleft)/2}]},
(*нормаль до поверхні призми в точці падіння *)
If[pozn,{Thin,Black,Dashed,line2[{{x1norm,y1norm=((prtop[[1]]-prleft[[1]])(-x1norm+pnt[[1]])/(prtop[[2]]-prleft[[2]])+pnt[[2]])},pnt},{x1norm,(prright[[1]]+prtop[[1]])/2}]},{}],
(*заломлений промінь*)
Table[{Thin,rainbow[[i]],(*заломлені промені в призмі*)Line[{(prtop+prleft)/2,(pcr=pcros[k[prtop,prright],b[prtop,prright],k2=Tan[ArcTan[k[sunloc,pnt]]-If[sunloc[[2]]<(y1norm=(prtop[[1]]-prleft[[1]])(-x1norm+pnt[[1]])/(prtop[[2]]-prleft[[2]])+pnt[[2]]),1,-1]((β=angle[sunloc,pnt,{x1norm,y1norm}])-refangle[β,(n1=nred+disp*(i-1)/6)])],(prtop[[2]]+prleft[[2]])/2-k2 pnt[[1]]])}],(*заломлені промені, що виходять з призми*)Line[{pcr,{x2ray,x2ray (k3=Tan[ArcTan[k[prtop,prright]]+π/2-refangle[Ω-If[sunloc[[2]]<y1norm,1,-1]refangle[β,(nred+disp*(i-1)/6)],1/(nred+disp*(i-1)/6)]])+pcr[[2]]-k3 pcr[[1]]}}]},{i,7,1,-1}],
If[pozn,{Thin,Darker[Red,.6],Text[Style["Ω",FontSize->14],prtop+{0,-1}],Text[Style["α",FontSize->14],(prtop+prleft)/2+{-.9,.2}],Text[Style["α'",FontSize->14],(prtop+prleft)/2+{.9,.2}],Text[Style["β",FontSize->14],pcr+{-1,-.2}],Text[Style["β'",FontSize->14],pcr+{1,0}],Dashed,(*нормаль2 до поверхні призми*)line2[{{x2norm,(prtop[[1]]-prright[[1]])(-x2norm+pcr[[1]])/(prtop[[2]]-prright[[2]])+pcr[[2]]},pcr},{pnt[[1]],x2norm}]},{}],GrayLevel[0.8],Rectangle[prleft-{0,2.3},prright+{5,-.08}]
},
(*Опції Графіка*)
ImageSize->{420,400},AspectRatio-> 0.72,Axes->False,PlotRange->{{-9,9},{-2,12}},ImagePadding->{{10,10},{0,40}},
PlotLabel->Style[Column[If[pozn,{Text["Ω = "<>ToString[Round[(Ω=angle[prleft,prtop,prright])/Degree,1]]<>"°  α = "<>ToString[Round[β/Degree,.1]]<>"°  α' = "<>ToString[Round[refangle[β,nred]/Degree,.1]]<>"°  β = "<>ToString[Round[(Ω-refangle[β,nred])/Degree,.1]]<>"°  β' = "<>ToString[Round[refangle[Ω-refangle[β,nred],1/nred]/Degree,.1]]<>"°"]},{}]],FontSize->14],Background->GrayLevel[0.8]](*End Graphics*)
],(*End Module*)
(*інструменти для керування*)
{{nred,1.5111,"refraction index for red light"
(*"показник заломлення матеріалу призми \n (для червоного променя)"*)},0.8,2.2,Appearance->"Labeled"},
{{disp,0.0057,"difference between violet \nand red refraction indices" 
(*"різниця між показниками заломлення \n для черв. та фіол. променя"*)},0,8*0.0057,Appearance->"Labeled"},
{{prtop,{0,10}},{-5,6.5},{4.95,12},Locator},
{{sunloc,{-9,4}},{-9,-2},{-8,12},Locator},
{{pozn,True,"annotations and surface normals"(*"Позначення та нормалі до поверхні призми"*)},{True,False}},
Button["reset to initial values"(*"встановити початкові значення"*),prtop={0,10};sunloc={-9,4};disp=0.0057;nred=1.5111],

TrackedSymbols:>True
]

CAPTION

This Demonstration shows the path of a ray in a prism.

THIS NOTEBOOK IS THE SOURCE CODE FROM

"Light Ray in a Prism" from the Wolfram Demonstrations Project
 http://demonstrations.wolfram.com/LightRayInAPrism/

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 »