scm/define-music-callbacks.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 1998--2011 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 'origin))
  27         (duration (ly:music-property music 'duration)))
  28     (list (make-music 'BarCheck
  29                       'origin location)
  30           (make-event-chord (cons (make-music 'MultiMeasureRestEvent
  31                                               'origin location
  32                                               'duration duration)
  33                                   (ly:music-property music 'articulations)))
  34           (make-music 'BarCheck
  35                       'origin location))))
  36
  37 (define (make-volta-set music)
  38   (let* ((alts (ly:music-property music 'elements))
  39          (lalts (length alts))
  40          (times (ly:music-property music 'repeat-count)))
  41     (map (lambda (x y)
  42            (make-music
  43              'SequentialMusic
  44              'elements
  45                ;; set properties for proper bar numbering
  46                (append
  47                  (list (make-music 'AlternativeEvent
  48                                    'alternative-dir (if (= y 0)
  49                                                         -1
  50                                                         0)
  51                                    'alternative-increment
  52                                      (if (= 0 y)
  53                                          (1+ (- times
  54                                                 lalts))
  55                                              1)))
  56                        (list x)
  57                        (if (= y (1- lalts))
  58                            (list (make-music 'AlternativeEvent
  59                                              'alternative-dir 1
  60                                              'alternative-increment 0))
  61                            '()))))
  62          alts
  63          (iota lalts))))
  64
  65 (define (make-ottava-set music)
  66   "Set context properties for an ottava bracket."
  67   (let ((octavation (ly:music-property music 'ottava-number)))
  68
  69     (list (context-spec-music
  70            (make-apply-context
  71             (lambda (context)
  72               (let ((offset (* -7 octavation))
  73                     (string (assoc-get octavation '((2 . "15ma")
  74                                                     (1 . "8va")
  75                                                     (0 . #f)
  76                                                     (-1 . "8vb")
  77                                                     (-2 . "15mb")))))
  78                 (set! (ly:context-property context 'middleCOffset) offset)
  79                 (set! (ly:context-property context 'ottavation) string)
  80                 (ly:set-middle-C! context))))
  81            'Staff))))
  82
  83 (define (make-time-signature-set music)
  84   "Set context properties for a time signature."
  85   (let* ((num (ly:music-property music 'numerator))
  86          (den (ly:music-property music 'denominator))
  87          (structure (ly:music-property music 'beat-structure))
  88          (fraction (cons num den)))
  89     (list (descend-to-context
  90             (context-spec-music
  91               (make-apply-context
  92                 (lambda (context)
  93                   (let* ((time-signature-settings
  94                           (ly:context-property context 'timeSignatureSettings))
  95                          (my-base-fraction
  96                            (base-fraction fraction time-signature-settings))
  97                          (my-beat-structure
  98                            (if (null? structure)
  99                                (beat-structure my-base-fraction
 100                                                fraction
 101                                                time-signature-settings)
 102                                structure))
 103                          (beaming-exception
 104                            (beam-exceptions fraction time-signature-settings))
 105                          (new-measure-length (ly:make-moment num den)))
 106                      (ly:context-set-property!
 107                        context 'timeSignatureFraction fraction)
 108                      (ly:context-set-property!
 109                        context 'baseMoment (fraction->moment my-base-fraction))
 110                      (ly:context-set-property!
 111                        context 'beatStructure my-beat-structure)
 112                      (ly:context-set-property!
 113                        context 'beamExceptions beaming-exception)
 114                      (ly:context-set-property!
 115                        context 'measureLength new-measure-length))))
 116                 'Timing)
 117             'Score))))