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