definitions/common.ly

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