%% $Id: pst-arrow.tex 316 2021-11-16 14:19:22Z herbert $ %% %% This is file `pst-arrow.tex', %% %% IMPORTANT NOTICE: %% %% Package `pst-arrow.tex' %% %% Copyright 2021 Herbert Voss %% %% 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: %% `pst-arrow' is a PSTricks package for additional arrows %% \csname PSTarrowLoaded\endcsname \let\PSTarrowLoaded\endinput % % Requires some packages \ifx\PSTricksLoaded\endinput\else\input pstricks \fi \ifx\PSTXKeyLoaded\endinput\else \input pst-xkey \fi % \def\fileversion{0.05} \def\filedate{2021/11/16} \message{`pst-arrow' v\fileversion, \filedate\space (dr,hv)} % \edef\PstAtCode{\the\catcode`\@} \catcode`\@=11\relax \pst@addfams{pst-arrow} % \def\psBigArrow{\pst@object{psBigArrow}} \def\psBigArrow@i(#1)(#2){% \addbefore@par{doublesep=1cm} \begin@ClosedObj \pssetlength\pst@dimm{\psdoublesep} \pst@getcoor{#1}\pst@tempA \pst@getcoor{#2}\pst@tempB \addto@pscode{ /Width \pst@number\pst@dimm def \pst@tempA % x1 y1 \pst@tempB % x1 y1 x2 y2 exch % x1 y1 y2 x2 4 -1 roll % y1 y2 x2 x1 sub /dxA ED % y1 y2 exch sub /dyA ED % dx dy dyA dxA atan % alpha \pst@tempA translate rotate 0 0 moveto 0 Width rlineto \pst@tempB \pst@tempA Pyth2 /ALength ED ALength Width sub 0 rlineto 0 Width 2 div rlineto Width dup -1.5 mul rlineto Width neg dup 1.5 mul rlineto 0 Width 2 div rlineto 0 Width neg lineto closepath }% \end@ClosedObj } %% %% Reqrite most of the existing macros %% \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 }> % \catcode`\@=\PstAtCode\relax % %% END: pst-arrow.tex \endinput