Retour

Source de pst-prisme.tex

Fichier TeX
%% Package `pst-prisme.tex'
%%
%% This program can be redistributed and/or modified under
%% the terms of the LaTeX Project Public License Distributed
%% from CTAN archives in directory macros/latex/base/lppl.txt.
%%
%% DESCRIPTION:
%%   `pst-prisme' is a PSTricks package for
%%   refraction and rispersion of Light by a glass prism
%%
%% Author : Manuel Luque <Mluque5130@aol.com>
%%
\csname PSTPrismeLoaded\endcsname
\let\PSTPrismeLoaded\endinput
%
% Require PSTricks, pst-node, pst-grad, pst-xkey and multido packages
\ifx\PSTricksLoaded\endinput\else\input pstricks.tex\fi
\ifx\MultidoLoaded\endinput\else\input multido.tex\fi
\ifx\PSTGradLoaded\endinput\else\input pst-grad.tex\fi
\ifx\PSTNodeLoaded\endinput\else\input pst-node.tex\fi
\ifx\PSTXKeyLoaded\endinput\else\input pst-xkey.tex\fi
\ifx\PSTmathLoaded\endinput\else\input pst-math.tex\fi
%
\def\fileversion{1.0}
\def\filedate{05/10/20}
%
\message{`PST-prisme' v\fileversion, \filedate\space (ML)}
\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
%
\pst@addfams{pst-prisme}
\define@key[psset]{pst-prisme}{AnglePrisme}{\edef\psk@Prisme@AnglePrisme{#1}}
\define@key[psset]{pst-prisme}{AnglePlan1}{\edef\psk@Prisme@AnglePlanOne{#1}}
\define@key[psset]{pst-prisme}{AnglePlan2}{\edef\psk@Prisme@AnglePlanTwo{#1}}
\define@key[psset]{pst-prisme}{lambda}{\edef\psk@Prisme@Lambda{#1}}
\define@key[psset]{pst-prisme}{k}{\edef\psk@Prisme@k{#1}}
\newif\ifPst@Prisme@notations
\define@key[psset]{pst-prisme}{notations}[true]{\@nameuse{Pst@Prisme@notations#1}}%
%
\psset{AnglePrisme=60,AnglePlan1=25,AnglePlan2=55,k=1,lambda=632.8,notations=true}
%
\SpecialCoor
%% Commande \psprisme
\def\psprisme{\pst@object{psprisme}}
\def\psprisme@i{{%
   \begin@SpecialObj
\ifPst@Prisme@notations
\psline{->}(0,8)
\uput[90](0,8){$y$}
\psline{->}(-6,0)(6,0)
\uput[0](6,0){$x$}
\fi
\pnode(0,0){O}
\pnode(!
    /AnglePrisme \psk@Prisme@AnglePrisme\space 2 div def
    /AnglePlan1 \psk@Prisme@AnglePlanOne\space def
    /AnglePlan2 \psk@Prisme@AnglePlanTwo\space def
    /lambda \psk@Prisme@Lambda\space def
% le point C1 sur la droite 1
    /C1x -6 def
    /C1y 6 def
% le point C2 sur la droite 2
    /C2x 7 def
    /C2y 5 def
% donne la distance C1E
    /k \psk@Prisme@k\space def
%
    /g1x AnglePrisme sin neg def % -sin(A/2)
    /g1y AnglePrisme cos def     %  cos(A/2)
    /u1x AnglePlan1 sin neg def
    /u1y AnglePlan1 cos neg def
% le point E émetteur
    /E1x C1x k u1x mul add def
    /E1y C1y k u1y mul add def
    %
    /n1x AnglePlan1 cos def
    /n1y AnglePlan1 sin neg def
    /Lambda {E1x g1y mul E1y g1x mul neg add
             n1y g1x mul neg n1x g1y mul add
             div neg} bind def
% point I1
    /i1x {E1x Lambda n1x mul add} bind def
    /i1y {E1y Lambda n1y mul add} bind def
    0 0){Stockage_parametres_prisme}
\pspolygon[fillstyle=gradient,gradbegin=cyan,gradend=white,gradangle=60,gradmidpoint=0.5](O)%
                                (! 7 90 AnglePrisme add cos mul 7 90 AnglePrisme add sin mul)
                                (! 7 90 AnglePrisme sub cos mul 7 90 AnglePrisme sub sin mul)
\pnode(!
% Les datas
% Sellmeier's
% glass sf15 : verre flint
% n=sqrt(1+B1*L^2/(l^2-C1)+B2*L^2/(l^2-C2)+B3*L^2/(l^2-C3))
%  Cauchy :  /N {1.606 6545 1 mul lambda dup mul div add} bind def
    /L2 {lambda 1e-3 mul dup mul} bind def % en micromètres
    /N {1
        1.539259 L2 mul L2 0.011931 sub div
         add
         0.247621 L2 mul L2 0.055608 sub div
         add
         1.038164 L2 mul L2 116.416755 sub div
         add
         sqrt} bind def
    /alpha1 AnglePlan1 AnglePrisme add def
    /sinB1 alpha1 sin N div def
    /B1 sinB1 asin def
    /Delta1 AnglePrisme B1 sub def
%%%
    /g2x AnglePrisme sin def
    /g2y AnglePrisme cos def
    /d12x Delta1 cos def % d12x
    /d12y Delta1 sin def % d12y
    /Lambda2 {i1x g2y mul i1y g2x mul sub
            d12y g2x mul d12x g2y mul sub
            div} bind def
% point I2
    /i2x {i1x Lambda2 d12x mul add} bind def
    /i2y {i1y Lambda2 d12y mul add} bind def
%
    /B2  AnglePrisme 2 mul B1 sub def
    /sinA2 N B2 sin mul def
    /alpha2 sinA2 asin def
    /u2x AnglePlan2 sin def
    /u2y AnglePlan2 cos neg def
    /Delta2 alpha2 AnglePrisme sub def
    /d2x Delta2 cos def
    /d2y Delta2 sin def
    /DELTA u2x d2y mul neg u2y d2x mul add def
    /DELTA_X i2x C2x sub d2y mul neg
             i2y C2y sub d2x mul add def
    /DELTA_Y u2x i2y C2y sub mul neg
             u2y i2x C2x sub mul add def
    /MU DELTA_X DELTA div def
    /LAMBDA3 DELTA_Y DELTA div def
% le point R2
    /r2x C2x MU u2x mul add def
    /r2y C2y MU u2y mul add def
    /a_i {AnglePlan1 neg} bind def
    /a_r {alpha2 AnglePrisme sub} bind def
    /tan_i {a_i tan} bind def
    /tan_r {a_r tan} bind def
    0 0){factice}
\pnode(! C1x C1y){C1}
\pnode(! C2x C2y){C2}
\pnode(! E1x E1y){E1}
\pnode(! i1x i1y){P1}
\pnode(! i2x i2y){I2}
\pnode(! r2x r2y){R2}
\pnode(! /bQ {i1y i1x AnglePrisme tan mul sub} bind def
         /bQ' {i2y i2x AnglePrisme tan mul add} bind def
         /xQ {bQ' bQ sub 2 div AnglePrisme tan div} bind def
         /yQ {bQ bQ' add 2 div} bind def
         xQ yQ){Q}
\pnode(! /bI {i1y i1x tan_i mul sub} bind def
         /bI'{i2y i2x tan_r mul sub} bind def
         /xI {bI bI' sub tan_r tan_i sub div} bind def
         /yI {xI tan_i mul bI add} bind def
         xI yI){I}
\pcline[linestyle=dashed,nodesepB=-2](P1)(I)
\pcline[linestyle=dashed,nodesepB=-2](I2)(I)
\pcline[linestyle=dashed,nodesepB=-1,nodesepA=-2](P1)(Q)
\pcline[linestyle=dashed,nodesepB=-1,nodesepA=-2](I2)(Q)
\rput(P1){%
    \rput{30}(0,0){\psframe*(0,0)(0.2,0.2)}
    \psarc{<-}(0,0){0.8}{!180 AnglePrisme add alpha1 sub}{!180 AnglePrisme add}
    \uput{1}[! 180 AnglePrisme add alpha1 2 div sub](0,0){$i_1$}
    \psarc[linecolor=blue]{<-}(0,0){1}{!AnglePrisme B1 sub}{!AnglePrisme}
    \uput{1.2}[! AnglePrisme B1 2 div sub](0,0){$r_1$}
    \uput{0.4}[90](0,0){$I_1$}}
\rput(I2){%
    \rput{60}(0,0){\psframe*(0,0)(0.2,0.2)}
    \psarc[linecolor=blue]{->}(0,0){0.8}{! AnglePrisme neg 180 add}{!AnglePrisme neg 180 add B2 add}
    \uput{1}[!AnglePrisme neg 180 add B2 2 div add](0,0){$r_2$}
    \psarc{->}(0,0){1}{! AnglePrisme neg}{!alpha2 AnglePrisme sub}
    \uput{1.2}[!alpha2 2 div AnglePrisme sub](0,0){$i_2$}
    \uput{0.4}[90](0,0){$I_2$}}
\psline[linecolor={[wave]{\psk@Prisme@Lambda}},arrowscale=2]{->}(P1)(I2)(R2)
\psline[linecolor={[wave]{\psk@Prisme@Lambda}}](E1)(P1)
\psline[linecolor={[wave]{\psk@Prisme@Lambda}},arrowscale=2]{->}(E1)(!i1x E1x add 2 div i1y E1y add 2 div)
\psarc(0,0){0.8}{!90 AnglePrisme sub}{!90 AnglePrisme add}
\uput[90](0,0.8){$\widehat{A}$}
\psdot[dotstyle=o](O)
\psdot[dotstyle=o](I)
\psdot[dotstyle=o](Q)
\rput(I){\psarc{->}(0,0){1}{!a_i}{!a_r}
         \uput{1.1}[!a_i a_r add 2 div](0,0){$\widehat{D}$}}
\ifPst@Prisme@notations
\pcline[nodesepB=-2,nodesepA=-2](C1)(E1)
\uput[180](C1){$C_1$}
\uput[180](E1){$E_1$}
%
\pcline[nodesepB=-2,nodesepA=-2](C2)(R2)
\uput[-90](C2){$C_2$}
\uput[180](R2){$R_2$}
\rput(C1){\psline(0,2)
          \psarc(0,0){1}{! 90 AnglePlan1 sub}{90}
          \uput{1.1}[!90 AnglePlan1 2 div sub](0,0){$\rho_1$}
          \psline[arrowinset=0,linewidth=2\pslinewidth]{->}(! 90 AnglePlan1 sub cos neg 90 AnglePlan1 sub sin neg)
          \uput[0](! 90 AnglePlan1 sub cos neg 90 AnglePlan1 sub sin neg){$\overrightarrow{u}_1$}
          \psline[arrowinset=0,linewidth=2\pslinewidth]{->}(! AnglePlan1 neg cos AnglePlan1 neg sin)
          \uput[90](! AnglePlan1 neg cos AnglePlan1 neg sin){$\overrightarrow{n}_1$}}
\rput(C2){\psline(0,2)
          \psarc(0,0){1}{90}{! 90 AnglePlan2 add}
          \uput{1.1}[!90 AnglePlan2 2 div add](0,0){$\rho_2$}
          \psline[arrowinset=0,linewidth=2\pslinewidth]{->}(! AnglePlan2 cos AnglePlan2 sin)
          \uput[! AnglePlan2](! AnglePlan2 cos AnglePlan2 sin){$\overrightarrow{n}_2$}
          \psline[arrowinset=0,linewidth=2\pslinewidth]{->}(! 90 AnglePlan2 add cos 90 AnglePlan2 add sin)
          \uput[-90](! 90 AnglePlan2 add cos 90 AnglePlan2 add sin){$\overrightarrow{u}_2$}}
\psdot[dotstyle=o](C1)
\psdot[dotstyle=o,linecolor={[wave]{\psk@Prisme@Lambda}}](E1)
\psdot[dotstyle=o](C2)
\psdot[dotstyle=o](R2)
\fi
   \end@SpecialObj
}}
%
%% Commande \psprismeColor
\def\psprismeColor{\pst@object{psprismeColor}}
\def\psprismeColor@i{{%
   \begin@SpecialObj
\pnode(0,0){O}
\pnode(!
    /AnglePrisme \psk@Prisme@AnglePrisme\space 2 div def
    /AnglePlan1 \psk@Prisme@AnglePlanOne\space def
    /AnglePlan2 \psk@Prisme@AnglePlanTwo\space def
% le point C1 sur la droite 1
    /C1x -8 def
    /C1y 7 def
% le point C2 sur la droite 2
    /C2x 11 def
    /C2y 5 def
% donne la distance C1E1
    /k \psk@Prisme@k\space def
%
    /g1x AnglePrisme sin neg def % -sin(A/2)
    /g1y AnglePrisme cos def     %  cos(A/2)
    /u1x AnglePlan1 sin neg def
    /u1y AnglePlan1 cos neg def
% le point E émetteur
    /E1x C1x k u1x mul add def
    /E1y C1y k u1y mul add def
    %
    /n1x AnglePlan1 cos def
    /n1y AnglePlan1 sin neg def
    /Lambda {E1x g1y mul E1y g1x mul neg add
             n1y g1x mul neg n1x g1y mul add
             div neg} bind def
% point I1
    /i1x {E1x Lambda n1x mul add} bind def
    /i1y {E1y Lambda n1y mul add} bind def
    0 0){Stockage_parametres_prisme}
\pspolygon[fillstyle=gradient,gradbegin=cyan,gradend=white,gradangle=60,gradmidpoint=0.5](O)%
        (! 7 90 AnglePrisme add cos mul 7 90 AnglePrisme add sin mul)
        (! 7 90 AnglePrisme sub cos mul 7 90 AnglePrisme sub sin mul)
\multido{\iLAMBDA=400+5}{80}{%
  \definecolor{prisme}{wave}{\iLAMBDA}%
\pnode(!
% Les datas
% Sellmeier's
% glass sf15 : verre flint lourd
% n=sqrt(1+B1*L^2/(l^2-C1)+B2*L^2/(l^2-C2)+B3*L^2/(l^2-C3))
% Cauchy : /N {1.606 6545 1 mul lambda dup mul div add} bind def
    /lambda \iLAMBDA\space def
    /L2 {lambda 1e-3 mul dup mul} bind def
    /N {1
        1.539259 L2 mul L2 0.011931 sub div
         add
         0.247621 L2 mul L2 0.055608 sub div
         add
         1.038164 L2 mul L2 116.416755 sub div
         add
         sqrt} bind def
    /alpha1 AnglePlan1 AnglePrisme add def
    /sinB1 alpha1 sin N div def
    /B1 sinB1 asin def
    /Delta1 AnglePrisme B1 sub def
%%%
    /g2x AnglePrisme sin def
    /g2y AnglePrisme cos def
    /d12x Delta1 cos def % d12x
    /d12y Delta1 sin def % d12y
    /Lambda2 {i1x g2y mul i1y g2x mul sub
            d12y g2x mul d12x g2y mul sub
            div} bind def
% point I2
    /i2x {i1x Lambda2 d12x mul add} bind def
    /i2y {i1y Lambda2 d12y mul add} bind def
%
    /B2 AnglePrisme 2 mul B1 sub def
    /sinA2 N B2 sin mul def
    /alpha2 sinA2 asin def
    /u2x AnglePlan2 sin def
    /u2y AnglePlan2 cos neg def
    /Delta2 alpha2 AnglePrisme sub def
    /d2x Delta2 cos def
    /d2y Delta2 sin def
    /s2x i2x C2x sub def
    /s2y i2y C2y sub def
    /dA d2x u2y mul d2y u2x mul sub def
    /dM d2x s2y mul d2y s2x mul sub def
% le point R2
    /r2x C2x dM dA div u2x mul add def
    /r2y C2y dM dA div u2y mul add def
0 0){factice}
\pnode(! C1x C1y){C1}
\pnode(! C2x C2y){C2}
\pnode(! E1x E1y){E1}
\pnode(! i1x i1y){I1}
\pnode(! i2x i2y){I2}
\pnode(! r2x r2y){R2}
\psline[linecolor=prisme](I1)(I2)(R2)}
\psline[linecolor=white,linewidth=0.5mm](E1)(I1)
\psline[linecolor=white,linewidth=0.5mm,arrowscale=2]{->}(E1)(!i1x E1x add 2 div i1y E1y add 2 div)
   \end@SpecialObj
}}
\catcode`\@=\PstAtCode\relax
\endinput