1 subroutine inprfd(idum,latex,kadre,signe,hx,hy,angle 2 & ,nomfich,longfich,icol) 3c 4c On garde idum comme premier argument pour compatibilite 5c 6 INCLUDE 'Parametres.f' 7 real xpapier,ypapier 8cc parameter (ptcm=0.0283464566929134) 9c---------- taille du papier standart ------------- 10 parameter (xpapier=21000.,ypapier=29700.) 11c-------------------------------------------------- 12 logical*4 latex,kadre,signe 13 real hx,hy,angle 14 character strng*255,nomfich*512 15c 16 1 format(a) 17 2 format(a,f6.0,' def') 18 3 format(a,i6,' def') 19 if (icol.eq.0) then 20 ipostscript = -1 21 else 22 ipostscript = -2 23 endif 24c 25ccc ilaser_file = i 26 k = ilaser_file 27 taille_x = hx 28 taille_y = hy 29c 30 write(k,1)'%% Fin des informations diverses ------------------' 31 write(k,1)'%' 32 write(k,1)'%%EndComments' 33 write(k,1)'%%BeginProlog' 34 write(k,1)'%' 35 write(k,1)'300 dict begin' 36c write(k,1)'% debut des variables postscript modifiables' 37c write(k,1)'% ------------------------------------------' 38c write(k,1)'% - decxcm et decycm permettent de' 39c write(k,1)'% decaler le dessin resp. vers la droite' 40c write(k,1)'% et vers le haut (la feuille est verticale)' 41c write(k,1)' ' 42 write(k,1)'/decxcm 0. def' 43 write(k,1)'/decycm 0. def' 44c write(k,1)' ' 45c write(k,1)'% - angle permet de tourner le dessin' 46c write(k,1)'% en degres' 47c write(k,1)' ' 48 write(k,2)'/angle',angle 49c write(k,1)' ' 50c write(k,1)'% - zoomx zoomy permet de grossir le dessin' 51c write(k,1)'% facteur d''agrandissement resp.' 52c write(k,1)'% dans la direction x et y' 53c write(k,1)'% du dessin initial' 54c write(k,1)' ' 55 write(k,1)'/zoomx 1. def' 56 write(k,1)'/zoomy 1. def' 57c write(k,1)' ' 58c write(k,1)'% tex permet d''inserer un dessin postscript' 59c write(k,1)'%' 60c write(k,1)'% si latex est vrai => showdessin est faux ' 61c write(k,1)'% Pour utilisation avec dvi2ps faire :' 62c write(k,1)'% latex faux et showdessin vrai' 63c write(k,1)'% -----------------------------------------' 64 write(k,1)'/latex dup where {pop true}{false} ifelse def' 65 write(k,1)'/showdessin latex not def' 66c write(k,1)' ' 67c write(k,1)'% kadre permet d''encadrer le dessin' 68c write(k,1)' ' 69 if (kadre) then 70 write(k,1)'/kadre true def' 71 else 72 write(k,1)'/kadre false def' 73 endif 74c write(k,1)'%' 75c write(k,1)'% fin des variables postscript modifiables' 76c write(k,1)'% ----------------------------------------' 77 call signat(strng,j) 78 if (signe) then 79 if (longfich.le.0) then 80 write(k,1)'/texte ( '//strng(1:j)//' ) def' 81 else 82 if (albion) then 83 write(k,1)'/texte ( '//strng(1:j)// 84 & ', file: '//nomfich(1:longfich)//') def' 85 else 86 write(k,1)'/texte ( '//strng(1:j)// 87 & ', fich: '//nomfich(1:longfich)//') def' 88 endif 89 endif 90 else 91 if (longfich.le.0) then 92 write(k,1)'% /texte ( '//strng(1:j)//' ) def' 93 else 94 if (albion) then 95 write(k,1)'% /texte ( '//strng(1:j)// 96 & ', file: '//nomfich(1:longfich)//') def' 97 else 98 write(k,1)'% /texte ( '//strng(1:j)// 99 & ', fich: '//nomfich(1:longfich)//') def' 100 endif 101 endif 102 endif 103 write(k,3)'/hx',nint(hx*1000.) 104 write(k,3)'/hy',nint(hy*1000.) 105 write(k,3)'/xpapier',nint(xpapier) 106 write(k,3)'/ypapier',nint(ypapier) 107c write(k,1)'% -------- Debut des definition des macros ----------' 108c write(k,1)'%' 109c write(k,1)'% x2 y2 x1 y2 sg ;' 110c write(k,1)'% trace le segment (x1,y1) (x2,y2)' 111c write(k,1)'% x2 y2 x1 y2 sge ;' 112c write(k,1)'% efface et trace le segment (x1,y1) (x2,y2)' 113c write(k,1)'% d x1 y1 .... xn yn gris f ;' 114c write(k,1)'% remplie le contour de la couleur gris' 115c write(k,1)'%' 116c write(k,1)'% jeux sens taille lf' 117c write(k,1)'% load la font : jeux,sens,taille' 118c write(k,1)'% sens en degres' 119c write(k,1)'% 0<jeux<36' 120c write(k,1)'% epais type dt ;' 121c write(k,1)'% definit type trait et l''epaisseur en mm' 122cc write(k,1)'% newdessin' 123cc write(k,1)'% imprime la page et redessine la banniere' 124cc write(k,1)'% si le mode n''est pas latex ' 125c write(k,1)'% inc : met le clipping sur le rectangle 0 hx 0 hy' 126c write(k,1)'% xmin xmax ymin ymax hdc : met' 127c write(k,1)'% le clipping sur le rectangle xmin xmax ymin ymax' 128c write(k,1)'% initf3d : initialise f3d' 129c write(k,1)'% finf3d : termine f3d' 130 write(k,1)'/ptcm 0.0283464566929134 def' 131 write(k,1)'/cm {ptcm mul} def' 132c write(k,1)'%' 133 write(k,1)'/rec {newpath 4 copy 8 1 roll moveto' 134 write(k,1)' 3 -1 roll lineto 4 2 roll exch' 135 write(k,1)' lineto lineto closepath} bind def' 136 write(k,1)'/police [' 137 write(k,1)' (Courier)' 138 write(k,1)' (NewCenturySchlbk-Italic)' 139 write(k,1)' (Bookman-LightItalic)' 140 write(k,1)' (Helvetica)' 141 write(k,1)' (Courier-Bold)' 142 write(k,1)' (Helvetica-Narrow-Bold)' 143 write(k,1)' (Courier-BoldOblique)' 144 write(k,1)' (Times-Italic)' 145 write(k,1)' (Times-Bold)' 146 write(k,1)' (NewCenturySchlbk-Roman)' 147 write(k,1)' (Helvetica-Narrow-Oblique)' 148 write(k,1)' (Bookman-DemiItalic)' 149 write(k,1)' (Symbol)' 150 write(k,1)' (Bookman-Demi)' 151 write(k,1)' (Helvetica-BoldOblique)' 152 write(k,1)' (Bookman-Light)' 153 write(k,1)' (Helvetica-Oblique)' 154 write(k,1)' (AvantGarde-Book)' 155 write(k,1)' (AvantGarde-DemiOblique)' 156 write(k,1)' (AvantGarde-BookOblique)' 157 write(k,1)' (AvantGarde-Demi)' 158 write(k,1)' (Helvetica-Narrow)' 159 write(k,1)' (ZapfChancery-MediumItalic)' 160 write(k,1)' (Courier-Oblique)' 161 write(k,1)' (NewCenturySchlbk-BoldItalic)' 162 write(k,1)' (Helvetica-Bold)' 163 write(k,1)' (Times-Roman)' 164 write(k,1)' (Times-BoldItalic)' 165 write(k,1)' (Helvetica-Narrow-BoldOblique)' 166 write(k,1)' (NewCenturySchlbk-Bold)' 167 write(k,1)' (Palatino-Bold)' 168 write(k,1)' (Courier)' 169 write(k,1)' (Palatino-Italic)' 170 write(k,1)' (Palatino-Roman)' 171 write(k,1)' (Palatino-BoldItalic)' 172 write(k,1)' (ZapfDingbats)' 173 write(k,1)' ] def' 174 write(k,1)'/#findfont /findfont load def % save real findfont' 175 write(k,1) 176 &'% redefined findfont to make accented characters available' 177 write(k,1)'/findfont {' 178 write(k,1) 179 & 'dup #findfont dup /Encoding get 8#340 get /.notdef eq {' 180 write(k,1)'12 dict begin' 181 write(k,1)'/newcodesandnames [' 182 write(k,1)'8#200 /aacute' 183 write(k,1)'8#201 /aring' 184 write(k,1)'8#202 /atilde' 185 write(k,1)'8#203 /iacute' 186 write(k,1)'8#204 /igrave' 187 write(k,1)'8#205 /ntilde' 188 write(k,1)'8#206 /oacute' 189 write(k,1)'8#207 /ograve' 190 write(k,1)'8#210 /otilde' 191 write(k,1)'8#211 /scaron' 192 write(k,1)'8#212 /uacute' 193 write(k,1)'8#213 /ydieresis' 194 write(k,1)'8#214 /zcaron' 195 write(k,1)'8#215 /Aacute' 196 write(k,1)'8#216 /Aring' 197 write(k,1)'8#217 /Atilde' 198 write(k,1)'8#220 /Iacute' 199 write(k,1)'8#221 /Igrave' 200 write(k,1)'8#222 /Ntilde' 201 write(k,1)'8#223 /Oacute' 202 write(k,1)'8#224 /Ograve' 203 write(k,1)'8#225 /Otilde' 204 write(k,1)'8#226 /Scaron' 205 write(k,1)'8#227 /Uacute' 206 write(k,1)'8#230 /Ydieresis' 207 write(k,1)'8#231 /Zcaron' 208 write(k,1)'8#232 /plusminus' 209 write(k,1)'8#233 /mu' 210 write(k,1)'8#300 /Acircumflex' 211 write(k,1)'8#311 /Adieresis' 212 write(k,1)'8#314 /Agrave' 213 write(k,1)'8#321 /Ccedilla' 214 write(k,1)'8#322 /Eacute' 215 write(k,1)'8#323 /Ecircumflex' 216 write(k,1)'8#324 /Edieresis' 217 write(k,1)'8#325 /Egrave' 218 write(k,1)'8#326 /Icircumflex' 219 write(k,1)'8#327 /Idieresis' 220 write(k,1)'8#330 /Ocircumflex' 221 write(k,1)'8#331 /Odieresis' 222 write(k,1)'8#332 /Ucircumflex' 223 write(k,1)'8#333 /Udieresis' 224 write(k,1)'8#334 /Ugrave' 225 write(k,1)'8#335 /acircumflex' 226 write(k,1)'8#336 /adieresis' 227 write(k,1)'8#337 /agrave' 228 write(k,1)'8#340 /ccedilla' 229 write(k,1)'8#342 /eacute' 230 write(k,1)'8#344 /ecircumflex' 231 write(k,1)'8#345 /edieresis' 232 write(k,1)'8#346 /egrave' 233 write(k,1)'8#347 /icircumflex' 234 write(k,1)'8#354 /idieresis' 235 write(k,1)'8#355 /ocircumflex' 236 write(k,1)'8#356 /odieresis' 237 write(k,1)'8#357 /ucircumflex' 238 write(k,1)'8#360 /udieresis' 239 write(k,1)'8#362 /ugrave' 240 write(k,1)'] def' 241 write(k,1)'/basefontdict exch def /newfontname exch def' 242 write(k,1)'/newfont basefontdict maxlength dict def' 243 write(k,1)'basefontdict { exch dup /FID ne {' 244 write(k,1)'dup /Encoding eq {exch 256 array copy}{exch} ifelse' 245 write(k,1)'newfont 3 1 roll put } { pop pop } ifelse } forall' 246 write(k,1)'newfont /FontName newfontname put' 247 write(k,1)'newcodesandnames aload pop' 248 write(k,1)'newcodesandnames length 2 idiv' 249 write(k,1)'{newfont /Encoding get 3 1 roll put}' 250 write(k,1)'repeat newfontname newfont definefont end}{exch pop}' 251 write(k,1)'ifelse' 252 write(k,1)'} bind def' 253 write(k,1)'/lf {dup matrix scale exch matrix rotate' 254 write(k,1)' matrix concatmatrix' 255 write(k,1)' exch police exch get findfont' 256 write(k,1)' exch makefont setfont} bind def' 257 write(k,1)'/g {setgray} bind def' 258 write(k,1)'/c {setrgbcolor} bind def' 259 if (icol.eq.0) then 260 write(k,1)'/B {1 setgray} bind def' 261 write(k,1)'/N {0 setgray} bind def' 262 else 263 write(k,1)'/B {1 1 1 setrgbcolor} bind def' 264 write(k,1)'/N {0 0 0 setrgbcolor} bind def' 265 write(k,1)'/Ro {1 0 0 setrgbcolor} bind def' 266 write(k,1)'/Ve {0 1 0 setrgbcolor} bind def' 267 write(k,1)'/Bl {0 0 1 setrgbcolor} bind def' 268 write(k,1)'/Cy {0 1 1 setrgbcolor} bind def' 269 if (ipapercolor.eq.0) then 270 write(k,1)'/Ja {1 1 0 setrgbcolor} bind def' 271 else 272 write(k,1)'/Ja {0.9 0.6 0 setrgbcolor} bind def' 273 endif 274 write(k,1)'/Ma {1 0 1 setrgbcolor} bind def' 275 endif 276 write(k,1)'/C {closepath} bind def' 277 write(k,1)'/s {stroke} bind def' 278 write(k,1)'/m {moveto} bind def' 279 write(k,1)'/l {lineto} bind def' 280 write(k,1)'/matrice1 {matini setmatrix ccx cm ccy cm translate' 281 write(k,1)' angle rotate echelle cm dup scale' 282 write(k,1)' hx 2 div neg' 283 write(k,1)' hy 2 div neg translate} def' 284 write(k,1)'/matrice {matini setmatrix ' 285 write(k,1)' ccx decxcm add cm' 286 write(k,1)' ccy decycm add cm translate' 287 write(k,1)' angle rotate echelle cm dup scale' 288 write(k,1)' zoomx zoomy scale' 289 write(k,1)' hx 2 div neg hy 2 div neg translate} def' 290 write(k,1)'/cadre {currentlinewidth 2 div neg dup' 291 write(k,1)' hx exch sub' 292 write(k,1)' currentlinewidth 2 div neg dup' 293 write(k,1)' hy exch sub rec} def' 294 write(k,1)'/showcadre {gsave initclip matrice1 kadre' 295 write(k,1)' {.05 setlinewidth [] 0 setdash' 296 if (icol.eq.0) then 297 write(k,1)' 0. setgray cadre stroke}' 298 else 299 write(k,1)' 0. 0. 0. setrgbcolor cadre stroke}' 300 endif 301 write(k,1)' if grestore} def' 302 write(k,1)'/S {moveto lineto stroke} bind def' 303c if (icol.eq.0) then 304c write(k,1)'/sge {moveto lineto gsave 1. setgray' 305c else 306c write(k,1)'/sge {moveto lineto gsave 1. 1. 1. setrgbcolor' 307c endif 308c write(k,1)' [] 0 setdash stroke grestore stroke} def' 309 if (icol.eq.0) then 310 write(k,1)'/d {currentgray mark} bind def' 311 write(k,1)'/f {setgray newpath moveto' 312 write(k,1)' counttomark 2 idiv {lineto} repeat' 313 write(k,1)' closepath fill cleartomark setgray} bind def' 314 write(k,1)'/F {setgray newpath moveto' 315 write(k,1)' counttomark 2 idiv {lineto} repeat' 316 write(k,1)' closepath gsave fill grestore cleartomark' 317 write(k,1)' setgray stroke} bind def' 318 write(k,1)'/q {setgray' 319 write(k,1)' 4 copy' 320 write(k,1)' 3 1 roll exch 4 2 roll 5 2 roll 3 -1 roll exch' 321 write(k,1)' 5 1 roll 4 2 roll' 322 write(k,1)' newpath moveto' 323 write(k,1)' counttomark 2 idiv {lineto} repeat' 324 write(k,1)' closepath fill cleartomark setgray} bind def' 325 write(k,1)'/Q {setgray' 326 write(k,1)' 4 copy' 327 write(k,1)' 3 1 roll exch 4 2 roll 5 2 roll 3 -1 roll exch' 328 write(k,1)' 5 1 roll 4 2 roll' 329 write(k,1)' newpath moveto' 330 write(k,1)' counttomark 2 idiv {lineto} repeat' 331 write(k,1)' closepath gsave fill grestore cleartomark' 332 write(k,1)' setgray stroke} bind def' 333 else 334 write(k,1)'/d {currentrgbcolor mark} bind def' 335 write(k,1)'/f {setrgbcolor newpath moveto' 336 write(k,1)' counttomark 2 idiv {lineto} repeat' 337 write(k,1)' closepath fill cleartomark setrgbcolor} bind def' 338 write(k,1)'/F {setrgbcolor newpath moveto' 339 write(k,1)' counttomark 2 idiv {lineto} repeat' 340 write(k,1)' closepath gsave fill grestore cleartomark' 341 write(k,1)' setrgbcolor stroke} bind def' 342 write(k,1)'/q {setrgbcolor' 343 write(k,1)' 4 copy' 344 write(k,1)' 3 1 roll exch 4 2 roll 5 2 roll 3 -1 roll exch' 345 write(k,1)' 5 1 roll 4 2 roll' 346 write(k,1)' newpath moveto' 347 write(k,1)' counttomark 2 idiv {lineto} repeat' 348 write(k,1)' closepath fill cleartomark setrgbcolor} bind def' 349 write(k,1)'/Q {setrgbcolor' 350 write(k,1)' 4 copy' 351 write(k,1)' 3 1 roll exch 4 2 roll 5 2 roll 3 -1 roll exch' 352 write(k,1)' 5 1 roll 4 2 roll' 353 write(k,1)' newpath moveto' 354 write(k,1)' counttomark 2 idiv {lineto} repeat' 355 write(k,1)' closepath gsave fill grestore cleartomark' 356 write(k,1)' setrgbcolor stroke} bind def' 357 endif 358 write(k,1)'/inc {matrice1 initclip 0 hx 0 hy rec' 359 write(k,1)' clip newpath matrice} bind def' 360 write(k,1)'/hdc {inc rec clip newpath} bind def' 361 write(k,1)'/aller {3 copy 3 1 roll moveto currentlinewidth' 362 write(k,1)' exch dup .1 mul setlinewidth} bind def' 363 write(k,1)'/seg0 {aller dup neg 0 exch 0 rmoveto rlineto' 364 write(k,1)' stroke setlinewidth} bind def' 365 write(k,1)'/seg1 {aller .70711 mul dup dup neg dup rmoveto' 366 write(k,1)' rlineto stroke setlinewidth} bind def' 367 write(k,1)'/seg2 {aller dup neg 0 exch 0 4 1 roll rmoveto' 368 write(k,1)' rlineto stroke setlinewidth} bind def' 369 write(k,1)'/seg3 {aller .70711 mul neg dup neg dup dup neg' 370 write(k,1)' rmoveto rlineto stroke setlinewidth} bind def' 371 write(k,1) 372 &'/seg4 {aller 1.414213 mul dup dup neg .5 mul dup rmoveto' 373 write(k,1) ' rlineto stroke setlinewidth} bind def' 374 write(k,1) 375 &'/seg5 {aller 1.414213 mul neg dup neg dup .5 mul dup neg' 376 write(k,1) ' rmoveto rlineto stroke setlinewidth} bind def' 377 write(k,1) '/seg6 {aller 2 mul dup neg 0 exch .5 mul 0' 378 write(k,1) ' rmoveto rlineto stroke setlinewidth} bind def' 379 write(k,1) 380 &'/seg7 {aller 2 mul dup neg 0 exch .5 mul 0 4 1 roll' 381 write(k,1) ' rmoveto rlineto stroke setlinewidth} bind def' 382 write(k,1) '/Mc {aller 1.77245 mul neg dup 0 exch 0 exch dup neg' 383 write(k,1) ' dup 0 exch 0 exch dup .5 mul neg dup' 384 write(k,1) ' rmoveto rlineto rlineto rlineto rlineto' 385 write(k,1) ' stroke setlinewidth pop pop pop} bind def' 386 write(k,1) '/MC {aller 1.77245 mul neg dup 0 exch 0 exch dup neg' 387 write(k,1) ' dup 0 exch 0 exch dup .5 mul neg dup' 388 write(k,1) ' rmoveto rlineto rlineto rlineto rlineto' 389 write(k,1) ' fill stroke setlinewidth pop pop pop} bind def' 390 write(k,1) 391 &'/Ml {aller 1.25331 mul neg dup neg dup neg dup dup neg' 392 write(k,1) ' dup neg dup neg dup dup neg 0' 393 write(k,1) ' rmoveto rlineto rlineto rlineto rlineto' 394 write(k,1) ' stroke setlinewidth pop pop pop} bind def' 395 write(k,1) 396 &'/ML {aller 1.25331 mul neg dup neg dup neg dup dup neg' 397 write(k,1) ' dup neg dup neg dup dup neg 0' 398 write(k,1) ' rmoveto rlineto rlineto rlineto rlineto' 399 write(k,1) ' fill stroke setlinewidth pop pop pop} bind def' 400 write(k,1) '/Mt {aller 2.2 mul neg dup neg .5 mul 0 exch dup dup' 401 write(k,1) 402 &' 1.73205 mul neg exch dup dup 1.73205 mul exch neg dup' 403 write(k,1) ' .57735 mul rmoveto rlineto rlineto rlineto' 404 write(k,1) ' stroke setlinewidth pop pop pop} bind def' 405 write(k,1) '/MT {aller 2.2 mul neg dup neg .5 mul 0 exch dup dup' 406 write(k,1) 407 &' 1.73205 mul neg exch dup dup 1.73205 mul exch neg dup' 408 write(k,1) ' .57735 mul rmoveto rlineto rlineto rlineto' 409 write(k,1) ' fill stroke setlinewidth pop pop pop} bind def' 410 write(k,1) '/Mt2 {aller 2.2 mul dup neg .5 mul 0 exch dup dup' 411 write(k,1) 412 &'1.73205 mul neg exch dup dup 1.73205 mul exch neg dup .57735 mul' 413 write(k,1) ' rmoveto rlineto rlineto rlineto' 414 write(k,1) ' stroke setlinewidth pop pop pop} bind def' 415 write(k,1) '/MT2 {aller 2.2 mul dup neg .5 mul 0 exch dup dup' 416 write(k,1) 417 &'1.73205 mul neg exch dup dup 1.73205 mul exch neg dup' 418 write(k,1) ' .57735 mul rmoveto rlineto rlineto rlineto' 419 write(k,1) ' fill stroke setlinewidth pop pop pop} bind def' 420 write(k,1) '/Mp {seg6 seg7 pop pop pop} bind def' 421 write(k,1) '/Mx {seg4 seg5 pop pop pop} bind def' 422 write(k,1)'/Ms {3 copy Mp Mx} bind def' 423 write(k,1)'/MV {pop pop pop} bind def' 424 write(k,1)'/R {currentlinewidth 4 1 roll dup .1 mul' 425 write(k,1)' setlinewidth 0 360 arc stroke' 426 write(k,1)' setlinewidth} bind def' 427 write(k,1)'/R2 {0 360 arc stroke} bind def' 428 write(k,1)'/r {0 360 arc fill} bind def' 429 write(k,1)'/E {dup 5 1 roll stringwidth' 430 write(k,1)' 2 index neg mul 3 index add exch' 431 write(k,1)' 2 index neg mul 4 index add exch' 432 write(k,1)' moveto pop pop pop show newpath} bind def' 433 write(k,1)'/cartouche{/dessin dessin 1 add def latex not' 434 write(k,1)' {gsave initgraphics 1 cm 1 cm scale' 435 if (signe) then 436 if (longfich.gt.256) then 437 write(k,1)' 24 0 80 lf' 438 write(k,1)' 500 500 moveto' 439 elseif (longfich.gt.64) then 440 write(k,1)' 24 0 150 lf' 441 if (longfich.le.96) then 442 write(k,1)' 4000 500 moveto' 443 else 444 write(k,1)' 500 500 moveto' 445 endif 446 else 447 write(k,1)' 24 0 350 lf' 448 if (longfich.eq.0) then 449 write(k,1)' 7000 500 moveto' 450 elseif (longfich.le.16) then 451 write(k,1)' 6000 500 moveto' 452 elseif (longfich.le.32) then 453 write(k,1)' 5000 500 moveto' 454 elseif (longfich.le.48) then 455 write(k,1)' 3000 500 moveto' 456 else 457 write(k,1)' 500 500 moveto' 458 endif 459 endif 460 write(k,1)' texte show' 461 endif 462 write(k,1)' grestore} if} def' 463 write(k,1)'/typetrait [[]' 464 write(k,1)' [30 70]' 465 write(k,1)' [100]' 466 write(k,1)' [50 70 200 70]' 467 write(k,1)' [150 70]' 468 write(k,1)' [30 30 30 80]' 469 write(k,1)' [30 50 30 50 150 50]' 470 write(k,1)' [250 70]] bind def' 471 write(k,1)'/dt {dup 0 lt {pop pop}' 472 write(k,1)' {exch dup 0.1 mul setlinewidth /LW exch def' 473 write(k,1)' 8 mod typetrait exch get /tt exch def' 474 write(k,1) 475 &'[ 0 1 tt length 1 sub {tt exch get LW mul 0.005 mul} for ]' 476 write(k,1)' 0 setdash} ifelse} def' 477cc write(k,1) 478cc &'/dt {dup 0 lt {pop}{8 mod typetrait exch get 0 setdash}' 479cc write(k,1)' ifelse' 480cc write(k,1)' dup 0 lt {pop}{.1 mul setlinewidth}' 481cc write(k,1)' ifelse} bind def' 482cc write(k,1)'/newdessin {showdessin ' 483cc write(k,1)' {gsave showpage grestore' 484cc write(k,1)' showcadre cartouche} if} def' 485 write(k,1)'/initialise {gsave /initCPU usertime def' 486 write(k,1)' /dessin 1 def /matini matrix currentmatrix def' 487 write(k,1)' latex' 488 write(k,1)' {/echelle' 489 write(k,1)' hhx hx angle cos mul abs' 490 write(k,1)' hy angle sin mul abs add div' 491 write(k,1)' hhy hx angle sin mul abs' 492 write(k,1)' hy angle cos mul abs add div' 493 write(k,1)' 2 copy' 494 write(k,1)' gt {exch} if pop' 495 write(k,1)' def' 496 write(k,1)' /xmin 0. def' 497 write(k,1)' /xmax hx def' 498 write(k,1)' /ymin 0. def' 499 write(k,1)' /ymax hy def' 500c write(k,1)'%-- position du cadre dans le rectangle' 501 write(k,1)' currentpoint' 502 write(k,1)' /ccy exch ptcm div def' 503 write(k,1)' /ccx exch ptcm div def' 504 write(k,1)' }' 505 write(k,1)' {/echelle 1 def' 506 write(k,1)' /xmin 0. def' 507 write(k,1)' /xmax hx def' 508 write(k,1)' /ymin 0. def' 509 write(k,1)' /ymax hy def' 510 write(k,1)' /ccx xpapier 2 div def' 511 write(k,1)' /ccy ypapier 2 div def' 512c write(k,1)'% position du centre du rectangle' 513c write(k,1)'% sur la feuille en cm' 514 write(k,1)' }' 515 write(k,1)' ifelse' 516 write(k,1)' /dessin 0 def' 517 write(k,1)' matrice' 518 write(k,1)' showcadre' 519 write(k,1)' cartouche' 520 write(k,1)' inc' 521 write(k,1)' } def' 522cc write(k,1)'/finf3d {grestore} def' 523cc write(k,1)' ' 524Cfj write(k,1)'% fin des definitions PostScript' 525Cfj write(k,1)'% ----------------------------------------------------' 526Cfj write(k,1)'% Programmeurs: Hecht, Saltel, Josserond (INRIA) 88-91' 527Cfj write(k,1)'% F.Jouve (CMAP-X) plein de modifs 91-95' 528Cfj write(k,1)'% ----------------------------------------------------' 529 write(k,1)'%%EndProlog' 530 write(k,1)'initialise' 531 write(k,1)'%%Pages: 1' 532c 533 ifonte_courante_ps = 8 534 angle_texte = 0. 535 taille_texte = .65*amin1(taille_x,taille_y)/19. 536 ityp_ligne = 0 537 epais_ligne = .2*amin1(taille_x,taille_y)/19. 538 write(ilaser_file,1000) ifonte_courante_ps,angle_texte 539 & ,nint(taille_texte*1000) 540 1000 format(i2,f6.2,i6,' lf') 541cc 1000 format(i2,2f6.2,' lf') 542 if (icol.eq.0) then 543 write(ilaser_file,'(a1)') 'N' 544 else 545 write(ilaser_file,'(a2)') 'Ro' 546 icoul_eff = 1 547 endif 548 write(ilaser_file,'(a)') '0 setlinecap' 549 write(ilaser_file,'(a)') '1 setlinejoin' 550 write(ilaser_file,'(i4,a)') nint(1000*epais_ligne),' 0 dt' 551 ityp_ligne_pend = 0 552 epais_ligne_pend = epais_ligne 553c 554 end 555