3 ;;;; source file of the GNU LilyPOnd music typesetter
6 (define-public (no-flag stem-grob)
7 "No flag: Simply return empty stencil"
11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17 ;; (define-public (add-stroke-straight stencil dir stroke-style)
21 ;; ;; Create a stencil for a straight flag
22 ;; ;; flag-thickness, -spacing are given in staff spaces
23 ;; ;; *flag-length are given in black notehead widths
25 ;; (define-public (straight-flag flag-thickness flag-spacing
26 ;; upflag-angle upflag-length
27 ;; downflag-angle downflag-length)
28 ;; (lambda (stem-grob)
29 ;; (let* ((log (ly:grob-property stem-grob 'duration-log))
30 ;; (staff-space 1) ; TODO
31 ;; (black-notehead-width 1) ; TODO
32 ;; (stem-thickness 1) ; TODO: get rid of
33 ;; (half-stem-thickness (/ stem-thickness 2))
34 ;; (staff-space 1) ; TODO
35 ;; (up-length (+ (* upflag-length black-notehead-width) half-stem-thickness))
36 ;; (down-length (+ (* downflag-length black-notehead-width) half-stem-thickness))
37 ;; (thickness (* flag-thickness staff-space))
38 ;; (spacing (* flag-spacing staff-space)))
44 ;; ;; Modern straight flags: angles are not so large as with the old style
45 ;; (define-public (modern-straight-flag stem-grob)
46 ;; ((straight-flag 0.55 0.9 -18 0.95 22 1.0) stem-grob))
48 ;; ;; Old-straight flags (Bach, etc.): quite large flag angles
49 ;; (define-public (old-straight-flag stem-grob)
50 ;; ((straight-flag 0.55 0.9 -45 0.95 45 1.0) stem-grob))
53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
54 ;;;; Flags created from feta glyphs (normal and mensural flags)
55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58 ; NOTE: By default, lilypond uses the C++ method Stem::calc-flag
59 ; (ly:stem::calc-flag is the corresponding Scheme interface) to generate the
60 ; flag stencil. The following functions are simply a reimplementation in
61 ; Scheme, so that one has that functionality available in Scheme, if one
62 ; wants to write a flag style, which modifies one of the standard flags
63 ; by some stencil operations.
66 (define-public (add-stroke-glyph stencil stem-grob dir stroke-style flag-style)
67 "Load and add a stroke (represented by a glyph in the font) to the given
69 (if (not (string? stroke-style))
71 ; Otherwise: look up the stroke glyph and combine it with the flag
72 (let* ((font-char (string-append "flags." flag-style dir stroke-style))
73 (alt-font-char (string-append "flags." dir stroke-style))
74 (font (ly:grob-default-font stem-grob))
75 (tmpstencil (ly:font-get-glyph font font-char))
76 (stroke-stencil (if (ly:stencil-empty? tmpstencil)
77 (ly:font-get-glyph font alt-font-char)
79 (if (ly:stencil-empty? stroke-stencil)
81 (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
83 (ly:stencil-add stencil stroke-stencil)))))
86 (define-public (retrieve-glyph-flag flag-style dir dir-modifier stem-grob)
87 "Load the correct flag glyph from the font"
88 (let* ((log (ly:grob-property stem-grob 'duration-log))
89 (font (ly:grob-default-font stem-grob))
90 (font-char (string-append "flags." flag-style dir dir-modifier (number->string log)))
91 (flag (ly:font-get-glyph font font-char)))
92 (if (ly:stencil-empty? flag)
93 (ly:warning "flag ~a not found" font-char))
97 (define-public (create-glyph-flag flag-style dir-modifier stem-grob)
98 "Create a flag stencil by looking up the glyph from the font"
99 (let* ((dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "u" "d"))
100 (flag (retrieve-glyph-flag flag-style dir dir-modifier stem-grob))
101 (stroke-style (ly:grob-property stem-grob 'stroke-style)))
102 (if (null? stroke-style)
104 (add-stroke-glyph flag stem-grob dir stroke-style flag-style))))
108 (define-public (mensural-flag stem-grob)
109 "Mensural flags: Create the flag stencil by loading the glyph from the font.
110 Flags are always aligned with staff lines, so we need to check the end point
111 of the stem: For stems ending on staff lines, use different flags than for
112 notes between staff lines. The idea is that flags are always vertically
113 aligned with the staff lines, regardless of whether the note head is on a
114 staff line or between two staff lines. In other words, the inner end of
115 a flag always touches a staff line."
118 (stem-end (inexact->exact (round (ly:grob-property stem-grob 'stem-end-position))))
119 ; For some reason the stem-end is a real instead of an integer...
120 (dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0"))
121 (modifier (if adjust dir-modifier "2")))
122 (create-glyph-flag "mensural" modifier stem-grob)))
126 (define-public ((glyph-flag flag-style) stem-grob)
127 "Simulates the default way of generating flags: look up glyphs
128 flags.style[ud][1234] from the feta font and use it for the flag stencil."
129 (create-glyph-flag flag-style "" stem-grob))
133 (define-public (normal-flag stem-grob)
134 "Create a default flag"
135 (create-glyph-flag "" "" stem-grob))
139 (define-public (default-flag stem-grob)
140 "Create a flag stencil for the stem. Its style will be derived from the
141 @code{'flag-style} Stem property. By default, @code{lilypond} uses a
142 C++ Function (which is slightly faster) to do exactly the same as this
143 function. However, if one wants to modify the default flags, this function
144 can be used to obtain the default flag stencil, which can then be modified
145 at will. The correct way to do this is:
147 \\override Stem #'flag = #default-flag
148 \\override Stem #'flag-style = #'mensural
151 (let* ((flag-style-symbol (ly:grob-property stem-grob 'flag-style))
152 (flag-style (if (symbol? flag-style-symbol)
153 (symbol->string flag-style-symbol)
156 ((equal? flag-style "") (normal-flag stem-grob))
157 ((equal? flag-style "mensural") (mensural-flag stem-grob))
158 ((equal? flag-style "no-flag") (no-flag stem-grob))
159 (else ((glyph-flag flag-style) stem-grob)))))