root/trunk/pst-map3d/pstricks-add.tex

%% $Id: pstricks-add.tex 7 2007-12-29 22:21:13Z herbert $
%%
%%
%% This is file `pstricks-add.tex',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pstricks-add.tex'
%%
%% Dominique Rodriguez <DR _at_ pstricks.de>
%% Herbert Voss <Herbert.Voss _at_ pstricks.de>
%%
%% This program can be redistributed and/or modified under the terms
%% of the LaTeX Project Public License Distributed from CTAN archives
%% in directory macros/latex/base/lppl.txt.
%%
%% DESCRIPTION:
%%   `pstricks-add' is a PSTricks package for additionals to the standard
%%         pstricks package
%%
\csname PSTricksAddLoaded\endcsname
\let\PSTricksAddLoaded\endinput
%
% Requires some packages
\ifx\PSTricksLoaded\endinput\else\input pstricks \fi
\ifx\PSTplotLoaded\endinput\else \input pst-plot \fi
\ifx\PSTnodesLoaded\endinput\else\input pst-node \fi
\ifx\PSTthreeDLoaded\endinput\else\input pst-3d \fi
\ifx\MultidoLoaded\endinput\else \input multido  \fi
\ifx\PSTXKeyLoaded\endinput\else \input pst-xkey \fi
%
\def\fileversion{3.00}
\def\filedate{2008/01/01}
\message{`pstricks-add' v\fileversion, \filedate\space (dr,hv)}
%
\edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax
\SpecialCoor
\pst@addfams{pstricks-add}
%
%% prologue for postcript
\pstheader{pstricks-add.pro}%
%\pstheader{pst-algparser.pro}%  done by pstricks.tex
%
%-------------------------------- pstricks ------------------------------------
%
%%%%%%% \begin{pspicture} %%%%%%%%%%%%%%%%%%%
\newdimen\pst@dimm%
\newdimen\pst@dimn%
\newdimen\pst@dimo%
\newdimen\pst@dimp%
\newcount\pst@cntm%
\newcount\pst@cntn%
\newcount\pst@cnto%
\newcount\pst@cntp%
%\psset{dx=0}%
%\psset{dy=0}%
\newcount\@zero\@zero=0\relax
\chardef\f@ur=4
%
\def\psPiFour{12.566371}
\def\psPiTwo{6.283185}
\def\psPi{3.14159265}
\def\psPiH{1.570796327}
\newdimen\pstRadUnit
\newdimen\pstRadUnitInv
\pstRadUnit=1.047198cm % this is pi/3
\pstRadUnitInv=0.95493cm % this is 3/pi
%
\def\pst@getdimdim#1 #2 #3\@nil{%
  \def\pst@tempA{#2}%
  \ifx\pst@tempA\@empty
    \pssetlength\pst@dimn{#1}%
    \pst@dimm=\z@%
  \else%
    \pssetlength\pst@dimm{#1}%
    \pssetlength\pst@dimn{#2}%
  \fi%
}
\def\pst@getxdimdim#1 #2 #3\@nil{%
  \def\pst@tempA{#2}%
  \ifx\pst@tempA\@empty
    \pssetxlength\pst@dimn{#1}%
    \pst@dimm=\z@
  \else%
    \pssetxlength\pst@dimm{#1}%
    \pssetxlength\pst@dimn{#2}%
  \fi%
}
\def\pst@getydimdim#1 #2 #3\@nil{%
  \def\pst@tempA{#2}
  \ifx\pst@tempA\@empty
    \pssetylength\pst@dimn{#1}
    \pst@dimm=\z@
  \else
    \pssetylength\pst@dimm{#1}%
    \pssetylength\pst@dimn{#2}%
  \fi%
}
%
% stolen from latex.ltx to make it TeX compatible
%
\def\@fornoop#1\@@#2#3{}
\long\def\@for#1:=#2\do#3{%
  \expandafter\def\expandafter\@fortmp\expandafter{#2}%
  \ifx\@fortmp\@empty \else
    \expandafter\@forloop#2,\@nil,\@nil\@@#1{#3}\fi}
\long\def\@forloop#1,#2,#3\@@#4#5{\def#4{#1}\ifx #4\@nnil \else
       #5\def#4{#2}\ifx #4\@nnil \else#5\@iforloop #3\@@#4{#5}\fi\fi}
\long\def\@iforloop#1,#2\@@#3#4{\def#3{#1}\ifx #3\@nnil
       \expandafter\@fornoop \else
      #4\relax\expandafter\@iforloop\fi#2\@@#3{#4}}
\def\psforeach#1#2#3{%
  \begingroup
    \edef\reserved@a{#2}%
    \@for#1:=\reserved@a\do{#3}%
  \endgroup%
}
%
% A modulo macro for integer values
% \pst@mod{34}{6}\value ==> \value is 4
%
\def\pst@mod#1#2#3{%
  \begingroup%
  \pst@cntm=#1\pst@cntn=#2\relax%
  \pst@cnto=\pst@cntm%
  \divide\pst@cntm by \pst@cntn%
  \multiply\pst@cntn by \pst@cntm%
  \advance\pst@cnto by -\pst@cntn%
  \edef\value{\endgroup\def\noexpand#3{\number\pst@cnto}}\value%
}
\def\pst@max#1#2#3{%
  \begingroup%
  \pst@cntm=#1\pst@cntn=#2\relax%
  \ifnum\pst@cntm<\pst@cntn\pst@cntm=\pst@cntn\fi
  \global#3=\the\pst@cntm%
  \endgroup%
}
\def\pst@maxdim#1#2#3{%
  \begingroup%
  \pst@dimm=#1\pst@dimn=#2\relax%
  \ifdim\pst@dimm<\pst@dimn\pst@dimm=\pst@dimn\fi
  \global#3=\the\pst@dimm%
  \endgroup%
}
\def\pst@abs#1#2{%
  \begingroup%
  \pst@cntm=#1\relax%
  \ifnum\pst@cntm<\z@\pst@cntm=-\pst@cntm\fi%
  \global#2=\the\pst@cntm
  \endgroup%
}
\def\pst@absdim#1#2{%
  \begingroup%
  \pst@dimm=#1\relax%
  \ifdim\pst@dimm<\z@\pst@dimm=-\pst@dimm\fi%
  \global#2=\the\pst@dimm%
  \endgroup%
}
%
%--------------------------------------- small stuff -------------------------------
\define@boolkey[psset]{pstricks-add}[Pst@]{CMYK}[true]{}
\psset[pstricks-add]{CMYK=true}
%
\def\defineTColor{\@ifnextchar[{\defineTColor@i}{\defineTColor@i[]}}
\def\defineTColor@i[#1]#2#3{%     "semi transparency colors"
  \def\pst@tempA{#1}%
  \newpsstyle{#2}{%
     fillstyle=vlines,hatchwidth=0.1\pslinewidth,
     hatchsep=1\pslinewidth,hatchcolor=#3}%
  \ifx\pst@tempA\@empty\else\psset{#1}\fi%
}
\defineTColor{TRed}{red}
\defineTColor{TGreen}{green}
\defineTColor{TBlue}{blue}
%
\define@key[psset]{pstricks-add}{fsAngle}{\pst@getangle{#1}\pst@fsAngle }
\define@key[psset]{pstricks-add}{fsOrigin}{%
  \pst@@getcoor{#1}\edef\pst@fsOrigin{\pst@coor T }}
\psset[pstricks-add]{fsOrigin={0,0},fsAngle=137.50775}
%
\def\psfs@spiral{\pst@fill{\pst@fsOrigin \pst@usecolor\psfillcolor clip newpath
0 .1 500 { dup dup sqrt 4 div 0 360 arc fill \pst@fsAngle rotate } for }}
%
\def\rmultiput{\def\pst@par{}\pst@ifstar{\@ifnextchar[{\rmultiput@i}{\rmultiput@i[]}}}
\def\rmultiput@i[#1]{\begingroup\psset{#1}\rmultiput@ii}
\def\rmultiput@ii#1{\def\@rmultiputArg{#1}%
  \@ifnextchar({\rmultiput@iii}{\rmultiput@iii(\z@,\z@)}}
\def\rmultiput@iii(#1){%
  \pst@killglue%
  \if@star\rput*(#1){\@rmultiputArg}
  \else\rput(#1){\@rmultiputArg}\fi
  \@ifnextchar({\rmultiput@iii}{\endgroup}%
}

% #1: (x,y)  #2: rotAngle   #3: object
\def\psrotate{\pst@object{psrotate}}
\def\psrotate@i(#1)#2{%
  \pst@killglue
  \begingroup%
  \use@par\pst@makebox{\psrotate@ii(#1){#2}}}
\def\psrotate@ii(#1)#2{%
  \pst@getcoor{#1}\pst@tempA%
  \pst@getangle{#2}\pst@tempB%
  \leavevmode%
  \pst@Verb{% 
     { \pst@tempA /yRot ED /xRot ED 
       \pst@tempB dup cos /cosA ED sin /sinA ED
       /ax cosA def
       /by sinA def
       /cx sinA neg def
       /dy cosA def
       /ex xRot cosA mul neg xRot add yRot sinA mul add def
       /fy xRot sinA mul neg yRot add yRot cosA mul sub def
       [ax by cx dy ex fy] concat } \tx@TMChange }%
    \box\pst@hbox%
  \pst@Verb{ \tx@TMRestore }\endgroup}
%
% [#1]: obtargs; (#2,#3): center; {#4}: factor; {#5}: object
\def\psHomothetie{\pst@object{psHomothetie}}
\def\psHomothetie@i(#1)#2{%
  \begin@SpecialObj%
  \pst@getcoor{#1}\pst@tempA% converts the coordinates without a unit into pt
  \pst@makebox{\psHomothetie@ii{#2}}}% put the contents into a box
\def\psHomothetie@ii#1{%
  \pst@Verb{%
    { \pst@tempA  /yH ED /xH ED  
      [#1 0 0 #1 #1 xH mul neg xH add #1 yH mul neg yH add] concat }
      \tx@TMChange }%
  \box\pst@hbox%
  \pst@Verb{\tx@TMRestore}%
  \end@SpecialObj}
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Begin patch TN; Date (YY-MM-DD): 04-07-17; first part
\define@key[psset]{}{dash}{%    defined in pstricks.tex
  \pst@expandafter\psset@@dash{#1}\@nil% Error handling for empty argument.
}
\define@key[psset]{pstricks-add}{maxdashes}{\def\psk@maxdashes{#1}}
%\psset{maxdashes=11}
\def\psset@@dash#1\@nil{%
 \def\psk@dash{}%
 % modification 04-08-07:
 \pst@cntm0
 \def\next##1 ##2\relax{%
   \expandafter\ifnum\psk@maxdashes>\pst@cntm\relax  % 04-08-07
     \edef\@tempa{##1}%
     \ifx\@tempa\@empty\else% gobble leading spaces
       \pssetlength\pst@dimc{##1}%
       \advance\pst@cntm by 1
       \edef\psk@dash{\psk@dash\space\pst@number\pst@dimc}%
     \fi%
     \edef\@tempa{##2}%
     \ifx\@tempa\@empty\else% detect end
       \ifx\@tempa\space\else% gobble trailing spaces
         \next##2\relax%
     \fi\fi%
   \else% 04-08-07
     \@pstrickserr{Number of dashes > \psk@maxdashes. Increasing 
        'maxdashes' might work.}\@ehpa% 04-08-07
   \fi% 04-08-07
 }%
\expandafter\next#1 \relax}
%% End patch TN; Date (YY-MM-DD): 04-07-17; 1st part
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%\psset{dash=5pt 3pt}% black white black white 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Begin patch TN; Date (YY-MM-DD): 04-07-17; 2nd part
\def\psls@dashed{%
  \ifpsdashadjust
    [ \psk@dash ] \pst@linetype\space \tx@DashLine
  \else
    [ \psk@dash ] 0 setdash stroke
  \fi}
%% End patch TN; Date (YY-MM-DD): 04-07-17; 2nd part
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%-----------------------------------------------------------------------------------
\pst@def{DashLine}<
    dup 0 gt
    { /a .5 def PathLength exch div }
    { pop /a 1 def PathLength } ifelse
    /b ED % pattern should fit evenly in b
    dup /X ED % pattern array
    0 get /y ED % length of first black segment
    /z 0 X {add} forall def % length of the full pattern
    %% Computation of the scaling factor as described by van Zandt:
    b a .5 sub 2 mul y mul sub z Div round
    z mul a .5 sub 2 mul y mul add b exch Div
    %%%% scaling factor on stack.
    /z ED %% now, z is the scaling factor
    false % for the length test below
    X { z mul } forall X astore %% modification TN 04-08-07
    %%% Checking whether at least one dash in X has positive length:
    {0 gt or} forall
    { X 1 a sub y mul }
    { [ 1 0 ] 0 }
    ifelse
    setdash stroke >
%% TN end patch; Date (YY-MM-DD): 04-07-17;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
\define@key[psset]{pstricks-add}{intSeparator}{\def\psk@intSeparator{#1}}
%\psset{intSeparator={,}}
%
\def\psFormatInt{\def\pst@par{}\pst@object{psFormatInt}}
\def\psFormatInt@i#1{{%
  \pst@killglue
  \use@par
  \count1=#1\count2=\count1
  \ifnum\count1=0 0\else
    \ifnum\count1>999999
    \count3=\count1
    \divide\count3 by 1000000
    \the\count3\psk@intSeparator\relax
    \multiply\count3 by 1000000
    \advance\count1 by -\count3 % modulo 1000000
  \fi%
  \ifnum\count2>999
    \count3=\count1
    \divide\count3 by 1000
    \ifnum\count2>99999
        \ifnum\count3<100 0\fi
        \ifnum\count3<10 0\fi
    \fi%
    \the\count3\psk@intSeparator\relax
    \multiply\count3 by 1000
    \advance\count1 by -\count3 %modulo 1000
  \fi%
  \ifnum\count2>999
    \ifnum\count1<100 0\fi
    \ifnum\count1<10 0\fi
  \fi%
  \the\count1
  \fi%
}\ignorespaces}
%
\define@key[psset]{pstricks-add}{braceWidth}{\pst@getlength{#1}\psk@braceWidth}
\define@key[psset]{pstricks-add}{bracePos}{\pst@checknum{#1}\psk@bracePos}
\define@key[psset]{pstricks-add}{braceWidthInner}{\pst@getlength{#1}\psk@braceWidthInner}
\define@key[psset]{pstricks-add}{braceWidthOuter}{\pst@getlength{#1}\psk@braceWidthOuter}
%
\def\psbrace{\pst@object{psbrace}}
\def\psbrace@i(#1)(#2)#3{%
  \addbefore@par{ref=lb,linewidth=0.01pt,fillstyle=solid,fillcolor=black}
  \begin@SpecialObj
  \if@star\def\pst@tempC{true }\else\def\pst@tempC{false }\fi
  \ifx\psk@rot\empty\def\psk@@rot{0}\else\let\psk@@rot\psk@rot\fi
  \def\psk@rot{Alpha \psk@@rot\space add 90 sub}%
  \pst@getcoor{#1}\pst@tempA
  \pst@getcoor{#2}\pst@tempB
  \rput(!
    /ifStar \pst@tempC def
    /radius1 \psk@braceWidthOuter def
    /radius2 \psk@braceWidthInner def
    /Alpha \pst@tempA \pst@tempB 3 -1 roll sub 3 1 roll exch sub atan def 
    /Length \pst@tempA \pst@tempB Pyth2 def
    /Left { Length \psk@bracePos\space mul } bind def
    /Right { Length Left sub } bind def
    /Width \psk@braceWidth def
    /pop4 { pop pop pop pop } def
    gsave
    [ Alpha cos Alpha sin Alpha sin neg Alpha cos \pst@tempA ] concat 
    0 0 moveto
    0 radius2 neg radius2 radius2 neg radius2 arcto pop4
    Left radius2 sub radius1 sub 0 rlineto 
    Left radius2 neg Left radius2 radius1 add neg radius1 arcto pop4
    currentpoint /y@Label ED /x@Label ED
    Left radius2 neg Left radius1 add radius2 neg radius1 arcto pop4
    Right radius2 sub radius1 sub 0 rlineto
    Length radius2 neg Length 0 radius2 arcto pop4
%    0 Width neg rlineto
    Length radius2 Width add neg Length radius2 sub radius2 Width add neg radius2 arcto pop4
    Right radius2 sub radius1 sub neg 0 rlineto
    Left radius1 add Width radius1 add radius2 add neg radius1 90 180 arc
    Left radius1 sub Width radius1 add radius2 add neg radius1 0 90 arc
    Left radius2 sub radius1 sub neg 0 rlineto 
    radius2 Width neg radius2 270 180 arcn
    0 0 lineto 
    gsave
    ifStar { \pst@usecolor\pslinecolor }{ \pst@usecolor\psfillcolor } ifelse fill 
    grestore
    0.01 setlinewidth \pst@usecolor\pslinecolor stroke
    0 0 moveto
    grestore
%   now calculate the label pos
    /Dh radius1 radius2 add Width add def
    \pst@tempA \pst@tempB 3 -1 roll sub 3 1 roll exch sub % dy dx 
    \psk@bracePos\space mul exch \psk@bracePos\space mul  % d'x d'y
    \pst@tempA 3 -1 roll add Dh Alpha cos mul sub         % d'x x yA
    \psk@nodesepB sub                                     % use minus sign to shidt right
    3 1 roll add Dh Alpha sin mul add \psk@nodesepA add 
    exch \tx@UserCoor ){#3}
  \end@SpecialObj}
%
% -------------- the arrow part -------------
%  the original table
% \def\pst@arrowtable{,<->,<<->>,>-<,>>-<<,(-),[-],)-(,]-[,|>-<|}
%
% v : Vee arrow (inside)                 v,V,f and F by Christophe FOUREY
% V : Vee arrow (outside)
% f : Filled vee arrow (inside)
% F : Filled vee arrow (outside)
\edef\pst@arrowtable{\pst@arrowtable,v-v,V-V,f-f,F-F,t-t,T-T}

% Vee arrow
\define@key[psset]{pstricks-add}{veearrowlength}{\pst@getlength{#1}\psk@veearrowlength}
\psset[pstricks-add]{veearrowlength=3mm} % default projected length
\define@key[psset]{pstricks-add}{veearrowangle}{\pst@getangle{#1}\psk@veearrowangle}
\psset[pstricks-add]{veearrowangle=30} % default angle
\define@key[psset]{pstricks-add}{veearrowlinewidth}{\pst@getlength{#1}\psk@veearrowlinewidth}
\psset[pstricks-add]{veearrowlinewidth=.35mm} % default vee arrow line width

% Filled vee arrow
\define@key[psset]{pstricks-add}{filledveearrowlength}{\pst@getlength{#1}\psk@filledveearrowlength}
\psset[pstricks-add]{filledveearrowlength=3mm} % default projected length
\define@key[psset]{pstricks-add}{filledveearrowangle}{\pst@getangle{#1}\psk@filledveearrowangle}
\psset[pstricks-add]{filledveearrowangle=15} % default angle
\define@key[psset]{pstricks-add}{filledveearrowlinewidth}{\pst@getlength{#1}\psk@filledveearrowlinewidth}
\psset[pstricks-add]{filledveearrowlinewidth=.35mm} % default vee arrow line width
\define@key[psset]{pstricks-add}{arrowLW}{\pst@getlength{#1}\psk@arrowLW}
% arrowLW as LineWidth for the circled line ends
%
\def\psas@o{\psk@arrowLW\space dup 0 eq { pop }{ SLW } ifelse
  {\pst@usecolor\psfillcolor true} false \psk@dotsize \tx@EndDot }
\@namedef{psas@*}{\psk@arrowLW\space dup 0 eq { pop }{ SLW } ifelse
  {\pst@usecolor\psfillcolor false} false \psk@dotsize \tx@EndDot}

\pst@def{VeeArrow}<%
    1 setlinecap            % round caps
    1 setlinejoin            % round join
    setlinewidth            % vee arrow line width
    /y ED                % projected length
    2 div /a ED                % angle (divide by 2)
    /t ED                % false = inside, true = outside
    a sin a cos div y mul /x ED        % perpendicular length : x=tan(a).y
    t { 1 -1 scale } if            % if outside : symmetry
    x neg y moveto            % point #1
    0 0 L                % point #2
    x y L                % point #3
    {closepath gsave fill grestore} if    % if filled : close and fill
    stroke                % draw line
    0 t {y 2 mul} {0} ifelse moveto>    % if outside : twice longer line

% VeeArrow : filled?   outside?   (total) angle   (projected) length   (arrow) line width

\@namedef{psas@v}{%
  false false \psk@veearrowangle \psk@veearrowlength \psk@veearrowlinewidth \tx@VeeArrow}
\@namedef{psas@V}{%
  false true \psk@veearrowangle \psk@veearrowlength \psk@veearrowlinewidth \tx@VeeArrow}
\@namedef{psas@f}{%
  true false \psk@filledveearrowangle \psk@filledveearrowlength \psk@filledveearrowlinewidth \tx@VeeArrow}
\@namedef{psas@F}{%
  true true \psk@filledveearrowangle \psk@filledveearrowlength \psk@filledveearrowlinewidth \tx@VeeArrow}

% And An another arrowhead
% architectural tick / oblique arrow

% Tick arrow
\define@key[psset]{pstricks-add}{tickarrowlength}{\pst@getlength{#1}\psk@tickarrowlength}
\psset[pstricks-add]{tickarrowlength=1.5mm} % default projected length
\define@key[psset]{pstricks-add}{tickarrowlinewidth}{\pst@getlength{#1}\psk@tickarrowlinewidth}
\psset[pstricks-add]{tickarrowlinewidth=.35mm} % default tick arrow line width

\pst@def{TickArrow}<%
    1 setlinecap            % round caps
    1 setlinejoin            % round join
    setlinewidth            % tick line width
    /y ED                % projected length
    /t ED                % false = normal, true = reversed
    t { 1 -1 scale } if            % if reversed : symmetry
    y neg y moveto            % point #1
    y y neg L                % point #2
    stroke                % draw line
    0 0 moveto>                % origin

\@namedef{psas@t}{ false \psk@tickarrowlength \psk@tickarrowlinewidth \tx@TickArrow }
\@namedef{psas@T}{ true \psk@tickarrowlength \psk@tickarrowlinewidth \tx@TickArrow }
%
% HookLeft/RightArrow
\newdimen\pshooklength
\newdimen\pshookwidth
\define@key[psset]{pstricks-add}{hooklength}{\pssetlength\pshooklength{#1}}
\define@key[psset]{pstricks-add}{hookwidth}{\pssetlength\pshookwidth{#1}}
%\psset{hooklength=3mm,hookwidth=1mm}
%
\edef\pst@arrowtable{\pst@arrowtable,H-H,h-h} % add new arrow
\def\tx@RHook{RHook }         % PostScript name
\def\tx@Rhook{Rhook }         % PostScript name
\@namedef{psas@H}{%
  /RHook {
    /x ED                     % hook width
    /y ED                     % hook length 
    /z CLW 2 div def          % save it
    x y moveto                % goto first point
    x 0 0 0 0 y 
    curveto                   % draw Bezier
    stroke 
    0 y moveto                % define current point
  } def
  \pst@number\pshooklength
  \pst@number\pshookwidth
  \tx@RHook 
}
\@namedef{psas@h}{%
  /Rhook {
    CLW mul                     % size * CLW
    add dup                     % +length  size*CLW+length size*CLW+length 
    2 div /w ED                 % (size*CLW+length)/2  -> w 
    mul dup /h ED mul           % (size*CLW+length)
    /a ED  
    w neg h abs moveto 0 0 L 
    gsave 
    stroke grestore 
  } def
  0 \psk@arrowlength \psk@arrowsize \tx@Rhook 
}
% New parameter "arrowfill", with default as "true"
\define@boolkey[psset]{pstricks-add}[ps]{ArrowFill}[true]{}
%
% Modification of the PostScript macro Arrow to choose to fill or not the arrow
% (it require to restore the current linewidth, despite of the scaling)
\pst@def{Arrow}<{%
    CLW mul add dup 2 div
    /w ED mul dup
    /h ED mul
    /a ED { 0 h T 1 -1 scale } if
    gsave
    \ifpsArrowFill\else\pst@number\pslinewidth \pst@arrowscale\space div SLW \fi
    w neg h moveto
    0 0 L w h L w neg a neg rlineto
    \ifpsArrowFill gsave fill grestore \else gsave closepath stroke grestore \fi
    grestore
    0 h a sub moveto
}>
%
\define@key[psset]{pstricks-add}{nArrowsA}{\def\psk@nArrowsA{#1}}
\define@key[psset]{pstricks-add}{nArrowsB}{\def\psk@nArrowsB{#1}}
\define@key[psset]{pstricks-add}{nArrows}{\def\psk@nArrowsA{#1}\def\psk@nArrowsB{#1}}
%\psset{nArrows=2}
%
\@namedef{psas@>>}{%
    \psk@nArrowsA\space 1 sub {
      false \psk@arrowinset \psk@arrowlength \psk@arrowsize \tx@Arrow
      0 h a sub T
    } repeat
    gsave
    newpath
    false \psk@arrowinset \psk@arrowlength \psk@arrowsize \tx@Arrow
    CP
    grestore
    moveto
}
%
\@namedef{psas@<<}{%
    true \psk@arrowinset \psk@arrowlength \psk@arrowsize \tx@Arrow
    0 h neg a add T
  \psk@nArrowsB\space 2 sub {
    false \psk@arrowinset \psk@arrowlength \psk@arrowsize \tx@Arrow
    0 h neg a add T
  } repeat
  false \psk@arrowinset \psk@arrowlength \psk@arrowsize \tx@Arrow
  0 h a 5 mul 2 div sub moveto
}
%
% DG addition begin - Dec. 18/19, 1997 and Oct. 11, 2002
% Adapted from \psset@arrows
\define@key[psset]{pstricks-add}{ArrowInside}{%
  \def\pst@tempArrow{#1}%
  \ifx\pst@tempArrow\@empty \def\psk@ArrowInside{} %
  \else%
    \begingroup%
      \pst@activearrows%
      \xdef\pst@tempg{<#1}%
    \endgroup%
    \expandafter\psset@@ArrowInside\pst@tempg\@empty-\@empty\@nil%
    \if@pst\else\@pstrickserr{Bad intermediate arrow specification: #1}\@ehpa\fi%
  \fi%
}
% Adapted from \psset@@arrows
\def\psset@@ArrowInside#1-#2\@empty#3\@nil{%
  \@psttrue
  \def\next##1,#1-##2,##3\@nil{\def\pst@tempg{##2}}%
  \expandafter\next\pst@arrowtable,#1-#1,\@nil
  \@ifundefined{psas@#2}%
    {\@pstfalse\def\psk@ArrowInside{}}%
    {\def\psk@ArrowInside{#2}}%
}
% Default value empty
\psset{ArrowInside={}}
% Modified version of \pst@addarrowdef
\def\pst@addarrowdef{%
  \addto@pscode{%
    /ArrowA {
      \ifx\psk@arrowA\@empty
        \pst@oplineto
      \else
        \pst@arrowdef{A}
        moveto
      \fi
    } def
    /ArrowB { 
      \ifx\psk@arrowB\@empty \else \pst@arrowdef{B} \fi 
    } def
% DG addition
    /ArrowInside { 
      \ifx\psk@ArrowInside\@empty \else \pst@arrowdefA{Inside} \fi 
    } def
  }%
}
% Adapted from \pst@arrowdef
\def\pst@arrowdefA#1{%
  \ifnum\pst@repeatarrowsflag>\z@ 
    /Arrow#1c [ 6 2 roll ] cvx def Arrow#1c 
  \fi   
  \tx@BeginArrow
  \psk@arrowscale
  \@nameuse{psas@\@nameuse{psk@Arrow#1}}
  \tx@EndArrow%
}
% ArrowInsidePos parameter (default value 0.5)
\define@key[psset]{pstricks-add}{ArrowInsidePos}{\pst@checknum{#1}\psk@ArrowInsidePos}%
%\psset{ArrowInsidePos=0.5}
%
% Modified version of \begin@ClosedObj
\def\begin@ClosedObj{%
  \leavevmode%
  \pst@killglue%
  \begingroup%
  \use@par%
  \solid@star%
  \ifpsdoubleline\pst@setdoublesep\fi%
  \pst@addarrowdef% DG addition
  \init@pscode}
%