summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/tex/generic/pst-diffraction
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2007-09-16 00:18:08 +0000
committerKarl Berry <karl@freefriends.org>2007-09-16 00:18:08 +0000
commit14c7fd46eb994879e14d10b636bcd97a0a3237e8 (patch)
treec17867bf2b11377b69c1930324fe573baa0d7f37 /Master/texmf-dist/tex/generic/pst-diffraction
parentb4f513643e9222ff96f871b92cbd9d94c8ec1096 (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/pst-diffraction')
-rw-r--r--Master/texmf-dist/tex/generic/pst-diffraction/pst-diffraction.tex387
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