]> git.donarmstrong.com Git - lilypond.git/blob - scm/page-layout.scm
* lily/translator.cc (derived_mark): new function.
[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       (line-stencils (map ly:paper-system-stencil lines))
147       (height-proc (ly:output-def-lookup paper 'page-music-height))
148
149       (page-stencil (ly:make-stencil '()
150                                      (cons leftmargin hsize)
151                                      (cons (- topmargin) 0)))
152       (was-title #t)
153       (add-system (lambda (stencil-position)
154                     (set! page-stencil
155                           (ly:stencil-add
156                            (ly:stencil-translate-axis
157                             (car stencil-position)
158                             (- 0
159                                (cadr stencil-position)
160                                topmargin)
161                                Y)
162                            page-stencil))))
163       )
164
165
166     (map add-system (zip line-stencils offsets))
167     (if (ly:stencil? foot)
168         (set! page-stencil
169               (ly:stencil-add
170                page-stencil
171                (ly:stencil-translate
172                 foot
173                 (cons 0
174                       (+ (- bottom-edge)
175                          (- (car (ly:stencil-extent foot Y)))))
176                 ))))
177
178     (ly:stencil-translate page-stencil (cons leftmargin 0))
179   ))
180   
181
182
183
184 ;;; optimal page breaking
185
186 ;;; This is not optimal page breaking, this is optimal distribution of
187 ;;; lines over pages; line breaks are a given.
188
189 ; TODO:
190 ;
191 ; - density scoring
192 ; - separate function for word-wrap style breaking?
193 ; - raggedbottom? raggedlastbottom? 
194
195 (define-public (ly:optimal-page-breaks
196                 lines paper-book)
197   "Return pages as a list starting with 1st page. Each page is a list
198 of lines. "
199
200
201   (define MAXPENALTY 1e9)
202   (define bookpaper (ly:paper-book-book-paper paper-book))
203   (define scopes (ly:paper-book-scopes paper-book))
204
205   (define (page-height page-number last?)
206     (let
207         ((p (ly:output-def-lookup bookpaper 'page-music-height)))
208
209       (if (procedure? p)
210           (p bookpaper scopes page-number last?)
211           10000)))
212   
213   (define (get-path node done)
214     "Follow NODE.PREV, and return as an ascending list of pages. DONE
215 is what have collected so far, and has ascending page numbers."
216     
217     (if (is-a? node <optimally-broken-page-node>)
218         (get-path (node-prev node) (cons node done))
219         done))
220
221   (define (combine-penalties force user best-paths)
222     (let*
223         ((prev-force  (if (null? best-paths)
224                           0.0
225                           (node-force  (car best-paths))))
226          (prev-penalty (if (null? best-paths)
227                            0.0
228                            (node-penalty (car best-paths))))
229          (inter-system-space (ly:output-def-lookup bookpaper 'betweensystemspace))
230          (force-equalization-factor 0.3)
231          (relative-force (/ force inter-system-space))
232          (abs-relative-force (abs relative-force))
233          )
234          
235          
236     (+ (* abs-relative-force (+ abs-relative-force 1))
237        prev-penalty
238        (* force-equalization-factor (/ (abs (- prev-force force)) inter-system-space))
239        user)))
240
241   (define (space-systems page-height lines ragged?)
242     (let*
243         ((inter-system-space
244           (ly:output-def-lookup bookpaper 'betweensystemspace))
245
246          (staff-extents
247           (list->vector
248            (append  (map
249                      ly:paper-system-staff-extents
250                      lines)
251                     (if (= (length lines) 1)
252                         '((0 .  0))
253                         '())) 
254            ))
255          (real-extents
256           (list->vector
257            (append
258             (map
259              (lambda (sys) (ly:paper-system-extent sys Y)) lines)
260                     (if (= (length lines) 1)
261                         '((0 .  0))
262                         '()) 
263                     )))
264          (no-systems (vector-length real-extents))
265          (topskip (cdr (vector-ref real-extents 0)))
266          (space-left (- page-height
267                         (apply + (map interval-length (vector->list real-extents)))
268
269                         ))
270                      
271          (space (- page-height
272                    topskip
273                    (-  (car (vector-ref real-extents (1- no-systems))))
274                    ))
275
276          (calc-spring
277           (lambda (idx)
278             (let*
279                 ((this-system-ext (vector-ref staff-extents idx))
280                  (next-system-ext (vector-ref staff-extents (1+ idx)))
281                  (fixed (- (cdr next-system-ext)
282                            (car this-system-ext)))
283                  (ideal (+ inter-system-space fixed))
284                  (hooke (/ 1 (- ideal fixed)))
285                  )
286               (list ideal hooke))
287             ))
288
289          (springs (map calc-spring (iota (1- no-systems))))
290          (fixed-dist (ly:output-def-lookup bookpaper 'betweensystempadding))
291          (calc-rod
292           (lambda (idx)
293             (let*
294                 ((this-system-ext (vector-ref real-extents idx))
295                  (next-system-ext (vector-ref real-extents (1+ idx)))
296                  (distance (- (+ (cdr next-system-ext)
297                                  fixed-dist)
298                               (car this-system-ext)
299                               ))
300                  (entry (list idx (1+ idx) distance)))
301               entry)))
302          (rods (map calc-rod (iota (1- no-systems))))
303          (page-very-empty? (> space-left (/ page-height 3)))
304          (result (ly:solve-spring-rod-problem
305                   springs rods space
306                   (or page-very-empty? ragged?)))
307          (force (car (if page-very-empty?
308                          (ly:solve-spring-rod-problem
309                           springs rods space ragged?)
310                          result)))
311          (positions
312           (map (lambda (y)
313                        (+ y topskip)) 
314                (cdr  result)))
315          )
316
317      (if #f ;; debug.
318          (begin
319            (display (list "\n# systems: " no-systems
320                           "\nreal-ext" real-extents "\nstaff-ext" staff-extents
321                           "\ninterscore" inter-system-space
322                           "\nspace-letf" space-left
323                           "\npage empty" page-very-empty
324                           "\nspring,rod" springs rods
325                           "\ntopskip " topskip
326                           " space " space
327                           "\npage-height" page-height
328                           "\nragged" ragged?
329                           "\nforce" force
330                           "\nres" (cdr result)
331                           "\npositions" positions "\n"))))
332      
333      (cons force positions)))
334   
335   (define (walk-paths done-lines best-paths current-lines  last? current-best)
336     "Return the best optimal-page-break-node that contains
337 CURRENT-LINES.  DONE-LINES.reversed ++ CURRENT-LINES is a consecutive
338 ascending range of lines, and BEST-PATHS contains the optimal breaks
339 corresponding to DONE-LINES.
340
341 CURRENT-BEST is the best result sofar, or #f."
342     
343     (let* ((this-page-num (if (null? best-paths)
344                               (ly:output-def-lookup bookpaper 'firstpagenumber)
345                               (1+ (node-page-number (car best-paths)))))
346
347            
348            (ragged? (or (eq? #t (ly:output-def-lookup bookpaper 'raggedbottom))
349                        (and (eq? #t (ly:output-def-lookup bookpaper 'raggedlastbottom))
350                             last?)))
351            (page-height (page-height this-page-num last?))
352            (vertical-spacing (space-systems page-height current-lines ragged?))
353            (satisfied-constraints (car vertical-spacing))
354            (force (if satisfied-constraints satisfied-constraints 10000))
355            (positions (cdr vertical-spacing))
356            (user-penalty (ly:paper-system-break-penalty (car current-lines)))
357            (total-penalty (combine-penalties
358                            force user-penalty
359                            best-paths))
360
361            
362            (better? (or
363                      (not current-best)
364                      (< total-penalty (node-penalty current-best))))
365            (new-best (if better?
366                          (make <optimally-broken-page-node>
367                            #:prev  (if (null? best-paths)
368                                         #f
369                                         (car best-paths))
370                            #:lines current-lines
371                            #:pageno this-page-num
372                            #:force force
373                            #:configuration positions
374                            #:penalty total-penalty)
375                          current-best)))
376       
377       (if #f ;; debug
378           (display
379            (list
380             "\nuser pen " user-penalty
381             "\nsatisfied-constraints" satisfied-constraints
382             "\nlast? " last? "ragged?" ragged?
383             "\nbetter? " better? " total-penalty " total-penalty "\n"
384             "\nconfig " positions
385             "\nforce " force
386             "\nlines: " current-lines "\n")))
387
388       (if #f ; debug
389           (display (list "\nnew-best is " (node-lines new-best)
390                          "\ncontinuation of "
391                          (if (null? best-paths)
392                              "start"
393                              (node-lines (car best-paths))))))
394       
395       (if (and (pair? done-lines)
396                ;; if this page is too full, adding another line won't help
397                satisfied-constraints)
398           (walk-paths (cdr done-lines) (cdr best-paths)
399                       (cons (car done-lines) current-lines)
400                       last? new-best)
401           
402           new-best)))
403
404   (define (walk-lines done best-paths todo)
405     "Return the best page breaking as a single
406 <optimal-page-break-node> for optimally breaking TODO ++
407 DONE.reversed. BEST-PATHS is a list of break nodes corresponding to
408 DONE."
409     (if (null? todo)
410         (car best-paths)
411         (let* ((this-line (car todo))
412                (last? (null? (cdr todo)))
413                (next (walk-paths done best-paths (list this-line) last? #f)))
414
415 ;         (display "\n***************")
416           (walk-lines (cons this-line done)
417                       (cons next best-paths)
418                       (cdr todo)))))
419
420   (define (line-number node)
421     (ly:paper-system-number (car (node-lines node))))
422
423   (let* ((best-break-node (walk-lines '() '() lines))
424          (break-nodes (get-path best-break-node '())))
425
426     (if #f; (ly:get-option 'verbose)
427         (begin
428           (display (list
429                     "\nbreaks: " (map line-number break-nodes))
430                     "\nsystems " (map node-lines break-nodes)
431                     "\npenalties " (map node-penalty break-nodes)
432                     "\nconfigs " (map node-configuration break-nodes))))
433
434     
435     ; create stencils.
436     
437     (map (lambda (node)
438            ((ly:output-def-lookup bookpaper 'page-make-stencil)
439             (node-lines node)
440             (node-configuration node)
441             bookpaper
442             scopes
443             (node-page-number node)
444             (eq? node best-break-node)))
445          break-nodes)))
446
447