From: Han-Wen Nienhuys <hanwen@xs4all.nl>
Date: Sun, 2 Oct 2005 01:16:08 +0000 (+0000)
Subject: * scm/lily-library.scm (interval-translate): new function
X-Git-Tag: release/2.7.11~1
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=d372176add53661074bf57362acbdf31eb8350cb;p=lilypond.git

* scm/lily-library.scm (interval-translate): new function
(interval-center): new function.

* scm/page-layout.scm (paper-system-annotate): new function. Add
arrows for dimensions.

* scm/stencil.scm (dimension-arrows): new function.

* Documentation/user/global.itely (Vertical spacing): mention annotatespacing

* input/regression/page-spacing.ly: add annotatespacing

* lily/paper-system-scheme.cc (LY_DEFINE): remove ly:paper-system-{extent,stencil}
(LY_DEFINE): new function ly:paper-system-set-property!

* Documentation/user/global.itely (Paper size): explain how to add
sizes.
---

diff --git a/ChangeLog b/ChangeLog
index 1c65215b0d..512c76805f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,19 @@
 2005-10-02  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 
+	* scm/lily-library.scm (interval-translate): new function
+	(interval-center): new function. 
+
+	* scm/page-layout.scm (paper-system-annotate): new function. Add
+	arrows for dimensions.
+ 
+	* scm/stencil.scm (dimension-arrows): new function.
+
+	* Documentation/user/global.itely (Vertical spacing): mention annotatespacing
+
+	* input/regression/page-spacing.ly: add annotatespacing
+
 	* lily/paper-system-scheme.cc (LY_DEFINE): remove ly:paper-system-{extent,stencil}
+	(LY_DEFINE): new function ly:paper-system-set-property!
 
 	* Documentation/user/global.itely (Paper size): explain how to add
 	sizes.
diff --git a/Documentation/user/global.itely b/Documentation/user/global.itely
index a2bc344061..150b6d85c5 100644
--- a/Documentation/user/global.itely
+++ b/Documentation/user/global.itely
@@ -340,6 +340,7 @@ top-most of the next system.
 Increasing this will put systems whose bounding boxes almost touch
 farther apart.
 
+
 @cindex @code{horizontalshift}
 @item horizontalshift
 All systems (including titles and system separators) are shifted by
@@ -529,6 +530,16 @@ The vertical spacing on a page can also be changed for each system individually.
 Some examples are found in the example file
 @inputfileref{input/regression/,page-spacing.ly}.
 
+When setting @code{annotatespacing} in the @code{\paper} block LilyPond
+will graphically indicate the dimensions of properties that may be set
+for page spacing,
+
+@lilypond[verbatim]
+\paper { annotatespacing = ##t }
+{ c4 }
+@end lilypond
+
+
 
 @seealso
 
diff --git a/input/mutopia/J.S.Bach/baerenreiter-sarabande.ly b/input/mutopia/J.S.Bach/baerenreiter-sarabande.ly
index 1724d21f3a..bfe8bbe133 100644
--- a/input/mutopia/J.S.Bach/baerenreiter-sarabande.ly
+++ b/input/mutopia/J.S.Bach/baerenreiter-sarabande.ly
@@ -174,6 +174,8 @@ smallerPaper = \layout {
   linewidth =183.5 \mm
   betweensystemspace = 25\mm 
   betweensystempadding = 0\mm
+
+%%  annotatespacing = ##t
 }
 
 \book {
diff --git a/input/regression/page-spacing.ly b/input/regression/page-spacing.ly
index 015ad62285..08c102af4c 100644
--- a/input/regression/page-spacing.ly
+++ b/input/regression/page-spacing.ly
@@ -8,6 +8,7 @@ For technical reasons, @code{outputProperty} has to be used for
 setting properties on individual object. @code{\override} may still be
 used for global overrides.
 
+By setting @code{annotatespacing}, we can see the effect of each property.
 "
 
 }
@@ -66,6 +67,7 @@ used for global overrides.
   }
   \paper {
     raggedlastbottom = ##f
+    annotatespacing = ##t
     betweensystemspace = 1.0
     #(set! text-font-defaults
       (acons
diff --git a/lily/line-interface.cc b/lily/line-interface.cc
index fab325528f..a938017616 100644
--- a/lily/line-interface.cc
+++ b/lily/line-interface.cc
@@ -146,4 +146,10 @@ ADD_INTERFACE (Line_interface, "line-interface",
 	       "produced. If @code{dash-fraction} is negative, the line is made "
 	       "transparent.",
 
-	       "dash-period dash-fraction thickness style arrow-length arrow-width")
+	       /* properties */
+	       "dash-period "
+	       "dash-fraction "
+	       "thickness "
+	       "style "
+	       "arrow-length "
+	       "arrow-width")
diff --git a/lily/paper-system-scheme.cc b/lily/paper-system-scheme.cc
index f61c5a0534..2baaceef4b 100644
--- a/lily/paper-system-scheme.cc
+++ b/lily/paper-system-scheme.cc
@@ -8,7 +8,16 @@
 
 #include "paper-system.hh"
 
+LY_DEFINE (ly_paper_system_set_property_x, "ly:paper-system-set-property!",
+	   2, 1, 0, (SCM system, SCM sym, SCM value),
+	   "Set property @var{sym} of @var{system} to @var{value}")
+{
+  Paper_system *ps = unsmob_paper_system (system);
+  SCM_ASSERT_TYPE (ps, system, SCM_ARG1, __FUNCTION__, "paper-system");
 
+  ps->internal_set_property (sym, value);
+  return SCM_UNSPECIFIED;
+}
 
 LY_DEFINE (ly_paper_system_property, "ly:paper-system-property",
 	   2, 1, 0, (SCM system, SCM sym, SCM dfault),
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index 6e00f7a3d7..748ef92cfb 100644
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -267,7 +267,7 @@ gsave /ecrm10 findfont
   (let* ((output (ly:score-embedded-format score layout)))
 
     (if (ly:music-output? output)
-	(ly:paper-system-stencil
+	(paper-system-stencil
 	 (vector-ref (ly:paper-score-paper-systems output) 0))
 	(begin
 	  (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
@@ -1224,3 +1224,9 @@ the elements marked in @var{indices}, which is a list of numbers."
 
     (apply ly:stencil-add
 	   (append stacked brackets))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; size indications arrow
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
diff --git a/scm/framework-eps.scm b/scm/framework-eps.scm
index 658f2cd47f..01a09a5a87 100644
--- a/scm/framework-eps.scm
+++ b/scm/framework-eps.scm
@@ -98,7 +98,7 @@ stencil, so LaTeX includegraphics doesn't fuck up the alignment."
   (output-scopes scopes fields basename)
   
   (dump-stencils-as-EPSes
-   (map ly:paper-system-stencil (ly:paper-book-systems book))
+   (map paper-system-stencil (ly:paper-book-systems book))
    book
    basename))
 
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index 125fd8645f..a6e60d48c9 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -514,7 +514,7 @@
     (dump-stencil-as-EPS
      paper
      (stack-stencils Y DOWN 0.0
-		     (map ly:paper-system-stencil (reverse to-dump-systems)))
+		     (map paper-system-stencil (reverse to-dump-systems)))
      (format "~a.preview" basename)
      #t)
 
@@ -532,7 +532,7 @@
 				(not (paper-system-title? x))) systems))
 	     (dump-me
 	      (stack-stencils Y DOWN 0.0
-			      (map ly:paper-system-stencil
+			      (map paper-system-stencil
 				   (append titles (list non-title))))))
 	(output-scopes scopes fields basename)
 	(dump-stencil-as-EPS paper dump-me
diff --git a/scm/framework-socket.scm b/scm/framework-socket.scm
index 799e95d77b..6467835100 100644
--- a/scm/framework-socket.scm
+++ b/scm/framework-socket.scm
@@ -23,7 +23,7 @@
 
     (if (pair? systems)
 	(ly:outputter-dump-stencil outputter
-				   (ly:paper-system-stencil (car systems))))
+				   (paper-system-stencil (car systems))))
     ))
 
 (define-public output-classic-framework output-framework)
diff --git a/scm/framework-tex.scm b/scm/framework-tex.scm
index 7da550ef6a..3f2821b783 100644
--- a/scm/framework-tex.scm
+++ b/scm/framework-tex.scm
@@ -222,7 +222,7 @@
 	   (ly:number->string
 	    (interval-length (paper-system-extent line Y)))))
 
-  (ly:outputter-dump-stencil putter (ly:paper-system-stencil line))
+  (ly:outputter-dump-stencil putter (paper-system-stencil line))
   (ly:outputter-dump-string
    putter
    (if last?
diff --git a/scm/framework-texstr.scm b/scm/framework-texstr.scm
index 7fd5294b49..0c5488e0ab 100644
--- a/scm/framework-texstr.scm
+++ b/scm/framework-texstr.scm
@@ -40,7 +40,7 @@
     (ly:outputter-dump-string outputter (header basename))
     (for-each
      (lambda (system)
-       (ly:outputter-dump-stencil outputter (ly:paper-system-stencil system)))
+       (ly:outputter-dump-stencil outputter (paper-system-stencil system)))
      lines)
     (ly:outputter-dump-string outputter (footer))))
 
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 93af42793a..bac5d0467f 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -120,8 +120,11 @@
   (equal? #t (ly:paper-system-property system 'is-title)
 	  ))
 
+(define-public (paper-system-stencil system)
+  (ly:paper-system-property system 'stencil))
+
 (define-public (paper-system-extent system axis)
-  (ly:stencil-extent (ly:paper-system-property system 'stencil) axis))
+  (ly:stencil-extent (paper-system-stencil system) axis))
 
 ;;;;;;;;;;;;;;;;
 ;; alist
@@ -323,6 +326,16 @@ found."
 (define-public interval-start car)
 (define-public interval-end cdr)
 
+(define-public (interval-center x)
+  "Center the number-pair X, when an interval"
+  (/ (+ (car x) (cdr x)) 2))
+
+(define-public interval-start car)
+(define-public interval-end cdr)
+(define-public (interval-translate iv amount)
+  (cons (+ amount (car iv))
+	(+ amount (cdr iv))))
+
 (define (other-axis a)
   (remainder (+ a 1) 2))
 
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 2fe0bc373a..d30c668bf3 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -16,10 +16,16 @@
   (make-procedure-with-setter ly:music-property
 			      ly:music-set-property!))
 
+
+;; TODO move this
 (define-public ly:grob-property
   (make-procedure-with-setter ly:grob-property
 			      ly:grob-set-property!))
 
+(define-public ly:paper-system-property
+  (make-procedure-with-setter ly:paper-system-property
+			      ly:paper-system-set-property!))
+
 (define-public (music-map function music)
   "Apply @var{function} to @var{music} and all of the music it contains.
 
diff --git a/scm/page-layout.scm b/scm/page-layout.scm
index 50dfbcd9d8..4c48fb6ceb 100644
--- a/scm/page-layout.scm
+++ b/scm/page-layout.scm
@@ -37,6 +37,99 @@
   (ly:paper-system-property ps 'refpoint-Y-extent '(0 . 0)))
 
 
+
+(define (paper-system-annotate system layout)
+  "Add arrows and texts to indicate which lengths are set."
+  (let*
+      ((annotations (ly:make-stencil '() (cons 0 2) (cons 0 0)))
+       (text-props (cons
+		    '((font-size . -3)
+		      (font-family . typewriter)
+		      )
+		   (layout-extract-page-properties layout)))
+       (append-stencil
+	(lambda (a b)
+	  (ly:stencil-combine-at-edge a X RIGHT b 0.5 0)))
+
+       (annotate-property
+	(lambda (name extent is-length?)
+
+	  ;; do something sensible for 0,0 intervals. 
+	  (set! extent (interval-widen extent 0.001))
+	  (let*
+	      ((annotation (interpret-markup
+			    layout text-props
+			    (make-column-markup
+			     (list
+			      (make-whiteout-markup (make-simple-markup name))
+			      (make-whiteout-markup
+			       (make-simple-markup
+				(if is-length?
+				    (format "~$" (interval-length extent))
+				    (format "(~$,~$)" (car extent) (cdr extent)))))))))
+	    
+	       
+	       (arrows
+		(ly:stencil-translate-axis 
+		 (dimension-arrows (cons 0 (interval-length extent)))
+		 (interval-start extent) Y))
+	       )
+
+	    (set! annotation
+		  (ly:stencil-aligned-to annotation Y CENTER))
+	    (set! annotation
+		  (ly:stencil-translate annotation (cons 0 (interval-center extent))))
+
+
+	    (set! annotations
+		  (append-stencil annotations
+				  (append-stencil arrows annotation))))))
+
+
+       (bbox-extent (paper-system-extent system Y))
+       (refp-extent (ly:paper-system-property system 'refpoint-Y-extent))
+       (next-space (ly:paper-system-property system 'next-space
+					     (ly:output-def-lookup layout 'betweensystemspace)
+					     ))
+       (next-padding (ly:paper-system-property system 'next-padding
+					       (ly:output-def-lookup layout 'betweensystempadding)
+					       ))
+		     
+       )
+
+    (if (number-pair? bbox-extent) 
+	(annotate-property "Y-extent"
+			   bbox-extent #f))
+
+    ;; titles don't have a refpoint-Y-extent.
+    (if (number-pair? refp-extent)
+	(begin
+	  (annotate-property "refpoint-Y-extent"
+			     refp-extent #f)
+	
+	  (annotate-property "next-space"
+			     (interval-translate (cons (- next-space) 0) (car refp-extent))
+		       #t)))
+	
+    
+    (annotate-property "next-padding"
+		       (interval-translate (cons (- next-padding) 0) (car bbox-extent))
+		       #t)
+    
+
+    (set! (ly:paper-system-property system 'stencil)
+	  (ly:stencil-add
+	   (ly:paper-system-property system 'stencil)
+	   (ly:make-stencil
+	    (ly:stencil-expr annotations)
+	    (ly:stencil-extent empty-stencil X)
+	    (ly:stencil-extent empty-stencil Y)
+	    )))
+    
+    ))
+
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define (page-headfoot layout scopes number sym sepsym dir last?)
@@ -85,6 +178,9 @@
 create offsets.
  "
 
+  (if (eq? #t (ly:output-def-lookup layout 'annotatespacing))
+      (for-each (lambda (sys) (paper-system-annotate sys layout))
+		lines))
   (let* ((topmargin (ly:output-def-lookup layout 'topmargin))
 
        ;; TODO: naming vsize/hsize not analogous to TeX.
@@ -135,7 +231,7 @@ create offsets.
 	 (add-system
 	  (lambda (stencil-position)
 	    (let* ((system (car stencil-position))
-		   (stencil (ly:paper-system-stencil system))
+		   (stencil (paper-system-stencil system))
 		   (y (cadr stencil-position))
 		   (is-title (paper-system-title?
 			      (car stencil-position))))
diff --git a/scm/safe-lily.scm b/scm/safe-lily.scm
index 2ef10c89a2..d5851fd20b 100644
--- a/scm/safe-lily.scm
+++ b/scm/safe-lily.scm
@@ -100,7 +100,6 @@
    ly:layout-def?
    ly:paper-get-font
    ly:paper-get-number
-   ly:paper-system-stencil
    ly:paper-system?
    ly:output-def-lookup
    ly:parse-string
diff --git a/scm/stencil.scm b/scm/stencil.scm
index 7d93738ef1..4cc57b39fd 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -115,3 +115,50 @@ encloses the contents.
          (c `(white-text ,(* 2 scale) ,text)))
     ;;urg -- extent is not from ps font, but we hope it's close
     (ly:make-stencil c (car b) (cdr b))))
+
+(define-public (dimension-arrows destination) 
+  "Draw twosided arrow from here to @var{destination}"
+  
+  (let*
+      ((e_x 1+0i)
+       (e_y 0+1i)
+       (rotate (lambda (z ang)
+		 (* (make-polar 1 ang)
+		    z)))
+       (complex-to-offset (lambda (z)
+			    (list (real-part z) (imag-part z))))
+       
+       (z-dest (+ (* e_x (car destination)) (* e_y (cdr destination))))
+       (triangle-points '(-1+0.25i
+			  0
+			  -1-0.25i))
+       (p1s (map (lambda (z)
+		   (+ z-dest (rotate z (angle z-dest))))
+		 triangle-points))
+       (p2s (map (lambda (z)
+		   (rotate z (angle (- z-dest))))
+		   triangle-points))
+       (null (cons 0 0)) 
+       (arrow-1  
+	(ly:make-stencil
+	 `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
+		   0.0
+		   #t) null null))
+       (arrow-2
+	(ly:make-stencil
+	 `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
+		   0.0
+		   #t) null null ) )
+       (line (ly:make-stencil
+	      `(draw-line 0.1 0 0
+			  ,(car destination)
+			  ,(cdr destination))
+	      (cons (min 0 (car destination))
+		    (min 0 (cdr destination)))
+	      (cons (max 0 (car destination))
+		    (max 0 (cdr destination)))))
+		    
+       (result (ly:stencil-add arrow-2 arrow-1 line)))
+
+
+    result))