Current File : //proc/self/root/usr/share/texlive/texmf-dist/tex/generic/pstricks-add/pstricks-add.tex
%% $Id: pstricks-add.tex 741 2013-01-01 16:08:58Z herbert $
%%
%%
%% This is file `pstricks-add.tex',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pstricks-add.tex'
%%
%% Dominique Rodriguez
%% Herbert Voss <hvoss@tug.org>
%% Michael Sharpe <msharpe@ucsd.edu>
%%
%% 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
\ifx\PSTmathLoaded\endinput\else \input pst-math \fi
%
\def\fileversion{3.60}
\def\filedate{2013/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}%
%
\def\psGetSlope(#1,#2)(#3,#4)#5{% 4 values without a dimen! #5 is a macro
\pst@dimm=#1pt%
\advance\pst@dimm by -#3pt%
\pst@dimn=#2pt%
\advance\pst@dimn by -#4pt
\pst@divide{\pst@dimn}{\pst@dimm}#5}
%
\def\psGetDistance(#1,#2)(#3,#4)#5{% 4 values without a dimen! #5 is a macro
\pst@dimm=#1pt%
\advance\pst@dimm by -#3pt%
\pst@dimn=#2pt%
\advance\pst@dimn by -#4pt
\pst@pyth\pst@dimm\pst@dimn\pst@dimo
\edef#5{\strip@pt\pst@dimo}
}%
%--------------------------------------- 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}
%
\def\rmultiput{\pst@object{rmultiput}}
\def\rmultiput@i#1{%
\pst@killglue%
\begingroup%
\use@par%
\@ifnextchar({\rmultiput@ii{#1}}{\rmultiput@ii{#1}(\z@,\z@)}}
\def\rmultiput@ii#1(#2){%
\if@star\rput*(#2){#1}\else\rput(#2){#1}\fi
\@ifnextchar({\rmultiput@ii{#1}}{\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{\def\pst@par{}\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}
%
\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{\def\pst@par{}\pst@object{psbrace}}
\def\psbrace@i(#1)(#2)#3{%
\addbefore@par{ref=lb,linewidth=0.01pt,fillstyle=solid,fillcolor=black}% default setting
\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
gsave STV CP T /ps@rot \psk@rot\space def grestore
/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
\ifx\psk@fillstyle\relax\else
gsave
ifStar { \pst@usecolor\pslinecolor }{ \pst@usecolor\psfillcolor } ifelse
fill
grestore
\fi
\pst@number\pslinewidth 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}
%
\def\psBrace{\def\pst@par{}\pst@object{psBrace}}
\def\psBrace@i(#1)(#2){%
\begin@ClosedObj
\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
\addto@pscode{
/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
% gsave STV CP T /ps@rot \psk@rot\space def grestore
/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
[ 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 }
\end@ClosedObj
\ignorespaces}
%
\newdimen\psparallelogramsep
\define@key[psset]{pstricks-add}{parallelogramsep}[3mm]{\pssetlength\psparallelogramsep{#1}}
\psset[pstricks-add]{parallelogramsep=3mm}
%
\def\psparallelogrambox{\pst@object{psparallelogrambox}}
\def\psparallelogrambox@i{\pst@makebox\psparallelogrambox@ii}
\def\psparallelogrambox@ii{%
\begingroup
\pst@useboxpar
\pst@dima=\pslinewidth
\advance\pst@dima by \psframesep
\pst@dimc=\wd\pst@hbox\advance\pst@dimc by \pst@dima
\pst@dimb=\dp\pst@hbox\advance\pst@dimb by \pst@dima
\pst@dimd=\ht\pst@hbox\advance\pst@dimd by \pst@dima
% Dirk Osburg modification begin - Jul. 16, 2011
\divide\psparallelogramsep by 2
\advance\pst@dima by \psparallelogramsep
\advance\pst@dimc by \psparallelogramsep
% Dirk Osburg modification end
\setbox\pst@hbox=\hbox{%
\ifpsboxsep\kern\pst@dima\fi
\begin@ClosedObj
\addto@pscode{%
\psk@cornersize
\pst@number\pst@dima neg % left
\pst@number\pst@dimb neg % lower
\pst@number\pst@dimc % right
\pst@number\pst@dimd % upper
.5
% D.G. modification begin - Nov. 28, 2001
%\tx@Frame}%
\pst@number\psparallelogramsep
\tx@Parallelogram}%
% D.G. modification end
\def\pst@linetype{2}%
\showpointsfalse
\end@ClosedObj
\box\pst@hbox
\ifpsboxsep\kern\pst@dima\fi%
}%
\ifpsboxsep\dp\pst@hbox=\pst@dimb\ht\pst@hbox=\pst@dimd\fi
\leavevmode\box\pst@hbox
\endgroup%
}
% From the Frame and Rect PostScript macros
\pst@def{Parallelogram}<{%
/ParallelogramA {
% Dirk Osburg modification begin - Jul. 16, 2011
%%%% old stuff: %%%
%x1 pgs sub y1 moveto
%x1 y2 lineto
%x2 pgs add y2 lineto
%x2 y1 lineto
%x1 pgs sub y1 lineto
%%%% replaced by: %%%
x1 pgs sub y1 moveto
x1 pgs add y2 lineto
x2 pgs add y2 lineto
x2 pgs sub y1 lineto
x1 pgs sub y1 lineto
% Dirk Osburg modification end
closepath} def
%
/pgs ED
CLW mul
/a ED
3 -1 roll
2 copy gt { exch } if
a sub
/y2 ED
a add
/y1 ED
2 copy gt { exch } if
a sub
/x2 ED
a add
/x1 ED
1 index 0 eq {pop pop ParallelogramA } { OvalFrame } ifelse}>
%
%
% -------------- 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}[3mm]{\pst@getlength{#1}\psk@veearrowlength}
\psset[pstricks-add]{veearrowlength=3mm} % default projected length
\define@key[psset]{pstricks-add}{veearrowangle}[30]{\pst@getangle{#1}\psk@veearrowangle}
\psset[pstricks-add]{veearrowangle=30} % default angle
\define@key[psset]{pstricks-add}{veearrowlinewidth}[0.35mm]{\pst@getlength{#1}\psk@veearrowlinewidth}
\psset[pstricks-add]{veearrowlinewidth=0.35mm} % default vee arrow line width
% Filled vee arrow
\define@key[psset]{pstricks-add}{filledveearrowlength}[3mm]{\pst@getlength{#1}\psk@filledveearrowlength}
\psset[pstricks-add]{filledveearrowlength=3mm} % default projected length
\define@key[psset]{pstricks-add}{filledveearrowangle}[15]{\pst@getangle{#1}\psk@filledveearrowangle}
\psset[pstricks-add]{filledveearrowangle=15} % default angle
\define@key[psset]{pstricks-add}{filledveearrowlinewidth}[0.35mm]{\pst@getlength{#1}\psk@filledveearrowlinewidth}
\psset[pstricks-add]{filledveearrowlinewidth=0.35mm} % default vee arrow line width
\define@key[psset]{pstricks-add}{arrowlinestyle}[solid]{%
\@ifundefined{psls@#1}%
{\@pstrickserr{Line style `#1' not defined}\@eha}%
{\def\psarrowlinestyle{#1}}}
\psset[pstricks-add]{arrowlinestyle=solid} % default
\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
\@nameuse{psls@\psarrowlinestyle}
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}[1.5mm]{\pst@getlength{#1}\psk@tickarrowlength}
\psset[pstricks-add]{tickarrowlength=1.5mm} % default projected length
\define@key[psset]{pstricks-add}{tickarrowlinewidth}[0.35mm]{\pst@getlength{#1}\psk@tickarrowlinewidth}
\psset[pstricks-add]{tickarrowlinewidth=0.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
\@nameuse{psls@\psarrowlinestyle}
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}[3mm]{\pssetlength\pshooklength{#1}}
\define@key[psset]{pstricks-add}{hookwidth}[1mm]{\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}[2]{\def\psk@nArrowsA{#1}}
\define@key[psset]{pstricks-add}{nArrowsB}[2]{\def\psk@nArrowsB{#1}}
\define@key[psset]{pstricks-add}{nArrows}[2]{\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}[0.5]{\pst@checknum{#1}\psk@ArrowInsidePos}%
%\psset{ArrowInsidePos=0.5}
%
%
% Redefinition of the PostScript /Line macro to print the intermediate
% arrow on each segment of the line
%
\define@key[psset]{pstricks-add}{ArrowInsideNo}[1]{\pst@checknum{#1}\psk@ArrowInsideNo}% hv 20031001
\define@key[psset]{pstricks-add}{ArrowInsideOffset}[0]{\pst@checknum{#1}\psk@ArrowInsideOffset}% hv 20031001
%\psset{ArrowInsideNo=1,ArrowInsideOffset=0}
%
\def\arrowType@H{H}
\pst@def{Line}<
NArray n 0 eq not { n 1 eq { 0 0 /n 2 def } if
(\psk@ArrowInside) length 0 gt {
\ifx\psk@arrowA\arrowType@H % do we have a Hook arrow at the beginning?
\pst@number\pshooklength % yes
\else
\psk@arrowsize\space CLW mul add dup \psk@arrowlength\space mul exch \psk@arrowinset mul neg add
\fi
/arrowlength exch def
4 copy % copy all four values for the arrow line
/y1 ED /x1 ED /y2 ED /x2 ED % save them
/Alpha y2 y1 sub x2 x1 sub Atan def % the gradient of the line
% 2 copy /y1 ED /x1 ED ArrowA x1 y1
ArrowA % draw arrowA
x1 Alpha cos arrowlength mul add % dx add
y1 Alpha sin arrowlength mul add % dy add, to get the current point at the end of the arrow tip
/n n 1 sub def
n {
4 copy
/y1 ED /x1 ED /y2 ED /x2 ED
x1 y1
\psk@ArrowInsidePos\space 1 gt {
/Alpha y2 y1 sub x2 x1 sub Atan def
/ArrowPos \psk@ArrowInsideOffset\space def
/dArrowPos \psk@ArrowInsidePos\space abs def
% /Length x2 x1 sub y2 y1 sub Pyth def
\psk@ArrowInsideNo\space cvi {
/ArrowPos ArrowPos dArrowPos add def
% ArrowPos Length gt { exit } if
x1 Alpha cos ArrowPos mul add
y1 Alpha sin ArrowPos mul add
ArrowInside
pop pop
} repeat
}{
/ArrowPos \psk@ArrowInsideOffset\space def
/dArrowPos \psk@ArrowInsideNo 1 gt {%
1.0 \psk@ArrowInsideNo 1.0 add div
}{\psk@ArrowInsidePos } ifelse def
\psk@ArrowInsideNo\space cvi {
/ArrowPos ArrowPos dArrowPos add def
x2 x1 sub ArrowPos mul x1 add
y2 y1 sub ArrowPos mul y1 add
ArrowInside
pop pop
} repeat
} ifelse
pop pop Lineto
} repeat
}{ ArrowA /n n 2 sub def n { Lineto } repeat } ifelse
CP 4 2 roll ArrowB L pop pop } if >
%
% Redefinition of the PostScript /Polygon macro to print the intermediate
% arrow on each segment of the line
\pst@def{Polygon}<{%
NArray n 2 eq { 0 0 /n 3 def } if
n 3 lt {
n { pop pop } repeat
}{
n 3 gt { CheckClosed } if
n 2 mul -2 roll
/y0 ED
/x0 ED
/y1 ED
/x1 ED
/xx1 x1 def
/yy1 y1 def
x1 y1
/x1 x0 x1 add 2 div def
/y1 y0 y1 add 2 div def
x1 y1 moveto
/n n 2 sub def
/drawArrows {
x11 y11
\psk@ArrowInsidePos\space 1 gt {
/Alpha y12 y11 sub x12 x11 sub atan def
/ArrowPos \psk@ArrowInsideOffset\space def
/Length x12 x11 sub y12 y11 sub Pyth def
/dArrowPos \psk@ArrowInsidePos\space abs def
{
/ArrowPos ArrowPos dArrowPos add def
ArrowPos Length gt { exit } if
x11 Alpha cos ArrowPos mul add
y11 Alpha sin ArrowPos mul add
currentdict /ArrowInside known { ArrowInside } if
pop pop
} loop
}{
/ArrowPos \psk@ArrowInsideOffset\space def
/dArrowPos \psk@ArrowInsideNo\space 1 gt {%
1.0 \psk@ArrowInsideNo\space 1.0 add div
}{ \psk@ArrowInsidePos } ifelse def
\psk@ArrowInsideNo\space cvi {
/ArrowPos ArrowPos dArrowPos add def
x12 x11 sub ArrowPos mul x11 add
y12 y11 sub ArrowPos mul y11 add
currentdict /ArrowInside known { ArrowInside } if
pop pop
} repeat
} ifelse
pop pop Lineto
} def
n {
4 copy
/y11 ED /x11 ED /y12 ED /x12 ED
drawArrows
} repeat
x1 y1 x0 y0
6 4 roll
2 copy
/y11 ED /x11 ED /y12 y0 def /x12 x0 def
drawArrows
/y11 y0 def /x11 x0 def /y12 yy1 def /x12 xx1 def
drawArrows
pop pop
closepath
} ifelse %
}>
%
%
% Redefinition of the PostScript /OpenBezier macro to print the intermediate
% arrow
\pst@def{OpenBezier}<{%
/dArrowPos \psk@ArrowInsideNo 1 gt {%
1.0 \psk@ArrowInsideNo 1.0 add div
}{ \psk@ArrowInsidePos } ifelse def
BezierNArray
n 1 eq { pop pop
}{ 2 copy
/y0 ED /x0 ED
ArrowA
n 4 sub 3 idiv { 6 2 roll 4 2 roll curveto } repeat
6 2 roll
4 2 roll
ArrowB
/y3 ED /x3 ED /y2 ED /x2 ED /y1 ED /x1 ED
/cx x1 x0 sub 3 mul def
/cy y1 y0 sub 3 mul def
/bx x2 x1 sub 3 mul cx sub def
/by y2 y1 sub 3 mul cy sub def
/ax x3 x0 sub cx sub bx sub def
/ay y3 y0 sub cy sub by sub def
/getValues {
ax t0 3 exp mul bx t0 t0 mul mul add cx t0 mul add x0 add
ay t0 3 exp mul by t0 t0 mul mul add cy t0 mul add y0 add
ax t 3 exp mul bx t t mul mul add cx t mul add x0 add
ay t 3 exp mul by t t mul mul add cy t mul add y0 add
} def
/getdL {
getValues
3 -1 roll sub 3 1 roll sub Pyth
} def
/CurveLength {
/u 0 def
/du 0.01 def
0 100 {
/t0 u def
/u u du add def
/t u def
getdL add
} repeat } def
/GetArrowPos {
/ende \psk@ArrowInsidePos\space 1 gt
{ArrowPos}
{ArrowPos CurveLength mul} ifelse def
/u 0 def
/du 0.01 def
/sum 0 def
{ /t0 u def
/u u du add def
/t u def
/sum getdL sum add def
sum ende gt {exit} if
} loop u
} def
/ArrowPos \psk@ArrowInsideOffset\space def
/loopNo \psk@ArrowInsidePos\space 1 gt {%
CurveLength \psk@ArrowInsidePos\space div cvi
}{ \psk@ArrowInsideNo } ifelse def
loopNo cvi {
/ArrowPos ArrowPos dArrowPos add def
/t GetArrowPos def
/t0 t 0.95 mul def
getValues
ArrowInside pop pop pop pop
} repeat
x1 y1 x2 y2 x3 y3 curveto
} ifelse
}>
%
% Redefinition of the PostScript /NCLine macro to print the intermediate
% arrow of the line
\pst@def{NCLine}<{%
NCCoor
tx@Dict begin
ArrowA CP 4 2 roll ArrowB
4 copy
/y2 ED /x2 ED /y1 ED /x1 ED
x1 y1
\psk@ArrowInsidePos\space 1 gt {
/Alpha y2 y1 sub x2 x1 sub atan def
/ArrowPos \psk@ArrowInsideOffset\space def
/Length x2 x1 sub y2 y1 sub Pyth def
/dArrowPos \psk@ArrowInsidePos\space abs def
{%
/ArrowPos ArrowPos dArrowPos add def
ArrowPos Length gt { exit } if
x1 Alpha cos ArrowPos mul add
y1 Alpha sin ArrowPos mul add
ArrowInside
pop pop
} loop
}{%
/ArrowPos \psk@ArrowInsideOffset\space def
/dArrowPos \psk@ArrowInsideNo 1 gt {%
1.0 \psk@ArrowInsideNo 1.0 add div
}{ \psk@ArrowInsidePos } ifelse def
\psk@ArrowInsideNo\space cvi {
/ArrowPos ArrowPos dArrowPos add def
x2 x1 sub ArrowPos mul x1 add
y2 y1 sub ArrowPos mul y1 add
ArrowInside
pop pop
} repeat
} ifelse
pop pop lineto pop pop
end%
}>
%
\pst@def{NCCurve}<{%
GetEdgeA GetEdgeB
xA1 xB1 sub yA1 yB1 sub
Pyth 2 div dup 3 -1 roll mul
/ArmA ED
mul
/ArmB ED
/ArmTypeA 0 def
/ArmTypeB 0 def
GetArmA GetArmB
xA2 yA2 xA1 yA1
2 copy
/y0 ED /x0 ED
tx@Dict begin
ArrowA
end
xB2 yB2 xB1 yB1
tx@Dict begin
ArrowB
end
/y3 ED /x3 ED /y2 ED /x2 ED /y1 ED /x1 ED
/cx x1 x0 sub 3 mul def
/cy y1 y0 sub 3 mul def
/bx x2 x1 sub 3 mul cx sub def
/by y2 y1 sub 3 mul cy sub def
/ax x3 x0 sub cx sub bx sub def
/ay y3 y0 sub cy sub by sub def
/getValues {
ax t0 3 exp mul bx t0 t0 mul mul add cx t0 mul add x0 add
ay t0 3 exp mul by t0 t0 mul mul add cy t0 mul add y0 add
ax t 3 exp mul bx t t mul mul add cx t mul add x0 add
ay t 3 exp mul by t t mul mul add cy t mul add y0 add
} def
/getdL {
getValues
3 -1 roll sub 3 1 roll sub Pyth
} def
/CurveLength {
/u 0 def
/du 0.01 def
0 100 {
/t0 u def
/u u du add def
/t u def
getdL add
} repeat } def
/GetArrowPos {
/ende \psk@ArrowInsidePos\space 1 gt {ArrowPos}{ArrowPos CurveLength mul} ifelse def
/u 0 def
/du 0.01 def
/sum 0 def
{
/t0 u def
/u u du add def
/t u def
/sum getdL sum add def
sum ende gt {exit} if
} loop u
} def
/dArrowPos \psk@ArrowInsideNo 1 gt {%
1.0 \psk@ArrowInsideNo 1.0 add div
}{ \psk@ArrowInsidePos } ifelse def
/ArrowPos \psk@ArrowInsideOffset\space def
/loopNo \psk@ArrowInsidePos\space 1 gt {%
CurveLength \psk@ArrowInsidePos\space div cvi
}{ \psk@ArrowInsideNo } ifelse def
loopNo cvi {
/ArrowPos ArrowPos dArrowPos add def
/t GetArrowPos def
/t0 t 0.95 mul def
getValues
ArrowInside pop pop pop pop
} repeat
x1 y1 x2 y2 x3 y3 curveto
/LPutVar [ xA1 yA1 xA2 yA2 xB2 yB2 xB1 yB1 ] cvx def
/LPutPos { t LPutVar BezierMidpoint } def
/HPutPos { { HPutLines } HPutCurve } def
/VPutPos { { VPutLines } HPutCurve } def
}>
%
\def\parseRP#1;#2;#3\@nil{%check whether arg of refpt contains ;
\def\arg@A{#1}\def\arg@B{#2}}
%
\def\Put{\pst@object{Put}}%
\def\Put@i{\@ifnextchar({\Put@ii{}}{\Put@ii}}%
\def\Put@ii#1(#2)#3{{%
\pst@killglue%
\use@par%
\expandafter\parseRP#1;;\@nil%sets \arg@A, \arg@B
\ifx\arg@B\@empty% use \rput
\edef\arg@A{\if@star*\fi\ifx\arg@A\@empty\else[\arg@A]\fi}%
\expandafter\rput\arg@A(>#2){#3}
\else% use \uput
\edef\arg@A{\if@star*\fi%
\ifx\arg@A\@empty\else{\arg@A}\fi%
\ifx\arg@B\@empty[0]\else[\arg@B]\fi}%
\expandafter\uput\arg@A(>#2){#3}
\fi}\ignorespaces}%
% Modify pst@rot so that a rotation may be specified with a node or ps code
%
\define@key[psset]{pstricks-add}{Os}[0]{\def\PST@Os{#1}}
\psset{Os=0}%
\define@key[psset]{pstricks-add}{Ds}[1]{\def\PST@Ds{#1}}
\psset{Ds=1}%
\define@key[psset]{pstricks-add}{metricInitValue}[0]{\def\PST@metricInitValue{#1}}
\psset{metricInitValue=0}%
\define@boolkey[psset]{pstricks-add}[PST@]{metricFunction}[true]{}%use \ifPST@metricFunction
\psset{metricFunction=false}%
\def\pscurvepoints{\pst@object{pscurvepoints}}%
\def\pscurvepoints@i#1#2#3#4{{%optional [plotpoints=xx]
% #1=tmin,#2=tmax,#3=function (of t),#4=array root name,
\pst@killglue%
\use@par%
\edef\my@tempA{#3}% x(t) y(t) expanded
\expandafter\testAlg\my@tempA|\@nil%
\pst@Verb{ % so we can use definitions from tx@Dict
/unitratio \pst@number\psyunit \pst@number\psxunit div def
/unitratiosq unitratio dup mul def
/t0 #1 def
/t1 #2 def
t1 t0 sub \psk@plotpoints\space div /dt exch def }%
\pst@cntc=\psk@plotpoints\relax%\psk@plotpoints=plotpoints-1
\pst@cntb=\pst@cntc\relax%\psk@plotpoints=plotpoints-1
\advance\pst@cntc by \@ne\relax%=plotpoints
\ifx\my@tempD\@empty\pst@Verb{ /Func (#3) cvx def }%
\else\pst@Verb{ /Func (#3 ) AlgParser cvx def }%
\fi%
\pst@Verb{
/#4.X \the\pst@cntc\space array def
/#4.Y \the\pst@cntc\space array def %
/#4Delta.X \the\pst@cntc\space array def %
/#4Delta.Y \the\pst@cntc\space array def %
/#4Normal.X \the\pst@cntc\space array def %
/#4Normal.Y \the\pst@cntc\space array def %
/t #1 def Func 2 copy /priory ED /priorx ED #4.Y 0 3 -1 roll put #4.X 0 3 -1 roll put %
1 1 \the\pst@cntb\space { dup /j ED dt mul #1 add /t ED Func %x y on stack
2 copy priory sub dup #4Delta.Y j 3 -1 roll put % x y x y-priory
unitratiosq mul neg #4Normal.X j 3 -1 roll put % x y x
priorx sub dup #4Delta.X j 3 -1 roll put % x y x-priorx
#4Normal.Y j 3 -1 roll put % x y
2 copy /priory ED /priorx ED % x y
#4.Y j 3 -1 roll put #4.X j 3 -1 roll put } for %
}%
\expandafter\xdef \csname #4pointcount\endcsname {\psk@plotpoints}%
% \typeout{Created points #40 .. #4\psk@plotpoints}%
}\ignorespaces}%
%
%code to place ticks along polyline
\def\pspolylineticks{\pst@object{pspolylineticks}}%
\def\pspolylineticks@i#1{\@ifnextchar[{\pspolylineticks@ii{#1}}{\pspolylineticks@ii{#1}[]}}%
\newcount\pst@cntC%
\def\pspolylineticks@ii#1[#2]#3#4#5{{%
%#1= root name,#2=pscode (optional),#3=metric function,#4=first tick,#5=tick count
% Metric function may be a function of x, y (keyword metricFunction)
% or a function of x, y, dx, dy, ds requiring incremental build
\addbefore@par{arrows=-,linewidth=\psk@ytickwidth\pslinewidth}%
\use@par%
\pst@killglue%there's a leak that can occur here with ticksize--fixed in recent pstricks.tex
\pst@cntC=\expandafter\csname #1pointcount\endcsname\relax%
\pst@cntb=\pst@cntC\advance\pst@cntb\m@ne\relax%
\pst@cntd=\pst@cntC\advance\pst@cntd\@ne\relax%
\pst@Verb{ % so we can use definitions from tx@Dict in pstricks.pro
/TDict 20 dict def TDict begin %
/Func (#3) cvx def /sarray \the\pst@cntd\space array def %
#2
\ifPST@metricFunction
0 1 #1.X length 1 sub {
/j ED sarray j %
#1.X j get /x ED #1.Y j get /y ED Func put
} for %
\else %build by increments
sarray 0 \PST@metricInitValue\space put %
1 1 #1.X length 1 sub {
/j ED sarray j %
#1.X j 1 sub get
/x ED #1.Y j 1 sub get
/y ED #1Delta.X j get
/dx ED #1Delta.Y j get
/dy ED /ds dx dup mul dy dup mul add sqrt def %
Func sarray j 1 sub get add put
} for %
\fi %\ifPSTfunctionMetric
\ifnum\Pst@Debug>0
/str 10 string def
/tmpar [(Metric range: [) () (, ) () (])] def %
tmpar 1 sarray 0 get str cvs put
/str 10 string def
tmpar 3 sarray \the\pst@cntC\space get str cvs put tmpar
tx@NodeDict begin concatstringarray = end %
\fi % end debug
%compute ticks
/nl 0 def /nu \the\pst@cntC\space def
/smin sarray 0 get def
/smax sarray nu get def
/Os \ifx\PST@Os\@empty smin \else \PST@Os\space \fi def %
/Ds \ifx\PST@Ds\@empty smax Os sub 10 div \else \PST@Ds\space \fi def %
/scount smax Os sub Ds div cvi def %
/tarray scount 1 add array def %
/#1Tick.X scount 1 add array def %
/#1Tick.Y scount 1 add array def %
/#1TickN.X scount 1 add array def %
/#1TickN.Y scount 1 add array def %
0 1 scount { dup Ds mul Os add tarray 3 1 roll put } for %tick positions in tarray
% find the corresponding s values using binary search
0 1 scount {
dup tarray exch get /s exch def /j exch def %sought metric value,index
/m nl def /n nu def /k nl nu add 2 div cvi def 20 { s sarray k get lt { %
/n k def /k k m add 2 div cvi def }{ /m k def /nl k def /k k n add 2 div cvi def } ifelse %
n 1 sub m le { /nl m def exit } if } repeat %
sarray n get sarray m get dup 3 1 roll % sm sn sm
sub dup 0 le { pop pop 0 }{%sm sn-sm
exch %sn-sm sm
s sub neg exch div } ifelse % s->(s-sm)/(sn-sm)
dup #1Delta.X m 1 add get mul #1.X m get add #1Tick.X j 3 -1 roll put % s on stack
#1Delta.Y m 1 add get mul #1.Y m get add #1Tick.Y j 3 -1 roll put %
#1TickN.X j #1Normal.X m 1 add get put #1TickN.Y j #1Normal.Y m 1 add get put %
} for %
\ifnum\Pst@Debug>0
/tmpar 2 array def
/str 4 string def tmpar 0 (Created data for points #1Tick0..#1Tick) put
tmpar 1 scount str cvs put tmpar tx@NodeDict begin concatstringarray = end
\fi%
end }% end pst@Verb
%Draw ticks
\multido{\iA=#4+1}{#5}{%
\pnode(! TDict begin \iA\space scount gt
{ 1 0 /VV ED /UU ED 0 0 }
{ #1TickN.X \iA\space get #1TickN.Y \iA\space get /VV ED /UU ED #1Tick.X \iA\space get #1Tick.Y \iA\space get } ifelse
2 copy /YY ED /XX ED end){#1Tick\iA}%
\pnode(! TDict begin UU VV end ){#1Normal\iA}%
\pnode(! TDict begin VV UU neg unitratiosq div end ){#1Tangent\iA}%
\edef\cmd{\noexpand\psline(\the\pst@yticksizeA;{(! TDict begin UU VV end )})(\the\pst@yticksizeB;{(! TDict begin UU VV end )})}%
\pscustom{\translate(! TDict begin XX YY end)\cmd}}%
}\ignorespaces}%
%
\define@key[psset]{pstricks-add}{randomPoints}[1000]{\def\psk@randomPoints{#1}}
\define@boolkey[psset]{pstricks-add}[Pst@]{color}[true]{}
\psset{randomPoints=1000,color=false}
%
\def\psRandom{\def\pst@par{}\pst@object{psRandom}}% hv 2004-11-12
\def\psRandom@i{\@ifnextchar({\psRandom@ii}{\psRandom@iii(0,0)(1,1)}}
\def\psRandom@ii(#1){\@ifnextchar({\psRandom@iii(#1)}{\psRandom@iii(0,0)(#1)}}
\def\psRandom@iii(#1)(#2)#3{%
\def\pst@tempA{#3}%
\ifx\pst@tempA\pst@empty\psclip{\psframe(#2)}\else\psclip{#3}\fi
\pst@getcoor{#1}\pst@tempA
\pst@getcoor{#2}\pst@tempB
\begin@SpecialObj
\addto@pscode{
\pst@tempA\space /yMin exch def
/xMin exch def
\pst@tempB\space /yMax exch def
/xMax exch def
/dy yMax yMin sub def
/dx xMax xMin sub def
rrand srand % initializes the random generator
/getRandReal { rand 2147483647 div } def
\psk@dotsize % defines /DS ... def
\@nameuse{psds@\psk@dotstyle}
\psk@randomPoints {
\ifPst@color getRandReal getRandReal getRandReal setrgbcolor \fi
getRandReal dx mul xMin add
getRandReal dy mul yMin add
Dot
\ifx\psk@fillstyle\psfs@solid fill \fi stroke
} repeat
}%
\end@SpecialObj
\endpsclip
\ignorespaces
}
%
\def\psComment{\def\pst@par{}\pst@object{psComment}}
\def\psComment@i{\pst@getarrows\psComment@ii}
\def\psComment@ii(#1)(#2)#3{\@ifnextchar[
{\psComment@iii(#1)(#2){#3}}
{\psComment@iii(#1)(#2){#3}[\ncline]}}
\def\psComment@iii(#1)(#2)#3[#4]{\@ifnextchar[
{\psComment@iv(#1)(#2){#3}[#4]}
{\psComment@iv(#1)(#2){#3}[#4][\rput]}}
\def\psComment@iv(#1)(#2)#3[#4][#5]{%
\pnode(#1){comment@1}
\pnode(#2){comment@2}
\ifx\relax#4\relax\let\pst@ConnectionCommand\ncline
\else\let\pst@ConnectionCommand#4\fi
\ifx\relax#5\relax\let\pst@PutCommand\rput
\else\let\pst@PutCommand#5\fi
\addbefore@par{npos=0}%
\begin@SpecialObj%
\pst@ConnectionCommand{comment@1}{comment@2}
\if@star\pst@PutCommand*(#1){#3}\else\pst@PutCommand(#1){#3}\fi
\end@SpecialObj%
\ignorespaces%
}
%
\def\tx@MovetoByHand{ tx@addDict begin MovetoByHand end }
\def\tx@LinetoByHand{ tx@addDict begin LinetoByHand end }
%/amplHand {.8} def
%/dtHand 2 def
\def\pslineByHand{\def\pst@par{}\pst@object{pslineByHand}}
\def\pslineByHand@i{%
\addbefore@par{VarStepEpsilon=2,varsteptol=0.8}
\pst@getarrows{%
\begin@OpenObj
\pst@getcoors[\pslineByHand@ii}}
\def\pslineByHand@ii{%
\addto@pscode{
tx@addDict begin
/dtHand \psk@VarStepEpsilon\space def
/amplHand \psk@varsteptol\space def
% \pst@cp % current point
\tx@setlinejoin % hv 2007-10-13
MovetoByHand
counttomark 2 div /maxLines ED
1 1 maxLines { pop LinetoByHand } for
end
}%
\end@OpenObj%
}
%
\def\psRelNode{\pst@object{psRelNode}}
\def\psRelNode@i(#1)(#2)#3#4{{% A - B - factor - node name
\use@par
\pst@getcoor{#1}\pst@tempA%
\pst@getcoor{#2}\pst@tempB%
\pnode(!
\pst@tempA /YA exch \pst@number\psyunit div def
/XA exch \pst@number\psxunit div def
\pst@tempB /YB exch \pst@number\psyunit div def
/XB exch \pst@number\psxunit div def
/AlphaStrich \psk@angleA\space def
/unit \pst@number\psyunit \pst@number\psxunit div def % yunit/xunit
%
/dx XB XA sub def
/dy YB YA sub \ifPst@trueAngle\space unit mul \fi\space def
/laenge dy dup mul dx dup mul add sqrt #3 mul def
/Alpha dy dx atan def
/beta Alpha AlphaStrich add def
laenge beta cos mul XA add
laenge beta sin mul \ifPst@trueAngle\space unit div \fi\space YA add ){#4}%
}}
%
\def\psRelLine{\def\pst@par{}\pst@object{psRelLine}}
\def\psRelLine@i{\@ifnextchar({\psRelLine@iii}{\psRelLine@ii}}
\def\psRelLine@ii#1{%
\addto@par{arrows=#1}%
\psRelLine@iii%
}
\def\psRelLine@iii(#1)(#2)#3#4{{
\pst@killglue
\use@par
\psRelNode(#1)(#2){#3}{#4}
\psline(#1)(#4)%
}\ignorespaces}
%
% #1 options
% draw a parallel line to #2 #3
% #2---------#3
% #4----------#5(new node)
% #5 length of the line
% #6 node name
\def\psParallelLine{\def\pst@par{}\pst@object{psParallelLine}}
\def\psParallelLine@i{\@ifnextchar({\psParallelLine@iii}{\psParallelLine@ii}}
\def\psParallelLine@ii#1{\addto@par{arrows=#1}\psParallelLine@iii}
\def\psParallelLine@iii(#1)(#2)(#3)#4#5{{
\pst@killglue
\use@par
\pst@getcoor{#1}\pst@tempA
\pst@getcoor{#2}\pst@tempB
\pst@getcoor{#3}\pst@tempC
% \pst@getlength{#4}\pst@dima
\pnode(!%
\pst@tempA /YA exch \pst@number\psyunit div def
/XA exch \pst@number\psxunit div def
\pst@tempB /YB exch \pst@number\psyunit div def
/XB exch \pst@number\psxunit div def
\pst@tempC /YC exch \pst@number\psyunit div def
/XC exch \pst@number\psxunit div def
%
/dx XB XA sub def
/dy YB YA sub def
/laenge dy dup mul dx dup mul add sqrt #4 mul def
/Alpha dy dx atan def
laenge Alpha cos mul XC add
laenge Alpha sin mul YC add ){#5}%
\psline(#3)(#5)
}\ignorespaces}
%
\def\psIntersectionPoint(#1)(#2)(#3)(#4)#5{%
\pst@getcoor{#1}\pst@tempA
\pst@getcoor{#2}\pst@tempB
\pst@getcoor{#3}\pst@tempC
\pst@getcoor{#4}\pst@tempd
\pnode(!%
\pst@tempA /YA exch \pst@number\psyunit div def
/XA exch \pst@number\psxunit div def
\pst@tempB /YB exch \pst@number\psyunit div def
/XB exch \pst@number\psxunit div def
\pst@tempC /YC exch \pst@number\psyunit div def
/XC exch \pst@number\psxunit div def
\pst@tempd /YD exch \pst@number\psyunit div def
/XD exch \pst@number\psxunit div def
/dY1 YB YA sub def
/dX1 XB XA sub def
/dY2 YD YC sub def
/dX2 XD XC sub def
dX1 abs 0.01 lt {
/m2 dY2 dX2 div def
XA dup XC sub m2 mul YC add
}{
dX2 abs 0.01 lt {
/m1 dY1 dX1 div def
XC dup XA sub m1 mul YA add
}{%
/m1 dY1 dX1 div def
/m2 dY2 dX2 div def
m1 XA mul m2 XC mul sub YA sub YC add m1 m2 sub div dup
XA sub m1 mul YA add
} ifelse
} ifelse ){#5}%
}
%
\define@cmdkeys[psset]{pstricks-add}[PSTPSPNk@]{% Christophe Jorssen 2007
blName,bcName,brName,
clName,ccName,crName,
tlName,tcName,trName}[]{}%
\psset[pstricks-add]{%
blName=PSPbl,bcName=PSPbc,brName=PSPbr,
clName=PSPcl,ccName=PSPcc,crName=PSPcr,
tlName=PSPtl,tcName=PSPtc,trName=PSPtr}
\def\psDefPSPNodes{\def\pst@par{}\pst@object{psDefPSPNodes}}
\def\psDefPSPNodes@i{%
\pst@killglue
\begingroup
\use@par
\expandafter\psDefPSPNodes@ii\pic@coor}
%
\def\psDefPSPNodes@ii(#1)(#2)(#3){%
% \pnode(#1){PSPN@temp}\pnode([nodesep=.75,angle=45]PSPN@temp){\PSTPSPNk@blName}
% \pnode(#3){PSPN@temp}\pnode([nodesep=.75,angle=-135]PSPN@temp){\PSTPSPNk@trName}
\pnode(#1){PSPN@temp}\pnode([angle=45]PSPN@temp){\PSTPSPNk@blName}
\pnode(#3){PSPN@temp}\pnode([angle=-135]PSPN@temp){\PSTPSPNk@trName}
\pnode(\PSTPSPNk@blName|\PSTPSPNk@trName){\PSTPSPNk@tlName}
\pnode(\PSTPSPNk@trName|\PSTPSPNk@blName){\PSTPSPNk@brName}
\ncline[linestyle=none]{\PSTPSPNk@blName}{\PSTPSPNk@tlName}
\ncput[npos=.5]{\pnode{\PSTPSPNk@clName}}
\ncline[linestyle=none]{\PSTPSPNk@blName}{\PSTPSPNk@brName}
\ncput[npos=.5]{\pnode{\PSTPSPNk@bcName}}
\pnode(\PSTPSPNk@brName|\PSTPSPNk@clName){\PSTPSPNk@crName}
\pnode(\PSTPSPNk@bcName|\PSTPSPNk@trName){\PSTPSPNk@tcName}
\pnode(\PSTPSPNk@bcName|\PSTPSPNk@clName){\PSTPSPNk@ccName}
\endgroup
\ignorespaces}
%
%\define@key[psset]{pstricks-add}{method}{\def\psk@method{#1}}% defined in pst-plot
\define@key[psset]{pstricks-add}{whichabs}{\def\psk@whichabs{#1}}%
\define@key[psset]{pstricks-add}{whichord}{\def\psk@whichord{#1}}%
\define@key[psset]{pstricks-add}{plotfuncx}{\def\psk@plotfuncx{#1}}%
\define@key[psset]{pstricks-add}{plotfuncy}{\def\psk@plotfuncy{#1}}%
\define@key[psset]{pstricks-add}{expression}{\def\psk@expression{#1}}%
\define@boolkey[psset]{pstricks-add}[Pst@]{buildvector}[true]{}%
%
\define@key[psset]{pstricks-add}{varsteptol}{\def\psk@varsteptol{#1}}%
\define@key[psset]{pstricks-add}{adamsorder}{\def\psk@adamsorder{#1}}%
%\define@key[psset]{pstricks-add}{varstepincrease}{\def\psk@varstepincrease{#1}}% varrk4
%
\define@key[psset]{pstricks-add}{StepType}{\pst@expandafter\psset@@StepType{#1}\@nil}%
\def\psset@@StepType#1#2\@nil{%
\ifx#1u\let\psk@StepType\@ne
\else\ifx#1l\let\psk@StepType\z@
\else\ifx#1i\let\psk@StepType\thr@@
\else\ifx#1s\let\psk@StepType\f@ur
\else\let\psk@StepType\tw@\fi\fi\fi\fi}
\psset{StepType=lower} % alternative StepType=upper/inf/sup/Riemann
%
\def\psStep{\def\pst@par{}\pst@object{psStep}}
\def\psStep@i(#1,#2)#3#4{%
\begin@ClosedObj%
\addto@pscode{
\ifPst@algebraic /Func (#4) tx@addDict begin AlgParser end cvx def \fi
/x #1 def
/dx #2 #1 sub #3 div def
/scx { \pst@number\psxunit mul } def
/scy { \pst@number\psyunit mul } def
\ifcase\psk@StepType % 0->lower, height is always f(x)
x scx 0 moveto
#3 {
\ifPst@algebraic Func \else #4 \fi scy dup x scx exch lineto
/x x dx add def
x scx exch lineto x scx 0 lineto
} repeat
\or % 1-> upper, height is always f(x+dx)
x scx 0 moveto
#3 {
/x x dx add def
\ifPst@algebraic Func \else #4 \fi scy dup x dx sub scx exch lineto
x scx exch lineto x scx 0 lineto
} repeat
\or % 2-> Riemann
/eps3 100 def
/xMinMax [] def
/AMax [] def
/AMin [] def
/dt dx eps3 div def
#3 {
/Max \ifPst@algebraic Func \else #4 \fi def
/Min Max def
/t x def % save x value
eps3 {
\ifPst@algebraic Func \else #4 \fi
dup
Max lt { /Max exch def } { dup Min gt { /Min exch def }{ pop } ifelse } ifelse
/x x dt add def
} repeat
/x t def % restore
x scx Min scy Max scy xMinMax aload length 3 add array astore /xMinMax exch def
/x x dx add def
} repeat
/dx dx scx def
xMinMax aload length 3 div cvi {
/yMax ED /yMin ED /x ED
x yMin moveto dx 0 rlineto x dx add yMax lineto
dx neg 0 rlineto x yMin lineto } repeat
\or % 3->inf(imum)
x scx 0 moveto
#3 {
\ifPst@algebraic Func \else #4 \fi /y0 ED % left value f(x)
/xOld x def
/x x dx add def
\ifPst@algebraic Func \else #4 \fi /y1 ED % right value f(x+dx)
y0 y1 lt { y0 }{ y1 } ifelse % use infimum
scy dup xOld scx exch lineto
x scx exch lineto x scx 0 lineto
} repeat
\or % 4-> sup(remum)
x scx 0 moveto
#3 {
\ifPst@algebraic Func \else #4 \fi /y0 ED % left value f(x)
/x x dx add def
\ifPst@algebraic Func \else #4 \fi /y1 ED % right value f(x+dx)
y0 y1 gt { y0 }{ y1 } ifelse % use supremum
scy dup x dx sub scx exch lineto
x scx exch lineto x scx 0 lineto
} repeat
\fi
}%
\psk@fillstyle
\pst@stroke
\end@ClosedObj%
}
%
\define@key[psset]{pstricks-add}{Derive}{\def\psk@Derive{#1}}%
\define@boolkey[psset]{pstricks-add}[PST@]{Tnormal}[true]{}
\psset[pstricks-add]{CMYK=true}
\def\@NOTEMPTY{NOT@EMPTY}%%dr 0606
%
\def\psTangentLine{\def\pst@par{}\pst@object{psTangentLine}}
\def\psTangentLine@i(#1,#2)(#3,#4)(#5,#6)#7#8{%
\begin@OpenObj%
\addto@pscode{
[[#1 dup dup mul exch 1 #2]
[#3 dup dup mul exch 1 #4]
[#5 dup dup mul exch 1 #6]]
SolveLinEqSystem
/abc ED
abc aload pop % a b c on stack
exch #7 % a c b x
mul add exch % c+b*x a
#7 dup mul mul add % a*x^2+b*x+c
/y0 ED % save value
abc aload pop pop exch % b a
#7 mul 2 mul add % b+2*a*x0=mTan
\ifPST@Tnormal
neg 1 exch div % -1/mTan=mOrth
#8 mul /dy ED % mOrth*dx=dy
[
#7 #8 add y0 dy add \tx@ScreenCoor % x0+dx y0 +dy
#7 y0 \tx@ScreenCoor % x0 y0
\else
dup % mTan mTan
#8 mul /dy1 ED % mTan*dx
#8 neg mul /dy2 ED % mTan*-dx
[
#7 #8 add y0 dy1 add \tx@ScreenCoor % x0+dx y0 +dy1
#7 #8 sub y0 dy2 add \tx@ScreenCoor % x0-dx y0 +dy2
\fi
/Lineto /lineto load def
\ifshowpoints true \else false \fi
\tx@setlinejoin %
\tx@Line
}%
\end@OpenObj%
\pnode(!
[[#1 dup dup mul exch 1 #2][#3 dup dup mul exch 1 #4][#5 dup dup mul exch 1 #6]]
SolveLinEqSystem /abc ED
abc aload pop % a b c on stack
exch #7 % a c b x
mul add exch % c+b*x a
#7 dup mul mul add % a*x^2+b*x+c
/y0 ED % save value
#7 y0 ){OCurve}%
\pnode(!
[[#1 dup dup mul exch 1 #2][#3 dup dup mul exch 1 #4][#5 dup dup mul exch 1 #6]]
SolveLinEqSystem /abc ED
abc aload pop % a b c on stack
exch #7 % a c b x
mul add exch % c+b*x a
#7 dup mul mul add % a*x^2+b*x+c
/y0 ED % save value
abc aload pop pop exch % b a
#7 mul 2 mul add % b+2*a*x0=mTan
neg 1 exch div % -1/mTan=mOrth
#8 mul /dy ED % mOrth*dx=dy
#7 #8 add y0 dy add % x0+dx y0 +dy
){ENormal}%
\pnode(!
[[#1 dup dup mul exch 1 #2][#3 dup dup mul exch 1 #4][#5 dup dup mul exch 1 #6]]
SolveLinEqSystem
/abc ED
abc aload pop % a b c on stack
exch #7 % a c b x
mul add exch % c+b*x a
#7 dup mul mul add % a*x^2+b*x+c
/y0 ED % save value
abc aload pop pop exch % b a
#7 mul 2 mul add % b+2*a*x0=mTan
#8 mul /dy1 ED % mTan*dx
#7 #8 add y0 dy1 add ){ETangent}%
\ignorespaces}
\def\psplotTangent@x#1,#2,#3\@nil{%
\def\pst@tempLeft{#1}%
\def\pst@tempRight{#2}}
%% #1 : x value
%% #2 : delta x or x0,x1
%% #3 : function
\def\psplotTangent{\@ifnextchar*{\@startrue\psplotTangent@i}{\@starfalse\psplotTangent@i*}}
\def\psplotTangent@i*{\@ifnextchar[{\psplotTangent@ii}{\psplotTangent@ii[]}}
\def\psplotTangent@ii[#1]#2#3#4{%
\pst@killglue%
\expandafter\psplotTangent@x#3,,\@nil\relax%
\begingroup%
\ifx\relax#1\relax\else\psset{linestyle=solid,#1}\fi%
\ifx\psk@Derive\@empty\ifPst@algebraic\def\psk@Derive{NOT@EMPTY}\fi\fi%%dr 0606 hv 1003
\pst@addarrowdef%
\addto@pscode{%
/F@pstplot \ifPst@algebraic (#4) tx@addDict begin AlgParser end cvx \else { #4 } \fi def % define function
\ifx\psk@Derive\@empty\else
\ifx\psk@Derive\@NOTEMPTY\else%%dr 0606
/FDer@pstplot % do we have a derivation defined?
\ifPst@algebraic (\psk@Derive) tx@addDict begin AlgParser end cvx \else { \psk@Derive } \fi def % define derivation
\fi%%dr 0606
\fi%
/@parametric false def %%dr 0606
% first we calculate the origin
#2 dup /x ED /t ED tx@addDict begin mark F@pstplot end counttomark 1 gt % test, if we have parametricplot
%%{ /y ED /x ED } % if yes, then we have 2 values
{ /y ED /x ED /@parametric true def } % if yes, then we have 2 values%%dr 0606
{ \ifPst@polarplot x \ifPst@algebraic RadtoDeg \fi PtoC /y ED /x ED \else /y ED \fi } ifelse
cleartomark
\ifx\psk@Derive\@NOTEMPTY %%begin dr 0606
%% algebraic we can use the derivative machine
/FDer@pstplot (#4) @parametric { (t) } { (x) } ifelse
tx@Derive begin Derive end tx@addDict begin AlgParser end cvx def
\fi %%end dr 0606
x \pst@number\psxunit mul y \pst@number\psyunit mul
translate % define the temporary origin
% now we calculate the slope of the tangent
\ifx\psk@Derive\@empty% de we have a derivation defined?
#2 abs 1.0e-6 lt % no, we choose secant for the tangent
{ #2 0.0005 add dup /x ED /t ED tx@addDict begin mark F@pstplot end counttomark 1 gt % test, if we have parametricplot
{ /y2 ED /x2 ED } % we have 2 values
{ \ifPst@polarplot dup x \ifPst@algebraic RadtoDeg \fi
cos mul /x2 ED x \ifPst@algebraic RadtoDeg \fi sin mul \else /x2 x def \fi /y2 ED } ifelse
cleartomark % delete the mark
#2 0.0005 sub dup /x ED /t ED tx@addDict begin mark F@pstplot end counttomark 1 gt % test, if we have parametricplot
{ /y1 ED /x1 ED }
{ \ifPst@polarplot dup x \ifPst@algebraic RadtoDeg \fi
cos mul /x1 ED x \ifPst@algebraic RadtoDeg \fi sin mul \else /x1 x def \fi /y1 ED } ifelse
cleartomark
y2 y1 sub x2 x1 sub } % dy dx
{ % > 1.0e-06
#2 1.0005 mul dup /x ED /t ED tx@addDict begin mark F@pstplot end counttomark 1 gt % test, if we have parametricplot
{ /y2 ED /x2 ED } % we have 2 values
{ \ifPst@polarplot dup x \ifPst@algebraic RadtoDeg \fi
cos mul /x2 ED x \ifPst@algebraic RadtoDeg \fi sin mul \else /x2 x def \fi /y2 ED } ifelse
cleartomark
#2 .9995 mul dup /x ED /t ED tx@addDict begin mark F@pstplot end counttomark 1 gt % test, if we have parametricplot
{ /y1 ED /x1 ED } % we have 2 values
{ \ifPst@polarplot dup x \ifPst@algebraic RadtoDeg \fi
cos mul /x1 ED x \ifPst@algebraic RadtoDeg \fi sin mul \else /x1 x def \fi /y1 ED } ifelse
cleartomark
y2 y1 sub \pst@number\psyunit mul x2 x1 sub \pst@number\psxunit mul } ifelse
atan % atan(dy dx), we have the slope angle of the secant
\ifPST@Tnormal 90 add \fi
\else % there is a derivation defined
#2 dup /x ED /t ED tx@addDict begin mark FDer@pstplot end counttomark 1 gt % test, if we have parametricplot
{ /y ED /x ED }
{ \ifPst@polarplot /Fphi ED % the value F'(phi)
tx@addDict begin F@pstplot end x \ifPst@algebraic RadtoDeg \fi PtoC /y0 ED /x0 ED % the x y values
x \ifPst@algebraic RadtoDeg \fi sin Fphi mul x0 add /y ED
x \ifPst@algebraic RadtoDeg \fi cos Fphi mul y0 sub /x ED
\else /y ED /x 1 def \fi } ifelse
cleartomark
y \pst@number\psyunit mul x \pst@number\psxunit mul Atan \ifPST@Tnormal 90 add \fi
% y ATAN1 % we have the slope angle of the tangent. ATAN is defined int the pstricks.pro, patch 6
\fi
dup % to prevent rounding errors use original value
cvi 180 mod 90 gt { 180 sub } if % -90 <= angle <= 90
rotate % rotate, depending to the origin
/Lineto /lineto load def % the pro file needs /Lineto
\pst@cp % kill the currentpoint, if any
[ % start array of points
\ifPST@Tnormal
0 0 % moveto
#3
y \pst@number\psyunit mul x \pst@number\psxunit mul Atan cos div \pst@number\psxunit mul 0 % lineto
\else % points are in reverse order ...
\ifx\pst@tempRight\@empty #3 \else \pst@tempRight\space \fi \pst@number\psxunit mul 0 % moveto
\if@star 0
\else
\ifx\pst@tempRight\@empty #3 neg \else \pst@tempLeft\space \fi
\pst@number\psxunit mul
\fi 0 % lineto
\fi
\pst@usecolor\pslinecolor
false % don't show the points
\tx@Line
\ifx\pslinestyle\@none\else
\pst@number\pslinewidth SLW
\tx@setStrokeTransparency
\@nameuse{psls@\pslinestyle}
\fi
\ifshowpoints % show the points?
gsave
\psk@dotsize
\@nameuse{psds@\psk@dotstyle}
0 0 Dot
grestore
\fi
}%
\use@pscode%
\endgroup%
\@starfalse%
\ignorespaces}
%
%% #1-#2 x range
%% #3 initial value of y (which is a vector) y(0) y'(0) y''(0) ...
%% #4 value of the derivative (y and t can be used)
%
\define@boolkey[psset]{pstricks-add}[Pst@]{GetFinalState}[true]{}
\define@key[psset]{pstricks-add}{filename}{\def\psk@filename{#1}}%
\define@boolkey[psset]{pstricks-add}[Pst@]{saveData}[true]{} % \ifPst@saveData
\psset[pstricks-add]{GetFinalState=false,saveData=false,filename=PSTdata}
%
\def\Begin@SaveFinalState{ end
/PST@beginspecial /@beginspecial load def
/PST@endspecial /@endspecial load def
/PST@setspecial /@setspecial load def
/@beginspecial {} def /@endspecial{} def /@setspecial {} def
tx@Dict begin
}
\newif\ifPst@BeginSaveFinalState \Pst@BeginSaveFinalStatefalse
\def\BeginSaveFinalState{\Pst@BeginSaveFinalStatetrue}
\def\End@SaveFinalState{
/@beginspecial /PST@beginspecial load def
/@endspecial /PST@endspecial load def
/@setspecial /PST@setspecial load def
}
\def\EndSaveFinalState{\pstverb{\End@SaveFinalState}}
\def\psplotDiffEqn{\def\pst@par{}\pst@object{psplotDiffEqn}}% initial code by Dominique 2005-05-21
\def\psplotDiffEqn@i#1#2#3#4{%
\addbefore@par{xStart=#1}%
\pst@killglue%
\begingroup%
\use@par%
\@nameuse{beginplot@\psplotstyle}%
\addto@pscode{%
\ifPst@BeginSaveFinalState \Begin@SaveFinalState \fi
\ifPst@saveData /Pst@data (\psk@filename) (w) file def \fi
/x #1 def % first value
/x1 #2 def % last value
\ifPst@GetFinalState \Begin@SaveFinalState /y SaveFinalState def
\else /y [ #3 ] def \fi % values for t=0
/ylength y length def % number of elements in #3
/addvect {
1 1 ylength {
/i exch def
ylength i sub 2 add -1 roll add ylength 2 mul i sub 1 roll
} for
} def
/dx x1 x sub \psk@plotpoints\space div def
/mulvect {
ylength exch
1 index {
dup 4 -1 roll mul 2 index 2 add 1 roll
} repeat
pop pop } def
/divvect { ylength exch 1 index { dup 4 -1 roll exch div 2 index 2 add 1 roll } repeat pop pop } def
/k0 0 def /k1 0 def /k2 0 def /k3 0 def
\ifPst@algebraic /F@pstplot (#4) tx@addDict begin AlgParser end cvx def \fi
/Func {
\ifPst@algebraic F@pstplot ylength array astore
\else
\ifPst@buildvector\else y aload pop \fi #4
\ifPst@buildvector\else ylength array astore \fi
\fi
} def
\ifx\psk@method\@adams /F1 0 def /F2 0 def /F3 0 def /F4 0 def /F5 0 def /F6 0 def /INIT 1 def \fi
\ifx\psk@method\@empty\else
\ifx\psk@method\@varrkiv %% RUNGE-KUTTA method with var step algorithm
/VarStep false def /VarStepRatio 1 def
/RK {
/k0 Func { dx mul } forall ylength array astore def %% y
dup aload pop k0 { 2 div } forall addvect ylength array astore /y exch def %
x dup dx 2 div add /x exch def %% y x
/k1 Func { dx mul } forall ylength array astore def %% y x
exch dup aload pop k1 { 2 div } forall addvect y astore pop %% x y
/k2 Func { dx mul } forall ylength array astore def %% x y
dup aload pop k2 aload pop addvect y astore pop exch dup dx add /x exch def %% y x
/k3 Func { dx mul } forall ylength array astore def %% y x
/x exch def %% y
dup aload pop k0 aload pop k1 aload pop k2 aload pop addvect
2 mulvect addvect k3 aload pop addvect
6 divvect addvect y astore
} def
/VARRK {
VarStep
%{ /dx dx \psk@varstepincrease\space mul def /VarStep false def } if
{ /dx dx VarStepRatio mul def /VarStep false def } if
x dx add x1 gt { /dx x1 x sub def } if
%{ /dx dx \psk@varstepdecrease\space div def } ifelse
%% we compute y(x+dx) from y(x) using RK4
RK %% y(x) y(x+dx)
exch /y exch def /dx dx 2 div def
{ %% we compute y(x+dx/2) from y(x) using RK4
y RK %% y(x+dx) y(x+dx/2)
%% then y(x+dx) from y(x+dx/2) using RK4
/y exch def y RK %% y(x+dx) y(x) y(x+dx/2) y(x+dx)
dup aload pop 4 ylength add -1 roll
{ -1 mul } forall addvect 0 ylength { exch abs 2 copy lt { exch } if pop } repeat
0 3 -1 roll {abs 2 copy lt { exch } if pop } forall
dup 1e-6 lt { pop } { div } ifelse
/dx dx 2 mul def
dup \psk@varsteptol\space lt
%{ \psk@varsteptol\space div .1 lt { /VarStep true def } if pop exit } if
%pop /dx dx 4 div def exch /y exch def } loop
{ .001 div dup .1 lt
{ dup 1e-6 lt { pop 3 } { log neg } ifelse /VarStepRatio exch def /VarStep true def }
{ pop } ifelse pop exit } if
pop /dx dx 4 div def exch /y exch def } loop
} def
\else %% RUNGE-KUTTA & ADAMS methods
/RK {
/k0 Func { dx mul } forall ylength array astore def %% y
dup aload pop k0 { 2 div } forall addvect ylength array astore /y exch def %
x dup dx 2 div add /x exch def %% y x
/k1 Func { dx mul } forall ylength array astore def %% y x
exch dup aload pop k1 { 2 div } forall addvect y astore pop %% x y
/k2 Func { dx mul } forall ylength array astore def %% x y
dup aload pop k2 aload pop addvect y astore pop exch dup dx add /x exch def %% y x
/k3 Func { dx mul } forall ylength array astore def %% y x
/x exch def %% y
dup aload pop k0 aload pop k1 aload pop k2 aload pop addvect
2 mulvect addvect k3 aload pop addvect
6 divvect addvect y astore pop
} def
\ifx\psk@method\@adams
/ADAMS {
\ifcase\psk@adamsorder
\errmessage{pstricks-add error: no order 0th for adams method (see user's manual)}
\or\errmessage{pstricks-add error: no order 1st for adams method (see user's manual)}
\or\errmessage{pstricks-add error: no order 2nd for adams method (see user's manual)}
\or\errmessage{pstricks-add error: no order 3rd for adams method (see user's manual)}
\or
%% ORDRE 4
F4 aload pop 55 mulvect
F3 aload pop -59 mulvect addvect
F2 aload pop 37 mulvect addvect
F1 aload pop -9 mulvect addvect
dx mulvect 24 divvect
\or
%% ORDRE 5
F5 aload pop 1901 mulvect
F4 aload pop -2774 mulvect addvect
F3 aload pop 2616 mulvect addvect
F2 aload pop -1274 mulvect addvect
F1 aload pop 251 mulvect addvect
dx mulvect 720 divvect
\or
%% ORDRE 6
F6 aload pop 4277 mulvect
F5 aload pop -7923 mulvect addvect
F4 aload pop 9982 mulvect addvect
F3 aload pop -7298 mulvect addvect
F2 aload pop 2877 mulvect addvect
F1 aload pop -475 mulvect addvect
dx mulvect 1440 divvect
\fi
y aload pop addvect ylength array astore /y exch def } def
\fi
\fi
\fi
/xy {
\ifx\psk@plotfuncx\@empty
\ifx\psk@whichabs\@empty x \else y \psk@whichabs\space get \fi
\else \psk@plotfuncx\space \fi
\pst@number\psxunit mul y
\ifx\psk@method\@empty %% EULER method
/y Func { dx mul } forall y aload pop addvect ylength array astore def
\else%
\ifx\psk@method\@varrkiv %% RUNGE-KUTTA method
VARRK
\else\ifx\psk@method\@rkiv %% RUNGE-KUTTA method
RK
\else
/F1 F2 def /F2 F3 def /F3 F4 def /F4 %% ADAMS method
\ifcase\psk@adamsorder\or\or\or\or
%% ORDRE 4
Func def
\or
%% ORDRE 5
F5 def /F5 Func def
\or
%% ORDRE 6
F5 def /F5 F6 def /F6 Func def
\fi
INIT \psk@adamsorder\space lt
{ RK /INIT INIT 1 add def }
{ ADAMS } ifelse
\fi\fi
\fi
\ifx\psk@plotfuncy\@empty
\ifx\psk@whichord\@empty 0 \else \psk@whichord\space \fi get %
\else \psk@plotfuncy\space \fi
\pst@number\psyunit mul
% Pst@data (\string\[) writestring
\ifPst@saveData
2 copy
\pst@number\psyunit div exch \pst@number\psxunit div
20 string cvs Pst@data exch writestring
Pst@data (\space) writestring
20 string cvs Pst@data exch writestring
Pst@data (\string\n) writestring
\fi
} def
}%
\gdef\psplot@init{}%
\@pstfalse
\@nameuse{testqp@\psplotstyle}%
\if@pst\psplot@ii\else\psplot@iii\fi
% \addto@pscode{\ifPst@saveData Pst@data closefile \fi}
\endgroup%
\ignorespaces%
}
%
%
\def\psGTriangle{\def\pst@par{}\pst@object{psGTriangle}}
\def\psGTriangle@i(#1)(#2)(#3)#4#5#6{{%
\def\solid@star{}%
\begin@ClosedObj
\pst@getcoor{#1}\pst@tempA % A: "rgb xr xg xb" or "gray xg"
\pst@getcoor{#2}\pst@tempB % B
\pst@getcoor{#3}\pst@tempC % C
\pst@getcolor{#4}\pst@colorA
\pst@getcolor{#5}\pst@colorB
\pst@getcolor{#6}\pst@colorC
\addto@pscode{%
\pst@tempC % C
\pst@tempB % B
\psk@gangle % rotating angle
\pst@tempA % A, temporary origin
/rgb {} def
/gray {} def
[ \pst@colorC ] aload length 1 eq { dup dup } if 3 array astore % gray -> rgb
[ \pst@colorB ] aload length 1 eq { dup dup } if 3 array astore
[ \pst@colorA ] aload length 1 eq { dup dup } if 3 array astore
tx@addDict begin GTriangle end % PS part
}%
\if@star\pspolygon[fillstyle=none](#1)(#2)(#3)\fi% draw borderline
\def\pst@linetype{2}%
\end@ClosedObj%
}\ignorespaces}
%
\def\psdice{\def\pst@par{}\pst@object{psdice}}
\def\psdice@i#1{{%
\pst@killglue%
\addbefore@par{framearc=0.3,linewidth=1pt}%
\use@par%
\psframe(-0.5,-0.5)(0.5,0.5)%
\ifodd#1 \qdisk(0,0){0.1\psunit}\else\qdisk(-0.3,-0.3){0.1\psunit}\qdisk(0.3,0.3){0.1\psunit}\fi
\ifcase#1%
\or\or\or\qdisk(-0.3,-0.3){0.1\psunit}\qdisk(0.3,0.3){0.1\psunit}% 3
\or\qdisk(-0.3,0.3){0.1\psunit}\qdisk(0.3,-0.3){0.1\psunit}% 4
\or\qdisk(-0.3,-0.3){0.1\psunit}\qdisk(0.3,0.3){0.1\psunit}% 5
\qdisk(-0.3,0.3){0.1\psunit}\qdisk(0.3,-0.3){0.1\psunit}
\or\qdisk(-0.3,0.3){0.1\psunit}\qdisk(0.3,-0.3){0.1\psunit}% 6
\qdisk(-0.3,0){0.1\psunit}\qdisk(0.3,0){0.1\psunit}%
\fi%
\ignorespaces%
}}
%
% the datafile must be a matrix with
% /dotmatrix [
% .....
% .....
% ] def
%
\def\pswavelengthToGRAY{ tx@addDict begin wavelengthToGRAY end }
\def\pswavelengthToRGB{ tx@addDict begin wavelengthToRGB Red Green Blue end }
%
\define@key[psset]{pstricks-add}{Xoffset}[0pt]{\pst@getlength{#1}\psk@Xoffset}
\define@key[psset]{pstricks-add}{Yoffset}[0pt]{\pst@getlength{#1}\psk@Yoffset}
\define@key[psset]{pstricks-add}{XYoffset}[0pt]{\pst@getlength{#1}\psk@Xoffset\let\psk@Yoffset\psk@Xoffset}
\psset[pstricks-add]{XYoffset=0pt}
\define@key[psset]{pstricks-add}{colorType}[0]{\def\psk@colorType{#1}}
\define@key[psset]{pstricks-add}{colorTypeDef}[{}]{\def\psk@colorTypeDef{#1\space}}
\psset[pstricks-add]{colorType=0,colorTypeDef={}} % 0-> two color mode 1->wavelength mode (400..700nm)
% 0-> two color mode
% 1-> wavelength mode (400..700nm)
% 2-> wavelength mode inverse
% 3-> gray color mode
% 4-> gray color mode invers
% 5-> own color definition
\def\psMatrixPlot{\def\pst@par{}\pst@object{psMatrixPlot}}
\def\psMatrixPlot@i#1#2#3{%
\pst@killglue%
\addbefore@par{xStep=1,yStep=1}%
\begin@SpecialObj%
\addto@pscode{
(#3) run % load the data file
/Min 0 def /Max 0 def
dotmatrix { dup Min lt { /Min ED } { dup Max gt { /Max ED } { pop } ifelse } ifelse } forall
/dMaxMin Max Min sub def
\psk@dotsize
\psk@Xoffset\space \psk@Yoffset\space translate
\@nameuse{psds@\psk@dotstyle} %
/n 0 def % index for element
1 1 #1 { % the y loop (outer one)
/y exch def % save y
1 1 #2 { % the x loop (inner one)
/x exch def % save x
dotmatrix n get % get value from matrix
\ifcase\psk@colorType
dup 0 gt { % test if > 0
\or
Min sub dMaxMin div 300 mul 400 add
\pswavelengthToRGB setrgbcolor
\or
Min sub dMaxMin div neg 1 add 300 mul 400 add
\pswavelengthToRGB setrgbcolor
\or
Min sub dMaxMin div neg 1 add 300 mul 400 add
\pswavelengthToGRAY setgray
\or
Min sub dMaxMin div neg 1 add 300 mul 400 add
\pswavelengthToGRAY neg 1 add setgray
\or
currentdict /colorTypeDef known { colorTypeDef } { \psk@colorTypeDef } ifelse
\fi
x \psk@xStep\space mul \pst@number\psxunit mul
\ifPst@ChangeOrder #1 y sub 1 add \else y \fi \psk@yStep\space mul \pst@number\psyunit mul Dot%
\ifcase\psk@colorType
} { pop } ifelse
\fi
/n n 1 add def
} for
} for
}%
\end@SpecialObj%
\ignorespaces%
}
%
\newdimen\chart@ColorIndex
\newdimen\chart@ColorStep
\newdimen\pst@chartHeight
\newdimen\pst@chartStackDepth
\newdimen\pst@chartStackWidth
\newcount\chart@Toggle
\newif\if@chartSep
\newif\if@chartUserColor
%
\define@key[psset]{pstricks-add}{chartStyle}{\def\psk@chartStyle{#1}}
\psset[pstricks-add]{chartStyle=pie}% p)ie P)ie-3d-view h)istogram H)istogram-3dview
%
\define@key[psset]{pstricks-add}{chartColor}{\pst@expandafter\psk@@chartColor{#1}\@nil}
\def\psk@@chartColor#1#2\@nil{%
\ifx#1r\def\psk@chartColor{2}\else%
\ifx#1c\def\psk@chartColor{380}\else\def\psk@chartColor{0}\fi\fi}
\psset[pstricks-add]{chartColor=gray}% gray, color, randomColor
%
\define@key[psset]{pstricks-add}{chartSep}{\pst@getlength{#1}\psk@chartSep}
\define@key[psset]{pstricks-add}{chartStack}{\pst@getint{#1}\psk@chartStack}
\define@key[psset]{pstricks-add}{chartStackDepth}{\pssetylength\pst@chartStackDepth{#1}}
\define@key[psset]{pstricks-add}{chartStackWidth}{\pssetxlength\pst@chartStackWidth{#1}}
\define@key[psset]{pstricks-add}{chartHeight}{\pssetylength\pst@chartHeight{#1}}
\psset[pstricks-add]{chartSep=10pt,chartStack=0,chartStackDepth=2cm,chartStackWidth=2cm,%
chartHeight=5mm}
%
\define@boolkey[psset]{pstricks-add}[Pst@]{uselinecolor}[true]{}
\psset[pstricks-add]{uselinecolor=false}
%
\define@key[psset]{pstricks-add}{userColor}{%
\chart@Toggle=0\relax%
\def\chart@option{#1}%
\ifx\chart@option\@empty\@chartUserColorfalse%
\else%
\@chartUserColortrue%
\expandafter\psk@@chartUserColor#1,,\@nil%
\fi}
\def\psk@@chartUserColor#1,#2,#3\@nil{%
\advance\chart@Toggle by \@ne%
\xglobal\colorlet{chartFillColor\the\chart@Toggle}{#1}%
\def\chart@option{#2}%
\ifx\chart@option\@empty\else\psk@@chartUserColor#2,#3,\@nil\fi}%
\psset[pstricks-add]{userColor={}}
\define@key[psset]{pstricks-add}{chartNodeI}{\def\psk@chartNodeI{#1}}
\define@key[psset]{pstricks-add}{chartNodeO}{\def\psk@chartNodeO{#1}}
\psset[pstricks-add]{chartNodeI=0.75,chartNodeO=1.5}
%
\def\psChart{\pst@object{psChart}}
\def\psChart@i#1#2#3{%
% #1:values #2:separated charts
% #3 radius->pie; max height->histogram
\pst@killglue%
\global\pssetylength\pst@chartHeight{#3}%
\global\let\pst@chartRadius\pst@chartHeight%
\begingroup%
\def\psk@chartValues{#1}%
\def\psk@chartSepValues{#2}% only valid for a pie chart
\pst@dimm=\z@% sum of all entries (for a pie)
\pst@cnta=1\relax% number of entries
\pst@dimn=\z@% greatest entry
\psforeach{\chart@tempA}{#1}{%
\global\advance\pst@cnta by \@ne% % no of entries
\global\advance\pst@dimm by \chart@tempA\p@% % sum of all entries
\pst@dima=\chart@tempA\p@%
\ifdim\pst@dima>\pst@dimn\global\pst@dimn=\pst@dima\fi%
}%
\addbefore@par{dimen=outer}%
\begin@SpecialObj%
\ifnum\psk@chartColor>0\relax%
\chart@ColorStep=400\p@\else\chart@ColorStep=\p@\fi % the "numerical color"
\divide\chart@ColorStep by \pst@cnta% % step =1/no or 400/no
\chart@ColorIndex=\psk@chartColor\p@% % the start color (gray or wave)
\@nameuse{pscs@\psk@chartStyle}%
\end@SpecialObj%
\endgroup%
\ignorespaces%
}
%
\def\pscs@pie{%
\degrees[\pst@number\pst@dimm]% % instead of 360 degrees
\def\chart@alpha{0}%
\pst@dimm=\z@\pst@dimn=\z@\pst@dimo=\z@\pst@cnta=0\relax%
\global\chart@Toggle=1\relax%
\ifpsshadow% create shadow first
\psforeach{\chart@tempA}{\psk@chartValues}{%
\global\advance\pst@dimm by \chart@tempA\p@%
\global\advance\pst@dimn by \chart@alpha\p@%
\global\advance\pst@cnta by \@ne%
\pst@dimo=0.5\pst@dimn\advance\pst@dimo by 0.5\pst@dimm% half angle of the chart
\global\@chartSepfalse%
\if$\psk@chartSepValues$\else%
\psforeach{\chart@tempC}{\psk@chartSepValues}{\ifnum\chart@tempC=\the\pst@cnta\relax\global\@chartSeptrue\fi}%
\fi%
\if@chartSep%
\pswedge(\psk@chartSep\p@;\pst@number\pst@dimo){\pst@chartRadius}{\pst@number\pst@dimn}{\pst@number\pst@dimm}%
\else%
\pswedge(0,0){\pst@chartRadius}{\pst@number\pst@dimn}{\pst@number\pst@dimm}%
\fi%
\global\let\chart@alpha\chart@tempA%
}%
\psshadowfalse%
\fi%
\def\chart@alpha{0}%
\pst@dimm=0pt\pst@dimn=0pt\pst@dimo=0pt\pst@cnta=0\relax%
\psForeach{\chart@tempA}{\psk@chartValues}{%
\global\advance\pst@dimm by \chart@tempA\p@%
\global\advance\pst@dimn by \chart@alpha\p@%
\def\pst@tempB{\pst@number\chart@ColorIndex}%
% \psDEBUG[psChart:wave:color]{\pst@tempB}%
\global\advance\pst@cnta by \@ne%
\if@chartUserColor\else%
\def\chart@FillColor{chartFillColor\the\pst@cnta}%
\ifnum\psk@chartColor>0\relax%
\xglobal\definecolor{\chart@FillColor}{wave}{\pst@tempB}%
\else\xglobal\definecolor{\chart@FillColor}{gray}{\pst@tempB}\fi%
\fi%
\pst@dimo=0.5\pst@dimn\advance\pst@dimo by 0.5\pst@dimm% half angle of the chart
\global\@chartSepfalse%
\if$\psk@chartSepValues$\else%
\psForeach{\chart@tempC}{\psk@chartSepValues}{\ifnum\chart@tempC=\the\pst@cnta\relax\global\@chartSeptrue\fi}%
\fi%
\if@chartSep
\ifPst@uselinecolor
\pswedge[linecolor=\pslinecolor,fillstyle=solid,fillcolor={chartFillColor\the\pst@cnta}]%
(\psk@chartSep\p@;\pst@number\pst@dimo){\pst@chartRadius}{\pst@number\pst@dimn}{\pst@number\pst@dimm}%
\else
\pswedge[linecolor={chartFillColor\the\pst@cnta},fillstyle=solid,fillcolor={chartFillColor\the\pst@cnta}]%
(\psk@chartSep\p@;\pst@number\pst@dimo){\pst@chartRadius}{\pst@number\pst@dimn}{\pst@number\pst@dimm}%
\fi
\pst@dima=\pst@chartRadius\advance\pst@dima by \psk@chartSep\p@%
\pnode(\pst@dima;\pst@number\pst@dimo){psChart\the\pst@cnta}%
\pst@dimb=\psk@chartNodeI\pst@dima%
\pst@dimc=\psk@chartNodeO\pst@dima%
\pnode(\pst@dimb;\pst@number\pst@dimo){psChartI\the\pst@cnta}%
\pnode(\pst@dimc;\pst@number\pst@dimo){psChartO\the\pst@cnta}%
\else%
\ifPst@uselinecolor
\pswedge[linecolor=\pslinecolor,fillstyle=solid,fillcolor={chartFillColor\the\pst@cnta}](0,0)%
{\pst@chartRadius}{\pst@number\pst@dimn}{\pst@number\pst@dimm}%
\else
\pswedge[linecolor={chartFillColor\the\pst@cnta},fillstyle=solid,fillcolor={chartFillColor\the\pst@cnta}](0,0)%
{\pst@chartRadius}{\pst@number\pst@dimn}{\pst@number\pst@dimm}%
\fi
\pnode(\pst@chartRadius;\pst@number\pst@dimo){psChart\the\pst@cnta}%
\pst@dima=\pst@chartRadius%
\pst@dimb=\psk@chartNodeI\pst@dima%
\pst@dimc=\psk@chartNodeO\pst@dima%
\pnode(\pst@dimb;\pst@number\pst@dimo){psChartI\the\pst@cnta}%
\pnode(\pst@dimc;\pst@number\pst@dimo){psChartO\the\pst@cnta}%
\fi%
\global\let\chart@alpha\chart@tempA%
\global\advance\chart@Toggle by \@ne%
\ifnum\chart@Toggle<3\relax%
\global\advance\chart@ColorIndex by 2\chart@ColorStep%
\else%
\global\chart@Toggle=0%
\global\advance\chart@ColorIndex by -\chart@ColorStep%
\fi%
}% end foreach
\ignorespaces%
}
%
\def\pscs@histogram{%
\def\chart@maxValue{\pst@number\pst@dimn}% max of the data
\pst@@divide\pst@dimn\pst@chartHeight% maxValue/maxHeight
\psDEBUG[pscs@histogram]{chart@maxValue=\chart@maxValue}
\psDEBUG[pscs@histogram]{(maxValue/maxHeight)pst@dimg=\pst@number\pst@dimg}
\psDEBUG[pscs@histogram]{pst@chartHeight=\the\pst@chartHeight}
\pst@dimo=28.46\pst@dimg
\edef\pst@chartUnit{\pst@number\pst@dimo}
% \psaxes[axesstyle=frame,
% dy=1cm,Dy=\pst@number\pst@dimo](\the\pst@cnta,\the\pst@chartHeight)
\pst@dimm=0pt\pst@dimn=0pt\pst@dimo=0pt\pst@cnta=0%
\global\chart@Toggle=1
\psforeach{\chart@tempA}{\psk@chartValues}{%
\global\advance\pst@dimm by \chart@tempA pt%
\def\pst@tempB{\pst@number\chart@ColorIndex}%
\psDEBUG[psChart:wave:color]{\pst@tempB}%
\global\advance\pst@cnta by \@ne%
\if@chartUserColor\else
\def\chart@FillColor{chartFillColor\the\pst@cnta}
\ifnum\psk@chartColor>0 \xglobal\definecolor{\chart@FillColor}{wave}{\pst@tempB}%
\else\xglobal\definecolor{\chart@FillColor}{gray}{\pst@tempB}\fi%
\fi
\psframe[linecolor={chartFillColor\the\pst@cnta},fillstyle=solid,fillcolor={chartFillColor\the\pst@cnta}]%
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div sub 0)
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div add \chart@tempA\space \pst@chartUnit\space div)
\pnode(!\the\pst@cnta\space 0){psChart\the\pst@cnta}%
\pnode(!\the\pst@cnta\space \chart@tempA\space 2 div \pst@chartUnit\space div){psChartM\the\pst@cnta}%
\pnode(!\the\pst@cnta\space \chart@tempA\space \pst@chartUnit\space div){psChartT\the\pst@cnta}%
\global\advance\chart@Toggle by \@ne
\ifnum\chart@Toggle<3
\global\advance\chart@ColorIndex by 2\chart@ColorStep
\else
\global\chart@Toggle=0
\global\advance\chart@ColorIndex by -\chart@ColorStep%
\fi%
}% end foreach
}
%
\def\pst@stackList{}
\def\addbefore@stackList#1{%
\ifx\pst@stackList\@empty
\xdef\pst@stackList{#1}%
\else
\toks@{#1}%
\pst@toks\expandafter{\pst@stackList}%
\xdef\pst@stackList{\the\toks@,\the\pst@toks}%
\fi%
}
%
\def\pscs@Histogram{%
\psDEBUG[pscs@Histogram]{psk@chartStack=\psk@chartStack}%
\def\chart@maxValue{\pst@number\pst@dimn}% max of the data
\pst@@divide\pst@dimn\pst@chartHeight% maxValue/maxHeight
\psDEBUG[pscs@Histogram]{chart@maxValue=\chart@maxValue}%
\psDEBUG[pscs@Histogram]{(maxValue/maxHeight)pst@dimg=\pst@number\pst@dimg}%
\psDEBUG[pscs@Histogram]{pst@chartHeight=\the\pst@chartHeight}%
\pst@dimo=28.46\pst@dimg%
\edef\pst@chartUnit{\pst@number\pst@dimo}%
% \psaxes[axesstyle=frame,
% dy=1cm,Dy=\pst@number\pst@dimo](\the\pst@cnta,\the\pst@chartHeight)
\pst@dimm=0pt\pst@dimn=0pt\pst@dimo=0pt\pst@cnta=0%
\global\chart@Toggle=1 % for color toggling
\pst@cntn=0 % stacked step
\pst@cnto=0 % for a stacked view
\pst@cntp=\psk@chartStack % for a stacked view
\def\pst@stackList{}
\psDEBUG[pscs@Histogram]{psk@chartStack=\the\pst@cntp}%
\psforeach{\chart@tempA}{\psk@chartValues}{% the loop
\ifnum\pst@cntp>0 % stacked version?
\advance\pst@cnto by \@ne % increase
\psDEBUG[pscs@Histogram]{chart@tempA=\chart@tempA}%
\expandafter\addbefore@stackList\expandafter{\chart@tempA}%
\psDEBUG[pscs@Histogram]{stack list=\pst@stackList}%
\ifnum\pst@cnto=\pst@cntp % draw?
\pst@cnto=\psk@chartStack\advance\pst@cnto by \m@ne
\psforeach{\chart@tempB}{\pst@stackList}{% the stack loop
\global\pst@cnta=\pst@cntn % we do not need the value
\psDEBUG[pscs@Histogram]{pst@cnto=\the\pst@cnto}%
\psDEBUG[pscs@Histogram]{pst@chartStackDepth=\the\pst@chartStackDepth}%
\psDEBUG[pscs@Histogram]{pst@chartStackWidth=\the\pst@chartStackWidth}%
\edef\pst@tempA{\the\pst@cnto}%
\psDEBUG[pscs@Histogram]{pst@tempA=\pst@tempA}%
\ifnum\pst@cnto>0
\pst@dima=\pst@chartStackDepth%
\pst@dimb=\pst@chartStackWidth%
\divide \pst@dima by \pst@tempA%
\divide \pst@dimb by \pst@tempA%
\else\pst@dima=\z@ \pst@dimb=\z@%
\fi%
\rput(\the\pst@dima, \the\pst@dimb){\pscs@Histogram@i{\chart@tempB}}
\advance\pst@cnto by \m@ne % decrease stack counter
}%
\advance\pst@cntn by \tw@ % increase
\def\pst@stackList{}% reset stack list
\pst@cnto=0 % reset stack counter
\fi%
\else%
\pscs@Histogram@i{\chart@tempA}% non stacked version
\fi%
}% end foreach
}
%
\def\pscs@Histogram@i#1{% draw the 3d-like bar
\def\pst@tempB{\pst@number\chart@ColorIndex}%
\global\advance\pst@cnta by \@ne%
\if@chartUserColor\else
\def\chart@FillColor{chartFillColor\the\pst@cnta}
\ifnum\psk@chartColor>0 \xglobal\definecolor{\chart@FillColor}{wave}{\pst@tempB}%
\else\xglobal\definecolor{\chart@FillColor}{gray}{\pst@tempB}\fi%
\fi
\pspolygon[fillstyle=solid,fillcolor={chartFillColor\the\pst@cnta}]%
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div sub 0)% ll
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div add 0)% lr
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div 1.5 mul add \psk@chartSep\space 56.92 div)% 'lr
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div 1.5 mul add
\psk@chartSep\space 56.92 div #1 \pst@chartUnit\space div add )% 'ur
(!\the\pst@cnta\space \psk@chartSep\space 56.92 div sub
\psk@chartSep\space 56.92 div #1 \pst@chartUnit\space div add )% 'ul
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div sub #1 \pst@chartUnit\space div)%ul
\psline%
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div add 0)% lr
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div add #1 \pst@chartUnit\space div)
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div sub #1 \pst@chartUnit\space div)%ul
\psline%
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div add #1 \pst@chartUnit\space div)
(!\the\pst@cnta\space \psk@chartSep\space 28.46 div 1.5 mul add
\psk@chartSep\space 56.92 div #1 \pst@chartUnit\space div add )% 'ur
\pnode(!\the\pst@cnta\space 0){psChart\the\pst@cnta}%
\pnode(!\the\pst@cnta\space #1 2 div \pst@chartUnit\space div){psChartM\the\pst@cnta}%
\pnode(!\the\pst@cnta\space #1 \pst@chartUnit\space div){psChartT\the\pst@cnta}%
\global\advance\chart@Toggle by \@ne
\ifnum\chart@Toggle<3
\global\advance\chart@ColorIndex by 2\chart@ColorStep
\else
\global\chart@Toggle=0
\global\advance\chart@ColorIndex by -\chart@ColorStep%
\fi%
\global\advance\chart@ColorIndex by 1pt
}
%
\define@key[psset]{pstricks-add}{cancelType}{\pst@expandafter\psk@@cancelType{#1xx}\@nil}
\def\psk@@cancelType#1#2\@nil{%
\ifx\relax#1\relax\def\psk@cancelType{2}\else% x
\ifx#1b\def\psk@cancelType{2}\else% \
\ifx#1s\def\psk@cancelType{1}\else% /
\def\psk@cancelType{0}\fi\fi\fi}% x every other
\psset[pstricks-add]{cancelType=}% x, crossing
\def\psCancel{\def\pst@par{}\pst@object{psCancel}}% by Stefano Baroni 2008-06-21
\def\psCancel@i{\pst@makebox\psCancel@iii}
\def\psCancel@iii{%
\begingroup
\solid@star
\use@par
\pst@dima=\pslinewidth
\advance\pst@dima by \psframesep
\pst@dimc=\wd\pst@hbox\advance\pst@dimc by \pst@dima
\pst@dimb=\dp\pst@hbox\advance\pst@dimb by \pst@dima
\pst@dimd=\ht\pst@hbox\advance\pst@dimd by \pst@dima
\setbox\pst@hbox=\hbox{%
\ifpsboxsep\kern\pst@dima\fi
\begin@ClosedObj
\addto@pscode{
\psk@cornersize % arcradius boolean
\pst@number\pst@dima neg
\pst@number\pst@dimb neg
\pst@number\pst@dimc
\pst@number\pst@dimd
.5
\if@star \tx@Frame \else
CLW mul /a ED % the middle of the line
3 -1 roll 2 copy gt { exch } if
a sub /y2 ED
a add /y1 ED
2 copy gt { exch } if
a sub /x2 ED
a add /x1 ED
pop pop % delete arc values
\ifnum\psk@cancelType<\tw@ % / or x
x1 y1 moveto
x2 y2 lineto
\fi%
\ifnum\psk@cancelType=\@ne\else % \ or x
x2 y1 moveto
x1 y2 lineto
\fi
\fi
}%
\def\pst@linetype{2}%
\showpointsfalse
\end@ClosedObj
\box\pst@hbox
\ifpsboxsep\kern\pst@dima\fi%
}%
\ifpsboxsep\dp\pst@hbox=\pst@dimb\ht\pst@hbox=\pst@dimd\fi
\leavevmode\box\pst@hbox
\endgroup%
}
%
\newcount\psVectorCtr
\define@boolkey[psset]{pstricks-add}[Pst@]{markAngle}[true]{}
\psset[pstricks-add]{markAngle=false}
%
\newpsstyle{psMarkAngleStyle}{arrows=->,arrowsize=4pt}
\newpsstyle{psMarkAngleLineStyle}{linestyle=dotted,arrows=-}
%
\def\psStartPoint{\@ifnextchar[{\psStartPoint@i}{\psStartPoint@i[Vector]}}
\def\psStartPoint@i[#1](#2){%
\global\psVectorCtr=\@ne
\gdef\psVectorName{#1}
\pnode(#2){#10}
\pst@getcoor{#2}\pst@tempA%
\pstVerb{tx@Dict begin
\pst@tempA
\pst@number\psyunit div /cp.Y exch def
\pst@number\psxunit div /cp.X exch def end }}
%
\def\psVector{\pst@object{psVector}}
\def\psVector@i(#1){%
\pst@killglue%
\addbefore@par{arrows=->,arrowsize=6pt}%
\pst@getcoor{#1}\pst@tempCoor%
\begingroup
\use@par%
\rput(! cp.X cp.Y ){%
\psline(0,0)(#1)%
\ifPst@markAngle
\psarc[style=psMarkAngleStyle](0,0){1}{0}{!\pst@tempCoor exch atan}%
\psline[style=psMarkAngleLineStyle](1.5,0)%
\fi}%
\pnode(! \pst@tempCoor \pst@number\psyunit div cp.Y add exch
\pst@number\psxunit div cp.X add exch ){\psVectorName\the\psVectorCtr}%
\global\advance\psVectorCtr by \@ne%
\endgroup%
\pst@Verb{%tx@Dict begin
\pst@tempCoor
\pst@number\psyunit div cp.Y add /cp.Y exch def
\pst@number\psxunit div cp.X add /cp.X exch def %end
}%
\ignorespaces}
%
\define@key[psset]{pstricks-add}{basename}{\def\psk@basename{#1}}%
\psset[pstricks-add]{basename=}%
%
\def\psCircleTangents{\pst@object{psCircleTangents}}
\def\psCircleTangents@i(#1){\@ifnextchar({\psCircleTangents@ii(#1)}{\psCircleTangents@iii(#1)}}%
\def\psCircleTangents@ii(#1)(#2)#3{% (viewpoint) (circle) {radius}
\pst@killglue%
\begingroup%
\pst@getlength{#3}\pst@LengthA%
\addbefore@par{basename=CircleT}%
\use@par%
\edef\@cmd{\noexpand\psEllipseTangentsN(#2)(! \pst@LengthA dup %
\pst@number\psxunit div exch \pst@number\psyunit div )(#1){\psk@basename}}%
\@cmd%
\endgroup%
\ignorespaces%
}%
\def\psCircleTangents@iii(#1)#2(#3)#4{% two circles--- (Cntr1){radius1}(Cntr2){radius2}
\pst@killglue%
\begingroup%
\pst@getlength{#2}\pst@LengthA% radius1
\pst@getlength{#4}\pst@LengthB% radius2
\addbefore@par{basename=CircleT}%
\use@par%
\psLCNodeVar(#1)(#3)(! \pst@LengthA \pst@number\psrunit div dup \pst@LengthB %
\pst@number\psrunit div % r1 r1 r2 on stack
3 copy add div /tti ED sub dup 0 eq % r1 r1-r2 on stack
{ pop pop /ttx 1000 def }{ div dup abs 1000 gt % r1/(r1-r2) on stack
{ 0 gt { ttx 1000 def }{ ttx -1000 def } ifelse}{ /ttx ED } ifelse } ifelse %
1 tti sub tti )% 1-tti tti on stack
{\psk@basename C1}%
% tti=r1/(r1+r2), ttx=r1/(r1-r2)
\psLCNodeVar(#1)(#3)(! 1 ttx sub ttx ){\psk@basename C2}% outside crossing pt
\expandafter\psCircleTangents@ii\expandafter(\psk@basename C1)(#1){#2}%
\pnode(CircleT1){\psk@basename I1}\pnode(CircleT2){\psk@basename I3}%
\expandafter\psCircleTangents@ii\expandafter(\psk@basename C1)(#3){#4}%
\pnode(CircleT1){\psk@basename I2}\pnode(CircleT2){\psk@basename I4}%
% external tangents
\expandafter\psCircleTangents@ii\expandafter(\psk@basename C2)(#1){#2}%
\pnode(CircleT1){\psk@basename O2}\pnode(CircleT2){\psk@basename O4}%
\expandafter\psCircleTangents@ii\expandafter(\psk@basename C2)(#3){#4}%
\pnode(CircleT1){\psk@basename O1}\pnode(CircleT2){\psk@basename O3}%
\endgroup%
\ignorespaces%
}%
%
\def\psEllipseTangents{\pst@object{psEllipseTangents}}
\def\psEllipseTangents@i(#1)(#2)(#3){% (Center)(axes)(viewpoint)
\pst@killglue{%
\use@par% only one parameter matters---psk@basename
\ifx\psk@basename\@empty \def\psk@basename{EllipseT}\fi %
\edef\@cmd{\noexpand\psEllipseTangentsN(#1)(#2)(#3){\psk@basename}}%
\@cmd}\ignorespaces}%
%
\def\psEllipseTangentsN(#1)(#2)(#3)#4{% (xe,ye)(a,b)(xP,yP){basename} % no optional arguments
\pst@killglue%
\pnode(#1){E@Cntr}% center of ellipse
\pnode(#2){@@TMP}% semimajor, semiminor
\pnode(#3){@@@TMP}% viewpt
\pst@getcoor{#3}\my@tempC% external viewpoint
\AtoB(E@Cntr)(@@@TMP){@TMP}% center to viewpoint
\ifnum\Pst@Debug>0
\shownode(E@Cntr)%
\shownode(@TMP)%
\shownode(@@@TMP)%
\fi%
\pnode(!
\psGetNodeCenter{@@TMP}\space
/B @@TMP.y def% semiminor
/A @@TMP.x def% semimajor
/A2 A dup mul def /B2 B dup mul def
/C2 B A div dup mul def
\psGetNodeCenter{@TMP}\space
/Xp @TMP.x def /Yp @TMP.y def % center to viewpoint
/Xp2 Xp dup mul def /Yp2 Yp dup mul def
\psGetNodeCenter{E@Cntr}\space
/Xc E@Cntr.x def /Yc E@Cntr.y def
/R Xp2 A2 sub C2 mul Yp2 add Sqrt def % R=Sqrt{(Xp2-A2) C2 + Yp2}
/Q C2 Xp2 mul Yp2 add def % C2 Xp2 + Yp2
/Xta B2 Xp mul A Yp R mul mul sub Q div def
/Yta Yp Xp R mul A div add B2 mul Q div def
/Xtb B2 Xp mul A Yp R mul mul add Q div def
/Ytb Yp Xp R mul A div sub B2 mul Q div def
0 Xta Yp mul Yta Xp mul sub gt % swap a, b
{ /A Xta def /B Yta def /Xta Xtb def /Yta Ytb def /Xtb A def /Ytb B def } if
Xta Xc add Yta Yc add ) {#42}%
\pnode(! Xtb Xc add Ytb Yc add ) {#41}%
\ignorespaces}%
%
\define@key[psset]{pstricks-add}{rotate}{\def\psk@rotate{#1 }}
\psset[pstricks-add]{rotate=0}
\def\pst@saveDegrees{}
\def\psKiviat{\pst@object{psKiviat}}
\def\psKiviat@i#1#2{% #1: number of edges #2 radius
\gdef\pst@saveDegrees{#1}
\begingroup%
\degrees[#1]%
\SpecialCoor%
\addbefore@par{rotate=0}
\use@par%
\global\let\psk@@rotate\psk@rotate
\def\pst@Coordinates{}
\psLoop{#1}{\xdef\pst@Coordinates{\pst@Coordinates(#2;\the\psLoopIndex)}}
\rput{\psk@rotate}(0,0){\expandafter\pspolygon\pst@Coordinates
\multido{\nA=0+1}{#1}{\uput{\pslabelsep}[\nA]{*0}(#2;\nA){\psPutYLabel{\nA}}}}
\endgroup%
\ignorespaces}
%
\def\psKiviatLine{\pst@object{psKiviatLine}}
\def\psKiviatLine@i#1{{%
\addbefore@par{showpoints}%
\use@par%
\degrees[\pst@saveDegrees]%
\psKiviatLine@ii#1\@nil}}%
\def\psKiviatLine@ii#1,#2\@nil{%
\global\pst@cntm=0
\global\pst@cntn=1
\begingroup
\xdef\pst@saveCoors{}
\psKiviatLine@iii#1,#2,#1,,\@nil
\rput{\psk@@rotate}(0,0){\expandafter\pspolygon\pst@saveCoors}
}
\def\psKiviatLine@iii#1,#2,#3\@nil{%
\ifx\relax#2\relax\else%\psline(#1;\the\pst@cntm)(#2;\the\pst@cntn)
\xdef\pst@saveCoors{\pst@saveCoors(#1;\the\pst@cntm)}\fi
\advance\pst@cntm\@ne
\advance\pst@cntn\@ne
\ifx\relax#3\relax\endgroup\else\psKiviatLine@iii#2,#3\@nil\fi}
%
\def\psKiviatTicklines{\pst@object{psKiviatTicklines}}
\def\psKiviatTicklines@i#1#2{{% n, radius
\degrees[#1]%
\use@par%
\pstFPDiv\pst@tempN{#2}{\psk@Dx}%
\pst@cntm=\pst@tempN \advance\pst@cntm by \m@ne
\multido{\rA=\psk@Dx+\psk@Dx}{\the\pst@cntm}{%
\def\pst@Coordinates{}%
\psLoop{#1}{\xdef\pst@Coordinates{\pst@Coordinates(\rA;\the\psLoopIndex)}}%
\rput{\psk@@rotate}(0,0){\expandafter\pspolygon\pst@Coordinates}%
}%
}\ignorespaces}%
%
\def\psKiviatAxes{\pst@object{psKiviatAxes}}
\def\psKiviatAxes@i#1#2{{%
\degrees[#1]
\use@par%
\multido{\iA=0+1}{#1}{\rput{\psk@@rotate}(0,0){\psline(0,0)(#2;\iA)}}%
}\ignorespaces}%
%
\def\resetOptions{%
\def\pst@linetype{0}%
\pstScalePoints(1,1){}{}%
\psset[pstricks-add]{%
hooklength=3mm, hookwidth=1mm,
ArrowFill=true,
ArrowInside={}, ArrowInsidePos=0.5,
ArrowInsideNo=1, ArrowInsideOffset=0,
randomPoints=1000,color=false,
whichabs={},whichord={},
plotfuncx={},plotfuncy={},buildvector=false,
Derive={},adamsorder=4,
Tnormal=false,
braceWidth=2\pslinewidth,
bracePos=0.5,
braceWidthInner=10\pslinewidth,
braceWidthOuter=10\pslinewidth,
chartNodeI=0.75,
chartNodeO=1.5,
markAngle=false,
}}
%
\resetOptions
%
\catcode`\@=\PstAtCode\relax
%
%% END: pstricks-add.tex
\endinput
Mini Shell