1 ;;; paper.scm -- scm paper variables and functions
3 ;;; source file of the GNU LilyPond music typesetter
5 ;;; (c) 1999--2000 Jan Nieuwenhuizen <janneke@gnu.org>
7 ;;; All dimensions are measured in staff-spaces
10 ; This is a mess : global namespace pollution. We should wait
11 ; till guile has proper toplevel environment support.
14 ;; Beams should be prevented to conflict with the stafflines,
15 ;; especially at small slopes
16 ;; ----------------------------------------------------------
20 ;; --------------########------------------------------------
23 ;; hang straddle sit inter hang
25 ;; inter seems to be a modern quirk, we don't use that
27 (define staff-line 0.10)
28 (define beam-thickness (* 0.52 (- 1 staff-line)))
29 (define beam-straddle 0)
30 (define beam-sit (/ (+ beam-thickness staff-line) 2))
31 (define beam-hang (- 1 (/ (- beam-thickness staff-line) 2)))
33 ;; Note: quanting period is take as quants.top () - quants[0],
34 ;; which should be 1 (== 1 interline)
36 (define beam-normal-dy-quants
37 (list 0 (/ (+ beam-thickness staff-line) 2) (+ beam-thickness staff-line) 1))
39 ;; two popular veritcal beam quantings
40 ;; see params.ly: #'beam-vertical-quants
41 (define (beam-normal-y-quants multiplicity dy)
42 (let ((quants (list beam-hang)))
43 (if (or (<= multiplicity 1) (>= (abs dy) (/ staff-line 2)))
44 (set! quants (cons beam-sit quants)))
45 (if (or (<= multiplicity 2) (>= (abs dy) (/ staff-line 2)))
46 (set! quants (cons beam-straddle quants)))
47 ;; period: 1 (interline)
48 (append quants (list (+ 1 (car quants))))))
50 (define (beam-traditional-y-quants multiplicity dy)
52 (if (>= dy (/ staff-line -2))
53 (set! quants (cons beam-hang quants)))
54 (if (and (<= multiplicity 1) (<= dy (/ staff-line 2)))
55 (set! quants (cons beam-sit quants)))
56 (if (or (<= multiplicity 2) (>= (abs dy) (/ staff-line 2)))
57 (set! quants (cons beam-straddle quants)))
58 ;; period: 1 (interline)
59 (append quants (list (+ 1 (car quants))))))
62 ;; There are several ways to calculate the direction of a beam
64 ;; * majority: number count of up or down notes
65 ;; * mean : mean centre distance of all notes
66 ;; * median : mean centre distance weighted per note
68 (define (dir-compare up down)
76 (define (beam-dir-majority count total)
77 (dir-compare (car count) (cdr count)))
79 (define (beam-dir-mean count total)
80 (dir-compare (car total) (cdr total)))
82 (define (beam-dir-median count total)
83 (if (and (> (car count) 0)
85 (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
86 (dir-compare (car count) (cdr count))))
89 ;;; Default variables and settings
91 (define beam-height-quants beam-normal-dy-quants)
92 (define beam-vertical-position-quants beam-normal-y-quants)
95 ;; [Ross] states that the majority of the notes dictates the
96 ;; direction (and not the mean of "center distance")
98 ;; But is that because it really looks better, or because he wants
99 ;; to provide some real simple hands-on rules?
101 ;; We have our doubts, so we simply provide all sensible alternatives.
102 (define beam-dir-algorithm beam-dir-majority)
105 ;; array index flag-2 (what a name!!), last if index>size
107 (define stem-length '(3.5 3.5 3.5 4.5 5.0))
108 (define grace-length-factor 0.8)
109 (define grace-stem-length
110 (map (lambda (x) (* grace-length-factor x)) stem-length))
112 ;; array index multiplicity, last if index>size
114 (define beamed-stem-shorten '(0.5))
115 (define beamed-stem-length '(0.0 2.5 2.0 1.5))
116 (define grace-beamed-stem-length '(0.0 2.5 2.0 1.5))
117 (define beamed-stem-minimum-length '(0.0 1.5 1.25 1.0))
118 (define grace-beamed-stem-minimum-length
119 (map (lambda (x) (* grace-length-factor x)) beamed-stem-minimum-length))
121 ;; Stems in unnatural (forced) direction should be shortened,
122 ;; according to [Roush & Gourlay]. Their suggestion to knock off
123 ;; a whole staffspace seems a bit drastical: we'll do half.
126 ;; - take #forced stems into account (now done in C++)?
127 ;; - take y-position of chord or beam into account
129 (define stem-shorten '(0.5))
130 (define grace-stem-shorten '(0.0))
133 (define pi (* 2 (acos 0)))
135 (define (slur-default-height h-inf r-0 b)
136 (let ((alpha (/ (* 2.0 h-inf) pi))
137 (beta (/ (* pi r-0) (* 2.0 h-inf))))
138 (* alpha (atan (* beta b)))))