X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftitling.scm;h=d34b7113d46aa89eee62234d4c45f1db76832f4f;hb=5d3ad90b7bea98b61c01e00258360e234853aa9b;hp=4a0eb678342c832fe7e89c8daf544b492b95422a;hpb=754d360118e26e2e48ec080849d9c0f94d1c7416;p=lilypond.git diff --git a/scm/titling.scm b/scm/titling.scm index 4a0eb67834..d34b7113d4 100644 --- a/scm/titling.scm +++ b/scm/titling.scm @@ -2,131 +2,92 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2004 Jan Nieuwenhuizen -;;;; Han-Wen Nienhuys +;;;; (c) 2004--2008 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys -(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) - (define (get sym) - (let ((x (ly:modules-lookup scopes sym))) - (if (markup? x) x ""))) - (define (has sym) - (markup? (ly:modules-lookup scopes sym))) + "Read variables WHAT-ODD, WHAT-EVEN from LAYOUT, and interpret them +as markup. The PROPS argument will include variables set in SCOPES and +page:is-bookpart-last-page, page:is-last-bookpart, page:page-number-string +and page:page-number" - (let ((props (page-properties paper))) - - (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 (""))) + (define (get sym) + (ly:output-def-lookup layout sym)) - )) - ) - '()) - - (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)) + (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 '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) ""))) -;;; '()) - )))))))))) + (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)) + empty-stencil)) -(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." + (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 WHAT from SCOPES, and interpret it as markup. The +PROPS argument will include variables set in 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) + (ly:make-stencil '() '(1 . -1) '(1 . -1)))))