]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/layout-beam.scm
Revert "Apply scripts/auxiliar/fixscm.sh"
[lilypond.git] / scm / layout-beam.scm
index fe4fa4df438131935c1cbbfc9252e4f56b3c94ca..f72afacf0dd1c8ffbcc5972ff760a40e375906e7 100644 (file)
 (define check-beam-quant
   (lambda (posl posr)
     (lambda (beam posns)
-      "Check whether BEAM has POSL and POSR quants.  POSL are (POSITION
-. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter)
+  "Check whether BEAM has POSL and POSR quants.  POSL are (POSITION
+. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter) 
 
 "
-      (let* ((thick (ly:grob-property beam 'beam-thickness))
-             (layout (ly:grob-layout beam))
-             (lthick (ly:output-def-lookup layout 'line-thickness))
-             (staff-thick lthick) ; fixme.
-             (quant->coord (lambda (p q)
-                             (if (= 2 (abs q))
-                                 (+ p (/ q 4.0))
-                                 (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
-             (want-l (quant->coord (car posl) (cdr posl)))
-             (want-r (quant->coord (car posr) (cdr posr)))
-             (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
-
-        (if (or (not (almost-equal want-l (car posns)))
-                (not (almost-equal want-r (cdr posns))))
-            (begin
-              (ly:warning (_ "Error in beam quanting.  Expected (~S,~S) found ~S.")
-                          want-l want-r posns)
-              (set! (ly:grob-property beam 'annotation)
-                    (format #f "(~S,~S)" want-l want-r))))
-        posns))))
+  (let* ((thick (ly:grob-property beam 'beam-thickness))
+        (layout (ly:grob-layout beam))
+        (lthick (ly:output-def-lookup layout 'line-thickness))
+        (staff-thick lthick) ; fixme.
+        (quant->coord (lambda (p q)
+                        (if (= 2 (abs q))
+                            (+ p (/ q 4.0))
+                            (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
+        (want-l (quant->coord (car posl) (cdr posl))) 
+        (want-r (quant->coord (car posr) (cdr posr)))
+        (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
+    
+    (if (or (not (almost-equal want-l (car posns)))
+           (not (almost-equal want-r (cdr posns))))
+       (begin
+         (ly:warning (_ "Error in beam quanting.  Expected (~S,~S) found ~S.")
+                     want-l want-r posns)
+         (set! (ly:grob-property beam 'annotation)
+               (format #f "(~S,~S)" want-l want-r))))
+    posns))))
 
 (define check-beam-slope-sign
   (lambda (comparison)
     (lambda (beam posns)
-      "Check whether the slope of BEAM is correct wrt. COMPARISON."
-      (let* ((slope-sign (- (cdr posns) (car posns)))
-             (correct (comparison slope-sign 0)))
-        (if (not correct)
-            (begin
-              (ly:warning (_ "Error in beam quanting.  Expected ~S 0, found ~S.")
-                          (procedure-name comparison) slope-sign)
-              (set! (ly:grob-property beam 'annotation)
-                    (format #f "~S 0" (procedure-name comparison))))
-            (set! (ly:grob-property beam 'annotation) ""))
-        posns))))
+  "Check whether the slope of BEAM is correct wrt. COMPARISON."
+  (let* ((slope-sign (- (cdr posns) (car posns)))
+        (correct (comparison slope-sign 0)))
+    (if (not correct)
+       (begin
+         (ly:warning (_ "Error in beam quanting.  Expected ~S 0, found ~S.")
+                     (procedure-name comparison) slope-sign)
+         (set! (ly:grob-property beam 'annotation)
+               (format #f "~S 0" (procedure-name comparison))))
+       (set! (ly:grob-property beam 'annotation) ""))
+    posns))))
 
 
 (define-public (check-quant-callbacks l r)
   (lambda (grob)
     ((check-beam-quant l r)
-     grob
-     (beam::place-broken-parts-individually grob))))
+       grob
+       (beam::place-broken-parts-individually grob))))
 
 
 (define-public (check-slope-callbacks comparison)
   (lambda (grob)
     ((check-beam-slope-sign comparison)
-     grob
-     (beam::place-broken-parts-individually grob))))
+       grob
+       (beam::place-broken-parts-individually grob))))