doc/pst-anamorphosis-add.tex

   1 %% This work may be distributed and/or modified under the
   2 %% conditions of the LaTeX Project Public License, either version 1.3
   3 %% of this license or (at your option) any later version.
   4 %% The latest version of this license is in
   5 %%   http://www.latex-project.org/lppl.txt
   6 %% and version 1.3 or later is part of all distributions of LaTeX
   7 %% version 2003/12/01 or later.
   8
   9 \csname PSTANAMORPHOSISAddLoaded\endcsname
  10 \let\PSTANAMORPHOSISAddLoaded\endinput
  11 % Requires some packages
  12 \ifx\PSTANAMORPHOSISLoaded\endinput\else \input pst-anamorphosis \fi
  13 \ifx\PSTnodesLoaded\endinput\else\input pst-node \fi
  14 \ifx\MultidoLoaded\endinput\else \input multido.tex \fi
  15 \ifx\PSTXKeyLoaded\endinput\else  \input pst-xkey \fi
  16 \def\fileversion{0.3}
  17 \def\filedate{2011/10/19}
  18 \message{`PSTANAMORPHOSISAdd' v\fileversion, \filedate}
  19
  20
  21 \edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
  22 \SpecialCoor
  23 \psset{dimen=middle}
  24 %
  25 \pst@def{optionsanamorphosisAdd}<%
  26 \psk@Anamorphose@translate
  27  /t@@y exch unit def
  28  /t@@x exch unit def
  29 >
  30
  31 % Built from \psline
  32 \def\pslineA{\pst@object{pslineA}}
  33 \def\pslineA@i{%
  34 \addto@pscode{
  35     \tx@optionsanamorphosis
  36     \tx@optionsanamorphosisAdd
  37           }%
  38   \pst@getarrows{%
  39     \begin@OpenObj
  40     \pst@getcoors[\pslineA@ii%
  41   }%
  42 }
  43 \def\pslineA@ii{%
  44   \ifx\pslinestyle\psls@@symbol\addto@pscode{ \psls@symbol SymbolLine }%
  45   \else%
  46   \addto@pscode{
  47      ] /lespoints ED
  48 /n1 lespoints length 2 div cvi def % nbre de points
  49 /i 0 def
  50 /TableauPoints [
  51 n1 {
  52     [ lespoints i get
  53       lespoints i 1 add get
  54     ]
  55   /i i 2 add def
  56   }repeat
  57   ] def
  58 % Tableau general des points
  59 /TAB [
  60 0 1 n1 2 sub {/i ED
  61   TableauPoints i get aload pop
  62   /Y1 ED /X1 ED
  63   TableauPoints i 1 add get aload pop
  64   /Y2 ED /X2 ED
  65 0 0.005 1.0 { % k
  66     /K exch def
  67     [
  68     K X2 mul 1 K sub X1 mul add
  69     K Y2 mul 1 K sub Y1 mul add
  70     tx@anamorphosisPathDict begin Anamorphose end
  71   ]
  72     } for
  73 } for
  74 ] def
  75 /n2 TAB length def
  76 [0 1 n2 1 sub {
  77     /compteur exch def
  78     TAB compteur get aload pop
  79     } for
  80 %      \ifPst@noCurrentPoint\else\pst@cp\fi       % current point?
  81       \pslineA@iii % arc and lineto type
  82       \tx@Line    % .pro function
  83     }%
  84   \fi%
  85   \end@OpenObj%
  86 }
  87 \def\pslineA@iii{
  88   \ifdim\pslinearc>\z@
  89     /r \pst@number\pslinearc def
  90     /Lineto { \tx@Arcto } def
  91   \else
  92     /Lineto /lineto load def
  93   \fi
  94   \ifshowpoints true \else false \fi
  95   \tx@setlinejoin                       %
  96 }%
  97 %
  98 \def\pscircleA{\def\pst@par{}\pst@object{pscircleA}}
  99 \def\pscircleA@i{\@ifnextchar({\pscircleA@do}{\pscircleA@do(0,0)}}
 100 \def\pscircleA@do(#1)#2{%
 101     \begin@ClosedObj
 102     \pst@@getcoor{#1}%
 103     \pssetlength\pst@dimc{#2}%
 104     \def\pst@linetype{4}%
 105     \addto@pscode{
 106     \tx@optionsanamorphosis
 107     \tx@optionsanamorphosisAdd
 108       \pst@coor /yC exch def /xC exch def
 109       \ifPst@SpecialLength \pst@SpecialLength \else \pst@number\pst@dimc \fi
 110       \psk@dimen CLW mul sub
 111       /rayon exch def
 112       rayon xC add yC
 113       tx@anamorphosisPathDict begin Anamorphose end
 114       moveto
 115       0 1 360 {/iA exch def
 116        iA cos rayon mul xC add
 117        iA sin rayon mul yC add
 118        tx@anamorphosisPathDict begin Anamorphose end
 119        lineto
 120        } for
 121       \ifPst@variableLW \pst@flattenpath \fi
 122       closepath
 123     }%
 124     \showpointsfalse
 125     \end@ClosedObj
 126     }%
 127 %
 128 \def\psbezierA{\pst@object{psbezierA}}
 129 \def\psbezierA@i{%
 130 \addto@pscode{
 131     \tx@optionsanamorphosis
 132     \tx@optionsanamorphosisAdd
 133           }
 134   \pst@getarrows{%
 135     \begin@OpenObj
 136       \pst@getcoors[\psbezierA@ii%
 137   }%
 138 }
 139 \def\psbezierA@ii{%
 140   \addto@pscode{
 141      ] /lespoints ED
 142     [0 2 lespoints length 2 sub {/iP ED
 143   lespoints iP get
 144   lespoints iP 1 add get
 145   tx@anamorphosisPathDict begin Anamorphose end
 146   } for
 147     \ifPst@noCurrentPoint\else\pst@cp\fi
 148     \ifshowpoints true \else false \fi
 149     \ifx\pslinestyle\psls@@symbol \psls@symbol OpenSymbolBezier
 150     \else
 151       \tx@OpenBezier
 152       \ifshowpoints \tx@BezierShowPoints \fi
 153     \fi
 154   }%
 155   \def\pst@linetype{1}%
 156   \ifx\pslinestyle\psls@@symbol\def\pslinestyle{none}\fi%
 157   \end@OpenObj}
 158 %
 159 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 160 \def\pscurveA{\pst@object{pscurveA}}
 161 \def\pscurveA@i{%
 162 \addto@pscode{
 163     \tx@optionsanamorphosis
 164     \tx@optionsanamorphosisAdd
 165           }
 166   \pst@getarrows{%
 167     \begin@OpenObj
 168       \pst@getcoors[\pscurveA@ii% \pst@coors on stack
 169     }%
 170 }
 171 \def\pscurveA@ii{%
 172   \addto@pscode{
 173      ] /lespoints ED
 174   [0 2 lespoints length 2 sub {/iP ED
 175   lespoints iP get
 176   lespoints iP 1 add get
 177   tx@anamorphosisPathDict begin Anamorphose end
 178   } for
 179     \ifPst@noCurrentPoint\else\pst@cp\fi                % current point
 180     \psk@curvature\space /c ED /b ED /a ED
 181     \ifshowpoints true \else false \fi
 182     \ifx\pslinestyle\psls@@symbol \psls@symbol OpenSymbolCurve \else \tx@OpenCurve \fi
 183     \ifPst@variableLW \pst@flattenpath \fi
 184   }%
 185   \ifx\pslinestyle\psls@@symbol\def\pslinestyle{none}\fi%
 186   \end@OpenObj%
 187 }
 188 %
 189 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 190 \def\psccurveA{\pst@object{psccurveA}}
 191 \def\psccurveA@i{%
 192 \addto@pscode{
 193     \tx@optionsanamorphosis
 194     \tx@optionsanamorphosisAdd
 195           }
 196   \pst@getarrows{%
 197     \begin@OpenObj
 198       \pst@getcoors[\psccurveA@ii% \pst@coors on stack
 199     }%
 200 }
 201 \def\psccurveA@ii{%
 202   \addto@pscode{
 203      ] /lespoints ED
 204   [0 2 lespoints length 2 sub {/iP ED
 205   lespoints iP get
 206   lespoints iP 1 add get
 207   tx@anamorphosisPathDict begin Anamorphose end
 208   } for
 209     \ifPst@noCurrentPoint\else\pst@cp\fi                % current point
 210     \psk@curvature\space /c ED /b ED /a ED
 211     \ifshowpoints true \else false \fi
 212     \ifx\pslinestyle\psls@@symbol \psls@symbol ClosedSymbolCurve \else \tx@ClosedCurve \fi
 213     \ifPst@variableLW \pst@flattenpath \fi
 214   }%
 215   \ifx\pslinestyle\psls@@symbol\def\pslinestyle{none}\fi%
 216   \end@OpenObj%
 217 }
 218 %
 219 \def\pnodeA{\def\pst@par{}\pst@object{pnodeA}}
 220 \def\pnodeA@i(#1)#2{{%
 221 \pst@@getcoor{#1}%
 222 \pnode(!
 223       \tx@optionsanamorphosis
 224       \tx@optionsanamorphosisAdd
 225       \pst@coor
 226   tx@anamorphosisPathDict begin Anamorphose end
 227   \pst@number\psyunit div exch
 228   \pst@number\psxunit div exch
 229   ){#2}}%
 230 \ignorespaces%
 231 }
 232 %
 233 \def\movetoA{\def\pst@par{}\pst@object{movetoA}}
 234 \def\movetoA@i(#1){{%
 235 \pst@@getcoor{#1}%
 236 \addto@pscode{
 237     \tx@optionsanamorphosis
 238     \tx@optionsanamorphosisAdd
 239  \pst@coor
 240 tx@anamorphosisPathDict begin Anamorphose end
 241     moveto}}}%
 242 %
 243 % choix de la police et de la taille des caracteres en cm !!
 244 \define@key[psset]{pst-anamorphosis}{PSfont}{\def\pst@Anamorphose@PSfont{/#1 }}
 245 \define@key[psset]{pst-anamorphosis}{fontsize}{\def\pst@Anamorphose@fontsize{#1 }}
 246 %\define@key[psset]{pst-anamorphosis}{RotationAngleText}{\edef\psk@Anamorphose@RotationAngleText{#1 }}%
 247 \psset[pst-anamorphosis]{PSfont=Times-Roman,fontsize=35}%,RotationAngleText=0}
 248
 249 \def\pstextA{\def\pst@par{}\pst@object{pstextA}}
 250 \def\pstextA@i{\@ifnextchar({\pstextA@do}{\pstextA@do(0,0)}}
 251 \def\pstextA@do(#1)#2{%  #2 = texte à transformer
 252 \begingroup%
 253   \begin@SpecialObj%
 254   \pst@@getcoor{#1}%
 255 \addto@pscode{
 256     \pst@coor /t@@y ED /t@@x ED % Translate
 257     \tx@optionsanamorphosis
 258 /fontsize {\pst@Anamorphose@fontsize } bind def
 259 /PSfont {\pst@Anamorphose@PSfont} def
 260 %/RotationAngleText \psk@Anamorphose@RotationAngleText def
 261 %% D'après un fichier original de
 262 %%(c) P. Kleiweg 1997
 263 %% adapté par :
 264 %% Manuel Luque
 265 %% Arnaud Schmittbuhl
 266 %% Jean-Paul Vignault
 267 %% les commentaires sont de Jean-Paul Vignault
 268 %% juin 2006
 269 %% Caractères accentués
 270 /ReEncode { exch findfont
 271 dup length dict begin { 1 index /FID eq {pop pop} {def} ifelse
 272 }forall /Encoding ISOLatin1Encoding def currentdict end definefont
 273 pop }bind def
 274 /Font PSfont /ISOfont ReEncode /ISOfont def
 275 %% decalage en picas du texte en
 276 %% dessous de la ligne y=0
 277 %% la procedure de base pour la transformation des points du chemin
 278  /warp {
 279 3 dict begin
 280  tx@anamorphosisPathDict begin Anamorphose end
 281 end
 282 } bind def
 283 %% pour remplacer 'move'
 284 /warpmove{
 285    %% on teste le booleen place 2 tokens plus en avant sur la pile
 286    %% si c'est 'true', alors on en est au 1er appel => on initialise
 287    %% le chemin
 288    2 index {
 289       newpath
 290    } if
 291    %% puis on applique warp a notre point
 292    warp  moveto
 293    %% on enleve le 'true' pour mettre un 'false' a la place
 294    pop false
 295 } bind def
 296 %% pour remplacer 'lineto
 297 /warpline {
 298    warp lineto
 299 } bind def
 300 %% pour remplacer 'curveto'
 301 /warpcurve {
 302    6 2 roll warp
 303    6 2  roll warp
 304    6 2 roll warp
 305    curveto
 306 }  bind def
 307 %% 'warpit' declenche la transformation du chemin courant
 308 /warpit {
 309 true
 310 { warpmove } {  warpline } { warpcurve } { closepath } pathforall
 311 pop
 312 }  bind def
 313 %% definition des differentes constantes
 314 % taille de des caracteres
 315 Font findfont fontsize  scalefont setfont
 316 /warptxt (#2) def  % texte a deformer
 317 /warpwidth warptxt stringwidth pop def % largeur horizontale du texte
 318 /warphalf warpwidth 2 div def          % demi-largeur horizontale
 319 %% le chemin constitue avec la chaine de caracteres
 320 warptxt warphalf neg 0 moveto   %% on se deplace (init chemin)
 321 true charpath   %% on cree le chemin
 322 %% maintenant on y va
 323 warpit                  %% on applique le pathforall
 324 gsave
 325 \pst@usecolor\psfillcolor
 326     fill
 327 grestore
 328 stroke
 329 % le texte dans le cercle
 330 t@@x t@@y translate
 331 s@@x s@@y scale
 332 warptxt warphalf neg 0 moveto  %% on se deplace (init chemin)
 333 true charpath
 334 gsave
 335 \pst@usecolor\psfillcolor
 336     fill
 337 grestore
 338 stroke
 339   }%
 340   \end@SpecialObj%
 341 \endgroup%
 342 }
 343
 344
 345
 346 %% =============================================================================
 347 %% AFP : Anamorphose à partir d'un Fichier PST.
 348 %% Le code de pscustom est évalué après reroutage de la macro. Il est exécuté
 349 %% dans le contexte tx@anamorphosisPathDict
 350 %% =============================================================================
 351 %% Début et Fin
 352 \def\pst@begin@AFP{\xdef\pst@code{\pst@code
 353   tx@anamorphosisPathDict begin
 354   \tx@optionsanamorphosis
 355   \tx@optionsanamorphosisAdd\space}}
 356 \def\pst@end@AFP{\xdef\pst@code{\pst@code end\space}}
 357 %% pscustom adapté à la tâche
 358 \def\pscustomAFP{\def\pst@par{}\pst@object{pscustomAFP}}
 359 \long\def\pscustomAFP@i#1{%
 360   \begin@SpecialObj%
 361     \pst@begin@AFP%
 362     \the\pst@customAFPdefs
 363     \setbox\pst@hbox=\hbox{#1}%
 364     \psk@fillstyle%
 365     \pst@stroke%
 366     \pst@end@AFP%
 367   \end@SpecialObj}
 368 %% pscustomdefs associé
 369 \newtoks\pst@customAFPdefs
 370 \pst@customAFPdefs{%
 371   \def\moveto(#1){\pst@@getcoor{#1}\addto@pscode{\pst@coor moveto}}%
 372   \def\psline(#1){\pst@@getcoor{#1}\addto@pscode{\pst@coor lineto}}%
 373   \def\closepath{\addto@pscode{closepath}}%
 374   \def\newpath{\addto@pscode{newpath}}%
 375   \def\stroke{\def\pst@par{}\pst@object{stroke}}%
 376   \def\fill{\def\pst@par{}\pst@object{fill}}%
 377 }
 378 \def\AFP#1{%
 379   \begingroup
 380     \def\curvetoinv{\pst@getcoors{\space}\fcurvetoinv}
 381     \def\fcurvetoinv{\addto@pscode{curvetoinv}}
 382     \let\SAUVEpscustom\pscustom
 383     \let\SAUVEpsbezier\psbezier
 384     \let\pscustom\pscustomAFP
 385     \let\psbezier\curvetoinv
 386     \input{#1}
 387     \let\psbezier\SAUVEpsbezier
 388     \let\pscustom\SAUVEpscustom
 389   \endgroup%
 390 }%
 391 %%%% Fin de AFP %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%