]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/titling.scm
fix source/format
[lilypond.git] / scm / titling.scm
index 05b823215bf25af38d6a167436ce40fc665ace8d..d0dde63bdfb8a8c244f1e60b20e6f17f37d94d4c 100644 (file)
-;;;; titling.scm -- titling functions
+;;;; This file is part of LilyPond, the GNU music typesetter.
 ;;;;
-;;;;  source file of the GNU LilyPond music typesetter
+;;;; Copyright (C) 2004--2011 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;          Han-Wen Nienhuys <hanwen@xs4all.nl>
 ;;;;
-;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
 
-(define-public (page-properties paper)
-  (list (append `((linewidth . ,(ly:paper-get-number
-                                paper 'linewidth)))
-               (ly:output-def-lookup paper 'text-font-defaults))))
+(define-public (layout-extract-page-properties layout)
+  (list (append `((line-width . ,(ly:paper-get-number
+                                layout 'line-width)))
+               (ly:output-def-lookup layout 'text-font-defaults))))
 
 ;;;;;;;;;;;;;;;;;;
-                                       ; titling.
-(define-public (default-book-title paper scopes)
-  "Generate book title from header strings."
 
+(define-public ((marked-up-headfoot what-odd what-even)
+                layout scopes page-number is-last-bookpart is-bookpart-last-page)
+  "Read variables @var{what-odd}, @var{what-even} from @var{layout},
+and interpret them as markup.  The @var{props} argument will include
+variables set in @var{scopes} and @code{page:is-bookpart-last-page},
+@code{page:is-last-bookpart}, @code{page:page-number-string}, and
+@code{page:page-number}." 
 
   (define (get sym)
-    (let ((x (ly:modules-lookup scopes sym)))
-      (if (markup? x) x "")))
-  (define (has sym)
-    (markup?  (ly:modules-lookup scopes sym)))
-
-  (let ((props (page-properties paper)))
+    (ly:output-def-lookup layout sym))
 
-    (interpret-markup
-     paper props
-     (make-override-markup
-      '(baseline-skip . 4)
-      (make-column-markup
-       (append
-       (if (has 'dedication)
-           (list (markup #:fill-line
-                         (#:normalsize (get 'dedication))))
-           '())
-       (if (has 'title)
-           (list
-            (markup (#:fill-line
-                     (#:huge #:bigger #:bigger #:bigger #:bigger #:bold
-                             (get 'title)))))
-           '())
-       (if (or (has 'subtitle) (has 'subsubtitle))
-           (list
-            (make-override-markup
-             '(baseline-skip . 3)
-             (make-column-markup
-              (list
-               (markup #:fill-line
-                       (#:large #:bigger #:bigger #:bold (get 'subtitle)))
-               (markup #:fill-line (#:bigger #:bigger #:bold
-                                             (get 'subsubtitle)))
-               (markup #:override '(baseline-skip . 5)
-                       #:column ("")))
-
-              ))
-            )
-           '())
-       
-       (list
-        (make-override-markup
-         '(baseline-skip . 2.5)
-         (make-column-markup
-          (append
-           (if (or (has 'poet) (has 'composer))
-               (list (markup #:fill-line
-                             (#:bigger (get 'poet)
-                                       #:large #:bigger #:caps
-                                       (get 'composer))))
-               '())
-           (if (or (has 'texttranslator) (has 'opus))
-               (list
-                (markup
-                 #:fill-line
-                 (#:bigger (get 'texttranslator) #:bigger (get 'opus))))
-               '())
-           (if (or (has 'meter) (has 'arranger))
+  (define (interpret-in-page-env potential-markup)
+    (if (markup? potential-markup)
+       (let* ((alists (map ly:module->alist scopes))
+              (prefixed-alists
+               (map (lambda (alist)
+                      (map (lambda (entry)
+                             (cons
+                              (string->symbol
+                               (string-append
+                                "header:"
+                                (symbol->string (car entry))))
+                              (cdr entry)))
+                           alist))
+                    alists))
+              (pgnum-alist
                (list
-                (markup #:fill-line
-                        (#:bigger (get 'meter) #:bigger (get 'arranger))))
-               '())
-           (if (has 'instrument)
-               (list
-                ""
-                (markup #:fill-line (#:large #:bigger (get 'instrument))))
-               '())
-;;; piece is done in the score-title
-;;;         (if (has 'piece)
-;;;             (list ""
-;;;                   (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
-;;;             '())
-           ))))))))))
-
+                (cons 'header:tagline
+                      (ly:modules-lookup scopes 'tagline
+                                         (ly:output-def-lookup layout 'tagline)))
+                (cons 'page:is-last-bookpart is-last-bookpart)
+                (cons 'page:is-bookpart-last-page is-bookpart-last-page)
+                (cons 'page:page-number-string
+                      (number->string page-number))
+                (cons 'page:page-number page-number)))
+              (props (append
+                      (list pgnum-alist)
+                      prefixed-alists
+                      (layout-extract-page-properties layout))))
+         (interpret-markup layout props potential-markup))
 
-(define-public (default-user-title paper markup)
-  "Generate book title from header markup."
-  (if (markup? markup)
-      (let ((props (page-properties paper))
-           (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
-       (stack-lines DOWN 0 BASELINE-SKIP
-                    (list (interpret-markup paper props markup))))))
+       empty-stencil))
 
-(define-public (default-score-title paper scopes)
-  "Generate score title from header strings."
+  (interpret-in-page-env
+   (if (and (even? page-number)
+           (markup? (get what-even)))
+       (get what-even)
+       (get what-odd))))
 
+(define-public ((marked-up-title what) layout scopes)
+  "Read variables @var{what} from @var{scopes}, and interpret it as markup.
+The @var{props} argument will include variables set in @var{scopes} (prefixed
+with `header:'."
+  
   (define (get sym)
     (let ((x (ly:modules-lookup scopes sym)))
-      (if (markup? x) x "")))
+      (if (markup? x) x #f)))
 
-  (define (has sym)
-    (markup? (ly:modules-lookup scopes sym)))
+  (let* ((alists (map ly:module->alist scopes))
+        (prefixed-alist
+         (map (lambda (alist)
+                (map (lambda (entry)
+                       (cons
+                        (string->symbol
+                         (string-append
+                          "header:"
+                          (symbol->string (car entry))))
+                        (cdr entry)))
+                     alist))
+              alists))
+        (props (append prefixed-alist
+                       (layout-extract-page-properties layout)))
 
-  (let ((props (page-properties paper)))
-    (interpret-markup
-     paper props
-     (make-override-markup
-      '(baseline-skip . 4)
-      (make-column-markup
-       (append
-       (if (has 'opus)
-           (list (markup #:fill-line ("" (get 'opus))))
-           '())
-       (if (has 'piece)
-           (list
-            (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
-           '())))))))
+        (markup (ly:output-def-lookup layout what)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    (if (markup? markup)
+       (interpret-markup layout props markup)
+       (ly:make-stencil '() '(1 . -1) '(1 . -1)))))