scm/paper.scm

   1 ;;; paper.scm -- scm paper variables and functions
   2 ;;;
   3 ;;;  source file of the GNU LilyPond music typesetter
   4 ;;;
   5 ;;; (c) 1999--2000 Jan Nieuwenhuizen <janneke@gnu.org>
   6
   7 ;;; All dimensions are measured in staff-spaces
   8
   9
  10 ; This is a mess : global namespace pollution. We should wait
  11 ;  till guile has proper toplevel environment support.
  12
  13
  14 ;; Beams should be prevented to conflict with the stafflines,
  15 ;; especially at small slopes
  16 ;;    ----------------------------------------------------------
  17 ;;                                                   ########
  18 ;;                                        ########
  19 ;;                             ########
  20 ;;    --------------########------------------------------------
  21 ;;       ########
  22 ;;
  23 ;;       hang       straddle   sit        inter      hang
  24
  25 ;; inter seems to be a modern quirk, we don't use that
  26
  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)))
  32
  33 ;; Note: quanting period is take as quants.top () - quants[0],
  34 ;; which should be 1 (== 1 interline)
  35
  36 (define beam-normal-dy-quants
  37   (list 0 (/ (+ beam-thickness staff-line) 2) (+ beam-thickness staff-line) 1))
  38
  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))))))
  49
  50 (define (beam-traditional-y-quants multiplicity dy)
  51   (let ((quants '()))
  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))))))
  60
  61
  62 ;; There are several ways to calculate the direction of a beam
  63 ;;
  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
  67
  68 (define (dir-compare up down)
  69   (if (= up down)
  70       0
  71       (if (> up down)
  72           1
  73           -1)))
  74
  75 ;; (up . down)
  76 (define (beam-dir-majority count total)
  77   (dir-compare (car count) (cdr count)))
  78
  79 (define (beam-dir-mean count total)
  80   (dir-compare (car total) (cdr total)))
  81
  82 (define (beam-dir-median count total)
  83   (if (and (> (car count) 0)
  84            (> (cdr count) 0))
  85       (dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
  86       (dir-compare (car count) (cdr count))))
  87
  88
  89 ;;; Default variables and settings
  90
  91 (define beam-height-quants beam-normal-dy-quants)
  92 (define beam-vertical-position-quants beam-normal-y-quants)
  93
  94
  95 ;; [Ross] states that the majority of the notes dictates the
  96 ;; direction (and not the mean of "center distance")
  97 ;;
  98 ;; But is that because it really looks better, or because he wants
  99 ;; to provide some real simple hands-on rules?
 100 ;;
 101 ;; We have our doubts, so we simply provide all sensible alternatives.
 102 (define beam-dir-algorithm beam-dir-majority)
 103
 104
 105 ;; array index flag-2 (what a name!!), last if index>size
 106 ;; unbeamed stems
 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))
 111
 112 ;; array index multiplicity, last if index>size
 113 ;; beamed stems
 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))
 120
 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.
 124
 125 ;; TODO
 126 ;;  - take #forced stems into account (now done in C++)?
 127 ;;  - take y-position of chord or beam into account
 128
 129 (define stem-shorten '(0.5))
 130 (define grace-stem-shorten '(0.0))
 131
 132 ;; urg
 133 (define pi (* 2 (acos 0)))
 134
 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)))))
 139