diff options
author | Karl Berry <karl@freefriends.org> | 2007-09-16 00:18:08 +0000 |
---|---|---|
committer | Karl Berry <karl@freefriends.org> | 2007-09-16 00:18:08 +0000 |
commit | 14c7fd46eb994879e14d10b636bcd97a0a3237e8 (patch) | |
tree | c17867bf2b11377b69c1930324fe573baa0d7f37 /Master/texmf-dist/tex/generic | |
parent | b4f513643e9222ff96f871b92cbd9d94c8ec1096 (diff) |
new pstricks pst-diffraction (13sep07)
git-svn-id: svn://tug.org/texlive/trunk@4950 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/texmf-dist/tex/generic')
-rw-r--r-- | Master/texmf-dist/tex/generic/pst-diffraction/pst-diffraction.tex | 387 |
1 files changed, 387 insertions, 0 deletions
diff --git a/Master/texmf-dist/tex/generic/pst-diffraction/pst-diffraction.tex b/Master/texmf-dist/tex/generic/pst-diffraction/pst-diffraction.tex new file mode 100644 index 00000000000..d00c540e315 --- /dev/null +++ b/Master/texmf-dist/tex/generic/pst-diffraction/pst-diffraction.tex @@ -0,0 +1,387 @@ +%% +%% 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.10b}% +\def\filedate{2007/09/07}% +\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 + \pst@number\pslinewidth setlinewidth + stroke + \pst@number\pslinewidth 2 div setlinewidth + /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 |