From d5fce41ff513cba5e4775ebbdfe888dd13464b80 Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 11 Jun 2004 13:35:44 +0000 Subject: [PATCH] * Documentation/user/changing-defaults.itely (Creating contexts): index entries * scm/page-breaking.scm (ly:optimal-page-breaks): new file. Rewrite function. * lily/paper-book.cc (pages): new interface: page-breaking returns list of line-list. * lily/page.cc (Page): take lines argument. * scm/document-translation.scm (all-engravers-doc): link to user man * scm/page-layout.scm (ly:optimal-page-breaks): use penalty iso. score. * Documentation/user/notation.itely (Relative octaves): typo. * lily/paper-book.cc (LY_DEFINE): ly:output-formats. New function. --- ChangeLog | 23 ++- Documentation/user/changing-defaults.itely | 19 +- Documentation/user/lilypond.tely | 2 + Documentation/user/notation.itely | 18 +- lily/include/page.hh | 2 +- lily/include/paper-line.hh | 4 +- lily/page.cc | 13 +- lily/paper-book.cc | 100 +++++----- lily/paper-line.cc | 8 +- lily/system.cc | 7 +- ly/declarations-init.ly | 9 +- scm/document-translation.scm | 1 + scm/lily.scm | 1 + scm/page-breaking.scm | 212 +++++++++++++++++++++ scm/page-layout.scm | 175 +---------------- scm/safe-lily.scm | 2 +- 16 files changed, 360 insertions(+), 236 deletions(-) create mode 100644 scm/page-breaking.scm diff --git a/ChangeLog b/ChangeLog index c3560a55d7..91cc77b0f2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,11 +1,28 @@ -2004-06-11 Jan Nieuwenhuizen +2004-06-11 Han-Wen Nienhuys - * scm/output-gnome.scm: Update build script. + * Documentation/user/changing-defaults.itely (Creating contexts): + index entries -2004-06-11 Han-Wen Nienhuys + * scm/page-breaking.scm (ly:optimal-page-breaks): new + file. Rewrite function. + + * lily/paper-book.cc (pages): new interface: page-breaking returns + list of line-list. + + * lily/page.cc (Page): take lines argument. + + * scm/document-translation.scm (all-engravers-doc): link to user man + + * scm/page-layout.scm (ly:optimal-page-breaks): use penalty iso. score. + + * Documentation/user/notation.itely (Relative octaves): typo. * lily/paper-book.cc (LY_DEFINE): ly:output-formats. New function. +2004-06-11 Jan Nieuwenhuizen + + * scm/output-gnome.scm: Update build script. + 2004-06-10 Jan Nieuwenhuizen * scm/output-gnome.scm: Add font scaling. Attempt to resurrect diff --git a/Documentation/user/changing-defaults.itely b/Documentation/user/changing-defaults.itely index 8a7d0cc61d..e12f4408b6 100644 --- a/Documentation/user/changing-defaults.itely +++ b/Documentation/user/changing-defaults.itely @@ -301,7 +301,11 @@ created automatically. For more complex scores, it is necessary to create them by hand. There are three commands which do this. The easiest command is @code{\new}, and it also the quickest to type. -It is prepended to a music expression, for example +It is prepended to a music expression, for example + +@cindex @code{\new} +@cindex new contexts +@cindex Context, creating @example \new @var{type} @var{music expression} @@ -322,6 +326,8 @@ staves. Each part that should be on its own staff, is preceded with >> @end lilypond +@cindex @code{\context} + Like @code{\new}, the @code{\context} command also directs a music expression to a context object, but gives the context an extra name. The syntax is @@ -368,13 +374,14 @@ They are combined by sending both to the same @context{Voice} context, music = \notes { c4 c4 } arts = \notes { s4-. s4-> } \score { - \notes \relative c'' << \new Staff \context Voice = "A" \music + \notes \relative c'' << \new Staff \context Voice = "A" \music \context Voice = "A" \arts >> } @end lilypond - +@cindex @code{\context} +@cindex creating contexts The third command for creating contexts is @example @@ -407,6 +414,10 @@ these forms @node Changing context properties on the fly @subsection Changing context properties on the fly +@cindex properties +@cindex @code{\set} +@cindex changing properties + Each context can have different @emph{properties}, variables contained in that context. They can be changed during the interpretation step. This is achieved by inserting the @code{\set} command in the music, @@ -446,6 +457,8 @@ example @context{Staff}, then the change would also apply to all `on-the-fly', during the music, so that the setting only affects the second group of eighth notes. +@cindex @code{\unset} + There is also an @code{\unset} command, @quotation @code{\set }@var{context}@code{.}@var{prop} diff --git a/Documentation/user/lilypond.tely b/Documentation/user/lilypond.tely index c06925c2f0..2be8e61d8a 100644 --- a/Documentation/user/lilypond.tely +++ b/Documentation/user/lilypond.tely @@ -42,6 +42,8 @@ Distributions will want to install lilypond.info in postinstall, doing: HINTS FOR STYLE +* Do not forget to create @cindex entries for new sections of text. + * Try not to use punctuation between introductocing sentence and display material (verbatim, music, example code). diff --git a/Documentation/user/notation.itely b/Documentation/user/notation.itely index 9497ec27fc..e14580f87f 100644 --- a/Documentation/user/notation.itely +++ b/Documentation/user/notation.itely @@ -511,6 +511,10 @@ instead. @seealso +User manual: @ref{Changing context properties on the fly} for the +@code{\set} command. + + Program reference: @internalsref{TupletBracket}, and @internalsref{TimeScaledMusic}. Examples: @inputfileref{input/regression,tuplet-nest.ly}. @@ -603,7 +607,7 @@ to determine the first note of the next chord @cindex @code{\notes} The pitch after the @code{\relative} contains a note name. To parse -the note name as a pitch, it must surrounded by @code{\notes} +the note name as a pitch, it must be surrounded by @code{\notes} The relative conversion will not affect @code{\transpose}, @code{\chords} or @code{\relative} sections in its argument. If you @@ -629,13 +633,14 @@ following notes. -There is also a syntax that is separate from the notes. +There is also a syntax that is separate from the notes. The syntax + @example \octave @var{pitch} @end example -This checks that @var{pitch} (without octave) yields @var{pitch} (with -octave) in \relative mode. If not, a warning is printed, and the +This checks that @var{pitch} (without quotes) yields @var{pitch} (with +quotes) in \relative mode. If not, a warning is printed, and the octave is corrected, for example, the first check is passed successfully. The second check fails with an error message. The octave is adjusted so the following notes are in the correct octave @@ -1428,6 +1433,11 @@ behavior can be changed by setting @code{allowBeamBreak}. @cindex auto-knee-gap +@seealso + +User manual: @ref{Changing context properties on the fly} for the +@code{\set} command + @refbugs diff --git a/lily/include/page.hh b/lily/include/page.hh index cc351ac076..49ed408e31 100644 --- a/lily/include/page.hh +++ b/lily/include/page.hh @@ -40,7 +40,7 @@ public: Real top_margin_; Real bottom_margin_; - Page (Output_def*, int); + Page (SCM, Output_def*, int); /* available area for text. */ Real text_height () const; diff --git a/lily/include/paper-line.hh b/lily/include/paper-line.hh index 61e11807df..eec021ff08 100644 --- a/lily/include/paper-line.hh +++ b/lily/include/paper-line.hh @@ -18,12 +18,12 @@ class Paper_line DECLARE_SMOBS (Paper_line, ); Stencil stencil_; bool is_title_; - int penalty_; public: + int penalty_; int number_; - Paper_line (Stencil, int penalty, bool); + Paper_line (Stencil, bool); Offset dim () const; Stencil to_stencil () const; diff --git a/lily/page.cc b/lily/page.cc index b40d805654..01199b9068 100644 --- a/lily/page.cc +++ b/lily/page.cc @@ -18,13 +18,16 @@ Real Page::MIN_COVERAGE_ = 0.66; -Page::Page (Output_def *paper, int number) +Page::Page (SCM lines, Output_def *paper, int number) { copyright_ = SCM_EOL; footer_ = SCM_EOL; header_ = SCM_EOL; lines_ = SCM_EOL; tagline_ = SCM_EOL; + + smobify_self (); + paper_ = paper; number_ = number; @@ -44,7 +47,13 @@ Page::Page (Output_def *paper, int number) if (unsmob_stencil (footer_)) unsmob_stencil (footer_)->align_to (Y_AXIS, UP); - smobify_self (); + lines_ = lines; + for (SCM s = lines; ly_c_pair_p (s); s = ly_cdr (s)) + { + height_ += unsmob_paper_line (ly_car (s))->dim()[Y_AXIS]; + line_count_ ++; + } + } Page::~Page () diff --git a/lily/paper-book.cc b/lily/paper-book.cc index 82ec23cda7..9836726869 100644 --- a/lily/paper-book.cc +++ b/lily/paper-book.cc @@ -27,8 +27,8 @@ Paper_book::Paper_book () { - pages_ = SCM_EOL; - lines_ = SCM_EOL; + pages_ = SCM_BOOL_F; + lines_ = SCM_BOOL_F; copyright_ = SCM_EOL; tagline_ = SCM_EOL; header_ = SCM_EOL; @@ -124,8 +124,6 @@ LY_DEFINE (ly_output_formats, "ly:output-formats", return lst; } - - /* TODO: there is too much code dup, and the interface is not @@ -136,7 +134,8 @@ Paper_book::output (String outname) { if (!score_lines_.size ()) return; - + + /* Generate all stencils to trigger font loads. */ pages (); @@ -144,11 +143,9 @@ Paper_book::output (String outname) SCM formats = ly_output_formats(); for (SCM s = formats; ly_c_pair_p (s); s = ly_cdr (s)) { - String format = ly_scm2string (ly_car (s)); Paper_outputter *out = get_paper_outputter (outname + "." + format, format); - SCM scopes = SCM_EOL; if (ly_c_module_p (header_)) @@ -308,19 +305,20 @@ Paper_book::score_title (int i) return title; } - SCM Paper_book::lines () { - if (ly_c_pair_p (lines_)) + if (SCM_BOOL_F != lines_) return lines_; - Stencil title = book_title (); + lines_ = SCM_EOL; + Stencil title = book_title (); + if (!title.is_empty ()) { - Paper_line *pl = new Paper_line (title, -10001, true); + Paper_line *pl = new Paper_line (title, true); lines_ = scm_cons (pl->self_scm (), lines_); scm_gc_unprotect_object (pl->self_scm ()); @@ -332,7 +330,7 @@ Paper_book::lines () Stencil title = score_title (i); if (!title.is_empty ()) { - Paper_line *pl = new Paper_line (title, -10001, true); + Paper_line *pl = new Paper_line (title, true); lines_ = scm_cons (pl->self_scm (), lines_); scm_gc_unprotect_object (pl->self_scm ()); } @@ -340,15 +338,29 @@ Paper_book::lines () if (scm_vector_p (score_lines_[i].lines_) == SCM_BOOL_T) { SCM line_list = scm_vector_to_list (score_lines_[i].lines_); // guh. - lines_ = scm_append (scm_list_2 (scm_reverse (line_list), lines_)); + + line_list = scm_reverse (line_list); + lines_ = scm_append (scm_list_2 (line_list, lines_)); } } lines_ = scm_reverse (lines_); - + int i = 0; + Paper_line * last = 0; for (SCM s = lines_; s != SCM_EOL; s = ly_cdr (s)) - unsmob_paper_line (ly_car (s))->number_ = ++i; + { + Paper_line * p = unsmob_paper_line (ly_car (s)); + p->number_ = ++i; + + if (last && last->is_title ()) + { + p->penalty_ = 10000; // ugh, hardcoded. + } + last = p; + } + + return lines_; } @@ -372,12 +384,16 @@ make_copyright (Output_def *paper, SCM scopes) SCM Paper_book::pages () { - if (ly_c_pair_p (pages_)) + if (SCM_BOOL_F != pages_) return pages_; + pages_ = SCM_EOL; + Output_def *paper = bookpaper_; - Page *page = new Page (paper, 1); + + // dummy to extract dims + Page *page = new Page (SCM_EOL, paper, 1); // ugh Real text_height = page->text_height (); Real copy_height = 0; @@ -388,15 +404,7 @@ Paper_book::pages () if (Stencil *s = unsmob_stencil (tagline_)) tag_height = s->extent (Y_AXIS).length (); - SCM all = lines (); - SCM proc = paper->c_variable ("page-breaking"); - SCM breaks = scm_apply_0 (proc, scm_list_n (all, - self_scm (), - scm_make_real (text_height), - scm_make_real (-copy_height), - scm_make_real (-tag_height), - SCM_UNDEFINED)); - + scm_gc_unprotect_object (page->self_scm ()); /* UGH - move this out of C++. @@ -408,32 +416,32 @@ Paper_book::pages () tagline_ = make_tagline (bookpaper_, scopes); copyright_ = make_tagline (bookpaper_, scopes); - int page_count = SCM_VECTOR_LENGTH ((SCM) breaks); - int line = 1; - for (int i = 0; i < page_count; i++) + SCM all = lines (); + SCM proc = paper->c_variable ("page-breaking"); + SCM pages = scm_apply_0 (proc, scm_list_n (all, + self_scm (), + scm_make_real (text_height), + scm_make_real (-copy_height), + scm_make_real (-tag_height), + SCM_UNDEFINED)); + + + SCM *page_tail = &pages_; + int num = 0; + for (SCM s = pages; ly_c_pair_p (s); s = ly_cdr (s)) { - if (i) - page = new Page (paper, i + 1); + Page * page = new Page (ly_car (s), paper, ++num); + + *page_tail = scm_cons (page->self_scm () , SCM_EOL); + page_tail = SCM_CDRLOC(*page_tail); - int next = i + 1 < page_count - ? ly_scm2int (scm_vector_ref (breaks, scm_int2num (i))) : 0; - while ((!next && all != SCM_EOL) || line <= next) - { - SCM s = ly_car (all); - page->lines_ = ly_snoc (s, page->lines_); - page->height_ += unsmob_paper_line (s)->dim ()[Y_AXIS]; - page->line_count_++; - all = ly_cdr (all); - line++; - } - if (i == page_count-1) + scm_gc_unprotect_object (page->self_scm ()); + + if (!ly_c_pair_p (ly_cdr (s))) page->is_last_ = true; - - pages_ = scm_cons (page->self_scm (), pages_); } - pages_ = scm_reverse (pages_); return pages_; } diff --git a/lily/paper-line.cc b/lily/paper-line.cc index 21c51439c1..00d4bf444a 100644 --- a/lily/paper-line.cc +++ b/lily/paper-line.cc @@ -19,11 +19,11 @@ IMPLEMENT_DEFAULT_EQUAL_P (Paper_line); -Paper_line::Paper_line (Stencil s, int penalty, bool is_title) +Paper_line::Paper_line (Stencil s, bool is_title) { is_title_ = is_title; number_ = 0; - penalty_ = penalty; + penalty_ = 0; smobify_self (); stencil_ = s; } @@ -47,6 +47,8 @@ Paper_line::print_smob (SCM smob, SCM port, scm_print_state*) scm_puts (classname (p), port); scm_puts (" ", port); scm_puts (to_string (p->number_).to_str0 (), port); + scm_puts ("p ", port); + scm_puts (to_string (p->penalty_).to_str0 (), port); if (p->is_title ()) scm_puts (" t", port); scm_puts (" >", port); @@ -99,7 +101,7 @@ LY_DEFINE (ly_paper_line_number, "ly:paper-line-number", return scm_int2num (pl->number_); } -LY_DEFINE (ly_paper_line_break_score, "ly:paper-line-break-score", +LY_DEFINE (ly_paper_line_break_score, "ly:paper-line-break-penalty", 1, 0, 0, (SCM line), "Return the score for page break after @var{line}.") { diff --git a/lily/system.cc b/lily/system.cc index 9b8499810f..caab3a2bb5 100644 --- a/lily/system.cc +++ b/lily/system.cc @@ -386,13 +386,18 @@ System::get_line () } } + /* + TODO: fix user penalties. + + */ + Interval x (extent (this, X_AXIS)); Interval y (extent (this, Y_AXIS)); Stencil sys_stencil (Box (x,y), scm_cons (ly_symbol2scm ("combine-stencil"), exprs)); - Paper_line *pl = new Paper_line (sys_stencil, (int) penalty, false); + Paper_line *pl = new Paper_line (sys_stencil, false); return scm_gc_unprotect_object (pl->self_scm ()); } diff --git a/ly/declarations-init.ly b/ly/declarations-init.ly index 1e47fb9e65..92ec2ee052 100644 --- a/ly/declarations-init.ly +++ b/ly/declarations-init.ly @@ -32,14 +32,19 @@ working with lyric sections) %% rather name \newline, \newpage ? break = #(make-event-chord (list (make-penalty-music -10001 0))) noBreak = #(make-event-chord (list (make-penalty-music 10001 0))) -pagebreak = #(make-event-chord (list (make-penalty-music -10001 -10001))) -noPagebreak = #(make-event-chord (list (make-penalty-music 0 10001))) +pageBreak = #(make-event-chord (list (make-penalty-music -10001 -10001))) +pagebreak = \pageBreak % ugh. +noPageBreak = #(make-event-chord (list (make-penalty-music 0 10001))) +noPagebreak = \noPageBreak % ugh noBeam = #(make-music 'BeamForbidEvent) pipeSymbol = #(make-music 'BarCheck) +foo = \notes { \pageBreak } + \include "scale-definitions-init.ly" + melisma = #(make-span-event 'ManualMelismaEvent START) melismaEnd = #(make-span-event 'ManualMelismaEvent STOP) diff --git a/scm/document-translation.scm b/scm/document-translation.scm index b5ac64d324..222ee09851 100644 --- a/scm/document-translation.scm +++ b/scm/document-translation.scm @@ -287,6 +287,7 @@ (make #:name "Engravers" #:desc "All separate engravers" + #:text "See @usermanref{Modifying context plug-ins}." #:children (map engraver-doc all-engravers-list))) diff --git a/scm/lily.scm b/scm/lily.scm index 302bb819e0..b364d2f20c 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -461,6 +461,7 @@ L1 is copied, L2 not. "define-grobs.scm" "define-grob-interfaces.scm" "page-layout.scm" + "page-breaking.scm" "paper.scm" diff --git a/scm/page-breaking.scm b/scm/page-breaking.scm new file mode 100644 index 0000000000..c5b381d495 --- /dev/null +++ b/scm/page-breaking.scm @@ -0,0 +1,212 @@ +(use-modules (oop goops describe) + (oop goops) + ) + +;;; optimal page breaking + +;;; This is not optimal page breaking, this is optimal distribution of +;;; lines over pages; line breaks are a given. + +;;; TODO: +;;; - user tweaking: +;;; + \pagebreak, \nopagebreak +;;; + #pages? +;;; - short circut SCORE=-1 (dismiss path) +;;; - density scoring + + + + + +(define-class () + (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev) + (page #:init-value 0 #:accessor node-page-number #:init-keyword #:pageno) + (penalty #:init-value 0 #:accessor node-penalty #:init-keyword #:penalty) + (height #:init-value 0 #:accessor node-height #:init-keyword #:height) + (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines) + + ) + +(define-method (display (node ) port) + (map + (lambda (x) + (display x port)) + + (list + "Page " (node-page-number node) + " Lines: " (node-lines node) + " Penalty " (node-penalty node) + "\n" + ))) + + + + + + +;; +;; TODO: first-diff and last-diff are arbitrary. +;; for the future. +;; +(define-public (ly:optimal-page-breaks lines + paper-book + text-height + first-diff last-diff) + "Return pages as a list starting with 1st page. Each page is a list of lines. " + + (define (make-node prev lines page-num penalty) + (make + #:prev prev + #:lines lines + #:pageno page-num + #:penalty penalty)) + + (define INFINITY 1e9) + + + (define (line-height line) + (ly:paper-line-extent line Y)) + + ;; FIXME: may need some tweaking: square, cubic + (define (height-penalty available used) + ;; FIXME, simplistic + (let* + ((left (- available used)) + + ;; scale independent + (relative-empty (/ left available))) + + ;; Convexity: two half-empty pages is better than 1 completely + ;; empty page + (* (1+ relative-empty) relative-empty))) + + + ;; TODO: rewrite + ;; this should take the + (define (page-height page-number last?) + (let ((h text-height)) + (if (= page-number 1) + (set! h (+ h first-diff))) + (if last? + (set! h (+ h last-diff))) + h)) + + (define (cumulative-height lines) + (apply + (map line-height lines))) + + (define (get-path node done) + "Follow NODE.PREV, and return as an ascending list of pages. DONE is what have +collected so far, and has ascending page numbers." + + (if (is-a? node ) + (get-path (node-prev node) (cons node done)) + done)) + + + (define (add-penalties . lst) + (if (find negative? lst) + -1 + (apply + lst))) + + (define (walk-paths done-lines best-paths current-lines last? current-best) + "Return the best optimal-page-break-node that contains +CURRENT-LINES. DONE-LINES.reversed ++ CURRENT-LINES is a consecutive +ascending range of lines, and BEST-PATHS contains the optimal breaks +corresponding to DONE-LINES. + +CURRENT-BEST is the best result sofar, or #f." + + (let* + + ((this-page-num (if (null? best-paths) + 1 + (1+ (node-page-number (car best-paths))))) + (prev-penalty (if (null? best-paths) + 0.0 + (node-penalty (car best-paths)))) + + (page-height (page-height this-page-num last?)) + (space-used (cumulative-height current-lines)) + + (this-page-penalty (height-penalty page-height space-used)) + (user-penalty (ly:paper-line-break-penalty (car current-lines))) + (total-penalty (add-penalties + user-penalty + this-page-penalty + prev-penalty)) + (better? (or + (not current-best) + (< total-penalty (node-penalty current-best)))) + (new-best (if better? + (make-node (if (null? best-paths) + #f + (car best-paths)) + current-lines + this-page-num total-penalty) + current-best)) + + (debug-info (list + "user pen " user-penalty " prev-penalty " prev-penalty "\n" + "better? " better? " total-penalty " total-penalty "\n" + "height " page-height " spc used: " space-used "\n" + "pen " this-page-penalty " lines: " current-lines "\n")) + + (foo (display debug-info)) + ) + + (if (and (pair? done-lines) + + ;; if this page is too full, adding another line won't help + (positive? this-page-penalty)) + (walk-paths (cdr done-lines) (cdr best-paths) (cons (car done-lines) current-lines) + last? new-best) + new-best))) + + (define (walk-lines done best-paths todo) + "Return the best page breaking as a single + for optimally breaking TODO ++ +DONE.reversed. BEST-PATHS is a list of break nodes corresponding to +DONE." + + (if (null? todo) + (car best-paths) + (let* + ((this-line (car todo)) + (last? (null? (cdr todo))) + (next (walk-paths + done best-paths + (list this-line) + last? #f + + ))) + + (walk-lines (cons this-line done) + (cons next best-paths) + (cdr todo)) + ))) + + (define (line-number node) + (ly:paper-line-number (car (node-lines node)))) + ; main body. + + (let* + ((best-break-node + (walk-lines '() '() lines)) + (break-nodes (get-path best-break-node '())) + (break-lines (map node-lines break-nodes)) + (break-numbers (map line-number break-nodes)) + ) + + (display break-lines) + + (if (ly:get-option 'verbose) + (begin + (format (current-error-port) "breaks: ~S\n" break-numbers) + (force-output (current-error-port)))) + + ;; TODO: if solution is bad return no breaks and revert to + ;; ragged bottom + + + break-lines)) + diff --git a/scm/page-layout.scm b/scm/page-layout.scm index 9eeb91cf14..71256d678f 100644 --- a/scm/page-layout.scm +++ b/scm/page-layout.scm @@ -48,174 +48,6 @@ ((markup? copyright) (interpret-markup paper props copyright))))) -;;; optimal page breaking - -;;; This is not optimal page breaking, this is optimal distribution of -;;; lines over pages; line breaks are a given. - -;;; TODO: -;;; - user tweaking: -;;; + \pagebreak, \nopagebreak -;;; + #pages? -;;; - short circut SCORE=-1 (dismiss path) -;;; - density scoring - - -(use-modules (oop goops describe)) - -(define-class () - (prev #:init-value '() #:accessor node-prev #:init-keyword #:prev) - (line #:init-value 'barf #:accessor node-line #:init-keyword #:line) - (page #:init-value 0 #:accessor node-page #:init-keyword #:page) - (score #:init-value 0 #:accessor node-score #:init-keyword #:score) - (height #:init-value 0 #:accessor node-height #:init-keyword #:height)) - -(define INFINITY 1e9) - -(define (robust-paper-line-number line) - (if (null? line) 0 - (ly:paper-line-number line))) - -(define (robust-line-height line) - (if (null? line) 0 - (ly:paper-line-extent line Y))) - -(define (robust-line-number node) - (if (null? node) 0 - (robust-paper-line-number (node-line node)))) - -(define (robust-break-score node) - (let ((line (node-line node))) - (if (null? line) 0 - (ly:paper-line-break-score line)))) - -(define (make-node prev line page score . height) - (make #:prev prev #:line line #:page page #:score score - #:height (if (null? height) 0 (car height)))) - -;; max density % -(define MAX-CRAMP 0.05) - -(define-public (ly:optimal-page-breaks lines - paper-book - text-height - first-diff last-diff) - "DOCME" - ;; FIXME: may need some tweaking: square, cubic - (define (height-score available used) - (let* ((empty (- available used)) - (norm-empty (* empty (/ 100 available)))) - (if (< norm-empty 0) - (if (> (* -1 (/ empty available)) MAX-CRAMP) - ;; cannot fill more than MAX-CRAMP - -1 - ;; overfull page is still worse by a power - ;; -- which means it never happens - ;; let's try a factor 2 - ;;(* -1 norm-empty norm-empty norm-empty)) - (* 2 norm-empty norm-empty)) - (* norm-empty norm-empty)))) - - (define (page-height page-number page-count) - (let ((h text-height)) - (if (= page-number 1) - (set! h (+ h first-diff))) - (if (= page-number page-count) - (set! h (+ h last-diff))) - h)) - - (define (cumulative-height lines) - (apply + (map robust-line-height lines))) - - (define (get-path node) - (if (null? node) '() (cons node (get-path (node-prev node))))) - - (define (add-scores . lst) - (if (null? (filter (lambda (x) (> 0 x)) lst)) (apply + lst) -1)) - - (define (density-variance nodes) - (define (sqr x) (* x x)) - (define (density node) - (let ((p (page-height (node-page node) (node-page (car nodes)))) - (h (node-height node))) - (if (and p h) (/ h p) 0))) - - (let* ((height-nodes (reverse - ;; reverse makes for handier debugging - (filter (lambda (x) (> (node-height x) 0)) nodes))) - (densities (map density height-nodes)) - (p-heights (map (lambda (x) (page-height (node-page x) - (node-page (car nodes)))) - height-nodes)) - (heights (map node-height height-nodes)) - (mean (/ (apply + densities) (length densities))) - (diff (map (lambda (x) (- x mean)) densities)) - (var (map sqr (map (lambda (x) (* (car p-heights) x)) diff)))) - (apply + var))) - - (define (walk-paths best node lines nodes paths) - (let* ((height (cumulative-height lines)) - (next-page (+ (if (null? paths) 0 (node-page (car paths))) 1)) - (page (page-height (node-page node) next-page)) - (hh (make-node '() (node-line node) 0 0 height)) - (break-score (robust-break-score node)) - (density-score (if (null? paths) 0 - ;; 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 (and (>= score 0) - (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) (car paths)))) - - (if (or (null? nodes) - ;; short circuit - (and (= path-score -1) - (> (- (/ height page) 1) MAX-CRAMP))) - best - (walk-paths best (car nodes) - (cons (node-line (car paths)) lines) - (cdr nodes) (cdr paths))))) - - (define (walk-lines lines nodes paths) - (if (null? (cdr lines)) - 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 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)) - (this (make-node dummy (car lines) 0 0)) - (result (walk-lines lines (list this dummy) (list dummy))) - (path (get-path (car result))) - ;; CDR: junk dummy node - (breaks (cdr (reverse (map robust-line-number path))))) - - (if (ly:get-option 'verbose) - (begin - (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) @@ -331,3 +163,10 @@ '())) ))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;NEW;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + diff --git a/scm/safe-lily.scm b/scm/safe-lily.scm index a99269de54..a98baf5f53 100644 --- a/scm/safe-lily.scm +++ b/scm/safe-lily.scm @@ -95,7 +95,7 @@ ly:paper-def? ly:paper-get-font ly:paper-get-number - ly:paper-line-break-score + ly:paper-line-break-penalty ly:paper-line-extent ly:paper-line-number ly:paper-line-stencil -- 2.39.2