scm/page-layout.scm

   1 ;;;; page-layout.scm -- page layout functions
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
   6
   7
   8 (define-public (page-properties paper)
   9   (list (append `((linewidth . ,(ly:paper-get-number
  10                                  paper 'linewidth)))
  11                 (ly:paper-lookup paper 'text-font-defaults))))
  12
  13 (define-public (plain-header paper page-number)
  14   (let ((props (page-properties paper) ))
  15     (interpret-markup paper props
  16                       (markup #:fill-line
  17                               ("" #:bold (number->string page-number))))))
  18
  19 (define-public (plain-footer paper page-number)
  20   (let ((props (page-properties paper)))
  21
  22     (interpret-markup paper props
  23                       (markup #:fill-line ("" (number->string page-number))))))
  24
  25
  26 (define TAGLINE
  27   (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
  28
  29 (define-public (TAGLINE-or-tagline-from-header paper scopes)
  30   (let* ((props (page-properties paper))
  31          (tagline-var (ly:modules-lookup scopes 'tagline))
  32          (tagline (if (markup? tagline-var) tagline-var TAGLINE)))
  33
  34     (cond ((string? tagline)
  35            (if (not (equal? tagline ""))
  36                (interpret-markup paper props
  37                                  (markup #:fill-line (tagline "")))))
  38           ((markup? tagline) (interpret-markup paper props tagline)))))
  39
  40 (define-public (copyright-from-header paper scopes)
  41   (let ((props (page-properties paper))
  42         (copyright (ly:modules-lookup scopes 'copyright)))
  43
  44     (cond ((string? copyright)
  45            (if (not (equal? copyright ""))
  46                (interpret-markup paper props
  47                                  (markup #:fill-line (copyright "")))))
  48           ((markup? copyright) (interpret-markup paper props copyright)))))
  49
  50
  51 ;;; optimal page breaking
  52
  53 ;;; This is not optimal page breaking, this is optimal distribution of
  54 ;;; lines over pages; line breaks are a given.
  55
  56 ;;; TODO:
  57 ;;;    - user tweaking:
  58 ;;;       + \pagebreak, \nopagebreak
  59 ;;;       + #pages?
  60 ;;;    - short circut SCORE=-1 (dismiss path)
  61 ;;;    - density scoring
  62
  63
  64 (use-modules (oop goops describe))
  65
  66 (define-class <break-node> ()
  67   (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
  68   (line #:init-value 'barf #:accessor node-line #:init-keyword #:line)
  69   (page #:init-value 0 #:accessor node-page #:init-keyword #:page)
  70   (score #:init-value 0 #:accessor node-score #:init-keyword #:score)
  71   (height #:init-value 0 #:accessor node-height #:init-keyword #:height))
  72
  73 (define INFINITY 1e9)
  74
  75 (define (robust-paper-line-number line)
  76   (if (null? line) 0
  77       (ly:paper-line-number line)))
  78
  79 (define (robust-line-height line)
  80   (if (null? line) 0
  81       (ly:paper-line-height line)))
  82
  83 (define (robust-line-number node)
  84   (if (null? node) 0
  85       (robust-paper-line-number (node-line node))))
  86
  87 (define (robust-break-score node)
  88   (let ((line (node-line node)))
  89     (if (null? line) 0
  90         (ly:paper-line-break-score line))))
  91
  92 (define (make-node prev line page score . height)
  93   (make <break-node> #:prev prev #:line line #:page page #:score score
  94         #:height (if (null? height) 0 (car height))))
  95
  96 ;; max density %
  97 (define MAX-CRAMP 0.05)
  98
  99 (define-public (ly:optimal-page-breaks lines book-height text-height
 100                                        first-diff last-diff)
 101   "DOCME"
 102   ;; FIXME: may need some tweaking: square, cubic
 103   (define (height-score available used)
 104     (let* ((empty (- available used))
 105            (norm-empty (* empty (/ 100 available))))
 106       (if (< norm-empty 0)
 107           (if (> (* -1 (/ empty available)) MAX-CRAMP)
 108               ;; cannot fill more than MAX-CRAMP
 109               -1
 110               ;; overfull page is still worse by a power
 111               ;; -- which means it never happens
 112               ;; let's try a factor 2
 113               ;;(* -1 norm-empty norm-empty norm-empty))
 114               (* 2 norm-empty norm-empty))
 115           (* norm-empty norm-empty))))
 116
 117   (define (page-height page-number page-count)
 118     (let ((h text-height))
 119       (if (= page-number 1)
 120           (set! h (+ h first-diff)))
 121       (if (= page-number page-count)
 122           ;;(> page-number (/ book-height text-height))
 123        (set! h (+ h last-diff)))
 124       h))
 125
 126   (define (cumulative-height lines)
 127     (apply + (map robust-line-height lines)))
 128
 129   (define (get-path node)
 130     (if (null? node) '() (cons node (get-path (node-prev node)))))
 131
 132   (define (add-scores . lst)
 133     (if (null? (filter (lambda (x) (> 0 x)) lst)) (apply + lst) -1))
 134
 135   (define (density-variance nodes)
 136     (define (sqr x) (* x x))
 137     (define (density node)
 138       (let ((p (page-height (node-page node) (node-page (car nodes))))
 139             (h (node-height node)))
 140         (if (and p h) (/ h p) 0)))
 141
 142     (let* ((height-nodes (reverse
 143                           ;; reverse makes for handier debugging
 144                           (filter (lambda (x) (> (node-height x) 0)) nodes)))
 145            (densities (map density height-nodes))
 146            (p-heights (map (lambda (x) (page-height (node-page x)
 147                                                     (node-page (car nodes))))
 148                            height-nodes))
 149            (heights (map node-height height-nodes))
 150            (mean (/ (apply + densities) (length densities)))
 151            (diff (map (lambda (x) (- x mean)) densities))
 152            (var (map sqr (map (lambda (x) (* (car p-heights) x)) diff))))
 153       (apply + var)))
 154
 155   (define (walk-paths best node lines nodes paths)
 156     (let* ((height (cumulative-height lines))
 157            (next-page (+ (if (null? paths) 0 (node-page (car paths))) 1))
 158            (page (page-height (node-page node) next-page))
 159            (hh (make-node '() (node-line node) 0 0 height))
 160            (break-score (robust-break-score node))
 161            (density-score (if (null? paths) 0
 162                               ;; TODO: find out why we need density
 163                               ;;       use other height-score parameters?
 164                               ;; See: input/test/page-breaks.ly
 165                               (* 1 (density-variance
 166                                     (cons hh (get-path (car paths)))))))
 167            (page-score (height-score page height))
 168            (this-score (add-scores page-score break-score density-score))
 169            (path-score (if (null? paths) 0 (node-score (car paths))))
 170            (score (add-scores path-score this-score)))
 171
 172       (if (and (>= score 0)
 173                (or (<= score (node-score best))
 174                    (= (node-score best) -1)))
 175           (begin
 176             (set! (node-score best) score)
 177             (set! (node-page best) next-page)
 178             (set! (node-height best) height)
 179             (set! (node-prev best) (car paths))))
 180
 181       (if (or (null? nodes)
 182               ;; short circuit
 183               (and (= path-score -1)
 184                    (> (- (/ height page) 1) MAX-CRAMP)))
 185           best
 186           (walk-paths best (car nodes)
 187                       (cons (node-line (car paths)) lines)
 188                       (cdr nodes) (cdr paths)))))
 189
 190   (define (walk-lines lines nodes paths)
 191     (if (null? (cdr lines))
 192         paths
 193         (let* ((prev (node-prev (car nodes)))
 194                (this (make-node prev (car lines) 0 INFINITY))
 195                (next (make-node this (cadr lines) 0 0))
 196                (best (walk-paths this prev (list (node-line (car nodes)))
 197                                  (cddr nodes) paths)))
 198           (walk-lines (cdr lines) (cons next nodes) (cons best paths)))))
 199
 200   (let* ((dummy (make-node '() '() 0 0))
 201          (this (make-node dummy (car lines) 0 0))
 202          (result (walk-lines lines (list this dummy) (list dummy)))
 203          (path (get-path (car result)))
 204          ;; CDR: junk dummy node
 205          (breaks (cdr (reverse (map robust-line-number path)))))
 206
 207     (if (ly:get-option 'verbose)
 208         (begin
 209           (format (current-error-port) "Estimated page count: ~S\n"
 210                   (/ book-height text-height))
 211         (format (current-error-port) "breaks: ~S\n" breaks)
 212         (force-output (current-error-port))))
 213         ;; TODO: if solution is bad return no breaks and revert to
 214         ;;       ragged bottom
 215     (list->vector breaks)))