-;; ;; TODO
-;; (define-public (add-stroke-straight stencil dir stroke-style)
-;; stencil
-;; )
-;;
-;; ;; Create a stencil for a straight flag
-;; ;; flag-thickness, -spacing are given in staff spaces
-;; ;; *flag-length are given in black notehead widths
-;; ;; TODO
-;; (define-public (straight-flag flag-thickness flag-spacing
-;; upflag-angle upflag-length
-;; downflag-angle downflag-length)
-;; (lambda (stem-grob)
-;; (let* ((log (ly:grob-property stem-grob 'duration-log))
-;; (staff-space 1) ; TODO
-;; (black-notehead-width 1) ; TODO
-;; (stem-thickness 1) ; TODO: get rid of
-;; (half-stem-thickness (/ stem-thickness 2))
-;; (staff-space 1) ; TODO
-;; (up-length (+ (* upflag-length black-notehead-width) half-stem-thickness))
-;; (down-length (+ (* downflag-length black-notehead-width) half-stem-thickness))
-;; (thickness (* flag-thickness staff-space))
-;; (spacing (* flag-spacing staff-space)))
-;; empty-stencil
-;; )
-;; )
-;; )
-;;
-;; ;; Modern straight flags: angles are not so large as with the old style
-;; (define-public (modern-straight-flag stem-grob)
-;; ((straight-flag 0.55 0.9 -18 0.95 22 1.0) stem-grob))
-;;
-;; ;; Old-straight flags (Bach, etc.): quite large flag angles
-;; (define-public (old-straight-flag stem-grob)
-;; ((straight-flag 0.55 0.9 -45 0.95 45 1.0) stem-grob))
+(define-public (add-stroke-straight stencil grob dir log stroke-style
+ offset length thickness stroke-thickness)
+ "Add the stroke for acciaccatura to the given flag stencil.
+The stroke starts for up-flags at `upper-end-of-flag + (0,length/2)'
+and ends at `(0, vertical-center-of-flag-end) - (flag-x-width/2,
+flag-x-width + flag-thickness)'. Here `length' is the
+whole length, while `flag-x-width' is just the x-extent and thus depends on
+the angle! Other combinations don't look as good.
+
+For down-stems the y-coordinates are simply mirrored."
+ (let* ((stem-grob (ly:grob-parent grob X))
+ (start (offset-add offset (cons 0 (* (/ length 2) dir))))
+ (end (offset-add (cons 0 (cdr offset))
+ (cons (- (/ (car offset) 2)) (* (- (+ thickness (car offset))) dir))))
+ (stroke (make-line-stencil stroke-thickness (car start) (cdr start) (car end) (cdr end))))
+ (ly:stencil-add stencil stroke)))
+
+(define (buildflag flag-stencil remain curr-stencil spacing)
+ "Internal function to recursively create a stencil with @code{remain} flags
+ from the single-flag stencil curr-stencil, which is already translated to
+ the position of the previous flag position."
+ (if (> remain 0)
+ (let* ((translated-stencil (ly:stencil-translate-axis curr-stencil spacing Y))
+ (new-stencil (ly:stencil-add flag-stencil translated-stencil)))
+ (buildflag new-stencil (- remain 1) translated-stencil spacing))
+ flag-stencil))
+
+(define-public (straight-flag flag-thickness flag-spacing
+ upflag-angle upflag-length
+ downflag-angle downflag-length)
+ "Create a stencil for a straight flag. @var{flag-thickness} and
+@var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
+@var{downflag-angle} are given in degrees, and @var{upflag-length} and
+@var{downflag-length} are given in staff spaces.
+
+All lengths are scaled according to the font size of the note."
+
+ (lambda (grob)
+ (let* ((stem-grob (ly:grob-parent grob X))
+ (log (ly:grob-property stem-grob 'duration-log))
+ (dir (ly:grob-property stem-grob 'direction))
+ (stem-up (eqv? dir UP))
+ (layout (ly:grob-layout grob))
+ ;; scale with the note size (e.g. for grace notes)
+ (factor (magstep (ly:grob-property grob 'font-size 0)))
+ (grob-stem-thickness (ly:grob-property stem-grob 'thickness))
+ (line-thickness (ly:output-def-lookup layout 'line-thickness))
+ (half-stem-thickness (/ (* grob-stem-thickness line-thickness) 2))
+ (raw-length (if stem-up upflag-length downflag-length))
+ (angle (if stem-up upflag-angle downflag-angle))
+ (flag-length (+ (* raw-length factor) half-stem-thickness))
+ ;; For flat flags the points to create the stencil using
+ ;; ly:round-filled-polygon need to be different concerning flag-end
+ (flag-end (if (= angle 0)
+ (cons flag-length (* half-stem-thickness dir))
+ (polar->rectangular flag-length angle)))
+ (thickness (* flag-thickness factor))
+ (thickness-offset (cons 0 (* -1 thickness dir)))
+ (spacing (* -1 flag-spacing factor dir ))
+ (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
+ ;; The points of a round-filled-polygon need to be given in clockwise
+ ;; order, otherwise the polygon will be enlarged by blot-size*2!
+ (points (if stem-up
+ (list start
+ flag-end
+ (offset-add flag-end thickness-offset)
+ (offset-add start thickness-offset))
+ (list start
+ (offset-add start thickness-offset)
+ (offset-add flag-end thickness-offset)
+ flag-end)))
+ (stencil (ly:round-filled-polygon points half-stem-thickness))
+ ;; Log for 1/8 is 3, so we need to subtract 3
+ (flag-stencil (buildflag stencil (- log 3) stencil spacing))
+ (stroke-style (ly:grob-property grob 'stroke-style)))
+ (if (equal? stroke-style "grace")
+ (add-stroke-straight flag-stencil grob
+ dir log
+ stroke-style
+ flag-end flag-length
+ thickness
+ (* half-stem-thickness 2))
+ flag-stencil))))
+
+(define-public (modern-straight-flag grob)
+ "Modern straight flag style (for composers like Stockhausen, Boulez, etc.).
+The angles are 18 and 22 degrees and thus smaller than for the ancient style
+of Bach, etc."
+ ((straight-flag 0.55 1 -18 1.1 22 1.2) grob))
+
+(define-public (old-straight-flag grob)
+ "Old straight flag style (for composers like Bach). The angles of the
+flags are both 45 degrees."
+ ((straight-flag 0.55 1 -45 1.2 45 1.4) grob))
+
+(define-public (flat-flag grob)
+ "Flat flag style. The angles of the flags are both 0 degrees"
+ ((straight-flag 0.55 1.0 0 1.0 0 1.0) grob))