LilyPond-Ruby 0.0.2.1 → 0.1.2

data/share/lilypond/2.24.1/scm/lily/auto-beam.scm

@@ -0,0 +1,163 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2000--2022 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
+
+;;  Determine whether an auto beam should be extended to the right
+;;  of the current stem.  We start anywhere, except mid-measure in
+;;  3/4 time. We end according to the follwing rules, in order of
+;;  decreasing priority:
+;;
+;;  1. end <type>
+;;  2. end <greater type>
+;;  3. if 1-2 not specified,  end at beatStructure intervals
+;;
+;;  Rationale:
+;;
+;;  [user override]
+;;  1. override for specific duration type
+;;  2. overrides apply to shorter durations
+;;
+;;  defined in scm/time-signature-settings.scm:
+;;  1. Default grouping for common time signatures
+
+(define-public (default-auto-beam-check context dir measure-pos test-beam)
+  (define (get name default)
+    (let ((value (ly:context-property context name)))
+      (if (not (null? value)) value default)))
+
+  (define (ending-moments group-list base-length)
+    (let ((beat 0))
+      (map-in-order (lambda (x)
+                      (set! beat (+ beat x))
+                      (* base-length beat))
+                    group-list)))
+
+  (define (larger-setting type sorted-alist)
+    (assoc type sorted-alist <=))
+
+  (define (beat-end? moment beat-endings)
+    (pair? (memv moment beat-endings)))  ;; member returns a list if found, not #t
+
+  ;; Start of actual auto-beam test routine
+  ;;
+  ;;
+  ;; Don't start auto beams on grace notes
+  (and (or (zero? (ly:moment-grace (ly:context-current-moment context)))
+           (!= dir START))
+       (let* ((base-length (cond ((get 'baseMoment #f) => ly:moment-main)
+                                 (else 1/4)))
+              (measure-length (cond ((get 'measureLength #f) => ly:moment-main)
+                                    (else 1)))
+              (time-signature-fraction
+               (get 'timeSignatureFraction '(4 . 4)))
+              (beat-structure (get 'beatStructure '(1 1 1 1)))
+              (beat-endings (ending-moments beat-structure base-length))
+              (exceptions (sort (map
+                                 (lambda (a)
+                                   (if (pair? (car a))
+                                       (cons (/ (caar a) (cdar a))
+                                             (cdr a))
+                                       a))
+                                 (assoc-get 'end
+                                            (get 'beamExceptions '())
+                                            '()))
+                                car<))
+              (function (if (= dir START) 'begin 'end))
+              (beam-half-measure (get 'beamHalfMeasure #t))
+              (type (ly:moment-main test-beam))
+              (non-grace (ly:moment-main measure-pos))
+              (pos (if (negative? non-grace)
+                       (+ measure-length non-grace)
+                       non-grace))
+              (type-grouping (assoc-get type exceptions '()))
+              (default-rule (and (null? type-grouping)
+                                 (larger-setting type exceptions)))
+              (default-grouping (and default-rule (cdr default-rule)))
+              (default-beat-length (and default-rule (car default-rule)))
+              (exception-grouping (if (null? type-grouping)
+                                      default-grouping
+                                      type-grouping))
+              (grouping-moment (if (null? type-grouping)
+                                   default-beat-length
+                                   type))
+              (exception-moments (and exception-grouping
+                                      (ending-moments
+                                       exception-grouping grouping-moment))))
+
+         (if (= dir START)
+             ;; Start rules -- #t if beam is allowed to start
+             (or beam-half-measure ;; Start anywhere, but option for mid-measure
+                 (not (= (+ pos pos) measure-length))
+                 (not (= 3 (car time-signature-fraction))) ;; in triple meter
+                 (not (= (denominator type) ;; when the beamed note is 1/6 of a measure
+                         (* 2 (cdr time-signature-fraction)))))
+             ;; End rules -- #t if beam is required to end
+             (or (zero? pos) ;; end at measure beginning
+                 (if exception-grouping
+                     (beat-end? pos exception-moments) ;; check exception rule
+                     (beat-end? pos beat-endings))))))) ;; no exception, so check beat ending
+
+
+(define-public (extract-beam-exceptions music)
+  "Create a value useful for setting @code{beamExceptions} from @var{music}."
+  (define (car> a b) (> (car a) (car b)))
+  (define (beatify! lst)
+    ;; takes a collection of end points, sorts them, and returns the
+    ;; non-zero differences as beaming pattern
+    (let ((s (sort-list! lst <)))
+      (remove! zero?
+               (map - s (cons 0 s)))))
+  (let ((res '()))
+    (let analyze ((m (unfold-repeats-fully (event-chord-reduce music)))
+                  (pos 0))
+      ;; enter beam ends from m starting at pos into res, return new pos
+      (cond ((music-is-of-type? m 'bar-check) 0)
+            ((music-is-of-type? m 'simultaneous-music)
+             (fold (lambda (m prev) (max (analyze m pos) prev))
+                   pos
+                   (ly:music-property m 'elements)))
+            ((not (music-is-of-type? m 'rhythmic-event))
+             (let ((elt (ly:music-property m 'element)))
+               (fold analyze
+                     (if (ly:music? elt) (analyze elt pos) pos)
+                     (ly:music-property m 'elements))))
+            ;; Have rhythmic event.
+            ((any
+              (lambda (art)
+                (and (music-is-of-type? art 'beam-event)
+                     (= (ly:music-property art 'span-direction START) STOP)))
+              (ly:music-property m 'articulations))
+             (let* ((len (duration-length (ly:music-property m 'duration)))
+                    (pos (+ pos len))
+                    (ass (assv len res)))
+               (cond ((or (zero? len) (not (integer? (/ pos len))))
+                      (ly:warning m (G_ "Beam end fits no pattern")))
+                     (ass
+                      (set-cdr! ass (cons (/ pos len) (cdr ass))))
+                     (else
+                      (set! res (cons (list len (/ pos len)) res))))
+               pos))
+            (else
+             (+ pos (duration-length (ly:music-property m 'duration))))))
+
+    ;; takes the output from the loop, generates actual beam exceptions
+    (list
+     (cons 'end
+           (map!
+            (lambda (l)
+              (cons (car l)
+                    (beatify! (cdr l))))
+            (sort-list! res car>))))))

data/share/lilypond/2.24.1/scm/lily/autochange.scm

@@ -0,0 +1,100 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2000--2022  Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; autochange.scm - fairly related to part combining.
+
+(define-public (make-autochange-music music . ref-pitch)
+  (define ref-pitch-steps
+    (if (and (pair? ref-pitch) (car ref-pitch))
+        (ly:pitch-steps (car ref-pitch))
+        0))
+  (define (generate-change-music-list
+           prev-change-mom prev-dir rest-mom event-list acc)
+    "@var{prev-change-mom} is the moment (relative to the start of the
+auto-change music) of the previous change added to @var{acc}.
+@var{rest-mom} is the moment (relative to the start of the auto-change
+music) of a potential change at a rest, which is being deferred until
+the direction of subsequent notes is seen.
+"
+    (if (null? event-list)
+        ;; add a final skip so that the length of the music is correct
+        (cons (skip-of-moment-span prev-change-mom rest-mom) acc)
+        ;; event-list is not empty yet
+        (let* ((now-tun (caar event-list))
+               (evs (map car (cdar event-list)))
+               (now (car now-tun))
+               (notes (filter (lambda (x)
+                                (ly:in-event-class? x 'note-event))
+                              evs))
+               (pitch (if (pair? notes)
+                          (ly:event-property (car notes) 'pitch)
+                          #f))
+               (dir (if pitch
+                        (sign
+                         (- (ly:pitch-steps pitch) ref-pitch-steps))
+                        0)))
+          ;; tail recursive.
+          (if (and (not (= dir 0))
+                   (not (= dir prev-dir)))
+              (let* ((change-mom (or rest-mom now))
+                     (skip-music
+                      (skip-of-moment-span prev-change-mom change-mom))
+                     (change-music (make-music
+                                    'ContextChange
+                                    'change-tag '$autoChange
+                                    'change-to-type 'Staff
+                                    'change-to-id (if (< dir 0) "down" "up"))))
+                (generate-change-music-list now
+                                            dir
+                                            #f
+                                            (cdr event-list)
+                                            (cons change-music
+                                                  (cons skip-music
+                                                        acc))))
+              (generate-change-music-list
+               prev-change-mom
+               prev-dir
+               (if pitch #f (or rest-mom now))
+               (cdr event-list) acc)))))
+
+  (let* ((context-list
+          (recording-group-emulate
+           (context-spec-music (make-non-relative-music music) 'Voice "")
+           (ly:parser-lookup 'partCombineListener)))
+         (changes (reverse! (generate-change-music-list
+                             (ly:music-start music)
+                             0
+                             #f
+                             (reverse! (cdar context-list))
+                             '())
+                            '())))
+    ;; \autoChange depends on Simultaneous_music_iterator's processing
+    ;; its children in order (at each timestep) so that context
+    ;; changes occur before notation events.  If
+    ;; Simultaneous_music_iterator's behavior is ever changed, this
+    ;; will need to be changed too.
+    ;;
+    ;; TODO: Is non-relative music necessary here, or only for the
+    ;; analysis above?
+    (context-spec-music
+     (make-music 'SimultaneousMusic
+                 'elements (list (make-sequential-music changes)
+                                 (make-non-relative-music music))
+                 'tags '($autoChange))
+     'Voice "")))