pst-spirograph (20aug14)

git-svn-id: svn://tug.org/texlive/trunk@34995 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 177 insertions, 0 deletions

diff --git a/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro b/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro
new file mode 100644
index 00000000000..bdf690be00e
--- /dev/null
+++ b/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro
@@ -0,0 +1,177 @@
+%% $Id: pst-spirograph.pro 75 2014-08-19 18:38:05Z herbert $
+%%
+% PostScript prologue for pst-spirograph.tex.
+%
+% Version 0.40, 2014/08/18 
+%
+/tx@spirographDict 10 dict def 
+tx@spirographDict begin
+/coorPen {
+  1 dict begin
+    /t exch def
+    r2 qi t cos mul ki qi t mul 60 ni mul sub cos mul add mul cm
+    r2 qi t sin mul ki qi t mul 60 ni mul sub sin mul sub mul cm
+  end
+} def
+/coorPen2 {
+  1 dict begin
+    /t exch def
+    r2 qi2 t cos mul ki qi2 t mul 60 ni mul neg 180 Z2 div sub sub cos mul sub mul cm
+    r2 qi2 t sin mul ki qi2 t mul 60 ni mul neg 180 Z2 div sub sub sin mul sub mul cm
+  end
+} def
+/Datas1 {
+  /Z@ exch def
+  /m@ exch def
+  /R@ {m@ Z@ mul 2 div } bind def % cercle primitif
+  /Rb {R@ ap cos mul } bind def % cercle de base
+  /Rp {R@ 2 mul 2.5 m@ mul sub 2 div } bind def % cercle de pied
+  /Rt {R@ 2 mul 2 m@ mul add 2 div } bind def % cercle de tête
+} def
+/Datas2 {
+  /Z@ exch def
+  /m@ exch def
+  /R@ {m@ Z@ mul 2 div } bind def % cercle primitif
+  /Rb {R@ ap cos mul } bind def % cercle de base
+  /Rp {R@ 2 mul 2 m@ mul sub 2 div } bind def % cercle de pied
+  /Rt {R@ 2 mul 2.5 m@ mul add 2 div } bind def % cercle de tête
+} def
+/Calculs { % les valeurs suivantes sont en radians
+  /ThetaP {R@ Rb div dup mul 1 sub sqrt } bind def % intersection avec cercle primitif
+  /ThetaT {Rt Rb div dup mul 1 sub sqrt } bind def % intersection avec cercle de tete
+  % Les valeurs suivantes ont en degrés
+  /ThetaTdeg {Rt Rb div dup mul 1 sub sqrt RadtoDeg } bind def %
+  /ThetaPdeg {R@ Rb div dup mul 1 sub sqrt RadtoDeg } bind def
+  /DeltaP {ThetaPdeg sin ThetaP ThetaPdeg cos mul sub
+           ThetaPdeg cos ThetaP ThetaPdeg sin mul add atan } bind def
+  /DeltaT {ThetaTdeg sin ThetaT ThetaTdeg cos mul sub
+           ThetaTdeg cos ThetaT ThetaTdeg sin mul add atan } bind def
+  /DeltaS {Pi 2 div Z@ div } bind def
+         /DeltaSdeg {90 Z@ div } bind def
+         /AngleDent {360 Z@ div} bind def
+         /Alpha {DeltaSdeg DeltaP add DeltaT sub } bind def
+         /2Beta {DeltaSdeg DeltaP add 2 mul } bind def
+         /Beta_  {DeltaSdeg DeltaP add neg} bind def
+         /ptA {Rp cm 0} bind def
+         /ptB {Rb cm 0} bind def
+         /ptC {Rp cm DeltaSdeg 2 mul neg 2Beta 2 div add cos mul
+               Rp cm DeltaSdeg 2 mul neg 2Beta 2 div add sin mul} bind def
+         /ptA'{Rp cm DeltaP DeltaSdeg add 2 mul cos mul
+               Rp cm DeltaP DeltaSdeg add 2 mul sin mul} bind def
+         /ptB'{Rb cm DeltaP DeltaSdeg add 2 mul cos mul
+               Rb cm DeltaP DeltaSdeg add 2 mul sin mul} bind def
+         /ptC'{Rp cm DeltaSdeg 3 mul DeltaP add cos mul
+               Rp cm DeltaSdeg 3 mul DeltaP add sin mul} bind def
+         /Raxe {Rp 4 div } bind def
+         /A@0 14.5 def % position et largeur de la clavette
+    % rayon de raccordement sur le cercle de pied
+         /Rarct {Rp Pi mul Z@ div 12 div cm} bind def
+} def
+% Le symetrique P' de P par rapport a la l'axe de la dent
+% Delta(axe de la dent) y=x*tan(Beta)
+% x'=y*sin(2*Beta)+x*cos(2*Beta)
+% y'=x*sin(2*Beta)-y*cos(2*Beta)
+% x y symAxe -> x' y'
+/symAxe {
+ 2 dict begin
+  /y exch def
+  /x exch def
+  y 2Beta sin mul x 2Beta cos mul add % x'
+  x 2Beta sin mul y 2Beta cos mul sub % y'
+ end
+} def
+ %
+% Rotation pour amener l'axe de la dent horizontal
+%
+/RotDent {
+  2 dict begin
+    /y exch def
+    /x exch def
+    i@ cos x mul i@ sin y mul sub
+    i@ sin x mul i@ cos y mul add
+  end
+} def
+% developpante du cercle de base
+%
+/devCercle {
+  1 dict begin
+  /t exch def % en degres
+  Rb t cos t DegtoRad t sin mul add mul cm % x
+  Rb t sin t DegtoRad t cos mul sub mul cm % y
+ end
+} def
+% trace des cercles
+%%%% definition de la roue dentee %%%%%%
+/Roue {
+% arc de développante
+/tabArcDev [
+0 1 ThetaTdeg { /i@ exch def
+ [i@ devCercle] } for
+ ] def
+%
+/n@ tabArcDev length def
+%
+/tabDent [
+% l'arc de developpante initial
+  tabArcDev aload pop
+% l'arc ce cercle de tete
+DeltaT 0.1 2Beta DeltaT sub {/i@ exch def
+ [Rt cm i@ cos mul
+  Rt cm i@ sin mul]
+ } for
+% le symetrique de l'arc de developpante par rapport a l'axe de la dent
+n@ 1 sub -1 0  {
+    /compteur exch def
+    [tabArcDev compteur get aload pop symAxe]
+    } for
+    ] def
+% trace de la dent
+/n2@ tabDent length def
+newpath
+ptC moveto
+0 1 Z@ 1 sub {/i@ exch AngleDent mul def
+ifinner 
+{
+  wheel 2 eq { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto }
+             { ptA RotDent lineto ptB RotDent lineto } ifelse
+}
+{
+  Rp Rb eq { ptA RotDent lineto ptB RotDent lineto }
+           { ptA RotDent ptB RotDent Rarct arct ptB RotDent lineto } ifelse
+} ifelse
+  0 1 n2@ 1 sub {
+    /compteur exch def
+    tabDent compteur get aload pop
+    RotDent lineto } for
+ifinner
+  {wheel 2 eq {
+   Rp Rb eq {
+    ptA' RotDent lineto ptC' RotDent lineto
+    }{
+    ptA' RotDent ptC' RotDent Rarct arct
+    ptC' RotDent lineto } ifelse
+    } {
+     ptA' RotDent lineto ptC' RotDent lineto } ifelse
+}{
+  Rp Rb eq {
+    ptA' RotDent lineto ptC' RotDent lineto
+    }{
+    ptA' RotDent ptC' RotDent Rarct arct
+    ptC' RotDent lineto }
+  ifelse
+} ifelse
+} for
+} def
+% pour l'engrenage interieur
+/COURONNE {   0 0 Rt 1.1 mul cm 360 0 arcn } def
+%
+/untrou {
+    newpath
+    a@ THETA DegtoRad mul THETA cos mul neg
+    a@ THETA DegtoRad mul THETA sin mul
+    0.05 cm 0 360 arc
+    closepath
+} def
+%
+end
+%%
\ No newline at end of file