LilyPond-Ruby 0.1.1 → 0.1.2

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

@@ -0,0 +1,78 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2007--2022 Joe Neeman <joeneeman@gmail.com>
+;;;;
+;;;; 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/>.
+
+
+(define-module (lily graphviz)
+  #:use-module (lily)
+  #:export
+  (make-empty-graph add-node add-edge add-cluster
+                    graph-write
+                    ))
+
+(define graph-type (make-record-type "graph" '(nodes edges clusters name)))
+
+(define make-graph (record-constructor graph-type))
+(define (make-empty-graph name) (make-graph '() '() '() name))
+
+(define nodes (record-accessor graph-type 'nodes))
+(define edges (record-accessor graph-type 'edges))
+(define clusters (record-accessor graph-type 'clusters))
+(define set-nodes! (record-modifier graph-type 'nodes))
+(define set-edges! (record-modifier graph-type 'edges))
+(define set-clusters! (record-modifier graph-type 'clusters))
+
+(define (add-cluster graph node-id cluster-name)
+  (let* ((cs (clusters graph))
+         (cluster (assoc cluster-name cs))
+         (already-in-cluster (if cluster
+                                 (cdr cluster)
+                                 '())))
+    (set-clusters! graph (assoc-set! cs
+                                     cluster-name
+                                     (cons node-id already-in-cluster)))))
+
+(define (add-node graph label . cluster-name)
+  (let* ((ns (nodes graph))
+         (id (length ns)))
+    (set-nodes! graph (assv-set! ns id label))
+    (if (and (not (null? cluster-name))
+             (string? (car cluster-name)))
+        (add-cluster graph id (car cluster-name)))
+    id))
+
+(define (add-edge graph node1 node2)
+  (set-edges! graph (cons `(,node1 . ,node2) (edges graph))))
+
+(define (graph-write graph out)
+  (let ((ns (nodes graph))
+        (es (edges graph))
+        (cs (clusters graph)))
+    (if (file-port? out)
+        (ly:message (G_ "Writing graph to `~a'...\n") (port-filename out)))
+    (display "digraph G {\nrankdir=\"LR\"\nnode [shape=rectangle]\n" out)
+    (for-each (lambda (n) (format out "~a [label=\"~a\"]\n" (car n) (cdr n)))
+              ns)
+    (for-each (lambda (e) (format out "~a -> ~a\n" (car e) (cdr e)))
+              es)
+    (for-each (lambda (c)
+                (format out "subgraph cluster_~a {\nlabel= \"~a\"\ncolor=blue\n"
+                        (string-filter char-alphabetic? (car c))
+                        (car c))
+                (for-each (lambda (n) (format out "~a\n" n)) (cdr c))
+                (display "}\n" out))
+              cs)
+    (display "}" out)))

data/share/lilypond/2.24.1/scm/lily/guile-debugger.scm

@@ -0,0 +1,90 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2010--2022 Ian Hulin <ian@hulin.org.uk>
+;;;;
+;;;; 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/>.
+
+;;; Commentary:
+
+;;; This file provides the support routines for a guile debugger called
+;;; from an environment controlled by LilyPond.  It works in conjunction
+;;; with file guile-debugger.ly.
+
+;;; Code:
+
+(define-module (lily guile-debugger)
+  #:use-module (ice-9 debugger)
+  #:use-module (ice-9 debugging traps)
+  #:use-module (ice-9 debugging trace)
+  #:use-module (ice-9 debugging steps)
+  #:use-module (ice-9 debugging ice-9-debugger-extensions)
+  #:use-module (ice-9 readline)
+  #:export (set-break!
+            clear-break!
+            set-trace-call!
+            clear-trace-call!
+            set-trace-subtree!
+            clear-trace-subtree!
+            debug-help))
+
+(define (set-break! proc)
+  (install-trap (make <procedure-trap>
+                  #:procedure proc
+                  #:behaviour debug-trap)))
+(define (clear-break! proc)
+  (uninstall-trap (make <procedure-trap>
+                    #:procedure proc
+                    #:behaviour debug-trap)))
+
+
+(define (set-trace-call! proc)
+  (install-trap (make <procedure-trap>
+                  #:procedure proc
+                  #:behaviour (list trace-trap
+                                    trace-at-exit))))
+(define (clear-trace-call! proc)
+  (uninstall-trap (make <procedure-trap>
+                    #:procedure proc
+                    #:behaviour (list trace-trap
+                                      trace-at-exit))))
+
+(define (set-trace-subtree! proc)
+  (install-trap (make <procedure-trap>
+                  #:procedure proc
+                  #:behaviour (list trace-trap
+                                    trace-until-exit))))
+
+(define (clear-trace-subtree! proc)
+  (uninstall-trap (make <procedure-trap>
+                    #:procedure proc
+                    #:behaviour (list trace-trap
+                                      trace-until-exit))))
+
+(define (debug-help )
+  (display "\nYou may add the following commands as debugging statements in your source file\n")
+  (display "or enter the set-x! commands at the guile prompt:\n\n")
+  (display " (set-break! <procedure>)\n")
+  (display "   causes guile to enter debugger on a call to <procedure>\n")
+  (display " (clear-break! <procedure>)\n")
+  (display "   disables a breakpoint previously set on a call to <procedure>\n")
+  (display " (set-trace-call! <procedure>)\n")
+  (display "   prints out a line when Scheme enters or exits <procedure>\n")
+  (display " (clear-trace-call! <procedure>)\n")
+  (display "   turns off tracing calls to <procedure>\n")
+  (display " (set-trace-subtree! <procedure>)\n")
+  (display "   displays each line of Scheme code executed during a call to <procedure>\n")
+  (display " (clear-trace-subtree! <procedure>)\n")
+  (display "   turns off tracing code during calls to <procedure>\n\n")
+  (display "Enter help at the guile debug> prompt for further information on debugger commands\n")
+  (newline))

data/share/lilypond/2.24.1/scm/lily/harp-pedals.scm

@@ -0,0 +1,172 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2008--2022 Reinhold Kainhofer <reinhold@kainhofer.com>
+;;;;
+;;;; 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/>.
+
+
+
+(define-markup-command (harp-pedal layout props definition-string) (string?)
+  #:category instrument-specific-markup ; markup type for the documentation!
+  #:properties ((size 1.2)
+                (harp-pedal-details '())
+                (thickness 0.5))
+  "Make a harp pedal diagram.
+
+Possible elements in @var{definition-string}:
+
+@table @code
+@item ^
+pedal is up
+@item -
+pedal is neutral
+@item v
+pedal is down
+@item |
+vertical divider line
+@item o
+the following pedal should be circled (indicating a change)
+@end table
+
+The function also checks if the string has the typical form of three
+pedals, then the divider and then the remaining four pedals.  If not it
+prints out a warning.  However, in any case, it will also print each symbol
+in the order as given.  This means you can place the divider (even
+multiple dividers) anywhere you want, but you'll have to live with the
+warnings.
+
+The appearance of the diagram can be tweaked inter alia using the size property
+of the TextScript grob (@code{\\override Voice.TextScript.size = #0.3}) for
+the overall, the thickness property (@code{\\override
+Voice.TextScript.thickness = #3}) for the line thickness of
+the horizontal line and the divider.  The remaining configuration (box
+sizes, offsets and spaces) is done by the harp-pedal-details list of
+properties (@code{\\override Voice.TextScript.harp-pedal-details.box-width = #1}).
+It contains the following settings: @code{box-offset} (vertical shift
+of the box center for up/down pedals), @code{box-width},
+@code{box-height}, @code{space-before-divider} (the spacing between
+two boxes before the divider) and @code{space-after-divider} (box
+spacing after the divider).
+
+@lilypond[verbatim,quote]
+\\markup \\harp-pedal #\"^-v|--ov^\"
+@end lilypond
+"
+  (let* ((pedal-list (harp-pedals-parse-string definition-string))
+         (details (begin (harp-pedal-check pedal-list) harp-pedal-details))
+         (dy (* size (assoc-get 'box-offset details 0.8))) ; offset of the box center from the line
+         (line-width (* (ly:output-def-lookup layout 'line-thickness)
+                        thickness))
+         (box-width (* size (assoc-get 'box-width details 0.4)))
+         (box-hheight (* size (/ (assoc-get 'box-height details 1.0) 2))) ; half the box-height, saves some divisions by 2
+         (spacebeforedivider (* size (assoc-get 'space-before-divider details 0.8))) ; full space between boxes before the first divider
+         (spaceafterdivider (* size (assoc-get 'space-after-divider details 0.8))) ; full space between boxes
+         (circle-thickness (* (ly:output-def-lookup layout 'line-thickness)
+                              (assoc-get 'circle-thickness details 0.5)))
+         (circle-x-padding (* size (assoc-get 'circle-x-padding details 0.15)))
+         (circle-y-padding (* size (assoc-get 'circle-y-padding details 0.2)))
+         (box-x-dimensions (lambda (prev-x p space) (cons (+ prev-x space)
+                                                          (+ prev-x space box-width))))
+         (box-y-dimensions (lambda (prev-x p space) (cons (- (* p dy) box-hheight)
+                                                          (+ (* p dy) box-hheight))))
+         (divider-stencil (lambda (xpos) (make-line-stencil line-width
+                                                            xpos (- 0 dy box-hheight)
+                                                            xpos (+ dy box-hheight))))
+         (result (let process-pedal  ((remaining pedal-list)
+                                      (prev-x 0)
+                                      (stencils '())
+                                      (circled #f)
+                                      (space spacebeforedivider))
+                   ;; Terminal condition of the recursion, return (final-x . stencil-list)
+                   (if (null? remaining)
+                       (cons (+ prev-x space) (reverse stencils))
+
+                       (case (car remaining)
+                         ((1 0 -1)  ; Pedal up/neutral/down
+                          (let* ((p (car remaining))
+                                 (stencil (make-filled-box-stencil
+                                           (box-x-dimensions prev-x p space)
+                                           (box-y-dimensions prev-x p space)))
+                                 (pedal-stencil
+                                  (if circled
+                                      (oval-stencil stencil circle-thickness
+                                                    circle-x-padding circle-y-padding)
+                                      stencil))
+                                 (new-prev-x (+ prev-x space box-width)))
+                            (process-pedal (cdr remaining) new-prev-x
+                                           (cons pedal-stencil stencils) #f space)))
+                         ((#\|)  ; Divider line
+                          (let* ((xpos (+ prev-x space))
+                                 (stencil (divider-stencil xpos))
+                                 (new-prev-x (+ prev-x space)))
+                            (process-pedal (cdr remaining) new-prev-x
+                                           (cons stencil stencils)
+                                           circled spaceafterdivider)))
+                         ((#\o)  ; Next pedal should be circled
+                          (process-pedal (cdr remaining) prev-x stencils #t space))
+                         (else
+                          (ly:warning (G_ "Unhandled entry in harp-pedal: ~a")
+                                      (car remaining))
+                          (process-pedal (cdr remaining)
+                                         prev-x stencils circled space))))))
+         (final-x (car result))
+         (stencils (cdr result)))
+    ;; Add the horizontal line and combine all stencils:
+    (apply ly:stencil-add
+           (make-line-stencil line-width 0 0 final-x 0) ; the horizontal line
+           (make-transparent-box-stencil ; space for absent boxes
+            (cons 0 final-x)
+            (interval-widen '(0 . 0) (+ box-hheight dy)))
+           stencils)))
+
+;; Parse the harp pedal definition string into list of directions (-1/0/1), #\o and #\|
+;; Whitespace is removed from definition string before the procedure applies.
+(define (harp-pedals-parse-string definition-string)
+  "Parse a harp pedals diagram string and return a list containing 1, 0, -1, #\\o or #\\|"
+  (map (lambda (c)
+         (case c
+           ((#\^) 1)
+           ((#\v) -1)
+           ((#\-) 0)
+           ((#\| #\o) c)
+           (else c)))
+       (string->list (remove-whitespace definition-string))))
+
+
+;; Analyze the pedal-list: Return (pedalcount . (divider positions))
+(define (harp-pedal-info pedal-list)
+  (let check ((pedals pedal-list)
+              (pedalcount 0)
+              (dividerpositions '()))
+    (if (null? pedals)
+        (cons pedalcount (reverse dividerpositions))
+
+        (case (car pedals)
+          ((-1 0 1) (check (cdr pedals) (+ pedalcount 1) dividerpositions))
+          ((#\|)    (check (cdr pedals) pedalcount (cons pedalcount dividerpositions)))
+          (else     (check (cdr pedals) pedalcount dividerpositions))))))
+
+
+;; Sanity checks, spit out warning if pedal-list violates the conventions
+(define (harp-pedal-check pedal-list)
+  "Perform some sanity checks for harp pedals (7 pedals, divider after third)"
+  (let ((info (harp-pedal-info pedal-list)))
+    ;; 7 pedals:
+    (if (not (equal? (car info) 7))
+        (ly:warning (G_ "Harp pedal diagram contains ~a pedals rather than the usual 7.") (car info)))
+    ;; One divider after third pedal:
+    (if (null? (cdr info))
+        (ly:warning (G_ "Harp pedal diagram does not contain a divider (usually after third pedal)."))
+        (if (not (equal? (cdr info) '(3)))
+            (ly:warning (G_ "Harp pedal diagram contains dividers at positions ~a.  Normally, there is only one divider after the third pedal.") (cdr info))))))

data/share/lilypond/2.24.1/scm/lily/hyphenate-internal-words.scm

@@ -0,0 +1,51 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2021--2022 Jean Abou Samra <jean@abou-samra.fr>
+;;;;
+;;;; 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/>.
+
+;; Many node names from the Internals Reference are camel-cased, e.g.,
+;; NoteHead.  In "See also" sections, they appear in a normal (not typewriter)
+;; font; therefore, TeX happily hyphenates them in ugly places, like
+;; No-teHead.  This generates an includable Texinfo file containing hyphenation
+;; rules to force breaking at word boundaries, like Note-Head.
+
+;; TODO: make it work for Translator_names?  The use of underscores seems
+;; to make this a nightmare.
+
+(use-modules (ice-9 regex))
+
+(define hyphenation-rules-string
+  (let ((music-types (map car music-descriptions))
+        (context-types (map car (ly:output-description $defaultlayout)))
+        (grob-types (map car all-grob-descriptions))
+        ;; This is enough because we don't use non-ASCII characters in internal
+        ;; naming.
+        (uppercase (make-regexp "[A-Z]")))
+    (define (hyphenate-camel-case name)
+      (define (maybe-hyphen match)
+        ;; Don't add a leading hyphen at the start of the string.
+        (if (zero? (match:start match))
+            ""
+            "-"))
+      (regexp-substitute/global #f uppercase name 'pre maybe-hyphen 0 'post))
+    (define (format-hyphenation-entry hyphenated)
+      (format #f "@hyphenation{~a}\n" hyphenated))
+    (apply string-append
+           (map
+            (lambda (sym)
+              (format-hyphenation-entry
+               (hyphenate-camel-case
+                (symbol->string sym))))
+            (append music-types context-types grob-types)))))

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

@@ -0,0 +1,73 @@
+;;;; 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/>.
+
+(define check-beam-quant
+  (lambda (posl posr)
+    (lambda (beam posns)
+      "Check whether BEAM has POSL and POSR quants.  POSL are (POSITION
+. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter)
+
+"
+      (let* ((thick (ly:grob-property beam 'beam-thickness))
+             (layout (ly:grob-layout beam))
+             (lthick (ly:output-def-lookup layout 'line-thickness))
+             (staff-thick lthick) ; fixme.
+             (quant->coord (lambda (p q)
+                             (if (= 2 (abs q))
+                                 (+ p (/ q 4.0))
+                                 (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
+             (want-l (quant->coord (car posl) (cdr posl)))
+             (want-r (quant->coord (car posr) (cdr posr)))
+             (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
+
+        (if (or (not (almost-equal want-l (car posns)))
+                (not (almost-equal want-r (cdr posns))))
+            (begin
+              (ly:warning (G_ "Error in beam quanting.  Expected (~S,~S) found ~S.")
+                          want-l want-r posns)
+              (set! (ly:grob-property beam 'annotation)
+                    (format #f "(~S,~S)" want-l want-r))))
+        posns))))
+
+(define check-beam-slope-sign
+  (lambda (comparison)
+    (lambda (beam posns)
+      "Check whether the slope of BEAM is correct wrt. COMPARISON."
+      (let* ((slope-sign (- (cdr posns) (car posns)))
+             (correct (comparison slope-sign 0)))
+        (if (not correct)
+            (begin
+              (ly:warning (G_ "Error in beam quanting.  Expected ~S 0, found ~S.")
+                          (procedure-name comparison) slope-sign)
+              (set! (ly:grob-property beam 'annotation)
+                    (format #f "~S 0" (procedure-name comparison))))
+            (set! (ly:grob-property beam 'annotation) ""))
+        posns))))
+
+
+(define-public (check-quant-callbacks l r)
+  (lambda (grob)
+    ((check-beam-quant l r)
+     grob
+     (beam::place-broken-parts-individually grob))))
+
+
+(define-public (check-slope-callbacks comparison)
+  (lambda (grob)
+    ((check-beam-slope-sign comparison)
+     grob
+     (beam::place-broken-parts-individually grob))))

data/share/lilypond/2.24.1/scm/lily/layout-slur.scm

@@ -0,0 +1,45 @@
+;;;; 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/>.
+
+;; this is put into the slur-details property of Slur and PhrasingSlur
+(define-public default-slur-details
+  '((region-size . 4)
+    (head-encompass-penalty . 1000.0)
+    (stem-encompass-penalty . 30.0)
+    (edge-attraction-factor . 4)
+    (same-slope-penalty . 20)
+    (steeper-slope-factor . 50)
+    (non-horizontal-penalty . 15)
+    (max-slope . 1.1)
+    (max-slope-factor . 10)
+    (free-head-distance . 0.3)
+    (free-slur-distance . 0.8)
+    (gap-to-staffline-inside . 0.2)
+    (gap-to-staffline-outside . 0.1)
+    (extra-object-collision-penalty . 50)
+    (accidental-collision . 3)
+    (extra-encompass-free-distance . 0.3)
+    (extra-encompass-collision-distance . 0.8)
+    (head-slur-distance-max-ratio . 3)
+    (head-slur-distance-factor . 10)
+    (absolute-closeness-measure . 0.3)
+    (edge-slope-exponent . 1.7)
+    (close-to-edge-length . 2.5)
+    (encompass-object-range-overshoot . 0.5)
+    (slur-tie-extrema-min-distance . 0.2)
+    (slur-tie-extrema-min-distance-penalty . 2)
+    ))