X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftitling.scm;h=4bb464ae68cc0bbbb18cde1762d1210ce36bcb59;hb=750b714488c5af6eae22d07163bba8b554734ac6;hp=4a0eb678342c832fe7e89c8daf544b492b95422a;hpb=754d360118e26e2e48ec080849d9c0f94d1c7416;p=lilypond.git diff --git a/scm/titling.scm b/scm/titling.scm index 4a0eb67834..4bb464ae68 100644 --- a/scm/titling.scm +++ b/scm/titling.scm @@ -1,132 +1,106 @@ -;;;; 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--2015 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys ;;;; -;;;; (c) 2004 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; 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 . -(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 ((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))) + (ly:output-def-lookup layout sym)) - (let ((props (page-properties paper))) + (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)) + (number-type (get 'page-number-type)) + (pgnum-alist + (list + (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-format number-type 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)) - (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 (""))) + empty-stencil)) - )) - ) - '()) - - (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)) - (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) ""))) -;;; '()) - )))))))))) + (interpret-in-page-env + (if (and (even? page-number) + (markup? (get what-even))) + (get what-even) + (get what-odd)))) +(export marked-up-headfoot) - -(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)))))) - -(define-public (default-score-title paper scopes) - "Generate score title from header strings." +(define ((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 ""))) - - (define (has sym) - (markup? (ly:modules-lookup scopes sym))) + (if (markup? x) x #f))) - (let ((props (page-properties paper))) - (interpret-markup - paper props - (make-override-markup - '(baseline-skip . 4) - (make-column-markup - (append - (if (has 'opus) - ;; opus, again? - '() + (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))) - ;; todo: figure out if and what should be here? - ;;(list (markup #:fill-line ("" (get 'opus)))) - '()) - (if (has 'piece) - (list - (markup #:fill-line (#:large #:bigger (get 'piece) ""))) - '()))))))) + (markup (ly:output-def-lookup layout what))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (if (markup? markup) + (interpret-markup layout props markup) + empty-stencil))) +(export marked-up-title)