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 *score-indent* (make-parameter #f))
 162 #(define *score-extra-music* (make-parameter #f))
 163 #(define *score-extra-music2* (make-parameter #f))
 164 #(define *tag-global* (make-parameter #f))
 165 #(define *tag-notes* (make-parameter #f))
 166 #(define *figures* (make-parameter #f))
 167 #(define *clef* (make-parameter #f))
 168
 169 #(define*-public (include-part-markup parser
 170                                       name
 171                                       markp
 172                                       #:optional label)
 173    (add-music parser
 174               (make-music 'Music
 175                           'page-marker #t
 176                           'page-label (string->symbol (or label name))))
 177    (add-text parser markp))
 178
 179 #(define*-public (include-part-score parser
 180                                     name
 181                                     score-filename
 182                                     from-templates
 183                                     #:optional label)
 184    (add-music parser
 185               (make-music 'Music
 186                           'page-marker #t
 187                           'page-label (string->symbol (or label name))))
 188    (parameterize ((*piece* name))
 189      (ly:parser-parse-string
 190       (ly:parser-clone parser)
 191       (format #f "\\include \"~a\""
 192               (if from-templates
 193                   (string-append "templates/" score-filename ".ily")
 194                   (include-pathname score-filename))))))
 195
 196 #(define* (make-piece piece-spec
 197                       #:key
 198                       (score #f)
 199                       (score-template "score")
 200                       notes
 201                       (instrument #f)
 202                       (ragged #f)
 203                       (clef "treble")
 204                       (figures "chiffres")
 205                       (tag-global #f)
 206                       (tag-notes #f))
 207   "Return an associative list defining a part piece, with the following keys:
 208  - name          the piece name.
 209  - score         the part piece filename (without directory, nor extension)
 210                    Default: \"score\"
 211  - from-template should the score filename be found in templates directory?
 212                    Is #t when #:score has been explicitely specified, #f otherwise.
 213  - ragged        the value of the layout ragged-last variable
 214                    Default: #f
 215  - indent        the value of the layout indent variable
 216                    Default: #f (which means that the globally defined indent is used)
 217  - tag-global    the tag to be used when including the 'global.ily' file:
 218                    \\keepWithTag #tag \\global
 219                    Default: #f (do not use a tag)
 220  - tag-notes     the tag to be used when including the note file:
 221                    Default: #f (do not use a tag)
 222  - notes         the note filename (without directory, nor extension)
 223                    Default: default-note-filename
 224  - instrument    the instrument name to be printed before the first staff
 225                    Default: #f (do not print instrument name)
 226
 227 `piece-spec' should be a list, which first-element is the piece name,
 228 then consisting of alterning keywords and values, the keywords being any
 229 combination from the following list:
 230   #:score #:score-template #:ragged #:indent #:tag-global #:tag-notes
 231   #:notes #:instrument #:music
 232 #:music allows to include some extra music
 233 The keyword arguments give default values to be used when non-specified in `piece-spec'."
 234   (let ((score (or score score-template))
 235         (from-templates (not score))
 236         (ragged ragged)
 237         (indent #f)
 238         (tag-global tag-global)
 239         (tag-notes tag-notes)
 240         (notes notes)
 241         (clef clef)
 242         (instrument instrument)
 243         (music #f)
 244         (music2 #f)
 245         (on-the-fly-markup #f))
 246     (if clef (*clef* clef)) ;; hack: set *clef* for silence scores
 247     (let parse-props ((props piece-spec))
 248       (if (not (or (null? props) (null? (cdr props))))
 249           (begin
 250             (case (car props)
 251               ((#:notes) (set! notes (cadr props)))
 252               ((#:clef) (set! clef (cadr props)))
 253               ((#:ragged) (set! ragged (cadr props)))
 254               ((#:indent) (set! indent (cadr props)))
 255               ((#:tag-global) (set! tag-global (cadr props)))
 256               ((#:tag-notes) (set! tag-notes (cadr props)))
 257               ((#:score)
 258                (set! score (cadr props))
 259                (set! from-templates #f))
 260               ((#:score-template)
 261                (set! score (cadr props))
 262                (set! from-templates #t))
 263               ((#:on-the-fly-markup) (set! on-the-fly-markup (cadr props)))
 264               ((#:instrument) (set! instrument (cadr props)))
 265               ((#:music) (set! music (cadr props)))
 266               ((#:music2) (set! music2 (cadr props))))
 267             (parse-props (cddr props)))))
 268     `((score . ,score)
 269       (from-templates . ,from-templates)
 270       (ragged . ,ragged)
 271       (indent . ,indent)
 272       (tag-global . ,tag-global)
 273       (tag-notes . ,tag-notes)
 274       (notes . ,notes)
 275       (clef . ,clef)
 276       (instrument . ,instrument)
 277       (figures . ,figures)
 278       (music . ,music)
 279       (music2 . ,music2)
 280       (on-the-fly-markup . ,on-the-fly-markup))))
 281
 282 piecePartSpecs =
 283 #(define-music-function (parser location piece-specs) (list?)
 284    "Define the part spec for a piece, by setting the *piece-description* special variable"
 285    (define (get-part-opus-spec part)
 286      (let ((spec (assoc part (*opus-part-specs*))))
 287        (and spec (cdr spec))))
 288    (define (get-fallbacks part)
 289      (let ((part-opus-spec (get-part-opus-spec part)))
 290        (or (and part-opus-spec (cadr part-opus-spec)) (list))))
 291    (define (get-defaults part)
 292      (let ((part-opus-spec (get-part-opus-spec part)))
 293        (or (and part-opus-spec (caddr part-opus-spec)) (list))))
 294    (define (get-default-clef part)
 295      (define* (get-clef-helper #:key (clef #f) #:allow-other-keys)
 296        clef)
 297      (let ((part-opus-spec (get-part-opus-spec part)))
 298        (and part-opus-spec (apply get-clef-helper (caddr part-opus-spec)))))
 299
 300    (define (get-part-piece parts piece-specs)
 301      (if (null? parts)
 302          ;; default silent piece
 303          (make-piece (list #:ragged #t
 304                            #:notes "silence"
 305                            #:score-template "score-silence")
 306                      #:clef #f)
 307          (let* ((part (caar parts))
 308                 (part-name (cadar parts))
 309                 (forced-clef (if (null? (cddar parts)) #f (caddar parts)))
 310                 (spec-result (assoc part piece-specs))
 311                 (spec (and spec-result (cdr spec-result))))
 312            (if spec
 313                (let* ((default-spec (append (get-defaults part)
 314                                             (if forced-clef
 315                                                 (list #:clef forced-clef)
 316                                                 (list))))
 317                        (piece (apply make-piece spec default-spec)))
 318                  (if (and part-name (not (assoc-ref piece 'instrument)))
 319                      (assoc-set! piece 'instrument part-name))
 320                  piece)
 321                (get-part-piece (cdr parts) piece-specs)))))
 322
 323    (let* ((part-opus-spec (get-part-opus-spec (*part*)))
 324           (parts (append (list (list (*part*) #f))
 325                          (get-fallbacks (*part*))
 326                          (list (list 'silence #f (get-default-clef (*part*)))))))
 327      (*piece-description* (get-part-piece parts piece-specs)))
 328    (make-music 'Music 'void #t))
 329
 330 opusPartSpecs =
 331 #(define-music-function (parser location opus-specs) (list?)
 332    (let* ((silence-specs '(silence "" ()
 333                                    (#:ragged #t #:notes "silence"
 334                                     #:score-template "score-silence")))
 335           (full-opus-specs (if (not (assoc 'silence opus-specs))
 336                                (cons silence-specs opus-specs)
 337                                opus-specs)))
 338      (*opus-part-specs* full-opus-specs))
 339    (let* ((name (ly:get-option 'part))
 340           (spec (assoc name (*opus-part-specs*))))
 341      (cond (spec
 342             (*part* name)
 343             (*part-name* (cadr spec)))
 344            (name
 345             (ly:warning "No `~a' part defined for this opus" name))))
 346    (make-music 'Music 'void #t))
 347
 348 %%%
 349 %%% Music functions
 350 %%%
 351
 352 global =
 353 #(define-music-function (parser this-location) ()
 354    (set! location #f)
 355   (let* ((global-symbol
 356           (string->symbol (format "global~a~a" (*opus*) (*piece*))))
 357          (global-music (ly:parser-lookup parser global-symbol)))
 358    (if (not (ly:music? global-music))
 359        (let* ((global-file (include-pathname "global")))
 360          (set! global-music
 361                #{ \notemode { \staffStart \include $global-file } #})
 362          (ly:parser-define! parser global-symbol global-music)))
 363    (ly:music-deep-copy global-music)))
 364
 365 includeNotes =
 366 #(define-music-function (parser this-location pathname) (string?)
 367    ;; use locations from the included file,
 368    ;; and not from where \includeNotes is called
 369    (set! location #f)
 370   (let ((include-file (include-pathname pathname)))
 371    #{ \notemode { \include $include-file } #}))
 372
 373 includeLyrics =
 374 #(define-music-function (parser this-location pathname) (string?)
 375    ;; use locations from the included file,
 376    ;; and not from where \includeNotes is called
 377    (set! location #f)
 378   (let ((include-file (include-pathname pathname)))
 379    #{ \lyricmode { \include $include-file } #}))
 380
 381 includeFigures =
 382 #(define-music-function (parser this-location pathname) (string?)
 383    ;; use locations from the included file,
 384    ;; and not from where \includeNotes is called
 385    (set! location #f)
 386   (let ((include-file (include-pathname pathname)))
 387      #{ \new FiguredBass \figuremode { \include $include-file } #}))
 388
 389 setComposer =
 390 #(define-music-function (parser location name) (string?)
 391    (*composer* name)
 392    (make-music 'Music 'void #t))
 393
 394 setCategory =
 395 #(define-music-function (parser location name) (string?)
 396    (let ((match (string-match "^(.*)/(.*)$" name)))
 397      (if match
 398          (begin ;; composer/category
 399            (*composer* (match:substring match 1))
 400            (*category* (match:substring match 2)))
 401          ;; category
 402          (*category* name)))
 403    (make-music 'Music 'void #t))
 404
 405 setOpus =
 406 #(define-music-function (parser location name) (string?)
 407    (let ((match (string-match "^(.*)/(.*)/(.*)$" name)))
 408      (if match
 409          (begin ;; composet/category/opus
 410            (*composer* (match:substring match 1))
 411            (*category* (match:substring match 2))
 412            (*opus* (match:substring match 3)))
 413          (let ((match (string-match "^(.*)/(.*)$" name)))
 414            (if match
 415                (begin ;; category/opus
 416                  (*category* (match:substring match 1))
 417                  (*opus* (match:substring match 2)))
 418                ;; opus
 419                (*opus* name)))))
 420    (make-music 'Music 'void #t))
 421
 422 #(define (include-score-helper parser name label allow-page-turn)
 423    ;;(format #t "Including score `~a'~%" name)
 424    (if (eqv? #t (ly:get-option 'non-score-print))
 425        (let ((label (string->symbol (or label name))))
 426          (add-music
 427           parser
 428           (make-music 'EventChord
 429                       'elements (list (make-music
 430                                        'LabelEvent
 431                                        'page-label label))
 432                       'page-marker #t
 433                       'page-label label))
 434          (add-toplevel-markup parser name))
 435        (parameterize ((*piece* name))
 436          ;;(format #t "Reading ~a~%" name)
 437          (if (*part*)
 438              (begin ;; a part score
 439                ;; Include the parts.ily file, describing
 440                ;; the parts defined for this piece.
 441                ;; It should contain a call to \piecePartSpec
 442                ;; which sets *piece-description*
 443                (ly:parser-parse-string (ly:parser-clone parser)
 444                                        (format #f "\\include \"~a\""
 445                                                (include-pathname "parts")))
 446                (let ((piece (*piece-description*)))
 447                  ;; special case: if on-the-fly-markup is set,
 448                  ;; just include the markup
 449                  (if (assoc-ref piece 'on-the-fly-markup)
 450                      (include-part-markup parser
 451                                           name
 452                                           (assoc-ref piece 'on-the-fly-markup)
 453                                           label)
 454                      (parameterize ((*score-ragged* (assoc-ref piece 'ragged))
 455                                     (*note-filename* (assoc-ref piece 'notes))
 456                                     (*instrument-name* (assoc-ref piece 'instrument))
 457                                     (*score-indent* (assoc-ref piece 'indent))
 458                                     (*tag-global* (assoc-ref piece 'tag-global))
 459                                     (*tag-notes* (assoc-ref piece 'tag-notes))
 460                                     (*figures* (assoc-ref piece 'figures))
 461                                     (*clef* (or (assoc-ref piece 'clef) (*clef*) "treble"))
 462                                     (*score-extra-music* (assoc-ref piece 'music))
 463                                     (*score-extra-music2* (assoc-ref piece 'music2)))
 464                        (include-part-score parser
 465                                            name
 466                                            (assoc-ref piece 'score)
 467                                            (assoc-ref piece 'from-templates)
 468                                            label))))
 469                (if allow-page-turn
 470                    (add-allow-page-turn parser)))
 471              ;; conductor score
 472              (include-score parser name label))))
 473    (make-music 'Music 'void #t))
 474
 475 includeScore =
 476 #(define-music-function (parser location name) (string?)
 477    (include-score-helper parser name #f #t))
 478
 479 includeScoreCond =
 480 #(define-music-function (parser location condition name)
 481      (boolean? string?)
 482    (if condition
 483        (include-score-helper parser name #f #t)
 484        (make-music 'Music 'void #t)))
 485
 486 includeScoreNoPageTurn =
 487 #(define-music-function (parser location name) (string?)
 488    (include-score-helper parser name #f #f))
 489
 490 reIncludeScore =
 491 #(define-music-function (parser location name label) (string? string?)
 492    (include-score-helper parser name label #t))
 493
 494 reIncludeScoreCond =
 495 #(define-music-function (parser location condition name label)
 496      (boolean? string? string?)
 497    (if condition
 498        (include-score-helper parser name label #t)
 499        (make-music 'Music 'void #t)))
 500
 501 %%%
 502 %%%
 503 %%%
 504 #(define (toplevel-score-handler parser score)
 505     (cond ((ly:parser-lookup parser '$current-bookpart)
 506            ((ly:parser-lookup parser 'bookpart-score-handler)
 507             (ly:parser-lookup parser '$current-bookpart) score))
 508           ((ly:parser-lookup parser '$current-book)
 509            ((ly:parser-lookup parser 'book-score-handler)
 510             (ly:parser-lookup parser '$current-book) score))
 511           (else
 512            (collect-scores-for-book parser score))))