common/includes.ily

   1 %%% includes.ily -- commands for including files from a project hierarchy
   2 %%%
   3 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
   4 %%%
   5 %%% Directory hierarchy:
   6 %%%   Composer > Category > Opus > Piece
   7 %%%
   8 %%% For instance:
   9 %%%
  10 %%%   Lully/Ballets/AmourMalade/AAouverture
  11 %%%
  12 %%% LilyPond should be invoked from the hierarchy root,
  13 %%% or the hierarchy root should be in LilyPond include path.
  14 %%%
  15 %%% Special variables
  16 %%% =================
  17 %%%   (*composer*)
  18 %%%     the composer identifier in the project herarchy (a string)
  19 %%%
  20 %%%   (*category*)
  21 %%%     the category identifier in the project herarchy (a string)
  22 %%%
  23 %%%   (*opus*)
  24 %%%     the opus identifier in the project herarchy (a string)
  25 %%%
  26 %%%   (*piece*)
  27 %%%     the piece identifier in the project herarchy (a string)
  28 %%%
  29 %%% Scheme functions
  30 %%% ================
  31 %%%
  32 %%%  (include-pathname name)
  33 %%%    Composer, category, opus and piece special variables being set,
  34 %%%    possibly to an empty string, return the complete pathname of
  35 %%%    file <name>.ily
  36 %%%
  37 %%%  (include-score parser name)
  38 %%%    Set the piece special variable to `name', then parse the
  39 %%%    following LilyPond code:
  40 %%%       \include "<complete piece pathname>/score.ily"
  41 %%%
  42 %%% Music functions
  43 %%% ===============
  44 %%% Functions setting the current composer, category and opus:
  45 %%%
  46 %%%   \setComposer "composer"
  47 %%%     define the current composer
  48 %%%
  49 %%%   \setCategory "category"
  50 %%%   \setCategory "composer/category"
  51 %%%     define the current category, and possibly the current composer
  52 %%%
  53 %%%   \setOpus "opus"
  54 %%%   \setOpus "category/opus"
  55 %%%   \setOpus "composer/category/opus"
  56 %%%     define the current opus, and possibly the current composer and
  57 %%%     category
  58 %%%
  59 %%% Functions for parsing a piece score:
  60 %%%
  61 %%%   \includeScore "piece"
  62 %%%     set the current piece to `piece', and parse the file
  63 %%%     "<piece pathname>/score.ily"
  64 %%%
  65 %%% Functions parsing a file and returning its music:
  66 %%%
  67 %%%   \global
  68 %%%     Return the music of the current piece "global.ily" file,
  69 %%%     parsing it if that has not been done yet.
  70 %%%
  71 %%%   \includeNotes "name"
  72 %%%     == \notemode { \include "<piece pathname>/name.ily" }
  73 %%%
  74 %%%   \includeLyrics "name"
  75 %%%     == \lyricmode { \include "<piece pathname>/name.ily" }
  76 %%%
  77 %%%   \includeFigures "name"
  78 %%%     == \figuremode { \include "<piece pathname>/name.ily" }
  79 %%%
  80 %%% Depedencies
  81 %%% ===========
  82 %%% None
  83
  84 %%%
  85 %%%
  86 %%%
  87 #(use-modules (srfi srfi-39)
  88               (ice-9 optargs)
  89               (ice-9 regex))
  90
  91 %% Define the *target* and *target-full* variables
  92 #(define-public *target*
  93    (make-parameter (cond ((symbol? (ly:get-option 'target)) (ly:get-option 'target))
  94                          ((symbol? (ly:get-option 'part)) (ly:get-option 'part))
  95                          ((eqv? #t (ly:get-option 'letter))  'full-letter)
  96                          ((eqv? #t (ly:get-option 'urtext))  'full-urtext)
  97                          ((eqv? #t (ly:get-option 'use-rehearsal-numbers)) 'full-rehearsal)
  98                          (else 'full-a4))))
  99 #(define-public *target-full* (make-parameter (not (symbol? (ly:get-option 'part)))))
 100
 101 %% The newBookPart command uses the *target* variable value to decide
 102 %% whether it should actually start a new book part
 103 newBookPart =
 104 #(define-music-function (parser location targets) (list?)
 105    "To be used at toplevel, to start a new implicit bookpart, if
 106 *target* is a member of `targets'.  If there is some toplevel music or
 107 text, add it to a bookpart, and add that bookpart to the list of
 108 toplevel bookparts."
 109   (if (and (or (null? targets)
 110                (memq (*target*) targets)
 111                (and (*target-full*) (memq 'full targets)))
 112            (pair? (ly:parser-lookup parser 'toplevel-scores)))
 113       (begin
 114         (ly:parser-define! parser 'toplevel-bookparts
 115           (cons (ly:make-book-part (ly:parser-lookup parser 'toplevel-scores))
 116                 (ly:parser-lookup parser 'toplevel-bookparts)))
 117         (ly:parser-define! parser 'toplevel-scores (list))))
 118    (make-music 'Music 'void #t))
 119
 120 #(define *composer* (make-parameter ""))
 121 #(define *category* (make-parameter ""))
 122 #(define *opus* (make-parameter ""))
 123 #(define *piece* (make-parameter ""))
 124
 125 #(define-public (include-pathname name)
 126    (let ((hierarchy (list (*composer*)
 127                           (*category*)
 128                           (*opus*)
 129                           (*piece*))))
 130      (string-append
 131       (apply string-append
 132              (map (lambda (dir)
 133                     (if (string-null? dir)
 134                         ""
 135                         (string-append dir "/")))
 136                   hierarchy))
 137       name
 138       ".ily")))
 139
 140 #(define*-public (include-score parser name #:optional label)
 141    (add-music parser
 142               (make-music 'Music
 143                           'page-marker #t
 144                           'page-label (string->symbol (or label name))))
 145    (parameterize ((*piece* name))
 146      (ly:parser-parse-string
 147       (ly:parser-clone parser)
 148       (format #f "\\include \"~a\""
 149               (include-pathname "score")))))
 150
 151 %%%
 152 %%% Separate parts
 153 %%%
 154 #(define *opus-part-specs* (make-parameter #f)) % all part global specs
 155 #(define *part* (make-parameter #f)) % The chosen part identifer
 156 #(define *part-name* (make-parameter "")) % The chosen part name
 157 #(define *piece-description* (make-parameter #f)) % the current piece description
 158 #(define *note-filename* (make-parameter #f))
 159 #(define *instrument-name* (make-parameter #f))
 160 #(define *score-ragged* (make-parameter #f))
 161 #(define *system-count* (make-parameter #f))
 162 #(define *score-indent* (make-parameter #f))
 163 #(define *score-extra-music* (make-parameter #f))
 164 #(define *score-extra-music2* (make-parameter #f))
 165 #(define *tag-global* (make-parameter #f))
 166 #(define *tag-notes* (make-parameter #f))
 167 #(define *figures* (make-parameter #f))
 168 #(define *clef* (make-parameter #f))
 169
 170 #(define*-public (include-part-markup parser
 171                                       name
 172                                       markp
 173                                       #:optional label)
 174    (add-music parser
 175               (make-music 'Music
 176                           'page-marker #t
 177                           'page-label (string->symbol (or label name))))
 178    (add-text parser markp))
 179
 180 #(define*-public (include-part-music parser
 181                                      name
 182                                      music
 183                                      #:optional label)
 184    (add-music parser
 185               (make-music 'Music
 186                           'page-marker #t
 187                           'page-label (string->symbol (or label name))))
 188    (add-music parser music))
 189
 190 #(define*-public (include-part-score parser
 191                                     name
 192                                     score-filename
 193                                     from-templates
 194                                     #:optional label)
 195    (add-music parser
 196               (make-music 'Music
 197                           'page-marker #t
 198                           'page-label (string->symbol (or label name))))
 199    (parameterize ((*piece* name))
 200      (ly:parser-parse-string
 201       (ly:parser-clone parser)
 202       (format #f "\\include \"~a\""
 203               (if from-templates
 204                   (string-append "templates/" score-filename ".ily")
 205                   (include-pathname score-filename))))))
 206
 207 #(define* (make-piece piece-spec
 208                       #:key
 209                       (score #f)
 210                       (score-template "score")
 211                       notes
 212                       (instrument #f)
 213                       (ragged #f)
 214                       (system-count #f)
 215                       (clef "treble")
 216                       (figures "chiffres")
 217                       (tag-global #f)
 218                       (tag-notes #f))
 219   "Return an associative list defining a part piece, with the following keys:
 220  - name          the piece name.
 221  - score         the part piece filename (without directory, nor extension)
 222                    Default: \"score\"
 223  - from-template should the score filename be found in templates directory?
 224                    Is #t when #:score has been explicitely specified, #f otherwise.
 225  - ragged        the value of the ragged-last layout variable
 226                    Default: #f
 227  - system-count  the value of the system-count layout variable
 228                    Default: #f
 229  - indent        the value of the indent layout variable
 230                    Default: #f (which means that the globally defined indent is used)
 231  - tag-global    the tag to be used when including the 'global.ily' file:
 232                    \\keepWithTag #tag \\global
 233                    Default: #f (do not use a tag)
 234  - tag-notes     the tag to be used when including the note file:
 235                    Default: #f (do not use a tag)
 236  - notes         the note filename (without directory, nor extension)
 237                    Default: default-note-filename
 238  - instrument    the instrument name to be printed before the first staff
 239                    Default: #f (do not print instrument name)
 240
 241 `piece-spec' should be a list, which first-element is the piece name,
 242 then consisting of alterning keywords and values, the keywords being any
 243 combination from the following list:
 244   #:score #:score-template #:ragged #:system-count #:indent #:tag-global
 245   #:tag-notes #:notes #:instrument #:music
 246 #:music allows to include some extra music
 247 The keyword arguments give default values to be used when non-specified in `piece-spec'."
 248   (let ((score (or score score-template))
 249         (from-templates (not score))
 250         (ragged ragged)
 251         (system-count system-count)
 252         (indent #f)
 253         (tag-global tag-global)
 254         (tag-notes tag-notes)
 255         (notes notes)
 256         (clef clef)
 257         (instrument instrument)
 258         (music #f)
 259         (music2 #f)
 260         (on-the-fly-music #f)
 261         (on-the-fly-markup #f))
 262     (if clef (*clef* clef)) ;; hack: set *clef* for silence scores
 263     (let parse-props ((props piece-spec))
 264       (if (not (or (null? props) (null? (cdr props))))
 265           (begin
 266             (case (car props)
 267               ((#:notes) (set! notes (cadr props)))
 268               ((#:clef) (set! clef (cadr props)))
 269               ((#:ragged) (set! ragged (cadr props)))
 270               ((#:system-count) (set! system-count (cadr props)))
 271               ((#:indent) (set! indent (cadr props)))
 272               ((#:tag-global) (set! tag-global (cadr props)))
 273               ((#:tag-notes) (set! tag-notes (cadr props)))
 274               ((#:score)
 275                (set! score (cadr props))
 276                (set! from-templates #f))
 277               ((#:score-template)
 278                (set! score (cadr props))
 279                (set! from-templates #t))
 280               ((#:on-the-fly-music) (set! on-the-fly-music (cadr props)))
 281               ((#:on-the-fly-markup) (set! on-the-fly-markup (cadr props)))
 282               ((#:instrument) (set! instrument (cadr props)))
 283               ((#:music) (set! music (cadr props)))
 284               ((#:music2) (set! music2 (cadr props))))
 285             (parse-props (cddr props)))))
 286     `((score . ,score)
 287       (from-templates . ,from-templates)
 288       (ragged . ,ragged)
 289       (system-count . ,system-count)
 290       (indent . ,indent)
 291       (tag-global . ,tag-global)
 292       (tag-notes . ,tag-notes)
 293       (notes . ,notes)
 294       (clef . ,clef)
 295       (instrument . ,instrument)
 296       (figures . ,figures)
 297       (music . ,music)
 298       (music2 . ,music2)
 299       (on-the-fly-markup . ,on-the-fly-markup)
 300       (on-the-fly-music . ,on-the-fly-music))))
 301
 302 piecePartSpecs =
 303 #(define-music-function (parser location piece-specs) (list?)
 304    "Define the part spec for a piece, by setting the *piece-description* special variable"
 305    (define (get-part-opus-spec part)
 306      (let ((spec (assoc part (*opus-part-specs*))))
 307        (and spec (cdr spec))))
 308    (define (get-fallbacks part)
 309      (let ((part-opus-spec (get-part-opus-spec part)))
 310        (or (and part-opus-spec (cadr part-opus-spec)) (list))))
 311    (define (get-defaults part)
 312      (let ((part-opus-spec (get-part-opus-spec part)))
 313        (or (and part-opus-spec (caddr part-opus-spec)) (list))))
 314    (define (get-default-clef part)
 315      (define* (get-clef-helper #:key (clef #f) #:allow-other-keys)
 316        clef)
 317      (let ((part-opus-spec (get-part-opus-spec part)))
 318        (and part-opus-spec (apply get-clef-helper (caddr part-opus-spec)))))
 319
 320    (define (get-part-piece parts piece-specs)
 321      (if (null? parts)
 322          ;; default silent piece
 323          (make-piece (list #:ragged #t
 324                            #:notes "silence"
 325                            #:score-template "score-silence")
 326                      #:clef #f)
 327          (let* ((part (caar parts))
 328                 (part-name (cadar parts))
 329                 (forced-clef (if (null? (cddar parts)) #f (caddar parts)))
 330                 (spec-result (assoc part piece-specs))
 331                 (spec (and spec-result (cdr spec-result))))
 332            (if spec
 333                (let* ((default-spec (append (get-defaults part)
 334                                             (if forced-clef
 335                                                 (list #:clef forced-clef)
 336                                                 (list))))
 337                        (piece (apply make-piece spec default-spec)))
 338                  (if (and part-name (not (assoc-ref piece 'instrument)))
 339                      (assoc-set! piece 'instrument part-name))
 340                  piece)
 341                (get-part-piece (cdr parts) piece-specs)))))
 342
 343    (let* ((part-opus-spec (get-part-opus-spec (*part*)))
 344           (parts (append (list (list (*part*) #f))
 345                          (get-fallbacks (*part*))
 346                          (list (list 'silence #f (get-default-clef (*part*)))))))
 347      (*piece-description* (get-part-piece parts piece-specs)))
 348    (make-music 'Music 'void #t))
 349
 350 opusPartSpecs =
 351 #(define-music-function (parser location opus-specs) (list?)
 352    (let* ((silence-specs '(silence "" ()
 353                                    (#:ragged #t #:notes "silence"
 354                                     #:score-template "score-silence")))
 355           (full-opus-specs (if (not (assoc 'silence opus-specs))
 356                                (cons silence-specs opus-specs)
 357                                opus-specs)))
 358      (*opus-part-specs* full-opus-specs))
 359    (let* ((name (ly:get-option 'part))
 360           (spec (assoc name (*opus-part-specs*))))
 361      (cond (spec
 362             (*part* name)
 363             (*part-name* (cadr spec)))
 364            (name
 365             (ly:warning "No `~a' part defined for this opus" name))))
 366    (make-music 'Music 'void #t))
 367
 368 %%%
 369 %%% Music functions
 370 %%%
 371
 372 global =
 373 #(define-music-function (parser this-location) ()
 374    (set! location #f)
 375   (let* ((global-symbol
 376           (string->symbol (format "global~a~a" (*opus*) (*piece*))))
 377          (global-music (ly:parser-lookup parser global-symbol)))
 378    (if (not (ly:music? global-music))
 379        (let* ((global-file (include-pathname "global")))
 380          (set! global-music
 381                #{ \notemode { \staffStart \include $global-file } #})
 382          (ly:parser-define! parser global-symbol global-music)))
 383    (ly:music-deep-copy global-music)))
 384
 385 includeNotes =
 386 #(define-music-function (parser this-location pathname) (string?)
 387    ;; use locations from the included file,
 388    ;; and not from where \includeNotes is called
 389    (set! location #f)
 390   (let ((include-file (include-pathname pathname)))
 391    #{ \notemode { \include $include-file } #}))
 392
 393 includeLyrics =
 394 #(define-music-function (parser this-location pathname) (string?)
 395    ;; use locations from the included file,
 396    ;; and not from where \includeNotes is called
 397    (set! location #f)
 398   (let ((include-file (include-pathname pathname)))
 399    #{ \lyricmode { \include $include-file } #}))
 400
 401 includeFigures =
 402 #(define-music-function (parser this-location pathname) (string?)
 403    ;; use locations from the included file,
 404    ;; and not from where \includeNotes is called
 405    (set! location #f)
 406   (let ((include-file (include-pathname pathname)))
 407      #{ \new FiguredBass \figuremode { \include $include-file } #}))
 408
 409 setComposer =
 410 #(define-music-function (parser location name) (string?)
 411    (*composer* name)
 412    (make-music 'Music 'void #t))
 413
 414 setCategory =
 415 #(define-music-function (parser location name) (string?)
 416    (let ((match (string-match "^(.*)/(.*)$" name)))
 417      (if match
 418          (begin ;; composer/category
 419            (*composer* (match:substring match 1))
 420            (*category* (match:substring match 2)))
 421          ;; category
 422          (*category* name)))
 423    (make-music 'Music 'void #t))
 424
 425 setOpus =
 426 #(define-music-function (parser location name) (string?)
 427    (let ((match (string-match "^(.*)/(.*)/(.*)$" name)))
 428      (if match
 429          (begin ;; composet/category/opus
 430            (*composer* (match:substring match 1))
 431            (*category* (match:substring match 2))
 432            (*opus* (match:substring match 3)))
 433          (let ((match (string-match "^(.*)/(.*)$" name)))
 434            (if match
 435                (begin ;; category/opus
 436                  (*category* (match:substring match 1))
 437                  (*opus* (match:substring match 2)))
 438                ;; opus
 439                (*opus* name)))))
 440    (make-music 'Music 'void #t))
 441
 442 #(define (include-score-helper parser name label allow-page-turn)
 443    ;;(format #t "Including score `~a'~%" name)
 444    (if (eqv? #t (ly:get-option 'non-score-print))
 445        (let ((label (string->symbol (or label name))))
 446          (add-music
 447           parser
 448           (make-music 'EventChord
 449                       'elements (list (make-music
 450                                        'LabelEvent
 451                                        'page-label label))
 452                       'page-marker #t
 453                       'page-label label))
 454          (add-toplevel-markup parser name))
 455        (parameterize ((*piece* name))
 456          ;;(format #t "Reading ~a~%" name)
 457          (if (*part*)
 458              (begin ;; a part score
 459                ;; Include the parts.ily file, describing
 460                ;; the parts defined for this piece.
 461                ;; It should contain a call to \piecePartSpec
 462                ;; which sets *piece-description*
 463                (ly:parser-parse-string (ly:parser-clone parser)
 464                                        (format #f "\\include \"~a\""
 465                                                (include-pathname "parts")))
 466                (let ((piece (*piece-description*)))
 467                  ;; special cases: if on-the-fly-markup or
 468                  ;; on-the-fly-music are set,
 469                  ;; just include the markup/music
 470                  (cond ((assoc-ref piece 'on-the-fly-markup)
 471                         (include-part-markup parser
 472                                              name
 473                                              (assoc-ref piece 'on-the-fly-markup)
 474                                              label))
 475                        ((assoc-ref piece 'on-the-fly-music)
 476                         (include-part-music parser
 477                                             name
 478                                             (assoc-ref piece 'on-the-fly-music)
 479                                             label))
 480                        (else
 481                         (parameterize ((*score-ragged* (assoc-ref piece 'ragged))
 482                                        (*system-count* (assoc-ref piece 'system-count))
 483                                        (*note-filename* (assoc-ref piece 'notes))
 484                                        (*instrument-name* (assoc-ref piece 'instrument))
 485                                        (*score-indent* (assoc-ref piece 'indent))
 486                                        (*tag-global* (assoc-ref piece 'tag-global))
 487                                        (*tag-notes* (assoc-ref piece 'tag-notes))
 488                                        (*figures* (assoc-ref piece 'figures))
 489                                        (*clef* (or (assoc-ref piece 'clef) (*clef*) "treble"))
 490                                        (*score-extra-music* (assoc-ref piece 'music))
 491                                        (*score-extra-music2* (assoc-ref piece 'music2)))
 492                           (include-part-score parser
 493                                               name
 494                                               (assoc-ref piece 'score)
 495                                               (assoc-ref piece 'from-templates)
 496                                               label)))))
 497                (if allow-page-turn
 498                    (add-allow-page-turn parser)))
 499              ;; conductor score
 500              (include-score parser name label))))
 501    (make-music 'Music 'void #t))
 502
 503 includeScore =
 504 #(define-music-function (parser location name) (string?)
 505    (include-score-helper parser name #f #t))
 506
 507 includeScoreCond =
 508 #(define-music-function (parser location condition name)
 509      (boolean? string?)
 510    (if condition
 511        (include-score-helper parser name #f #t)
 512        (make-music 'Music 'void #t)))
 513
 514 includeScoreNoPageTurn =
 515 #(define-music-function (parser location name) (string?)
 516    (include-score-helper parser name #f #f))
 517
 518 reIncludeScore =
 519 #(define-music-function (parser location name label) (string? string?)
 520    (include-score-helper parser name label #t))
 521
 522 reIncludeScoreCond =
 523 #(define-music-function (parser location condition name label)
 524      (boolean? string? string?)
 525    (if condition
 526        (include-score-helper parser name label #t)
 527        (make-music 'Music 'void #t)))
 528
 529 %%%
 530 %%%
 531 %%%
 532 #(define (toplevel-score-handler parser score)
 533     (cond ((ly:parser-lookup parser '$current-bookpart)
 534            ((ly:parser-lookup parser 'bookpart-score-handler)
 535             (ly:parser-lookup parser '$current-bookpart) score))
 536           ((ly:parser-lookup parser '$current-book)
 537            ((ly:parser-lookup parser 'book-score-handler)
 538             (ly:parser-lookup parser '$current-book) score))
 539           (else
 540            (collect-scores-for-book parser score))))