summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/dvips/pst-geo/map3d.pro
blob: f65513ce4bfaad586092fb7aa45105fb39ec17e1 (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
%version 29 novembre 2003
% modification 11/05/2004
% allégée de 3D.pro
/tx@map3DDict 100 dict def
tx@map3DDict begin
%
 /CalculsPoints{%
   /region exch def
   newpath
   /nbr region length def % nombre de régions
   0 1 nbr 1 sub {
     /counter exch def % pour mémoriser le premier point vu
     counter
     region exch get aload pop
     /Y exch def /X exch def
     /Xpoint { Y cos X cos mul Rsphere mul } def
     /Ypoint { Y cos X sin mul Rsphere mul } def
     /Zpoint { Y sin Rsphere mul } def
     CalculsPointsAfterTransformations
     CalcCoordinates
     Test
     PS 0 lt {% marque le point
        /X1 X def
        /Y1 Y def
         moveto
        exit % termine
     }{ pop pop } ifelse
  } for
  nbr counter sub 1 gt {
    /ncount 0 def % hv 2004-05-04
    counter 1 nbr 1 sub {
      /ctrl exch def
      /ncount ncount 1 add def
      region ctrl get aload pop
      ncount step mod 0 eq ctrl nbr sub 1 eq or { % hv 2004-05-11
        /Y exch def /X exch def
        /Xpoint { Y cos X cos mul Rsphere mul } def
        /Ypoint { Y cos X sin mul Rsphere mul } def
        /Zpoint { Y sin Rsphere mul } def
        CalculsPointsAfterTransformations
        CalcCoordinates
        Test
        PS 0 le { lineto } if
        PS 0 gt { /Angle Yi Xi atan def
          RsphereScreen Angle cos mul
          RsphereScreen Angle sin mul
          lineto
        } if
      }{ pop pop } ifelse % hv 2004-05-11 
    } for 
  } if
} def
%
/MatriceTransformation{%
   /Sin1 THETA sin def
    /Sin2 PHI sin def
    /Cos1 THETA cos def
    /Cos2 PHI cos def
    /Cos1Sin2 Cos1 Sin2 mul def
    /Sin1Sin2 Sin1 Sin2 mul def
    /Cos1Cos2 Cos1 Cos2 mul def
    /Sin1Cos2 Sin1 Cos2 mul def
    /XpointVue Dobs Cos1Cos2 mul def
    /YpointVue Dobs Sin1Cos2 mul def
    /ZpointVue Dobs Sin2 mul def
    /M11 RotZ cos RotY cos mul def
    /M12 RotZ cos RotY sin mul RotX sin mul
         RotZ sin RotX cos mul sub def
    /M13 RotZ cos RotY sin mul RotX cos mul
         RotZ sin RotX sin mul add def
    /M21 RotZ sin RotY cos mul def
    /M22 RotZ sin RotY sin RotX sin mul mul
         RotZ cos RotX cos mul add def
    /M23 RotZ sin RotY sin mul RotX cos mul
         RotZ cos RotX sin mul sub def
    /M31 RotY sin neg def
    /M32 RotX sin RotY cos mul def
    /M33 RotX cos RotY cos mul def
   } def
/CalcCoordinates{%
    formulesTroisD
    Xi xunit Yi yunit
    }
    def
% pour la 3D conventionnelle
/formulesTroisD{%
    /xObservateur Xabscisse Sin1 mul neg Yordonnee Cos1 mul add def
    /yObservateur Xabscisse Cos1Sin2 mul neg Yordonnee Sin1Sin2 mul sub Zcote Cos2 mul add def
    /zObservateur Xabscisse neg Cos1Cos2 mul Yordonnee Sin1Cos2 mul sub Zcote Sin2 mul sub Dobs add def
    /Xi DScreen xObservateur mul zObservateur div def
    /Yi DScreen yObservateur mul zObservateur div def
  }
def
%
/CalculsPointsAfterTransformations{%
    /Xabscisse M11 Xpoint mul M12 Ypoint mul add M13 Zpoint mul add def
    /Yordonnee M21 Xpoint mul M22 Ypoint mul add M23 Zpoint mul add def
    /Zcote M31 Xpoint mul M32 Ypoint mul add M33 Zpoint mul add def
    }
def
%
/Test { % test de visibilité d'un point
% rayon vers point de vue
    /RXvue Xabscisse XpointVue sub def
    /RYvue Yordonnee YpointVue sub def
    /RZvue Zcote ZpointVue sub def
% test de visibilité
    /PS RXvue Xabscisse mul % produit scalaire
    RYvue Yordonnee mul add
    RZvue Zcote mul add
    def
} def
%
/MaillageSphere {
gsave
maillageColor  setrgbcolor
0.25 setlinewidth
0 increment 360 increment sub {%
    /theta exch def
departPhi increment 90 increment sub {%
    /phi exch def
% newpath
    /Xpoint Rsphere theta cos mul phi cos mul def
    /Ypoint Rsphere theta sin mul phi cos mul def
    /Zpoint Rsphere phi sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
     moveto
% Centre de la facette
    /Xpoint Rsphere theta increment 2 div add cos mul phi increment 2 div add cos mul def
    /Ypoint Rsphere theta increment 2 div add sin mul phi increment 2 div add cos mul def
    /Zpoint Rsphere phi increment 2 div add sin mul def
CalculsPointsAfterTransformations
    /xCentreFacette Xabscisse def
    /yCentreFacette Yordonnee def
    /zCentreFacette Zcote def
% normale à la facette
    /nXfacette xCentreFacette def
    /nYfacette yCentreFacette def
    /nZfacette zCentreFacette def
% rayon vers point de vue
    /RXvue xCentreFacette XpointVue sub def
    /RYvue yCentreFacette YpointVue sub def
    /RZvue zCentreFacette ZpointVue sub def
% test de visibilité
    /PSfacette RXvue nXfacette mul
    RYvue nYfacette mul add
    RZvue nZfacette mul add
    def
condition {
theta 1 theta increment add {%
    /theta1 exch def
    /Xpoint Rsphere theta1 cos mul phi cos mul def
    /Ypoint Rsphere theta1 sin mul phi cos mul def
    /Zpoint Rsphere phi sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
phi 1 phi increment add {
    /phi1 exch def
    /Xpoint Rsphere theta increment add cos mul phi1 cos mul def
    /Ypoint Rsphere theta increment add sin mul phi1 cos mul def
    /Zpoint Rsphere phi1 sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
theta increment add -1 theta {%
    /theta1 exch def
    /Xpoint Rsphere theta1 cos mul phi increment add cos mul def
    /Ypoint Rsphere theta1 sin mul phi increment add cos mul def
    /Zpoint Rsphere phi increment add sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
    } for
phi increment add -1 phi {
    /phi1 exch def
    /Xpoint Rsphere theta cos mul phi1 cos mul def
    /Ypoint Rsphere theta sin mul phi1 cos mul def
    /Zpoint Rsphere phi1 sin mul def
CalculsPointsAfterTransformations
    CalcCoordinates
    lineto
        } for
} if
} for
} for
stroke
} def
%
/DrawCitys {
/CITY exch def
/Rayon exch def
/nbr CITY length def % nombre de villes
0 1 nbr 1 sub {
  /compteur exch def
  CITY compteur get aload pop
  /X exch def /Y exch def
  /Xpoint {%
    Y cos X cos mul Rsphere mul
    } def
  /Ypoint {%
    Y cos X sin mul Rsphere mul
    } def
  /Zpoint { Y sin Rsphere mul } def
CalculsPointsAfterTransformations
    CalcCoordinates
Test
PS 0 lt %
 {1 0 0 setrgbcolor newpath Rayon 0 360 arc closepath fill}{pop pop}
 ifelse
} for
} def
end