1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 2008--2011 Reinhold Kainhofer <reinhold@kainhofer.com>
5 ;;;; LilyPond is free software: you can redistribute it and/or modify
6 ;;;; it under the terms of the GNU General Public License as published by
7 ;;;; the Free Software Foundation, either version 3 of the License, or
8 ;;;; (at your option) any later version.
10 ;;;; LilyPond is distributed in the hope that it will be useful,
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 ;;;; GNU General Public License for more details.
15 ;;;; You should have received a copy of the GNU General Public License
16 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
18 ;;;; This file implements different flag styles in Scheme / GUILE, most
19 ;;;; notably the old-straight-flag and the modern-straight-flag styles.
22 (define-public (no-flag stem-grob)
23 "No flag: Simply return empty stencil."
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
32 (define-public (add-stroke-straight stencil stem-grob dir log stroke-style
33 offset length thickness stroke-thickness)
34 "Add the stroke for acciaccatura to the given flag stencil.
35 The stroke starts for up-flags at `upper-end-of-flag + (0,length/2)'
36 and ends at `(0, vertical-center-of-flag-end) -
37 (flag-x-width/2, flag-x-width + flag-thickness)'. Here `length' is the
38 whole length, while `flag-x-width' is just the x-extent and thus depends on
39 the angle! Other combinations don't look as good.
41 For down-stems the y-coordinates are simply mirrored."
42 (let* ((start (offset-add offset (cons 0 (* (/ length 2) dir))))
43 (end (offset-add (cons 0 (cdr offset))
44 (cons (- (/ (car offset) 2)) (* (- (+ thickness (car offset))) dir))))
45 (stroke (make-line-stencil stroke-thickness (car start) (cdr start) (car end) (cdr end))))
46 (ly:stencil-add stencil stroke)))
48 (define (buildflag flag-stencil remain curr-stencil spacing)
49 "Internal function to recursively create a stencil with @code{remain} flags
50 from the single-flag stencil curr-stencil, which is already translated to
51 the position of the previous flag position."
53 (let* ((translated-stencil (ly:stencil-translate-axis curr-stencil spacing Y))
54 (new-stencil (ly:stencil-add flag-stencil translated-stencil)))
55 (buildflag new-stencil (- remain 1) translated-stencil spacing))
58 (define-public (straight-flag flag-thickness flag-spacing
59 upflag-angle upflag-length
60 downflag-angle downflag-length)
61 "Create a stencil for a straight flag. @var{flag-thickness} and
62 @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
63 @var{downflag-angle} are given in degrees, and @var{upflag-length} and
64 @var{downflag-length} are given in staff spaces.
66 All lengths are scaled according to the font size of the note."
69 (let* ((log (ly:grob-property stem-grob 'duration-log))
70 (dir (ly:grob-property stem-grob 'direction))
71 (stem-up (eqv? dir UP))
72 (layout (ly:grob-layout stem-grob))
73 ; scale with the note size (e.g. for grace notes)
74 (factor (magstep (ly:grob-property stem-grob 'font-size 0)))
75 (grob-stem-thickness (ly:grob-property stem-grob 'thickness))
76 (line-thickness (ly:output-def-lookup layout 'line-thickness))
77 (half-stem-thickness (/ (* grob-stem-thickness line-thickness) 2))
78 (raw-length (if stem-up upflag-length downflag-length))
79 (angle (if stem-up upflag-angle downflag-angle))
80 (flag-length (+ (* raw-length factor) half-stem-thickness))
81 (flag-end (polar->rectangular flag-length angle))
82 (thickness (* flag-thickness factor))
83 (thickness-offset (cons 0 (* -1 thickness dir)))
84 (spacing (* -1 flag-spacing factor dir ))
85 (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
86 ; The points of a round-filled-polygon need to be given in clockwise
87 ; order, otherwise the polygon will be enlarged by blot-size*2!
88 (points (if stem-up (list start flag-end
89 (offset-add flag-end thickness-offset)
90 (offset-add start thickness-offset))
92 (offset-add start thickness-offset)
93 (offset-add flag-end thickness-offset)
95 (stencil (ly:round-filled-polygon points half-stem-thickness))
96 ; Log for 1/8 is 3, so we need to subtract 3
97 (flag-stencil (buildflag stencil (- log 3) stencil spacing))
98 (stroke-style (ly:grob-property stem-grob 'stroke-style)))
99 (if (equal? stroke-style "grace")
100 (add-stroke-straight flag-stencil stem-grob
105 (* half-stem-thickness 2))
108 (define-public (modern-straight-flag stem-grob)
109 "Modern straight flag style (for composers like Stockhausen, Boulez, etc.).
110 The angles are 18 and 22 degrees and thus smaller than for the ancient style
112 ((straight-flag 0.55 1 -18 1.1 22 1.2) stem-grob))
114 (define-public (old-straight-flag stem-grob)
115 "Old straight flag style (for composers like Bach). The angles of the
116 flags are both 45 degrees."
117 ((straight-flag 0.55 1 -45 1.2 45 1.4) stem-grob))
120 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
121 ;;;; Flags created from feta glyphs (normal and mensural flags)
122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
125 ; NOTE: By default, lilypond uses the C++ method Stem::calc-flag
126 ; (ly:stem::calc-flag is the corresponding Scheme interface) to generate the
127 ; flag stencil. The following functions are simply a reimplementation in
128 ; Scheme, so that one has that functionality available in Scheme, if one
129 ; wants to write a flag style, which modifies one of the standard flags
130 ; by some stencil operations.
133 (define-public (add-stroke-glyph stencil stem-grob dir stroke-style flag-style)
134 "Load and add a stroke (represented by a glyph in the font) to the given
136 (if (not (string? stroke-style))
138 ; Otherwise: look up the stroke glyph and combine it with the flag
139 (let* ((font-char (string-append "flags." flag-style dir stroke-style))
140 (alt-font-char (string-append "flags." dir stroke-style))
141 (font (ly:grob-default-font stem-grob))
142 (tmpstencil (ly:font-get-glyph font font-char))
143 (stroke-stencil (if (ly:stencil-empty? tmpstencil)
144 (ly:font-get-glyph font alt-font-char)
146 (if (ly:stencil-empty? stroke-stencil)
148 (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
150 (ly:stencil-add stencil stroke-stencil)))))
153 (define-public (retrieve-glyph-flag flag-style dir dir-modifier stem-grob)
154 "Load the correct flag glyph from the font."
155 (let* ((log (ly:grob-property stem-grob 'duration-log))
156 (font (ly:grob-default-font stem-grob))
157 (font-char (string-append "flags." flag-style dir dir-modifier (number->string log)))
158 (flag (ly:font-get-glyph font font-char)))
159 (if (ly:stencil-empty? flag)
160 (ly:warning "flag ~a not found" font-char))
164 (define-public (create-glyph-flag flag-style dir-modifier stem-grob)
165 "Create a flag stencil by looking up the glyph from the font."
166 (let* ((dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "u" "d"))
167 (flag (retrieve-glyph-flag flag-style dir dir-modifier stem-grob))
168 (stroke-style (ly:grob-property stem-grob 'stroke-style)))
169 (if (null? stroke-style)
171 (add-stroke-glyph flag stem-grob dir stroke-style flag-style))))
175 (define-public (mensural-flag stem-grob)
176 "Mensural flags: Create the flag stencil by loading the glyph from the font.
177 Flags are always aligned with staff lines, so we need to check the end point
178 of the stem: For stems ending on staff lines, use different flags than for
179 notes between staff lines. The idea is that flags are always vertically
180 aligned with the staff lines, regardless of whether the note head is on a
181 staff line or between two staff lines. In other words, the inner end of
182 a flag always touches a staff line."
185 (stem-end (inexact->exact (round (ly:grob-property stem-grob 'stem-end-position))))
186 ; For some reason the stem-end is a real instead of an integer...
187 (dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0"))
188 (modifier (if adjust dir-modifier "2")))
189 (create-glyph-flag "mensural" modifier stem-grob)))
193 (define-public ((glyph-flag flag-style) stem-grob)
194 "Simulatesthe default way of generating flags: Look up glyphs
195 @code{flags.style[ud][1234]} from the feta font and use it for the flag
197 (create-glyph-flag flag-style "" stem-grob))
201 (define-public (normal-flag stem-grob)
202 "Create a default flag."
203 (create-glyph-flag "" "" stem-grob))
207 (define-public (default-flag stem-grob)
208 "Create a flag stencil for the stem. Its style will be derived from the
209 @code{'flag-style} Stem property. By default, @code{lilypond} uses a
210 C++ Function (which is slightly faster) to do exactly the same as this
211 function. However, if one wants to modify the default flags, this function
212 can be used to obtain the default flag stencil, which can then be modified
213 at will. The correct way to do this is:
216 \\override Stem #'flag = #default-flag
217 \\override Stem #'flag-style = #'mensural
220 (let* ((flag-style-symbol (ly:grob-property stem-grob 'flag-style))
221 (flag-style (if (symbol? flag-style-symbol)
222 (symbol->string flag-style-symbol)
225 ((equal? flag-style "") (normal-flag stem-grob))
226 ((equal? flag-style "mensural") (mensural-flag stem-grob))
227 ((equal? flag-style "no-flag") (no-flag stem-grob))
228 (else ((glyph-flag flag-style) stem-grob)))))