[pstricks] psEllipticArc

[Christophe Jorssen]

Hello,

I don't know exactly what pstricks-add does but here is a piece of code
Denis gave me a few months ago (according to him, it is nearly the code that
will be included in patch 15 of pstricks).

Hope it helps

Kristof

% Code from "pstricks.tex" 0.94 beta (TvZ)
\def\psellipticarcn{\def\pst at par{}\pst at object{psellipticarcn}}
\def\psellipticarcn at i{\let\if at psarcn\iftrue\psellipticarc at ii}
\def\psellipticarc{\def\pst at par{}\pst at object{psellipticarc}}
\def\psellipticarc at i{\let\if at psarcn\iffalse\psellipticarc at ii}
\let\if at psarcn\iffalse
\def\psellipticarc at ii{\pst at getarrows\psellipticarc at iii}
\def\psellipticarc at iii(#1){%
  \@ifnextchar({\psellipticarc at iv(#1)}{\psellipticarc at iv(0,0)(#1)}}
\def\psellipticarc at iv(#1)(#2)#3#4{%
  \begin at OpenObj
    \pst at getcoor{#1}\pst at tempa
    \pst at getcoor{#2}\pst at tempb
    \pst at getangle{#3}\pst at tempc
    \pst at getangle{#4}\pst at tempd
    \addto at pscode{\psellipticarc at definearg \psellipticarc at draw}%
    \showpointsfalse
  \end at OpenObj}
\def\psellipticarc at definearg{%
  \pst at tempa /y ED /x ED  % Origin
  \pst at tempb              % radii. Now adjust:
  \ifdim\psk at dimen\p@=\z@\else
    \psk at dimen CLW mul dup 3 1 roll
    sub 3 1 roll sub exch
  \fi
  /ry ED /rx ED
  /angleA
    \pst at tempc dup \psk at arcsepA \tx at ArcAdjust
    \if at psarcn sub \else add \fi
  def
  /angleB
    \pst at tempd dup \psk at arcsepB \tx at ArcAdjust
    \if at psarcn add \else sub \fi
  def
  \ifshowpoints\psellipticarc at showpoints\fi
  \ifx\psk at arrowA\@empty
    \ifnum\psk at liftpen=2
      angleA cos rx mul x add
      angleA sin ry mul y add
      moveto
    \fi
  \fi}
\def\psellipticarc at draw{%
  0 0 1
  angleA
  \ifx\psk at arrowA\@empty\else
    { ArrowA CP }
    { \if at psarcn sub \else add \fi }
    \tx at EllipticArcArrow
  \fi
  angleB
  \ifx\psk at arrowB\@empty\else
    { ArrowB }
    { \if at psarcn add \else sub \fi }
    \tx at EllipticArcArrow
  \fi
  /mtrx CM def
  x y T
  rx ry scale
  \if at psarcn arcn \else arc \fi
  mtrx setmatrix}
\def\psellipticarc at showpoints{%
  gsave
    /mtrx CM def
    x y T
    rx ry scale
    0 0 moveto
    0 0 1 \pst at tempc \pst at tempd
    \ifcase\psarc at type arc \or arcn \fi
    closepath
    mtrx setmatrix
    CLW 2 div SLW
    [ \psk at dash\space ] 0 setdash stroke
  grestore }
\pst at def{ArcAdjust}<%
  57.2958 mul exch
  dup sin rx mul dup mul exch
  cos ry mul dup mul
  add sqrt div>
\pst at def{EllipticArcArrow}<%
  /d ED      % add/sub
  /b ED      % arrow procedure
  /a1 ED     % angle
  gsave
    newpath
    0 -1000 moveto
    clip                  % Set clippath far from arrow.
    newpath
    0 1 0 0 b             % Draw arrow to determine length.
  grestore
  % Length of arrow is on top of stack. Next 3 numbers are junk.
  a1 exch \tx at ArcAdjust   % Angle by which to adjust for arrow length.
  a1 exch d /a2 ED        % Angular position of base of arrow.
  pop pop pop
  a2 cos rx mul x add
  a2 sin ry mul y add
  a1 cos rx mul x add
  a1 sin ry mul y add
  % Now arrow tip coor and base coor are on stack.
  b pop pop pop pop       % Draw arrow, and discard coordinates.
  a2 dup CLW 8 div \tx at ArcAdjust neg d>  % Adjust angle to give overlap.