scm/flag-styles.scm

   1 ;;;;  flag-styles.scm
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPOnd music typesetter
   4 ;;;;
   5
   6 (define-public (no-flag stem-grob)
   7   "No flag: Simply return empty stencil"
   8   empty-stencil)
   9
  10
  11 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  12 ;;;;  Straight flags
  13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14
  15
  16 ;; ;; TODO
  17 ;; (define-public (add-stroke-straight stencil dir stroke-style)
  18 ;;   stencil
  19 ;; )
  20 ;;
  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
  24 ;; ;; TODO
  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)))
  39 ;;       empty-stencil
  40 ;;     )
  41 ;;   )
  42 ;; )
  43 ;;
  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))
  47 ;;
  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))
  51
  52
  53 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  54 ;;;;  Flags created from feta glyphs (normal and mensural flags)
  55 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  56
  57
  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.
  64
  65
  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
  68    flag stencil"
  69   (if (not (string? stroke-style))
  70     stencil
  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)
  78                                tmpstencil)))
  79       (if (ly:stencil-empty? stroke-stencil)
  80         (begin
  81           (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
  82           stencil)
  83         (ly:stencil-add stencil stroke-stencil)))))
  84
  85
  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))
  94     flag))
  95
  96
  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)
 103       flag
 104       (add-stroke-glyph flag stem-grob dir stroke-style flag-style))))
 105
 106
 107
 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."
 116
 117   (let* ((adjust #t)
 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)))
 123
 124
 125
 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))
 130
 131
 132
 133 (define-public (normal-flag stem-grob)
 134   "Create a default flag"
 135   (create-glyph-flag "" "" stem-grob))
 136
 137
 138
 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:
 146 @example
 147 \\override Stem #'flag = #default-flag
 148 \\override Stem #'flag-style = #'mensural
 149 @end example
 150 "
 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)
 154                          "")))
 155     (cond
 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)))))