common/baroque.ily

   1 %% Breathing signs from Hippolyte et Aricie
   2 cesure = {
   3   \once\override BreathingSign #'text = \markup \fontsize #2 "|"
   4   \once\override BreathingSign #'Y-offset = #0
   5   \breathe
   6 }
   7 cesureCenter = {
   8   \once\override BreathingSign #'text = \markup \fontsize #2 "|"
   9   \once\override BreathingSign #'Y-offset = #-1
  10   \breathe
  11 }
  12 cesureDown = {
  13   \once\override BreathingSign #'text = \markup \fontsize #2 "|"
  14   \once\override BreathingSign #'Y-offset = #-2
  15   \breathe
  16 }
  17
  18 cesureInstr = {
  19   \once\override BreathingSign #'text = \markup \musicglyph #"scripts.caesura.straight"
  20   \breathe
  21 }
  22
  23 dotSign=\markup\vcenter "╸"
  24
  25 %% New baroque scripts (Charpentier, Rameau...)
  26 #(define-public baroque-script-alist
  27    (append!
  28     `(("t"
  29        (script-stencil
  30         . (markup . ,(markup #:center-align #:sans #:fontsize -2 #:bold "t")))
  31        (padding . 0.20)
  32        (avoid-slur . around)
  33        (direction . ,UP))
  34       ("arcTrill" ; + with an arc above (like a formata with a + signe instead of dot)
  35        (script-stencil
  36         . (markup . ,(markup #:combine
  37                              #:concat (#:null #:translate '(0.3 . 0.8) #:rotate -90
  38                                               #:musicglyph "accidentals.leftparen")
  39                              #:musicglyph "scripts.stopped")))
  40        (padding . 0.20)
  41        (avoid-slur . around)
  42        (direction . ,UP))
  43       ("arcDot"
  44        (script-stencil
  45         . (markup . ,(markup #:combine
  46                              #:concat (#:null #:translate '(0.3 . 0.65) #:rotate -90
  47                                               #:musicglyph "accidentals.leftparen")
  48                              #:musicglyph "scripts.staccato")))
  49        (padding . 0.40)
  50        (avoid-slur . around)
  51        (direction . ,UP))
  52       ("dotDot"
  53        (script-stencil
  54         . (markup . ,(markup #:center-align #:line (#:musicglyph "period" #:musicglyph "period"))))
  55        (padding . 0.20)
  56        (avoid-slur . around)
  57        (direction . ,UP))
  58       ("dotPrall" ; Articulation used Charpentier: a dot, followed by a prall sign
  59        (script-stencil
  60         . (markup . ,(markup #:override '(word-space . 1)
  61                              #:line (#:vcenter "╸" #:vcenter #:musicglyph "scripts.prall"))))
  62        (padding . 0.20)
  63        (avoid-slur . around)
  64        (direction . ,UP))
  65       ("dotDoublePrallDoublePrall"
  66        (script-stencil
  67         . (markup . ,(markup #:override '(word-space . 2) #:override '(baseline-skip . 0)
  68                            #:column (#:line (#:vcenter "╸"
  69                                              #:vcenter #:musicglyph "scripts.prallprall" )
  70                                      #:line (#:transparent #:vcenter "╸"
  71                                              #:vcenter #:musicglyph "scripts.prallprall")))))
  72        (padding . 0.20)
  73        (avoid-slur . around)
  74        (direction . ,UP))
  75       ("doublePrall"
  76        (script-stencil
  77         . (markup . ,(markup #:override '(baseline-skip . 0)
  78                              #:center-align #:column (#:musicglyph "scripts.prall"
  79                                                       #:musicglyph "scripts.prall"))))
  80        (padding . 0.20)
  81        (avoid-slur . around)
  82        (direction . ,UP))
  83       )
  84     default-script-alist))
  85
  86 #(define (baroque-script-interface::print grob)
  87    (let ((script-stencil (ly:grob-property grob 'script-stencil)))
  88      (cond ((and (pair? script-stencil)
  89                  (eqv? 'markup (car script-stencil)))
  90             (set! (ly:grob-property grob 'font-encoding) 'latin1)
  91             (grob-interpret-markup grob (cdr script-stencil)))
  92            (else
  93             (ly:script-interface::print grob)))))
  94
  95 \layout {
  96   \context {
  97     \Score
  98     scriptDefinitions = #baroque-script-alist
  99   }
 100   \context {
 101     \Voice
 102     \override Script #'stencil = #baroque-script-interface::print
 103   }
 104 }
 105 tr = #(make-articulation "t")
 106 arcTrill = #(make-articulation "arcTrill")
 107 arcDot = #(make-articulation "arcDot")
 108 dotDot = #(make-articulation "dotDot")
 109 dotPrall = #(make-articulation "dotPrall")
 110 dotDoublePrallDoublePrall = #(make-articulation "dotDoublePrallDoublePrall")
 111 doublePrall = #(make-articulation "doublePrall")
 112
 113 %% A slur and a prall, both joined on their right ends
 114 slurPrall = {
 115   \once\override Slur #'direction = #UP
 116   \once\override Slur #'text = \markup\musicglyph #"scripts.prall"
 117   \once\override Slur #'stencil =
 118   #(lambda (grob)
 119      (let* ((slur-stencil (ly:slur::print grob))
 120             (coords (ly:slur::calc-control-points grob))
 121             (X-ext (ly:stencil-extent slur-stencil X))
 122             (Y-ext (ly:stencil-extent slur-stencil Y))
 123             (text-stencil (ly:text-interface::print grob))
 124             (text-width (interval-length (ly:stencil-extent text-stencil X)))
 125             (prall-stencil (ly:stencil-translate
 126                             (ly:stencil-aligned-to text-stencil X LEFT)
 127                             (cons (- (cdr X-ext) text-width 0.17)
 128                                   (+ (if (< (cdr (list-ref coords 3)) 2.8)
 129                                          (- 2.8 (cdr (list-ref coords 3)))
 130                                          0.5)
 131                                      (- (cdr (list-ref coords 3)) 0.15)))))
 132             (combo-stencil (ly:stencil-add slur-stencil prall-stencil)))
 133        (ly:stencil-translate combo-stencil (cons 0 0))))
 134   \once\override Slur #'control-points =
 135   #(lambda (grob)
 136      (let* ((coords (ly:slur::calc-control-points grob))
 137             (point-0 (list-ref coords 0))
 138             (point-1 (list-ref coords 1))
 139             (point-2 (list-ref coords 2))
 140             (point-3 (list-ref coords 3))
 141             (text-stencil (ly:text-interface::print grob))
 142             (text-width (interval-length (ly:stencil-extent text-stencil X))))
 143        (set-cdr! point-1 (+ (cdr point-1) 1))
 144        (set-car! point-2 (+ (car point-2) (/ text-width 1.0)))
 145        (set-car! point-3 (+ (car point-3) 0.34 (/ text-width 2.0)))
 146        (set-cdr! point-3 (if (< (cdr point-3) 2.8)
 147                              2.8
 148                              (+ 0.5 (cdr point-3))))
 149        (set-cdr! point-2 (+ (cdr point-3) 2.0))
 150        coords))
 151 }
 152
 153 %% Charpentier
 154 %% For quarter note with eighth note flag and half note note head (in e.g. 3/2)
 155 #(define-public (calc-white-note-head-glyph grob)
 156    (let ((style (ly:grob-property grob 'style))
 157          (duration-log (min 1 (ly:grob-property grob 'duration-log))))
 158      (select-head-glyph style duration-log)))
 159
 160 whiteNoteHeadsOn = {
 161   \override Staff.NoteHead #'style = #'baroque
 162   \override Staff.NoteHead #'glyph-name = #calc-white-note-head-glyph
 163 }
 164 whiteNoteHeadsOff = {
 165   \revert Staff.NoteHead #'style
 166   \revert Staff.NoteHead #'glyph-name
 167 }
 168
 169 %% Black notation, for breve and whole notes
 170 #(define-public (ly:note-head::print-black grob)
 171    (let ((head-style (ly:grob-property grob 'style)))
 172      (case head-style
 173        ((baroque default)
 174         (let* ((head-stencil (ly:note-head::print grob))
 175                (duration (ly:grob-property grob 'duration-log))
 176                (glyph-name (format #f "noteheads.s~a"
 177                                    (ly:grob-property grob 'glyph-name)))
 178                (glyph (grob-interpret-markup
 179                        grob
 180                        (make-musicglyph-markup glyph-name))))
 181           (ly:stencil-add
 182            (ly:stencil-translate
 183             (ly:stencil-aligned-to
 184              (stencil-with-color
 185               (if (>= duration 0)
 186                   ;; oval for whole note
 187                   (make-oval-stencil
 188                    (* 0.9 (/ (interval-length (ly:stencil-extent glyph X)) 2))
 189                    (* 1.1 (/ (interval-length (ly:stencil-extent glyph Y)) 2))
 190                    0 #t)
 191                   ;; rectangle for breve
 192                   (make-filled-box-stencil (ly:stencil-extent glyph X)
 193                                            (ly:stencil-extent glyph Y)))
 194               black)
 195              X CENTER)
 196             (cons (/ (interval-length (ly:stencil-extent head-stencil X)) 2)
 197                   0))
 198            head-stencil)))
 199        ((petrucci)
 200         (set! (ly:grob-property grob 'style) 'blackpetrucci)
 201         (ly:note-head::print grob))
 202        (else
 203         (ly:note-head::print grob)))))
 204
 205 blackNotation =
 206 #(define-music-function (parser location music) (ly:music?)
 207    #{ \override NoteHead #'stencil = #ly:note-head::print-black
 208       \override NoteHead #'Y-extent =
 209       #(ly:make-unpure-pure-container
 210         ly:grob::stencil-height
 211         (lambda (grob b e) (ly:grob::stencil-height grob)))
 212       $music
 213       \revert NoteHead #'stencil #})
 214
 215 ficta = { \once\set suggestAccidentals = ##t }
 216
 217 %% Figured bass
 218 %% change a flat or sharp alteration into natural
 219 %% unless 'ancient-style option is true
 220 naturalFig =
 221 #(define-music-function (parser location fig) (ly:music?)
 222    (if (eqv? #t (ly:get-option 'ancient-style))
 223        fig
 224        (music-map
 225         (lambda (music)
 226           (if (eqv? 'BassFigureEvent (ly:music-property music 'name))
 227               (let ((alteration (ly:music-property music 'alteration)))
 228                 (if (and (number? alteration)
 229                          (or (= alteration 1/2) (= alteration -1/2)))
 230                     (set! (ly:music-property music 'alteration) 0))))
 231           music)
 232         fig)))