scm/beam.scm

   1 ;;;;
   2 ;;;; beam.scm -- Beam scheme stuff
   3 ;;;;
   4 ;;;; source file of the GNU LilyPond music typesetter
   5 ;;;;
   6 ;;;; (c) 2000--2001 Jan Nieuwenhuizen <janneke@gnu.org>
   7 ;;;;
   8
   9 (define (default-beam-space-function multiplicity)
  10   (if (<= multiplicity 3) 0.816 0.844)
  11   )
  12
  13 ;;
  14 ;; width in staff space.
  15 ;;
  16 (define (default-beam-flag-width-function type)
  17   (cond
  18    ((eq? type 1) 1.98)
  19    ((eq? type 1) 1.65) ;; FIXME: check what this should be and why
  20    (else 1.32)
  21    ))
  22
  23
  24 ;; This is a mess : global namespace pollution. We should wait
  25 ;;  till guile has proper toplevel environment support.
  26
  27
  28 ;; Beams should be prevented to conflict with the stafflines,
  29 ;; especially at small slopes
  30 ;;    ----------------------------------------------------------
  31 ;;                                                   ########
  32 ;;                                        ########
  33 ;;                             ########
  34 ;;    --------------########------------------------------------
  35 ;;       ########
  36 ;;
  37 ;;       hang       straddle   sit        inter      hang
  38
  39 ;; inter seems to be a modern quirk, we don't use that
  40
  41 ;; two popular veritcal beam quantings
  42 ;; see params.ly: #'beam-vertical-quants
  43
  44
  45 (define (default-beam-pos-quants beam multiplicity dy staff-line)
  46   (let* ((beam-straddle 0)
  47          (thick (ly-get-grob-property beam 'thickness))
  48          (beam-sit (/ (- thick staff-line) 2))
  49          (beam-hang (- 1 (/ (- thick staff-line) 2)))
  50          (quants (list beam-hang))
  51          )
  52
  53     (if (or (<= multiplicity 1) (>= (abs dy) (/ staff-line 2)))
  54         (set! quants (cons beam-sit quants)))
  55     (if (or (<= multiplicity 2) (>= (abs dy) (/ staff-line 2)))
  56         (set! quants (cons beam-straddle quants)))
  57     ;; period: 1 (staff-space)
  58     (append quants (list (+ 1 (car quants))))))
  59
  60 (define (default-left-beam-pos-quants beam multiplicity dir dy staff-line)
  61   (default-beam-pos-quants beam multiplicity 1 staff-line))
  62
  63 (define (foo beam multiplicity dir dy staff-line)
  64   (let* ((beam-straddle 0)
  65          (thick (ly-get-grob-property beam 'thickness))
  66          (beam-sit (/ (- thick staff-line) 2))
  67          (beam-hang (- 1 (/ (- thick staff-line) 2)))
  68          (quants '())
  69          )
  70
  71     (if (or (<= multiplicity 1)
  72             (and (not (equal? dir 1))
  73                  (not (< dy 0))))
  74         (set! quants (cons beam-sit quants)))
  75     (if (or (<= multiplicity 1)
  76             (and (not (equal? dir -1))
  77                  (not (> dy 0))))
  78         (set! quants (cons beam-hang quants)))
  79     (if (or (<= multiplicity 2) (>= (abs dy) (/ staff-line 2)))
  80         (set! quants (cons beam-straddle quants)))
  81     ;; period: 1 (staff-space)
  82     (append quants (list (+ 1 (car quants))))))
  83
  84 (define (default-right-beam-pos-quants beam multiplicity dir dy staff-line)
  85   (default-beam-pos-quants beam multiplicity 1 staff-line))
  86
  87 (define (foo beam multiplicity dir dy staff-line)
  88   (let* ((beam-straddle 0)
  89          (thick (ly-get-grob-property beam 'thickness))
  90          (beam-sit (/ (- thick staff-line) 2))
  91          (beam-hang (- 1 (/ (- thick staff-line) 2)))
  92          (quants '())
  93          )
  94
  95
  96     (if (or (<= multiplicity 1)
  97             (and (not (equal? dir 1))
  98                  (not (> dy 0))))
  99         (set! quants (cons beam-sit quants)))
 100     (if (or (<= multiplicity 1)
 101             (and (not (equal? dir -1))
 102                  (not (< dy 0))))
 103         (set! quants (cons beam-hang quants)))
 104     (if (or (<= multiplicity 2) (>= (abs dy) (/ staff-line 2)))
 105         (set! quants (cons beam-straddle quants)))
 106     ;; period: 1 (staff-space)
 107     (append quants (list (+ 1 (car quants))))))
 108
 109 (define (beam-traditional-pos-quants beam multiplicity dy staff-line)
 110   (let* ((beam-straddle 0)
 111         (thick (ly-get-grob-property beam 'thickness))
 112         (beam-sit (/ (- thick staff-line) 2))
 113         (beam-hang (- 1 (/ (- thick staff-line) 2)))
 114         (quants '())
 115         )
 116     (if (>= dy (/ staff-line -2))
 117         (set! quants (cons beam-hang quants)))
 118     (if (and (<= multiplicity 1) (<= dy (/ staff-line 2)))
 119         (set! quants (cons beam-sit quants)))
 120     (if (or (<= multiplicity 2) (>= (abs dy) (/ staff-line 2)))
 121         (set! quants (cons beam-straddle quants)))
 122     ;; period: 1 (staff-space)
 123     (append quants (list (+ 1 (car quants))))))
 124
 125
 126 ;; There are several ways to calculate the direction of a beam
 127 ;;
 128 ;; * majority: number count of up or down notes
 129 ;; * mean    : mean centre distance of all notes
 130 ;; * median  : mean centre distance weighted per note
 131
 132 (define (dir-compare up down)
 133   (sign (- up down)))
 134
 135 ;; arguments are in the form (up . down)
 136 (define (beam-dir-majority count total)
 137   (dir-compare (car count) (cdr count)))
 138
 139 (beam-dir-majority '(0 . 0) '(0 . 0))
 140
 141 (define (beam-dir-mean count total)
 142   (dir-compare (car total) (cdr total)))
 143
 144 (define (beam-dir-median count total)
 145   (if (and (> (car count) 0)
 146            (> (cdr count) 0))
 147       (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
 148       (dir-compare (car count) (cdr count))))
 149
 150
 151
 152 ;; [Ross] states that the majority of the notes dictates the
 153 ;; direction (and not the mean of "center distance")
 154 ;;
 155 ;; But is that because it really looks better, or because he wants
 156 ;; to provide some real simple hands-on rules?
 157 ;;
 158 ;; We have our doubts, so we simply provide all sensible alternatives.
 159
 160 ;; array index multiplicity, last if index>size
 161 ;; beamed stems
 162
 163
 164 ;; TODO
 165 ;;  - take #forced stems into account (now done in C++)?
 166 ;;  - take staff-position of chord or beam into account
 167