X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fpage.scm;h=a4862198010c206a36b72febae29b8d3ee3aeefa;hb=4908b13c0e8c514699d563a32d84ab477154cd5a;hp=aff8dfa67efa6c219850cf6ea666402c98413760;hpb=0fa943af67565b567d7f99946b6d3cce9188f830;p=lilypond.git

diff --git a/scm/page.scm b/scm/page.scm
index aff8dfa67e..a486219801 100644
--- a/scm/page.scm
+++ b/scm/page.scm
@@ -12,7 +12,8 @@
 	    page-property
 	    page-set-property!
 	    page-prev
-	    page-height
+	    page-printable-height
+	    layout->page-init
 	    page-lines
 	    page-force 
 	    page-penalty
@@ -21,6 +22,7 @@
 	    page-page-number
 	    page-system-numbers
 	    page-stencil
+	    page-free-height
 	    page? 
 	    ))
 
@@ -30,23 +32,29 @@
 
 
 (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
@@ -57,63 +65,79 @@
     (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))
 
 
 
 
-(define (page-headfoot layout scopes number
-		       sym separation-symbol dir last?)
+(define (page-headfoot layout scopes number sym separation-symbol dir
+		       is-last-bookpart is-bookpart-last-page)
   
   "Create a stencil including separating space."
 
@@ -122,9 +146,8 @@
 	 (stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
 	 (head-stencil
 	  (if (procedure? header-proc)
-	      (header-proc layout scopes number last?)
-	      #f))
-	 )
+	      (header-proc layout scopes number is-last-bookpart is-bookpart-last-page)
+	      #f)))
     
     (if (and (number? sep)
 	     (ly:stencil? head-stencil)
@@ -134,11 +157,12 @@
 	  (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
@@ -147,15 +171,15 @@
 					   (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)
@@ -169,151 +193,153 @@
 
 (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))
-
-       )
+       (is-last-bookpart (page-property page 'is-last-bookpart))
+       (is-bookpart-last-page (page-property page 'is-bookpart-last-page)))
        
       (page-headfoot layout scopes number
 		(if (= dir UP)
 		    'make-header
 		    'make-footer)
 		(if (= dir UP)
-		    'headsep
-		    'footsep)
-		dir last?)))
+		    'head-separation
+		    'foot-separation)
+		dir is-last-bookpart is-bookpart-last-page)))
 
-(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-separator-markup (ly:output-def-lookup layout 'systemSeparatorMarkup))
+       (system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
+       (system-separator-markup (ly:output-def-lookup layout 'system-separator-markup))
        (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)))
@@ -323,22 +349,22 @@ create offsets.
 	       (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.
@@ -347,20 +373,17 @@ create offsets.
       (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))
@@ -371,3 +394,10 @@ create offsets.
     
     ;; (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))
+