definitions/common.ly

   1 %------------------------------------------------------------------%
   2 % Opéra Libre -- common.ly                                         %
   3 %                                                                  %
   4 % (c) Valentin Villenave, 2008                                     %
   5 %                                                                  %
   6 %------------------------------------------------------------------%
   7
   8 %%%%%%%%%%%%%%%%%%%%%%%%%% Common Layout %%%%%%%%%%%%%%%%%%%%%%%%%%%
   9
  10 %% Paper size -----------------------------------------------------%
  11 #(set-default-paper-size "a4" 'landscape)
  12
  13 %% Page breaking --------------------------------------------------%
  14 #(define page-breaking ly:optimal-breaking)
  15
  16 %% Staff size -----------------------------------------------------%
  17 #(set-global-staff-size 14)
  18
  19 %% Time Signatures layouts ----------------------------------------%
  20
  21 % FIXME: move to layout.ly
  22
  23 CoolSignatures = {
  24   \override TimeSignature #'break-visibility = #end-of-line-invisible
  25   \override TimeSignature #'font-size = #3
  26   \override TimeSignature #'break-align-symbol = ##f
  27   \override TimeSignature #'X-offset = #ly:self-alignment-interface::x-aligned-on-self
  28   \override TimeSignature #'self-alignment-X = #0
  29   \override TimeSignature #'after-line-breaking = #shift-right-at-line-begin
  30 }
  31
  32 topTimeSig = {
  33   \CoolSignatures
  34   \override TimeSignature #'font-size = #4
  35 }
  36
  37 middleTimeSig = {
  38   \CoolSignatures
  39 %  \override TimeSignature #'break-visibility = ##(#f #t #f)
  40   \override TimeSig.TimeSignature #'font-size = #3
  41   \override TimeSig.VerticalAxisGroup #'minimum-Y-extent = #'(-1 . 5)
  42 }
  43
  44 PianoDynamics = {
  45   \override Dynamics.TimeSignature #'font-size = #1
  46   \override Dynamics.VerticalAxisGroup #'minimum-Y-extent = #'(-1.5 . 1.5 )
  47 }
  48
  49
  50
  51 %%%%%%%%%%%%%%%%%%%% Functions initialization %%%%%%%%%%%%%%%%%%%%%%
  52
  53 #(use-modules (srfi srfi-39)(ice-9 regex))
  54 #(ly:set-option 'point-and-click #f)
  55
  56
  57
  58
  59
  60
  61
  62
  63
  64
  65 %%% -*- Mode: scheme -*-
  66 %%% The following functions were provided by
  67 %%% Nicolas Sceaux <nicolas.sceaux@free.fr>
  68
  69
  70 %%%%%%%%%%%%%%%%%%%%%%%%%% Score Inclusion %%%%%%%%%%%%%%%%%%%%%%%%%
  71
  72 %% Scheme functions -----------------------------------------------%
  73
  74 #(define *composer* (make-parameter ""))
  75 #(define *category* (make-parameter ""))
  76 #(define *opus* (make-parameter ""))
  77 #(define *piece* (make-parameter ""))
  78
  79 #(define-public (include-pathname name)
  80    (let ((hierarchy (list (*composer*)
  81                           (*category*)
  82                           (*opus*)
  83                           (*piece*))))
  84      (string-append
  85       (apply string-append
  86              (map (lambda (dir)
  87                     (if (string-null? dir)
  88                         ""
  89                         (string-append dir "/")))
  90                   hierarchy))
  91       name
  92       ".ly")))
  93
  94 #(define-public (include-score parser name)
  95    (collect-music-for-book
  96     parser
  97     (make-music 'Music
  98                 'page-marker #t
  99                 'page-label (string->symbol name)))
 100    (parameterize ((*piece* name))
 101      (ly:parser-parse-string
 102       (ly:parser-clone parser)
 103       (format #f "\\include \"~a\""
 104               (include-pathname "score")))))
 105
 106 %%%
 107 %%% Separate parts
 108 %%%
 109 #(define *all-part-specs* (make-parameter (list)))
 110 #(define *part-specs* (make-parameter #f))
 111 #(define *part* (make-parameter #f))
 112 #(define *part-name* (make-parameter ""))
 113 #(define *note-filename* (make-parameter #f))
 114 #(define *instrument-name* (make-parameter #f))
 115 #(define *score-ragged* (make-parameter #f))
 116 #(define *score-indent* (make-parameter #f))
 117 #(define *score-extra-music* (make-parameter #f))
 118 #(define *tag* (make-parameter #f))
 119
 120 #(define-public (include-part-score parser
 121                                     name
 122                                     score-filename
 123                                     from-templates)
 124    (collect-music-for-book
 125     parser
 126     (make-music 'Music
 127                 'page-marker #t
 128                 'page-label (string->symbol name)))
 129    (parameterize ((*piece* name))
 130      (ly:parser-parse-string
 131       (ly:parser-clone parser)
 132       (format #f "\\include \"~a\""
 133               (if from-templates
 134                   (string-append "templates/" score-filename ".ly")
 135                   (include-pathname score-filename))))))
 136
 137 #(define (make-piece piece-spec default-note-filename)
 138   "Return an associative list defining a part piece, with the following keys:
 139  - name          the piece name.
 140  - score         the part piece filename (without directory, nor extension)
 141                    Default: \"score\"
 142  - from-template should the score filename be found in templates directory?
 143                    Is #t when #:score has been explicitely specified, #f otherwise.
 144  - ragged        the value of the layout ragged-last variable
 145                    Default: #f
 146  - indent        the value of the layout indent variable
 147                    Default: #f (which means that the globally defined indent is used)
 148  - tag           the tag to be used when including the 'global.ily' file:
 149                    \\keepWithTag #tag \\global
 150                    Default: #f (do not use a tag)
 151  - notes         the note filename (without directory, nor extension)
 152                    Default: default-note-filename
 153  - instrument    the instrumnt name to be printed before the first staff
 154                    Default: #f (do not print instrument name)
 155
 156 `piece-spec' should be a list, which first-element is the peice name,
 157 then consisting of alterning keywords and values, the keywords being any
 158 combination from the following list:
 159   #:score #:ragged #:indent #:tag #:notes #:instrument #:silence #:music
 160 where #:silence, when associated to a true value, forces the printing of rests
 161       #:music allows to include some extra music"
 162   (let ((name (car piece-spec))
 163         (score "score")
 164         (from-templates #t)
 165         (ragged #f)
 166         (indent #f)
 167         (tag #f)
 168         (notes default-note-filename)
 169         (instrument #f)
 170         (music #f))
 171     (let parse-props ((props (cdr piece-spec)))
 172       (if (not (or (null? props) (null? (cdr props))))
 173           (begin
 174             (case (car props)
 175               ((#:notes) (set! notes (cadr props)))
 176               ((#:ragged) (set! ragged (cadr props)))
 177               ((#:indent) (set! indent (cadr props)))
 178               ((#:tag) (set! tag (cadr props)))
 179               ((#:score)
 180                (set! score (cadr props))
 181                (set! from-templates #f))
 182               ((#:instrument) (set! instrument (cadr props)))
 183               ((#:music) (set! music (cadr props)))
 184               ((#:silence)
 185                (if (cadr props)
 186                    (begin
 187                      (set! score "score-silence")
 188                      (set! ragged #t)
 189                      (set! notes "silence")
 190                      (set! from-templates #t)))))
 191             (parse-props (cddr props)))))
 192     `((name . ,name)
 193       (score . ,score)
 194       (from-templates . ,from-templates)
 195       (ragged . ,ragged)
 196       (indent . ,indent)
 197       (tag . ,tag)
 198       (notes . ,notes)
 199       (instrument . ,instrument)
 200       (music . ,music))))
 201
 202 %% Music functions ------------------------------------------------%
 203
 204 %%%   \includeScore "piece"
 205 %%%     set the current piece to `piece', and parse the file
 206 %%%     "<piece pathname>/score.ily"
 207 %%%
 208 %%% Functions parsing a file and returning its music:
 209 %%%
 210 %%%   \global
 211 %%%     Return the music of the current piece "global.ily" file,
 212 %%%     parsing it if that has not been done yet.
 213
 214 setPart =
 215 #(define-music-function (parser location name) (string?)
 216    (define (add-piece! pieces-htable piece-spec forced default-note-filename instrument)
 217      (let ((piece-name (car piece-spec)))
 218        (if (or forced (not (hashq-ref pieces-htable piece-name #f)))
 219            (let ((piece (make-piece piece-spec default-note-filename)))
 220              (if (and instrument
 221                       (not (assoc-ref piece 'instrument)))
 222                  (assoc-set! piece 'instrument instrument))
 223              (hashq-set! pieces-htable piece-name piece)))))
 224    (let* ((part-key (string->symbol name))
 225           (spec (assoc part-key (*all-part-specs*))))
 226      (if spec
 227          (let ((part-name (cadr spec))
 228                (fallbacks (caddr spec))
 229                (default-notes (cadddr spec))
 230                (piece-specs (cddddr spec)))
 231            (*part* part-key)
 232            (*part-name* part-name)
 233            (*part-specs* (make-hash-table 150))
 234            (for-each (lambda (piece-spec)
 235                       (add-piece! (*part-specs*) piece-spec #t default-notes #f))
 236                     piece-specs)
 237            (for-each (lambda (fallback)
 238                       (let* ((key (car fallback))
 239                              (instrument (cadr fallback))
 240                              (spec (assoc key (*all-part-specs*))))
 241                         (if spec
 242                             (let ((default-notes (cadddr spec))
 243                                   (piece-specs (cddddr spec)))
 244                               (for-each (lambda (piece-spec)
 245                                          (add-piece! (*part-specs*) piece-spec #f default-notes instrument))
 246                                        piece-specs)))))
 247                     fallbacks))
 248          (ly:warning "No `~a' part defined for this opus" part-key)))
 249    (make-music 'Music 'void #t))
 250
 251 %%%
 252 %%% Music functions
 253 %%%
 254
 255 global =
 256 #(define-music-function (parser location) ()
 257   (let* ((global-symbol (string->symbol (format "global~a~a" (*opus*) (*piece*))))
 258          (global-music (ly:parser-lookup parser global-symbol))
 259          (start-overrides (ly:parser-lookup parser 'staffStart)))
 260    (if (not (ly:music? global-music))
 261        (let* ((global-file (include-pathname "global")))
 262          (if (not (ly:music? start-overrides))
 263              (set! start-overrides (make-music 'Music)))
 264          (set! global-music #{ \notemode { $start-overrides \include $global-file } #})
 265          (ly:parser-define! parser global-symbol global-music)))
 266    (ly:music-deep-copy global-music)))
 267
 268 includeNotes =
 269 #(define-music-function (parser location pathname) (string?)
 270   (let ((include-file (include-pathname pathname)))
 271    #{ \notemode { \include $include-file } #}))
 272
 273 includeLyrics =
 274 #(define-music-function (parser location pathname) (string?)
 275   (let ((include-file (include-pathname pathname)))
 276    #{ \lyricmode { \include $include-file } #}))
 277
 278 includeScore =
 279 #(define-music-function (parser location name) (string?)
 280    (if (*part*)
 281        ;; a part score
 282        (let ((piece (hashq-ref (*part-specs*)
 283                                (string->symbol name)
 284                                (make-piece (list (string->symbol name)
 285                                                  #:silence #t)
 286                                            "silence"))))
 287          (parameterize ((*score-ragged* (assoc-ref piece 'ragged))
 288                         (*note-filename* (assoc-ref piece 'notes))
 289                         (*instrument-name* (assoc-ref piece 'instrument))
 290                         (*score-indent* (assoc-ref piece 'indent))
 291                         (*tag* (assoc-ref piece 'tag))
 292                         (*score-extra-music* (assoc-ref piece 'music)))
 293            (include-part-score parser
 294                                name
 295                                (assoc-ref piece 'score)
 296                                (assoc-ref piece 'from-templates))))
 297        ;; conductor score
 298        (include-score parser name))
 299    (make-music 'Music 'void #t))
 300
 301 %%% -*- Mode: scheme -*-
 302
 303 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 304 %%%
 305 %%% Tagging commands
 306 %%%
 307
 308 #(use-modules (srfi srfi-1))
 309 #(define* (has-some-member? list1 list2 #:key (test eqv?))
 310    "Return a true value iif there exists an element of list1 that also
 311 belongs to list2 under test."
 312    (if (null? list1)
 313        #f
 314        (or (member (car list1) list2 test)
 315            (has-some-member? (cdr list1) list2 #:test test))))
 316
 317 #(define (symbol-or-symbols? x)
 318    (or (null? x)
 319        (symbol? x)
 320        (and (list? x) (every symbol? x))))
 321
 322 keepWithTag =
 323 #(define-music-function (parser location tags music)
 324                         (symbol-or-symbols? ly:music?)
 325    (music-filter
 326     (lambda (m)
 327       (let ((m.tags (ly:music-property m 'tags)))
 328         (cond ((symbol? tags)
 329                (or (null? m.tags) (memq tags m.tags)))
 330               ((null? tags)
 331                (null? m.tags))
 332               ((list? tags)
 333                (or (null? m.tags) (has-some-member? tags m.tags)))
 334               (else #t))))
 335     music))
 336
 337 tag =
 338 #(define-music-function (parser location tags arg)
 339                         (symbol-or-symbols? ly:music?)
 340    "Add @var{tags} (a single tag or a list of tags) to the @code{tags}
 341 property of @var{arg}."
 342    (set! (ly:music-property arg 'tags)
 343          (if (symbol? tags)
 344              (cons tags (ly:music-property arg 'tags))
 345              (append tags (ly:music-property arg 'tags))))
 346    arg)
 347
 348
 349 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 350 %%%
 351 %%% smaller notes
 352 %%%
 353
 354 smallNotes =
 355 #(define-music-function (parser location music) (ly:music?)
 356   (let ((first-chord-already-found #f)
 357         (last-chord #f)
 358         (start-beam (make-music 'BeamEvent
 359                                 'span-direction -1))
 360         (end-beam (make-music 'BeamEvent
 361                               'span-direction 1))
 362         (note-count 0))
 363     ;; Add [ beaming directive to the first chord
 364     (music-map (lambda (event)
 365                  (cond ((eqv? (ly:music-property event 'name) 'EventChord)
 366                         (cond ((not first-chord-already-found)
 367                                ;; the first ChordEvent: add start beam
 368                                (set! first-chord-already-found #t)
 369                                (set! (ly:music-property event 'elements)
 370                                      (cons start-beam
 371                                            (ly:music-property event 'elements))))
 372                               (else (set! last-chord event))))
 373                        ((eqv? (ly:music-property event 'name) 'NoteEvent)
 374                         (set! note-count (1+ note-count))))
 375                  event)
 376                music)
 377     ;; Add ] beaming directive to the last chord
 378     (set! (ly:music-property last-chord 'elements)
 379           (cons end-beam (ly:music-property last-chord 'elements)))
 380     ;; If there are 3 notes, add a *2/3 duration factor
 381     (if (= note-count 3)
 382         (music-map (lambda (event)
 383                      (if (eqv? (ly:music-property event 'name) 'NoteEvent)
 384                          (let* ((duration (ly:music-property event 'duration))
 385                                 (dot-count (ly:duration-dot-count duration))
 386                                 (log (ly:duration-log duration)))
 387                            (set! (ly:music-property event 'duration)
 388                                  (ly:make-duration log dot-count 2 3))))
 389                      event)
 390                    music)))
 391   #{
 392   \override Voice.NoteHead #'font-size = #-3
 393   \override Voice.Stem #'font-size = #-3
 394   \override Voice.NoteHead #'font-size = #-3
 395   \override Voice.Accidental #'font-size = #-4
 396   $music
 397   \revert Voice.NoteHead #'font-size
 398   \revert Voice.Stem #'font-size
 399   \revert Voice.NoteHead #'font-size
 400   \revert Voice.Accidental #'font-size
 401   #})
 402
 403
 404 %%%
 405 %%% Misc utilities
 406 %%%
 407
 408 instrumentName =
 409 #(define-music-function (parser location name) (markup?)
 410    #{ \set Staff.instrumentName = \markup \large $name #})
 411
 412 characterName =
 413 #(define-music-function (parser location name) (markup?)
 414   #{ \set Staff . instrumentName = \markup \large \smallCaps $name #})
 415