%% This work may be distributed and/or modified under the
%% conditions of the LaTeX Project Public License, either version 1.3
%% of this license or (at your option) any later version.
%% The latest version of this license is in
%%   http://www.latex-project.org/lppl.txt
%% and version 1.3 or later is part of all distributions of LaTeX
%% version 2003/12/01 or later.

\csname PSTANAMORPHOSISAddLoaded\endcsname
\let\PSTANAMORPHOSISAddLoaded\endinput
% Requires some packages
\ifx\PSTANAMORPHOSISLoaded\endinput\else \input pst-anamorphosis \fi
\ifx\PSTnodesLoaded\endinput\else\input pst-node \fi
\ifx\MultidoLoaded\endinput\else \input multido.tex \fi
\ifx\PSTXKeyLoaded\endinput\else  \input pst-xkey \fi
\def\fileversion{0.2}
\def\filedate{2011/10/13}
\message{`PSTANAMORPHOSISAdd' v\fileversion, \filedate}


\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
\SpecialCoor
\psset{dimen=middle}
%
\pst@def{optionsanamorphosisAdd}<%
\psk@Anamorphose@translate
 /t@@y exch unit def
 /t@@x exch unit def
>

% Built from \psline
\def\pslineA{\pst@object{pslineA}}
\def\pslineA@i{%
\addto@pscode{
    \tx@optionsanamorphosis
    \tx@optionsanamorphosisAdd
          }%
  \pst@getarrows{%
    \begin@OpenObj
    \pst@getcoors[\pslineA@ii%
  }%
}
\def\pslineA@ii{%
  \ifx\pslinestyle\psls@@symbol\addto@pscode{ \psls@symbol SymbolLine }%
  \else%
  \addto@pscode{
     ] /lespoints ED
/n1 lespoints length 2 div cvi def % nbre de points
/i 0 def
/TableauPoints [
n1 {
    [ lespoints i get
      lespoints i 1 add get
    ]
  /i i 2 add def
  }repeat
  ] def
% Tableau general des points
/TAB [
0 1 n1 2 sub {/i ED
  TableauPoints i get aload pop
  /Y1 ED /X1 ED
  TableauPoints i 1 add get aload pop
  /Y2 ED /X2 ED
0 0.01 1.0 { % k
    /K exch def
    [
    K X2 mul 1 K sub X1 mul add
    K Y2 mul 1 K sub Y1 mul add
    tx@anamorphosisPathDict begin Anamorphose end
  ]
    } for
} for
] def
/n2 TAB length def
[0 1 n2 1 sub {
    /compteur exch def
    TAB compteur get aload pop
    } for
%      \ifPst@noCurrentPoint\else\pst@cp\fi 	  % current point?
      \pslineA@iii % arc and lineto type
      \tx@Line	  % .pro function
    }%
  \fi%
  \end@OpenObj%
}
\def\pslineA@iii{
  \ifdim\pslinearc>\z@
    /r \pst@number\pslinearc def
    /Lineto { \tx@Arcto } def
  \else
    /Lineto /lineto load def
  \fi
  \ifshowpoints true \else false \fi
  \tx@setlinejoin 			%
}%
%
\def\pscircleA{\def\pst@par{}\pst@object{pscircleA}}
\def\pscircleA@i{\@ifnextchar({\pscircleA@do}{\pscircleA@do(0,0)}}
\def\pscircleA@do(#1)#2{%
    \begin@ClosedObj
    \pst@@getcoor{#1}%
    \pssetlength\pst@dimc{#2}%
    \def\pst@linetype{4}%
    \addto@pscode{
      \pst@coor /yC exch def /xC exch def
      \ifPst@SpecialLength \pst@SpecialLength \else \pst@number\pst@dimc \fi
      \psk@dimen CLW mul sub /rayon exch def
      rayon xC add yC
      tx@anamorphosisPathDict begin Anamorphose end
      moveto
      0 1 360 {/iA exch def
       iA cos rayon mul xC add
       iA sin rayon mul yC add
       tx@anamorphosisPathDict begin Anamorphose end
       lineto
       } for
      \ifPst@variableLW \pst@flattenpath \fi
      closepath
    }%
    \showpointsfalse
    \end@ClosedObj
    }%
%
\def\psbezierA{\pst@object{psbezierA}}
\def\psbezierA@i{%
\addto@pscode{
    \tx@optionsanamorphosis
    \tx@optionsanamorphosisAdd
          }
  \pst@getarrows{%
    \begin@OpenObj
      \pst@getcoors[\psbezierA@ii%
  }%
}
\def\psbezierA@ii{%
  \addto@pscode{
     ] /lespoints ED
    [0 2 lespoints length 2 sub {/iP ED
  lespoints iP get
  lespoints iP 1 add get
  tx@anamorphosisPathDict begin Anamorphose end
  } for
    \ifPst@noCurrentPoint\else\pst@cp\fi
    \ifshowpoints true \else false \fi
    \ifx\pslinestyle\psls@@symbol \psls@symbol OpenSymbolBezier
    \else
      \tx@OpenBezier
      \ifshowpoints \tx@BezierShowPoints \fi
    \fi
  }%
  \def\pst@linetype{1}%
  \ifx\pslinestyle\psls@@symbol\def\pslinestyle{none}\fi%
  \end@OpenObj}
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\def\pscurveA{\pst@object{pscurveA}}
\def\pscurveA@i{%
\addto@pscode{
    \tx@optionsanamorphosis
    \tx@optionsanamorphosisAdd
          }
  \pst@getarrows{%
    \begin@OpenObj
      \pst@getcoors[\pscurveA@ii% \pst@coors on stack
    }%
}
\def\pscurveA@ii{%
  \addto@pscode{
     ] /lespoints ED
  [0 2 lespoints length 2 sub {/iP ED
  lespoints iP get
  lespoints iP 1 add get
  tx@anamorphosisPathDict begin Anamorphose end
  } for
    \ifPst@noCurrentPoint\else\pst@cp\fi		% current point
    \psk@curvature\space /c ED /b ED /a ED
    \ifshowpoints true \else false \fi
    \ifx\pslinestyle\psls@@symbol \psls@symbol OpenSymbolCurve \else \tx@OpenCurve \fi
    \ifPst@variableLW \pst@flattenpath \fi
  }%
  \ifx\pslinestyle\psls@@symbol\def\pslinestyle{none}\fi%
  \end@OpenObj%
}
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\def\psccurveA{\pst@object{psccurveA}}
\def\psccurveA@i{%
\addto@pscode{
    \tx@optionsanamorphosis
    \tx@optionsanamorphosisAdd
          }
  \pst@getarrows{%
    \begin@OpenObj
      \pst@getcoors[\psccurveA@ii% \pst@coors on stack
    }%
}
\def\psccurveA@ii{%
  \addto@pscode{
     ] /lespoints ED
  [0 2 lespoints length 2 sub {/iP ED
  lespoints iP get
  lespoints iP 1 add get
  tx@anamorphosisPathDict begin Anamorphose end
  } for
    \ifPst@noCurrentPoint\else\pst@cp\fi		% current point
    \psk@curvature\space /c ED /b ED /a ED
    \ifshowpoints true \else false \fi
    \ifx\pslinestyle\psls@@symbol \psls@symbol ClosedSymbolCurve \else \tx@ClosedCurve \fi
    \ifPst@variableLW \pst@flattenpath \fi
  }%
  \ifx\pslinestyle\psls@@symbol\def\pslinestyle{none}\fi%
  \end@OpenObj%
}
%
\def\pnodeA{\def\pst@par{}\pst@object{pnodeA}}
\def\pnodeA@i(#1)#2{{%
\pst@@getcoor{#1}%
\pnode(!
      \tx@optionsanamorphosis
      \tx@optionsanamorphosisAdd
      \pst@coor
  tx@anamorphosisPathDict begin Anamorphose end
  \pst@number\psyunit div exch
  \pst@number\psxunit div exch
  ){#2}}%
\ignorespaces%
}
%
\def\movetoA{\def\pst@par{}\pst@object{movetoA}}
\def\movetoA@i(#1){{%
\pst@@getcoor{#1}%
\addto@pscode{
    \tx@optionsanamorphosis
    \tx@optionsanamorphosisAdd
 \pst@coor
tx@anamorphosisPathDict begin Anamorphose end
    moveto}}}%
%
% choix de la police et de la taille des caracteres en cm !!
\define@key[psset]{pst-anamorphosis}{PSfont}{\def\pst@Anamorphose@PSfont{/#1 }}
\define@key[psset]{pst-anamorphosis}{fontsize}{\def\pst@Anamorphose@fontsize{#1 }}
%\define@key[psset]{pst-anamorphosis}{RotationAngleText}{\edef\psk@Anamorphose@RotationAngleText{#1 }}%
\psset[pst-anamorphosis]{PSfont=Times-Roman,fontsize=35}%,RotationAngleText=0}

\def\pstextA{\def\pst@par{}\pst@object{pstextA}}
\def\pstextA@i{\@ifnextchar({\pstextA@do}{\pstextA@do(0,0)}}
\def\pstextA@do(#1)#2{%  #2 = texte à transformer
\begingroup%
  \begin@SpecialObj%
  \pst@@getcoor{#1}%
\addto@pscode{
    \pst@coor /t@@y ED /t@@x ED % Translate
    \tx@optionsanamorphosis
/fontsize {\pst@Anamorphose@fontsize } bind def
/PSfont {\pst@Anamorphose@PSfont} def
%/RotationAngleText \psk@Anamorphose@RotationAngleText def
%% D'après un fichier original de
%%(c) P. Kleiweg 1997
%% adapté par :
%% Manuel Luque
%% Arnaud Schmittbuhl
%% Jean-Paul Vignault
%% les commentaires sont de Jean-Paul Vignault
%% juin 2006
%% Caractères accentués
/ReEncode { exch findfont
dup length dict begin { 1 index /FID eq {pop pop} {def} ifelse
}forall /Encoding ISOLatin1Encoding def currentdict end definefont
pop }bind def
/Font PSfont /ISOfont ReEncode /ISOfont def
%% decalage en picas du texte en
%% dessous de la ligne y=0
%% la procedure de base pour la transformation des points du chemin
 /warp {
3 dict begin
 tx@anamorphosisPathDict begin Anamorphose end
end
} bind def
%% pour remplacer 'move'
/warpmove{
   %% on teste le booleen place 2 tokens plus en avant sur la pile
   %% si c'est 'true', alors on en est au 1er appel => on initialise
   %% le chemin
   2 index {
      newpath
   } if
   %% puis on applique warp a notre point
   warp  moveto
   %% on enleve le 'true' pour mettre un 'false' a la place
   pop false
} bind def
%% pour remplacer 'lineto
/warpline {
   warp lineto
} bind def
%% pour remplacer 'curveto'
/warpcurve {
   6 2 roll warp
   6 2  roll warp
   6 2 roll warp
   curveto
}  bind def
%% 'warpit' declenche la transformation du chemin courant
/warpit {
true
{ warpmove } {  warpline } { warpcurve } { closepath } pathforall
pop
}  bind def
%% definition des differentes constantes
% taille de des caracteres
Font findfont fontsize  scalefont setfont
/warptxt (#2) def  % texte a deformer
/warpwidth warptxt stringwidth pop def % largeur horizontale du texte
/warphalf warpwidth 2 div def          % demi-largeur horizontale
%% le chemin constitue avec la chaine de caracteres
warptxt warphalf neg 0 moveto   %% on se deplace (init chemin)
true charpath   %% on cree le chemin
%% maintenant on y va
warpit                  %% on applique le pathforall
gsave
\pst@usecolor\psfillcolor
    fill
grestore
stroke
% le texte dans le cercle
t@@x t@@y translate
s@@x s@@y scale
warptxt warphalf neg 0 moveto  %% on se deplace (init chemin)
true charpath
gsave
\pst@usecolor\psfillcolor
    fill
grestore
stroke
  }%
  \end@SpecialObj%
\endgroup%
} 



%% =============================================================================
%% AFP : Anamorphose à partir d'un Fichier PST.
%% Le code de pscustom est évalué après reroutage de la macro. Il est exécuté
%% dans le contexte tx@anamorphosisPathDict
%% =============================================================================
%% Début et Fin
\def\pst@begin@AFP{\xdef\pst@code{\pst@code
  tx@anamorphosisPathDict begin
  \tx@optionsanamorphosis
  \tx@optionsanamorphosisAdd\space}}
\def\pst@end@AFP{\xdef\pst@code{\pst@code end\space}}
%% pscustom adapté à la tâche
\def\pscustomAFP{\def\pst@par{}\pst@object{pscustomAFP}}
\long\def\pscustomAFP@i#1{%
  \begin@SpecialObj%
    \pst@begin@AFP%
    \the\pst@customAFPdefs
    \setbox\pst@hbox=\hbox{#1}%
    \psk@fillstyle%
    \pst@stroke%
    \pst@end@AFP%
  \end@SpecialObj}
%% pscustomdefs associé
\newtoks\pst@customAFPdefs
\pst@customAFPdefs{%
  \def\moveto(#1){\pst@@getcoor{#1}\addto@pscode{\pst@coor moveto}}%
  \def\psline(#1){\pst@@getcoor{#1}\addto@pscode{\pst@coor lineto}}%
  \def\closepath{\addto@pscode{closepath}}%
  \def\newpath{\addto@pscode{newpath}}%
  \def\stroke{\def\pst@par{}\pst@object{stroke}}%
  \def\fill{\def\pst@par{}\pst@object{fill}}%
}
\def\AFP#1{%
  \begingroup
    \def\curvetoinv{\pst@getcoors{\space}\fcurvetoinv}
    \def\fcurvetoinv{\addto@pscode{curvetoinv}}
    \let\SAUVEpscustom\pscustom
    \let\SAUVEpsbezier\psbezier
    \let\pscustom\pscustomAFP
    \let\psbezier\curvetoinv
    \input{#1}
    \let\psbezier\SAUVEpsbezier
    \let\pscustom\SAUVEpscustom
  \endgroup%
}%
%%%% Fin de AFP %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
