From 452c9d0af12acb085390fe26cc37a9e93d689d5a Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Sat, 12 Jun 2010 00:12:11 +0000 Subject: pst-magneticfield 1.12 (11jun10) git-svn-id: svn://tug.org/texlive/trunk@18901 c570f23f-e606-0410-a88d-b1316a301751 --- .../dvips/pst-magneticfield/pst-magneticfield.pro | 303 +++++++++++++++++++++ 1 file changed, 303 insertions(+) create mode 100644 Master/texmf-dist/dvips/pst-magneticfield/pst-magneticfield.pro (limited to 'Master/texmf-dist/dvips') diff --git a/Master/texmf-dist/dvips/pst-magneticfield/pst-magneticfield.pro b/Master/texmf-dist/dvips/pst-magneticfield/pst-magneticfield.pro new file mode 100644 index 00000000000..fdd24b8217c --- /dev/null +++ b/Master/texmf-dist/dvips/pst-magneticfield/pst-magneticfield.pro @@ -0,0 +1,303 @@ +%% $Id: pst-magneticfield.pro 339 2010-06-07 20:50:23Z herbert $ +%% +%% This is file `pst-magneticfield.pro', +%% +%% IMPORTANT NOTICE: +%% +%% Package `pst-magneticfield.tex' +%% Jürgen Gilg +%% Manuel Luque +%% Herbert Voss +%% +%% 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-magneticfield' is a PSTricks package to draw fields of Helmholtz coils +%% +%% version 0.01 / 2010-06-07 Herbert Voss +%% +% +/tx@MFieldDict 60 dict def +tx@MFieldDict begin +% +% helper functions +/setpixel { 1 0 360 arc fill } bind def +% +/fleche { + gsave + x2 y2 moveto + y2 y1 sub x2 x1 sub atan rotate % 1 1 scale + -1 CLW mul 2 CLW mul rlineto + 7 CLW mul -2 CLW mul rlineto + -7 CLW mul -2 CLW mul rlineto + closepath + fill + grestore +} def +/Calcul_B_Spires { + /Bx 0 def + /By 0 def + 1 1 NombreSpires { % on calcule le champ resultant de toutes les spires + /iS ED % numero de la spire + /yi yA iS 1 sub inter mul sub def % position de la spire + /Bx0 { + /arz {1 Radius xP add dup mul yP yi add dup mul add sqrt div} def + yP yi add xP div arz mul + EllipticK neg + Radius dup mul xP dup mul add yP yi add dup mul add + Radius xP sub dup mul yP yi add dup mul add div + EllipticE mul + add + mul + } def + /By0 { + /arz {1 Radius xP add dup mul yP yi add dup mul add sqrt div} def + arz + EllipticK + Radius dup mul xP dup mul sub yP yi add dup mul sub + Radius xP sub dup mul yP yi add dup mul add div + EllipticE mul + add + mul + } def + AntiHelmholtz { iS 2 eq {/Bx0 Bx0 neg def /By0 By0 neg def} if } if + /Bx Bx Bx0 add def + /By By By0 add def + } for +} def +/EllipticKE{ + /K {2 Radius xP mul sqrt mul arz mul} def + /m1 {1 K dup mul sub} def + /m2 {m1 dup mul} def + /m3 {m2 m1 mul} def + /m4 {m2 dup mul} def + /m_1 {1 m1 div} def + /EllipticK { + 0.5 + 0.12498593597 m1 mul add + 0.06880248576 m2 mul add + 0.03328355376 m3 mul add + 0.00441787012 m4 mul add + m_1 ln mul + 1.38629436112 add + 0.09666344259 m1 mul add + 0.03590092383 m2 mul add + 0.03742563713 m3 mul add + 0.01451196212 m4 mul add + } def + /EllipticE { + 0.24998368310 m1 mul + 0.09200180037 m2 mul add + 0.04069697526 m3 mul add + 0.00526449639 m4 mul add + m_1 ln mul + 1 add + 0.44325141463 m1 mul add + 0.062606012206 m2 mul add + 0.04757383546 m3 mul add + 0.01736506451 m4 mul add + } def + Calcul_B_Spires +% au point Pi + /xPi xP def + /yPi yP def + /NormeB Bx dup mul By dup mul add sqrt def + /dX Bx NormeB div Pas mul def + /dXi dX def + /dY By NormeB div Pas mul def + /dYi dY def + /xCi xPi dX add def + /yCi yPi dY add def + /xP xCi def + /yP yCi def + Calcul_B_Spires +% au point C + /NormeB Bx dup mul By dup mul add sqrt def + /dX Bx NormeB div Pas mul def + /dY By NormeB div Pas mul def + /yP yPi dY dYi add 2 div add def +} def +% +%0 0 translate +% +/setValues { % on stack +1 or -1 + /yfactor ED /xfactor ED + Ligne_Champ dup length 1 sub 1.5 div cvi get aload pop + yfactor 0 gt { + /y2 exch yfactor mul def + /x2 exch xfactor mul def + }{ + /y1 exch yfactor mul def + /x1 exch xfactor mul def + } ifelse + Ligne_Champ dup length 1 sub 1.5 div cvi 1 add get aload pop + yfactor 0 gt { + /y1 exch yfactor mul def + /x1 exch xfactor mul def + }{ + /y2 exch yfactor mul def + /x2 exch xfactor mul def + } ifelse +} def +% +/Lignes_Champ { + /Ligne_Champ [ + NbrePoints {% + EllipticKE + [ xP yP yUnit mul exch xUnit mul exch ] + trace 1 eq {By 0 lt Bx 0 lt and {exit} if} if + AntiHelmholtz not { xP xMax ge yP yMax ge or {exit} if } if + } repeat + ] def +% + Ligne_Champ 0 get aload pop moveto % xP yP + 1 1 Ligne_Champ length 1 sub { + /iCompteur exch def + Ligne_Champ iCompteur get aload pop lineto + } for + stroke +% les flèches (xP,yP) + 1 1 setValues + nCount 0 eq {/yAxe1 y1 def /yAxe2 y2 def} if + fleche +% + Ligne_Champ 0 get aload pop neg moveto % xP -yP + 1 1 Ligne_Champ length 1 sub { + /iCompteur ED + Ligne_Champ iCompteur get aload pop neg lineto + } for + stroke + trace 1 eq { +% (xP,-yP) + 1 -1 setValues + fleche + } if + Ligne_Champ 0 get aload pop exch neg exch moveto % -xP yP + 1 1 Ligne_Champ length 1 sub { + /iCompteur ED + Ligne_Champ iCompteur get aload pop exch neg exch lineto + } for + stroke +% (-xP,yP) + -1 1 setValues + fleche + Ligne_Champ 0 get aload pop exch neg exch neg moveto % -xP -yP + 1 1 Ligne_Champ length 1 sub { + /iCompteur ED + Ligne_Champ iCompteur get aload pop exch neg exch neg lineto + } for + stroke + trace 1 eq { +% (-xP,-yP) + -1 -1 setValues + fleche + } if + } def +% +/MagneticField { +StreamDensityPlot { + /Bmax 0 def + /Pas PasB def + % recherche du Bmax + AntiHelmholtz { + Radius 0.1 sub 0.1 Radius 1.5 mul { + /xP exch def + 0 0.1 yMax { + /yP exch def + EllipticKE + NormeB Bmax gt {/Bmax NormeB def} if + } for + }for + }{ + 0.01 0.1 Radius 0.1 sub { + /xP exch def + 0 0.1 yMax { + /yP exch def + EllipticKE + NormeB Bmax gt {/Bmax NormeB def} if + } for + }for + } ifelse +%/xP 0.001 def +%/yP 0 def +%EllipticKE +%/Bmax NormeB def + /StepPixel + 1 Unit div store + gsave + 0.009 StepPixel xMax { + /xPos ED + /xP xPos def + 0.009 StepPixel yMax { + /yPos ED + /yP yPos def + EllipticKE + /HB NormeB Bmax div store + Setgray { /HB HB 25 mul round 25 div def } if % 25 niveaux de gris + xPos xUnit mul yPos yUnit mul + Setgray { HB setgray setpixel }{ HB 0.7 1 sethsbcolor setpixel } ifelse + xPos xUnit mul neg yPos yUnit mul + Setgray { HB setgray }{ HB 0.7 1 sethsbcolor } ifelse setpixel + xPos xUnit mul neg yPos yUnit mul neg + Setgray { HB setgray }{ HB 0.7 1 sethsbcolor } ifelse setpixel + xPos xUnit mul yPos yUnit mul neg + Setgray { HB setgray }{ HB 0.7 1 sethsbcolor } ifelse setpixel + } for + }for + grestore +} if +% lignes de champ de l'ensemble de la bobine + /trace 1 def + /nCount 0 def +% 0.1 Radius mul StepLines Radius mul 0.9 Radius mul { + StepLines StepLines Radius 1.5 StepLines mul sub { + /NbrePoints NbrePointsB def + /xStart ED + /yStart 0 def + /Pas PasB def + /xP xStart def + /yP yStart Pas sub def + Lignes_Champ + /nCount nCount 1 add def + } for + AntiHelmholtz not { + % l'axe oriente de la bobine + 0 yMin yUnit mul moveto + 0 yMax yUnit mul lineto + stroke + /x1 0 def + /y1 yAxe1 def + /y2 yAxe2 def + /x2 0 def + fleche + %/x1 0 def + /y1 yAxe2 neg def + /y2 yAxe1 neg def + %/x2 0 def + fleche } if + % quelques lignes de champ autour de chaque spire + /trace 0 def + /increment 0.25 Radius mul def + AntiHelmholtz { /Pas PasS def /NbrePoints NbrePointsS def } if + nS { % nS lignes + 0 1 TS length 1 sub { + /nTemp ED + /iS TS nTemp get def % numero de la spire en partant du haut + iS 0 eq { /iS 1 def } if % iS ne peut pas = 0 + iS NombreSpires gt { /iS NombreSpires def } if % iS ne peut pas > nbre spires + /yi yA iS 1 sub inter mul sub def % position du centre de la spire + AntiHelmholtz not { /NbrePoints NbrePointsS def /Pas PasS def } if + /xStart Radius increment add def + /yStart yi def + /xP xStart def + /yP yStart Pas sub def + Lignes_Champ + } for + AntiHelmholtz { /NbrePoints NbrePoints 750 add def } if + /increment increment 0.2 Radius mul add def + } repeat +} def % /MagneticField +end +%% -- cgit v1.2.3