]> git.donarmstrong.com Git - lilypond.git/blob - scm/page-layout.scm
49568d251d0ddeb3ae5e6cd05e82bc8c20284eae
[lilypond.git] / scm / page-layout.scm
1 ;;; page-layout.scm -- page breaking and page layout
2 ;;;
3 ;;;;  source file of the GNU LilyPond music typesetter
4 ;;;;
5 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;;;          Han-Wen Nienhuys <hanwen@cs.uu.nl>
7
8 (use-modules (oop goops describe)
9              (oop goops))
10
11
12 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
13
14 (define-class <optimally-broken-page-node> ()
15   (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev)
16   (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno)
17   (force #:init-value 0 #:accessor node-force #:init-keyword #:force) 
18   (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty)
19   (configuration #:init-value '() #:accessor node-configuration #:init-keyword #:configuration)
20   (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
21
22 (define-method (display (node <optimally-broken-page-node>) port)
23   (map (lambda (x) (display x port))
24        (list
25         "Page " (node-page-number node)
26         " Lines: " (node-lines node)
27         " Penalty " (node-penalty node)
28         "\n")))
29
30 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31
32 (define TAGLINE
33   (string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
34
35 ;; TODO: take <optimally-broken-page-node> iso. page-number
36 ;; for all of these functions ?
37
38 (define-public (plain-header paper scopes page-number last?)
39   "Standard header for a part: page number --outside--  and instrument--centered."
40
41   (let* ((props (page-properties paper))
42          (pnum
43           (if (ly:output-def-lookup paper 'printpagenumber)
44               (markup #:bold (number->string page-number))
45               ""))
46          (instr (ly:modules-lookup scopes 'instrument))
47          
48          (line (list "" (if (markup? instr) instr "") pnum)))
49     
50     (if (even? page-number)
51         (set! line (reverse line)))
52     
53     (if (< (ly:output-def-lookup paper 'firstpagenumber) page-number)
54         (interpret-markup
55          paper props (make-fill-line-markup line))
56         '())))
57
58 ;; TODO: add publisher ID on non-first page.
59 (define-public (plain-footer paper scopes page-number last?)
60   "Standard footer. Empty, save for first (copyright) and last (tagline) page."
61   
62   (let*
63       ((props (page-properties paper))
64        (copyright (ly:modules-lookup scopes 'copyright))
65        (tagline-var (ly:modules-lookup scopes 'tagline))
66        (tagline (if (markup? tagline-var) tagline-var TAGLINE))
67        (stencil #f))
68
69     (if last?
70         (set! stencil
71               (ly:stencil-combine-at-edge
72                stencil Y DOWN (interpret-markup paper props tagline)
73                0.0
74                )))
75
76     (if (and (= 1 page-number)
77              (markup? copyright))
78
79         (set! stencil
80               (ly:stencil-combine-at-edge
81                stencil Y DOWN (interpret-markup paper props copyright)
82                0.0
83                )))
84
85     stencil))
86   
87 (define (page-headfoot paper scopes number sym sepsym dir last?)
88   "Create a stencil including separating space."
89   (let*
90       ((header-proc (ly:output-def-lookup paper sym))
91        (sep (ly:output-def-lookup paper sepsym))
92        (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
93        (head-stencil
94         (if (procedure? header-proc)
95             (header-proc paper scopes number last?)
96             #f)))
97
98     (if (and (number? sep) (ly:stencil? head-stencil))
99         (set! head-stencil
100               (ly:stencil-combine-at-edge
101                stencil Y  dir head-stencil
102                sep 0.0)))
103
104     head-stencil))
105
106 (define-public (default-page-music-height paper scopes number last?)
107   "Printable area for music and titles; matches default-page-make-stencil." 
108   (let*
109       ((h (- (ly:output-def-lookup paper 'vsize)
110              (ly:output-def-lookup paper 'topmargin)
111              (ly:output-def-lookup paper 'bottommargin)))
112        (head (page-headfoot paper scopes number 'make-header 'headsep UP last?))
113        (foot (page-headfoot paper scopes number 'make-footer 'footsep DOWN last?)))
114     (- h (if (ly:stencil? head)
115              (interval-length (ly:stencil-extent head Y))
116              0)
117        (if (ly:stencil? foot)
118            (interval-length (ly:stencil-extent foot Y))
119            0))
120     ))
121
122
123 (define-public (default-page-make-stencil
124                  lines offsets paper scopes number last? )
125   "Construct a stencil representing the page from LINES.  "
126   (let*
127      ((topmargin  (ly:output-def-lookup paper 'topmargin))
128       
129       ;; TODO: naming vsize/hsize not analogous to TeX.
130       
131       (vsize (ly:output-def-lookup paper 'vsize))
132       (hsize (ly:output-def-lookup paper 'hsize))
133       
134       (lmargin (ly:output-def-lookup paper 'leftmargin))
135       (leftmargin (if lmargin
136                       lmargin
137                       (/ (- hsize
138                             (ly:output-def-lookup paper 'linewidth)) 2)))
139  
140       (rightmargin (ly:output-def-lookup paper 'rightmargin))
141       (bottom-edge (- vsize
142                       (ly:output-def-lookup paper 'bottommargin)))
143                      
144       (head (page-headfoot paper scopes number 'make-header 'headsep UP last?))
145       (foot (page-headfoot paper scopes number 'make-footer 'footsep DOWN last?))
146
147       (head-height (if (ly:stencil? head)
148                        (interval-length (ly:stencil-extent head Y))
149                        0.0))
150
151       (line-stencils (map ly:paper-system-stencil lines))
152       (height-proc (ly:output-def-lookup paper 'page-music-height))
153
154       (page-stencil (ly:make-stencil '()
155                                      (cons leftmargin hsize)
156                                      (cons (- topmargin) 0)))
157       (was-title #t)
158       (add-system (lambda (stencil-position)
159                     (set! page-stencil
160                           (ly:stencil-add
161                            (ly:stencil-translate-axis
162                             (car stencil-position)
163                             (- 0
164                                head-height
165                                (cadr stencil-position)
166                                topmargin)
167                                Y)
168                            page-stencil))))
169       )
170
171
172     (set! page-stencil (ly:stencil-combine-at-edge
173           page-stencil Y DOWN head 0. 0.))
174
175     (map add-system (zip line-stencils offsets))
176     (if (ly:stencil? foot)
177         (set! page-stencil
178               (ly:stencil-add
179                page-stencil
180                (ly:stencil-translate
181                 foot
182                 (cons 0
183                       (+ (- bottom-edge)
184                          (- (car (ly:stencil-extent foot Y)))))
185                 ))))
186
187     (ly:stencil-translate page-stencil (cons leftmargin 0))
188   ))
189   
190
191
192
193 ;;; optimal page breaking
194
195 ;;; This is not optimal page breaking, this is optimal distribution of
196 ;;; lines over pages; line breaks are a given.
197
198 ; TODO:
199 ;
200 ; - density scoring
201 ; - separate function for word-wrap style breaking?
202 ; - raggedbottom? raggedlastbottom? 
203
204 (define-public (ly:optimal-page-breaks
205                 lines paper-book)
206   "Return pages as a list starting with 1st page. Each page is a list
207 of lines. "
208
209
210   (define MAXPENALTY 1e9)
211   (define bookpaper (ly:paper-book-book-paper paper-book))
212   (define scopes (ly:paper-book-scopes paper-book))
213
214   (define (page-height page-number last?)
215     (let
216         ((p (ly:output-def-lookup bookpaper 'page-music-height)))
217
218       (if (procedure? p)
219           (p bookpaper scopes page-number last?)
220           10000)))
221   
222   (define (get-path node done)
223     "Follow NODE.PREV, and return as an ascending list of pages. DONE
224 is what have collected so far, and has ascending page numbers."
225     
226     (if (is-a? node <optimally-broken-page-node>)
227         (get-path (node-prev node) (cons node done))
228         done))
229
230   (define (combine-penalties force user best-paths)
231     (let*
232         ((prev-force  (if (null? best-paths)
233                           0.0
234                           (node-force  (car best-paths))))
235          (prev-penalty (if (null? best-paths)
236                            0.0
237                            (node-penalty (car best-paths))))
238          (inter-system-space (ly:output-def-lookup bookpaper 'betweensystemspace))
239          (force-equalization-factor 0.3)
240          (relative-force (/ force inter-system-space))
241          (abs-relative-force (abs relative-force))
242          )
243          
244          
245     (+ (* abs-relative-force (+ abs-relative-force 1))
246        prev-penalty
247        (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
248        user)))
249
250   (define (space-systems page-height lines ragged?)
251     (let*
252         ((inter-system-space
253           (ly:output-def-lookup bookpaper 'betweensystemspace))
254          (system-vector (list->vector
255            (append lines
256                    (if (= (length lines) 1)
257                        '(#f)
258                         '()))
259            ))
260
261          (staff-extents
262           (list->vector
263            (append  (map
264                      ly:paper-system-staff-extents
265                      lines)
266                     (if (= (length lines) 1)
267                         '((0 .  0))
268                         '())) 
269            ))
270          (real-extents
271           (list->vector
272            (append
273             (map
274              (lambda (sys) (ly:paper-system-extent sys Y)) lines)
275                     (if (= (length lines) 1)
276                         '((0 .  0))
277                         '()) 
278                     )))
279          (no-systems (vector-length real-extents))
280          (topskip (cdr (vector-ref real-extents 0)))
281          (space-left (- page-height
282                         (apply + (map interval-length (vector->list real-extents)))
283
284                         ))
285                      
286          (space (- page-height
287                    topskip
288                    (-  (car (vector-ref real-extents (1- no-systems))))
289                    ))
290
291          (fixed-dist (ly:output-def-lookup bookpaper 'betweensystempadding))
292          (calc-spring
293           (lambda (idx)
294             (let*
295                 ((this-system-ext (vector-ref staff-extents idx))
296                  (next-system-ext (vector-ref staff-extents (1+ idx)))
297                  (fixed (max 0  (- (+ (cdr next-system-ext)
298                                       fixed-dist)
299                                    (car this-system-ext))))
300                  (title1? (and (vector-ref system-vector idx)
301                                (ly:paper-system-title? (vector-ref system-vector idx))))
302                  (title2? (and
303                             (vector-ref system-vector (1+ idx))
304                             (ly:paper-system-title? (vector-ref system-vector (1+ idx)))))
305                  (ideal (+
306                          (cond
307                           ((and title2? title1?)
308                            (ly:output-def-lookup bookpaper 'betweentitlespace))
309                           (title1?
310                            (ly:output-def-lookup bookpaper 'aftertitlespace))
311                           (title2?
312                            (ly:output-def-lookup bookpaper 'beforetitlespace))
313                           (else inter-system-space))
314                          fixed))
315                  (hooke (/ 1 (- ideal fixed)))
316                  )
317               (list ideal hooke))
318             ))
319
320          (springs (map calc-spring (iota (1- no-systems))))
321          (calc-rod
322           (lambda (idx)
323             (let*
324                 ((this-system-ext (vector-ref real-extents idx))
325                  (next-system-ext (vector-ref real-extents (1+ idx)))
326                  (distance (max  (- (+ (cdr next-system-ext)
327                                  fixed-dist)
328                                     (car this-system-ext)
329                                     ) 0)) 
330                  (entry (list idx (1+ idx) distance)))
331               entry)))
332          (rods (map calc-rod (iota (1- no-systems))))
333
334          ;; we don't set ragged based on amount space left.
335          ;; raggedbottomlast = ##T is much more predictable
336          (result (ly:solve-spring-rod-problem
337                   springs rods space
338                   ragged?))
339
340          (force (car result))
341          (positions
342           (map (lambda (y)
343                        (+ y topskip)) 
344                (cdr  result)))
345          )
346
347      (if #f ;; debug.
348          (begin
349            (display (list "\n# systems: " no-systems
350                           "\nreal-ext" real-extents "\nstaff-ext" staff-extents
351                           "\ninterscore" inter-system-space
352                           "\nspace-letf" space-left
353                           "\npage empty" page-very-empty?
354                           "\nspring,rod" springs rods
355                           "\ntopskip " topskip
356                           " space " space
357                           "\npage-height" page-height
358                           "\nragged" ragged?
359                           "\nforce" force
360                           "\nres" (cdr result)
361                           "\npositions" positions "\n"))))
362      
363      (cons force positions)))
364   
365   (define (walk-paths done-lines best-paths current-lines  last? current-best)
366     "Return the best optimal-page-break-node that contains
367 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
368 ascending range of lines, and BEST-PATHS contains the optimal breaks
369 corresponding to DONE-LINES.
370
371 CURRENT-BEST is the best result sofar, or #f."
372     
373     (let* ((this-page-num (if (null? best-paths)
374                               (ly:output-def-lookup bookpaper 'firstpagenumber)
375                               (1+ (node-page-number (car best-paths)))))
376
377            
378            (ragged? (or (eq? #t (ly:output-def-lookup bookpaper 'raggedbottom))
379                        (and (eq? #t (ly:output-def-lookup bookpaper 'raggedlastbottom))
380                             last?)))
381            (page-height (page-height this-page-num last?))
382            (vertical-spacing (space-systems page-height current-lines ragged?))
383            (satisfied-constraints (car vertical-spacing))
384            (force (if satisfied-constraints satisfied-constraints 10000))
385            (positions (cdr vertical-spacing))
386            (user-penalty (ly:paper-system-break-penalty (car current-lines)))
387            (total-penalty (combine-penalties
388                            force user-penalty
389                            best-paths))
390
391            
392            (better? (or
393                      (not current-best)
394                      (< total-penalty (node-penalty current-best))))
395            (new-best (if better?
396                          (make <optimally-broken-page-node>
397                            #:prev  (if (null? best-paths)
398                                         #f
399                                         (car best-paths))
400                            #:lines current-lines
401                            #:pageno this-page-num
402                            #:force force
403                            #:configuration positions
404                            #:penalty total-penalty)
405                          current-best)))
406       
407       (if #f ;; debug
408           (display
409            (list
410             "\nuser pen " user-penalty
411             "\nsatisfied-constraints" satisfied-constraints
412             "\nlast? " last? "ragged?" ragged?
413             "\nbetter? " better? " total-penalty " total-penalty "\n"
414             "\nconfig " positions
415             "\nforce " force
416             "\nlines: " current-lines "\n")))
417
418       (if #f ; debug
419           (display (list "\nnew-best is " (node-lines new-best)
420                          "\ncontinuation of "
421                          (if (null? best-paths)
422                              "start"
423                              (node-lines (car best-paths))))))
424       
425       (if (and (pair? done-lines)
426                ;; if this page is too full, adding another line won't help
427                satisfied-constraints)
428           (walk-paths (cdr done-lines) (cdr best-paths)
429                       (cons (car done-lines) current-lines)
430                       last? new-best)
431           
432           new-best)))
433
434   (define (walk-lines done best-paths todo)
435     "Return the best page breaking as a single
436 <optimal-page-break-node> for optimally breaking TODO ++
437 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
438 DONE."
439     (if (null? todo)
440         (car best-paths)
441         (let* ((this-line (car todo))
442                (last? (null? (cdr todo)))
443                (next (walk-paths done best-paths (list this-line) last? #f)))
444
445 ;         (display "\n***************")
446           (walk-lines (cons this-line done)
447                       (cons next best-paths)
448                       (cdr todo)))))
449
450   (define (line-number node)
451     (ly:paper-system-number (car (node-lines node))))
452
453   (let* ((best-break-node (walk-lines '() '() lines))
454          (break-nodes (get-path best-break-node '())))
455
456     (if #f; (ly:get-option 'verbose)
457         (begin
458           (display (list
459                     "\nbreaks: " (map line-number break-nodes))
460                     "\nsystems " (map node-lines break-nodes)
461                     "\npenalties " (map node-penalty break-nodes)
462                     "\nconfigs " (map node-configuration break-nodes))))
463
464     
465     ; create stencils.
466     
467     (map (lambda (node)
468            ((ly:output-def-lookup bookpaper 'page-make-stencil)
469             (node-lines node)
470             (node-configuration node)
471             bookpaper
472             scopes
473             (node-page-number node)
474             (eq? node best-break-node)))
475          break-nodes)))
476
477