% arrows.jam
% Rick Beach, June 22, 1982 11:32 am
% Maureen Stone October 14, 1982 9:21 am

% !lw - line width
% al - total arrow length in relative line width units
% ahl - arrow head length
% ahw - arrow head width
% afl - arrow feather length
% afw - arrow feather width
% lw2 - line width / 2
% lw45 - line width * sqrt(2)

% touch four points for cubic to draw arrow 
% <linewidth> arrow
(arrow) {(!lw) .exch .def (bx) 0 .def conformal .touch .touch .touch .touch .cubicmapper !lw !lw .cubicscale (!al) .getarc !lw .div .def arrowpattern}.cvx .def

% draw arrow given four Bezier control points
% <x0 y0 x1 y1 x2 y2 x3 y3> <linewidth> givenarrow
(givenarrow) {.true .setfat
(!lw) .exch .def conformal (bx) 0 .def .cubicmapper !lw !lw .cubicscale (!al) .getarc !lw .div .def arrowpattern}.cvx .def

% arrow heads are drawn clockwise from the bottom of the shaft
% the first (x,y) point is duplicated by a 2 .copy for the use of the arrow feather

% triangular arrowhead
% <arrowhead-length> <arrowhead-width> arrowhead1
(arrowhead1) {2.0 .div (!ahw) .exch .def 2.0 .div (!ahl) .exch .def !ahl -0.5 2 .copy move !ahl !ahw .neg line 0 0 line !ahl !ahw line !ahl 0.5 line}.cvx .def

% blunt arrowhead
% <arrowhead-length> <arrowhead-width> arrowhead2
(arrowhead2) {2.0 .div (!ahw) .exch .def 2.0 .div (!ahl) .exch .def (!lw45) 1 2 .sqrt .div .def (!lwr2) 2 .sqrt .def
!lwr2 0.5 .add -0.5 2 .copy move !ahl !lw45 .add !ahw !lw45 .sub .neg line !ahl !ahw .neg line 0 0 line !ahl !ahw line !ahl !lw45 .add !ahw !lw45 .sub line !lwr2 0.5 .add 0.5 line}.cvx .def

% trimmed blunt arrowhead
% <arrowhead-length> <arrowhead-width> arrowhead3
(arrowhead3) {2.0 .div (!ahw) .exch .def 2.0 .div (!ahl) .exch .def (!lw45) 1 2 .sqrt .div .def (!lwr2) 2 .sqrt .def
!lwr2 0.5 .add -0.5 2 .copy move !ahl !lwr2 .add !ahw .neg line
!ahl !ahw .neg line 0 0 line !ahl !ahw line !ahl !lwr2 .add !ahw line
!lwr2 0.5 .add 0.5 line}.cvx .def

% round arrow head
% <arrowhead-length> <arrowhead-width> arrowhead4
(arrowhead4) {2.0 .div (!ahw) .exch .def 2.0 .div (!ahl) .exch .def !ahl -0.5 2 .copy move !ahl !ahw .neg line 0 0  0 0  !ahl !ahw .ccurveto !ahl 0.5 line}.cvx .def

% round arrow head
% <arrowhead-length> <arrowhead-width> arrowhead5
(arrowhead5) {2.0 .div (!ahw) .exch .def 2.0 .div (!ahl) .exch .def !ahl -0.5 2 .copy move !ahl !ahw .neg 2 .copy 0 0 .ccurveto !ahl !ahw 2 .copy !ahl 0.5 .ccurveto}.cvx .def

% round arrow head
% <arrowhead-length> <arrowhead-width> arrowhead6
(arrowhead6(arrowpattern) (4 2 arrowhead4 arrowfeather1 0 drawstroke).cvx .def black) {2.0 .div (!ahw) .exch .def 2.0 .div (!ahl) .exch .def !ahl -0.5 2 .copy move !ahl !ahw .neg 2 .copy 0 0 .ccurveto !ahl !ahw 2 .copy !ahl 0.5 .ccurveto}.cvx .def

% square-end tail for the arrow
% arrowfeather1
(arrowfeather1) {!al 0.5 line !al -0.5 line line}.cvx .def

% tapered tail for the arrow
% arrowfeather2
(arrowfeather2) {!al 0 line line}.cvx .def

% traditional feather, slopes are identical to the arrowhead
% <feather-length> <feather-width> arrowfeather3
(arrowfeather3) {
2.0 .div (!afw) .exch .def
2.0 .div (!afl) .exch .def
(!slope) !ahl !ahw .div .def
!al !afl .sub 0.5 !slope .mul .add 0.5 line
!al !afl .sub !afw !slope .mul .add !afw line
!al !afw line
!al !afw !slope .mul .sub 0 line
!al !afw .neg line
!al !afl .sub !afw !slope .mul .add !afw .neg line
!al !afl .sub 0.5 !slope .mul .add -0.5 line line}.cvx .def

% sloped feather, chopped square at the tail
% <feather-length> <feather-width> arrowfeather4
(arrowfeather4) {
2.0 .div (!afw) .exch .def
2.0 .div (!afl) .exch .def
(!slope) !ahl !ahw .div .def
!al !afl .sub 0.5 !slope .mul .add 0.5 line
!al !afl .sub !afw !slope .mul .add !afw line
!al !afw line
!al !afw .neg line
!al !afl .sub !afw !slope .mul .add !afw .neg line
!al !afl .sub 0.5 !slope .mul .add -0.5 line line}.cvx .def

% vertical feather, sloped inward at the tail
% <feather-length> <feather-width> arrowfeather5
(arrowfeather5) {
2.0 .div (!afw) .exch .def
2.0 .div (!afl) .exch .def
(!slope) !ahl !ahw .div .def
!al !afl .sub 0.5 line
!al !afl .sub !afw line
!al !afw line
!al !afw !slope .mul .sub 0 line
!al !afw .neg line
!al !afl .sub !afw .neg line
!al !afl .sub -0.5 line line}.cvx .def

% ribbon cut arrow feather
% <tail-width> arrowfeather6
(arrowfeather6) {
2.0 .div (!afw) .exch .def
(!slope) !ahl !ahw .div .def
!al !afw line
!al !afw !slope .mul .sub 0 line
!al !afw .neg line line}.cvx .def

% arrow pattern: <arrowhead> <arrowfeather> <0 drawstroke OR drawarea>
(arrowpattern) (3 3 arrowhead1 arrowfeather1 drawarea) .cvx .def

(a1) ((arrowpattern) (.75 1.5 arrowhead1 2 1.5 arrowfeather3 .gray drawarea black 0 drawstroke).cvx .def ).cvx .def
(a2) ((arrowpattern) (4 2 arrowhead1 arrowfeather1 black drawarea).cvx .def).cvx .def
(a3) ((arrowpattern) (4 4 arrowhead2 arrowfeather1 black drawarea).cvx .def).cvx .def
(a4) ((arrowpattern) (4 4 arrowhead3 arrowfeather1 black 0 drawstroke).cvx .def).cvx .def
(a5) ((arrowpattern) (4 2 arrowhead1 2 arrowfeather6 black drawarea).cvx .def).cvx .def
(a6) ((arrowpattern) (4 2 arrowhead1 15 2 arrowfeather3 .gray drawarea black 0 drawstroke).cvx .def).cvx .def
(a7) ((arrowpattern) (.75 1.5 arrowhead1  1.5 arrowfeather6 black drawarea).cvx .def ).cvx .def
(a8) ((arrowpattern) (.75 1.5 arrowhead1 4 1.5 arrowfeather5 black 0 drawstroke).cvx .def ).cvx .def
(a9) ((arrowpattern) (4 2 arrowhead1 arrowfeather2 .gray drawarea black 0 drawstroke).cvx .def).cvx .def