scm/define-music-callbacks.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 1998--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
   4 ;;;;                 Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;;                 Neil Puttock <n.puttock@gmail.com>
   6 ;;;;                 Carl Sorensen <c_sorensen@byu.edu>
   7 ;;;;
   8 ;;;; LilyPond is free software: you can redistribute it and/or modify
   9 ;;;; it under the terms of the GNU General Public License as published by
  10 ;;;; the Free Software Foundation, either version 3 of the License, or
  11 ;;;; (at your option) any later version.
  12 ;;;;
  13 ;;;; LilyPond is distributed in the hope that it will be useful,
  14 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;;; GNU General Public License for more details.
  17 ;;;;
  18 ;;;; You should have received a copy of the GNU General Public License
  19 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;; TODO: should link back into user manual.
  22
  23 (define (mm-rest-child-list music)
  24   "Generate events for multimeasure rests,
  25 to be used by the sequential-iterator"
  26   (let ((location (ly:music-property music 'location)))
  27     (list (make-music 'BarCheck
  28                       'origin location)
  29           (make-music 'MultiMeasureRestEvent
  30                       (ly:music-deep-copy music))
  31           (make-music 'BarCheck
  32                       'origin location))))
  33
  34 (define (make-unfolded-set music)
  35   (let ((n (ly:music-property music 'repeat-count))
  36         (alts (ly:music-property music 'elements))
  37         (body (ly:music-property music 'element)))
  38     (cond ((<= n 0) '())
  39           ((null? alts) (make-list n body))
  40           (else
  41            (concatenate
  42             (zip (make-list n body)
  43                  (append! (make-list (max 0 (- n (length alts)))
  44                                      (car alts))
  45                           alts)))))))
  46
  47 (define (make-volta-set music)
  48   (let* ((alts (ly:music-property music 'elements))
  49          (lalts (length alts))
  50          (times (ly:music-property music 'repeat-count)))
  51     (map (lambda (x y)
  52            (make-music
  53             'SequentialMusic
  54             'elements
  55             ;; set properties for proper bar numbering
  56             (append
  57              (list (make-music 'AlternativeEvent
  58                                'alternative-dir (if (= y 0)
  59                                                     -1
  60                                                     0)
  61                                'alternative-increment
  62                                (if (= 0 y)
  63                                    (1+ (- times
  64                                           lalts))
  65                                    1)))
  66              (list x)
  67              (if (= y (1- lalts))
  68                  (list (make-music 'AlternativeEvent
  69                                    'alternative-dir 1
  70                                    'alternative-increment 0))
  71                  '()))))
  72          alts
  73          (iota lalts))))
  74
  75 (define (make-ottava-set music)
  76   "Set context properties for an ottava bracket."
  77   (let ((octavation (ly:music-property music 'ottava-number)))
  78
  79     (list (context-spec-music
  80            (make-apply-context
  81             (lambda (context)
  82               (let ((offset (* -7 octavation))
  83                     (string (assoc-get octavation '((2 . "15ma")
  84                                                     (1 . "8va")
  85                                                     (0 . #f)
  86                                                     (-1 . "8vb")
  87                                                     (-2 . "15mb")))))
  88                 (set! (ly:context-property context 'middleCOffset) offset)
  89                 (set! (ly:context-property context 'ottavation) string)
  90                 (ly:set-middle-C! context))))
  91            'Staff))))
  92
  93 (define (make-time-signature-set music)
  94   "Set context properties for a time signature."
  95   (let* ((num (ly:music-property music 'numerator))
  96          (den (ly:music-property music 'denominator))
  97          (structure (ly:music-property music 'beat-structure))
  98          (fraction (cons num den)))
  99     (list (descend-to-context
 100            (context-spec-music
 101             (make-apply-context
 102              (lambda (context)
 103                (let* ((time-signature-settings
 104                        (ly:context-property context 'timeSignatureSettings))
 105                       (my-base-length
 106                        (base-length fraction time-signature-settings))
 107                       (my-beat-structure
 108                        (if (null? structure)
 109                            (beat-structure my-base-length
 110                                            fraction
 111                                            time-signature-settings)
 112                            structure))
 113                       (beaming-exception
 114                        (beam-exceptions fraction time-signature-settings))
 115                       (new-measure-length (ly:make-moment num den)))
 116                  (ly:context-set-property!
 117                   context 'timeSignatureFraction fraction)
 118                  (ly:context-set-property!
 119                   context 'baseMoment (ly:make-moment my-base-length))
 120                  (ly:context-set-property!
 121                   context 'beatStructure my-beat-structure)
 122                  (ly:context-set-property!
 123                   context 'beamExceptions beaming-exception)
 124                  (ly:context-set-property!
 125                   context 'measureLength new-measure-length))))
 126             'Timing)
 127            'Score)
 128           ;; (make-music 'TimeSignatureEvent music) would always
 129           ;; create a Bottom context.  So instead, we just send the
 130           ;; event to whatever context may be currently active.  If
 131           ;; that is not contained within an existing context with
 132           ;; TimeSignatureEngraver at the time \time is iterated, it
 133           ;; will drop through the floor which mostly means that
 134           ;; point&click and tweaks are not available for any time
 135           ;; signatures engraved due to the Timing property changes
 136           ;; but without a \time of its own.  This is more a
 137           ;; "notification" rather than an "event" (which is always
 138           ;; sent to Bottom) but we don't currently have iterators for
 139           ;; that.
 140           (make-apply-context
 141            (lambda (context)
 142              (ly:broadcast (ly:context-event-source context)
 143                            (ly:make-stream-event
 144                             (ly:make-event-class 'time-signature-event)
 145                             (ly:music-mutable-properties music))))))))
 146
 147 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 148 ;; Some MIDI callbacks -- is this a good place for them?
 149
 150 (define-public (breathe::midi-length len context)
 151   ;;Shorten by half, or by up to a second, but always by a power of 2
 152   (let* ((desired (min (ly:moment-main (seconds->moment 1 context))
 153                        (* (ly:moment-main len) 1/2)))
 154          (scale (inexact->exact (ceiling (/ (log desired) (log 1/2)))))
 155          (breath (ly:make-moment (expt 1/2 scale))))
 156     (ly:moment-sub (ly:make-moment (ly:moment-main len)) breath)))