Jump to content

Ready-to-use LilyPond macros: advanced layout and titles, using a special stylesheet

From LilyPond wiki

Taking LilyPond to a whole new level

[edit | edit source]

This snippet is actually a set of advanced macros that provide some useful predefined commands. You can just copy the whole code, paste it in a separate file, named, for instance, 'book-titling.ily'; then just include it in your score and use the provided macros (see the end of the snippet description if you want an example of an actual score source file).

Using LilyPond to produce a whole book

[edit | edit source]

This snippet allows you to create:

  • a nice title page
  • a table of contents
  • some fancy page headers (with book and chapter titles)

The following commands are provided (in addition to LilyPond standard syntax)::

  • \bookTitle string

    defines the book title, as it should appear in even page header

  • \chapter string

    adds a page break and a big title, and a title in the TOC set the odd page header

  • \section string

    adds a section title, and a title in the TOC

  • \piece markup

    adds a piece title in the TOC

  • \titledPiece markup

    adds a piece title in book body and in the TOC

  • \useRehearsalNumbers boolean

    if set to 'true', adds rehearsal number before pieces

In this snippet, you will find the ready-to-use “stylesheet” (you may save it as a separate file named "book-titling.ily", and then include it in your scores), and at the bottom of the source code, a short example demonstrating some of these abilities.

\version "2.24.0"

%% http://lsr.di.unimi.it/LSR/Item?id=368
%% see also http://nicolas.sceaux.free.fr/

%%% book-titling.ily  -- a titling stylesheet for use in books
%%% 
%%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Utility markups

#(define-markup-command (when-property layout props symbol markp) (symbol? markup?)
  (if (chain-assoc-get symbol props)
      (interpret-markup layout props markp)
      (ly:make-stencil '()  '(1 . -1) '(1 . -1))))

#(define-markup-command (line-width-ratio layout props width-ratio arg) (number? markup?)
  (interpret-markup layout props
   (markup #:override (cons 'line-width (* width-ratio (chain-assoc-get 'line-width props)))
           arg)))

%% For guile-2 rework below, pitty the here defined 'smallCaps' is actually not
%% used in this snippet
%%  -Harm

%%% Guile does not deal with accented letters
#(use-modules (ice-9 regex))
%%;; actually defined below, in a closure
#(define-public string-upper-case #f)
#(define accented-char-upper-case? #f)
#(define accented-char-lower-case? #f)

%%;; an accented character is seen as two characters by guile
#(let ((lower-case-accented-string "éèêëáàâäíìîïóòôöúùûüçœæ")
       (upper-case-accented-string "ÉÈÊËÁÀÂÄÍÌÎÏÓÒÔÖÚÙÛÜÇŒÆ"))
   (define (group-by-2 chars result)
      (if (or (null? chars) (null? (cdr chars)))
          (reverse! result)
          (group-by-2 (cddr chars)
                      (cons (string (car chars) (cadr chars))
                            result))))
   (let ((lower-case-accented-chars
          (group-by-2 (string->list lower-case-accented-string) (list)))
         (upper-case-accented-chars
          (group-by-2 (string->list upper-case-accented-string) (list))))
     (set! string-upper-case
           (lambda (str)
             (define (replace-chars str froms tos)
               (if (null? froms)
                   str
                   (replace-chars (regexp-substitute/global #f (car froms) str
                                                            'pre (car tos) 'post)
                                  (cdr froms)
                                  (cdr tos))))
             (string-upcase (replace-chars str
                                           lower-case-accented-chars
                                           upper-case-accented-chars))))
     (set! accented-char-upper-case?
           (lambda (char1 char2)
             (member (string char1 char2) upper-case-accented-chars string=?)))
     (set! accented-char-lower-case?
           (lambda (char1 char2)
             (member (string char1 char2) lower-case-accented-chars string=?)))))

#(define-markup-command (smallCaps layout props text) (markup?)
  "Turn @code{text}, which should be a string, to small caps.
@example
\\markup \\small-caps \"Text between double quotes\"
@end example"
  (define (string-list->markup strings lower)
    (let ((final-string (string-upper-case
                         (apply string-append (reverse strings)))))
      (if lower
          (markup #:fontsize -2 final-string)
          final-string)))
  (define (make-small-caps rest-chars currents current-is-lower prev-result)
    (if (null? rest-chars)
        (make-concat-markup (reverse! (cons (string-list->markup
                                              currents current-is-lower)
                                            prev-result)))
        (let* ((ch1 (car rest-chars))
               (ch2 (and (not (null? (cdr rest-chars))) (cadr rest-chars)))
               (this-char-string (string ch1))
               (is-lower (char-lower-case? ch1))
               (next-rest-chars (cdr rest-chars)))
          (cond ((and ch2 (accented-char-lower-case? ch1 ch2))
                 (set! this-char-string (string ch1 ch2))
                 (set! is-lower #t)
                 (set! next-rest-chars (cddr rest-chars)))
                ((and ch2 (accented-char-upper-case? ch1 ch2))
                 (set! this-char-string (string ch1 ch2))
                 (set! is-lower #f)
                 (set! next-rest-chars (cddr rest-chars))))
          (if (or (and current-is-lower is-lower)
                  (and (not current-is-lower) (not is-lower)))
              (make-small-caps next-rest-chars
                               (cons this-char-string currents)
                               is-lower
                               prev-result)
              (make-small-caps next-rest-chars
                               (list this-char-string)
                               is-lower
                               (if (null? currents)
                                   prev-result
                                   (cons (string-list->markup
                                            currents current-is-lower)
                                         prev-result)))))))
  (interpret-markup layout props
    (if (string? text)
        (make-small-caps (string->list text) (list) #f (list))
        text)))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Title page
%%%
\paper {
  bookTitleMarkup = \markup \when-property #'header:title \column {
    \combine \null \vspace #6
    \fill-line { \fontsize #8 \italic \fromproperty #'header:composer }
    \combine \null \vspace #1
    \fill-line { \fontsize #8 \italic \fromproperty #'header:poet }
    \combine \null \vspace #6
    \fill-line { \fontsize #10 \fromproperty #'header:title }
    \combine \null \vspace #6
    \fill-line { \postscript "-20 0 moveto 40 0 rlineto stroke" }
    \combine \null \vspace #6
    \fill-line { \fontsize #5 \fromproperty #'header:date }
    \combine \null \vspace #1 
    \fill-line {
      \when-property #'header:arrangement \column {
        \combine \null \vspace #5
        \fill-line { \fontsize #3 \fromproperty #'header:arrangement }
      }
    }
  }
  scoreTitleMarkup = \markup \null
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Table of contents
%%%
#(define-markup-command (paper-prop layout props name default)
  (symbol? markup?)
  "Get the value of a \\paper property, or defaults to some value"
  (let ((val (ly:output-def-lookup layout name)))
    (interpret-markup layout props (if (markup? val)
                                      val
                                      default))))
\paper {
  tocTitleMarkup = \markup \column {
    \combine \null \vspace #2
    \fontsize #6 \fill-line { \paper-prop #'tocTitle "TABLE OF CONTENTS" }
    \combine \null \vspace #2
  }
  tocPieceMarkup = \markup \fill-line {
    \line-width-ratio #0.7 \fill-line {
      \line { \fromproperty #'toc:text }
      \fromproperty #'toc:page
    }
  }
  tocSectionMarkup = \markup \italic \column {
    \fill-line { \fromproperty #'toc:text }
  }
  tocChapterMarkup = \markup \large \italic \column {
    \combine \null \vspace #1
    \fontsize #2 \fill-line { \fromproperty #'toc:text }
    \combine \null \vspace #1
  }
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Markup commands for page headers
%%%
#(define-public add-odd-page-header-text #f)
#(define-public add-even-page-header-text #f)
#(define header-markup-aux #f)
#(let ((odd-label-header-table (list))
       (odd-page-header-table (list))
       (even-label-header-table (list))
       (even-page-header-table (list)))
  (set! header-markup-aux
   (lambda (layout props odd)
     (define (page-text page-number table)
       (if (null? table)
           ""
           (let* ((elment (car table))
                  (p (car elment))
                  (text (cadr elment))
                  (display-1st (caddr elment)))
             (cond ((and (= page-number p) (not display-1st)) #f)
                   ((>= page-number p) text)
                   (else (page-text page-number (cdr table)))))))
     (ly:make-stencil
       `(delay-stencil-evaluation
          ,(delay (ly:stencil-expr
                    (begin
                     (if (or (and odd (null? odd-page-header-table))
                             (and (not odd) (null? even-page-header-table)))
                         (let ((page-header-table (list)))
                          (for-each (lambda (label-header)
                                      (let* ((label (car label-header))
                                             (text-disp (cdr label-header))
                                             (table (ly:output-def-lookup layout 'label-page-table))
                                             (label-page (and (list? table) (assoc label table)))
                                             (page-number (and label-page (cdr label-page)))
                                             (prev-value (and page-number (assoc page-number page-header-table))))
                                        (if (not prev-value)
                                            (set! page-header-table (cons (cons page-number text-disp)
                                                                          page-header-table))
                                            (set! page-header-table
                                                  (assoc-set! page-header-table
                                                              page-number
                                                              (list (car text-disp) (caddr prev-value)))))))
                                    (reverse (if odd odd-label-header-table even-label-header-table)))
                          (if odd
                              (set! odd-page-header-table page-header-table)
                              (set! even-page-header-table page-header-table))))
                     (interpret-markup layout props
                       (let* ((page-number (chain-assoc-get 'page:page-number props -1))
                              (text (page-text page-number (if odd odd-page-header-table even-page-header-table)))
                              (text-markup (markup #:italic (or text "")))
                              (page-number-markup (number->string page-number)))
                         (cond ((or (= 1 page-number) (not text)) (markup #:null))
                               (odd (markup #:fill-line (#:null text-markup page-number-markup)))
                               (else (markup #:fill-line (page-number-markup text-markup #:null))))))))))
       (cons 0 0)
       (ly:stencil-extent (interpret-markup layout props "XXX") Y))))
  (set! add-odd-page-header-text
   (lambda (parser text display-1st)
     (let ((label (gensym "header")))
       (set! odd-label-header-table
             (cons (list label text display-1st)
                   odd-label-header-table))
       (collect-music-for-book
         (make-music 'Music
          'page-marker #t
          'page-label label)))))
  (set! add-even-page-header-text
   (lambda (parser text display-1st)
     (let ((label (gensym "header")))
       (set! even-label-header-table
             (cons (list label text display-1st)
                   even-label-header-table))
       (collect-music-for-book
         (make-music 'Music
          'page-marker #t
          'page-label label))))))

#(define-markup-command (odd-header layout props) ()
   (header-markup-aux layout props #t))

#(define-markup-command (even-header layout props) ()
   (header-markup-aux layout props #f))

\paper {
  evenHeaderMarkup = \markup \even-header
  oddHeaderMarkup = \markup \odd-header
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Utilities for adding (no-)page breaks, toplevel markups
%%%
#(define (add-page-break parser)
  (collect-music-for-book 
   (make-music 'Music
	       'page-marker #t
	       'line-break-permission 'force
	       'page-break-permission 'force)))

#(define (add-no-page-break parser)
  (collect-music-for-book 
   (make-music 'Music
	       'page-marker #t
	       'page-break-permission 'forbid)))

#(define (add-toplevel-markup parser text)
  (collect-scores-for-book (list text)))

#(define (add-toc-item parser markup-symbol text)
  (collect-music-for-book
   (add-toc-item! markup-symbol text)))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Rehearsal numbers
%%%
#(define-public rehearsal-number #f)
#(define-public increase-rehearsal-major-number #f)
#(let ((major-number 0)
       (minor-number 0))
  (set! increase-rehearsal-major-number
        (lambda ()
          (set! major-number (1+ major-number))
          (set! minor-number 0)))
  (set! rehearsal-number 
        (lambda ()
          (set! minor-number (1+ minor-number))
          (format #f "~a-~a" major-number minor-number))))

#(define-public (add-rehearsal-number parser)
   (collect-scores-for-book
    (list (markup #:huge #:bold (rehearsal-number)))))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Commands
%%%

#(use-modules (srfi srfi-39))
#(define *book-title* (make-parameter ""))
#(define *use-rehearsal-numbers* (make-parameter #f))

#(define-markup-command (chapter-title layout props title) (markup?)
  (interpret-markup layout props
   (markup #:column (#:vspace 3
                     #:pad-markup 3 #:fill-line (#:fontsize 5 title)))))

#(define-markup-command (section-title layout props title) (markup?)
  (interpret-markup layout props
   (markup #:column (#:vspace 1
                     #:fill-line (#:fontsize 3 title)
                     #:vspace 1))))

#(define-markup-command (piece-title layout props title) (markup?)
  (interpret-markup layout props
   (markup #:fill-line (#:override '(line-width . 80) title))))

#(define-markup-command (rehearsal-number layout props number) (markup?)
  (interpret-markup layout props
   (markup #:huge #:bold number)))

#(define-markup-command (piece-title-with-number layout props number title)
                        (markup? markup?)
  (interpret-markup layout props
    (markup #:rehearsal-number number
            #:hspace 1
            #:huge title)))

useRehearsalNumbers =
#(define-music-function (use-numbers) (boolean?)
  (*use-rehearsal-numbers* use-numbers)
   (make-music 'Music 'void #t))

bookTitle =
#(define-music-function (title) (string?)
   (*book-title* title)
   (make-music 'Music 'void #t))

chapter =
#(define-music-function (title) (string?)
  (increase-rehearsal-major-number)
  (add-page-break (*parser*))
  (add-toc-item (*parser*) 'tocChapterMarkup title)
  (add-even-page-header-text (*parser*) (string-upper-case (*book-title*)) #f)
  (add-odd-page-header-text (*parser*) (string-upper-case title) #f)
  (add-toplevel-markup (*parser*) (markup #:chapter-title (string-upper-case title)))
  (add-no-page-break (*parser*))
  (make-music 'Music 'void #t))

section =
#(define-music-function (title) (string?)
  (add-toc-item (*parser*) 'tocSectionMarkup title)
  (add-toplevel-markup (*parser*) (markup #:section-title (string-upper-case title)))
  (add-no-page-break (*parser*))
  (make-music 'Music 'void #t))
                        
piece =
#(define-music-function (title) (markup?)
  (add-toc-item (*parser*) 'tocPieceMarkup title)
  (add-no-page-break (*parser*))
  (if (*use-rehearsal-numbers*)
      (add-toplevel-markup (*parser*) (markup #:rehearsal-number (rehearsal-number))))
  (add-no-page-break (*parser*))
  (make-music 'Music 'void #t))
                        
titledPiece =
#(define-music-function (title) (markup?)
  (add-toc-item (*parser*) 'tocPieceMarkup title)
  (if (*use-rehearsal-numbers*)
      (add-toplevel-markup (*parser*)
        (markup #:piece-title-with-number (rehearsal-number) (string-upper-case title)))
      (add-toplevel-markup (*parser*) (markup #:piece-title (string-upper-case title))))
  (add-no-page-break (*parser*))
  (make-music 'Music 'void #t))

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%% Here's an example file that use the above functions.


  \header {
    title = "The Title"
    composer = "Composer"
    poet = "Lyricist"
    date = "1740-1742"
    arrangement = "..."
    copyright = "Copyright line"
  }
  \paper {
    %% Translate the TOC title
    tocTitle = "TABLE OF CONTENTS"
  }
%%  \include "book-titling.ily"
  
  \bookTitle "Title for header"
  %% set to #f to turn off piece numbering
  \useRehearsalNumbers ##t
  
  %% Table of contents
  \pageBreak
  \markuplist \table-of-contents
  
  %% 1st Chapter
  \chapter "Act I"
  \section "Scene 1"
  \titledPiece \markup Overtura
  \repeat unfold 12 { c'4 d' e' f' \break }
  \section "Scene 2"
  \piece \markup { Choir: \italic { bla bla bla } }
  \repeat unfold 12 { g'4 f' e' d'  \break }
  
  \chapter "Act II"
  \section "Scene 1"
  \titledPiece \markup Overtura
  { c'4 d' e' f' g'1 }