summaryrefslogtreecommitdiff
path: root/graphics/pstricks/contrib/pst-arrow/tex/pst-arrow.tex
blob: 3dee550dfd71c7f13a1031e3ad0e396366844b26 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
%% $Id: pst-arrow.tex 164 2021-08-25 19:26:42Z herbert $
%%
%% This is file `pst-arrow.tex',
%%
%% IMPORTANT NOTICE:
%%
%% Package `pst-arrow.tex'
%%
%% Copyright 2021 Herbert Voss <hvoss@tug.org>
%%
%% 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.04}
\def\filedate{2021/08/25}
\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 % x y 
    \pst@tempB % x y
    exch       % x y y x
    4 -1 roll   % y y x x
    sub        % y y dx
    3 1 roll   % dx y y
    sub        % dx dy
    exch       % dy dx
    atan neg      % alpha
    \pst@tempA
    translate
    rotate     
    0 0 moveto
    0 Width 2 div rlineto % |
    \pst@tempB \pst@tempA Pyth2 Width 1.5 mul sub 0 rlineto
    0 Width 1.5 div rlineto
    Width 1.5 mul dup neg rlineto
    Width 1.5 mul neg dup rlineto
    0 Width 1.5 div rlineto
    \pst@tempB \pst@tempA Pyth2 neg Width 1.5 mul add 0 rlineto
    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