Source de pst-diffraction.tex
%% %% This is file `pst-diffraction.tex', %% %% IMPORTANT NOTICE: %% %% Package `pst-diffraction.tex' %% %% Manuel Luque <ml@pstricks.de> %% Herbert Voss <hv@pstricks.de> %% %% with contributions of Julien Cubizolles %% %% 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-diffraction' is a PSTricks package to plot special diffractions %% %% \csname PSTDiffractionLoaded\endcsname \let\PSTDiffractionLoaded\endinput % Require PSTricks \ifx\PSTricksLoaded\endinput\else\input pstricks.tex\fi \ifx\PSTXKeyLoaded\endinput\else \input pst-xkey \fi % \def\fileversion{2.10a}% \def\filedate{2007/09/06}% \message{`PST-diffraction v\fileversion, \filedate\space (ML,hv)}% \edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax \pst@addfams{pst-diff} \define@key[psset]{pst-diff}{a}{\def\psk@Diffraction@Slit@A{#1 }} % largeur de la fente en m \define@key[psset]{pst-diff}{k}{\pst@checknum{#1}\psk@Diffraction@Slit@k } \define@key[psset]{pst-diff}{r}{\def\psk@Diffraction@Circular@r{#1 }} % rayon du trou en m \define@key[psset]{pst-diff}{d}{\def\psk@Diffraction@Circular@d{#1 }} % demi-distance entre les trous en m \define@key[psset]{pst-diff}{h}{\def\psk@Diffraction@Triangle@h{#1 }} % hauteur du triangle en m \define@key[psset]{pst-diff}{s}{\def\psk@Diffraction@Slit@s{#1 }} % distance entre les fentes \define@key[psset]{pst-diff}{lambda}{\pst@checknum{#1}\psk@Diffraction@Slit@Lambda }% en nm \define@key[psset]{pst-diff}{f}{\pst@checknum{#1}\psk@Diffraction@Slit@F }% focus en m \define@key[psset]{pst-diff}{gamma}{\pst@checknum{#1}\psk@Diffraction@gamma@G } \define@key[psset]{pst-diff}{pixel}{\pst@checknum{#1}\psk@Diffraction@Slit@pixel } \define@key[psset]{pst-diff}{colorMode}{\pst@getint{#1}\psk@Diffraction@colorMode } % 0 black and white inverse % 1 black and white % 2 color cmyk %>2 color RGB % \define@key[psset]{pst-diff}{contrast}{% \pst@cnta=#1\relax \ifnum\pst@cnta>38 \typeout{!!! The contrast value is `\the\pst@cnta', but cannot be greater than 38. Contrast=38 forced!}% \pst@cnta=38 \fi% \edef\psk@Diffraction@Slit@contrast{\the\pst@cnta\space}} % \define@boolkey[psset]{pst-diff}[Pst@Diffraction@Circular@]{twoHole}[true]{} \define@boolkey[psset]{pst-diff}[Pst@Diffraction@Rectangular@]{twoSlit}[true]{} % \psset[pst-diff]{a=0.2e-3,f=5,k=1,r=1e-3, d=6e-3,s=12e-3,h=0.5e-3, lambda=650,pixel=0.5, contrast=38,gamma=0.8,twoHole=false,twoSlit=false,colorMode=3} % % load the pstricks-add.pro only, if not already done \ifx\PSTricksAddLoaded\endinput\else\pstheader{pstricks-add.pro}\fi % \def\tx@RGBtoGRAY{ tx@addDict begin RGBtoGRAY end } \def\tx@RGBtoCMYK{ tx@addDict begin RGBtoCMYK end } % \def\psdiffractionRectangle{\pst@object{psdiffractionRectangle}} \def\psdiffractionRectangle@i{% \begin@SpecialObj% \addto@pscode{% % les dimensions sont en mètres /focus \psk@Diffraction@Slit@F def /widthSlit \psk@Diffraction@Slit@A def /heightSlit \psk@Diffraction@Slit@k widthSlit mul def /Gamma \psk@Diffraction@gamma@G def /pixel \psk@Diffraction@Slit@pixel def /SlitSeparation \psk@Diffraction@Slit@s def \psk@Diffraction@Slit@Lambda tx@addDict begin wavelengthToRGB Red Green Blue end /Blue ED /Green ED /Red ED 0 0 translate /ondeLongueur \psk@Diffraction@Slit@Lambda 1e-9 mul def % en m % les bornes sont en pt % +- 4 fois le premier minimum /bornexpt 1 widthSlit div focus mul ondeLongueur mul 2845 mul def /borneypt 1 heightSlit div focus mul ondeLongueur mul 2845 mul def % Les calculs commencent... borneypt 4 mul neg pixel 4 borneypt mul { /ordonneept exch def % y en m /ordonnee ordonneept 2845 div def /argumenty ordonnee heightSlit mul ondeLongueur div focus div def /argumentyRad argumenty Pi mul def /argumentyDeg argumenty 180 mul def /sincy argumentyRad 0 eq {1}{argumentyDeg sin argumentyRad div} ifelse def bornexpt 4 mul neg pixel 4 bornexpt mul { /abscissept exch def % x en m /abscisse abscissept 2845 div def /argumentx abscisse widthSlit mul ondeLongueur div focus div def /argumentcosx abscisse SlitSeparation mul ondeLongueur div focus div def /argumentxRad argumentx Pi mul def /argumentxDeg argumentx 180 mul def /argumentcosxDeg argumentcosx 180 mul def % sinus cardinal /sincx argumentxRad 0 eq {1} { argumentxDeg sin argumentxRad div } ifelse def % 1 1e\psk@Diffraction@Slit@contrast sincx dup mul sincy dup mul \ifPst@Diffraction@Rectangular@twoSlit mul argumentcosxDeg cos dup mul \fi mul neg exp sub dup dup Red mul 3 -1 roll Green mul 3 -1 roll Blue mul \ifcase\psk@Diffraction@colorMode \tx@RGBtoGRAY neg 1 add setgray \or \tx@RGBtoGRAY setgray \or \tx@RGBtoCMYK setcmykcolor \else setrgbcolor \fi % % newpath abscissept ordonneept 1 0 360 arc closepath fill stroke % 30 juillet 2004 newpath abscissept pixel 2 div sub ordonneept pixel 2 div sub moveto pixel 0 rlineto 0 pixel rlineto pixel neg 0 rlineto closepath fill stroke } for } for }% \addto@pscode \end@OpenObj% } % \def\psdiffractionCircular{\pst@object{psdiffractionCircular}} \def\psdiffractionCircular@i{% \begin@SpecialObj% \addto@pscode{% % les dimensions sont en mètres /focus \psk@Diffraction@Slit@F def /Gamma \psk@Diffraction@gamma@G def /pixel \psk@Diffraction@Slit@pixel def /contrast 1e\psk@Diffraction@Slit@contrast def /r \psk@Diffraction@Circular@r def /d \psk@Diffraction@Circular@d def \psk@Diffraction@Slit@Lambda tx@addDict begin wavelengthToRGB Red Green Blue end /Blue ED /Green ED /Red ED % 0 0 translate %% Handbook of mathematical functions %% ED. M.ABRAMOWITZ & I.A. STEGUN %% Chap. 9 : Bessel Functions of Integer Order %% Adapté en ps d'après le code de D.Martin %% http://perso.univ-rennes1.fr/daniel.martin/melina/www/code_html/specfct/bejy01.html % % les coefficients pour le calcul des fonctions de Bessel /COSO {0.79788456 1 X div sqrt mul X 0.78539816 sub RadtoDeg cos mul} def /SINO {.79788456 1 X div sqrt mul X 0.78539816 sub RadtoDeg sin mul} def % /PO { 0.209388721e-6 8 X div dup mul mul 0.207337064e-5 sub 8 X div dup mul mul 0.273451041e-4 add 8 X div dup mul mul 0.109862863e-2 sub 8 X div dup mul mul 1 add } def /QO {-0.934945152e-7 8 X div dup mul mul 0.762109516e-6 add 8 X div dup mul mul 0.691114765e-5 sub 8 X div dup mul mul 0.143048876e-3 add 8 X div dup mul mul 0.15624499998e-1 sub 8 X div mul } def /P1 { -0.240337019e-6 8 X div dup mul mul 0.2457520174e-5 add 8 X div dup mul mul 0.351639649e-4 sub 8 X div dup mul mul 0.183105e-2 add 8 X div dup mul mul 1 add } def /Q1 { 0.105787412e-6 8 X div dup mul mul 0.88228987e-6 sub 8 X div dup mul mul 0.8449199096e-5 add 8 X div dup mul mul 0.2002690873e-3 sub 8 X div dup mul mul 0.4687499995e-1 add 8 X div mul } def % les fonctions de Bessel /J0 { /X exch def X 0 lt { /X X neg def } if X 8 le { X 0 eq { 1 }{ 0.33848331e-10 X X dup mul 0.2895532e-7 sub X dup mul mul 0.113825372e-4 add X dup mul mul 0.258008068e-2 sub X dup mul mul 0.351527847 add X dup mul mul 27.7849812 sub X dup mul mul 0.114749848e4 add X dup mul mul 0.198342667e5 sub X dup mul mul 0.813241206e5 add X dup mul 0.49676332e3 add X dup mul mul 0.813241206e5 add div } ifelse }{ PO COSO mul QO SINO mul sub } ifelse } def % /J1 { /X exch def X 0 lt {/X X neg def /Signe {neg} def}{/Signe {} def} ifelse X 8 le { X 0 eq {0}{ -0.47427072618e-9 X dup mul mul 0.35236457401e-6 add X dup mul mul -0.11764050281e-3 add X dup mul mul 0.21979683808e-1 add X dup mul mul -0.23652383961e+1 add X dup mul mul 0.13812534164e+3 add X dup mul mul -0.373650260707e+4 add X dup mul mul 0.31625993793e+5 add X dup mul 0.433493017e+3 add X dup mul mul 0.6325198765e+5 add div X mul Signe } ifelse }{ P1 SINO mul Q1 COSO mul add Signe } ifelse } def % J1 cardinal au carré : (J1(x)/x)^2 /J1Card { dup 0 eq {1}{J1 X div dup mul 4 mul} ifelse } def % /cm { 28.45 mul } def % centimétres -> pts /m2pt { 284.5 mul } def % métres -> pts /L { \psk@Diffraction@Slit@Lambda 1e-9 mul } bind def % longueur d'onde en m /Coeff { TwoPi r mul L focus mul div } bind def /Facteur { 180 d mul L focus mul div } bind def /R_limite { 20 Coeff div 100 mul } bind def % en cm % 05 08 2004 \ifPst@Diffraction@Circular@twoHole R_limite 10 ge { /R_limite 10 def } if newpath R_limite neg 1.2 mul cm dup moveto R_limite 2.4 mul cm 0 rlineto 0 R_limite 2.4 mul cm rlineto R_limite neg 2.4 mul cm 0 rlineto closepath \ifnum\psk@Diffraction@colorMode=\z@ 1 \else 0 \fi setgray fill R_limite neg cm 1 R_limite cm { /xPts exch def /x { xPts 2845 div } bind def R_limite neg cm 1 R_limite cm { /yPts exch def /y { yPts 2845 div } bind def /R { x dup mul y dup mul add sqrt } bind def % R en m /m Coeff R mul def newpath xPts 0.5 sub yPts 0.5 sub moveto 1 0 rlineto 0 1 rlineto 1 neg 0 rlineto closepath fill 1 1e38 m J1Card Facteur x mul cos dup mul mul neg exp sub dup dup Red mul 3 -1 roll Green mul 3 -1 roll Blue mul \ifcase\psk@Diffraction@colorMode \tx@RGBtoGRAY neg 1 add setgray \or \tx@RGBtoGRAY setgray \or \tx@RGBtoCMYK setcmykcolor \else setrgbcolor \fi stroke } for } for % \else newpath R_limite neg 1.5 mul cm dup moveto R_limite 3 mul cm 0 rlineto 0 R_limite 3 mul cm rlineto R_limite neg 3 mul cm 0 rlineto closepath \ifnum\psk@Diffraction@colorMode=\z@ 1 \else 0 \fi setgray fill 0 0.01 R_limite { /Rayon exch def /m Coeff Rayon 0.01 mul mul def newpath 0 0 Rayon cm 0 360 arc 1 1e38 m J1Card neg exp sub Red mul % R 1 1e38 m J1Card neg exp sub Green mul % G 1 1e38 m J1Card neg exp sub Blue mul % B \ifcase\psk@Diffraction@colorMode \tx@RGBtoGRAY neg 1 add setgray \or \tx@RGBtoGRAY setgray \or \tx@RGBtoCMYK setcmykcolor \else setrgbcolor \fi stroke } for newpath 0 0 moveto R_limite 1.5 mul cm 0 rlineto 0 R_limite 1.5 mul cm rlineto R_limite neg 1.5 mul cm 0 rlineto closepath clip 0.95 setgray fill newpath 0 0 J1Card 1000 mul moveto 0 0.01 R_limite { /Rayon exch def /m Coeff Rayon 0.01 mul mul def Rayon cm m J1Card 1000 mul lineto } for \ifnum\psk@Diffraction@colorMode=\z@ 1 \else 0 \fi setgray 0.5 setlinewidth stroke /grille { -10 1 10 { /X exch def X cm -10 cm moveto X cm 10 cm lineto X 0 eq { 0 1 0 }{ 0 0 1 } ifelse \ifcase\psk@Diffraction@colorMode \tx@RGBtoGRAY neg 1 add setgray \or \tx@RGBtoGRAY setgray \or \tx@RGBtoCMYK setcmykcolor \else setrgbcolor \fi stroke } for -10 1 10 { /Y exch def -10 cm Y cm moveto 10 cm Y cm lineto Y 0 eq { 0 1 0 }{ 0 0 1 } ifelse \ifcase\psk@Diffraction@colorMode \tx@RGBtoGRAY neg 1 add setgray \or \tx@RGBtoGRAY setgray \or \tx@RGBtoCMYK setcmykcolor \else setrgbcolor \fi stroke } for } def newpath grille \fi }% \addto@pscode \end@SpecialObj% } %% % \def\psdiffractionTriangle{\pst@object{psdiffractionTriangle}} \def\psdiffractionTriangle@i{% \begin@SpecialObj \addto@pscode{% 0 0 translate % les dimensions sont en mètres /f \psk@Diffraction@Slit@F def /h \psk@Diffraction@Triangle@h def /Gamma \psk@Diffraction@gamma@G def /L { \psk@Diffraction@Slit@Lambda 1e-9 mul} bind def % longueur d'onde en m /pixel \psk@Diffraction@Slit@pixel def /k { TwoPi f L mul div } bind def /p { 30 dup sin exch cos div } bind def \psk@Diffraction@Slit@Lambda tx@addDict begin wavelengthToRGB Red Green Blue end /Blue ED /Green ED /Red ED % les bornes sont en pt % +- 4 fois le premier minimum /bornexpt 1 h div f mul L mul 2845 mul def /borneypt 1 h div f mul L mul 2845 mul def /P { 1 k y mul x p y mul sub mul div 1 k h mul x p y mul sub mul RadtoDeg cos sub mul 1 k y mul x p y mul add mul div 1 k h mul x p y mul add mul RadtoDeg cos sub mul sub } def /Q { 1 k y mul x p y mul sub mul div k h mul x p y mul sub mul RadtoDeg sin mul 1 k y mul x p y mul add mul div k h mul x p y mul add mul RadtoDeg sin mul sub } def /I { P dup mul Q dup mul add } def /I_max 0 store % Les calculs commencent... borneypt 4 mul neg pixel 4 borneypt mul { /ordonneept exch def % y en m /y ordonneept 2845 div def bornexpt 4 mul neg pixel 4 bornexpt mul { /abscissept exch def % x en m /x abscissept 2845 div def I_max I le { /I_max I def } if % 1.05 1e\psk@Diffraction@Slit@contrast I neg exp sub dup dup Red mul 3 -1 roll Green mul 3 -1 roll Blue mul \ifcase\psk@Diffraction@colorMode \tx@RGBtoGRAY neg 1 add setgray \or \tx@RGBtoGRAY setgray \or \tx@RGBtoCMYK setcmykcolor \else setrgbcolor \fi % newpath abscissept pixel 2 div sub ordonneept pixel 2 div sub moveto pixel 0 rlineto 0 pixel rlineto pixel neg 0 rlineto closepath fill stroke } for } for }% addto@pscode \end@SpecialObj% } % \catcode`\@=\PstAtCode\relax \endinput
— Syracuse — Dernière modification : 8 septembre 2007 (0.1s - 3788864 - 23 novembre 2008)
