+2004-06-13 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * lily/paper-book.cc: remove copyright & tagline. Remove
+ interactions with Page
+
+ * scm/page-layout.scm (ly:optimal-page-breaks): move back breaking
+ here,
+ (default-page-make-stencil): new function
+ (default-page-music-height): new function
+ (page-headfoot): new function
+ (ly:optimal-page-breaks): generate stencils directly from here
+
+ * scm/titling.scm: new file, group titling functions
+
2004-06-13 Jan Nieuwenhuizen <janneke@gnu.org>
* scm/framework-gnome.scm: Do not load output-gnome.
#include "output-def.hh"
#include "music-output.hh"
#include "music.hh"
-#include "page.hh"
#include "paper-book.hh"
#include "output-def.hh"
#include "score.hh"
return paper_book;
}
+#if 0
/* FIXME: WIP, this is a hack. Return first page as stencil. */
SCM
Book::to_stencil (Output_def *default_def)
SCM pages = paper_book->pages ();
scm_gc_unprotect_object (paper_book->self_scm ());
- if (pages != SCM_EOL)
+ if (ly_c_pair_p (pages))
{
progress_indication (_f ("paper output to `%s'...", "<markup>"));
- return (unsmob_page (ly_car (pages)))->to_stencil ().smobbed_copy ();
+ return ly_car (pages);
}
scm_gc_unprotect_object (paper_book->bookpaper_->self_scm ());
return SCM_EOL;
}
+#endif
+++ /dev/null
-/*
- page.hh -- declare Page
-
- source file of the GNU LilyPond music typesetter
-
- (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
-*/
-#ifndef PAGE_HH
-#define PAGE_HH
-
-#include "lily-proto.hh"
-#include "smobs.hh"
-
-/* WIP -- moving toward flexible stencil based output.
- Rename to Paper_page? */
-class Page
-{
- DECLARE_SMOBS (Page, );
-
-public:
- Output_def *paper_; // todo: make private?
- Output_def * bookpaper () const;
-
- static Real MIN_COVERAGE_;
-
- int number_;
- int line_count_;
- SCM lines_;
- SCM header_;
- SCM footer_;
- SCM copyright_;
- SCM tagline_;
-
- bool is_last_;
- /* actual height filled with text. */
- Real height_;
-
- // HMMM all this size stuff to paper/paper-outputter?
- Real vsize_;
- Real top_margin_;
- Real bottom_margin_;
-
- Page (SCM, Output_def*, int);
-
- /* available area for text. */
- Real text_height () const;
- Real left_margin () const;
- Stencil to_stencil () const;
-};
-
-DECLARE_UNSMOB (Page, page);
-
-#endif /* PAGE_HH */
Stencil to_stencil () const;
SCM stencils () const;
bool is_title () const;
- int penalty () const;
+ Real penalty () const;
};
DECLARE_UNSMOB (Paper_line, paper_line);
+++ /dev/null
-/*
- page.cc -- implement Page
-
- source file of the GNU LilyPond music typesetter
-
- (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
-*/
-
-#include "dimensions.hh"
-#include "ly-module.hh"
-#include "page.hh"
-#include "output-def.hh"
-#include "paper-outputter.hh"
-#include "paper-line.hh"
-#include "stencil.hh"
-#include "warn.hh"
-
-
-Real Page::MIN_COVERAGE_ = 0.66;
-
-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;
-
- height_ = 0;
- line_count_ = 0;
- is_last_ = false;
- header_ = scm_call_2 (paper_->c_variable ("make-header"),
- paper_->self_scm (),
- scm_int2num (number_));
- if (unsmob_stencil (header_))
- unsmob_stencil (header_)->align_to (Y_AXIS, UP);
-
- footer_ = scm_call_2 (paper_->c_variable ("make-footer"),
- paper_->self_scm (),
- scm_int2num (number_));
- if (unsmob_stencil (footer_))
- unsmob_stencil (footer_)->align_to (Y_AXIS, UP);
-
- 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 ()
-{
-}
-
-#include "ly-smobs.icc"
-
-IMPLEMENT_DEFAULT_EQUAL_P (Page)
-IMPLEMENT_SMOBS (Page)
-IMPLEMENT_TYPE_P (Page, "ly:page?")
-
-SCM
-Page::mark_smob (SCM smob)
-{
- Page *p = (Page*) SCM_CELL_WORD_1 (smob);
- scm_gc_mark (p->header_);
- scm_gc_mark (p->footer_);
-
- if (p->paper_)
- {
- scm_gc_mark (p->paper_->self_scm ());
- }
-
- scm_gc_mark (p->copyright_);
- scm_gc_mark (p->tagline_);
- //scm_gc_mark (p->lines_);
- return p->lines_;
-}
-
-int
-Page::print_smob (SCM smob, SCM port, scm_print_state*)
-{
- Page *p = (Page*) ly_cdr (smob);
- scm_puts ("#<", port);
- scm_puts (classname (p), port);
- scm_puts (to_string (p->number_).to_str0 (), port);
- scm_puts (" ", port);
- scm_puts (">", port);
- return 1;
-}
-
-static Stencil
-stack_stencils (Stencil a, Stencil b, Offset *origin)
-{
- Real height = b.extent (Y_AXIS).length ();
- if (height > 50 CM)
- {
- programming_error (to_string ("Improbable stencil height: %f", height));
- height = 50 CM;
- }
- Offset o = *origin;
- o.mirror (Y_AXIS);
- b.translate (o);
- a.add_stencil (b);
- (*origin)[Y_AXIS] += height;
- return a;
-}
-
-Stencil
-Page::to_stencil () const
-{
- SCM proc = paper_->lookup_variable (ly_symbol2scm ("page-to-stencil"));
- return *unsmob_stencil (scm_call_1 (proc, self_scm ()));
-}
-
-//urg
-Real
-Page::left_margin () const
-{
- return (paper_->get_dimension (ly_symbol2scm ("hsize"))
- - paper_->get_dimension (ly_symbol2scm ("linewidth"))) / 2;
-}
-
-LY_DEFINE (ly_page_header_lines_footer_stencil, "ly:page-header-lines-footer-stencil",
- 1, 0, 0, (SCM page),
- "Simple header, lines, footer stencil from PAGE.")
-{
- Page *p = unsmob_page (page);
- SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page");
-
- Stencil stencil;
- Offset o (p->left_margin (),
- p->paper_->get_dimension (ly_symbol2scm ("top-margin")));
-
- Real vfill = (p->line_count_ > 1
- ? (p->text_height () - p->height_) / (p->line_count_ - 1)
- : 0);
-
- Real coverage = p->height_ / p->text_height ();
- if (coverage < p->MIN_COVERAGE_)
- /* Do not space out a badly filled page. This is too simplistic
- (ie broken), because this should not vary too much between
- (subsequent?) pages in a book. */
- vfill = 0;
-
- if (Stencil *s = unsmob_stencil (p->header_))
- {
- stencil = stack_stencils (stencil, *s, &o);
- o[Y_AXIS] += p->paper_->get_dimension (ly_symbol2scm ("head-sep"));
- }
-
- for (SCM s = p->lines_; s != SCM_EOL; s = ly_cdr (s))
- {
- Paper_line *p = unsmob_paper_line (ly_car (s));
- stencil = stack_stencils (stencil, p->to_stencil (), &o);
- /* Do not put vfill between title and its music, */
- if (ly_cdr (s) != SCM_EOL
- && (!p->is_title () || vfill < 0))
- o[Y_AXIS] += vfill;
- /* rather put extra just before the title. */
- if (ly_cdr (s) != SCM_EOL
- && (unsmob_paper_line (ly_cadr (s))->is_title () && vfill > 0))
- o[Y_AXIS] += vfill;
- }
-
- o[Y_AXIS] = p->paper_->get_dimension (ly_symbol2scm ("vsize"))
- - p->paper_->get_dimension (ly_symbol2scm ("bottom-margin"));
- if (unsmob_stencil (p->copyright_))
- o[Y_AXIS] -= unsmob_stencil (p->copyright_)->extent (Y_AXIS).length ();
- if (unsmob_stencil (p->tagline_))
- o[Y_AXIS] -= unsmob_stencil (p->tagline_)->extent (Y_AXIS).length ();
- if (unsmob_stencil (p->footer_))
- o[Y_AXIS] -= unsmob_stencil (p->footer_)->extent (Y_AXIS).length ();
-
- if (Stencil *s = unsmob_stencil (p->copyright_))
- stencil = stack_stencils (stencil, *s, &o);
- if (Stencil *s = unsmob_stencil (p->tagline_))
- stencil = stack_stencils (stencil, *s, &o);
- if (Stencil *s = unsmob_stencil (p->footer_))
- stencil = stack_stencils (stencil, *s, &o);
-
- return stencil.smobbed_copy ();
-}
-
-Real
-Page::text_height () const
-{
- Real h = paper_->get_dimension (ly_symbol2scm ("vsize"))
- - paper_->get_dimension (ly_symbol2scm ("top-margin"))
- - paper_->get_dimension (ly_symbol2scm ("bottom-margin"));
- if (unsmob_stencil (header_))
- h -= unsmob_stencil (header_)->extent (Y_AXIS).length ()
- + paper_->get_dimension (ly_symbol2scm ("head-sep"));
- if (unsmob_stencil (copyright_)
- || unsmob_stencil (tagline_)
- || unsmob_stencil (footer_))
- h -= paper_->get_dimension (ly_symbol2scm ("foot-sep"));
- if (unsmob_stencil (copyright_))
- h -= unsmob_stencil (copyright_)->extent (Y_AXIS).length ();
- if (unsmob_stencil (tagline_))
- h -= unsmob_stencil (tagline_)->extent (Y_AXIS).length ();
- if (unsmob_stencil (footer_))
- h -= unsmob_stencil (footer_)->extent (Y_AXIS).length ();
- return h;
-}
-
-
-/*
- TODO: unused?
-
- */
-LY_DEFINE (ly_page_paper_lines, "ly:page-paper-lines",
- 1, 0, 0, (SCM page),
- "Return paper-lines from @var{page}.")
-{
- Page *p = unsmob_page (page);
- SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page");
- return p->lines_;
-}
-
-LY_DEFINE (ly_page_stencil, "ly:page-stencil",
- 1, 0, 0, (SCM page),
- "Return stencil for @var{page}.")
-{
- Page *p = unsmob_page (page);
- SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page");
- return p->to_stencil ().smobbed_copy ();
-}
-
-
-LY_DEFINE (ly_page_last_p, "ly:page-last?",
- 1, 0, 0, (SCM page),
- "Is @var{page} the last one?")
-{
- Page *p = unsmob_page (page);
- SCM_ASSERT_TYPE (p, page, SCM_ARG1, __FUNCTION__, "page");
- return ly_bool2scm (p->is_last_);
-}
#include "ly-module.hh"
#include "main.hh"
-#include "page.hh"
#include "paper-book.hh"
#include "output-def.hh"
#include "paper-outputter.hh"
{
pages_ = SCM_BOOL_F;
lines_ = SCM_BOOL_F;
- copyright_ = SCM_EOL;
- tagline_ = SCM_EOL;
header_ = SCM_EOL;
bookpaper_ = 0;
for (int i = 0; i < b->score_lines_.size (); i++)
b->score_lines_[i].gc_mark ();
- scm_gc_mark (b->copyright_);
if (b->bookpaper_)
scm_gc_mark (b->bookpaper_->self_scm ());
scm_gc_mark (b->header_);
scm_gc_mark (b->pages_);
- scm_gc_mark (b->lines_);
- return b->tagline_;
+ return b->lines_;
}
int
}
+LY_DEFINE(ly_paper_book_scopes, "ly:paper-book-scopes",
+ 1,0,0,
+ (SCM book),
+ "Return pages in paper book @var{book}.")
+{
+ Paper_book * pb = unsmob_paper_book(book);
+ SCM_ASSERT_TYPE(pb, book, SCM_ARG1, __FUNCTION__, "Paper_book");
+
+ SCM scopes = SCM_EOL;
+ if (ly_c_module_p (pb->header_))
+ scopes = scm_cons (pb->header_, scopes);
+
+ return scopes;
+}
+
+
LY_DEFINE(ly_paper_book_lines, "ly:paper-book-lines",
1,0,0,
(SCM pb),
SCM tit = SCM_EOL;
if (ly_c_procedure_p (title_func))
- tit =scm_call_2 (title_func,
+ tit = scm_call_2 (title_func,
bookpaper_->self_scm (),
scopes);
}
-SCM
-make_tagline (Output_def*paper, SCM scopes)
-{
- SCM make_tagline = paper->c_variable ("make-tagline");
- SCM tagline = scm_call_2 (make_tagline, paper->self_scm (), scopes);
- return tagline;
-}
-
-SCM
-make_copyright (Output_def *paper, SCM scopes)
-{
- SCM make_copyright = paper->c_variable ("make-copyright");
- SCM copyright = scm_call_2 (make_copyright, paper->self_scm (), scopes);
- return copyright;
-}
-
SCM
Paper_book::pages ()
{
Output_def *paper = bookpaper_;
-
- // dummy to extract dims
- Page *page = new Page (SCM_EOL, paper, 1); // ugh
- Real text_height = page->text_height ();
-
- Real copy_height = 0;
- if (Stencil *s = unsmob_stencil (copyright_))
- copy_height = s->extent (Y_AXIS).length ();
-
- Real tag_height = 0;
- if (Stencil *s = unsmob_stencil (tagline_))
- tag_height = s->extent (Y_AXIS).length ();
-
- scm_gc_unprotect_object (page->self_scm ());
-
- /*
- UGH - move this out of C++.
- */
- SCM scopes = SCM_EOL;
- if (ly_c_module_p (header_))
- scopes = scm_cons (header_, scopes);
-
- tagline_ = make_tagline (bookpaper_, scopes);
- copyright_ = make_tagline (bookpaper_, scopes);
-
-
- 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))
- {
- Page * page = new Page (ly_car (s), paper, ++num);
-
- *page_tail = scm_cons (page->self_scm () , SCM_EOL);
- page_tail = SCM_CDRLOC(*page_tail);
-
- scm_gc_unprotect_object (page->self_scm ());
-
- if (!ly_c_pair_p (ly_cdr (s)))
- page->is_last_ = true;
- }
+ pages_ = scm_apply_0 (proc, scm_list_n (lines (),
+ self_scm (),
+ SCM_UNDEFINED));
return pages_;
}
+
+#if 0
+
static SCM
c_ragged_page_breaks (SCM lines,
Paper_book *book,
book_height += unsmob_paper_line (ly_car (s))->dim ()[Y_AXIS];
}
- /*
- UGH. following stuff should go out of C++.
- */
- SCM scopes = SCM_EOL;
- if (ly_c_module_p (book->header_))
- scopes = scm_cons (book->header_, scopes);
-
-
- SCM tag = make_tagline (book->bookpaper_, scopes);
- if (unsmob_stencil (tag))
- {
- book_height += unsmob_stencil (tag)->extent (Y_AXIS).length ();
- }
-
- SCM cr = make_copyright (book->bookpaper_, scopes);
- if (unsmob_stencil (cr))
- {
- book_height += unsmob_stencil (cr)->extent (Y_AXIS).length ();
- }
-
int page_count = int (book_height / text_height + 0.5); // ceil?
SCM breaks = SCM_EOL;
Real page_height = text_height + first;
ly_scm2double (text),
ly_scm2double (first), ly_scm2double (last));
}
+#endif
+
/****************************************************************/
return is_title_;
}
-int
+Real
Paper_line::penalty () const
{
return penalty_;
}
+
+LY_DEFINE (ly_paper_line_title_p, "ly:paper-line-title?",
+ 1, 0, 0, (SCM line),
+ "Is @var{line} a title line?")
+{
+ Paper_line *pl = unsmob_paper_line (line);
+ SCM_ASSERT_TYPE (pl, line, SCM_ARG1, __FUNCTION__, "paper-line");
+ return SCM_BOOL (pl->is_title ());
+}
+
LY_DEFINE (ly_paper_line_number, "ly:paper-line-number",
1, 0, 0, (SCM line),
"Return the number of @var{line}.")
#include "lily-version.hh"
#include "ly-module.hh"
#include "main.hh"
-#include "page.hh"
#include "paper-book.hh"
#include "output-def.hh"
#include "paper-line.hh"
}
-
+
LY_DEFINE (ly_stencil_combine_at_edge, "ly:stencil-combine-at-edge",
4, 2, 0, (SCM first, SCM axis, SCM direction,
SCM second,
"@var{direction} can be -1 (left or down) or 1 (right or up). "
"The stencils are juxtaposed with @var{padding} as extra space. "
"If this puts the reference points closer than @var{minimum}, "
- "they are moved by the latter amount.")
+ "they are moved by the latter amount."
+ "@var{first} and @var{second} may also be '() or #f.")
{
Stencil *s1 = unsmob_stencil (first);
Stencil *s2 = unsmob_stencil (second);
Stencil result;
- SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis");
- SCM_ASSERT_TYPE (is_direction (direction), direction, SCM_ARG4, __FUNCTION__, "dir");
+ SCM_ASSERT_TYPE (s1 || first == SCM_BOOL_F || first == SCM_EOL,
+ first, SCM_ARG1, __FUNCTION__, "Stencil, #f or ()");
+ SCM_ASSERT_TYPE (s2 || second == SCM_BOOL_F || second == SCM_EOL,
+ second, SCM_ARG4, __FUNCTION__, "Stencil, #f or ()");
+ SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis");
+ SCM_ASSERT_TYPE (is_direction (direction), direction, SCM_ARG3, __FUNCTION__, "dir");
Real p = 0.0;
if (padding != SCM_UNDEFINED)
if (s1)
result = *s1;
+
if (s2)
result.add_at_edge (Axis (ly_scm2int (axis)),
Direction (ly_scm2int (direction)), *s2, p, m);
% #(define page-breaking ly:ragged-page-breaks)
#(define page-breaking ly:optimal-page-breaks)
-
+ #(define page-music-height default-page-music-height )
+ #(define page-make-stencil default-page-make-stencil )
+
#(define page-to-stencil ly:page-header-lines-footer-stencil)
#(define make-header plain-header)
"0 0 start-system { "
"set-ps-scale-to-lily-scale "
"\n"))
- (ly:outputter-dump-stencil outputter (ly:page-stencil page))
+ (ly:outputter-dump-stencil outputter page)
(ly:outputter-dump-string outputter "} stop-system \nshowpage\n"))
(define-public (output-framework-ps outputter book scopes fields basename)
"\\lilypondspecial\n"
"\\lilypondpostscript\n"))
-(define (dump-page putter page)
+(define (dump-page putter page last?)
(ly:outputter-dump-string
putter
"\n\\vbox to 0pt{%\n\\leavevmode\n\\lybox{0}{0}{0}{0}{%\n")
- (ly:outputter-dump-stencil putter (ly:page-stencil page))
+ (ly:outputter-dump-stencil putter page)
(ly:outputter-dump-string
putter
- (if (ly:page-last? page)
+ (if last?
"}\\vss\n}\n\\vfill\n"
"}\\vss\n}\n\\vfill\\lilypondpagebreak\n")))
(define-public (output-framework-tex outputter book scopes fields basename)
(let* ((bookpaper (ly:paper-book-book-paper book))
- (pages (ly:paper-book-pages book)))
+ (pages (ly:paper-book-pages book))
+ (last-page (car (last-pair pages)))
+ )
(for-each
(lambda (x)
(ly:outputter-dump-string outputter x))
(header "creator" "timestamp" bookpaper (length pages) #f)
(define-fonts bookpaper)
(header-end)))
- (for-each (lambda (page) (dump-page outputter page)) pages)
+
+ (for-each
+ (lambda (page) (dump-page outputter page (eq? last-page page)))
+ pages)
(ly:outputter-dump-string outputter "\\lilypondend\n")))
(define (dump-line putter line last?)
+++ /dev/null
-;;;; page-breaking.scm -- page breaking functions
-;;;;
-;;;; source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
-
-(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:
-;
-; - density scoring
-;
-
-(define-class <optimally-broken-page-node> ()
- (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)
- (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
-
-(define-method (display (node <optimally-broken-page-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 slightly arbitrary interface
-;; For the future, we might want to invoke a function from PAPER-BOOK to
-;; determine available height given
-(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.
-
-TEXT-HEIGHT is the height of the printable area, FIRST-DIFF and
-LAST-DIFF are decrements for the 1st and last page. PAPER-BOOK is
-unused, at the moment."
-
- (define (make-node prev lines page-num penalty)
- (make <optimally-broken-page-node>
- #:prev prev
- #:lines lines
- #:pageno page-num
- #:penalty penalty))
-
- (define MAXPENALTY 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 (abs (/ left available))))
- (if (negative? left)
-
- ;; too full, penalise more
- (* 10 (1+ relative) relative)
-
- ;; Convexity: two half-empty pages is better than 1 completely
- ;; empty page
- (* (1+ relative) relative))))
-
- (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 <optimally-broken-page-node>)
- (get-path (node-prev node) (cons node done))
- done))
-
- (define (combine-penalties user page prev)
- (+ prev page user))
-
- (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 (combine-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)))
-
- (if #f ;; debug
- (display
- (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")))
-
- (if (and (pair? done-lines)
- ;; if this page is too full, adding another line won't help
- (< this-page-penalty MAXPENALTY))
- (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
-<optimal-page-break-node> 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))))
-
- (let* ((best-break-node (walk-lines '() '() lines))
- (break-nodes (get-path best-break-node '()))
- (break-lines (map node-lines break-nodes)))
-
- (if (ly:get-option 'verbose)
- (begin
- (format (current-error-port) "breaks: ~S\n" (map line-number break-nodes))
- (force-output (current-error-port))))
-
- break-lines))
-
-;;;; page-layout.scm -- page layout functions
-;;;;
+;;; page-layout.scm -- page breaking and page layout
+;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
-(define-public (page-properties paper)
- (list (append `((linewidth . ,(ly:paper-get-number
- paper 'linewidth)))
- (ly:output-def-lookup paper 'text-font-defaults))))
+(use-modules (oop goops describe)
+ (oop goops))
-(define-public (plain-header paper page-number)
- (let ((props (page-properties paper) ))
- (interpret-markup paper props
- (markup #:fill-line
- ("" #:bold (number->string page-number))))))
-(define-public (plain-footer paper page-number)
- (let ((props (page-properties paper)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- (interpret-markup paper props
- (markup #:fill-line ("" (number->string page-number))))))
+(define-class <optimally-broken-page-node> ()
+ (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)
+ (lines #:init-value 0 #:accessor node-lines #:init-keyword #:lines))
+(define-method (display (node <optimally-broken-page-node>) port)
+ (map (lambda (x) (display x port))
+ (list
+ "Page " (node-page-number node)
+ " Lines: " (node-lines node)
+ " Penalty " (node-penalty node)
+ "\n")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define TAGLINE
(string-append "Engraved by LilyPond (version " (lilypond-version) ")"))
+;; TODO: take <optimally-broken-page-node> iso. page-number
+;; for all of these functions ?
+
(define-public (TAGLINE-or-tagline-from-header paper scopes)
(let* ((props (page-properties paper))
(tagline-var (ly:modules-lookup scopes 'tagline))
((markup? copyright) (interpret-markup paper props copyright)))))
-;;;;;;;;;;;;;;;;;;
- ; titling.
-(define-public (default-book-title paper scopes)
- "Generate book title from header strings."
+;; TODO: add instrument name.
+(define-public (plain-header paper scopes page-number)
+ (let ((props (page-properties paper) ))
+ (interpret-markup paper props
+ (markup #:fill-line
+ ("" #:bold (number->string page-number))))))
- (define (get sym)
- (let ((x (ly:modules-lookup scopes sym)))
- (if (markup? x) x "")))
- (define (has sym)
- (markup? (ly:modules-lookup scopes sym)))
-
+; TODO: insert tagline and/or copyright
+(define-public (plain-footer paper scopes page-number)
(let ((props (page-properties paper)))
- (interpret-markup
- paper props
- (make-override-markup
- '(baseline-skip . 4)
- (make-column-markup
- (append
- (if (has 'dedication)
- (list (markup #:fill-line
- (#:normalsize (get 'dedication))))
- '())
- (if (has 'title)
- (list
- (markup (#:fill-line
- (#:huge #:bigger #:bigger #:bigger #:bigger #:bold
- (get 'title)))))
- '())
- (if (or (has 'subtitle) (has 'subsubtitle))
- (list
- (make-override-markup
- '(baseline-skip . 3)
- (make-column-markup
- (list
- (markup #:fill-line
- (#:large #:bigger #:bigger #:bold (get 'subtitle)))
- (markup #:fill-line (#:bigger #:bigger #:bold
- (get 'subsubtitle)))
- (markup #:override '(baseline-skip . 5)
- #:column ("")))
-
- ))
- )
- '())
+
+ ;; page number already in header.
+ '()
+
+ ))
+
+
+(define (page-headfoot paper scopes number sym sepsym dir)
+ (let*
+ ((header-proc (ly:output-def-lookup paper sym))
+ (sep (ly:output-def-lookup paper sepsym))
+ (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
+ (head-stencil
+ (if (procedure? header-proc)
+ (header-proc paper scopes number)
+ #f)))
+
+ (if (and (number? sep) (ly:stencil? head-stencil))
+ (set! head-stencil
+ (ly:stencil-combine-at-edge
+ stencil Y dir head-stencil
+ sep 0.0)))
+
+ head-stencil))
+
+(define-public (default-page-music-height paper scopes number last?)
+ (let*
+ ((h (- (ly:output-def-lookup paper 'vsize)
+ (ly:output-def-lookup paper 'top-margin)
+ (ly:output-def-lookup paper 'bottom-margin)))
+ (head (page-headfoot paper scopes number 'make-header 'head-sep UP))
+ (foot (page-headfoot paper scopes number 'make-footer 'foot-sep DOWN))
+ )
+ (- h (if (ly:stencil? head)
+ (interval-length (ly:stencil-extent head Y))
+ 0)
+ (if (ly:stencil? foot)
+ (interval-length (ly:stencil-extent foot Y))
+ 0))
+ ))
+
+
+(define-public (default-page-make-stencil lines paper scopes number last? )
+ (let*
+ (
+ (top-margin (ly:output-def-lookup paper 'top-margin))
+
+ ;; TODO: naming vsize/hsize not analogous to TeX.
+
+ (hsize (ly:output-def-lookup paper 'hsize))
+ (left-margin (- hsize
+ (/ (ly:output-def-lookup paper 'linewidth) 2)))
+ (vsize (ly:output-def-lookup paper 'vsize))
+ (bottom-edge (- vsize
+ (ly:output-def-lookup paper 'bottom-margin)))
+
+ (head (page-headfoot paper scopes number 'make-header 'head-sep UP))
+ (foot (page-headfoot paper scopes number 'make-footer 'foot-sep DOWN))
+ (line-stencils (map ly:paper-line-stencil lines))
+ (height-proc (ly:output-def-lookup paper 'page-music-height))
+ (music-height (height-proc paper scopes number last?))
+ (spc-left (- music-height
+ (apply + (map (lambda (x)
+ (interval-length (ly:stencil-extent x Y)))
+ line-stencils))))
+ (stretchable-lines (remove ly:paper-line-title? (cdr lines)))
+ (stretch (if (null? stretchable-lines)
+ 0.0
+ (/ spc-left (length stretchable-lines))))
+
+ (page-stencil (ly:make-stencil '()
+ (cons left-margin hsize)
+ (cons (- top-margin) 0)))
+ (was-title #t))
+
+ (set! page-stencil (ly:stencil-combine-at-edge
+ page-stencil Y DOWN head 0. 0.))
+
+ (for-each
+ (lambda (l)
+ (set! page-stencil
+ (ly:stencil-combine-at-edge
+ page-stencil Y DOWN (ly:paper-line-stencil l)
+ (if was-title
+ 0.0
+ stretch)
+ ))
+
+ (set! was-title (ly:paper-line-title? l)))
+ lines)
+
+ (if (ly:stencil? foot)
+ (set! page-stencil
+ (ly:stencil-add
+ page-stencil
+ (ly:stencil-translate
+ foot
+ (cons 0
+ (+ bottom-edge (- (car (ly:stencil-extent foot Y)))))
+ ))))
+ page-stencil
+ ))
+
+
+
+
+;;; optimal page breaking
+
+;;; This is not optimal page breaking, this is optimal distribution of
+;;; lines over pages; line breaks are a given.
+
+; TODO:
+;
+; - density scoring
+;
+
+;; TODO: first-diff and last-diff are slightly arbitrary interface
+;; For the future, we might want to invoke a function from PAPER-BOOK to
+;; determine available height given
+(define-public (ly:optimal-page-breaks
+ lines paper-book)
+ "Return pages as a list starting with 1st page. Each page is a list
+of lines.
+
+TEXT-HEIGHT is the height of the printable area, FIRST-DIFF and
+LAST-DIFF are decrements for the 1st and last page. PAPER-BOOK is
+unused, at the moment."
+
+ (define (make-node prev lines page-num penalty)
+ (make <optimally-broken-page-node>
+ #:prev prev
+ #:lines lines
+ #:pageno page-num
+ #:penalty penalty))
+
+ (define MAXPENALTY 1e9)
+ (define bookpaper (ly:paper-book-book-paper paper-book))
+ (define scopes (ly:paper-book-scopes paper-book))
+ (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 (abs (/ left available))))
+ (if (negative? left)
+
+ ;; too full, penalise more
+ (* 10 (1+ relative) relative)
+
+ ;; Convexity: two half-empty pages is better than 1 completely
+ ;; empty page
+ (* (1+ relative) relative))))
+
+ (define (page-height page-number last?)
+ (let
+ ((p (ly:output-def-lookup bookpaper 'page-height-function)))
+
+ (if (procedure? p)
+ (p bookpaper scopes page-number last?)
+ 10000)))
+
+
+ (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 <optimally-broken-page-node>)
+ (get-path (node-prev node) (cons node done))
+ done))
+
+ (define (combine-penalties user page prev)
+ (+ prev page user))
+
+ (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 (combine-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)))
+
+ (if #f ;; debug
+ (display
+ (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")))
+
+ (if (and (pair? done-lines)
+ ;; if this page is too full, adding another line won't help
+ (< this-page-penalty MAXPENALTY))
+ (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
+<optimal-page-break-node> 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)))
- (list
- (make-override-markup
- '(baseline-skip . 2.5)
- (make-column-markup
- (append
- (if (or (has 'poet) (has 'composer))
- (list (markup #:fill-line
- (#:bigger (get 'poet)
- #:large #:bigger #:caps
- (get 'composer))))
- '())
- (if (or (has 'texttranslator) (has 'opus))
- (list
- (markup
- #:fill-line
- (#:bigger (get 'texttranslator) #:bigger (get 'opus))))
- '())
- (if (or (has 'meter) (has 'arranger))
- (list
- (markup #:fill-line
- (#:bigger (get 'meter) #:bigger (get 'arranger))))
- '())
- (if (has 'instrument)
- (list
- ""
- (markup #:fill-line (#:large #:bigger (get 'instrument))))
- '())
-;;; piece is done in the score-title
-;;; (if (has 'piece)
-;;; (list ""
-;;; (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
-;;; '())
- ))))))))))
-
-
-(define-public (default-user-title paper markup)
- "Generate book title from header markup."
- (if (markup? markup)
- (let ((props (page-properties paper))
- (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
- (stack-lines DOWN 0 BASELINE-SKIP
- (list (interpret-markup paper props markup))))))
-
-(define-public (default-score-title paper scopes)
- "Generate score title from header strings."
-
- (define (get sym)
- (let ((x (ly:modules-lookup scopes sym)))
- (if (markup? x) x "")))
-
- (define (has sym)
- (markup? (ly:modules-lookup scopes sym)))
+ (walk-lines (cons this-line done)
+ (cons next best-paths)
+ (cdr todo)))))
- (let ((props (page-properties paper)))
- (interpret-markup
- paper props
- (make-override-markup
- '(baseline-skip . 4)
- (make-column-markup
- (append
- (if (has 'opus)
- (list (markup #:fill-line ("" (get 'opus))))
- '())
- (if (has 'piece)
- (list
- (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
- '())))))))
+ (define (line-number node)
+ (ly:paper-line-number (car (node-lines node))))
+
+ (let* ((best-break-node (walk-lines '() '() lines))
+ (break-nodes (get-path best-break-node '()))
+ )
+
+ (if (ly:get-option 'verbose)
+ (begin
+ (format (current-error-port) "breaks: ~S\n" (map line-number break-nodes))
+ (force-output (current-error-port))))
+
+
+ ; create stencils.
+
+ (map (lambda (node)
+ ((ly:output-def-lookup bookpaper 'page-make-stencil)
+ (node-lines node)
+ bookpaper
+ scopes
+ (node-page-number node)
+ (eq? node best-break-node)))
+ break-nodes)))
ly:pitch-transpose
ly:pitch<?
ly:pitch?
- ly:ragged-page-breaks
ly:round-filled-box
ly:run-translator
ly:set-option
--- /dev/null
+;;;; titling.scm -- titling functions
+;;;;
+;;;; source file of the GNU LilyPond music typesetter
+;;;;
+;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+(define-public (page-properties paper)
+ (list (append `((linewidth . ,(ly:paper-get-number
+ paper 'linewidth)))
+ (ly:output-def-lookup paper 'text-font-defaults))))
+
+;;;;;;;;;;;;;;;;;;
+ ; titling.
+(define-public (default-book-title paper scopes)
+ "Generate book title from header strings."
+
+
+ (define (get sym)
+ (let ((x (ly:modules-lookup scopes sym)))
+ (if (markup? x) x "")))
+ (define (has sym)
+ (markup? (ly:modules-lookup scopes sym)))
+
+ (let ((props (page-properties paper)))
+
+ (interpret-markup
+ paper props
+ (make-override-markup
+ '(baseline-skip . 4)
+ (make-column-markup
+ (append
+ (if (has 'dedication)
+ (list (markup #:fill-line
+ (#:normalsize (get 'dedication))))
+ '())
+ (if (has 'title)
+ (list
+ (markup (#:fill-line
+ (#:huge #:bigger #:bigger #:bigger #:bigger #:bold
+ (get 'title)))))
+ '())
+ (if (or (has 'subtitle) (has 'subsubtitle))
+ (list
+ (make-override-markup
+ '(baseline-skip . 3)
+ (make-column-markup
+ (list
+ (markup #:fill-line
+ (#:large #:bigger #:bigger #:bold (get 'subtitle)))
+ (markup #:fill-line (#:bigger #:bigger #:bold
+ (get 'subsubtitle)))
+ (markup #:override '(baseline-skip . 5)
+ #:column ("")))
+
+ ))
+ )
+ '())
+
+ (list
+ (make-override-markup
+ '(baseline-skip . 2.5)
+ (make-column-markup
+ (append
+ (if (or (has 'poet) (has 'composer))
+ (list (markup #:fill-line
+ (#:bigger (get 'poet)
+ #:large #:bigger #:caps
+ (get 'composer))))
+ '())
+ (if (or (has 'texttranslator) (has 'opus))
+ (list
+ (markup
+ #:fill-line
+ (#:bigger (get 'texttranslator) #:bigger (get 'opus))))
+ '())
+ (if (or (has 'meter) (has 'arranger))
+ (list
+ (markup #:fill-line
+ (#:bigger (get 'meter) #:bigger (get 'arranger))))
+ '())
+ (if (has 'instrument)
+ (list
+ ""
+ (markup #:fill-line (#:large #:bigger (get 'instrument))))
+ '())
+;;; piece is done in the score-title
+;;; (if (has 'piece)
+;;; (list ""
+;;; (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
+;;; '())
+ ))))))))))
+
+
+(define-public (default-user-title paper markup)
+ "Generate book title from header markup."
+ (if (markup? markup)
+ (let ((props (page-properties paper))
+ (baseline-skip (chain-assoc-get 'baseline-skip props 2)) )
+ (stack-lines DOWN 0 BASELINE-SKIP
+ (list (interpret-markup paper props markup))))))
+
+(define-public (default-score-title paper scopes)
+ "Generate score title from header strings."
+
+ (define (get sym)
+ (let ((x (ly:modules-lookup scopes sym)))
+ (if (markup? x) x "")))
+
+ (define (has sym)
+ (markup? (ly:modules-lookup scopes sym)))
+
+ (let ((props (page-properties paper)))
+ (interpret-markup
+ paper props
+ (make-override-markup
+ '(baseline-skip . 4)
+ (make-column-markup
+ (append
+ (if (has 'opus)
+ (list (markup #:fill-line ("" (get 'opus))))
+ '())
+ (if (has 'piece)
+ (list
+ (markup #:fill-line (#:large #:bigger #:caps (get 'piece) "")))
+ '())))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
projects / lilypond.git / commitdiff