scm/slur.scm

   1 ;;;;
   2 ;;;; slur.scm -- Slur 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 (define (attached-to-stem slur dir)
  10   (let* ((note-columns (ly:grob-property slur 'note-columns))
  11          (col (if (= dir 1) (car note-columns) (car (last-pair note-columns))))
  12          (stem (ly:grob-property col 'stem)))
  13     (and
  14      (eq? col (ly:spanner-get-bound slur dir))
  15      (ly:grob? stem)
  16      (ly:grob-property stem 'heads))))
  17
  18
  19 ;;
  20 ;; Currently, we have attachments:
  21 ;;
  22 ;;    'head 'along-side-stem 'stem 'loose-end
  23 ;;
  24 (define (calc-slur-extremity slur dir)
  25   (let* ((note-columns (ly:grob-property slur 'note-columns))
  26          (col (car (if (= dir 1) note-columns (reverse note-columns))))
  27          (stem (ly:grob-property col 'stem)))
  28
  29
  30    (cond
  31     ((< (length note-columns) 1) 'head)
  32     ((not (attached-to-stem slur dir)) 'loose-end)
  33     ((and stem
  34           (not (equal? (ly:grob-property slur 'direction)
  35                        (ly:grob-property stem 'direction))))  'head)
  36     ((and (attached-to-stem slur dir)
  37           (ly:grob? stem)
  38           (ly:grob? (ly:grob-property stem 'beam))
  39           ;; and beam on same side as slur
  40           (equal?
  41            (ly:grob-property stem 'direction)
  42            (ly:grob-property slur 'direction)))
  43      'stem)
  44     ((not (attached-to-stem slur dir))  'loose-end)
  45     (else 'head))
  46    ))
  47
  48
  49 ;; This list defines the offsets for each type of attachment.
  50 ;; The format of each element is
  51 ;; (attachment stem-dir*dir slur-dir*dir)
  52 ;; Different attachments have different default points:
  53 ;;
  54 ;; head: Default position is centered in X, on outer side of head Y
  55 ;; along-side-stem: Default position is on stem X, on outer side of head Y
  56 ;; stem: Default position is on stem X, at stem end Y
  57 (define default-slur-extremity-offset-alist
  58   '(
  59     ((head 1 1) . (-0.25 . 0.75))
  60     ((head 1 -1) . (-0.25 . 0.75))
  61     ((head -1 1) . (-0.25 . 0.75))
  62     ((head -1 -1) . (-0.85 . 0.75))
  63
  64     ((stem 1 1) . (-0.125 . 0.5))
  65     ((stem -1 -1) . (-0.125 . 0.5))
  66
  67     ((loose-end 1 1) . (-0.4 . 0))
  68     ((loose-end 1 -1) . (-0.4 . 0))
  69     ((loose-end -1 -1) . (-4 . 0))
  70     ((loose-end -1 1) . (-4 . 0))
  71     ))
  72
  73 ;; This is a bit of a hack: slurs and phrasing slurs
  74 ;; attaching at the same note must not collide.
  75 ;; However, slurs (and phrasing slurs) should look
  76 ;; at scripts and eachother.
  77 (define default-phrasing-slur-extremity-offset-alist
  78   '(
  79     ((head 1 1) . (-0.25 . 1.25))
  80     ((head 1 -1) . (-0.25 . 1.25))
  81     ((head -1 1) . (-0.25 . 1.25))
  82     ((head -1 -1) . (-0.85 . 1.25))
  83
  84     ((stem 1 1) . (-0.25 . 1.5))
  85     ((stem -1 -1) . (-0.25 . 1.5))
  86
  87     ((loose-end 1 1) . (-0.4 . 0))
  88     ((loose-end 1 -1) . (-0.4 . 0))
  89     ((loose-end -1 -1) . (-4 . 0))
  90     ((loose-end -1 1) . (-4 . 0))
  91     ))
  92
  93