scm/beam.scm

   1 ;;;;
   2 ;;;; beam.scm -- Beam scheme stuff
   3 ;;;;
   4 ;;;; source file of the GNU LilyPond music typesetter
   5 ;;;;
   6 ;;;; (c)  2000--2004 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;;
   8
   9 ;;
  10 ;; width in staff space.
  11 ;;
  12 (define (beam-flag-width-function type)
  13   (cond
  14    ((eq? type 1) 1.98)
  15    ((eq? type 1) 1.65) ;; FIXME: check what this should be and why
  16    (else 1.32)))
  17
  18 ;; There are several ways to calculate the direction of a beam
  19 ;;
  20 ;; * majority: number count of up or down notes
  21 ;; * mean    : mean centre distance of all notes
  22 ;; * median  : mean centre distance weighted per note
  23 ;;
  24 ;; [Ross] states that the majority of the notes dictates the
  25 ;; direction (and not the mean of "center distance")
  26 ;;
  27 ;; But is that because it really looks better, or because he wants
  28 ;; to provide some real simple hands-on rules?
  29 ;;
  30 ;; We have our doubts, so we simply provide all sensible alternatives.
  31
  32
  33 ;;
  34 ;
  35 ; DOCME: what goes into this func, what comes out.
  36
  37 (define (dir-compare up down)
  38   (sign (- up down)))
  39
  40 ;; arguments are in the form (up . down)
  41 (define-public (beam-dir-majority count total)
  42   (dir-compare (car count) (cdr count)))
  43
  44 (define-public (beam-dir-majority-median count total)
  45   "First try majority. If that doesn't work, try median."
  46   (let ((maj (dir-compare (car count) (cdr count))))
  47     (if (not (= maj 0))
  48         maj
  49         (beam-dir-median count total))
  50     ))
  51
  52
  53 (define-public (beam-dir-mean count total)
  54   (dir-compare (car total) (cdr total)))
  55
  56 (define-public (beam-dir-median count total)
  57   (if (and (> (car count) 0)
  58            (> (cdr count) 0))
  59       (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
  60       (dir-compare (car count) (cdr count))))
  61
  62
  63 (define ((check-beam-quant posl posr) beam)
  64   "Check whether BEAM has POSL and POSR quants.  POSL are (POSITION
  65 . QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter)
  66
  67 "
  68   (let*
  69       ((posns (ly:grob-property beam 'positions))
  70        (thick (ly:grob-property beam 'thickness))
  71        (paper (ly:grob-paper beam))
  72        (lthick (ly:output-def-lookup paper 'linethickness))
  73        (staff-thick lthick) ; fixme.
  74        (quant->coord (lambda (p q)
  75                        (if (= 2 (abs q))
  76                            (+ p (/ q 4.0))
  77                            (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
  78        (want-l (quant->coord (car posl) (cdr posl)))
  79        (want-r (quant->coord (car posr) (cdr posr)))
  80        (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
  81
  82     (if (or (not (almost-equal want-l (car posns)))
  83             (not (almost-equal want-r (cdr posns))))
  84         (begin
  85           (ly:warn
  86            (format "Error in beam quanting found. Want (~S,~S) found (~S)."
  87                    want-l want-r posns
  88                    ))
  89           (set! (ly:grob-property beam 'quant-score)
  90                 (format "(~S,~S)" want-l want-r)))
  91         (set! (ly:grob-property beam 'quant-score) "")
  92
  93
  94           )))
  95
  96 (define-public (check-quant-callbacks l r)
  97   (list Beam::least_squares
  98     Beam::check_concave
  99     Beam::slope_damping
 100     Beam::shift_region_to_valid
 101     Beam::quanting
 102     (check-beam-quant l r)
 103     ))
 104
 105