lib/liblayout.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- liblayout.scm                                      ;
   3 ;                                                                  ;
   4 ; (c) 2008-2011 Valentin Villenave <valentin@villenave.net>        ;
   5 ;                                                                  ;
   6 ;     opus_libre is a free framework for GNU LilyPond: you may     ;
   7 ; redistribute it and/or modify it under the terms of the GNU      ;
   8 ; General Public License as published by the Free Software         ;
   9 ; Foundation, either version 3 of the License, or (at your option) ;
  10 ; any later version.                                               ;
  11 ;     This program is distributed WITHOUT ANY WARRANTY; without    ;
  12 ; even the implied warranty of MERCHANTABILITY or FITNESS FOR A    ;
  13 ; PARTICULAR PURPOSE.  You should have received a copy of the GNU  ;
  14 ; General Public License along with this program (typically in the ;
  15 ; share/doc/ directory).  If not, see http://www.gnu.org/licenses/ ;
  16 ;                                                                  ;
  17 ;------------------------------------------------------------------;
  18
  19
  20 ; Layout functions.
  21
  22
  23 (define modern-accidentals-style
  24   `(Staff ,(make-accidental-rule 'same-octave 0)
  25           ,(make-accidental-rule 'any-octave 0)
  26           ,(make-accidental-rule 'same-octave 1)
  27           ,neo-modern-accidental-rule))
  28
  29 (define modern-cautionaries-style
  30   `(Staff ,(make-accidental-rule 'same-octave 1)
  31           ,(make-accidental-rule 'any-octave 1)))
  32
  33 (define modern-script-alist
  34   (let* ((new-alist default-script-alist)
  35          (set-prio! (lambda (script prio) (assoc-set! new-alist script
  36                               (acons
  37                                     'script-priority prio
  38                                      (assoc-get script default-script-alist))))))
  39      ;(set-prio! "staccato" -100)
  40      (set-prio! "accent" -105)
  41      (set-prio! "tenuto" -110)
  42      new-alist))
  43
  44 (define modern-time-signature-settings
  45   (append
  46     '(
  47       ((3 . 16) .
  48                 ((baseMoment . 3/16)))
  49       ((5 . 16) .
  50                 ((baseMoment . 3/16)))
  51       ((7 . 16) .
  52                 ((baseMoment . 4/16)))
  53       ((2 . 8) .
  54                 ((baseMoment . 2/8)))
  55       ((3 . 8) .
  56                 ((beamExceptions . ((end . (((1 . 8) . (3))))))))
  57       ((4 . 8) .
  58                 ((beatStructure . (2 2))))
  59       ((5 . 8) .
  60                 ((beatStructure . (3 2))))
  61       ((8 . 8) .
  62                 ((beatStructure . (3 3 2))))
  63       ((7 . 8) .
  64                 ((baseMoment . 4/8)))
  65       ((3 . 4) .
  66                 ((beamExceptions . ((end . (((1 . 8) . (2 2 2))
  67                                             ((1 . 12) . (3 3 3))))))))
  68       ((4 . 4) .
  69                 ((beamExceptions . ((end . (((1 . 8) . (4 4))
  70                                             ((1 . 12) . (3 3 3 3))))))))
  71       ((6 . 4) .
  72                 ((beamExceptions . ((end .  (((1 . 16) . (4 4 4 4 4 4))))))))
  73       ((2 . 2) .
  74                 ((beamExceptions . ((end . (((1 . 12) . (3 3 3 3))))))))
  75       ((3 . 2) .
  76                 ((beamExceptions . ((end .  (((1 . 12) . (3 3 3 3 3 3))))))))
  77       ((4 . 2) .
  78                 ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4 4 4))))))))
  79     ) default-time-signature-settings))