summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-3dplot/pst-3dplot.pro
blob: 30b2d62eeceddb84fe0ce60066b9e1fc7581e230 (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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
%%
%% This is file `pst-3dplot.pro',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pst-3dplot.tex'
%%
%% Herbert Voss <voss _at_ PSTricks.de>
%%
%% 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-3dplot' is a PSTricks package to draw 3d curves and graphical objects
%%
%%
%% version 0.23 / 2006-01-18  Herbert Voss <voss _at_ PSTricks.de>
%
/tx@3DPlotDict 50 dict def
tx@3DPlotDict begin
%
/printDot { gsave 2 copy 2 0 360 arc fill stroke grestore } def
%
/saveCoor { 
  dzUnit mul /z exch def
  dyUnit mul /y exch def
  dxUnit mul /x exch def
} def
%
/ConvertTo2D {
  RotatePoint
%  /x2D y x Alpha sin mul sub def  %  |/_  co system
%  /y2D z x Alpha cos mul sub def 
  /x2D x leftHanded not { neg } if Alpha cos mul y Alpha sin mul add def
  /y2D x leftHanded { neg } if Alpha sin mul y Alpha cos mul add neg Beta sin mul z Beta cos mul add def
} def
%
/Conv3D2D { /z ED /y ED /x ED ConvertTo2D x2D y2D } def
%
/ConvertToCartesian {
  /latitude exch def
  /longitude exch def
  /Radius exch def
  /z { Radius latitude sin mul } def
  /x { Radius longitude cos mul latitude cos mul } def
  /y { Radius longitude sin mul latitude cos mul } def
} def
/ConvCylToCartesian { % r phi h -> x y z
  3 1 roll			% r phi h
  /Phi ED
  /Radius ED			% h->z
  Radius Phi cos mul exch 	% x z
  Radius Phi sin mul exch	% x y z
} def
%
/SphericalTo2D {
  x y z ConvertToCartesian ConvertTo2D
} def
%
/CylinderTo2D { %  r phi h
  x y z ConvCylToCartesian ConvertTo2D
} def
%
/convertStackTo2D {
  counttomark
  /n exch def /n3 n 3 div cvi def
  n3 {
    n -3 roll
    SphericalCoor { ConvertToCartesian } { saveCoor } ifelse
    ConvertTo2D
    x2D xUnit y2D yUnit
    /n n 1 sub def
  } repeat
} def
%
/CalcCoordinates {% from pst-vue3d
    formulesTroisD
    Xi 28.45 mul Yi 28.45 mul
} def
% pour la 3D conventionnelle
/DScreen 1 def
/Dobs 0 def
/formulesTroisD{%
  /xObservateur x Sin1 mul neg y Cos1 mul add def
  /yObservateur x Cos1Sin2 mul neg y Sin1Sin2 mul sub z Cos2 mul add def
  /zObservateur x neg Cos1Cos2 mul y Sin1Cos2 mul sub z Sin2 mul sub def
  /Xi xObservateur mul zObservateur Div def
  /Yi yObservateur mul zObservateur Div def
} def
%
/RotatePointXYZ{% Mxx are defined in the TeX file
  /xi M11 x mul M12 y mul add M13 z mul add def
  /yi M21 x mul M22 y mul add M23 z mul add def
  /zi M31 x mul M32 y mul add M33 z mul add def
  /x xi def
  /y yi def
  /z zi def
} def
%
/RotXaxis { 
  /yTemp y RotX cos mul z RotX sin mul sub def
  /z  y RotX sin mul z RotX cos mul add def
  /y yTemp def
} def
/RotYaxis { 
  /xTemp x RotY cos mul z RotY sin mul add def
  /z  x RotY sin mul neg z RotY cos mul add def
  /x xTemp def
} def
/RotZaxis { 
  /xTemp x RotZ cos mul y RotZ sin mul sub def
  /y  x RotZ sin mul y RotZ cos mul add def
  /x xTemp def
} def
/xyz { RotXaxis RotYaxis RotZaxis } def
/yxz { RotYaxis RotXaxis RotZaxis } def
/yzx { RotYaxis RotZaxis RotXaxis } def
/xzy { RotXaxis RotZaxis RotYaxis } def
/zxy { RotZaxis RotXaxis RotYaxis } def
/zyx { RotZaxis RotYaxis RotXaxis } def
%
/RotatePoint { RotSequence cvx exec } def
%
/VecNorm { 0 exch { dup mul add } forall sqrt } def
/UnitVec {			% on stack is [a]; returns a vector with [a][a]/|a|=1 
  dup VecNorm /norm ED
  { norm div } forall 3 array astore } def
/AxB {				% on the stack are the two vectors [a][b]
    aload pop /b3 ED /b2 ED /b1 ED
    aload pop /a3 ED /a2 ED /a1 ED
    a2 b3 mul a3 b2 mul sub
    a3 b1 mul a1 b3 mul sub
    a1 b2 mul a2 b1 mul sub
    3 array astore } def
/AaddB {			% on the stack are the two vectors [a][b]
    aload pop /b3 ED /b2 ED /b1 ED
    aload pop /a3 ED /a2 ED /a1 ED
    a1 b1 add a2 b2 add a3 b3 add
    3 array astore } def
/AmulC {			% on stack is [a] and c; returns [a] mul c
    /factor ED { factor mul } forall 3 array astore } def
%
%
% 3D objects
/tx@ProjThreeD {% adopted from pst-3d
  /z ED /y ED /x ED
  Matrix3D aload pop
  z mul exch y mul add exch x mul add
  4 1 roll
  z mul exch y mul add exch x mul add
  exch} def
%
/setColorLight { % expects 7 values on stack C M Y K xL yL zL
% les rayons de lumière
  /zLight exch def 
  /yLight exch def
  /xLight exch def
% the color values
  /K exch def
  /Yellow exch def
  /Magenta exch def
  /Cyan exch def
%
  /NormeLight {xLight dup mul yLight dup mul zLight dup mul add add
            sqrt} bind def 
} def
/facetteSphere {
  newpath
  /Xpoint Rsphere theta cos mul phi cos mul CX add def
  /Ypoint Rsphere theta sin mul phi cos mul CY add def
  /Zpoint Rsphere phi sin mul CZ add def
  Xpoint Ypoint Zpoint tx@ProjThreeD moveto
  theta 1 theta increment add {%
    /theta1 exch def
    /Xpoint Rsphere theta1 cos mul phi cos mul CX add def
    /Ypoint Rsphere theta1 sin mul phi cos mul CY add def
    /Zpoint Rsphere phi sin mul CZ add def
    Xpoint Ypoint Zpoint tx@ProjThreeD  lineto
  } for
  phi 1 phi increment add {
    /phi1 exch def
    /Xpoint Rsphere theta increment add cos mul phi1 cos mul CX add def
    /Ypoint Rsphere theta increment add sin mul phi1 cos mul CY add def
    /Zpoint Rsphere phi1 sin mul CZ add def
    Xpoint Ypoint Zpoint tx@ProjThreeD lineto
  } for
  theta increment add -1 theta {%
    /theta1 exch def
    /Xpoint Rsphere theta1 cos mul phi increment add cos mul CX add def
    /Ypoint Rsphere theta1 sin mul phi increment add cos mul CY add def
    /Zpoint Rsphere phi increment add sin mul CZ add def
    Xpoint Ypoint Zpoint tx@ProjThreeD lineto
  } for
  phi increment add -1 phi {
    /phi1 exch def
    /Xpoint Rsphere theta cos mul phi1 cos mul CX add def
    /Ypoint Rsphere theta sin mul phi1 cos mul CY add def
    /Zpoint Rsphere phi1 sin mul CZ add def
    Xpoint Ypoint Zpoint tx@ProjThreeD lineto
  } for
  closepath 
} def
%
/condition { PSfacette 0 ge } def
/MaillageSphere { 
% on stack must be
% x y z Radius increment C M Y K x y zLIGHT
  setColorLight
  /increment exch def
  /Rsphere exch def
  /CZ exch def
  /CY exch def
  /CX exch def
  /StartTheta 0 def
  -90 increment 90 increment sub {%
    /phi exch def
    StartTheta increment 360 StartTheta add increment sub {%
      /theta exch def
      % Centre de la facette
      /Xpoint Rsphere theta increment 2 div add cos mul phi increment 2 div add cos mul CX add def
      /Ypoint Rsphere theta increment 2 div add sin mul phi increment 2 div add cos mul CY add def
      /Zpoint Rsphere phi increment 2 div add sin mul CZ add def
      % normale à la facette
      /nXfacette Xpoint CX sub def
      /nYfacette Ypoint CY sub def
      /nZfacette Zpoint CZ sub def
      % test de visibilité
      /PSfacette vX nXfacette mul
        vY nYfacette mul add
        vZ nZfacette mul add
      def
      condition {
        gsave
        facetteSphere
        /cosV { 1 xLight nXfacette mul
          yLight nYfacette mul
          zLight nZfacette mul
          add add
          NormeLight
          nXfacette dup mul
          nYfacette dup mul
          nZfacette dup mul
          add add sqrt mul div sub } bind def
        Cyan cosV mul Magenta cosV mul Yellow cosV mul K cosV mul setcmykcolor fill 
	grestore
%	0 setgray
        facetteSphere stroke	
      } if 
    } for
    % /StartTheta StartTheta increment 2 div add def
  } for
} def
%
%
/MoveTo { Conv3D2D moveto } def
/LineTo { Conv3D2D lineto } def

/IIIDEllipse { % x y z rA rB startAngle endAngle Wedge
  /dAngle 1 def
  /isWedge ED
  /endAngle ED
  /startAngle ED
  /radiusB ED
  /radiusA ED
  startAngle cos radiusA mul startAngle sin radiusB mul 0 
  isWedge { 0 0 moveto LineTo }{ MoveTo } ifelse
  /Angle startAngle def
  startAngle dAngle endAngle {
    /Angle ED
    Angle cos radiusA mul Angle sin radiusB mul 0 LineTo  
  } for
  isWedge { 0 0 lineto } if
} def

/IIIDCircle { % x y z r startAngle endAngle Wedge
  7 3 roll % startAngle endAngle Wedge x y z r
  dup      % startAngle endAngle Wedge x y z r r
  8 -3 roll
  IIIDEllipse 
} def

/IIIDWedge { % x y z r startAngle endAngle
  true IIIDCircle
} def

/IIIDCylinder {% x y z r h start end wedge
  /isWedge ED
  /increment ED
  /endAngle ED
  /startAngle ED
  /height ED
  /radius ED
  startAngle increment endAngle {
    /Angle exch def
    radius Angle 0 ConvCylToCartesian MoveTo  
    radius Angle height ConvCylToCartesian LineTo  
  } for
  stroke
} def
%
end