On 2024-06-04 9:40 am, Paolo Prete wrote:
That's impressive, thanks!!I encourage the maintainers of the code to replace the triangle shape in native LilyPond with your code, given that the actual shape is pretty weirdand the gap with the segment is not nice to look at...
I had hoped to keep this private, but now I guess I have to share with the class.
My apologies for anyone who dares to read through the craziness. It was never really intended to be shared broadly with the mailing list. The PDFs will make absolutely no sense on their own. The LY files are a mixture of code and comments, documenting my workflow. The idea was to solve Paolo's problem but do it in a step-by-step way. It gets pretty rambling here and there, so again I apologize for anyone who decides to dive in and look at it. Ultimately, each stage of experimentation is there. I did start to move faster in the Scheme approach, so there might be fewer stopping points. I had to remember to work in smaller chunks to be able to document things.
The final iteration of code in draw-arrow-2.ly is pretty much the "solution" to the problem.
All that said, it was a pretty fun activity. As a developer, we rarely show the dirty bits of the process. We like to wait until everything is neatly wrapped in a bow and glitter, mainly to hide all our mistakes, wrong paths taken, etc. :)
P.S. There might be one or two potentially disparaging comments aimed at LilyPond. I must also apologize for them. Hopefully, no LilyPond devs take them too harshly. Again, this code was never really intended for public reveal. I would have cleaned up such comments and written them with more tact if given the chance.
-- Aaron Hill
\version "2.25.13"
%% First: See what Lilypond has built-in that we can leverage.
%%
%% \arrow-head is almost useable, but its shape options are not great.
%% \draw-line looks perfectly useable for the main part of our arrow.
%% \path is somewhat a brute-force tool, so let's call it last resort.
%% \polygon is better than \path in terms of usability.
%% \postscript is even worse than \path; too much power, little gain.
%% Ooh, \triangle. That's almost exactly what we need.
%%
%% Okay, I think we have an initial plan. Use \draw-line for the main
%% body of the arrow. \triangle for the ends. We may need to \scale
%% the arrow heads to lengthen them, unless we are okay with perfect
%% equilateral triangles. Hmm, that could/should be an adjustable
%% parameter.
%% Let's try putting things together manually and see what is possible.
\paper { #(set-paper-size "a7") tagline = ##f }
\markup {
\concat {
\triangle ##f % Keeping one side unfilled to tell them apart.
\draw-line #'(5 . 0)
\triangle ##t
}
}
%% Interesting result. At least we know the default thickness is the
%% same between the line and triangle (unfilled). We need to rotate
%% those triangles and keep them aligned with the line.
%%
%% That's curious. The \rotate command is organized in the text align-
%% ment section. Does that mean it might not be suited for shapes?
%% Spidey-sense⢠tingling.
%%
%% Maths: How far do we need to spin this triangle? The right side of
%% the unfilled triangle is sitting 60 degrees up from the ground.
%% That means it is falling 30 degrees away from up-right. We need to
%% spin it 30 degrees clockwise. The example in the documentation
%% suggests rotations are counter-clockwise. They also mention the
%% center of the stencil is the rotation point.
\markup {
\concat {
\rotate #-30 \triangle ##f
\draw-line #'(5 . 0)
\triangle ##t
}
}
%% Okay. The documentation lied. That was not from the center of the
%% object. But I gather the center is being calculated from the bounds
%% of the stencil, which are rectangular. We may need to provide our
%% own bounds. On a positive note, we got the triangle pointing in the
%% right direction. Let's celebrate and fix the filled triangle.
\markup {
\concat {
\rotate #-30 \triangle ##f
\draw-line #'(5 . 0)
\rotate #30 \triangle ##t
}
}
%% More maths: We know an equilateral sits perfectly in a circle. And
%% that circle sits perfectly in a square. The coordinates for the
%% three points of a triangle can be fairly easily calculated. Let's
%% go with the orientation based on the \triangle command.
%%
%% Web search... height of triangle is root(3)/2 times its base.
%% Oh, dear. The documentation does not specify how wide the shape
%% is expected to be rendered. It also seems to change size based on
%% the extroversion parameter, which is used to adjust whether the ink
%% should favor being outside the bounds of the shape or to sit inside
%% the bounds. Do we dig into the source code, or should we just play
%% around and gather empirical data? I have a hunch the width is one.
\markup {
\combine
\triangle ##f
\lower #0.2 \draw-line #'(1 . 0)
}
%% Drat. Not one.
\markup {
\hspace #3
\combine
\triangle ##f
\lower #0.2 \draw-line #'(2 . 0)
}
%% Okay, pretty close to two. Seeing as we clearly are in fractional
%% territory, the "nice" numbers must be hidden. No more time playing.
%% Time to dig into the source code, and... oh, what is that code?!
%% It is a hacked mess of values found by trial and error. This type
%% of programming is not going to cut it in the end. We are definitely
%% going to need develop our own triangle function if we run into any
%% precision issues down the road.
\markup {
\combine
\triangle ##f
\lower #0.2 \draw-line #'(1.8 . 0)
}
%% But at least the hardcoded value gets us our width. Let's verify
%% height as well.
\markup {
\hspace #3
\overlay {
\triangle ##f
\lower #0.2 \draw-line #'(1.8 . 0)
\draw-line #`(0 . ,(* 1.8 0.86))
}
}
%% Can we draw the circumcircle?
\markup {
\combine
\triangle ##f
\translate #`(0.9 . ,(* 1.8 0.29))
\with-color #red \draw-circle #1.04 #0.05 ##f
}
%% Pretty close, just need to adjust for line thickness.
\markup {
\hspace #3
\combine
\translate #`(0.9 . ,(* 1.8 0.29))
\with-color #red \draw-circle #(+ 1.04 0.02) #0 ##t
\triangle ##f
}
%% Since we have a circle with the bounds we want, let's apply them.
%% But let's make a variable so we can encapsulate some of our work.
%% Also, why were we not using \general-align?!
baseTriangle = \markup
\general-align #Y #CENTER
\with-dimensions-from
\translate #'(0 . 0.52)
\draw-circle #1.06 #0 ##t
\general-align #X #CENTER
\triangle ##f
\markup {
\concat {
\rotate #-30 \baseTriangle
\draw-line #'(5 . 0)
\rotate #30 \baseTriangle
}
}
%% Wow. Those are looking pretty good! Now we need to shrink the
%% the bounds so the arrow heads can properly concatenate with the
%% body of the arrow.
%%
%% Let's take a look at the extents we are dealing with.
baseTriangle = \markup
\general-align #Y #CENTER
\with-dimensions-from
\translate #'(0 . 0.52)
\draw-circle #1.06 #0 ##t
\general-align #X #CENTER
\triangle ##f
baseTriangleWithExtent = \markup
\combine
\with-color #green
\override #'(box-padding . 0)
\override #'(thickness . 0.2) \box
\with-dimensions-from \baseTriangle \null
\baseTriangle
leftTriangle = \markup
\rotate #-30 \baseTriangleWithExtent
leftTriangleWithExtent = \markup
\combine
\with-color #magenta
\override #'(box-padding . 0)
\override #'(thickness . 0.2) \box
\with-dimensions-from \leftTriangle \null
\leftTriangle
\markup {
\concat {
\leftTriangleWithExtent
\draw-line #'(5 . 0)
\rotate #30 \baseTriangle
}
}
%% To my eye, the magenta bound is center-aligned with the triangle.
%% Let's try shrinking the outer extent. Oh, the built-in \pad*
%% commands appear not to accept negative inputs. We need a \deflate
%% command of some sort, or perhaps \inflate that accepts negatives.
#(define-markup-command
(inflate layout props amount arg) (number? markup?)
(let* ((stencil (interpret-markup layout props arg))
(x-ext (ly:stencil-extent stencil X))
(y-ext (ly:stencil-extent stencil Y)))
(ly:make-stencil
(ly:stencil-expr stencil)
(interval-widen x-ext amount)
(interval-widen y-ext amount))))
leftTriangle = \markup
\inflate #-1 \rotate #-30 \baseTriangleWithExtent
leftTriangleWithExtent = \markup
\combine
\leftTriangle
\with-color #magenta
\override #'(box-padding . 0)
\override #'(thickness . 0.8) \box
\with-dimensions-from \leftTriangle \null
\markup {
\concat {
\leftTriangleWithExtent
\draw-line #'(5 . 0)
\rotate #30 \baseTriangle
}
}
%% That was a lucky guess. Let's clean up all those extent boxes.
%% Once we get into Scheme territory, this should be a lot easier. No
%% need to hardcode anything as all our values will be precisely known.
leftTriangle = \markup
\inflate #-0.94 \rotate #-30 \baseTriangle
rightTriangle = \markup
\inflate #-0.94 \rotate #30 \baseTriangle
\markup {
\concat {
\leftTriangle
\draw-line #'(5 . 0)
\rightTriangle
}
}
%% Oops. The ink from the body line is leaking. Those extent boxes
%% were having too much of an impact. Nothing a little more manual
%% adjustment for now.
baseTriangle = \markup
\general-align #Y #CENTER
\with-dimensions-from
\translate #'(0 . 0.52)
\draw-circle #1.06 #0 ##t
\general-align #X #CENTER
\triangle ##t
leftTriangle = \markup
\inflate #-0.94 \rotate #-30 \baseTriangle
rightTriangle = \markup
\inflate #-0.94 \rotate #30 \baseTriangle
\markup {
\concat {
\leftTriangle
\draw-line #'(5 . 0)
\rightTriangle
}
}
%% Hmm... looks like we need an inflate with independent X and Y axis
%% inputs. The extent changes are making the triangle a little too
%% short.
#(define-markup-command
(inflate layout props x y arg) (number? number? markup?)
(let* ((stencil (interpret-markup layout props arg))
(x-ext (ly:stencil-extent stencil X))
(y-ext (ly:stencil-extent stencil Y)))
(ly:make-stencil
(ly:stencil-expr stencil)
(interval-widen x-ext x)
(interval-widen y-ext y))))
baseTriangle = \markup
\general-align #Y #CENTER
\with-dimensions-from
\translate #'(0 . 0.52)
\draw-circle #1.06 #0 ##t
\general-align #X #CENTER
\triangle ##t
leftTriangle = \markup
\inflate #-0.94 #-0.5 \rotate #-30 \baseTriangle
rightTriangle = \markup
\inflate #-0.94 #-0.5 \rotate #30 \baseTriangle
\markup {
\concat {
\leftTriangle
\draw-line #'(5 . 0)
\rightTriangle
\leftTriangle
\draw-line #'(5 . 0)
\rightTriangle
}
}
%% Well, symmetry only gets you so far. Seems the arrow tip has been
%% snipped too much. Time to reinvent our \inflate to support inputs.
%% Also, I think we need configure the extroversion parameter, which
%% will require additional tweaking.
#(define-markup-command
(inflate layout props x y arg) (number-pair? number-pair? markup?)
(let* ((stencil (interpret-markup layout props arg))
(x-ext (ly:stencil-extent stencil X))
(y-ext (ly:stencil-extent stencil Y)))
(ly:make-stencil
(ly:stencil-expr stencil)
(cons
(- (car x-ext) (car x))
(+ (cdr x-ext) (cdr x)))
(cons
(- (car y-ext) (car y))
(+ (cdr y-ext) (cdr y))))))
baseTriangle = \markup
\general-align #Y #CENTER
\with-dimensions-from
\translate #'(0 . 0.52)
\draw-circle #1.06 #0 ##t
\general-align #X #CENTER
\override #'(extroversion . -1) \triangle ##t
#(define zzz -0.59)
leftTriangle = \markup
\inflate #`(-0.46 . -0.98) #(cons zzz zzz)
\rotate #-30 \baseTriangle
rightTriangle = \markup
\inflate #`(-0.98 . -0.46) #(cons zzz zzz)
\rotate #30 \baseTriangle
\markup {
\override #'(baseline-skip . 0)
\column {
\concat {
\leftTriangle
\draw-line #'(5 . 0)
\rightTriangle
\leftTriangle
\draw-line #'(10 . 0)
\rightTriangle
}
\concat {
\leftTriangle
\draw-line #'(18 . 0)
\rightTriangle
}
}
}
%% It would appear our triangle is about 1.5 units wide. We could
%% continue with messing about in our "proof of concept" mode, but I
%% think we should just take a break from this and start a new document
%% and build up from scratch using Scheme. The goal being that we want
%% a nicely reusable markup command. For instance, we never even got
%% to adding text above or below the arrow body.
draw-arrow.pdf
Description: Adobe PDF document
\version "2.25.13"
\paper {
#(set-paper-size "a8")
left-margin = 1\cm
tagline = ##f
}
%% We are back to do this thing programmatically.
%% First thing's first. We need to determine our interface.
%% Offering independent control over the left and right end
%% points might seem a little overkill at first, but I would
%% prefer to make few assumptions in the code and all but
%% eliminate hardcoded/magic numbers.
%% \draw-arrow
%% xext (number-pair?)
%% yext (number-pair?)
%% label (markup?)
%% xext and yext are the extents of the arrow's body.
%% label is arbitrary markup that will be printed along
%% the edge of the arrow. At this point, we will not be
%% working with the argument, so \null is being passed to
%% our markup command for now.
#(define-markup-command
(draw-arrow layout props xext yext label)
(number-pair? number-pair? markup?)
#:properties ((thickness 1))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(body-sten
(make-line-stencil th x0 y0 x1 y1))
)
(ly:stencil-add
body-sten
)
))
grid = \markup {
\with-color #(x11-color 'gray) \overlay {
\override #'(thickness . 0.25) {
\translate #'(-4 . -3) \draw-line #'(8 . 0)
\translate #'(-4 . -2) \draw-line #'(8 . 0)
\translate #'(-4 . -1) \draw-line #'(8 . 0)
\translate #'(-4 . 1) \draw-line #'(8 . 0)
\translate #'(-4 . 2) \draw-line #'(8 . 0)
\translate #'(-4 . 3) \draw-line #'(8 . 0)
\translate #'(-3 . -4) \draw-line #'(0 . 8)
\translate #'(-2 . -4) \draw-line #'(0 . 8)
\translate #'(-1 . -4) \draw-line #'(0 . 8)
\translate #'( 1 . -4) \draw-line #'(0 . 8)
\translate #'( 2 . -4) \draw-line #'(0 . 8)
\translate #'( 3 . -4) \draw-line #'(0 . 8)
}
\override #'(thickness . 0.75) {
\translate #'( 0 . -4) \draw-line #'(0 . 8)
\translate #'(-4 . 0) \draw-line #'(8 . 0)
}
}
}
\markup {
\overlay { \grid
\draw-arrow #'(-2 . 2) #'(-1 . 1) \null
\override #'(thickness . 3)
\draw-arrow #'(1 . -1) #'(-2 . 2) \null
}
}
%% Whew... that might seem like a lot of work, but mainly
%% what I have done is taken care of some of the boilerplate
%% junk you have to do when creating a markup command. What
%% we have is basically a recreation of \draw-line except
%% we can control each end point independently. A grid was
%% created so we have a reference point when we are building
%% the shapes and getting things aligned. Triangles seem a
%% a good next step.
%%
%% Triangle width and length seems like a good way for users
%% to specify what they want. This feels like it gives the
%% most control. Let's add those parameters and get to work.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((thickness 1))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(t0ax x0) (t0ay y0)
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2))))
(t0cy (+ t0by (* vy (/ trw 2))))
(t0dx (+ t0bx (* (- vx) (/ trw 2))))
(t0dy (+ t0by (* (- vy) (/ trw 2))))
(first-triangle-sten
(ly:stencil-add
(make-line-stencil th t0ax t0ay t0cx t0cy)
(make-line-stencil th t0cx t0cy t0dx t0dy)
(make-line-stencil th t0dx t0dy t0ax t0ay)))
(t1ax x1) (t1ay y1)
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2))))
(t1cy (+ t1by (* vy (/ trw 2))))
(t1dx (+ t1bx (* (- vx) (/ trw 2))))
(t1dy (+ t1by (* (- vy) (/ trw 2))))
(second-triangle-sten
(ly:stencil-add
(make-line-stencil th t1ax t1ay t1cx t1cy)
(make-line-stencil th t1cx t1cy t1dx t1dy)
(make-line-stencil th t1dx t1dy t1ax t1ay)))
(body-sten
(make-line-stencil th t0bx t0by t1bx t1by))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
first-triangle-sten
second-triangle-sten
)
))
\markup {
\overlay { \grid
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2 \null
\override #'(thickness . 2)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1 \null
}
}
%% Linear algebra makes it trivial to plot out the points of a simple
%% triangle. We did not even have to do any angles or trigonometry.
%% Let's see how our extents look.
\markup {
\override #'(box-padding . 0) \box
\with-color #red
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2 \null
\override #'(box-padding . 0) \box
\override #'(thickness . 2) \with-color #green
\draw-arrow #'(1 . -3) #'(-1 . 2) #1.4 #0.7 \null
}
%% The bounds seem tight. There are a number of directions we could
%% take at this point:
%% - Providing a filled/unfilled variant.
%% - Angling the inside side of the triangle so that the triangle
%% end points stick further towards the body.
%% - Adding the label text to one of the sides of the body line.
%% Note that this will require rotation and some trigonometry.
%% Let's see about the label. It seems interesting. We will need
%% to let the user pick which side the label attaches (UP and DOWN).
%% I think LEFT/CENTER/RIGHT alignment of the label relative to the
%% ends of the arrow also makes sense for the end user.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((thickness 1)
(label-attach-side UP)
(label-alignment CENTER))
(define (colorize stencil color)
(stencil-with-color stencil (x11-color color)))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.1415926535846264338)))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(t0ax x0) (t0ay y0)
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2))))
(t0cy (+ t0by (* vy (/ trw 2))))
(t0dx (+ t0bx (* (- vx) (/ trw 2))))
(t0dy (+ t0by (* (- vy) (/ trw 2))))
(first-triangle-sten
(ly:stencil-add
(make-line-stencil th t0ax t0ay t0cx t0cy)
(make-line-stencil th t0cx t0cy t0dx t0dy)
(make-line-stencil th t0dx t0dy t0ax t0ay)))
(t1ax x1) (t1ay y1)
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2))))
(t1cy (+ t1by (* vy (/ trw 2))))
(t1dx (+ t1bx (* (- vx) (/ trw 2))))
(t1dy (+ t1by (* (- vy) (/ trw 2))))
(second-triangle-sten
(ly:stencil-add
(make-line-stencil th t1ax t1ay t1cx t1cy)
(make-line-stencil th t1cx t1cy t1dx t1dy)
(make-line-stencil th t1dx t1dy t1ax t1ay)))
(body-sten
(make-line-stencil th t0bx t0by t1bx t1by))
(label-sten
(interpret-markup layout props label))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext label-alignment))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (+ midx (* (/ (+ trw th) 2) vx label-attach-side)))
(ldesty (+ midy (* (/ (+ trw th) 2) vy label-attach-side)))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
(colorize first-triangle-sten 'darkorange)
(colorize second-triangle-sten 'deepskyblue)
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten
(cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty
)
)
))
\markup {
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { Lorem ipsum }
\override #'(thickness . 2)
\override #`(label-attach-side . ,DOWN)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { dolor sit amet. }
}
%% We have labels now. They can be attached on either down, but
%% the next step is getting horizontal alignment.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((thickness 1)
(label-attach-side UP)
(label-alignment CENTER))
(define (colorize stencil color)
(stencil-with-color stencil (x11-color color)))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.1415926535846264338)))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(t0ax x0) (t0ay y0)
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2))))
(t0cy (+ t0by (* vy (/ trw 2))))
(t0dx (+ t0bx (* (- vx) (/ trw 2))))
(t0dy (+ t0by (* (- vy) (/ trw 2))))
(first-triangle-sten
(ly:stencil-add
(make-line-stencil th t0ax t0ay t0cx t0cy)
(make-line-stencil th t0cx t0cy t0dx t0dy)
(make-line-stencil th t0dx t0dy t0ax t0ay)))
(t1ax x1) (t1ay y1)
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2))))
(t1cy (+ t1by (* vy (/ trw 2))))
(t1dx (+ t1bx (* (- vx) (/ trw 2))))
(t1dy (+ t1by (* (- vy) (/ trw 2))))
(second-triangle-sten
(ly:stencil-add
(make-line-stencil th t1ax t1ay t1cx t1cy)
(make-line-stencil th t1cx t1cy t1dx t1dy)
(make-line-stencil th t1dx t1dy t1ax t1ay)))
(body-sten
(make-line-stencil th t0bx t0by t1bx t1by))
(label-sten
(interpret-markup layout props label))
(destx0 (+ x0 (* vx label-attach-side (/ (+ trw th) 2))))
(destx1 (+ x1 (* vx label-attach-side (/ (+ trw th) 2))))
(desty0 (+ y0 (* vy label-attach-side (/ (+ trw th) 2))))
(desty1 (+ y1 (* vy label-attach-side (/ (+ trw th) 2))))
(dsxext (cons destx0 destx1))
(dsyext (cons desty0 desty1))
(align-clamped (min 1 (max -1 label-alignment)))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext align-clamped))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (interval-index dsxext label-alignment))
(ldesty (interval-index dsyext label-alignment))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
(colorize first-triangle-sten 'darkorange)
(colorize second-triangle-sten 'deepskyblue)
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten (cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty)
)
))
\markup {
\override #`(label-alignment . ,LEFT)
\override #`(label-attach-side . ,DOWN)
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { Lorem ipsum }
\override #'(thickness . 2)
\override #`(label-alignment . ,RIGHT)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { dolor sit amet. }
}
%% Looks like horizontal and vertical alignment works for labels.
%% We could probably tackle both the angularity of the arrow head
%% as well as the filled/unfilled. Although, I just thought of
%% something else. Some users might want only one arrow head for
%% arrows that are intended to point in a direction. Let us hold
%% off on that feature. Angularity of the arrow head should be
%% pretty straight-forward.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((angularity 0)
(label-attach-side UP)
(label-alignment CENTER)
(thickness 1))
(define (colorize stencil color)
(stencil-with-color stencil (x11-color color)))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.1415926535846264338)))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(angd (* angularity trl))
(t0ax x0) (t0ay y0)
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2)) (* ux angd)))
(t0cy (+ t0by (* vy (/ trw 2)) (* uy angd)))
(t0dx (+ t0cx (* (- vx) trw)))
(t0dy (+ t0cy (* (- vy) trw)))
(first-triangle-sten
(ly:stencil-add
(make-line-stencil th t0ax t0ay t0cx t0cy)
(make-line-stencil th t0cx t0cy t0bx t0by)
(make-line-stencil th t0bx t0by t0dx t0dy)
(make-line-stencil th t0dx t0dy t0ax t0ay)))
(t1ax x1) (t1ay y1)
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2)) (* (- ux) angd)))
(t1cy (+ t1by (* vy (/ trw 2)) (* (- uy) angd)))
(t1dx (+ t1cx (* (- vx) trw)))
(t1dy (+ t1cy (* (- vy) trw)))
(second-triangle-sten
(ly:stencil-add
(make-line-stencil th t1ax t1ay t1cx t1cy)
(make-line-stencil th t1cx t1cy t1bx t1by)
(make-line-stencil th t1bx t1by t1dx t1dy)
(make-line-stencil th t1dx t1dy t1ax t1ay)))
(body-sten
(make-line-stencil th t0bx t0by t1bx t1by))
(label-sten
(interpret-markup layout props label))
(destx0 (+ x0 (* vx label-attach-side (/ (+ trw th) 2))))
(destx1 (+ x1 (* vx label-attach-side (/ (+ trw th) 2))))
(desty0 (+ y0 (* vy label-attach-side (/ (+ trw th) 2))))
(desty1 (+ y1 (* vy label-attach-side (/ (+ trw th) 2))))
(dsxext (cons destx0 destx1))
(dsyext (cons desty0 desty1))
(align-clamped (min 1 (max -1 label-alignment)))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext align-clamped))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (interval-index dsxext label-alignment))
(ldesty (interval-index dsyext label-alignment))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
(colorize first-triangle-sten 'darkorange)
(colorize second-triangle-sten 'deepskyblue)
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten (cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty)
)
))
\markup {
\override #'(angularity . 0.2)
\override #`(label-alignment . ,LEFT)
\override #`(label-attach-side . ,DOWN)
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { Lorem ipsum }
\override #'(angularity . -0.1)
\override #`(label-alignment . ,RIGHT)
\override #'(thickness . 2)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { dolor sit amet. }
}
%% Angularity looks good, even negative amounts produce an arrow
%% with a unique style. Let's get those arrows filled.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((angularity 0)
(label-attach-side UP)
(label-alignment CENTER)
(thickness 1))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.1415926535846264338)))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(angd (* angularity trl))
(t0ax (+ x0 (* ux (/ th 2))))
(t0ay (+ y0 (* uy (/ th 2))))
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2)) (* ux angd)))
(t0cy (+ t0by (* vy (/ trw 2)) (* uy angd)))
(t0dx (+ t0cx (* (- vx) trw)))
(t0dy (+ t0cy (* (- vy) trw)))
(first-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list
(cons t0ax t0ay)
(cons t0cx t0cy)
(cons t0bx t0by)
(cons t0dx t0dy)))))
(t1ax (+ x1 (* (- ux) (/ th 2))))
(t1ay (+ y1 (* (- uy) (/ th 2))))
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2)) (* (- ux) angd)))
(t1cy (+ t1by (* vy (/ trw 2)) (* (- uy) angd)))
(t1dx (+ t1cx (* (- vx) trw)))
(t1dy (+ t1cy (* (- vy) trw)))
(second-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list
(cons t1ax t1ay)
(cons t1cx t1cy)
(cons t1bx t1by)
(cons t1dx t1dy)))))
(body-sten
(make-line-stencil th t0bx t0by t1bx t1by))
(label-sten
(interpret-markup layout props label))
(destx0 (+ x0 (* vx label-attach-side (/ (+ trw th) 2))))
(destx1 (+ x1 (* vx label-attach-side (/ (+ trw th) 2))))
(desty0 (+ y0 (* vy label-attach-side (/ (+ trw th) 2))))
(desty1 (+ y1 (* vy label-attach-side (/ (+ trw th) 2))))
(dsxext (cons destx0 destx1))
(dsyext (cons desty0 desty1))
(align-clamped (min 1 (max -1 label-alignment)))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext align-clamped))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (interval-index dsxext label-alignment))
(ldesty (interval-index dsyext label-alignment))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
first-triangle-sten
second-triangle-sten
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten (cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty))))
\markup {
\override #'(angularity . 0.2)
\override #'(filled . #f)
\override #`(label-alignment . ,LEFT)
\override #`(label-attach-side . ,DOWN)
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { Lorem ipsum }
\override #'(angularity . -0.1)
\override #`(label-alignment . ,RIGHT)
\override #'(thickness . 2)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { dolor sit amet. }
}
%% So much easier drawing the arrows when using the polygon
%% markup command, as it already handles filled and unfilled.
%% We are getting pretty close to the final implementation.
%% Now, hiding the start or end arrow probably should be
%% limited to specific combination. For instance, hiding
%% both arrows means we just have a line. We will ensure at
%% least one arrow remains. In fact, let us keep it simple
%% for the end user. The only options will be a single arrow
%% that goes from the start to the end otherwise the default
%% behavior is the two-headed that we have been working with.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((angularity 0)
(one-headed #f)
(label-attach-side UP)
(label-alignment CENTER)
(thickness 1))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.1415926535846264338)))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(angd (* angularity trl))
(t0ax (+ x0 (* ux (/ th 2))))
(t0ay (+ y0 (* uy (/ th 2))))
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2)) (* ux angd)))
(t0cy (+ t0by (* vy (/ trw 2)) (* uy angd)))
(t0dx (+ t0cx (* (- vx) trw)))
(t0dy (+ t0cy (* (- vy) trw)))
(first-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list
(cons t0ax t0ay)
(cons t0cx t0cy)
(cons t0bx t0by)
(cons t0dx t0dy)))))
(t1ax (+ x1 (* (- ux) (/ th 2))))
(t1ay (+ y1 (* (- uy) (/ th 2))))
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2)) (* (- ux) angd)))
(t1cy (+ t1by (* vy (/ trw 2)) (* (- uy) angd)))
(t1dx (+ t1cx (* (- vx) trw)))
(t1dy (+ t1cy (* (- vy) trw)))
(second-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list
(cons t1ax t1ay)
(cons t1cx t1cy)
(cons t1bx t1by)
(cons t1dx t1dy)))))
(body-sten
(make-line-stencil th
(if one-headed x0 t0bx)
(if one-headed y0 t0by)
t1bx t1by))
(label-sten
(interpret-markup layout props label))
(destx0 (+ x0 (* vx label-attach-side (/ (+ trw th) 2))))
(destx1 (+ x1 (* vx label-attach-side (/ (+ trw th) 2))))
(desty0 (+ y0 (* vy label-attach-side (/ (+ trw th) 2))))
(desty1 (+ y1 (* vy label-attach-side (/ (+ trw th) 2))))
(dsxext (cons destx0 destx1))
(dsyext (cons desty0 desty1))
(align-clamped (min 1 (max -1 label-alignment)))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext align-clamped))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (interval-index dsxext label-alignment))
(ldesty (interval-index dsyext label-alignment))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
(if one-headed empty-stencil first-triangle-sten)
second-triangle-sten
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten (cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty))))
\markup {
\override #'(angularity . 0.2)
\override #'(filled . #f)
\override #`(label-alignment . ,LEFT)
\override #`(label-attach-side . ,DOWN)
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { Lorem ipsum }
\override #'(angularity . -0.1)
\override #`(label-alignment . ,RIGHT)
\override #'(thickness . 2)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { dolor sit amet. }
\override #'(angularity . 0.2)
\override #'(filled . #f)
\override #'(one-headed . #t)
\override #`(label-alignment . ,LEFT)
\override #`(label-attach-side . ,DOWN)
\draw-arrow #'(-2 . 2) #'(-1 . 1) #0.6 #1.2
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { Lorem ipsum }
\override #'(angularity . -0.1)
\override #'(one-headed . #t)
\override #`(label-alignment . ,RIGHT)
\override #'(thickness . 2)
\draw-arrow #'(1 . -1) #'(-2 . 2) #0.8 #1
\override #'(box-padding . 0.1)
\override #'(thickness . 0.5) \box
\fontsize #-12 \line { dolor sit amet. }
}
%% Well, that was pretty easy. I had a thought earlier when
%% doing some testing. What happens if the markup argument is
%% a markup-list. Would the arrow be applied to each markup?
\markup {
\draw-arrow
#'(0 . 8) #'(-0.5 . 0.5)
#0.4 #1.2
\tiny { Lorem ipsum }
}
%% Okay, that is probably not what an end user would want. I
%% think it should be possible to consume the markup-list and
%% treat it as a singular markup, but the question is how to
%% join the markups. Simple concatenation as if the user had
%% used the \line command is a good start.
%%
%% It does not appear to be possible to accept both a markup
%% and a markup-list via the same argument. It will just have
%% to be up to the end user to pass the right thing.
\markup {
\draw-arrow
#'(0 . 8) #'(0.5 . -0.5)
#0.4 #1.2
\tiny \line { Lorem ipsum }
}
%% Let us add support for padding between the arrow and the
%% label. Of course, a user of the markup command could do
%% the same thing within the label. But the padding property
%% is pretty common in markup commands.
#(define-markup-command
(draw-arrow layout props xext yext trw trl label)
(number-pair? number-pair? number? number? markup?)
#:properties ((angularity 0)
(one-headed #f)
(label-attach-side UP)
(label-alignment CENTER)
(padding 0.5)
(thickness 1))
(let* ( (line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car xext)) (x1 (cdr xext))
(y0 (car yext)) (y1 (cdr yext))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.1415926535846264338)))
(bl (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx bl)) (uy (/ dy bl))
(vx (- uy)) (vy ux)
(angd (* angularity trl))
(t0ax (+ x0 (* ux (/ th 2))))
(t0ay (+ y0 (* uy (/ th 2))))
(t0bx (+ t0ax (* ux trl)))
(t0by (+ t0ay (* uy trl)))
(t0cx (+ t0bx (* vx (/ trw 2)) (* ux angd)))
(t0cy (+ t0by (* vy (/ trw 2)) (* uy angd)))
(t0dx (+ t0cx (* (- vx) trw)))
(t0dy (+ t0cy (* (- vy) trw)))
(first-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list
(cons t0ax t0ay)
(cons t0cx t0cy)
(cons t0bx t0by)
(cons t0dx t0dy)))))
(t1ax (+ x1 (* (- ux) (/ th 2))))
(t1ay (+ y1 (* (- uy) (/ th 2))))
(t1bx (+ t1ax (* (- ux) trl)))
(t1by (+ t1ay (* (- uy) trl)))
(t1cx (+ t1bx (* vx (/ trw 2)) (* (- ux) angd)))
(t1cy (+ t1by (* vy (/ trw 2)) (* (- uy) angd)))
(t1dx (+ t1cx (* (- vx) trw)))
(t1dy (+ t1cy (* (- vy) trw)))
(second-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list
(cons t1ax t1ay)
(cons t1cx t1cy)
(cons t1bx t1by)
(cons t1dx t1dy)))))
(body-sten
(make-line-stencil th
(if one-headed x0 t0bx)
(if one-headed y0 t0by)
t1bx t1by))
(label-sten
(interpret-markup layout props label))
(destx0 (+ x0 (* vx label-attach-side (/ (+ trw th) 2))))
(destx1 (+ x1 (* vx label-attach-side (/ (+ trw th) 2))))
(desty0 (+ y0 (* vy label-attach-side (/ (+ trw th) 2))))
(desty1 (+ y1 (* vy label-attach-side (/ (+ trw th) 2))))
(dsxext (cons destx0 destx1))
(dsyext (cons desty0 desty1))
(align-clamped (min 1 (max -1 label-alignment)))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext align-clamped))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (+ (interval-index dsxext label-alignment)
(* vx label-attach-side padding)))
(ldesty (+ (interval-index dsyext label-alignment)
(* vy label-attach-side padding)))
)
(if (< bl (* trl 2))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
(if one-headed empty-stencil first-triangle-sten)
second-triangle-sten
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten (cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty))))
\markup {
\draw-arrow
#'(0 . 8) #'(-0.5 . 0.5)
#0.4 #1.2
\tiny \line { Lorem ipsum }
\override #'(padding . 0)
\draw-arrow
#'(-0.5 . 0.5) #'(0 . 8)
#0.4 #1.2
\tiny \line { Lorem ipsum }
}
%% Padding should be a useful property. Looks like we have some
%% technical debt. I am going to do a round of refactoring.
#(define-markup-command
(draw-arrow layout props
x-extent y-extent arrow-width arrow-length label)
(number-pair? number-pair? number? number? markup?)
#:properties ((angularity 0)
(one-headed #f)
(label-attach-side UP)
(label-alignment CENTER)
(padding 0.5)
(thickness 1))
(let* ((line-thickness
(ly:output-def-lookup layout 'line-thickness))
(th (* line-thickness thickness))
(x0 (car x-extent)) (x1 (cdr x-extent))
(y0 (car y-extent)) (y1 (cdr y-extent))
(dx (- x1 x0)) (dy (- y1 y0))
(theta (* (atan dy dx) (/ 180 3.14159)))
(body-length (sqrt (+ (* dx dx) (* dy dy))))
(midx (/ (+ x0 x1) 2))
(midy (/ (+ y0 y1) 2))
(ux (/ dx body-length)) (uy (/ dy body-length))
(vx (- uy)) (vy ux)
(angd (* angularity arrow-length))
(t0ax (+ x0 (* ux (/ th 2))))
(t0ay (+ y0 (* uy (/ th 2))))
(t0bx (+ t0ax (* ux arrow-length)))
(t0by (+ t0ay (* uy arrow-length)))
(t0cx (+ t0bx (* vx (/ arrow-width 2)) (* ux angd)))
(t0cy (+ t0by (* vy (/ arrow-width 2)) (* uy angd)))
(t0dx (+ t0cx (* (- vx) arrow-width)))
(t0dy (+ t0cy (* (- vy) arrow-width)))
(first-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list (cons t0ax t0ay)
(cons t0cx t0cy)
(cons t0bx t0by)
(cons t0dx t0dy)))))
(t1ax (+ x1 (* (- ux) (/ th 2))))
(t1ay (+ y1 (* (- uy) (/ th 2))))
(t1bx (+ t1ax (* (- ux) arrow-length)))
(t1by (+ t1ay (* (- uy) arrow-length)))
(t1cx (+ t1bx (* vx (/ arrow-width 2)) (* (- ux) angd)))
(t1cy (+ t1by (* vy (/ arrow-width 2)) (* (- uy) angd)))
(t1dx (+ t1cx (* (- vx) arrow-width)))
(t1dy (+ t1cy (* (- vy) arrow-width)))
(second-triangle-sten
(interpret-markup layout props
(make-polygon-markup
(list (cons t1ax t1ay)
(cons t1cx t1cy)
(cons t1bx t1by)
(cons t1dx t1dy)))))
(body-sten
(make-line-stencil th
(if one-headed x0 t0bx)
(if one-headed y0 t0by)
t1bx t1by))
(label-sten
(interpret-markup layout props label))
(destx0 (+ x0 (* vx label-attach-side
(/ (+ arrow-width th) 2))))
(destx1 (+ x1 (* vx label-attach-side
(/ (+ arrow-width th) 2))))
(desty0 (+ y0 (* vy label-attach-side
(/ (+ arrow-width th) 2))))
(desty1 (+ y1 (* vy label-attach-side
(/ (+ arrow-width th) 2))))
(dsxext (cons destx0 destx1))
(dsyext (cons desty0 desty1))
(align-clamped (min 1 (max -1 label-alignment)))
(lxext (ly:stencil-extent label-sten X))
(lyext (ly:stencil-extent label-sten Y))
(lanchx (interval-index lxext align-clamped))
(lanchy (interval-index lyext (- label-attach-side)))
(ldestx (+ (interval-index dsxext label-alignment)
(* vx label-attach-side padding)))
(ldesty (+ (interval-index dsyext label-alignment)
(* vy label-attach-side padding))))
(if (< body-length (* arrow-length (if one-headed 1 2)))
(ly:warning "arrow head length combined exceeds the length of
the body as defined by the extents."))
(ly:stencil-add
body-sten
(if one-headed empty-stencil first-triangle-sten)
second-triangle-sten
(ly:stencil-rotate-absolute
(ly:stencil-translate
label-sten (cons (- ldestx lanchx) (- ldesty lanchy)))
theta ldestx ldesty))))
\markup {
\draw-arrow
#'(0 . 8) #'(0.5 . -0.5)
#0.4 #1.2
\tiny \line { Lorem ipsum }
}
%% In the process of doing that, I found a bug with the warning
%% about the arrow heads being too long for the body length.
%% If the arrow is one-headed, then the arrow length can be
%% permitted to be bigger.
%% I think we might be done, or at the very least we have a
%% reasonably function markup command.
draw-arrow-2.pdf
Description: Adobe PDF document
