page-property
page-set-property!
page-prev
- page-height
+ page-printable-height
+ layout->page-init
page-lines
page-force
page-penalty
page-page-number
page-system-numbers
page-stencil
+ page-free-height
page?
))
(define (annotate? layout)
- (eq? #t (ly:output-def-lookup layout 'annotatespacing)))
+ (eq? #t (ly:output-def-lookup layout 'annotate-spacing)))
(define page-module (current-module))
-(define (make-page . args)
- (apply ly:make-prob (append
- (list 'page '())
- args)))
+(define (make-page paper-book . args)
+ (let*
+ ((p (apply ly:make-prob (append
+ (list 'page (layout->page-init (ly:paper-book-paper paper-book))
+ 'paper-book paper-book)
+ args))))
+ (page-set-property! p 'head-stencil (page-header p))
+ (page-set-property! p 'foot-stencil (page-footer p))
+
+ p))
+
(define page-property ly:prob-property)
+(define page-set-property! ly:prob-set-property!)
(define (page-property? page sym)
(eq? #t (page-property page sym)))
-
(define (page? x) (ly:prob-type? x 'page))
-(define page-set-property! ly:prob-set-property!)
;; define accessors.
(for-each
(lambda (pg)
(page-property pg j))))
- '(page-number prev lines force penalty configuration lines))
+ '(page-number prev lines force penalty lines))
-(define (page-system-numbers node)
+(define (page-system-numbers page)
(map (lambda (ps) (ly:prob-property ps 'number))
- (page-lines node)))
-
-
-
-(define (annotate-page stencil layout)
- (let*
- ((topmargin (ly:output-def-lookup layout 'topmargin))
- (vsize (ly:output-def-lookup layout 'vsize))
- (bottommargin (ly:output-def-lookup layout 'bottommargin))
- (add-stencil (lambda (y)
- (set! stencil
- (ly:stencil-add stencil y))
- )))
-
+ (page-lines page)))
+
+(define (page-translate-systems page)
+ (for-each
+
+ (lambda (sys-off)
+ (let*
+ ((sys (car sys-off))
+ (off (cadr sys-off)))
+
+ (if (not (number? (ly:prob-property sys 'Y-offset)))
+ (ly:prob-set-property! sys 'Y-offset off))))
+
+ (zip (page-property page 'lines)
+ (page-property page 'configuration))))
+
+(define (annotate-page layout stencil)
+ (let ((top-margin (ly:output-def-lookup layout 'top-margin))
+ (paper-height (ly:output-def-lookup layout 'paper-height))
+ (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
+ (add-stencil (lambda (y)
+ (set! stencil
+ (ly:stencil-add stencil
+ (ly:stencil-translate-axis y 6 X))))))
(add-stencil
(ly:stencil-translate-axis
- (annotate-y-interval layout "vsize"
- (cons (- vsize) 0)
+ (annotate-y-interval layout "paper-height"
+ (cons (- paper-height) 0)
#t)
1 X))
-
-
(add-stencil
(ly:stencil-translate-axis
- (annotate-y-interval layout "topmargin"
- (cons (- topmargin) 0)
+ (annotate-y-interval layout "top-margin"
+ (cons (- top-margin) 0)
#t)
2 X))
-
(add-stencil
(ly:stencil-translate-axis
- (annotate-y-interval layout "bottommargin"
- (cons (- vsize) (- bottommargin vsize))
+ (annotate-y-interval layout "bottom-margin"
+ (cons (- paper-height) (- bottom-margin paper-height))
#t)
2 X))
-
stencil))
-(define (annotate-space-left page-stencil layout bottom-edge)
+(define (annotate-space-left page)
(let*
- ((arrow (annotate-y-interval layout
- "space left"
- (cons (- bottom-edge) (car (ly:stencil-extent page-stencil Y)))
- #t)))
-
+ ((paper-book (page-property page 'paper-book))
+ (layout (ly:paper-book-paper paper-book))
+ (arrow (annotate-y-interval layout
+ "space left"
+ (cons (- 0.0
+ (page-property page 'bottom-edge)
+ (let ((foot (page-property page 'foot-stencil)))
+ (if (and (ly:stencil? foot)
+ (not (ly:stencil-empty? foot)))
+ (car (ly:stencil-extent foot Y))
+ 0.0)))
+ (page-property page 'bottom-system-edge))
+ #t)))
+
(set! arrow (ly:stencil-translate-axis arrow 8 X))
- (ly:stencil-add page-stencil arrow)))
+
+ arrow))
\f
(set! head-stencil
(ly:stencil-combine-at-edge
stencil Y dir head-stencil
- sep 0.0))
+ sep))
;; add arrow markers
- (if (annotate? layout)
+ (if (or (annotate? layout)
+ (ly:output-def-lookup layout 'annotate-headers #f))
(set! head-stencil
(ly:stencil-add
(ly:stencil-translate-axis
(cons (min 0 (* dir sep))
(max 0 (* dir sep)))
#t)
- (/ (ly:output-def-lookup layout 'linewidth) 2)
+ (/ (ly:output-def-lookup layout 'line-width) 2)
X)
(if (= dir UP)
(ly:stencil-translate-axis
(annotate-y-interval layout
- "pagetopspace"
+ "page-top-space"
(cons
(- (min 0 (* dir sep))
- (ly:output-def-lookup layout 'pagetopspace))
+ (ly:output-def-lookup layout 'page-top-space))
(min 0 (* dir sep)))
#t)
(+ 7 (interval-center (ly:stencil-extent head-stencil X))) X)
(define (page-header-or-footer page dir)
(let*
- ((p-book (page-property page 'paper-book))
- (layout (ly:paper-book-paper p-book))
- (scopes (ly:paper-book-scopes p-book))
- (lines (page-lines page))
- (offsets (page-configuration page))
+ ((paper-book (page-property page 'paper-book))
+ (layout (ly:paper-book-paper paper-book))
+ (scopes (ly:paper-book-scopes paper-book))
(number (page-page-number page))
(last? (page-property page 'is-last))
-
)
(page-headfoot layout scopes number
'make-header
'make-footer)
(if (= dir UP)
- 'headsep
- 'footsep)
+ 'head-separation
+ 'foot-separation)
dir last?)))
-(define (page-footer page)
+(define (page-header page)
(page-header-or-footer page UP))
-(define (page-header page)
+(define (page-footer page)
(page-header-or-footer page DOWN))
-(define (make-page-stencil page)
- "Construct a stencil representing the page from LINES.
+(define (layout->page-init layout)
+ "Alist of settings for page layout"
+ (let*
+ ((paper-height (ly:output-def-lookup layout 'paper-height))
+ (paper-width (ly:output-def-lookup layout 'paper-width))
+ (lmargin (ly:output-def-lookup layout 'left-margin #f))
+ (left-margin (if lmargin
+ lmargin
+ (/ (- paper-width
+ (ly:output-def-lookup layout 'line-width)) 2)))
+ (bottom-edge (- paper-height
+ (ly:output-def-lookup layout 'bottom-margin)) )
+ (top-margin (ly:output-def-lookup layout 'top-margin))
+ )
+
+ `((paper-height . ,paper-height)
+ (paper-width . ,paper-width)
+ (left-margin . ,left-margin)
+ (top-margin . ,top-margin)
+ (bottom-edge . ,bottom-edge)
+ )))
- Offsets is a list of increasing numbers. They must be negated to
-create offsets.
- "
+(define (make-page-stencil page)
+ "Construct a stencil representing the page from PAGE."
+
+ (page-translate-systems page)
(let*
- ((p-book (page-property page 'paper-book))
- (layout (ly:paper-book-paper p-book))
- (scopes (ly:paper-book-scopes p-book))
+ ((paper-book (page-property page 'paper-book))
+ (prop (lambda (sym) (page-property page sym)))
+ (layout (ly:paper-book-paper paper-book))
+ (scopes (ly:paper-book-scopes paper-book))
(lines (page-lines page))
- (offsets (page-configuration page))
(number (page-page-number page))
- (last? (page-property page 'is-last))
- (topmargin (ly:output-def-lookup layout 'topmargin))
-
- ;; TODO: naming vsize/hsize not analogous to TeX.
-
- (vsize (ly:output-def-lookup layout 'vsize))
- (hsize (ly:output-def-lookup layout 'hsize))
+ ;; TODO: naming paper-height/paper-width not analogous to TeX.
- (system-xoffset (ly:output-def-lookup layout 'horizontalshift 0.0))
+ (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
(system-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
(system-separator-stencil (if (markup? system-separator-markup)
(interpret-markup layout
(layout-extract-page-properties layout)
system-separator-markup)
#f))
- (lmargin (ly:output-def-lookup layout 'leftmargin))
- (leftmargin (if lmargin
- lmargin
- (/ (- hsize
- (ly:output-def-lookup layout 'linewidth)) 2)))
-
- (rightmargin (ly:output-def-lookup layout 'rightmargin))
- (bottom-edge (- vsize
- (ly:output-def-lookup layout 'bottommargin)))
-
- (head (page-header page))
- (foot (page-footer page))
-
- (head-height (if (ly:stencil? head)
- (interval-length (ly:stencil-extent head Y))
+ (head-height (if (ly:stencil? (prop 'head-stencil))
+ (interval-length (ly:stencil-extent (prop 'head-stencil) Y))
0.0))
- (height-proc (ly:output-def-lookup layout 'page-music-height))
+ (page-stencil (ly:make-stencil '()))
- (page-stencil (ly:make-stencil '()
- (cons leftmargin hsize)
- (cons (- topmargin) 0)))
(last-system #f)
(last-y 0.0)
- (add-to-page (lambda (stencil y)
+ (add-to-page (lambda (stencil x y)
(set! page-stencil
(ly:stencil-add page-stencil
(ly:stencil-translate stencil
(cons
- system-xoffset
- (- 0 head-height y topmargin))
-
+ (+ system-xoffset x)
+ (- 0 head-height y (prop 'top-margin)))
+
)))))
(add-system
- (lambda (stencil-position)
- (let* ((system (car stencil-position))
- (stencil (paper-system-stencil system))
- (y (cadr stencil-position))
+ (lambda (system)
+ (let* ((stencil (paper-system-stencil system))
+ (y (ly:prob-property system 'Y-offset))
(is-title (paper-system-title?
- (car stencil-position))))
- (add-to-page stencil y)
+ system)))
+ (add-to-page stencil
+ (ly:prob-property system 'X-offset 0.0)
+ y)
(if (and (ly:stencil? system-separator-stencil)
last-system
(not (paper-system-title? system))
(not (paper-system-title? last-system)))
(add-to-page
system-separator-stencil
+ 0
(average (- last-y
(car (paper-system-staff-extents last-system)))
(- y
(cdr (paper-system-staff-extents system))))))
(set! last-system system)
(set! last-y y))))
+ (head (prop 'head-stencil))
+ (foot (prop 'foot-stencil))
)
+ (if (and
+ (or (annotate? layout)
+ (ly:output-def-lookup layout 'annotate-systems #f))
+ (pair? lines))
- (if (annotate? layout)
(begin
- (for-each (lambda (sys) (paper-system-annotate sys layout))
- lines)
+ (for-each (lambda (sys next-sys)
+ (paper-system-annotate sys next-sys layout))
+ lines
+ (append (cdr lines) (list #f)))
(paper-system-annotate-last (car (last-pair lines)) layout)))
-
-
- (if #f
- (display (list
- "leftmargin " leftmargin "rightmargin " rightmargin
- )))
-
- (set! page-stencil (ly:stencil-combine-at-edge
- page-stencil Y DOWN
- (if (and
- (ly:stencil? head)
- (not (ly:stencil-empty? head)))
- head
- (ly:make-stencil "" (cons 0 0) (cons 0 0)))
- 0. 0.))
-
- (map add-system (zip lines offsets))
- (if (annotate? layout)
- (set!
- page-stencil
- (annotate-space-left page-stencil layout
- (- bottom-edge
- (if (ly:stencil? foot)
- (interval-length (ly:stencil-extent foot Y))
- 0)))
- ))
+ (if (and
+ (ly:stencil? head)
+ (not (ly:stencil-empty? head)))
+
+ (set! page-stencil (ly:stencil-add page-stencil
+ (ly:stencil-translate-axis head
+ (- 0 head-height (prop 'top-margin)) Y))))
+
+ (map add-system lines)
+
+
+ (ly:prob-set-property! page 'bottom-system-edge
+ (car (ly:stencil-extent page-stencil Y)))
+ (ly:prob-set-property! page 'space-left
+ (+ (prop 'bottom-edge)
+ (prop 'bottom-system-edge)
+ (if (and (ly:stencil? foot)
+ (not (ly:stencil-empty? foot)))
+ (car (ly:stencil-extent foot Y))
+ 0.0)))
+ (if (annotate? layout)
+ (set! page-stencil
+ (ly:stencil-add page-stencil
+ (annotate-space-left page))))
(if (and (ly:stencil? foot)
(not (ly:stencil-empty? foot)))
(ly:stencil-translate
foot
(cons 0
- (+ (- bottom-edge)
+ (+ (- (prop 'bottom-edge))
(- (car (ly:stencil-extent foot Y)))))))))
(set! page-stencil
- (ly:stencil-translate page-stencil (cons leftmargin 0)))
+ (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0)))
;; annotation.
- (if (annotate? layout)
+ (if (or (annotate? layout)
+ (ly:output-def-lookup layout 'annotate-page #f))
(set! page-stencil (annotate-page layout page-stencil)))
-
+
page-stencil))
-
-(define (page-stencil page)
+(define-public (page-stencil page)
(if (not (ly:stencil? (page-property page 'stencil)))
;; todo: make tweakable.
(page-set-property! page 'stencil (make-page-stencil page)))
(page-property page 'stencil))
-(define (page-height page)
+(define (calc-printable-height page)
"Printable area for music and titles; matches default-page-make-stencil."
(let*
- ((p-book (page-property page 'paper-book))
- (layout (ly:paper-book-paper p-book))
- (scopes (ly:paper-book-scopes p-book))
- (number (page-page-number page))
- (last? (page-property page 'is-last))
- (h (- (ly:output-def-lookup layout 'vsize)
- (ly:output-def-lookup layout 'topmargin)
- (ly:output-def-lookup layout 'bottommargin)))
+ ((paper-book (page-property page 'paper-book))
+ (layout (ly:paper-book-paper paper-book))
+ (h (- (ly:output-def-lookup layout 'paper-height)
+ (ly:output-def-lookup layout 'top-margin)
+ (ly:output-def-lookup layout 'bottom-margin)))
- (head (page-headfoot layout scopes number 'make-header 'headsep UP last?))
- (foot (page-headfoot layout scopes number 'make-footer 'footsep DOWN last?))
+ (head (page-property page 'head-stencil))
+ (foot (page-property page 'foot-stencil))
(available
(- h (if (ly:stencil? head)
(interval-length (ly:stencil-extent head Y))
;; (display (list "\n available" available head foot))
available))
+
+(define (page-printable-height page)
+ (if (not (number? (page-property page 'printable-height)))
+ (page-set-property! page 'printable-height (calc-printable-height page)))
+
+ (page-property page 'printable-height))
+
projects / lilypond.git / blobdiff