;;;;
;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
-(define (ly:modules-lookup modules sym)
- (let ((v (module-variable (car modules) sym)))
- (if (and v (variable-bound? v) (variable-ref v))
- (variable-ref v)
- (if (module? (cdr modules)) (ly:modules-lookup (cdr modules) sym)))))
-(define (page-properties paper)
+(define-public (page-properties paper)
(list (append `((linewidth . ,(ly:paper-get-number
paper 'linewidth)))
- (ly:paper-lookup paper 'text-font-defaults))))
+ (ly:output-def-lookup paper 'text-font-defaults))))
-(define-public (book-title paper scopes)
- "Generate book title from header strings."
-
- (define (get sym)
- (let ((x (ly:modules-lookup scopes sym)))
- (if (and x (not (unspecified? x))) x "")))
-
- (let ((props (page-properties paper)))
-
- (interpret-markup
- paper props
- (markup
- #:column
- (#:override '(baseline-skip . 4)
- #:column
- (#:fill-line
- (#:normalsize (get 'dedication))
- #:fill-line
- (#:huge #:bigger #:bigger #:bigger #:bigger #:bold (get 'title))
- #:override '(baseline-skip . 3)
- #:column
- (#:fill-line
- (#:large #:bigger #:bigger #:bold (get 'subtitle))
- #:fill-line (#:bigger #:bigger #:bold (get 'subsubtitle)))
- #:override '(baseline-skip . 5)
- #:column ("")
- #:override '(baseline-skip . 2.5)
- #:column
- (#:fill-line
- (#:bigger (get 'poet) #:large #:bigger #:caps (get 'composer))
- #:fill-line (#:bigger (get 'texttranslator) #:bigger (get 'opus))
- #:fill-line
- (#:bigger (get 'meter) #:bigger (get 'arranger))
- ""
- #:fill-line (#:large #:bigger (get 'instrument))
- " "
- #:fill-line (#:large #:bigger #:caps (get 'piece) ""))))))))
-
-(define-public (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 (score-title paper scopes)
- "Generate score title from header strings."
-
- (define (get sym)
- (let ((x (ly:modules-lookup scopes sym)))
- (if (and x (not (unspecified? x))) x "")))
-
- (let ((props (page-properties paper)))
-
- (interpret-markup
- paper props
- (markup
- #:column
- (#:override '(baseline-skip . 4)
- #:column
- (#:fill-line
- ("" (get 'opus))
- #:fill-line (#:large #:bigger #:caps (get 'piece) "")))))))
-
-(define-public (make-header paper page-number)
+(define-public (plain-header paper page-number)
(let ((props (page-properties paper) ))
(interpret-markup paper props
(markup #:fill-line
("" #:bold (number->string page-number))))))
-(define-public (make-footer paper page-number)
+(define-public (plain-footer paper page-number)
(let ((props (page-properties paper)))
(interpret-markup paper props
- (markup #:fill-line ("" (number->string page-number))))))
+ (markup #:fill-line ("" (number->string page-number))))))
(define TAGLINE
(string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
-(define-public (make-tagline paper scopes)
+(define-public (TAGLINE-or-tagline-from-header paper scopes)
(let* ((props (page-properties paper))
(tagline-var (ly:modules-lookup scopes 'tagline))
(tagline (if (markup? tagline-var) tagline-var TAGLINE)))
(markup #:fill-line (tagline "")))))
((markup? tagline) (interpret-markup paper props tagline)))))
-(define-public (make-copyright paper scopes)
+(define-public (copyright-from-header paper scopes)
(let ((props (page-properties paper))
(copyright (ly:modules-lookup scopes 'copyright)))
(define-public (ly:optimal-page-breaks lines book-height text-height
first-diff last-diff)
-
+ "DOCME"
;; FIXME: may need some tweaking: square, cubic
(define (height-score available used)
(let* ((empty (- available used))
(mean (/ (apply + densities) (length densities)))
(diff (map (lambda (x) (- x mean)) densities))
(var (map sqr (map (lambda (x) (* (car p-heights) x)) diff))))
- (if #f
- (begin
- (format (current-error-port) "\nDENSITIES")
- (format (current-error-port) "lines: ~S\n"
- (map robust-line-number height-nodes))
- (format (current-error-port) "page-heighs: ~S\n" p-heights)
- (format (current-error-port) "heights: ~S\n" heights)
- (format (current-error-port) "densities: ~S\n" densities)
- (format (current-error-port) "mean: ~S\n" mean)
- (format (current-error-port) "diff: ~S\n" diff)
- (format (current-error-port) "density-var: ~S\n" var)))
(apply + var)))
(define (walk-paths best node lines nodes paths)
(hh (make-node '() (node-line node) 0 0 height))
(break-score (robust-break-score node))
(density-score (if (null? paths) 0
- (* 0 (density-variance
+ ;; TODO: find out why we need density
+ ;; use other height-score parameters?
+ ;; See: input/test/page-breaks.ly
+ (* 1 (density-variance
(cons hh (get-path (car paths)))))))
(page-score (height-score page height))
(this-score (add-scores page-score break-score density-score))
(path-score (if (null? paths) 0 (node-score (car paths))))
(score (add-scores path-score this-score)))
- (if #f
- (begin
- (format (current-error-port) "page-score: ~S\n" page-score)
- (format (current-error-port) "density-score: ~S\n" density-score)
- (format (current-error-port) "this-score: ~S\n" this-score)))
-
(if (and (>= score 0)
- (or (< score (node-score best))
+ (or (<= score (node-score best))
(= (node-score best) -1)))
(begin
(set! (node-score best) score)
(set! (node-page best) next-page)
(set! (node-height best) height)
- (set! (node-prev best) node)))
-
- (if (null? nodes)
+ (set! (node-prev best) (car paths))))
+
+ (if (or (null? nodes)
+ ;; short circuit
+ (and (= path-score -1)
+ (> (- (/ height page) 1) MAX-CRAMP)))
best
- (walk-paths best (car paths) (cons (node-line node) lines)
+ (walk-paths best (car nodes)
+ (cons (node-line (car paths)) lines)
(cdr nodes) (cdr paths)))))
(define (walk-lines lines nodes paths)
(let* ((prev (node-prev (car nodes)))
(this (make-node prev (car lines) 0 INFINITY))
(next (make-node this (cadr lines) 0 0))
- (best (walk-paths this (car paths)
- (list (node-line (car nodes)))
- (cddr nodes) (cdr paths))))
+ (best (walk-paths this prev (list (node-line (car nodes)))
+ (cddr nodes) paths)))
(walk-lines (cdr lines) (cons next nodes) (cons best paths)))))
(let* ((dummy (make-node '() '() 0 0))
;; CDR: junk dummy node
(breaks (cdr (reverse (map robust-line-number path)))))
- (format (current-error-port) "ESTIMATE: ~S\n"
- (/ book-height text-height))
- (format (current-error-port) "breaks: ~S\n" breaks)
- (force-output (current-error-port))
-
- (if #f (format (current-error-port) "scores: ~S\n" (map node-score path)))
-
+ (if (ly:get-option 'verbose)
+ (begin
+ (format (current-error-port) "Estimated page count: ~S\n"
+ (/ book-height text-height))
+ (format (current-error-port) "breaks: ~S\n" breaks)
+ (force-output (current-error-port))))
+ ;; TODO: if solution is bad return no breaks and revert to
+ ;; ragged bottom
(list->vector breaks)))
+
+
+
+;;;;;;;;;;;;;;;;;;
+; titling.
+(define-public (default-book-title paper scopes)
+ "Generate book title from header strings."
+
+ (define (get sym)
+ (let ((x (ly:modules-lookup scopes sym)))
+ (if (and x (not (unspecified? x))) x "")))
+
+ (let ((props (page-properties paper)))
+
+ (interpret-markup
+ paper props
+ (markup
+ #:column
+ (#:override '(baseline-skip . 4)
+ #:column
+ (#:fill-line
+ (#:normalsize (get 'dedication))
+ #:fill-line
+ (#:huge #:bigger #:bigger #:bigger #:bigger #:bold (get 'title))
+ #:override '(baseline-skip . 3)
+ #:column
+ (#:fill-line
+ (#:large #:bigger #:bigger #:bold (get 'subtitle))
+ #:fill-line (#:bigger #:bigger #:bold (get 'subsubtitle)))
+ #:override '(baseline-skip . 5)
+ #:column ("")
+ #:override '(baseline-skip . 2.5)
+ #:column
+ (#:fill-line
+ (#:bigger (get 'poet) #:large #:bigger #:caps (get 'composer))
+ #:fill-line (#:bigger (get 'texttranslator) #:bigger (get 'opus))
+ #:fill-line
+ (#:bigger (get 'meter) #:bigger (get 'arranger))
+ ""
+ #:fill-line (#:large #:bigger (get 'instrument))
+ " "
+ #:fill-line (#:large #:bigger #:caps (get 'piece) ""))))))))
+
+(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 (get sym)
+ (let ((x (ly:modules-lookup scopes sym)))
+ (if (and x (not (unspecified? x))) x "")))
+
+ (let ((props (page-properties paper)))
+
+ (interpret-markup
+ paper props
+ (markup
+ #:column
+ (#:override '(baseline-skip . 4)
+ #:column
+ (#:fill-line
+ ("" (get 'opus))
+ #:fill-line (#:large #:bigger #:caps (get 'piece) "")))))))
projects / lilypond.git / blobdiff