scm/flag-styles.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2008--2015 Reinhold Kainhofer <reinhold@kainhofer.com>
   4 ;;;;
   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.
   9 ;;;;
  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.
  14 ;;;;
  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/>.
  17
  18 ;;;;  This file implements different flag styles in Scheme / GUILE, most
  19 ;;;;  notably the old-straight-flag, the modern-straight-flag and the flat-flag
  20 ;;;;  styles.
  21
  22
  23 (define-public (no-flag grob)
  24   "No flag: Simply return empty stencil."
  25   empty-stencil)
  26
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;;;  Straight flags
  30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  31
  32
  33 (define-public (add-stroke-straight stencil grob dir log stroke-style
  34                                     offset length thickness stroke-thickness)
  35   "Add the stroke for acciaccatura to the given flag stencil.
  36 The stroke starts for up-flags at `upper-end-of-flag + (0,length/2)'
  37 and ends at `(0, vertical-center-of-flag-end) - (flag-x-width/2,
  38 flag-x-width + flag-thickness)'.  Here `length' is the
  39 whole length, while `flag-x-width' is just the x-extent and thus depends on
  40 the angle!  Other combinations don't look as good.
  41
  42 For down-stems the y-coordinates are simply mirrored."
  43   (let* ((stem-grob (ly:grob-parent grob X))
  44          (start (offset-add offset (cons 0  (* (/ length 2) dir))))
  45          (end (offset-add (cons 0 (cdr offset))
  46                           (cons (- (/ (car offset) 2)) (* (- (+ thickness (car offset))) dir))))
  47          (stroke (make-line-stencil stroke-thickness (car start) (cdr start) (car end) (cdr end))))
  48     (ly:stencil-add stencil stroke)))
  49
  50 (define (buildflag flag-stencil remain curr-stencil spacing)
  51   "Internal function to recursively create a stencil with @code{remain} flags
  52    from the single-flag stencil curr-stencil, which is already translated to
  53    the position of the previous flag position."
  54   (if (> remain 0)
  55       (let* ((translated-stencil (ly:stencil-translate-axis curr-stencil spacing Y))
  56              (new-stencil (ly:stencil-add flag-stencil translated-stencil)))
  57         (buildflag new-stencil (- remain 1) translated-stencil spacing))
  58       flag-stencil))
  59
  60 (define-public (straight-flag flag-thickness flag-spacing
  61                               upflag-angle upflag-length
  62                               downflag-angle downflag-length)
  63   "Create a stencil for a straight flag.  @var{flag-thickness} and
  64 @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
  65 @var{downflag-angle} are given in degrees, and @var{upflag-length} and
  66 @var{downflag-length} are given in staff spaces.
  67
  68 All lengths are scaled according to the font size of the note."
  69
  70   (lambda (grob)
  71     (let* ((stem-grob (ly:grob-parent grob X))
  72            (log (ly:grob-property stem-grob 'duration-log))
  73            (dir (ly:grob-property stem-grob 'direction))
  74            (stem-up (eqv? dir UP))
  75            (layout (ly:grob-layout grob))
  76            ;; scale with the note size (e.g. for grace notes)
  77            (factor (magstep (ly:grob-property grob 'font-size 0)))
  78            (grob-stem-thickness (ly:grob-property stem-grob 'thickness))
  79            (line-thickness (ly:output-def-lookup layout 'line-thickness))
  80            (half-stem-thickness (/ (* grob-stem-thickness line-thickness) 2))
  81            (raw-length (if stem-up upflag-length downflag-length))
  82            (angle (if stem-up upflag-angle downflag-angle))
  83            (flag-length (+ (* raw-length factor) half-stem-thickness))
  84            ;; For flat flags the points to create the stencil using
  85            ;; ly:round-filled-polygon need to be different concerning flag-end
  86            (flag-end (if (= angle 0)
  87                          (cons flag-length (* half-stem-thickness dir))
  88                          (polar->rectangular flag-length angle)))
  89            (thickness (* flag-thickness factor))
  90            (thickness-offset (cons 0 (* -1 thickness dir)))
  91            (spacing (* -1 flag-spacing factor dir ))
  92            (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
  93            ;; The points of a round-filled-polygon need to be given in clockwise
  94            ;; order, otherwise the polygon will be enlarged by blot-size*2!
  95            (points (if stem-up
  96                        (list start
  97                              flag-end
  98                              (offset-add flag-end thickness-offset)
  99                              (offset-add start thickness-offset))
 100                        (list start
 101                              (offset-add start thickness-offset)
 102                              (offset-add flag-end thickness-offset)
 103                              flag-end)))
 104            (stencil (ly:round-filled-polygon points half-stem-thickness))
 105            ;; Log for 1/8 is 3, so we need to subtract 3
 106            (flag-stencil (buildflag stencil (- log 3) stencil spacing))
 107            (stroke-style (ly:grob-property grob 'stroke-style)))
 108       (if (equal? stroke-style "grace")
 109           (add-stroke-straight flag-stencil grob
 110                                dir log
 111                                stroke-style
 112                                flag-end flag-length
 113                                thickness
 114                                (* half-stem-thickness 2))
 115           flag-stencil))))
 116
 117 (define-public (modern-straight-flag grob)
 118   "Modern straight flag style (for composers like Stockhausen, Boulez, etc.).
 119 The angles are 18 and 22 degrees and thus smaller than for the ancient style
 120 of Bach, etc."
 121   ((straight-flag 0.55 1 -18 1.1 22 1.2) grob))
 122
 123 (define-public (old-straight-flag grob)
 124   "Old straight flag style (for composers like Bach).  The angles of the
 125 flags are both 45 degrees."
 126   ((straight-flag 0.55 1 -45 1.2 45 1.4) grob))
 127
 128 (define-public (flat-flag grob)
 129   "Flat flag style.  The angles of the flags are both 0 degrees"
 130   ((straight-flag 0.55 1.0 0 1.0 0 1.0) grob))
 131
 132
 133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 134 ;;;;  Flags created from feta glyphs (normal and mensural flags)
 135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 136
 137
 138 ;; NOTE: By default, lilypond uses the C++ method Flag::stencil
 139 ;; (ly:flag::stencil is the corresponding Scheme interface) to generate the
 140 ;; flag stencil. The following functions are simply a reimplementation in
 141 ;; Scheme, so that one has that functionality available in Scheme, if one
 142 ;; wants to write a flag style, which modifies one of the standard flags
 143 ;; by some stencil operations.
 144
 145
 146 (define-public (add-stroke-glyph stencil grob dir stroke-style flag-style)
 147   "Load and add a stroke (represented by a glyph in the font) to the given
 148 flag stencil."
 149   (if (not (string? stroke-style))
 150       stencil
 151       ;; Otherwise: look up the stroke glyph and combine it with the flag
 152       (let* ((stem-grob (ly:grob-parent grob X))
 153              (font-char (string-append "flags." flag-style dir stroke-style))
 154              (alt-font-char (string-append "flags." dir stroke-style))
 155              (font (ly:grob-default-font grob))
 156              (tmpstencil (ly:font-get-glyph font font-char))
 157              (stroke-stencil (if (ly:stencil-empty? tmpstencil)
 158                                  (ly:font-get-glyph font alt-font-char)
 159                                  tmpstencil)))
 160         (if (ly:stencil-empty? stroke-stencil)
 161             (begin
 162               (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
 163               stencil)
 164             (ly:stencil-add stencil stroke-stencil)))))
 165
 166
 167 (define-public (retrieve-glyph-flag flag-style dir dir-modifier grob)
 168   "Load the correct flag glyph from the font."
 169   (let* ((stem-grob (ly:grob-parent grob X))
 170          (log (ly:grob-property stem-grob 'duration-log))
 171          (font (ly:grob-default-font grob))
 172          (font-char (string-append "flags." flag-style dir dir-modifier (number->string log)))
 173          (flag (ly:font-get-glyph font font-char)))
 174     (if (ly:stencil-empty? flag)
 175         (ly:warning "flag ~a not found" font-char))
 176     flag))
 177
 178
 179 (define-public (create-glyph-flag flag-style dir-modifier grob)
 180   "Create a flag stencil by looking up the glyph from the font."
 181   (let* ((stem-grob (ly:grob-parent grob X))
 182          (dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "u" "d"))
 183          (flag (retrieve-glyph-flag flag-style dir dir-modifier grob))
 184          (stroke-style (ly:grob-property grob 'stroke-style)))
 185     (if (null? stroke-style)
 186         flag
 187         (add-stroke-glyph flag grob dir stroke-style flag-style))))
 188
 189
 190
 191 (define-public (mensural-flag grob)
 192   "Mensural flags: Create the flag stencil by loading the glyph from the font.
 193 Flags are always aligned with staff lines, so we need to check the end point
 194 of the stem: For stems ending on staff lines, use different flags than for
 195 notes between staff lines.  The idea is that flags are always vertically
 196 aligned with the staff lines, regardless of whether the note head is on a
 197 staff line or between two staff lines.  In other words, the inner end of
 198 a flag always touches a staff line."
 199
 200   (let* ((stem-grob (ly:grob-parent grob X))
 201          (adjust #t)
 202          (d (ly:grob-property stem-grob 'direction))
 203          (ss (ly:staff-symbol-staff-space stem-grob))
 204          (stem-end (inexact->exact (round (* (index-cell
 205                                               (ly:grob-extent stem-grob
 206                                                               stem-grob
 207                                                               Y)
 208                                               d)
 209                                              (/ 2 ss)))))
 210          ;; For some reason the stem-end is a real instead of an integer...
 211          (dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0"))
 212          (modifier (if adjust dir-modifier "2")))
 213     (create-glyph-flag "mensural" modifier grob)))
 214
 215
 216
 217 (define ((glyph-flag flag-style) grob)
 218   "Simulatesthe default way of generating flags: Look up glyphs
 219 @code{flags.style[ud][1234]} from the feta font and use it for the flag
 220 stencil."
 221   (create-glyph-flag flag-style "" grob))
 222 (export glyph-flag)
 223
 224
 225
 226 (define-public (normal-flag grob)
 227   "Create a default flag."
 228   (create-glyph-flag "" "" grob))
 229
 230
 231
 232 (define-public (default-flag grob)
 233   "Create a flag stencil for the stem.  Its style will be derived from the
 234 @code{'style} Flag property.  By default, @code{lilypond} uses a
 235 C++ Function (which is slightly faster) to do exactly the same as this
 236 function.  However, if one wants to modify the default flags, this function
 237 can be used to obtain the default flag stencil, which can then be modified
 238 at will.  The correct way to do this is:
 239
 240 @example
 241 \\override Flag #'stencil = #default-flag
 242 \\override Flag #'style = #'mensural
 243 @end example
 244 "
 245   (let* ((stem-grob (ly:grob-parent grob X))
 246          (flag-style-symbol (ly:grob-property grob 'style))
 247          (flag-style (if (symbol? flag-style-symbol)
 248                          (symbol->string flag-style-symbol)
 249                          "")))
 250     (cond
 251      ((equal? flag-style "") (normal-flag grob))
 252      ((equal? flag-style "mensural") (mensural-flag grob))
 253      ((equal? flag-style "no-flag") (no-flag grob))
 254      (else ((glyph-flag flag-style) grob)))))