scm/page-breaking.scm

   1 (use-modules (oop goops describe)
   2              (oop goops)
   3              )
   4
   5 ;;; optimal page breaking
   6
   7 ;;; This is not optimal page breaking, this is optimal distribution of
   8 ;;; lines over pages; line breaks are a given.
   9
  10 ;;; TODO:
  11 ;;;    - user tweaking:
  12 ;;;       + \pagebreak, \nopagebreak
  13 ;;;       + #pages?
  14 ;;;    - short circut SCORE=-1 (dismiss path)
  15 ;;;    - density scoring
  16
  17
  18
  19
  20
  21 (define-class <optimally-broken-page-node> ()
  22   (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
  23   (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno)
  24   (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
  25   (height #:init-value 0 #:accessor node-height #:init-keyword #:height)
  26   (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines)
  27
  28   )
  29
  30 (define-method (display (node <optimally-broken-page-node>) port)
  31     (map
  32      (lambda (x)
  33        (display x port))
  34
  35      (list
  36       "Page " (node-page-number node)
  37       " Lines: " (node-lines node)
  38       " Penalty " (node-penalty node)
  39       "\n"
  40     )))
  41
  42
  43
  44
  45
  46
  47 ;;
  48 ;; TODO: first-diff and last-diff are arbitrary.
  49 ;; for the future.
  50 ;;
  51 (define-public (ly:optimal-page-breaks lines
  52                                        paper-book
  53                                        text-height
  54                                        first-diff last-diff)
  55   "Return pages as a list starting with 1st page. Each page is a list of lines. "
  56
  57   (define (make-node prev lines page-num penalty)
  58     (make <optimally-broken-page-node>
  59       #:prev prev
  60       #:lines lines
  61       #:pageno page-num
  62       #:penalty penalty))
  63
  64   (define INFINITY 1e9)
  65
  66
  67   (define (line-height line)
  68     (ly:paper-line-extent line Y))
  69
  70   ;; FIXME: may need some tweaking: square, cubic
  71   (define (height-penalty available used)
  72     ;; FIXME, simplistic
  73     (let*
  74         ((left (- available used))
  75
  76          ;; scale independent
  77          (relative-empty (/ left available)))
  78
  79       ;; Convexity: two half-empty pages is better than 1 completely
  80       ;; empty page
  81       (* (1+ relative-empty) relative-empty)))
  82
  83
  84   ;; TODO: rewrite
  85   ;; this should take the
  86   (define (page-height page-number last?)
  87     (let ((h text-height))
  88       (if (= page-number 1)
  89           (set! h (+ h first-diff)))
  90       (if last?
  91        (set! h (+ h last-diff)))
  92       h))
  93
  94   (define (cumulative-height lines)
  95     (apply + (map line-height lines)))
  96
  97   (define (get-path node done)
  98     "Follow NODE.PREV, and return as an ascending list of pages. DONE is what have
  99 collected so far, and has  ascending page numbers."
 100
 101     (if (is-a? node <optimally-broken-page-node>)
 102         (get-path (node-prev node) (cons node done))
 103         done))
 104
 105
 106   (define (add-penalties . lst)
 107     (if (find negative? lst)
 108         -1
 109         (apply + lst)))
 110
 111   (define (walk-paths done-lines best-paths current-lines  last? current-best)
 112     "Return the best optimal-page-break-node that contains
 113 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
 114 ascending range of lines, and BEST-PATHS contains the optimal breaks
 115 corresponding to DONE-LINES.
 116
 117 CURRENT-BEST is the best result sofar, or #f."
 118
 119     (let*
 120
 121         ((this-page-num (if (null? best-paths)
 122                             1
 123                             (1+ (node-page-number (car best-paths)))))
 124          (prev-penalty (if (null? best-paths)
 125                            0.0
 126                            (node-penalty (car best-paths))))
 127
 128          (page-height (page-height this-page-num last?))
 129          (space-used (cumulative-height current-lines))
 130
 131          (this-page-penalty (height-penalty  page-height space-used))
 132          (user-penalty (ly:paper-line-break-penalty (car current-lines)))
 133          (total-penalty (add-penalties
 134                          user-penalty
 135                          this-page-penalty
 136                          prev-penalty))
 137          (better? (or
 138                    (not current-best)
 139                    (< total-penalty (node-penalty current-best))))
 140          (new-best (if better?
 141                        (make-node (if (null? best-paths)
 142                                       #f
 143                                       (car best-paths))
 144                                   current-lines
 145                                   this-page-num total-penalty)
 146                        current-best))
 147
 148          (debug-info (list
 149                       "user pen " user-penalty " prev-penalty " prev-penalty "\n"
 150                       "better? " better? " total-penalty " total-penalty "\n"
 151                       "height " page-height " spc used: " space-used "\n"
 152                       "pen " this-page-penalty " lines: " current-lines  "\n"))
 153
 154          (foo (display debug-info))
 155          )
 156
 157       (if (and (pair? done-lines)
 158
 159                ;; if this page is too full, adding another line won't help
 160                (positive? this-page-penalty))
 161           (walk-paths (cdr done-lines) (cdr best-paths) (cons (car done-lines) current-lines)
 162                       last? new-best)
 163           new-best)))
 164
 165   (define (walk-lines done best-paths todo)
 166     "Return the best page breaking as a single
 167 <optimal-page-break-node> for optimally breaking TODO ++
 168 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
 169 DONE."
 170
 171     (if (null? todo)
 172         (car best-paths)
 173         (let*
 174             ((this-line (car todo))
 175              (last? (null? (cdr todo)))
 176              (next (walk-paths
 177                     done best-paths
 178                     (list this-line)
 179                     last? #f
 180
 181                     )))
 182
 183           (walk-lines (cons this-line done)
 184                       (cons next best-paths)
 185                       (cdr todo))
 186           )))
 187
 188   (define (line-number node)
 189     (ly:paper-line-number (car (node-lines node))))
 190   ; main body.
 191
 192   (let*
 193       ((best-break-node
 194         (walk-lines '() '() lines))
 195        (break-nodes (get-path best-break-node '()))
 196        (break-lines (map node-lines break-nodes))
 197        (break-numbers (map line-number break-nodes))
 198        )
 199
 200     (display break-lines)
 201
 202     (if (ly:get-option 'verbose)
 203         (begin
 204           (format (current-error-port) "breaks: ~S\n" break-numbers)
 205           (force-output (current-error-port))))
 206
 207     ;; TODO: if solution is bad return no breaks and revert to
 208     ;;       ragged bottom
 209
 210
 211     break-lines))
 212