summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-spirograph/pst-spirograph.pro
blob: bdf690be00e40f948e4e33c2a47522617a9e38b1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
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
%%