scm/flag-styles.scm

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