From: Marc Hohl <marc@hohlart.de>
Date: Thu, 6 Jun 2013 08:35:26 +0000 (+0200)
Subject: Apply scripts/auxiliar/fixscm.sh
X-Git-Tag: release/2.17.20-1~17
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=44dd3acc534e7a534f846810b481c3f603eaa92e;p=lilypond.git
Apply scripts/auxiliar/fixscm.sh
---
diff --git a/scm/auto-beam.scm b/scm/auto-beam.scm
index b77022f2fc..42387960ef 100644
--- a/scm/auto-beam.scm
+++ b/scm/auto-beam.scm
@@ -50,13 +50,13 @@
(ending-moments (cdr group-list) new-start base-moment)))))
(define (larger-setting test-beam sorted-alist)
- (if (null? sorted-alist)
- '()
- (let* ((first-key (caar sorted-alist))
- (first-moment (fraction->moment first-key)))
- (if (moment<=? test-beam first-moment)
- (car sorted-alist)
- (larger-setting test-beam (cdr sorted-alist))))))
+ (if (null? sorted-alist)
+ '()
+ (let* ((first-key (caar sorted-alist))
+ (first-moment (fraction->moment first-key)))
+ (if (moment<=? test-beam first-moment)
+ (car sorted-alist)
+ (larger-setting test-beam (cdr sorted-alist))))))
(define (beat-end? moment beat-structure)
(pair? (member moment beat-structure))) ;; member returns a list if found, not #t
@@ -71,7 +71,7 @@
(let* ((base-moment (get 'baseMoment (ly:make-moment 1 4)))
(measure-length (get 'measureLength (ly:make-moment 1 1)))
(time-signature-fraction
- (get 'timeSignatureFraction '(4 . 4)))
+ (get 'timeSignatureFraction '(4 . 4)))
(beat-structure (get 'beatStructure '(1 1 1 1)))
(beat-endings (ending-moments beat-structure 0 base-moment))
(exceptions (sort (assoc-get 'end
@@ -82,8 +82,8 @@
(beam-half-measure (get 'beamHalfMeasure #t))
(type (moment->fraction test-beam))
(non-grace (ly:make-moment
- (ly:moment-main-numerator measure-pos)
- (ly:moment-main-denominator measure-pos)))
+ (ly:moment-main-numerator measure-pos)
+ (ly:moment-main-denominator measure-pos)))
(pos (if (ly:moment<? non-grace ZERO-MOMENT)
(ly:moment-add measure-length non-grace)
non-grace))
@@ -98,15 +98,15 @@
(car default-rule)
'()))
(exception-grouping (if (null? type-grouping)
- default-grouping
- type-grouping))
+ default-grouping
+ type-grouping))
(grouping-moment (if (null? type-grouping)
(fraction->moment default-beat-length)
test-beam))
(exception-moments (ending-moments
- exception-grouping 0 grouping-moment)))
+ exception-grouping 0 grouping-moment)))
- (if (= dir START)
+ (if (= dir START)
;; Start rules -- #t if beam is allowed to start
(or beam-half-measure ;; Start anywhere, but option for mid-measure
(not (equal? (ly:moment-add pos pos) measure-length))
diff --git a/scm/autochange.scm b/scm/autochange.scm
index 14252e4b1d..b358c22b53 100644
--- a/scm/autochange.scm
+++ b/scm/autochange.scm
@@ -6,41 +6,41 @@
(define-public (make-autochange-music parser music)
(define (generate-split-list change-moment event-list acc)
(if (null? event-list)
- acc
- (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)))
- ;; tail recursive.
- (if (and pitch (not (= (ly:pitch-steps pitch) 0)))
- (generate-split-list #f
- (cdr event-list)
- (cons (cons
+ acc
+ (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)))
+ ;; tail recursive.
+ (if (and pitch (not (= (ly:pitch-steps pitch) 0)))
+ (generate-split-list #f
+ (cdr event-list)
+ (cons (cons
+
+ (if change-moment
+ change-moment
+ now)
+ (sign (ly:pitch-steps pitch))) acc))
+ (generate-split-list
+ (if pitch #f now)
+ (cdr event-list) acc)))))
- (if change-moment
- change-moment
- now)
- (sign (ly:pitch-steps pitch))) acc))
- (generate-split-list
- (if pitch #f now)
- (cdr event-list) acc)))))
-
(let* ((m (make-music 'AutoChangeMusic))
- (m1 (make-non-relative-music (context-spec-music music 'Voice "one")))
- (context-list (recording-group-emulate music
- (ly:parser-lookup parser 'partCombineListener)))
- (evs (car context-list))
+ (m1 (make-non-relative-music (context-spec-music music 'Voice "one")))
+ (context-list (recording-group-emulate music
+ (ly:parser-lookup parser 'partCombineListener)))
+ (evs (car context-list))
(rev (reverse! (cdar context-list)))
- (split (reverse! (generate-split-list
- #f
- rev
- '())
- '())))
+ (split (reverse! (generate-split-list
+ #f
+ rev
+ '())
+ '())))
(set! (ly:music-property m 'element) music)
(set! (ly:music-property m 'split-list) split)
m))
diff --git a/scm/backend-library.scm b/scm/backend-library.scm
index 0734a1a834..527e6fef95 100644
--- a/scm/backend-library.scm
+++ b/scm/backend-library.scm
@@ -16,25 +16,25 @@
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; backend helpers.
(use-modules (scm ps-to-png)
- (scm paper-system)
- (ice-9 optargs))
+ (scm paper-system)
+ (ice-9 optargs))
(define-public (ly:system command)
(ly:debug (_ "Invoking `~a'...") (string-join command))
(let ((status (apply ly:spawn command)))
(if (> status 0)
- (begin
- (ly:warning (_ "`~a' failed (~a)\n") command status)
- ;; hmmm. what's the best failure option?
- (throw 'ly-file-failed)))))
+ (begin
+ (ly:warning (_ "`~a' failed (~a)\n") command status)
+ ;; hmmm. what's the best failure option?
+ (throw 'ly-file-failed)))))
(define-public (sanitize-command-option str)
"Kill dubious shell quoting."
-
+
(string-append
"\""
(regexp-substitute/global #f "[^-_ 0-9,.a-zA-Z'\"\\]" str 'pre 'post)
@@ -43,81 +43,81 @@
(define-public (search-executable names)
(define (helper path lst)
(if (null? (cdr lst))
- (car lst)
- (if (search-path path (car lst)) (car lst)
- (helper path (cdr lst)))))
+ (car lst)
+ (if (search-path path (car lst)) (car lst)
+ (helper path (cdr lst)))))
(let ((path (parse-path (getenv "PATH"))))
(helper path names)))
(define-public (search-gs)
-
+
;; must be sure that we don't catch stuff from old GUBs.
(search-executable '("gs")))
-
+
(define-public (postscript->pdf paper-width paper-height name)
(let* ((pdf-name (string-append
- (dir-basename name ".ps" ".eps")
- ".pdf"))
- (is-eps (string-match "\\.eps$" name))
- (*unspecified* (if #f #f))
- (cmd
- (remove (lambda (x) (eq? x *unspecified*))
- (list
- (search-gs)
- (if (ly:get-option 'verbose) *unspecified* "-q")
- (if (or (ly:get-option 'gs-load-fonts)
- (ly:get-option 'gs-load-lily-fonts)
- (eq? PLATFORM 'windows))
- "-dNOSAFER"
- "-dSAFER")
-
- (if is-eps
- "-dEPSCrop"
- (ly:format "-dDEVICEWIDTHPOINTS=~$" paper-width))
- (if is-eps
- *unspecified*
- (ly:format "-dDEVICEHEIGHTPOINTS=~$" paper-height))
- "-dCompatibilityLevel=1.4"
- "-dNOPAUSE"
- "-dBATCH"
- "-r1200"
- "-sDEVICE=pdfwrite"
- (string-append "-sOutputFile=" pdf-name)
- "-c.setpdfwrite"
- (string-append "-f" name)))))
+ (dir-basename name ".ps" ".eps")
+ ".pdf"))
+ (is-eps (string-match "\\.eps$" name))
+ (*unspecified* (if #f #f))
+ (cmd
+ (remove (lambda (x) (eq? x *unspecified*))
+ (list
+ (search-gs)
+ (if (ly:get-option 'verbose) *unspecified* "-q")
+ (if (or (ly:get-option 'gs-load-fonts)
+ (ly:get-option 'gs-load-lily-fonts)
+ (eq? PLATFORM 'windows))
+ "-dNOSAFER"
+ "-dSAFER")
+
+ (if is-eps
+ "-dEPSCrop"
+ (ly:format "-dDEVICEWIDTHPOINTS=~$" paper-width))
+ (if is-eps
+ *unspecified*
+ (ly:format "-dDEVICEHEIGHTPOINTS=~$" paper-height))
+ "-dCompatibilityLevel=1.4"
+ "-dNOPAUSE"
+ "-dBATCH"
+ "-r1200"
+ "-sDEVICE=pdfwrite"
+ (string-append "-sOutputFile=" pdf-name)
+ "-c.setpdfwrite"
+ (string-append "-f" name)))))
(ly:message (_ "Converting to `~a'...\n") pdf-name)
(ly:system cmd)))
(define-public (postscript->png resolution paper-width paper-height name)
(let* ((verbose (ly:get-option 'verbose))
- (rename-page-1 #f))
+ (rename-page-1 #f))
;; Do not try to guess the name of the png file,
;; GS produces PNG files like BASE-page%d.png.
(ly:message (_ "Converting to ~a...") "PNG")
(make-ps-images name
- #:resolution resolution
- #:page-width paper-width
- #:page-height paper-height
- #:rename-page-1 rename-page-1
- #:be-verbose verbose
- #:anti-alias-factor (ly:get-option 'anti-alias-factor)
- #:pixmap-format (ly:get-option 'pixmap-format))
+ #:resolution resolution
+ #:page-width paper-width
+ #:page-height paper-height
+ #:rename-page-1 rename-page-1
+ #:be-verbose verbose
+ #:anti-alias-factor (ly:get-option 'anti-alias-factor)
+ #:pixmap-format (ly:get-option 'pixmap-format))
(ly:progress "\n")))
(define-public (postprocess-output paper-book module filename formats)
(let* ((completed (completize-formats formats))
- (base (dir-basename filename ".ps" ".eps"))
- (intermediate (remove (lambda (x) (member x formats)) completed)))
+ (base (dir-basename filename ".ps" ".eps"))
+ (intermediate (remove (lambda (x) (member x formats)) completed)))
(for-each (lambda (f)
- ((eval (string->symbol (format #f "convert-to-~a" f))
- module) paper-book filename)) completed)
+ ((eval (string->symbol (format #f "convert-to-~a" f))
+ module) paper-book filename)) completed)
(if (ly:get-option 'delete-intermediate-files)
- (for-each (lambda (f)
- (if (file-exists? f) (delete-file f)))
- (map (lambda (x) (string-append base "." x)) intermediate)))))
+ (for-each (lambda (f)
+ (if (file-exists? f) (delete-file f)))
+ (map (lambda (x) (string-append base "." x)) intermediate)))))
(define-public (completize-formats formats)
(define new-fmts '())
@@ -126,8 +126,8 @@
(if (member "pdf" formats)
(set! formats (cons "ps" formats)))
(for-each (lambda (x)
- (if (member x formats) (set! new-fmts (cons x new-fmts))))
- '("ps" "pdf" "png"))
+ (if (member x formats) (set! new-fmts (cons x new-fmts))))
+ '("ps" "pdf" "png"))
(uniq-list (reverse new-fmts)))
(define (header-to-file file-name key value)
@@ -135,13 +135,13 @@
(if (not (equal? "-" file-name))
(set! file-name (string-append file-name "." key)))
(ly:message (_ "Writing header field `~a' to `~a'...")
- key
- (if (equal? "-" file-name) "<stdout>" file-name))
+ key
+ (if (equal? "-" file-name) "<stdout>" file-name))
(if (equal? file-name "-")
(display value)
(let ((port (open-file file-name "w")))
- (display value port)
- (close-port port)))
+ (display value port)
+ (close-port port)))
(ly:progress "\n")
"")
@@ -152,10 +152,10 @@
string-append
(module-map
(lambda (sym var)
- (let ((val (if (variable-bound? var) (variable-ref var) "")))
- (if (and (memq sym fields) (string? val))
- (header-to-file basename sym val))
- ""))
+ (let ((val (if (variable-bound? var) (variable-ref var) "")))
+ (if (and (memq sym fields) (string? val))
+ (header-to-file basename sym val))
+ ""))
scope)))
(apply string-append (map output-scope scopes)))
@@ -163,20 +163,20 @@
(let ((systems (ly:paper-book-systems book)))
;; skip booktitles.
(if (and (not (ly:get-option 'include-book-title-preview))
- (pair? systems)
- (ly:prob-property (car systems) 'is-book-title #f))
- (cdr systems)
- systems)))
+ (pair? systems)
+ (ly:prob-property (car systems) 'is-book-title #f))
+ (cdr systems)
+ systems)))
(define-public (relevant-dump-systems systems)
(let ((to-dump-systems '()))
(for-each
- (lambda (sys)
- (if (or (paper-system-title? sys)
- (not (pair? to-dump-systems))
- (paper-system-title? (car to-dump-systems)))
- (set! to-dump-systems (cons sys to-dump-systems))))
- systems)
+ (lambda (sys)
+ (if (or (paper-system-title? sys)
+ (not (pair? to-dump-systems))
+ (paper-system-title? (car to-dump-systems)))
+ (set! to-dump-systems (cons sys to-dump-systems))))
+ systems)
to-dump-systems))
(define missing-stencil-list '())
@@ -188,20 +188,20 @@
""))
(map (lambda (x)
- (if (not (module-defined? output-module x))
- (begin
- (module-define! output-module x
- (lambda* (#:optional y . z)
- (missing-stencil-expression x)))
- (set! missing-stencil-list (append (list x)
- missing-stencil-list)))))
+ (if (not (module-defined? output-module x))
+ (begin
+ (module-define! output-module x
+ (lambda* (#:optional y . z)
+ (missing-stencil-expression x)))
+ (set! missing-stencil-list (append (list x)
+ missing-stencil-list)))))
(ly:all-stencil-commands)))
(define-public (remove-stencil-warnings output-module)
(for-each
- (lambda (x)
- (module-remove! output-module x))
- missing-stencil-list))
+ (lambda (x)
+ (module-remove! output-module x))
+ missing-stencil-list))
(define (filter-out pred? lst)
(filter (lambda (x) (not (pred? x))) lst))
@@ -211,8 +211,8 @@
or @code{#f}."
(let ((match (regexp-exec (make-regexp "(.*)-([0-9]*)") font-name)))
(if (regexp-match? match)
- (cons (match:substring match 1) (match:substring match 2))
- (cons font-name-designsize #f))))
+ (cons (match:substring match 1) (match:substring match 2))
+ (cons font-name-designsize #f))))
;; Example of a pango-physical-font
;; ("Emmentaler-11" "/home/janneke/vc/lilypond/out/share/lilypond/current/fonts/otf/emmentaler-11.otf" 0)
@@ -229,8 +229,8 @@ or @code{#f}."
(define (pango-font-name pango-font)
(let ((pf-fonts (ly:pango-font-physical-fonts pango-font)))
(if (pair? pf-fonts)
- (pango-pf-font-name (car pf-fonts))
- "")))
+ (pango-pf-font-name (car pf-fonts))
+ "")))
(define-public (define-fonts paper define-font define-pango-pf)
"Return a string of all fonts used in @var{paper}, invoking the functions
@@ -238,33 +238,33 @@ or @code{#f}."
definition."
(let* ((font-list (ly:paper-fonts paper))
- (pango-fonts (filter ly:pango-font? font-list))
- (other-fonts (filter-out ly:pango-font? font-list))
- (other-font-names (map ly:font-name other-fonts))
- (pango-only-fonts
- (filter-out (lambda (x)
- (member (pango-font-name x) other-font-names))
- pango-fonts)))
-
- (define (font-load-command font)
- (let* ((font-name (ly:font-name font))
- (designsize (ly:font-design-size font))
- (magnification (* (ly:font-magnification font)))
- (ops (ly:output-def-lookup paper 'output-scale))
- (scaling (* ops magnification designsize)))
- (if (equal? font-name "unknown")
- (display (list font font-name)))
- (define-font font font-name scaling)))
-
- (define (pango-font-load-command pango-font)
- (let* ((pf-fonts (ly:pango-font-physical-fonts pango-font))
- (pango-pf (if (pair? pf-fonts) (car pf-fonts) '("" "" 0)))
- (font-name (pango-pf-font-name pango-pf))
- (scaling (ly:output-def-lookup paper 'output-scale)))
- (if (equal? font-name "unknown")
- (display (list pango-font font-name)))
- (define-pango-pf pango-pf font-name scaling)))
+ (pango-fonts (filter ly:pango-font? font-list))
+ (other-fonts (filter-out ly:pango-font? font-list))
+ (other-font-names (map ly:font-name other-fonts))
+ (pango-only-fonts
+ (filter-out (lambda (x)
+ (member (pango-font-name x) other-font-names))
+ pango-fonts)))
- (string-append
- (apply string-append (map font-load-command other-fonts))
- (apply string-append (map pango-font-load-command pango-only-fonts)))))
+ (define (font-load-command font)
+ (let* ((font-name (ly:font-name font))
+ (designsize (ly:font-design-size font))
+ (magnification (* (ly:font-magnification font)))
+ (ops (ly:output-def-lookup paper 'output-scale))
+ (scaling (* ops magnification designsize)))
+ (if (equal? font-name "unknown")
+ (display (list font font-name)))
+ (define-font font font-name scaling)))
+
+ (define (pango-font-load-command pango-font)
+ (let* ((pf-fonts (ly:pango-font-physical-fonts pango-font))
+ (pango-pf (if (pair? pf-fonts) (car pf-fonts) '("" "" 0)))
+ (font-name (pango-pf-font-name pango-pf))
+ (scaling (ly:output-def-lookup paper 'output-scale)))
+ (if (equal? font-name "unknown")
+ (display (list pango-font font-name)))
+ (define-pango-pf pango-pf font-name scaling)))
+
+ (string-append
+ (apply string-append (map font-load-command other-fonts))
+ (apply string-append (map pango-font-load-command pango-only-fonts)))))
diff --git a/scm/bar-line.scm b/scm/bar-line.scm
index e23ff8c0f2..809a08ca48 100644
--- a/scm/bar-line.scm
+++ b/scm/bar-line.scm
@@ -35,12 +35,12 @@ and the dimensions of the extent into account."
(let ((blot-diameter (layout-blot-diameter grob))
(height (interval-length extent)))
- (cond ((< thickness blot-diameter) thickness)
- ((< height blot-diameter) height)
- (else blot-diameter)))
+ (cond ((< thickness blot-diameter) thickness)
+ ((< height blot-diameter) height)
+ (else blot-diameter)))
0)))
- blot))
+ blot))
(define (get-span-glyph bar-glyph)
"Get the corresponding span glyph from the @code{span-glyph-bar-alist}.
@@ -48,12 +48,12 @@ Pad the string with @code{annotation-char}s to the length of the
@var{bar-glyph} string."
(let ((span-glyph (assoc-get bar-glyph span-bar-glyph-alist bar-glyph)))
- (if (string? span-glyph)
- (set! span-glyph (string-pad-right
+ (if (string? span-glyph)
+ (set! span-glyph (string-pad-right
span-glyph
(string-length bar-glyph)
replacement-char)))
- span-glyph))
+ span-glyph))
(define (get-staff-symbol grob)
"Return the staff symbol corresponding to Grob @var{grob}."
@@ -66,51 +66,51 @@ Pad the string with @code{annotation-char}s to the length of the
(let* ((layout (ly:grob-layout grob))
(blot-diameter (ly:output-def-lookup layout 'blot-diameter)))
- blot-diameter))
+ blot-diameter))
(define (staff-symbol-line-count staff)
"Get or compute the number of lines of staff @var{staff}."
(let ((line-count 0))
- (if (ly:grob? staff)
- (let ((line-pos (ly:grob-property staff 'line-positions '())))
+ (if (ly:grob? staff)
+ (let ((line-pos (ly:grob-property staff 'line-positions '())))
- (set! line-count (if (pair? line-pos)
- (length line-pos)
- (ly:grob-property staff 'line-count 0)))))
+ (set! line-count (if (pair? line-pos)
+ (length line-pos)
+ (ly:grob-property staff 'line-count 0)))))
- line-count))
+ line-count))
(define (staff-symbol-line-span grob)
(let ((line-pos (ly:grob-property grob 'line-positions '()))
(iv (cons 0.0 0.0)))
- (if (pair? line-pos)
- (begin
- (set! iv (cons (car line-pos) (car line-pos)))
- (map (lambda (x)
- (set! iv (cons (min (car iv) x)
- (max (cdr iv) x))))
- (cdr line-pos)))
+ (if (pair? line-pos)
+ (begin
+ (set! iv (cons (car line-pos) (car line-pos)))
+ (map (lambda (x)
+ (set! iv (cons (min (car iv) x)
+ (max (cdr iv) x))))
+ (cdr line-pos)))
- (let ((line-count (ly:grob-property grob 'line-count 0)))
+ (let ((line-count (ly:grob-property grob 'line-count 0)))
- (set! iv (cons (- 1 line-count)
- (- line-count 1)))))
- iv))
+ (set! iv (cons (- 1 line-count)
+ (- line-count 1)))))
+ iv))
(define (staff-symbol-line-positions grob)
"Get or compute the @code{'line-positions} list from @var{grob}."
(let ((line-pos (ly:grob-property grob 'line-positions '())))
- (if (not (pair? line-pos))
- (let* ((line-count (ly:grob-property grob 'line-count 0))
- (height (- line-count 1.0)))
+ (if (not (pair? line-pos))
+ (let* ((line-count (ly:grob-property grob 'line-count 0))
+ (height (- line-count 1.0)))
- (set! line-pos (map (lambda (x)
- (- height (* x 2)))
- (iota line-count)))))
- line-pos))
+ (set! line-pos (map (lambda (x)
+ (- height (* x 2)))
+ (iota line-count)))))
+ line-pos))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; internal helper functions
@@ -128,46 +128,46 @@ mandatory to the procedures stored in @code{bar-glyph-print-procedures}."
(let ((proc (assoc-get glyph bar-glyph-print-procedures))
(stencil empty-stencil))
- (if (procedure? proc)
- (set! stencil (proc grob extent))
- (ly:warning (_ "Bar glyph ~a not known. Ignoring.") glyph))
- stencil))
+ (if (procedure? proc)
+ (set! stencil (proc grob extent))
+ (ly:warning (_ "Bar glyph ~a not known. Ignoring.") glyph))
+ stencil))
(define (string->string-list str)
"Convert a string into a list of strings with length 1.
@code{"aBc"} will be converted to @code{("a" "B" "c")}.
An empty string will be converted to a list containing @code{""}."
- (if (and (string? str)
- (not (zero? (string-length str))))
- (map (lambda (s)
- (string s))
- (string->list str))
- (list "")))
+(if (and (string? str)
+ (not (zero? (string-length str))))
+ (map (lambda (s)
+ (string s))
+ (string->list str))
+ (list "")))
(define (strip-string-annotation str)
"Strip annotations starting with and including the
annotation char from string @var{str}."
(let ((pos (string-index str annotation-char)))
- (if pos
- (substring str 0 pos)
- str)))
+ (if pos
+ (substring str 0 pos)
+ str)))
(define (check-for-annotation str)
"Check whether the annotation char is present in string @var{str}."
(if (string? str)
(if (string-index str annotation-char)
(ly:warning
- (_ "Annotation '~a' is allowed in the first argument of a bar line definition only.")
- str))))
+ (_ "Annotation '~a' is allowed in the first argument of a bar line definition only.")
+ str))))
(define (check-for-replacement str)
"Check whether the replacement char is present in string @var{str}."
(if (string? str)
(if (string-index str replacement-char)
(ly:warning
- (_ "Replacement '~a' is allowed in the last argument of a bar line definition only.")
- str))))
+ (_ "Replacement '~a' is allowed in the last argument of a bar line definition only.")
+ str))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; functions used by external routines
@@ -179,18 +179,18 @@ annotation char from string @var{str}."
(last-pos (1- (length sorted-elts)))
(idx 0))
- (map (lambda (g)
- (ly:grob-set-property!
- g
- 'has-span-bar
- (cons (if (eq? idx last-pos)
- #f
- grob)
- (if (zero? idx)
- #f
- grob)))
- (set! idx (1+ idx)))
- sorted-elts)))
+ (map (lambda (g)
+ (ly:grob-set-property!
+ g
+ 'has-span-bar
+ (cons (if (eq? idx last-pos)
+ #f
+ grob)
+ (if (zero? idx)
+ #f
+ grob)))
+ (set! idx (1+ idx)))
+ sorted-elts)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Line break decisions.
@@ -227,10 +227,10 @@ is not used within the routine."
(if (or (not (string? glyph))
(> (string-length glyph) 1))
(ly:warning
- (_ "add-bar-glyph-print-procedure: glyph '~a' has to be a single ASCII character.")
- glyph)
+ (_ "add-bar-glyph-print-procedure: glyph '~a' has to be a single ASCII character.")
+ glyph)
(set! bar-glyph-print-procedures
- (acons glyph proc bar-glyph-print-procedures))))
+ (acons glyph proc bar-glyph-print-procedures))))
(define-session bar-glyph-print-procedures `())
@@ -253,9 +253,9 @@ is not used within the routine."
(blot (calc-blot thickness extent grob))
(extent (bar-line::widen-bar-extent-on-span grob extent)))
- (ly:round-filled-box (cons 0 thickness)
- extent
- blot)))
+ (ly:round-filled-box (cons 0 thickness)
+ extent
+ blot)))
(define (make-thick-bar-line grob extent)
"Draw a thick bar line."
@@ -265,9 +265,9 @@ is not used within the routine."
(blot (calc-blot thickness extent grob))
(extent (bar-line::widen-bar-extent-on-span grob extent)))
- (ly:round-filled-box (cons 0 thickness)
- extent
- blot)))
+ (ly:round-filled-box (cons 0 thickness)
+ extent
+ blot)))
(define (make-tick-bar-line grob extent)
"Draw a tick bar line."
@@ -276,9 +276,9 @@ is not used within the routine."
(height (interval-end extent))
(blot (calc-blot staff-line-thickness extent grob)))
- (ly:round-filled-box (cons 0 staff-line-thickness)
- (cons (- height half-staff) (+ height half-staff))
- blot)))
+ (ly:round-filled-box (cons 0 staff-line-thickness)
+ (cons (- height half-staff) (+ height half-staff))
+ blot)))
(define (make-colon-bar-line grob extent)
"Draw repeat dots."
@@ -366,19 +366,19 @@ is not used within the routine."
(- 0.5 correction))))
(counting (interval-length (cons i e)))
(stil-list (map
- (lambda (x)
- (ly:stencil-translate-axis
- dot (+ x correction) Y))
- (iota counting i 1))))
+ (lambda (x)
+ (ly:stencil-translate-axis
+ dot (+ x correction) Y))
+ (iota counting i 1))))
- (define (add-stencils! stil l)
- (if (null? l)
- stil
- (if (null? (cdr l))
- (ly:stencil-add stil (car l))
- (add-stencils! (ly:stencil-add stil (car l)) (cdr l)))))
+ (define (add-stencils! stil l)
+ (if (null? l)
+ stil
+ (if (null? (cdr l))
+ (ly:stencil-add stil (car l))
+ (add-stencils! (ly:stencil-add stil (car l)) (cdr l)))))
- (add-stencils! empty-stencil stil-list)))
+ (add-stencils! empty-stencil stil-list)))
(define (make-dashed-bar-line grob extent)
"Draw a dashed bar line."
@@ -391,48 +391,48 @@ is not used within the routine."
(dash-size (- 1.0 (ly:grob-property grob 'gap 0.3)))
(line-count (staff-symbol-line-count staff-symbol)))
- (if (< (abs (+ line-thickness
- (* (1- line-count) staff-space)
- (- height)))
- 0.1)
- (let ((blot (layout-blot-diameter grob))
- (half-space (/ staff-space 2.0))
- (half-thick (/ line-thickness 2.0))
- (stencil empty-stencil))
-
- (map (lambda (i)
- (let ((top-y (min (* (+ i dash-size) half-space)
- (+ (* (1- line-count) half-space)
- half-thick)))
- (bot-y (max (* (- i dash-size) half-space)
- (- 0 (* (1- line-count) half-space)
- half-thick))))
-
- (set! stencil
- (ly:stencil-add
- stencil
- (ly:round-filled-box (cons 0 thickness)
- (cons bot-y top-y)
- blot)))))
- (iota line-count (1- line-count) (- 2)))
- stencil)
- (let* ((dashes (/ height staff-space))
- (total-dash-size (/ height dashes))
- (factor (/ (- dash-size thickness) staff-space))
- (stencil (ly:stencil-translate-axis
- (ly:make-stencil (list 'dashed-line
- thickness
- (* factor total-dash-size)
- (* (- 1 factor) total-dash-size)
- 0
- height
- (* factor total-dash-size 0.5))
- (cons (/ thickness -2) (/ thickness 2))
- (cons 0 height))
- (interval-start extent)
- Y)))
-
- (ly:stencil-translate-axis stencil (/ thickness 2) X)))))
+ (if (< (abs (+ line-thickness
+ (* (1- line-count) staff-space)
+ (- height)))
+ 0.1)
+ (let ((blot (layout-blot-diameter grob))
+ (half-space (/ staff-space 2.0))
+ (half-thick (/ line-thickness 2.0))
+ (stencil empty-stencil))
+
+ (map (lambda (i)
+ (let ((top-y (min (* (+ i dash-size) half-space)
+ (+ (* (1- line-count) half-space)
+ half-thick)))
+ (bot-y (max (* (- i dash-size) half-space)
+ (- 0 (* (1- line-count) half-space)
+ half-thick))))
+
+ (set! stencil
+ (ly:stencil-add
+ stencil
+ (ly:round-filled-box (cons 0 thickness)
+ (cons bot-y top-y)
+ blot)))))
+ (iota line-count (1- line-count) (- 2)))
+ stencil)
+ (let* ((dashes (/ height staff-space))
+ (total-dash-size (/ height dashes))
+ (factor (/ (- dash-size thickness) staff-space))
+ (stencil (ly:stencil-translate-axis
+ (ly:make-stencil (list 'dashed-line
+ thickness
+ (* factor total-dash-size)
+ (* (- 1 factor) total-dash-size)
+ 0
+ height
+ (* factor total-dash-size 0.5))
+ (cons (/ thickness -2) (/ thickness 2))
+ (cons 0 height))
+ (interval-start extent)
+ Y)))
+
+ (ly:stencil-translate-axis stencil (/ thickness 2) X)))))
(define ((make-segno-bar-line show-segno) grob extent)
@@ -443,37 +443,37 @@ draws the span bar variant, i.e. without the segno sign."
(thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness))
(thin-stil (make-simple-bar-line grob extent))
(double-line-stil (ly:stencil-combine-at-edge
- thin-stil
- X
- LEFT
- thin-stil
- thinkern))
+ thin-stil
+ X
+ LEFT
+ thin-stil
+ thinkern))
(segno (ly:font-get-glyph (ly:grob-default-font grob)
"scripts.varsegno"))
(stencil (ly:stencil-add
- (if show-segno
- segno
- (ly:make-stencil
- ""
- (ly:stencil-extent segno X)
- (cons 0 0)))
- (ly:stencil-translate-axis
- double-line-stil
- (* 1/2 thinkern)
- X))))
-
- stencil))
+ (if show-segno
+ segno
+ (ly:make-stencil
+ ""
+ (ly:stencil-extent segno X)
+ (cons 0 0)))
+ (ly:stencil-translate-axis
+ double-line-stil
+ (* 1/2 thinkern)
+ X))))
+
+ stencil))
(define (make-kievan-bar-line grob extent)
"Draw a kievan bar line."
(let* ((font (ly:grob-default-font grob))
(stencil (stencil-whiteout
- (ly:font-get-glyph font "scripts.barline.kievan"))))
+ (ly:font-get-glyph font "scripts.barline.kievan"))))
- ;; the kievan bar line has no staff lines underneath,
- ;; so we whiteout them and move the grob to a higher layer
- (ly:grob-set-property! grob 'layer 1)
- stencil))
+ ;; the kievan bar line has no staff lines underneath,
+ ;; so we whiteout them and move the grob to a higher layer
+ (ly:grob-set-property! grob 'layer 1)
+ stencil))
(define ((make-bracket-bar-line dir) grob extent)
"Draw a bracket-style bar line. If @var{dir} is set to @code{LEFT}, the
@@ -489,20 +489,20 @@ opening bracket will be drawn, for @code{RIGHT} we get the closing bracket."
(cons 0 0)
(ly:stencil-extent brackettips-up Y)))
(tip-down-stil (ly:make-stencil (ly:stencil-expr brackettips-down)
- (cons 0 0)
- (ly:stencil-extent brackettips-down Y)))
+ (cons 0 0)
+ (ly:stencil-extent brackettips-down Y)))
(stencil (ly:stencil-add
- thick-stil
- (ly:stencil-translate-axis tip-up-stil
- (interval-end extent)
- Y)
- (ly:stencil-translate-axis tip-down-stil
- (interval-start extent)
- Y))))
-
- (if (eq? dir LEFT)
- stencil
- (ly:stencil-scale stencil -1 1))))
+ thick-stil
+ (ly:stencil-translate-axis tip-up-stil
+ (interval-end extent)
+ Y)
+ (ly:stencil-translate-axis tip-down-stil
+ (interval-start extent)
+ Y))))
+
+ (if (eq? dir LEFT)
+ stencil
+ (ly:stencil-scale stencil -1 1))))
(define ((make-spacer-bar-line glyph) grob extent)
"Draw an invisible bar line which has the same dimensions as the one
@@ -510,7 +510,7 @@ drawn by the procedure associated with glyph @var{glyph}."
(let* ((stil (glyph->stencil glyph grob extent))
(stil-x-extent (ly:stencil-extent stil X)))
- (ly:make-stencil "" stil-x-extent extent)))
+ (ly:make-stencil "" stil-x-extent extent)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bar line callbacks
@@ -519,36 +519,36 @@ drawn by the procedure associated with glyph @var{glyph}."
(let ((staff-symbol (get-staff-symbol grob))
(staff-extent (cons 0 0)))
- (if (ly:grob? staff-symbol)
- (let ((bar-line-color (ly:grob-property grob 'color))
- (staff-color (ly:grob-property staff-symbol 'color))
- (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2))
- (staff-space (ly:staff-symbol-staff-space grob)))
-
- (set! staff-extent (ly:staff-symbol::height staff-symbol))
-
- (if (zero? staff-space)
- (set! staff-space 1.0))
-
- (if (< (interval-length staff-extent) staff-space)
- ;; staff is too small (perhaps consists of a single line);
- ;; extend the bar line to make it visible
- (set! staff-extent
- (interval-widen staff-extent staff-space))
- ;; Due to rounding problems, bar lines extending to the outermost edges
- ;; of the staff lines appear wrongly in on-screen display
- ;; (and, to a lesser extent, in print) - they stick out a pixel.
- ;; The solution is to extend bar lines only to the middle
- ;; of the staff line - unless they have different colors,
- ;; when it would be undesirable.
- ;;
- ;; This reduction should not influence whether the bar is to be
- ;; expanded later, so length is not updated on purpose.
- (if (eq? bar-line-color staff-color)
- (set! staff-extent
- (interval-widen staff-extent
- (- half-staff-line-thickness)))))))
- staff-extent))
+ (if (ly:grob? staff-symbol)
+ (let ((bar-line-color (ly:grob-property grob 'color))
+ (staff-color (ly:grob-property staff-symbol 'color))
+ (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2))
+ (staff-space (ly:staff-symbol-staff-space grob)))
+
+ (set! staff-extent (ly:staff-symbol::height staff-symbol))
+
+ (if (zero? staff-space)
+ (set! staff-space 1.0))
+
+ (if (< (interval-length staff-extent) staff-space)
+ ;; staff is too small (perhaps consists of a single line);
+ ;; extend the bar line to make it visible
+ (set! staff-extent
+ (interval-widen staff-extent staff-space))
+ ;; Due to rounding problems, bar lines extending to the outermost edges
+ ;; of the staff lines appear wrongly in on-screen display
+ ;; (and, to a lesser extent, in print) - they stick out a pixel.
+ ;; The solution is to extend bar lines only to the middle
+ ;; of the staff line - unless they have different colors,
+ ;; when it would be undesirable.
+ ;;
+ ;; This reduction should not influence whether the bar is to be
+ ;; expanded later, so length is not updated on purpose.
+ (if (eq? bar-line-color staff-color)
+ (set! staff-extent
+ (interval-widen staff-extent
+ (- half-staff-line-thickness)))))))
+ staff-extent))
;; this function may come in handy when defining new bar line glyphs, so
;; we make it public.
@@ -559,23 +559,23 @@ drawn by the procedure associated with glyph @var{glyph}."
(let ((staff-symbol (get-staff-symbol grob))
(has-span-bar (ly:grob-property grob 'has-span-bar #f)))
- (if (and (ly:grob? staff-symbol)
- (pair? has-span-bar))
- (let ((bar-line-color (ly:grob-property grob 'color))
- (staff-color (ly:grob-property staff-symbol 'color))
- (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2)))
- (if (eq? bar-line-color staff-color)
- ;; if the colors are equal, ly:bar-line::calc-bar-extent has
- ;; shortened the bar line extent by a half-staff-line-thickness
- ;; this is reverted on the interval bounds where span bars appear:
- (begin
- (and (ly:grob? (car has-span-bar))
- (set! extent (cons (- (car extent) half-staff-line-thickness)
- (cdr extent))))
- (and (ly:grob? (cdr has-span-bar))
- (set! extent (cons (car extent)
- (+ (cdr extent) half-staff-line-thickness))))))))
- extent))
+ (if (and (ly:grob? staff-symbol)
+ (pair? has-span-bar))
+ (let ((bar-line-color (ly:grob-property grob 'color))
+ (staff-color (ly:grob-property staff-symbol 'color))
+ (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2)))
+ (if (eq? bar-line-color staff-color)
+ ;; if the colors are equal, ly:bar-line::calc-bar-extent has
+ ;; shortened the bar line extent by a half-staff-line-thickness
+ ;; this is reverted on the interval bounds where span bars appear:
+ (begin
+ (and (ly:grob? (car has-span-bar))
+ (set! extent (cons (- (car extent) half-staff-line-thickness)
+ (cdr extent))))
+ (and (ly:grob? (cdr has-span-bar))
+ (set! extent (cons (car extent)
+ (+ (cdr extent) half-staff-line-thickness))))))))
+ extent))
(define (bar-line::bar-y-extent grob refpoint)
"Compute the y-extent of the bar line relative to @var{refpoint}."
@@ -583,24 +583,24 @@ drawn by the procedure associated with glyph @var{glyph}."
(rel-y (ly:grob-relative-coordinate grob refpoint Y))
(y-extent (coord-translate extent rel-y)))
- y-extent))
+ y-extent))
(define-public (ly:bar-line::print grob)
"The print routine for bar lines."
(let ((glyph-name (ly:grob-property grob 'glyph-name))
(extent (ly:grob-property grob 'bar-extent '(0 . 0))))
- (if (and glyph-name
- (> (interval-length extent) 0))
- (bar-line::compound-bar-line grob glyph-name extent)
- #f)))
+ (if (and glyph-name
+ (> (interval-length extent) 0))
+ (bar-line::compound-bar-line grob glyph-name extent)
+ #f)))
(define-public (bar-line::compound-bar-line grob bar-glyph extent)
"Build the bar line stencil."
(let* ((line-thickness (layout-line-thickness grob))
(kern (* (ly:grob-property grob 'kern 1) line-thickness))
(bar-glyph-list (string->string-list
- (strip-string-annotation bar-glyph)))
+ (strip-string-annotation bar-glyph)))
(span-glyph (get-span-glyph bar-glyph))
(span-glyph-list (string->string-list span-glyph))
(neg-stencil empty-stencil)
@@ -608,53 +608,53 @@ drawn by the procedure associated with glyph @var{glyph}."
(is-first-neg-stencil #t)
(is-first-stencil #t))
- ;; We build up two separate stencils first:
- ;; (1) the neg-stencil is built from all glyphs that have
- ;; a replacement-char in the span bar
- ;; (2) the main stencil is built from all remaining glyphs
- ;;
- ;; Afterwards the neg-stencil is attached left to the
- ;; stencil; this ensures that the main stencil starts
- ;; at x = 0.
- ;;
- ;; For both routines holds:
- ;; we stack the stencils obtained by the corresponding
- ;; single glyphs with spacing 'kern' except for the
- ;; first stencil
- ;; (Thanks to Harm who came up with this idea!)
- (for-each (lambda (bar span)
- (if (and (string=? span (string replacement-char))
- is-first-stencil)
- (begin
- (set! neg-stencil
- (ly:stencil-combine-at-edge
- neg-stencil
- X
- RIGHT
- (glyph->stencil bar grob extent)
- (if is-first-neg-stencil 0 kern)))
- (set! is-first-neg-stencil #f))
- (begin
- (set! stencil
- (ly:stencil-combine-at-edge
- stencil
- X
- RIGHT
- (glyph->stencil bar grob extent)
- (if is-first-stencil 0 kern)))
- (set! is-first-stencil #f))))
- bar-glyph-list span-glyph-list)
- ;; if we have a non-empty neg-stencil,
- ;; we attach it to the left side of the stencil
- (and (not is-first-neg-stencil)
- (set! stencil
- (ly:stencil-combine-at-edge
- stencil
- X
- LEFT
- neg-stencil
- kern)))
- stencil))
+ ;; We build up two separate stencils first:
+ ;; (1) the neg-stencil is built from all glyphs that have
+ ;; a replacement-char in the span bar
+ ;; (2) the main stencil is built from all remaining glyphs
+ ;;
+ ;; Afterwards the neg-stencil is attached left to the
+ ;; stencil; this ensures that the main stencil starts
+ ;; at x = 0.
+ ;;
+ ;; For both routines holds:
+ ;; we stack the stencils obtained by the corresponding
+ ;; single glyphs with spacing 'kern' except for the
+ ;; first stencil
+ ;; (Thanks to Harm who came up with this idea!)
+ (for-each (lambda (bar span)
+ (if (and (string=? span (string replacement-char))
+ is-first-stencil)
+ (begin
+ (set! neg-stencil
+ (ly:stencil-combine-at-edge
+ neg-stencil
+ X
+ RIGHT
+ (glyph->stencil bar grob extent)
+ (if is-first-neg-stencil 0 kern)))
+ (set! is-first-neg-stencil #f))
+ (begin
+ (set! stencil
+ (ly:stencil-combine-at-edge
+ stencil
+ X
+ RIGHT
+ (glyph->stencil bar grob extent)
+ (if is-first-stencil 0 kern)))
+ (set! is-first-stencil #f))))
+ bar-glyph-list span-glyph-list)
+ ;; if we have a non-empty neg-stencil,
+ ;; we attach it to the left side of the stencil
+ (and (not is-first-neg-stencil)
+ (set! stencil
+ (ly:stencil-combine-at-edge
+ stencil
+ X
+ LEFT
+ neg-stencil
+ kern)))
+ stencil))
(define-public (ly:bar-line::calc-anchor grob)
"Calculate the anchor position of a bar line. The anchor is used for
@@ -665,22 +665,22 @@ the correct placement of bar numbers etc."
(x-extent (ly:grob-extent grob grob X))
(anchor 0.0))
- (and (> (interval-length x-extent) 0)
- (if (or (= (length bar-glyph-list) 1)
- (string=? bar-glyph span-glyph)
- (string=? span-glyph ""))
- ;; We use the x-extent of the stencil if either
- ;; - we have a single bar-glyph
- ;; - bar-glyph and span-glyph are identical
- ;; - we have no span-glyph
- (set! anchor (interval-center x-extent))
- ;; If the conditions above do not hold,the anchor is the
- ;; center of the corresponding span bar stencil extent
- (set! anchor (interval-center
- (ly:stencil-extent
- (span-bar::compound-bar-line grob bar-glyph dummy-extent)
- X)))))
- anchor))
+ (and (> (interval-length x-extent) 0)
+ (if (or (= (length bar-glyph-list) 1)
+ (string=? bar-glyph span-glyph)
+ (string=? span-glyph ""))
+ ;; We use the x-extent of the stencil if either
+ ;; - we have a single bar-glyph
+ ;; - bar-glyph and span-glyph are identical
+ ;; - we have no span-glyph
+ (set! anchor (interval-center x-extent))
+ ;; If the conditions above do not hold,the anchor is the
+ ;; center of the corresponding span bar stencil extent
+ (set! anchor (interval-center
+ (ly:stencil-extent
+ (span-bar::compound-bar-line grob bar-glyph dummy-extent)
+ X)))))
+ anchor))
(define-public (bar-line::calc-glyph-name grob)
"Determine the @code{glyph-name} of the bar line depending on the
@@ -692,9 +692,9 @@ line break status."
glyph
(if (and result
(string? (index-cell result dir)))
- (index-cell result dir)
- #f))))
- glyph-name))
+ (index-cell result dir)
+ #f))))
+ glyph-name))
(define-public (bar-line::calc-break-visibility grob)
"Calculate the visibility of a bar line at line breaks."
@@ -716,85 +716,85 @@ The corresponding SpanBar glyph is computed within
(pos (1- (ly:grob-array-length elts)))
(glyph-name '()))
- (while (and (eq? glyph-name '())
- (> pos -1))
- (begin (set! glyph-name
- (ly:grob-property (ly:grob-array-ref elts pos)
- 'glyph-name))
- (set! pos (1- pos))))
- (if (eq? glyph-name '())
- (begin (ly:grob-suicide! grob)
- (set! glyph-name "")))
- glyph-name))
+ (while (and (eq? glyph-name '())
+ (> pos -1))
+ (begin (set! glyph-name
+ (ly:grob-property (ly:grob-array-ref elts pos)
+ 'glyph-name))
+ (set! pos (1- pos))))
+ (if (eq? glyph-name '())
+ (begin (ly:grob-suicide! grob)
+ (set! glyph-name "")))
+ glyph-name))
(define-public (ly:span-bar::width grob)
"Compute the width of the SpanBar stencil."
(let ((width (cons 0 0)))
- (if (grob::is-live? grob)
- (let* ((glyph-name (ly:grob-property grob 'glyph-name))
- (stencil (span-bar::compound-bar-line grob
- glyph-name
- dummy-extent)))
+ (if (grob::is-live? grob)
+ (let* ((glyph-name (ly:grob-property grob 'glyph-name))
+ (stencil (span-bar::compound-bar-line grob
+ glyph-name
+ dummy-extent)))
- (set! width (ly:stencil-extent stencil X))))
- width))
+ (set! width (ly:stencil-extent stencil X))))
+ width))
(define-public (ly:span-bar::before-line-breaking grob)
"A dummy callback that kills the Grob @var{grob} if it contains
no elements."
(let ((elts (ly:grob-object grob 'elements)))
- (if (zero? (ly:grob-array-length elts))
- (ly:grob-suicide! grob))))
+ (if (zero? (ly:grob-array-length elts))
+ (ly:grob-suicide! grob))))
(define-public (span-bar::compound-bar-line grob bar-glyph extent)
"Build the stencil of the span bar."
(let* ((line-thickness (layout-line-thickness grob))
(kern (* (ly:grob-property grob 'kern 1) line-thickness))
(bar-glyph-list (string->string-list
- (strip-string-annotation bar-glyph)))
+ (strip-string-annotation bar-glyph)))
(span-glyph (assoc-get bar-glyph span-bar-glyph-alist 'undefined))
(stencil empty-stencil))
- (if (string? span-glyph)
- (let ((span-glyph-list (string->string-list span-glyph))
- (is-first-stencil #t))
-
- (for-each (lambda (bar span)
- ;; the stencil stack routine is similar to the one
- ;; used in bar-line::compound-bar-line, but here,
- ;; leading replacement-chars are discarded.
- (if (not (and (string=? span (string replacement-char))
- is-first-stencil))
- (begin
- (set! stencil
- (ly:stencil-combine-at-edge
- stencil
- X
- RIGHT
- ;; if the current glyph is the replacement-char,
- ;; we take the corresponding glyph from the
- ;; bar-glyph-list and insert an empty stencil
- ;; with the appropriate width.
- ;; (this method would fail if the bar-glyph-list
- ;; were shorter than the span-glyph-list,
- ;; but this makes hardly any sense from a
- ;; typographical point of view
- (if (string=? span (string replacement-char))
- ((make-spacer-bar-line bar) grob extent)
- (glyph->stencil span grob extent))
- (if is-first-stencil 0 kern)))
- (set! is-first-stencil #f))))
- bar-glyph-list span-glyph-list))
- ;; if span-glyph is not a string, it may be #f or 'undefined;
- ;; the latter signals that the span bar for the current bar-glyph
- ;; is undefined, so we raise a warning.
- (if (eq? span-glyph 'undefined)
- (ly:warning
- (_ "No span bar glyph defined for bar glyph '~a'; ignoring.")
- bar-glyph)))
- stencil))
+ (if (string? span-glyph)
+ (let ((span-glyph-list (string->string-list span-glyph))
+ (is-first-stencil #t))
+
+ (for-each (lambda (bar span)
+ ;; the stencil stack routine is similar to the one
+ ;; used in bar-line::compound-bar-line, but here,
+ ;; leading replacement-chars are discarded.
+ (if (not (and (string=? span (string replacement-char))
+ is-first-stencil))
+ (begin
+ (set! stencil
+ (ly:stencil-combine-at-edge
+ stencil
+ X
+ RIGHT
+ ;; if the current glyph is the replacement-char,
+ ;; we take the corresponding glyph from the
+ ;; bar-glyph-list and insert an empty stencil
+ ;; with the appropriate width.
+ ;; (this method would fail if the bar-glyph-list
+ ;; were shorter than the span-glyph-list,
+ ;; but this makes hardly any sense from a
+ ;; typographical point of view
+ (if (string=? span (string replacement-char))
+ ((make-spacer-bar-line bar) grob extent)
+ (glyph->stencil span grob extent))
+ (if is-first-stencil 0 kern)))
+ (set! is-first-stencil #f))))
+ bar-glyph-list span-glyph-list))
+ ;; if span-glyph is not a string, it may be #f or 'undefined;
+ ;; the latter signals that the span bar for the current bar-glyph
+ ;; is undefined, so we raise a warning.
+ (if (eq? span-glyph 'undefined)
+ (ly:warning
+ (_ "No span bar glyph defined for bar glyph '~a'; ignoring.")
+ bar-glyph)))
+ stencil))
;; The method used in the following routine depends on bar_engraver
;; not being removed from staff context. If bar_engraver is removed,
@@ -815,72 +815,72 @@ no elements."
(bar-glyph (ly:grob-property grob 'glyph-name))
(span-bar empty-stencil))
- (if (string? bar-glyph)
- (let ((extents '())
- (make-span-bars '())
- (model-bar #f))
-
- ;; we compute the extents of each system and store them
- ;; in a list; dito for the 'allow-span-bar property.
- ;; model-bar takes the bar grob, if given.
- (map (lambda (bar)
- (let ((ext (bar-line::bar-y-extent bar refp))
- (staff-symbol (ly:grob-object bar 'staff-symbol)))
-
- (if (ly:grob? staff-symbol)
- (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
-
- (set! ext (interval-union ext refp-extent))
-
- (if (> (interval-length ext) 0)
- (begin
- (set! extents (append extents (list ext)))
- (set! model-bar bar)
- (set! make-span-bars
- (append make-span-bars
- (list (ly:grob-property
- bar
- 'allow-span-bar
- #t))))))))))
- elts)
- ;; if there is no bar grob, we use the callback argument
- (if (not model-bar)
- (set! model-bar grob))
- ;; we discard the first entry in make-span-bars,
- ;; because its corresponding bar line is the
- ;; uppermost and therefore not connected to
- ;; another bar line
- (if (pair? make-span-bars)
- (set! make-span-bars (cdr make-span-bars)))
- ;; the span bar reaches from the lower end of the upper staff
- ;; to the upper end of the lower staff - when allow-span-bar is #t
- (reduce (lambda (curr prev)
- (let ((span-extent (cons 0 0))
- (allow-span-bar (car make-span-bars)))
-
- (set! make-span-bars (cdr make-span-bars))
- (if (> (interval-length prev) 0)
- (begin
- (set! span-extent (cons (cdr prev)
- (car curr)))
- ;; draw the span bar only when the staff lines
- ;; don't overlap and allow-span-bar is #t:
- (and (> (interval-length span-extent) 0)
- allow-span-bar
- (set! span-bar
- (ly:stencil-add
- span-bar
- (span-bar::compound-bar-line
- model-bar
- bar-glyph
- span-extent))))))
- curr))
- "" extents)
- (set! span-bar (ly:stencil-translate-axis
- span-bar
- (- (ly:grob-relative-coordinate grob refp Y))
- Y))))
- span-bar))
+ (if (string? bar-glyph)
+ (let ((extents '())
+ (make-span-bars '())
+ (model-bar #f))
+
+ ;; we compute the extents of each system and store them
+ ;; in a list; dito for the 'allow-span-bar property.
+ ;; model-bar takes the bar grob, if given.
+ (map (lambda (bar)
+ (let ((ext (bar-line::bar-y-extent bar refp))
+ (staff-symbol (ly:grob-object bar 'staff-symbol)))
+
+ (if (ly:grob? staff-symbol)
+ (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
+
+ (set! ext (interval-union ext refp-extent))
+
+ (if (> (interval-length ext) 0)
+ (begin
+ (set! extents (append extents (list ext)))
+ (set! model-bar bar)
+ (set! make-span-bars
+ (append make-span-bars
+ (list (ly:grob-property
+ bar
+ 'allow-span-bar
+ #t))))))))))
+ elts)
+ ;; if there is no bar grob, we use the callback argument
+ (if (not model-bar)
+ (set! model-bar grob))
+ ;; we discard the first entry in make-span-bars,
+ ;; because its corresponding bar line is the
+ ;; uppermost and therefore not connected to
+ ;; another bar line
+ (if (pair? make-span-bars)
+ (set! make-span-bars (cdr make-span-bars)))
+ ;; the span bar reaches from the lower end of the upper staff
+ ;; to the upper end of the lower staff - when allow-span-bar is #t
+ (reduce (lambda (curr prev)
+ (let ((span-extent (cons 0 0))
+ (allow-span-bar (car make-span-bars)))
+
+ (set! make-span-bars (cdr make-span-bars))
+ (if (> (interval-length prev) 0)
+ (begin
+ (set! span-extent (cons (cdr prev)
+ (car curr)))
+ ;; draw the span bar only when the staff lines
+ ;; don't overlap and allow-span-bar is #t:
+ (and (> (interval-length span-extent) 0)
+ allow-span-bar
+ (set! span-bar
+ (ly:stencil-add
+ span-bar
+ (span-bar::compound-bar-line
+ model-bar
+ bar-glyph
+ span-extent))))))
+ curr))
+ "" extents)
+ (set! span-bar (ly:stencil-translate-axis
+ span-bar
+ (- (ly:grob-relative-coordinate grob refp Y))
+ Y))))
+ span-bar))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; volta bracket functions
@@ -892,7 +892,7 @@ no elements."
(append volta-bracket-allow-volta-hook-list
(list bar-glyph)))
(ly:warning (_ ("Volta hook bar line must be a string; ignoring '~a'.")
- bar-glyph))))
+ bar-glyph))))
(define-session volta-bracket-allow-volta-hook-list '())
@@ -926,8 +926,8 @@ of the volta brackets relative to the bar lines."
;; is the last entry with the same vag-index, so we transform the array to a list,
;; reverse it and search for suitable entries:
(filtered-grobs (filter (lambda (e)
- (eq? (ly:grob-get-vertical-axis-group-index e)
- vag-index))
+ (eq? (ly:grob-get-vertical-axis-group-index e)
+ vag-index))
(reverse (ly:grob-array->list bar-array))))
;; we need the first one (if any)
(right-bar-line (if (pair? filtered-grobs)
@@ -946,44 +946,44 @@ of the volta brackets relative to the bar lines."
(right-bar-broken (or (null? right-bar-line)
(not (zero? (ly:item-break-dir right-bar-line)))))
(left-span-stencil-extent (ly:stencil-extent
+ (span-bar::compound-bar-line
+ left-bar-line
+ left-bar-glyph-name
+ dummy-extent)
+ X))
+ (right-span-stencil-extent (ly:stencil-extent
(span-bar::compound-bar-line
- left-bar-line
- left-bar-glyph-name
- dummy-extent)
+ right-bar-line
+ right-bar-glyph-name
+ dummy-extent)
X))
- (right-span-stencil-extent (ly:stencil-extent
- (span-bar::compound-bar-line
- right-bar-line
- right-bar-glyph-name
- dummy-extent)
- X))
(left-shorten 0.0)
(right-shorten 0.0))
- ;; since "empty" intervals may look like (1.0 . -1.0), we use the
- ;; min/max functions to make sure that the placement is not corrupted
- ;; in case of empty bar lines
- (set! left-shorten
- (if left-bar-broken
- (- (max 0 (interval-end left-span-stencil-extent))
- (max 0 (interval-end (ly:stencil-extent
- (bar-line::compound-bar-line
- left-bar-line
- left-bar-glyph-name
- dummy-extent)
- X)))
- volta-half-line-thickness)
- (- (max 0 (interval-end left-span-stencil-extent))
- volta-half-line-thickness)))
-
- (set! right-shorten
- (if right-bar-broken
- (+ (- (max 0 (interval-end right-span-stencil-extent)))
- volta-half-line-thickness)
- (- (min 0 (interval-start right-span-stencil-extent))
- volta-half-line-thickness)))
-
- (cons left-shorten right-shorten)))
+ ;; since "empty" intervals may look like (1.0 . -1.0), we use the
+ ;; min/max functions to make sure that the placement is not corrupted
+ ;; in case of empty bar lines
+ (set! left-shorten
+ (if left-bar-broken
+ (- (max 0 (interval-end left-span-stencil-extent))
+ (max 0 (interval-end (ly:stencil-extent
+ (bar-line::compound-bar-line
+ left-bar-line
+ left-bar-glyph-name
+ dummy-extent)
+ X)))
+ volta-half-line-thickness)
+ (- (max 0 (interval-end left-span-stencil-extent))
+ volta-half-line-thickness)))
+
+ (set! right-shorten
+ (if right-bar-broken
+ (+ (- (max 0 (interval-end right-span-stencil-extent)))
+ volta-half-line-thickness)
+ (- (min 0 (interval-start right-span-stencil-extent))
+ volta-half-line-thickness)))
+
+ (cons left-shorten right-shorten)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; predefined bar glyph print procedures
diff --git a/scm/bezier-tools.scm b/scm/bezier-tools.scm
index 04859d03bb..defefc7bc4 100644
--- a/scm/bezier-tools.scm
+++ b/scm/bezier-tools.scm
@@ -16,67 +16,67 @@
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
(define (make-coord x-value y-value)
- "Make a coordinate pair from @var{x-valye} and @var{y-value}."
- (cons x-value y-value))
+ "Make a coordinate pair from @var{x-valye} and @var{y-value}."
+ (cons x-value y-value))
(define (coord+ coord1 coord2)
- "Add @var{coord1} to @var{coord2}, returning a coordinate."
- (cons (+ (car coord1) (car coord2))
- (+ (cdr coord1) (cdr coord2))))
+ "Add @var{coord1} to @var{coord2}, returning a coordinate."
+ (cons (+ (car coord1) (car coord2))
+ (+ (cdr coord1) (cdr coord2))))
(define (coord- coord1 coord2)
- "Subtract @var{coord2} from @var{coord1}."
- (cons (- (car coord1) (car coord2))
- (- (cdr coord1) (cdr coord2))))
+ "Subtract @var{coord2} from @var{coord1}."
+ (cons (- (car coord1) (car coord2))
+ (- (cdr coord1) (cdr coord2))))
(define (coord* scalar coord)
- "Multiply each component of @var{coord} by @var{scalar}."
- (cons (* (car coord) scalar)
- (* (cdr coord) scalar)))
+ "Multiply each component of @var{coord} by @var{scalar}."
+ (cons (* (car coord) scalar)
+ (* (cdr coord) scalar)))
(define (make-bezier point-0 point-1 point-2 point-3)
- "Create a cubic bezier from the four control points."
- (list point-0 point-1 point-2 point-3))
+ "Create a cubic bezier from the four control points."
+ (list point-0 point-1 point-2 point-3))
(define (interpolated-control-points control-points split-value)
- "Interpolate @var{control-points} at @var{split-value}. Return a
+ "Interpolate @var{control-points} at @var{split-value}. Return a
set of control points that is one degree less than @var{control-points}."
(if (null? (cdr control-points))
'()
(let ((first (car control-points))
(second (cadr control-points)))
- (cons* (coord+ first (coord* split-value (coord- second first)))
- (interpolated-control-points
- (cdr control-points)
- split-value)))))
+ (cons* (coord+ first (coord* split-value (coord- second first)))
+ (interpolated-control-points
+ (cdr control-points)
+ split-value)))))
(define (split-bezier bezier split-value)
- "Split a cubic bezier defined by @var{bezier} at the value
+ "Split a cubic bezier defined by @var{bezier} at the value
@var{split-value}. @var{bezier} is a list of pairs; each pair is
is the coordinates of a control point. Returns a list of beziers.
The first element is the LHS spline; the second
element is the RHS spline."
- (let* ((quad-points (interpolated-control-points
+ (let* ((quad-points (interpolated-control-points
bezier
split-value))
- (lin-points (interpolated-control-points
- quad-points
+ (lin-points (interpolated-control-points
+ quad-points
+ split-value))
+ (const-point (interpolated-control-points
+ lin-points
split-value))
- (const-point (interpolated-control-points
- lin-points
- split-value))
- (left-side (list (car bezier)
- (car quad-points)
- (car lin-points)
- (car const-point)))
- (right-side (list (car const-point)
- (list-ref lin-points 1)
- (list-ref quad-points 2)
- (list-ref bezier 3))))
- (cons left-side right-side)))
+ (left-side (list (car bezier)
+ (car quad-points)
+ (car lin-points)
+ (car const-point)))
+ (right-side (list (car const-point)
+ (list-ref lin-points 1)
+ (list-ref quad-points 2)
+ (list-ref bezier 3))))
+ (cons left-side right-side)))
(define (multi-split-bezier bezier start-t split-list)
- "Split @var{bezier} at all the points listed in @var{split-list}.
+ "Split @var{bezier} at all the points listed in @var{split-list}.
@var{bezier} has a parameter value that goes from @var{start-t} to 1.
Returns a list of @var{(1+ (length split-list))} beziers."
(let* ((bezier-split (split-bezier bezier
@@ -93,13 +93,13 @@ Returns a list of @var{(1+ (length split-list))} beziers."
(define (bezier-sandwich-list top-bezier bottom-bezier)
- "create the list of control points for a bezier sandwich consisting
+ "create the list of control points for a bezier sandwich consisting
of @var{top-bezier} and @var{bottom-bezier}."
- (list (list-ref bottom-bezier 1)
- (list-ref bottom-bezier 2)
- (list-ref bottom-bezier 3)
- (list-ref bottom-bezier 0)
- (list-ref top-bezier 2)
- (list-ref top-bezier 1)
- (list-ref top-bezier 0)
- (list-ref top-bezier 3)))
+ (list (list-ref bottom-bezier 1)
+ (list-ref bottom-bezier 2)
+ (list-ref bottom-bezier 3)
+ (list-ref bottom-bezier 0)
+ (list-ref top-bezier 2)
+ (list-ref top-bezier 1)
+ (list-ref top-bezier 0)
+ (list-ref top-bezier 3)))
diff --git a/scm/c++.scm b/scm/c++.scm
index f0c5d3aea9..8f4986a257 100644
--- a/scm/c++.scm
+++ b/scm/c++.scm
@@ -98,8 +98,8 @@
(if (null? alist)
"Unknown type"
(if (apply (caar alist) obj)
- (cdar alist)
- (match-predicate obj (cdr alist)))))
+ (cdar alist)
+ (match-predicate obj (cdr alist)))))
(define-public (object-type obj)
(match-predicate obj type-p-name-alist))
diff --git a/scm/chord-entry.scm b/scm/chord-entry.scm
index 28ae97442c..35946731bb 100644
--- a/scm/chord-entry.scm
+++ b/scm/chord-entry.scm
@@ -26,63 +26,63 @@ Notes: Natural 11 is left from chord if not explicitly specified.
Entry point for the parser."
(let* ((flat-mods (flatten-list modifications))
- (base-chord (stack-thirds (ly:make-pitch 0 4 0) the-canonical-chord))
- (complete-chord '())
- (bass #f)
- (inversion #f)
- (lead-mod #f)
- (explicit-11 #f)
- (start-additions #t))
+ (base-chord (stack-thirds (ly:make-pitch 0 4 0) the-canonical-chord))
+ (complete-chord '())
+ (bass #f)
+ (inversion #f)
+ (lead-mod #f)
+ (explicit-11 #f)
+ (start-additions #t))
(define (interpret-inversion chord mods)
"Read /FOO part. Side effect: INVERSION is set."
(if (and (> (length mods) 1) (eq? (car mods) 'chord-slash))
- (begin
- (set! inversion (cadr mods))
- (set! mods (cddr mods))))
+ (begin
+ (set! inversion (cadr mods))
+ (set! mods (cddr mods))))
(interpret-bass chord mods))
(define (interpret-bass chord mods)
"Read /+FOO part. Side effect: BASS is set."
(if (and (> (length mods) 1) (eq? (car mods) 'chord-bass))
- (begin
- (set! bass (cadr mods))
- (set! mods (cddr mods))))
+ (begin
+ (set! bass (cadr mods))
+ (set! mods (cddr mods))))
(if (pair? mods)
- (ly:warning (_ "Spurious garbage following chord: ~A") mods))
+ (ly:warning (_ "Spurious garbage following chord: ~A") mods))
chord)
- (define (interpret-removals chord mods)
+ (define (interpret-removals chord mods)
(define (inner-interpret chord mods)
- (if (and (pair? mods) (ly:pitch? (car mods)))
- (inner-interpret (remove-step (+ 1 (ly:pitch-steps (car mods))) chord)
- (cdr mods))
- (interpret-inversion chord mods)))
+ (if (and (pair? mods) (ly:pitch? (car mods)))
+ (inner-interpret (remove-step (+ 1 (ly:pitch-steps (car mods))) chord)
+ (cdr mods))
+ (interpret-inversion chord mods)))
(if (and (pair? mods) (eq? (car mods) 'chord-caret))
- (inner-interpret chord (cdr mods))
- (interpret-inversion chord mods)))
+ (inner-interpret chord (cdr mods))
+ (interpret-inversion chord mods)))
(define (interpret-additions chord mods)
"Interpret additions. TODO: should restrict modifier use?"
(cond ((null? mods) chord)
- ((ly:pitch? (car mods))
- (if (= (pitch-step (car mods)) 11)
- (set! explicit-11 #t))
- (interpret-additions (cons (car mods) (remove-step (pitch-step (car mods)) chord))
- (cdr mods)))
- ((procedure? (car mods))
- (interpret-additions ((car mods) chord)
- (cdr mods)))
- (else (interpret-removals chord mods))))
+ ((ly:pitch? (car mods))
+ (if (= (pitch-step (car mods)) 11)
+ (set! explicit-11 #t))
+ (interpret-additions (cons (car mods) (remove-step (pitch-step (car mods)) chord))
+ (cdr mods)))
+ ((procedure? (car mods))
+ (interpret-additions ((car mods) chord)
+ (cdr mods)))
+ (else (interpret-removals chord mods))))
(define (pitch-octavated-strictly-below p root)
- "return P, but octavated, so it is below ROOT"
+ "return P, but octavated, so it is below ROOT"
(ly:make-pitch (+ (ly:pitch-octave root)
- (if (> (ly:pitch-notename root)
- (ly:pitch-notename p))
- 0 -1))
- (ly:pitch-notename p)
- (ly:pitch-alteration p)))
+ (if (> (ly:pitch-notename root)
+ (ly:pitch-notename p))
+ 0 -1))
+ (ly:pitch-notename p)
+ (ly:pitch-alteration p)))
(define (process-inversion complete-chord)
"Take out inversion from COMPLETE-CHORD, and put it at the bottom.
@@ -94,82 +94,82 @@ the bass specified.
"
(let* ((root (car complete-chord))
- (inv? (lambda (y)
- (and (= (ly:pitch-notename y)
- (ly:pitch-notename inversion))
- (= (ly:pitch-alteration y)
- (ly:pitch-alteration inversion)))))
- (rest-of-chord (remove inv? complete-chord))
- (inversion-candidates (filter inv? complete-chord))
- (down-inversion (pitch-octavated-strictly-below inversion root)))
- (if (pair? inversion-candidates)
- (set! inversion (car inversion-candidates))
- (begin
- (set! bass inversion)
- (set! inversion #f)))
- (if inversion
- (cons down-inversion rest-of-chord)
- rest-of-chord)))
+ (inv? (lambda (y)
+ (and (= (ly:pitch-notename y)
+ (ly:pitch-notename inversion))
+ (= (ly:pitch-alteration y)
+ (ly:pitch-alteration inversion)))))
+ (rest-of-chord (remove inv? complete-chord))
+ (inversion-candidates (filter inv? complete-chord))
+ (down-inversion (pitch-octavated-strictly-below inversion root)))
+ (if (pair? inversion-candidates)
+ (set! inversion (car inversion-candidates))
+ (begin
+ (set! bass inversion)
+ (set! inversion #f)))
+ (if inversion
+ (cons down-inversion rest-of-chord)
+ rest-of-chord)))
;; root is always one octave too low.
;; something weird happens when this is removed,
;; every other chord is octavated. --hwn... hmmm.
(set! root (ly:pitch-transpose root (ly:make-pitch 1 0 0)))
;; skip the leading : , we need some of the stuff following it.
(if (pair? flat-mods)
- (if (eq? (car flat-mods) 'chord-colon)
- (set! flat-mods (cdr flat-mods))
- (set! start-additions #f)))
+ (if (eq? (car flat-mods) 'chord-colon)
+ (set! flat-mods (cdr flat-mods))
+ (set! start-additions #f)))
;; remember modifier
(if (and (pair? flat-mods) (procedure? (car flat-mods)))
- (begin
- (set! lead-mod (car flat-mods))
- (set! flat-mods (cdr flat-mods))))
+ (begin
+ (set! lead-mod (car flat-mods))
+ (set! flat-mods (cdr flat-mods))))
;; extract first number if present, and build pitch list.
(if (and (pair? flat-mods)
- (ly:pitch? (car flat-mods))
- (not (eq? lead-mod sus-modifier)))
- (begin
- (if (= (pitch-step (car flat-mods)) 11)
- (set! explicit-11 #t))
- (set! base-chord
- (stack-thirds (car flat-mods) the-canonical-chord))
- (set! flat-mods (cdr flat-mods))))
+ (ly:pitch? (car flat-mods))
+ (not (eq? lead-mod sus-modifier)))
+ (begin
+ (if (= (pitch-step (car flat-mods)) 11)
+ (set! explicit-11 #t))
+ (set! base-chord
+ (stack-thirds (car flat-mods) the-canonical-chord))
+ (set! flat-mods (cdr flat-mods))))
;; apply modifier
(if (procedure? lead-mod)
- (set! base-chord (lead-mod base-chord)))
+ (set! base-chord (lead-mod base-chord)))
(set! complete-chord
- (if start-additions
- (interpret-additions base-chord flat-mods)
- (interpret-removals base-chord flat-mods)))
+ (if start-additions
+ (interpret-additions base-chord flat-mods)
+ (interpret-removals base-chord flat-mods)))
(set! complete-chord (sort complete-chord ly:pitch<?))
;; If natural 11 + natural 3 is present, but not given explicitly,
;; we remove the 11.
(if (and (not explicit-11)
- (get-step 11 complete-chord)
- (get-step 3 complete-chord)
- (= 0 (ly:pitch-alteration (get-step 11 complete-chord)))
- (= 0 (ly:pitch-alteration (get-step 3 complete-chord))))
- (set! complete-chord (remove-step 11 complete-chord)))
+ (get-step 11 complete-chord)
+ (get-step 3 complete-chord)
+ (= 0 (ly:pitch-alteration (get-step 11 complete-chord)))
+ (= 0 (ly:pitch-alteration (get-step 3 complete-chord))))
+ (set! complete-chord (remove-step 11 complete-chord)))
;; must do before processing inversion/bass, since they are
;; not relative to the root.
(set! complete-chord (map (lambda (x) (ly:pitch-transpose x root))
- complete-chord))
+ complete-chord))
(if inversion
- (set! complete-chord (process-inversion complete-chord)))
+ (set! complete-chord (process-inversion complete-chord)))
(if bass
- (set! bass (pitch-octavated-strictly-below bass root)))
+ (set! bass (pitch-octavated-strictly-below bass root)))
(if #f
- (begin
- (write-me "\n*******\n" flat-mods)
- (write-me "root: " root)
- (write-me "base chord: " base-chord)
- (write-me "complete chord: " complete-chord)
- (write-me "inversion: " inversion)
- (write-me "bass: " bass)))
+ (begin
+ (write-me "\n*******\n" flat-mods)
+ (write-me "root: " root)
+ (write-me "base chord: " base-chord)
+ (write-me "complete chord: " complete-chord)
+ (write-me "inversion: " inversion)
+ (write-me "bass: " bass)))
(if inversion
- (make-chord-elements (cdr complete-chord) bass duration (car complete-chord)
- inversion)
- (make-chord-elements complete-chord bass duration #f #f))))
+ (make-chord-elements (cdr complete-chord) bass duration (car complete-chord)
+ inversion)
+ (make-chord-elements complete-chord bass duration #f #f))))
(define (make-chord-elements pitches bass duration inversion original-inv-pitch)
@@ -180,23 +180,23 @@ DURATION, and INVERSION."
'duration duration
'pitch pitch))
(let ((nots (map make-note-ev pitches))
- (bass-note (if bass (make-note-ev bass) #f))
- (inv-note (if inversion (make-note-ev inversion) #f)))
+ (bass-note (if bass (make-note-ev bass) #f))
+ (inv-note (if inversion (make-note-ev inversion) #f)))
(if bass-note
- (begin
- (set! (ly:music-property bass-note 'bass) #t)
- (set! nots (cons bass-note nots))))
+ (begin
+ (set! (ly:music-property bass-note 'bass) #t)
+ (set! nots (cons bass-note nots))))
(if inv-note
- (begin
- (set! (ly:music-property inv-note 'inversion) #t)
- (set! (ly:music-property inv-note 'octavation)
- (- (ly:pitch-octave inversion)
- (ly:pitch-octave original-inv-pitch)))
- (set! nots (cons inv-note nots))))
+ (begin
+ (set! (ly:music-property inv-note 'inversion) #t)
+ (set! (ly:music-property inv-note 'octavation)
+ (- (ly:pitch-octave inversion)
+ (ly:pitch-octave original-inv-pitch)))
+ (set! nots (cons inv-note nots))))
nots))
;;;;;;;;;;;;;;;;
-; chord modifiers change the pitch list.
+ ; chord modifiers change the pitch list.
(define (aug-modifier pitches)
(set! pitches (replace-step (ly:make-pitch 0 4 SHARP) pitches))
@@ -229,20 +229,20 @@ DURATION, and INVERSION."
;; canonical 13 chord.
(define the-canonical-chord
(map (lambda (n)
- (define (nca x)
- (if (= x 7) FLAT 0))
+ (define (nca x)
+ (if (= x 7) FLAT 0))
- (if (>= n 8)
- (ly:make-pitch 1 (- n 8) (nca n))
- (ly:make-pitch 0 (- n 1) (nca n))))
+ (if (>= n 8)
+ (ly:make-pitch 1 (- n 8) (nca n))
+ (ly:make-pitch 0 (- n 1) (nca n))))
'(1 3 5 7 9 11 13)))
(define (stack-thirds upper-step base)
"Stack thirds listed in BASE until we reach UPPER-STEP. Add
UPPER-STEP separately."
(cond ((null? base) '())
- ((> (ly:pitch-steps upper-step) (ly:pitch-steps (car base)))
- (cons (car base) (stack-thirds upper-step (cdr base))))
- ((<= (ly:pitch-steps upper-step) (ly:pitch-steps (car base)))
- (list upper-step))
- (else '())))
+ ((> (ly:pitch-steps upper-step) (ly:pitch-steps (car base)))
+ (cons (car base) (stack-thirds upper-step (cdr base))))
+ ((<= (ly:pitch-steps upper-step) (ly:pitch-steps (car base)))
+ (list upper-step))
+ (else '())))
diff --git a/scm/chord-generic-names.scm b/scm/chord-generic-names.scm
index abc39e3518..c366a70b54 100644
--- a/scm/chord-generic-names.scm
+++ b/scm/chord-generic-names.scm
@@ -23,7 +23,7 @@
(define (default-note-namer pitch)
- (note-name->markup pitch #f))
+ (note-name->markup pitch #f))
(define (markup-or-empty-markup markup)
"Return MARKUP if markup, else empty-markup"
@@ -34,7 +34,7 @@
(if bool
(make-line-markup
(list (make-hspace-markup amount)
- markup))
+ markup))
markup))
(define-public (banter-chord-names pitches bass inversion context)
@@ -46,7 +46,7 @@
'jazz pitches bass inversion context '()))
(define-public (ugh-compat-double-plus-new-chord->markup
- style pitches bass inversion context options)
+ style pitches bass inversion context options)
"Entry point for @code{New_chord_name_engraver}.
FIXME: func, options/context have changed
@@ -57,35 +57,35 @@ See @file{double-plus-new-chord-name.scm} for the signature of @var{style}.
(define (step-nr pitch)
(let* ((pitch-nr (+ (* 7 (ly:pitch-octave pitch))
- (ly:pitch-notename pitch)))
- (root-nr (+ (* 7 (ly:pitch-octave (car pitches)))
- (ly:pitch-notename (car pitches)))))
+ (ly:pitch-notename pitch)))
+ (root-nr (+ (* 7 (ly:pitch-octave (car pitches)))
+ (ly:pitch-notename (car pitches)))))
(+ 1 (- pitch-nr root-nr))))
(define (next-third pitch)
(ly:pitch-transpose pitch
- (ly:make-pitch 0 2 (if (or (= (step-nr pitch) 3)
- (= (step-nr pitch) 5))
- FLAT 0))))
+ (ly:make-pitch 0 2 (if (or (= (step-nr pitch) 3)
+ (= (step-nr pitch) 5))
+ FLAT 0))))
(define (step-alteration pitch)
(let* ((diff (ly:pitch-diff (ly:make-pitch 0 0 0) (car pitches)))
- (normalized-pitch (ly:pitch-transpose pitch diff))
- (alteration (ly:pitch-alteration normalized-pitch)))
+ (normalized-pitch (ly:pitch-transpose pitch diff))
+ (alteration (ly:pitch-alteration normalized-pitch)))
(if (= (step-nr pitch) 7) (+ alteration SEMI-TONE) alteration)))
(define (pitch-unalter pitch)
(let ((alteration (step-alteration pitch)))
(if (= alteration 0)
- pitch
- (ly:make-pitch (ly:pitch-octave pitch) (ly:pitch-notename pitch)
- (- (ly:pitch-alteration pitch) alteration)))))
+ pitch
+ (ly:make-pitch (ly:pitch-octave pitch) (ly:pitch-notename pitch)
+ (- (ly:pitch-alteration pitch) alteration)))))
(define (step-even-or-altered? pitch)
(let ((nr (step-nr pitch)))
(if (!= (modulo nr 2) 0)
- (!= (step-alteration pitch) 0)
- #t)))
+ (!= (step-alteration pitch) 0)
+ #t)))
(define (step->markup-plusminus pitch)
(make-line-markup
@@ -93,111 +93,111 @@ See @file{double-plus-new-chord-name.scm} for the signature of @var{style}.
(make-simple-markup (number->string (step-nr pitch)))
(make-simple-markup
(case (step-alteration pitch)
- ((DOUBLE-FLAT) "--")
- ((FLAT) "-")
- ((NATURAL) "")
- ((SHARP) "+")
- ((DOUBLE-SHARP) "++"))))))
+ ((DOUBLE-FLAT) "--")
+ ((FLAT) "-")
+ ((NATURAL) "")
+ ((SHARP) "+")
+ ((DOUBLE-SHARP) "++"))))))
(define (step->markup-accidental pitch)
(make-line-markup
(list (accidental->markup (step-alteration pitch))
- (make-simple-markup (number->string (step-nr pitch))))))
+ (make-simple-markup (number->string (step-nr pitch))))))
(define (step->markup-ignatzek pitch)
(make-line-markup
(if (and (= (step-nr pitch) 7)
- (= (step-alteration pitch) 1))
- (list (ly:context-property context 'majorSevenSymbol))
- (list (accidental->markup (step-alteration pitch))
- (make-simple-markup (number->string (step-nr pitch)))))))
+ (= (step-alteration pitch) 1))
+ (list (ly:context-property context 'majorSevenSymbol))
+ (list (accidental->markup (step-alteration pitch))
+ (make-simple-markup (number->string (step-nr pitch)))))))
;; tja, kennok
(define (make-sub->markup step->markup)
(lambda (pitch)
(make-line-markup (list (make-simple-markup "no")
- (step->markup pitch)))))
+ (step->markup pitch)))))
(define (step-based-sub->markup step->markup pitch)
(make-line-markup (list (make-simple-markup "no") (step->markup pitch))))
(define (get-full-list pitch)
(if (<= (step-nr pitch) (step-nr (last pitches)))
- (cons pitch (get-full-list (next-third pitch)))
- '()))
+ (cons pitch (get-full-list (next-third pitch)))
+ '()))
(define (get-consecutive nr pitches)
(if (pair? pitches)
- (let* ((pitch-nr (step-nr (car pitches)))
- (next-nr (if (!= (modulo pitch-nr 2) 0) (+ pitch-nr 2) nr)))
- (if (<= pitch-nr nr)
- (cons (car pitches) (get-consecutive next-nr (cdr pitches)))
- '()))
- '()))
+ (let* ((pitch-nr (step-nr (car pitches)))
+ (next-nr (if (!= (modulo pitch-nr 2) 0) (+ pitch-nr 2) nr)))
+ (if (<= pitch-nr nr)
+ (cons (car pitches) (get-consecutive next-nr (cdr pitches)))
+ '()))
+ '()))
(define (full-match exceptions)
(if (pair? exceptions)
- (let* ((e (car exceptions))
- (e-pitches (car e)))
- (if (equal? e-pitches pitches)
- e
- (full-match (cdr exceptions))))
- #f))
+ (let* ((e (car exceptions))
+ (e-pitches (car e)))
+ (if (equal? e-pitches pitches)
+ e
+ (full-match (cdr exceptions))))
+ #f))
(define (partial-match exceptions)
(if (pair? exceptions)
- (let* ((e (car exceptions))
- (e-pitches (car e)))
- (if (equal? e-pitches (take pitches (length e-pitches)))
- e
- (partial-match (cdr exceptions))))
- #f))
+ (let* ((e (car exceptions))
+ (e-pitches (car e)))
+ (if (equal? e-pitches (take pitches (length e-pitches)))
+ e
+ (partial-match (cdr exceptions))))
+ #f))
(if #f (begin
- (write-me "pitches: " pitches)))
+ (write-me "pitches: " pitches)))
(let* ((full-exceptions
- (ly:context-property context 'chordNameExceptionsFull))
- (full-exception (full-match full-exceptions))
- (full-markup (if full-exception (cadr full-exception) '()))
- (partial-exceptions
- (ly:context-property context 'chordNameExceptionsPartial))
- (partial-exception (partial-match partial-exceptions))
- (partial-pitches (if partial-exception (car partial-exception) '()))
- (partial-markup-prefix
- (if partial-exception (markup-or-empty-markup
- (cadr partial-exception)) empty-markup))
- (partial-markup-suffix
- (if (and partial-exception (pair? (cddr partial-exception)))
- (markup-or-empty-markup (caddr partial-exception)) empty-markup))
- (root (car pitches))
- (full (get-full-list root))
- ;; kludge alert: replace partial matched lower part of all with
- ;; 'normal' pitches from full
- ;; (all pitches)
- (all (append (take full (length partial-pitches))
- (drop pitches (length partial-pitches))))
-
- (highest (last all))
- (missing (list-minus full (map pitch-unalter all)))
- (consecutive (get-consecutive 1 all))
- (rest (list-minus all consecutive))
- (altered (filter step-even-or-altered? all))
- (cons-alt (filter step-even-or-altered? consecutive))
- (base (list-minus consecutive altered)))
+ (ly:context-property context 'chordNameExceptionsFull))
+ (full-exception (full-match full-exceptions))
+ (full-markup (if full-exception (cadr full-exception) '()))
+ (partial-exceptions
+ (ly:context-property context 'chordNameExceptionsPartial))
+ (partial-exception (partial-match partial-exceptions))
+ (partial-pitches (if partial-exception (car partial-exception) '()))
+ (partial-markup-prefix
+ (if partial-exception (markup-or-empty-markup
+ (cadr partial-exception)) empty-markup))
+ (partial-markup-suffix
+ (if (and partial-exception (pair? (cddr partial-exception)))
+ (markup-or-empty-markup (caddr partial-exception)) empty-markup))
+ (root (car pitches))
+ (full (get-full-list root))
+ ;; kludge alert: replace partial matched lower part of all with
+ ;; 'normal' pitches from full
+ ;; (all pitches)
+ (all (append (take full (length partial-pitches))
+ (drop pitches (length partial-pitches))))
+
+ (highest (last all))
+ (missing (list-minus full (map pitch-unalter all)))
+ (consecutive (get-consecutive 1 all))
+ (rest (list-minus all consecutive))
+ (altered (filter step-even-or-altered? all))
+ (cons-alt (filter step-even-or-altered? consecutive))
+ (base (list-minus consecutive altered)))
(if #f (begin
- (write-me "full:" full)
- ;; (write-me "partial-pitches:" partial-pitches)
- (write-me "full-markup:" full-markup)
- (write-me "partial-markup-perfix:" partial-markup-prefix)
- (write-me "partial-markup-suffix:" partial-markup-suffix)
- (write-me "all:" all)
- (write-me "altered:" altered)
- (write-me "missing:" missing)
- (write-me "consecutive:" consecutive)
- (write-me "rest:" rest)
- (write-me "base:" base)))
+ (write-me "full:" full)
+ ;; (write-me "partial-pitches:" partial-pitches)
+ (write-me "full-markup:" full-markup)
+ (write-me "partial-markup-perfix:" partial-markup-prefix)
+ (write-me "partial-markup-suffix:" partial-markup-suffix)
+ (write-me "all:" all)
+ (write-me "altered:" altered)
+ (write-me "missing:" missing)
+ (write-me "consecutive:" consecutive)
+ (write-me "rest:" rest)
+ (write-me "base:" base)))
(case style
((banter)
@@ -206,36 +206,36 @@ See @file{double-plus-new-chord-name.scm} for the signature of @var{style}.
;; + subs:missing
(let* ((root->markup (assoc-get
- 'root->markup options default-note-namer))
- (step->markup (assoc-get
- 'step->markup options step->markup-plusminus))
- (sub->markup (assoc-get
- 'sub->markup options
- (lambda (x)
- (step-based-sub->markup step->markup x))))
- (sep (assoc-get
- 'separator options (make-simple-markup "/"))))
-
- (if
- (pair? full-markup)
- (make-line-markup (list (root->markup root) full-markup))
-
- (make-line-markup
- (list
- (root->markup root)
- partial-markup-prefix
- (make-normal-size-super-markup
- (markup-join
- (apply append
- (map step->markup
- (append altered
- (if (and (> (step-nr highest) 5)
- (not
- (step-even-or-altered? highest)))
- (list highest) '())))
- (list partial-markup-suffix)
- (list (map sub->markup missing)))
- sep)))))))
+ 'root->markup options default-note-namer))
+ (step->markup (assoc-get
+ 'step->markup options step->markup-plusminus))
+ (sub->markup (assoc-get
+ 'sub->markup options
+ (lambda (x)
+ (step-based-sub->markup step->markup x))))
+ (sep (assoc-get
+ 'separator options (make-simple-markup "/"))))
+
+ (if
+ (pair? full-markup)
+ (make-line-markup (list (root->markup root) full-markup))
+
+ (make-line-markup
+ (list
+ (root->markup root)
+ partial-markup-prefix
+ (make-normal-size-super-markup
+ (markup-join
+ (apply append
+ (map step->markup
+ (append altered
+ (if (and (> (step-nr highest) 5)
+ (not
+ (step-even-or-altered? highest)))
+ (list highest) '())))
+ (list partial-markup-suffix)
+ (list (map sub->markup missing)))
+ sep)))))))
((jazz)
@@ -244,49 +244,49 @@ See @file{double-plus-new-chord-name.scm} for the signature of @var{style}.
;; + 'add'
;; + steps:rest
(let* ((root->markup (assoc-get
- 'root->markup options default-note-namer))
- (step->markup
- (assoc-get
- ;; FIXME: ignatzek
- ;;'step->markup options step->markup-accidental))
- 'step->markup options step->markup-ignatzek))
- (sep (assoc-get
- 'separator options (make-simple-markup " ")))
- (add-prefix (assoc-get 'add-prefix options
- (make-simple-markup " add"))))
-
- (if
- (pair? full-markup)
- (make-line-markup (list (root->markup root) full-markup))
-
- (make-line-markup
- (list
- (root->markup root)
- partial-markup-prefix
- (make-normal-size-super-markup
- (make-line-markup
- (list
-
- ;; kludge alert: omit <= 5
- ;;(markup-join (map step->markup
- ;; (cons (last base) cons-alt)) sep)
-
- ;; This fixes:
- ;; c C5 -> C
- ;; c:2 C5 2 -> C2
- ;; c:3- Cm5 -> Cm
- ;; c:6.9 C5 6add9 -> C6 add 9 (add?)
- ;; ch = \chords { c c:2 c:3- c:6.9^7 }
- (markup-join (map step->markup
- (let ((tb (last base)))
- (if (> (step-nr tb) 5)
- (cons tb cons-alt)
- cons-alt))) sep)
-
- (if (pair? rest)
- add-prefix
- empty-markup)
- (markup-join (map step->markup rest) sep)
- partial-markup-suffix))))))))
-
- (else empty-markup))))
+ 'root->markup options default-note-namer))
+ (step->markup
+ (assoc-get
+ ;; FIXME: ignatzek
+ ;;'step->markup options step->markup-accidental))
+ 'step->markup options step->markup-ignatzek))
+ (sep (assoc-get
+ 'separator options (make-simple-markup " ")))
+ (add-prefix (assoc-get 'add-prefix options
+ (make-simple-markup " add"))))
+
+ (if
+ (pair? full-markup)
+ (make-line-markup (list (root->markup root) full-markup))
+
+ (make-line-markup
+ (list
+ (root->markup root)
+ partial-markup-prefix
+ (make-normal-size-super-markup
+ (make-line-markup
+ (list
+
+ ;; kludge alert: omit <= 5
+ ;;(markup-join (map step->markup
+ ;; (cons (last base) cons-alt)) sep)
+
+ ;; This fixes:
+ ;; c C5 -> C
+ ;; c:2 C5 2 -> C2
+ ;; c:3- Cm5 -> Cm
+ ;; c:6.9 C5 6add9 -> C6 add 9 (add?)
+ ;; ch = \chords { c c:2 c:3- c:6.9^7 }
+ (markup-join (map step->markup
+ (let ((tb (last base)))
+ (if (> (step-nr tb) 5)
+ (cons tb cons-alt)
+ cons-alt))) sep)
+
+ (if (pair? rest)
+ add-prefix
+ empty-markup)
+ (markup-join (map step->markup rest) sep)
+ partial-markup-suffix))))))))
+
+ (else empty-markup))))
diff --git a/scm/chord-name.scm b/scm/chord-name.scm
index 606d806660..c75d91ba97 100644
--- a/scm/chord-name.scm
+++ b/scm/chord-name.scm
@@ -35,8 +35,8 @@
(make-smaller-markup
(make-raise-markup
(if (= alteration FLAT)
- 0.3
- 0.6)
+ 0.3
+ 0.6)
(make-musicglyph-markup
(assoc-get alteration standard-alteration-glyph-name-alist "")))))
@@ -55,9 +55,9 @@
(make-line-markup
(list
(make-hspace-markup (if (= alteration FLAT) 0.57285385 0.5))
- (make-raise-markup 0.7 (alteration->text-accidental-markup alteration))
- (make-hspace-markup (if (= alteration SHARP) 0.2 0.1))
- ))))
+ (make-raise-markup 0.7 (alteration->text-accidental-markup alteration))
+ (make-hspace-markup (if (= alteration SHARP) 0.2 0.1))
+ ))))
(define-public (note-name->markup pitch lowercase?)
"Return pitch markup for @var{pitch}."
@@ -73,38 +73,38 @@
(inexact->exact (round (* (ly:pitch-alteration pitch) 2))))
(define-safe-public ((chord-name->german-markup B-instead-of-Bb)
- pitch lowercase?)
+ pitch lowercase?)
"Return pitch markup for PITCH, using german note names.
If B-instead-of-Bb is set to #t real german names are returned.
Otherwise semi-german names (with Bb and below keeping the british names)
"
(let* ((name (ly:pitch-notename pitch))
(alt-semitones (pitch-alteration-semitones pitch))
- (n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
- (cons 7 (+ (if B-instead-of-Bb 1 0) alt-semitones))
- (cons name alt-semitones))))
+ (n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
+ (cons 7 (+ (if B-instead-of-Bb 1 0) alt-semitones))
+ (cons name alt-semitones))))
(make-line-markup
(list
(make-simple-markup
(conditional-string-downcase
- (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
- lowercase?))
+ (vector-ref #("C" "D" "E" "F" "G" "A" "H" "B") (car n-a))
+ lowercase?))
(make-normal-size-super-markup
(accidental->markup (/ (cdr n-a) 2)))))))
(define-safe-public (note-name->german-markup pitch lowercase?)
(let* ((name (ly:pitch-notename pitch))
- (alt-semitones (pitch-alteration-semitones pitch))
- (n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
- (cons 7 (+ 1 alt-semitones))
- (cons name alt-semitones))))
+ (alt-semitones (pitch-alteration-semitones pitch))
+ (n-a (if (member (cons name alt-semitones) `((6 . -1) (6 . -2)))
+ (cons 7 (+ 1 alt-semitones))
+ (cons name alt-semitones))))
(make-line-markup
(list
(string-append
(list-ref '("c" "d" "e" "f" "g" "a" "h" "b") (car n-a))
(if (or (equal? (car n-a) 2) (equal? (car n-a) 5))
- (list-ref '( "ses" "s" "" "is" "isis") (+ 2 (cdr n-a)))
- (list-ref '("eses" "es" "" "is" "isis") (+ 2 (cdr n-a)))))))))
+ (list-ref '( "ses" "s" "" "is" "isis") (+ 2 (cdr n-a)))
+ (list-ref '("eses" "es" "" "is" "isis") (+ 2 (cdr n-a)))))))))
(define-public ((chord-name->italian-markup re-with-eacute) pitch lowercase?)
"Return pitch markup for @var{pitch}, using Italian/@/French note names.
@@ -117,12 +117,12 @@ pitch@tie{}D instead of `re'."
(list
(make-simple-markup
(conditional-string-downcase
- (vector-ref
- (if re-with-eacute
- #("Do" "Ré" "Mi" "Fa" "Sol" "La" "Si")
- #("Do" "Re" "Mi" "Fa" "Sol" "La" "Si"))
- name)
- lowercase?))
+ (vector-ref
+ (if re-with-eacute
+ #("Do" "Ré" "Mi" "Fa" "Sol" "La" "Si")
+ #("Do" "Re" "Mi" "Fa" "Sol" "La" "Si"))
+ name)
+ lowercase?))
(accidental->markup-italian alt)
))))
@@ -136,29 +136,29 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
(define (chord-to-exception-entry m)
(let* ((elts (ly:music-property m 'elements))
- (omit-root (and (pair? rest) (car rest)))
- (pitches (map (lambda (x) (ly:music-property x 'pitch))
- (filter
- (lambda (y) (memq 'note-event
- (ly:music-property y 'types)))
- elts)))
- (sorted (sort pitches ly:pitch<?))
- (root (car sorted))
-
- ;; ugh?
- ;;(diff (ly:pitch-diff root (ly:make-pitch -1 0 0)))
- ;; FIXME. This results in #<Pitch c> ...,
- ;; but that is what we need because default octave for
- ;; \chords has changed to c' too?
- (diff (ly:pitch-diff root (ly:make-pitch 0 0 0)))
- (normalized (map (lambda (x) (ly:pitch-diff x diff)) sorted))
- (texts (map (lambda (x) (ly:music-property x 'text))
- (filter
- (lambda (y) (memq 'text-script-event
- (ly:music-property y 'types)))
- elts)))
-
- (text (if (null? texts) #f (if omit-root (car texts) texts))))
+ (omit-root (and (pair? rest) (car rest)))
+ (pitches (map (lambda (x) (ly:music-property x 'pitch))
+ (filter
+ (lambda (y) (memq 'note-event
+ (ly:music-property y 'types)))
+ elts)))
+ (sorted (sort pitches ly:pitch<?))
+ (root (car sorted))
+
+ ;; ugh?
+ ;;(diff (ly:pitch-diff root (ly:make-pitch -1 0 0)))
+ ;; FIXME. This results in #<Pitch c> ...,
+ ;; but that is what we need because default octave for
+ ;; \chords has changed to c' too?
+ (diff (ly:pitch-diff root (ly:make-pitch 0 0 0)))
+ (normalized (map (lambda (x) (ly:pitch-diff x diff)) sorted))
+ (texts (map (lambda (x) (ly:music-property x 'text))
+ (filter
+ (lambda (y) (memq 'text-script-event
+ (ly:music-property y 'types)))
+ elts)))
+
+ (text (if (null? texts) #f (if omit-root (car texts) texts))))
(cons (if omit-root (cdr normalized) normalized) text)))
(define (is-event-chord? m)
@@ -167,6 +167,6 @@ FOOBAR-MARKUP) if OMIT-ROOT is given and non-false.
(not (equal? ZERO-MOMENT (ly:music-length m)))))
(let* ((elts (filter is-event-chord? (ly:music-property seq 'elements)))
- (alist (map chord-to-exception-entry elts)))
+ (alist (map chord-to-exception-entry elts)))
(filter (lambda (x) (cdr x)) alist)))
diff --git a/scm/clip-region.scm b/scm/clip-region.scm
index 890cb657e3..5cfc4449e7 100644
--- a/scm/clip-region.scm
+++ b/scm/clip-region.scm
@@ -25,18 +25,18 @@
;; scm/output-lib.scm
;;
;;
-;; (define-public (make-rhythmic-location bar-num num den)
-;; (define-public (rhythmic-location? a)
-;; (define-public (make-graceless-rhythmic-location loc)
-;; (define-public rhythmic-location-measure-position cdr)
-;; (define-public rhythmic-location-bar-number car)
-;; (define-public (rhythmic-location<? a b)
-;; (define-public (rhythmic-location<=? a b)
-;; (define-public (rhythmic-location>=? a b)
-;; (define-public (rhythmic-location>? a b)
-;; (define-public (rhythmic-location=? a b)
-;; (define-public (rhythmic-location->file-string a)
-;; (define-public (rhythmic-location->string a)
+;; (define-public (make-rhythmic-location bar-num num den)
+;; (define-public (rhythmic-location? a)
+;; (define-public (make-graceless-rhythmic-location loc)
+;; (define-public rhythmic-location-measure-position cdr)
+;; (define-public rhythmic-location-bar-number car)
+;; (define-public (rhythmic-location<? a b)
+;; (define-public (rhythmic-location<=? a b)
+;; (define-public (rhythmic-location>=? a b)
+;; (define-public (rhythmic-location>? a b)
+;; (define-public (rhythmic-location=? a b)
+;; (define-public (rhythmic-location->file-string a)
+;; (define-public (rhythmic-location->string a)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -59,52 +59,52 @@
(region-end (cdr clip-region))
(found-grace-end #f)
(candidate-columns
- (filter
- (lambda (j)
- (let*
- ((column (ly:grob-array-ref columns j))
- (loc (ly:grob-property column 'rhythmic-location))
- (grace-less (make-graceless-rhythmic-location loc))
- )
+ (filter
+ (lambda (j)
+ (let*
+ ((column (ly:grob-array-ref columns j))
+ (loc (ly:grob-property column 'rhythmic-location))
+ (grace-less (make-graceless-rhythmic-location loc))
+ )
- (and (rhythmic-location? loc)
- (rhythmic-location<=? region-start loc)
- (or (rhythmic-location<? grace-less region-end)
- (and (rhythmic-location=? grace-less region-end)
- (eq? #t (ly:grob-property column 'non-musical))
+ (and (rhythmic-location? loc)
+ (rhythmic-location<=? region-start loc)
+ (or (rhythmic-location<? grace-less region-end)
+ (and (rhythmic-location=? grace-less region-end)
+ (eq? #t (ly:grob-property column 'non-musical))
- )))
+ )))
- ))
+ ))
- (iota (ly:grob-array-length columns))))
+ (iota (ly:grob-array-length columns))))
(column-range
- (if (>= 1 (length candidate-columns))
- #f
- (cons (car candidate-columns)
- (car (last-pair candidate-columns)))))
+ (if (>= 1 (length candidate-columns))
+ #f
+ (cons (car candidate-columns)
+ (car (last-pair candidate-columns)))))
(clipped-x-interval
- (if column-range
- (cons
-
- (interval-start
- (ly:grob-robust-relative-extent
- (if (= 0 (car column-range))
- system-grob
- (ly:grob-array-ref columns (car column-range)))
- system-grob X))
-
- (interval-end
- (ly:grob-robust-relative-extent
- (if (= (1- (ly:grob-array-length columns)) (cdr column-range))
- system-grob
- (ly:grob-array-ref columns (cdr column-range)))
- system-grob X)))
-
-
- #f
- )))
+ (if column-range
+ (cons
+
+ (interval-start
+ (ly:grob-robust-relative-extent
+ (if (= 0 (car column-range))
+ system-grob
+ (ly:grob-array-ref columns (car column-range)))
+ system-grob X))
+
+ (interval-end
+ (ly:grob-robust-relative-extent
+ (if (= (1- (ly:grob-array-length columns)) (cdr column-range))
+ system-grob
+ (ly:grob-array-ref columns (cdr column-range)))
+ system-grob X)))
+
+
+ #f
+ )))
clipped-x-interval))
diff --git a/scm/coverage.scm b/scm/coverage.scm
index 3c210555ae..75016517a2 100644
--- a/scm/coverage.scm
+++ b/scm/coverage.scm
@@ -3,28 +3,28 @@
(define-module (scm coverage))
(use-modules (lily)
- (ice-9 rdelim)
- (ice-9 regex)
- (ice-9 format) ;; needed for ~8@
- )
+ (ice-9 rdelim)
+ (ice-9 regex)
+ (ice-9 format) ;; needed for ~8@
+ )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (coverage:show-all filter?)
(let*
((keys
- (filter filter?
- (sort (map car (hash-table->alist coverage-table)) string<? ))))
-
- (newline)
- (for-each
- (lambda (k)
+ (filter filter?
+ (sort (map car (hash-table->alist coverage-table)) string<? ))))
- (format #t "Coverage for file: ~a\n" k)
- (display-coverage
- k (hash-ref coverage-table k)
- (format #f "~a.cov" (basename k))))
- keys)))
+ (newline)
+ (for-each
+ (lambda (k)
+
+ (format #t "Coverage for file: ~a\n" k)
+ (display-coverage
+ k (hash-ref coverage-table k)
+ (format #f "~a.cov" (basename k))))
+ keys)))
(define-public (coverage:enable)
@@ -32,7 +32,7 @@
(trap-enable 'memoize-symbol)
(trap-enable 'traps))
-
+
(define-public (coverage:disable)
(trap-set! memoize-symbol-handler #f)
(trap-disable 'memoize-symbol))
@@ -49,27 +49,27 @@
((lines (read-lines (open-file file "r")))
(format-str "~8@a: ~5@a:~a\n")
(out (if out-file (open-output-file out-file)
- (current-output-port))))
+ (current-output-port))))
(format out format-str "-" 0 (format #f "Source:~a" file))
(do
- ((i 0 (1+ i))
- (l lines (cdr l)))
- ((or (null? l) ))
+ ((i 0 (1+ i))
+ (l lines (cdr l)))
+ ((or (null? l) ))
(format out format-str
- (cond
- ((and (< i (vector-length vec)) (vector-ref vec i)) "1")
- ((and (string-contains file ".ly") (string-match "^[ \t]*%.*$" (car l)))
- "-")
- ((string-match "^[ \t]*[()'`,]*$" (car l))
- "-")
- ((string-match "^[ \t]*;.*$" (car l))
-
- "-")
- (else "0"))
- (1+ i)
- (car l)))))
+ (cond
+ ((and (< i (vector-length vec)) (vector-ref vec i)) "1")
+ ((and (string-contains file ".ly") (string-match "^[ \t]*%.*$" (car l)))
+ "-")
+ ((string-match "^[ \t]*[()'`,]*$" (car l))
+ "-")
+ ((string-match "^[ \t]*;.*$" (car l))
+
+ "-")
+ (else "0"))
+ (1+ i)
+ (car l)))))
(define (record-coverage key cont exp env)
(let*
@@ -78,20 +78,20 @@
(vec (and name (hash-ref coverage-table name #f)))
(veclen (and vec (vector-length vec)))
(veccopy (lambda (src dst)
- (vector-move-left! src 0 (vector-length src)
- dst 0)
- dst)))
+ (vector-move-left! src 0 (vector-length src)
+ dst 0)
+ dst)))
(if (and line name)
- (begin
- (if (or (not vec) (>= line (vector-length vec)))
- (set! vec
- (hash-set! coverage-table name
- (if vec
- (veccopy vec (make-vector (1+ line) #f))
- (make-vector (1+ line) #f)))))
-
- (vector-set! vec line #t))
- )))
+ (begin
+ (if (or (not vec) (>= line (vector-length vec)))
+ (set! vec
+ (hash-set! coverage-table name
+ (if vec
+ (veccopy vec (make-vector (1+ line) #f))
+ (make-vector (1+ line) #f)))))
+
+ (vector-set! vec line #t))
+ )))
diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm
index 4839493dd7..baf8163518 100644
--- a/scm/define-context-properties.scm
+++ b/scm/define-context-properties.scm
@@ -21,9 +21,9 @@
(define (translator-property-description symbol type? description)
(if (not (and
- (symbol? symbol)
- (procedure? type?)
- (string? description)))
+ (symbol? symbol)
+ (procedure? type?)
+ (string? description)))
(throw 'init-format-error))
@@ -516,9 +516,9 @@ voices is preserved.
@example
@{
r1 r1*3 R1*3
- \\set Score.skipBars= ##t
- r1*3 R1*3
-@}
+ \\set Score.skipBars= ##t
+ r1*3 R1*3
+ @}
@end example")
(skipTypesetting ,boolean? "If true, no typesetting is done,
speeding up the interpretation phase. Useful for debugging large
@@ -714,7 +714,7 @@ and subscripts. See @file{scm/@/script.scm} for more information.")
(define-public all-translation-properties
(append all-user-translation-properties
- all-internal-translation-properties))
+ all-internal-translation-properties))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm
index 9b00af992b..fb790a591f 100644
--- a/scm/define-event-classes.scm
+++ b/scm/define-event-classes.scm
@@ -22,10 +22,10 @@
(define event-classes
'((() . (StreamEvent))
(StreamEvent .
- (RemoveContext
- ChangeParent Override Revert UnsetProperty SetProperty
- music-event OldMusicEvent CreateContext Prepare
- OneTimeStep Finish))
+ (RemoveContext
+ ChangeParent Override Revert UnsetProperty SetProperty
+ music-event OldMusicEvent CreateContext Prepare
+ OneTimeStep Finish))
(music-event . (annotate-output-event
footnote-event arpeggio-event breathing-event
extender-event span-event rhythmic-event dynamic-event
@@ -57,9 +57,9 @@
(pedal-event . (sostenuto-event sustain-event una-corda-event))
(rhythmic-event . (lyric-event
melodic-event multi-measure-rest-event
- double-percent-event percent-event
- repeat-slash-event rest-event
- skip-event bass-figure-event))
+ double-percent-event percent-event
+ repeat-slash-event rest-event
+ skip-event bass-figure-event))
(melodic-event . (cluster-note-event note-event))
(() . (Announcement))
(Announcement . (AnnounceNewContext))
@@ -68,15 +68,15 @@
(define-public (event-class-cons class parent classlist)
(let ((lineage (assq parent classlist)))
(if (not lineage)
- (begin
- (if (not (null? parent))
- (ly:warning (_ "unknown parent class `~a'") parent))
- (set! lineage '())))
+ (begin
+ (if (not (null? parent))
+ (ly:warning (_ "unknown parent class `~a'") parent))
+ (set! lineage '())))
(if (symbol? class)
- (acons class lineage classlist)
- (fold (lambda (elt alist)
- (acons elt lineage alist))
- classlist class))))
+ (acons class lineage classlist)
+ (fold (lambda (elt alist)
+ (acons elt lineage alist))
+ classlist class))))
;; Each class will be defined as
;; (class parent grandparent .. )
@@ -88,8 +88,8 @@
(define-public all-event-classes
(fold (lambda (elt classlist)
- (event-class-cons (cdr elt) (car elt) classlist))
- '() event-classes))
+ (event-class-cons (cdr elt) (car elt) classlist))
+ '() event-classes))
;; does this exist in guile already?
(define (map-tree f t)
@@ -104,24 +104,24 @@
(define (expand-event-tree root)
(let ((children (assq root event-classes)))
(if children
- (cons root (map expand-event-tree (cdr children)))
- root)))
+ (cons root (map expand-event-tree (cdr children)))
+ root)))
;; produce neater representation of music event tree.
;; TODO: switch to this representation for the event-classes list?
(define music-event-tree (expand-event-tree 'music-event))
(define (sort-tree t)
(define (stringify el)
- (if (symbol? el)
- (symbol->string el)
- (symbol->string (first el))))
+ (if (symbol? el)
+ (symbol->string el)
+ (symbol->string (first el))))
(if (list? t)
(sort (map (lambda (el)
- (if (list? el)
- (cons (car el) (sort-tree (cdr el)))
- el))
- t)
- (lambda (a b) (string<? (stringify a) (stringify b))))
+ (if (list? el)
+ (cons (car el) (sort-tree (cdr el)))
+ el))
+ t)
+ (lambda (a b) (string<? (stringify a) (stringify b))))
t))
;;(use-modules (ice-9 pretty-print))
@@ -135,29 +135,29 @@
;; Special case for lists reduces stack consumption.
((list? e) (map simplify e))
((pair? e) (cons (simplify (car e))
- (simplify (cdr e))))
+ (simplify (cdr e))))
((ly:stream-event? e)
(list 'unquote (list 'make-stream-event (simplify (Stream_event::dump e)))))
((ly:music? e)
(list 'unquote (music->make-music e)))
((ly:moment? e)
(list 'unquote `(ly:make-moment
- ,(ly:moment-main-numerator e)
- ,(ly:moment-main-denominator e)
- . ,(if (zero? (ly:moment-grace-numerator e))
- '()
- (list (ly:moment-grace-numerator e)
- (ly:moment-grace-denominator e))))))
+ ,(ly:moment-main-numerator e)
+ ,(ly:moment-main-denominator e)
+ . ,(if (zero? (ly:moment-grace-numerator e))
+ '()
+ (list (ly:moment-grace-numerator e)
+ (ly:moment-grace-denominator e))))))
((ly:duration? e)
(list 'unquote `(ly:make-duration
- ,(ly:duration-log e)
- ,(ly:duration-dot-count e)
- ,(ly:duration-scale))))
+ ,(ly:duration-log e)
+ ,(ly:duration-dot-count e)
+ ,(ly:duration-scale))))
((ly:pitch? e)
(list 'unquote `(ly:make-pitch
- ,(ly:pitch-octave e)
- ,(ly:pitch-notename e)
- ,(ly:pitch-alteration e))))
+ ,(ly:pitch-octave e)
+ ,(ly:pitch-notename e)
+ ,(ly:pitch-alteration e))))
((ly:input-location? e)
(list 'unquote '(ly:dummy-input-location)))
(#t e)))
diff --git a/scm/define-grob-interfaces.scm b/scm/define-grob-interfaces.scm
index ad4f96e4bb..54d360903a 100644
--- a/scm/define-grob-interfaces.scm
+++ b/scm/define-grob-interfaces.scm
@@ -78,10 +78,10 @@ found in @file{scm/bar-line.scm}.
(ly:add-interface
'clef-modifier-interface
- "The number describing transposition of the clef, placed below
+ "The number describing transposition of the clef, placed below
or above clef sign. Usually this is 8 (octave transposition)
or 15 (two octaves), but LilyPond allows any integer here."
- '())
+ '())
(ly:add-interface
'dynamic-interface
@@ -137,9 +137,9 @@ or 15 (two octaves), but LilyPond allows any integer here."
thickness))
(ly:add-interface
- 'glissando-interface
- "A glissando."
- '(glissando-index))
+ 'glissando-interface
+ "A glissando."
+ '(glissando-index))
(ly:add-interface
'grace-spacing-interface
diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm
index 6434c15c46..809083cf52 100644
--- a/scm/define-grob-properties.scm
+++ b/scm/define-grob-properties.scm
@@ -31,9 +31,9 @@
(apply define-grob-property x))
`(
-;;
-;; a
-;;
+ ;;
+ ;; a
+ ;;
(add-stem-support ,boolean? "If set, the @code{Stem} object is
included in this script's support.")
(after-line-breaking ,boolean? "Dummy property, used to trigger
@@ -79,9 +79,9 @@ and @code{around} behave like @code{ignore}.")
grobs, this should contain only one number.")
-;;
-;; b
-;;
+ ;;
+ ;; b
+ ;;
(bar-extent ,number-pair? "The Y-extent of the actual bar line.
This may differ from @code{Y-extent} because it does not include the
dots in a repeat bar line.")
@@ -168,9 +168,9 @@ stick out of its bounds?")
(broken-bound-padding ,number? "The amount of padding to insert
when a spanner is broken at a line break.")
-;;
-;; c
-;;
+ ;;
+ ;; c
+ ;;
(c0-position ,integer? "An integer indicating the position of
middle@tie{}C.")
(circled-tip ,boolean? "Put a circle at start/@/end of
@@ -205,9 +205,9 @@ this should list the control points of a third-order B@'ezier curve.")
receives this number. The following measures are numbered in
increments from this initial value.")
-;;
-;; d
-;;
+ ;;
+ ;; d
+ ;;
(damping ,number? "Amount of beam slope damping.")
(dash-definition ,pair? "List of @code{dash-elements} defining the
dash structure. Each @code{dash-element} has a starting t value,
@@ -248,9 +248,9 @@ elements closer together.")
i.e., @code{0} = whole note, @code{1} = half note, etc.")
-;;
-;; e
-;;
+ ;;
+ ;; e
+ ;;
(eccentricity ,number? "How asymmetrical to make a slur.
Positive means move the center to the right.")
(edge-height ,pair? "A pair of numbers specifying the heights of
@@ -282,9 +282,9 @@ item). In order to make a grob take up no horizontal space at all,
set this to @code{(+inf.0 . -inf.0)}.")
-;;
-;; f
-;;
+ ;;
+ ;; f
+ ;;
(flag-count ,number? "The number of tremolo beams.")
(flat-positions ,list? "Flats in key signatures are placed
within the specified ranges of staff-positions. The general form
@@ -423,9 +423,9 @@ read from the NonMusicalPaperColumn that begins the measure.")
(full-size-change ,boolean? "Don't make a change clef smaller.")
-;;
-;; g
-;;
+ ;;
+ ;; g
+ ;;
(gap ,ly:dimension? "Size of a gap in a variable symbol.")
(gap-count ,integer? "Number of gapped beams for tremolo.")
(glissando-skip ,boolean? "Should this @code{NoteHead} be skipped
@@ -446,9 +446,9 @@ etc. are already taken.")
(grow-direction ,ly:dir? "Crescendo or decrescendo?")
-;;
-;; h
-;;
+ ;;
+ ;; h
+ ;;
(hair-thickness ,number? "Thickness of the thin line in a bar
line.")
(harp-pedal-details ,list? "An alist of detailed grob properties
@@ -499,9 +499,9 @@ of @code{NoteColumn}s for horizontal shifting. This is used by
left and one to the right of this grob.")
-;;
-;; i
-;;
+ ;;
+ ;; i
+ ;;
(id ,string? "An id string for the grob. Depending on the typestting
backend being used, this id will be assigned to a group containing all of
the stencils that comprise a given grob. For example, in the svg backend,
@@ -518,9 +518,9 @@ configuration to this index, and print the respective scores.")
slur quants to this position, and print the respective scores.")
-;;
-;; k
-;;
+ ;;
+ ;; k
+ ;;
(keep-inside-line ,boolean? "If set, this column cannot have
objects sticking into the margin.")
(kern ,ly:dimension? "Amount of extra white space to add. For
@@ -531,9 +531,9 @@ correction amount for kneed beams. Set between @code{0} for no
correction and @code{1} for full correction.")
-;;
-;; l
-;;
+ ;;
+ ;; l
+ ;;
(labels ,list? "List of labels (symbols) placed on a column.")
(layer ,integer? "An integer which determines the order of printing
objects. Objects with the lowest value of layer are drawn first, then
@@ -572,9 +572,9 @@ contour.")
(long-text ,markup? "Text markup. See @ruser{Formatting text}.")
-;;
-;; m
-;;
+ ;;
+ ;; m
+ ;;
(max-beam-connect ,integer? "Maximum number of beams to connect
to beams from this stem. Further beams are typeset as beamlets.")
(max-stretch ,number? "The maximum amount that this
@@ -615,9 +615,9 @@ X@tie{}dimension, measured in @code{staff-space} units.")
Y@tie{}dimension, measured in @code{staff-space} units.")
-;;
-;; n
-;;
+ ;;
+ ;; n
+ ;;
(neutral-direction ,ly:dir? "Which direction to take in the
center of the staff.")
(neutral-position ,number? "Position (in half staff spaces) where
@@ -668,9 +668,9 @@ between 0 and 1.")
easy-notation note heads.")
-;;
-;; o
-;;
+ ;;
+ ;; o
+ ;;
(outside-staff-horizontal-padding ,number? "By default, an
outside-staff-object can be placed so that is it very close to another
grob horizontally. If this property is set, the outside-staff-object
@@ -702,9 +702,9 @@ of a potential collision, the grob with the smaller
@code{outside-staff-priority} is closer to the staff.")
-;;
-;; p
-;;
+ ;;
+ ;; p
+ ;;
(packed-spacing ,boolean? "If set, the notes are spaced as
tightly as possible.")
(padding ,ly:dimension? "Add this much extra space between
@@ -737,9 +737,9 @@ dot.")
(protrusion ,number? "In an arpeggio bracket, the length of the
horizontal edges.")
-;;
-;; r
-;;
+ ;;
+ ;; r
+ ;;
(ratio ,number? "Parameter for slur shape. The higher this
number, the quicker the slur attains its @code{height-limit}.")
(remove-empty ,boolean? "If set, remove group if it contains no
@@ -767,9 +767,9 @@ rest when the length of a measure is between two values of
in a 3/2 measure.")
-;;
-;; s
-;;
+ ;;
+ ;; s
+ ;;
(same-direction-correction ,number? "Optical correction amount
for stems that are placed in tight configurations. This amount is
used for stems with the same direction to compensate for note head to
@@ -945,11 +945,11 @@ typeset. Valid choices depend on the @code{stencil} callback reading
this property.")
-;;
-;; t
-;;
+ ;;
+ ;; t
+ ;;
(text ,markup? "Text markup. See @ruser{Formatting text}.")
-;;FIXME -- Should both be the same?
+ ;;FIXME -- Should both be the same?
(text-direction ,ly:dir? "This controls the ordering of the
words. The default @code{RIGHT} is for roman text. Arabic or Hebrew
should use @code{LEFT}.")
@@ -970,7 +970,7 @@ line just before it would otherwise stop.")
(toward-stem-shift ,number? "Amount by which scripts are shifted
toward the stem if their direction coincides with the stem direction.
@code{0.0} means keep the default position (centered on the note
-head), @code{1.0} means centered on the stem. Interpolated values are
+ head), @code{1.0} means centered on the stem. Interpolated values are
possible.")
(transparent ,boolean? "This makes the grob invisible.")
@@ -1001,7 +1001,7 @@ one below this grob.")
happen?")
(whiteout ,boolean? "If true, the grob is printed over a white
background to white-out underlying material, if the grob is visible.
- Usually #f by default.")
+Usually #f by default.")
(width ,ly:dimension? "The width of a grob measured in staff
space.")
(word-space ,ly:dimension? "Space to insert between words in
diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index 4d015b7658..df94769f50 100644
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -29,363 +29,363 @@
`(
(Accidental
. (
- (alteration . ,accidental-interface::calc-alteration)
- (avoid-slur . inside)
- (glyph-name . ,accidental-interface::glyph-name)
- (glyph-name-alist . ,standard-alteration-glyph-name-alist)
- (stencil . ,ly:accidental-interface::print)
- (horizontal-skylines . ,(ly:make-unpure-pure-container ly:accidental-interface::horizontal-skylines))
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (X-extent . ,ly:accidental-interface::width)
- (Y-extent . ,accidental-interface::height)
- (meta . ((class . Item)
- (interfaces . (accidental-interface
- inline-accidental-interface
- font-interface))))))
+ (alteration . ,accidental-interface::calc-alteration)
+ (avoid-slur . inside)
+ (glyph-name . ,accidental-interface::glyph-name)
+ (glyph-name-alist . ,standard-alteration-glyph-name-alist)
+ (stencil . ,ly:accidental-interface::print)
+ (horizontal-skylines . ,(ly:make-unpure-pure-container ly:accidental-interface::horizontal-skylines))
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (X-extent . ,ly:accidental-interface::width)
+ (Y-extent . ,accidental-interface::height)
+ (meta . ((class . Item)
+ (interfaces . (accidental-interface
+ inline-accidental-interface
+ font-interface))))))
(AccidentalCautionary
. (
- (alteration . ,accidental-interface::calc-alteration)
- (avoid-slur . inside)
- (glyph-name-alist . ,standard-alteration-glyph-name-alist)
- (parenthesized . #t)
- (stencil . ,ly:accidental-interface::print)
- (Y-extent . ,accidental-interface::height)
- (meta . ((class . Item)
- (interfaces . (accidental-interface
- inline-accidental-interface
- font-interface))))))
+ (alteration . ,accidental-interface::calc-alteration)
+ (avoid-slur . inside)
+ (glyph-name-alist . ,standard-alteration-glyph-name-alist)
+ (parenthesized . #t)
+ (stencil . ,ly:accidental-interface::print)
+ (Y-extent . ,accidental-interface::height)
+ (meta . ((class . Item)
+ (interfaces . (accidental-interface
+ inline-accidental-interface
+ font-interface))))))
(AccidentalPlacement
. (
- (direction . ,LEFT)
- (positioning-done . ,ly:accidental-placement::calc-positioning-done)
+ (direction . ,LEFT)
+ (positioning-done . ,ly:accidental-placement::calc-positioning-done)
- ;; this is quite small, but it is very ugly to have
- ;; accs closer to the previous note than to the next one.
- (right-padding . 0.15)
+ ;; this is quite small, but it is very ugly to have
+ ;; accs closer to the previous note than to the next one.
+ (right-padding . 0.15)
- ;; for horizontally stacked scripts.
- (script-priority . -100)
+ ;; for horizontally stacked scripts.
+ (script-priority . -100)
- (X-extent . ,ly:axis-group-interface::width)
- (meta . ((class . Item)
- (interfaces . (accidental-placement-interface))))))
+ (X-extent . ,ly:axis-group-interface::width)
+ (meta . ((class . Item)
+ (interfaces . (accidental-placement-interface))))))
(AccidentalSuggestion
. (
- (alteration . ,accidental-interface::calc-alteration)
- (direction . ,UP)
- (font-size . -2)
- (glyph-name-alist . ,standard-alteration-glyph-name-alist)
- (outside-staff-priority . 0)
- (script-priority . 0)
- (self-alignment-X . ,CENTER)
- (side-axis . ,Y)
- (staff-padding . 0.25)
- (stencil . ,ly:accidental-interface::print)
- (X-extent . ,ly:accidental-interface::width)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::centered-on-x-parent))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (Y-extent . ,accidental-interface::height)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Item)
- (interfaces . (accidental-interface
- accidental-suggestion-interface
- font-interface
- script-interface
- self-alignment-interface
- side-position-interface))))))
+ (alteration . ,accidental-interface::calc-alteration)
+ (direction . ,UP)
+ (font-size . -2)
+ (glyph-name-alist . ,standard-alteration-glyph-name-alist)
+ (outside-staff-priority . 0)
+ (script-priority . 0)
+ (self-alignment-X . ,CENTER)
+ (side-axis . ,Y)
+ (staff-padding . 0.25)
+ (stencil . ,ly:accidental-interface::print)
+ (X-extent . ,ly:accidental-interface::width)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::centered-on-x-parent))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (Y-extent . ,accidental-interface::height)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Item)
+ (interfaces . (accidental-interface
+ accidental-suggestion-interface
+ font-interface
+ script-interface
+ self-alignment-interface
+ side-position-interface))))))
(Ambitus
. (
- (axes . (,X ,Y))
- (break-align-symbol . ambitus)
- (break-visibility . ,begin-of-line-visible)
- (non-musical . #t)
- (space-alist . (
- (cue-end-clef . (extra-space . 0.5))
- (clef . (extra-space . 0.5))
- (cue-clef . (extra-space . 0.5))
- (key-signature . (extra-space . 0.0))
- (staff-bar . (extra-space . 0.0))
- (time-signature . (extra-space . 0.0))
- (first-note . (fixed-space . 0.0))))
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (meta . ((class . Item)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (ambitus-interface
- axis-group-interface
- break-aligned-interface))))))
+ (axes . (,X ,Y))
+ (break-align-symbol . ambitus)
+ (break-visibility . ,begin-of-line-visible)
+ (non-musical . #t)
+ (space-alist . (
+ (cue-end-clef . (extra-space . 0.5))
+ (clef . (extra-space . 0.5))
+ (cue-clef . (extra-space . 0.5))
+ (key-signature . (extra-space . 0.0))
+ (staff-bar . (extra-space . 0.0))
+ (time-signature . (extra-space . 0.0))
+ (first-note . (fixed-space . 0.0))))
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (meta . ((class . Item)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (ambitus-interface
+ axis-group-interface
+ break-aligned-interface))))))
(AmbitusAccidental
. (
- (direction . ,LEFT)
- (glyph-name-alist . ,standard-alteration-glyph-name-alist)
- (padding . 0.5)
- (side-axis . ,X)
- (stencil . ,ly:accidental-interface::print)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . ,accidental-interface::height)
- (meta . ((class . Item)
- (interfaces . (accidental-interface
- break-aligned-interface
- font-interface
- side-position-interface))))))
+ (direction . ,LEFT)
+ (glyph-name-alist . ,standard-alteration-glyph-name-alist)
+ (padding . 0.5)
+ (side-axis . ,X)
+ (stencil . ,ly:accidental-interface::print)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . ,accidental-interface::height)
+ (meta . ((class . Item)
+ (interfaces . (accidental-interface
+ break-aligned-interface
+ font-interface
+ side-position-interface))))))
(AmbitusLine
. (
- (gap . 0.35)
- (stencil . ,ambitus::print)
- (thickness . 2)
- (X-offset . ,ly:self-alignment-interface::centered-on-x-parent)
- (meta . ((class . Item)
- (interfaces . (ambitus-interface
- font-interface))))))
+ (gap . 0.35)
+ (stencil . ,ambitus::print)
+ (thickness . 2)
+ (X-offset . ,ly:self-alignment-interface::centered-on-x-parent)
+ (meta . ((class . Item)
+ (interfaces . (ambitus-interface
+ font-interface))))))
(AmbitusNoteHead
. (
- (duration-log . 2)
- (glyph-name . ,note-head::calc-glyph-name)
- (stencil . ,ly:note-head::print)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (ambitus-interface
- font-interface
- ledgered-interface
- note-head-interface
- rhythmic-head-interface
- staff-symbol-referencer-interface))))))
+ (duration-log . 2)
+ (glyph-name . ,note-head::calc-glyph-name)
+ (stencil . ,ly:note-head::print)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (ambitus-interface
+ font-interface
+ ledgered-interface
+ note-head-interface
+ rhythmic-head-interface
+ staff-symbol-referencer-interface))))))
(Arpeggio
. (
- (direction . ,LEFT)
- (padding . 0.5)
- (positions . ,ly:arpeggio::calc-positions)
- (protrusion . 0.4)
- (script-priority . 0)
- (side-axis . ,X)
- (staff-position . 0.0)
- (stencil . ,ly:arpeggio::print)
- (X-extent . ,ly:arpeggio::width)
- (Y-extent . ,(grob::unpure-Y-extent-from-stencil ly:arpeggio::pure-height))
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-offset . ,staff-symbol-referencer::callback)
- (meta . ((class . Item)
- (interfaces . (arpeggio-interface
- font-interface
- side-position-interface
- staff-symbol-referencer-interface))))))
+ (direction . ,LEFT)
+ (padding . 0.5)
+ (positions . ,ly:arpeggio::calc-positions)
+ (protrusion . 0.4)
+ (script-priority . 0)
+ (side-axis . ,X)
+ (staff-position . 0.0)
+ (stencil . ,ly:arpeggio::print)
+ (X-extent . ,ly:arpeggio::width)
+ (Y-extent . ,(grob::unpure-Y-extent-from-stencil ly:arpeggio::pure-height))
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (meta . ((class . Item)
+ (interfaces . (arpeggio-interface
+ font-interface
+ side-position-interface
+ staff-symbol-referencer-interface))))))
(BalloonTextItem
. (
- (annotation-balloon . #t)
- (annotation-line . #t)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (stencil . ,ly:balloon-interface::print)
- (text . ,(grob::calc-property-by-copy 'text))
- (X-offset . ,(grob::calc-property-by-copy 'X-offset))
- (Y-offset . ,(grob::calc-property-by-copy 'Y-offset))
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (balloon-interface
- font-interface
- text-interface))))))
+ (annotation-balloon . #t)
+ (annotation-line . #t)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (stencil . ,ly:balloon-interface::print)
+ (text . ,(grob::calc-property-by-copy 'text))
+ (X-offset . ,(grob::calc-property-by-copy 'X-offset))
+ (Y-offset . ,(grob::calc-property-by-copy 'Y-offset))
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (balloon-interface
+ font-interface
+ text-interface))))))
(BarLine
. (
- (allow-span-bar . #t)
- (bar-extent . ,ly:bar-line::calc-bar-extent)
- (break-align-anchor . ,ly:bar-line::calc-anchor)
- (break-align-symbol . staff-bar)
- (break-visibility . ,bar-line::calc-break-visibility)
- (extra-spacing-height . ,pure-from-neighbor-interface::account-for-span-bar)
- (gap . 0.4)
- (glyph . "|")
- (glyph-name . ,bar-line::calc-glyph-name)
-
- ;;
- ;; Ross. page 151 lists other values, we opt for a leaner look
- ;;
- ;; TODO:
- ;; kern should scale with line-thickness too.
- (kern . 3.0)
- (thin-kern . 3.0)
- (hair-thickness . 1.9)
- (thick-thickness . 6.0)
-
- (layer . 0)
- (non-musical . #t)
- (rounded . #f)
- (space-alist . (
- (time-signature . (extra-space . 0.75))
- (custos . (minimum-space . 2.0))
- (clef . (minimum-space . 1.0))
- (key-signature . (extra-space . 1.0))
- (key-cancellation . (extra-space . 1.0))
- (first-note . (fixed-space . 1.3))
- (next-note . (semi-fixed-space . 0.9))
- (right-edge . (extra-space . 0.0))))
- (stencil . ,ly:bar-line::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
+ (allow-span-bar . #t)
+ (bar-extent . ,ly:bar-line::calc-bar-extent)
+ (break-align-anchor . ,ly:bar-line::calc-anchor)
+ (break-align-symbol . staff-bar)
+ (break-visibility . ,bar-line::calc-break-visibility)
+ (extra-spacing-height . ,pure-from-neighbor-interface::account-for-span-bar)
+ (gap . 0.4)
+ (glyph . "|")
+ (glyph-name . ,bar-line::calc-glyph-name)
+
+ ;;
+ ;; Ross. page 151 lists other values, we opt for a leaner look
+ ;;
+ ;; TODO:
+ ;; kern should scale with line-thickness too.
+ (kern . 3.0)
+ (thin-kern . 3.0)
+ (hair-thickness . 1.9)
+ (thick-thickness . 6.0)
+
+ (layer . 0)
+ (non-musical . #t)
+ (rounded . #f)
+ (space-alist . (
+ (time-signature . (extra-space . 0.75))
+ (custos . (minimum-space . 2.0))
+ (clef . (minimum-space . 1.0))
+ (key-signature . (extra-space . 1.0))
+ (key-cancellation . (extra-space . 1.0))
+ (first-note . (fixed-space . 1.3))
+ (next-note . (semi-fixed-space . 0.9))
+ (right-edge . (extra-space . 0.0))))
+ (stencil . ,ly:bar-line::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (bar-line-interface
- break-aligned-interface
- font-interface
- pure-from-neighbor-interface))))))
+ (interfaces . (bar-line-interface
+ break-aligned-interface
+ font-interface
+ pure-from-neighbor-interface))))))
(BarNumber
. (
- (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
- ;; want the bar number before the clef at line start.
- (break-align-symbols . (left-edge staff-bar))
-
- (break-visibility . ,begin-of-line-visible)
- (direction . ,UP)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (font-family . roman)
- (font-size . -2)
- (non-musical . #t)
- ;; w/o padding, bars numbers are not positioned over the staff as
- ;; they are slightly to the left. so we add just a bit.
- (horizon-padding . 0.05)
- (outside-staff-priority . 100)
- (padding . 1.0)
- (self-alignment-X . ,RIGHT)
- (side-axis . ,Y)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:break-alignable-interface::self-align-callback))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta .
- ((class . Item)
- (interfaces . (break-alignable-interface
- font-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
+ ;; want the bar number before the clef at line start.
+ (break-align-symbols . (left-edge staff-bar))
+
+ (break-visibility . ,begin-of-line-visible)
+ (direction . ,UP)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (font-family . roman)
+ (font-size . -2)
+ (non-musical . #t)
+ ;; w/o padding, bars numbers are not positioned over the staff as
+ ;; they are slightly to the left. so we add just a bit.
+ (horizon-padding . 0.05)
+ (outside-staff-priority . 100)
+ (padding . 1.0)
+ (self-alignment-X . ,RIGHT)
+ (side-axis . ,Y)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:break-alignable-interface::self-align-callback))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta .
+ ((class . Item)
+ (interfaces . (break-alignable-interface
+ font-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(BassFigure
. (
- (stencil . ,ly:text-interface::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (bass-figure-interface
- font-interface
- rhythmic-grob-interface
- text-interface))))))
+ (stencil . ,ly:text-interface::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (bass-figure-interface
+ font-interface
+ rhythmic-grob-interface
+ text-interface))))))
(BassFigureAlignment
. (
- (axes . (,Y))
- (padding . 0.2)
- (positioning-done . ,ly:align-interface::align-to-minimum-distances)
- (stacking-dir . ,DOWN)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (align-interface
- axis-group-interface
- bass-figure-alignment-interface))))))
+ (axes . (,Y))
+ (padding . 0.2)
+ (positioning-done . ,ly:align-interface::align-to-minimum-distances)
+ (stacking-dir . ,DOWN)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (align-interface
+ axis-group-interface
+ bass-figure-alignment-interface))))))
(BassFigureAlignmentPositioning
. (
- (axes . (,Y))
- (direction . ,UP)
- (padding . 0.5)
- (side-axis . ,Y)
- (staff-padding . 1.0)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- side-position-interface))))))
+ (axes . (,Y))
+ (direction . ,UP)
+ (padding . 0.5)
+ (side-axis . ,Y)
+ (staff-padding . 1.0)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ side-position-interface))))))
(BassFigureBracket
. (
- (edge-height . (0.2 . 0.2))
- (stencil . ,ly:enclosing-bracket::print)
- (X-extent . ,ly:enclosing-bracket::width)
- (meta . ((class . Item)
- (interfaces . (enclosing-bracket-interface))))))
+ (edge-height . (0.2 . 0.2))
+ (stencil . ,ly:enclosing-bracket::print)
+ (X-extent . ,ly:enclosing-bracket::width)
+ (meta . ((class . Item)
+ (interfaces . (enclosing-bracket-interface))))))
(BassFigureContinuation
. (
- (stencil . ,ly:figured-bass-continuation::print)
- (Y-offset . ,ly:figured-bass-continuation::center-on-figures)
- (meta . ((class . Spanner)
- (interfaces . (figured-bass-continuation-interface))))))
+ (stencil . ,ly:figured-bass-continuation::print)
+ (Y-offset . ,ly:figured-bass-continuation::center-on-figures)
+ (meta . ((class . Spanner)
+ (interfaces . (figured-bass-continuation-interface))))))
(BassFigureLine
. (
- (adjacent-pure-heights . ,ly:axis-group-interface::adjacent-pure-heights)
- (axes . (,Y))
- (vertical-skylines . ,ly:axis-group-interface::calc-skylines)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface))))))
+ (adjacent-pure-heights . ,ly:axis-group-interface::adjacent-pure-heights)
+ (axes . (,Y))
+ (vertical-skylines . ,ly:axis-group-interface::calc-skylines)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface))))))
(Beam
. (
- ;; todo: clean this up a bit: the list is getting
- ;; rather long.
- (auto-knee-gap . 5.5)
- (beam-segments . ,ly:beam::calc-beam-segments)
- (beam-thickness . 0.48) ; in staff-space
-
- ;; We have some unreferenced problems here.
- ;;
- ;; If we shorten beamed stems less than normal stems (1 staff-space),
- ;; or high order less than 8th beams, patterns like
- ;; c''4 [c''8 c''] c''4 [c''16 c]
- ;; are ugly (different stem lengths).
- ;;
- ;; But if we shorten 16th beams as much as 8th beams, a single
- ;; forced 16th beam looks *very* short.
-
- ;; We choose to shorten 8th beams the same as single stems,
- ;; and high order beams less than 8th beams, so that all
- ;; isolated shortened beams look nice and a bit shortened,
- ;; sadly possibly breaking patterns with high order beams.
- (beamed-stem-shorten . (1.0 0.5 0.25))
-
- (beaming . ,ly:beam::calc-beaming)
- (clip-edges . #t)
- (collision-interfaces . (beam-interface
- clef-interface
- clef-modifier-interface
- flag-interface
- inline-accidental-interface
- key-signature-interface
- note-head-interface
- stem-interface
- time-signature-interface))
- (cross-staff . ,ly:beam::calc-cross-staff)
- (damping . 1)
- (details
+ ;; todo: clean this up a bit: the list is getting
+ ;; rather long.
+ (auto-knee-gap . 5.5)
+ (beam-segments . ,ly:beam::calc-beam-segments)
+ (beam-thickness . 0.48) ; in staff-space
+
+ ;; We have some unreferenced problems here.
+ ;;
+ ;; If we shorten beamed stems less than normal stems (1 staff-space),
+ ;; or high order less than 8th beams, patterns like
+ ;; c''4 [c''8 c''] c''4 [c''16 c]
+ ;; are ugly (different stem lengths).
+ ;;
+ ;; But if we shorten 16th beams as much as 8th beams, a single
+ ;; forced 16th beam looks *very* short.
+
+ ;; We choose to shorten 8th beams the same as single stems,
+ ;; and high order beams less than 8th beams, so that all
+ ;; isolated shortened beams look nice and a bit shortened,
+ ;; sadly possibly breaking patterns with high order beams.
+ (beamed-stem-shorten . (1.0 0.5 0.25))
+
+ (beaming . ,ly:beam::calc-beaming)
+ (clip-edges . #t)
+ (collision-interfaces . (beam-interface
+ clef-interface
+ clef-modifier-interface
+ flag-interface
+ inline-accidental-interface
+ key-signature-interface
+ note-head-interface
+ stem-interface
+ time-signature-interface))
+ (cross-staff . ,ly:beam::calc-cross-staff)
+ (damping . 1)
+ (details
.(
(secondary-beam-demerit . 10)
(stem-length-demerit-factor . 5)
@@ -396,1010 +396,1010 @@
(hint-direction-penalty . 20)
(musical-direction-factor . 400)
(ideal-slope-factor . 10)
- (collision-penalty . 500)
- (collision-padding . 0.35)
+ (collision-penalty . 500)
+ (collision-padding . 0.35)
(round-to-zero-slope . 0.02)))
- (direction . ,ly:beam::calc-direction)
-
- (normalized-endpoints . ,ly:spanner::calc-normalized-endpoints)
- ;; only for debugging.
- (font-family . roman)
-
- (beam-gap . ,ly:beam::calc-beam-gap)
- (minimum-length . ,ly:beam::calc-minimum-length)
- (neutral-direction . ,DOWN)
- (positions . ,beam::place-broken-parts-individually)
- (springs-and-rods . ,ly:beam::calc-springs-and-rods)
- (X-positions . ,ly:beam::calc-x-positions)
+ (direction . ,ly:beam::calc-direction)
+
+ (normalized-endpoints . ,ly:spanner::calc-normalized-endpoints)
+ ;; only for debugging.
+ (font-family . roman)
+
+ (beam-gap . ,ly:beam::calc-beam-gap)
+ (minimum-length . ,ly:beam::calc-minimum-length)
+ (neutral-direction . ,DOWN)
+ (positions . ,beam::place-broken-parts-individually)
+ (springs-and-rods . ,ly:beam::calc-springs-and-rods)
+ (X-positions . ,ly:beam::calc-x-positions)
(transparent . ,(grob::inherit-parent-property
X 'transparent))
- ;; this is a hack to set stem lengths, if positions is set.
- (quantized-positions . ,ly:beam::set-stem-lengths)
+ ;; this is a hack to set stem lengths, if positions is set.
+ (quantized-positions . ,ly:beam::set-stem-lengths)
- (shorten . ,ly:beam::calc-stem-shorten)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (stencil . ,ly:beam::print)
+ (shorten . ,ly:beam::calc-stem-shorten)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (stencil . ,ly:beam::print)
- (meta . ((class . Spanner)
- (object-callbacks . ((normal-stems . ,ly:beam::calc-normal-stems)))
- (interfaces . (beam-interface
- font-interface
- staff-symbol-referencer-interface
- unbreakable-spanner-interface))))))
+ (meta . ((class . Spanner)
+ (object-callbacks . ((normal-stems . ,ly:beam::calc-normal-stems)))
+ (interfaces . (beam-interface
+ font-interface
+ staff-symbol-referencer-interface
+ unbreakable-spanner-interface))))))
(BendAfter
. (
- (minimum-length . 0.5)
- (stencil . ,bend::print)
- (thickness . 2.0)
- (meta . ((class . Spanner)
- (interfaces . (bend-after-interface
- spanner-interface))))))
+ (minimum-length . 0.5)
+ (stencil . ,bend::print)
+ (thickness . 2.0)
+ (meta . ((class . Spanner)
+ (interfaces . (bend-after-interface
+ spanner-interface))))))
(BreakAlignGroup
. (
- (axes . (,X))
- (break-align-anchor . ,ly:break-aligned-interface::calc-average-anchor)
- (break-visibility . ,ly:break-aligned-interface::calc-break-visibility)
- (X-extent . ,ly:axis-group-interface::width)
- (meta . ((class . Item)
- (interfaces . (axis-group-interface
- break-aligned-interface))))))
+ (axes . (,X))
+ (break-align-anchor . ,ly:break-aligned-interface::calc-average-anchor)
+ (break-visibility . ,ly:break-aligned-interface::calc-break-visibility)
+ (X-extent . ,ly:axis-group-interface::width)
+ (meta . ((class . Item)
+ (interfaces . (axis-group-interface
+ break-aligned-interface))))))
(BreakAlignment
. (
- (axes . (,X))
- (break-align-orders . ;; end of line
- #((
- left-edge
- cue-end-clef
- ambitus
- breathing-sign
- clef
- cue-clef
- staff-bar
- key-cancellation
- key-signature
- time-signature
- custos)
-
- ;; unbroken
- (
- left-edge
- cue-end-clef
- ambitus
- breathing-sign
- clef
- cue-clef
- staff-bar
- key-cancellation
- key-signature
- time-signature
- custos)
-
- ;; begin of line
- (
- left-edge
- ambitus
- breathing-sign
- clef
- key-cancellation
- key-signature
- time-signature
- staff-bar
- cue-clef
- custos)))
- (non-musical . #t)
- (positioning-done . ,ly:break-alignment-interface::calc-positioning-done)
- (stacking-dir . 1)
- (X-extent . ,ly:axis-group-interface::width)
- (meta . ((class . Item)
- (interfaces . (axis-group-interface
- break-alignment-interface))))))
+ (axes . (,X))
+ (break-align-orders . ;; end of line
+ #((
+ left-edge
+ cue-end-clef
+ ambitus
+ breathing-sign
+ clef
+ cue-clef
+ staff-bar
+ key-cancellation
+ key-signature
+ time-signature
+ custos)
+
+ ;; unbroken
+ (
+ left-edge
+ cue-end-clef
+ ambitus
+ breathing-sign
+ clef
+ cue-clef
+ staff-bar
+ key-cancellation
+ key-signature
+ time-signature
+ custos)
+
+ ;; begin of line
+ (
+ left-edge
+ ambitus
+ breathing-sign
+ clef
+ key-cancellation
+ key-signature
+ time-signature
+ staff-bar
+ cue-clef
+ custos)))
+ (non-musical . #t)
+ (positioning-done . ,ly:break-alignment-interface::calc-positioning-done)
+ (stacking-dir . 1)
+ (X-extent . ,ly:axis-group-interface::width)
+ (meta . ((class . Item)
+ (interfaces . (axis-group-interface
+ break-alignment-interface))))))
(BreathingSign
. (
- (break-align-symbol . breathing-sign)
- (break-visibility . ,begin-of-line-invisible)
- (non-musical . #t)
- (space-alist . (
- (ambitus . (extra-space . 2.0))
- (custos . (minimum-space . 1.0))
- (key-signature . (minimum-space . 1.5))
- (time-signature . (minimum-space . 1.5))
- (staff-bar . (minimum-space . 1.5))
- (clef . (minimum-space . 2.0))
- (cue-clef . (minimum-space . 2.0))
- (cue-end-clef . (minimum-space . 2.0))
- (first-note . (fixed-space . 1.0)) ;huh?
- (right-edge . (extra-space . 0.1))))
- (stencil . ,ly:text-interface::print)
- (text . ,(make-musicglyph-markup "scripts.rcomma"))
- (Y-offset . ,ly:breathing-sign::offset-callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (break-aligned-interface
- breathing-sign-interface
- font-interface
- text-interface))))))
+ (break-align-symbol . breathing-sign)
+ (break-visibility . ,begin-of-line-invisible)
+ (non-musical . #t)
+ (space-alist . (
+ (ambitus . (extra-space . 2.0))
+ (custos . (minimum-space . 1.0))
+ (key-signature . (minimum-space . 1.5))
+ (time-signature . (minimum-space . 1.5))
+ (staff-bar . (minimum-space . 1.5))
+ (clef . (minimum-space . 2.0))
+ (cue-clef . (minimum-space . 2.0))
+ (cue-end-clef . (minimum-space . 2.0))
+ (first-note . (fixed-space . 1.0)) ;huh?
+ (right-edge . (extra-space . 0.1))))
+ (stencil . ,ly:text-interface::print)
+ (text . ,(make-musicglyph-markup "scripts.rcomma"))
+ (Y-offset . ,ly:breathing-sign::offset-callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (break-aligned-interface
+ breathing-sign-interface
+ font-interface
+ text-interface))))))
(ChordName
. (
- (after-line-breaking . ,ly:chord-name::after-line-breaking)
- (font-family . sans)
- (font-size . 1.5)
- (stencil . ,ly:text-interface::print)
- (extra-spacing-height . (0.2 . -0.2))
- (extra-spacing-width . (-0.5 . 0.5))
- (word-space . 0.0)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (chord-name-interface
- font-interface
- rhythmic-grob-interface
- text-interface))))))
+ (after-line-breaking . ,ly:chord-name::after-line-breaking)
+ (font-family . sans)
+ (font-size . 1.5)
+ (stencil . ,ly:text-interface::print)
+ (extra-spacing-height . (0.2 . -0.2))
+ (extra-spacing-width . (-0.5 . 0.5))
+ (word-space . 0.0)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (chord-name-interface
+ font-interface
+ rhythmic-grob-interface
+ text-interface))))))
(Clef
. (
- (avoid-slur . inside)
- (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
- (break-align-anchor-alignment . ,RIGHT)
- (break-align-symbol . clef)
- (break-visibility . ,begin-of-line-visible)
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line)
- (glyph-name . ,ly:clef::calc-glyph-name)
- (non-musical . #t)
- (space-alist . ((cue-clef . (extra-space . 2.0))
- (staff-bar . (extra-space . 0.7))
- (key-cancellation . (minimum-space . 3.5))
- (key-signature . (minimum-space . 3.5))
- (time-signature . (minimum-space . 4.2))
- (first-note . (minimum-fixed-space . 5.0))
- (next-note . (extra-space . 1.0))
- (right-edge . (extra-space . 0.5))))
- (stencil . ,ly:clef::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
+ (avoid-slur . inside)
+ (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
+ (break-align-anchor-alignment . ,RIGHT)
+ (break-align-symbol . clef)
+ (break-visibility . ,begin-of-line-visible)
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line)
+ (glyph-name . ,ly:clef::calc-glyph-name)
+ (non-musical . #t)
+ (space-alist . ((cue-clef . (extra-space . 2.0))
+ (staff-bar . (extra-space . 0.7))
+ (key-cancellation . (minimum-space . 3.5))
+ (key-signature . (minimum-space . 3.5))
+ (time-signature . (minimum-space . 4.2))
+ (first-note . (minimum-fixed-space . 5.0))
+ (next-note . (extra-space . 1.0))
+ (right-edge . (extra-space . 0.5))))
+ (stencil . ,ly:clef::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (break-aligned-interface
- clef-interface
- font-interface
- pure-from-neighbor-interface
- staff-symbol-referencer-interface))))))
+ (interfaces . (break-aligned-interface
+ clef-interface
+ font-interface
+ pure-from-neighbor-interface
+ staff-symbol-referencer-interface))))))
(ClefModifier
. (
- (break-visibility . ,(grob::inherit-parent-property
+ (break-visibility . ,(grob::inherit-parent-property
X 'break-visibility))
- (font-shape . italic)
- (font-size . -4)
+ (font-shape . italic)
+ (font-size . -4)
(transparent . ,(grob::inherit-parent-property
X 'transparent))
(color . ,(grob::inherit-parent-property
X 'color))
- (self-alignment-X . ,CENTER)
- (staff-padding . 0.2)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::centered-on-x-parent)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (clef-modifier-interface
- font-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (self-alignment-X . ,CENTER)
+ (staff-padding . 0.2)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::centered-on-x-parent)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (clef-modifier-interface
+ font-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(ClusterSpanner
. (
- (cross-staff . ,ly:cluster::calc-cross-staff)
- (minimum-length . 0.0)
- (padding . 0.25)
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:cluster::print)
- (style . ramp)
- (meta . ((class . Spanner)
- (interfaces . (cluster-interface))))))
+ (cross-staff . ,ly:cluster::calc-cross-staff)
+ (minimum-length . 0.0)
+ (padding . 0.25)
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:cluster::print)
+ (style . ramp)
+ (meta . ((class . Spanner)
+ (interfaces . (cluster-interface))))))
(ClusterSpannerBeacon
. (
- (Y-extent . ,ly:cluster-beacon::height)
- (meta . ((class . Item)
- (interfaces . (cluster-beacon-interface
- rhythmic-grob-interface))))))
+ (Y-extent . ,ly:cluster-beacon::height)
+ (meta . ((class . Item)
+ (interfaces . (cluster-beacon-interface
+ rhythmic-grob-interface))))))
(CombineTextScript
. (
- (avoid-slur . outside)
- (baseline-skip . 2)
- (direction . ,UP)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (font-series . bold)
- (outside-staff-priority . 450)
- (padding . 0.5)
- (script-priority . 200)
- (side-axis . ,Y)
- (staff-padding . 0.5)
- ;; todo: add X self alignment?
- (stencil . ,ly:text-interface::print)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- side-position-interface
- text-interface
- text-script-interface))))))
+ (avoid-slur . outside)
+ (baseline-skip . 2)
+ (direction . ,UP)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (font-series . bold)
+ (outside-staff-priority . 450)
+ (padding . 0.5)
+ (script-priority . 200)
+ (side-axis . ,Y)
+ (staff-padding . 0.5)
+ ;; todo: add X self alignment?
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ side-position-interface
+ text-interface
+ text-script-interface))))))
(CueClef
. (
- (avoid-slur . inside)
- (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
- (break-align-symbol . cue-clef)
- (break-visibility . ,begin-of-line-visible)
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line)
- (font-size . -4)
- (glyph-name . ,ly:clef::calc-glyph-name)
- (non-musical . #t)
- (full-size-change . #t)
- (space-alist . ((staff-bar . (minimum-space . 2.7))
- (key-cancellation . (minimum-space . 3.5))
- (key-signature . (minimum-space . 3.5))
- (time-signature . (minimum-space . 4.2))
- (custos . (minimum-space . 0.0))
- (first-note . (minimum-fixed-space . 3.0))
- (next-note . (extra-space . 1.0))
- (right-edge . (extra-space . 0.5))))
- (stencil . ,ly:clef::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
+ (avoid-slur . inside)
+ (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
+ (break-align-symbol . cue-clef)
+ (break-visibility . ,begin-of-line-visible)
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line)
+ (font-size . -4)
+ (glyph-name . ,ly:clef::calc-glyph-name)
+ (non-musical . #t)
+ (full-size-change . #t)
+ (space-alist . ((staff-bar . (minimum-space . 2.7))
+ (key-cancellation . (minimum-space . 3.5))
+ (key-signature . (minimum-space . 3.5))
+ (time-signature . (minimum-space . 4.2))
+ (custos . (minimum-space . 0.0))
+ (first-note . (minimum-fixed-space . 3.0))
+ (next-note . (extra-space . 1.0))
+ (right-edge . (extra-space . 0.5))))
+ (stencil . ,ly:clef::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (break-aligned-interface
- clef-interface
- font-interface
- pure-from-neighbor-interface
- staff-symbol-referencer-interface))))))
+ (interfaces . (break-aligned-interface
+ clef-interface
+ font-interface
+ pure-from-neighbor-interface
+ staff-symbol-referencer-interface))))))
(CueEndClef
. (
- (avoid-slur . inside)
- (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
- (break-align-symbol . cue-end-clef)
- (break-visibility . ,begin-of-line-invisible)
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line)
- (font-size . -4)
- (glyph-name . ,ly:clef::calc-glyph-name)
- (non-musical . #t)
- (full-size-change . #t)
- (space-alist . ((clef . (extra-space . 0.7))
- (cue-clef . (extra-space . 0.7))
- (staff-bar . (extra-space . 0.7))
- (key-cancellation . (minimum-space . 3.5))
- (key-signature . (minimum-space . 3.5))
- (time-signature . (minimum-space . 4.2))
- (first-note . (minimum-fixed-space . 5.0))
- (next-note . (extra-space . 1.0))
- (right-edge . (extra-space . 0.5))))
- (stencil . ,ly:clef::print)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
+ (avoid-slur . inside)
+ (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
+ (break-align-symbol . cue-end-clef)
+ (break-visibility . ,begin-of-line-invisible)
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line)
+ (font-size . -4)
+ (glyph-name . ,ly:clef::calc-glyph-name)
+ (non-musical . #t)
+ (full-size-change . #t)
+ (space-alist . ((clef . (extra-space . 0.7))
+ (cue-clef . (extra-space . 0.7))
+ (staff-bar . (extra-space . 0.7))
+ (key-cancellation . (minimum-space . 3.5))
+ (key-signature . (minimum-space . 3.5))
+ (time-signature . (minimum-space . 4.2))
+ (first-note . (minimum-fixed-space . 5.0))
+ (next-note . (extra-space . 1.0))
+ (right-edge . (extra-space . 0.5))))
+ (stencil . ,ly:clef::print)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (break-aligned-interface
- clef-interface
- font-interface
- pure-from-neighbor-interface
- staff-symbol-referencer-interface))))))
+ (interfaces . (break-aligned-interface
+ clef-interface
+ font-interface
+ pure-from-neighbor-interface
+ staff-symbol-referencer-interface))))))
(Custos
. (
- (break-align-symbol . custos)
- (break-visibility . ,end-of-line-visible)
- (neutral-direction . ,DOWN)
- (non-musical . #t)
- (space-alist . (
- (first-note . (minimum-fixed-space . 0.0))
- (right-edge . (extra-space . 0.1))))
- (stencil . ,ly:custos::print)
- (style . vaticana)
- (Y-offset . ,staff-symbol-referencer::callback)
- (meta . ((class . Item)
- (interfaces . (break-aligned-interface
- custos-interface
- font-interface
- staff-symbol-referencer-interface))))))
+ (break-align-symbol . custos)
+ (break-visibility . ,end-of-line-visible)
+ (neutral-direction . ,DOWN)
+ (non-musical . #t)
+ (space-alist . (
+ (first-note . (minimum-fixed-space . 0.0))
+ (right-edge . (extra-space . 0.1))))
+ (stencil . ,ly:custos::print)
+ (style . vaticana)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (meta . ((class . Item)
+ (interfaces . (break-aligned-interface
+ custos-interface
+ font-interface
+ staff-symbol-referencer-interface))))))
(DotColumn
. (
- (axes . (,X))
- (direction . ,RIGHT)
- (positioning-done . ,ly:dot-column::calc-positioning-done)
- (X-extent . ,ly:axis-group-interface::width)
- (meta . ((class . Item)
- (interfaces . (axis-group-interface
- dot-column-interface))))))
+ (axes . (,X))
+ (direction . ,RIGHT)
+ (positioning-done . ,ly:dot-column::calc-positioning-done)
+ (X-extent . ,ly:axis-group-interface::width)
+ (meta . ((class . Item)
+ (interfaces . (axis-group-interface
+ dot-column-interface))))))
(Dots
. (
- (avoid-slur . inside)
- (dot-count . ,dots::calc-dot-count)
- (staff-position . ,dots::calc-staff-position)
- (stencil . ,ly:dots::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (extra-spacing-height . (-0.5 . 0.5))
- (meta . ((class . Item)
- (interfaces . (dots-interface
- font-interface
- staff-symbol-referencer-interface))))))
+ (avoid-slur . inside)
+ (dot-count . ,dots::calc-dot-count)
+ (staff-position . ,dots::calc-staff-position)
+ (stencil . ,ly:dots::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (extra-spacing-height . (-0.5 . 0.5))
+ (meta . ((class . Item)
+ (interfaces . (dots-interface
+ font-interface
+ staff-symbol-referencer-interface))))))
(DoublePercentRepeat
. (
- (break-align-symbol . staff-bar)
- (break-visibility . ,begin-of-line-invisible)
- (dot-negative-kern . 0.75)
- (font-encoding . fetaMusic)
- (non-musical . #t)
- (slash-negative-kern . 1.6)
- (slope . 1.0)
- (stencil . ,ly:percent-repeat-item-interface::double-percent)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (thickness . 0.48)
- (meta . ((class . Item)
- (interfaces . (break-aligned-interface
- font-interface
- percent-repeat-interface
- percent-repeat-item-interface))))))
+ (break-align-symbol . staff-bar)
+ (break-visibility . ,begin-of-line-invisible)
+ (dot-negative-kern . 0.75)
+ (font-encoding . fetaMusic)
+ (non-musical . #t)
+ (slash-negative-kern . 1.6)
+ (slope . 1.0)
+ (stencil . ,ly:percent-repeat-item-interface::double-percent)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (thickness . 0.48)
+ (meta . ((class . Item)
+ (interfaces . (break-aligned-interface
+ font-interface
+ percent-repeat-interface
+ percent-repeat-item-interface))))))
(DoublePercentRepeatCounter
. (
- (direction . ,UP)
- (font-encoding . fetaText)
- (font-size . -2)
- (padding . 0.2)
- (self-alignment-X . ,CENTER)
- (side-axis . ,Y)
- (staff-padding . 0.25)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::centered-on-y-parent))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- percent-repeat-interface
- percent-repeat-item-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (direction . ,UP)
+ (font-encoding . fetaText)
+ (font-size . -2)
+ (padding . 0.2)
+ (self-alignment-X . ,CENTER)
+ (side-axis . ,Y)
+ (staff-padding . 0.25)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::centered-on-y-parent))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ percent-repeat-interface
+ percent-repeat-item-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(DoubleRepeatSlash
. (
- (dot-negative-kern . 0.75)
- (font-encoding . fetaMusic)
- (slash-negative-kern . 1.6)
- (slope . 1.0)
- (stencil . ,ly:percent-repeat-item-interface::beat-slash)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (thickness . 0.48)
- (meta . ((class . Item)
- (interfaces . (font-interface
- percent-repeat-interface
- percent-repeat-item-interface
- rhythmic-grob-interface))))))
+ (dot-negative-kern . 0.75)
+ (font-encoding . fetaMusic)
+ (slash-negative-kern . 1.6)
+ (slope . 1.0)
+ (stencil . ,ly:percent-repeat-item-interface::beat-slash)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (thickness . 0.48)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ percent-repeat-interface
+ percent-repeat-item-interface
+ rhythmic-grob-interface))))))
(DynamicLineSpanner
. (
- (axes . (,Y))
- (cross-staff . ,ly:side-position-interface::calc-cross-staff)
- (direction . ,DOWN)
- (minimum-space . 1.2)
- (outside-staff-priority . 250)
- (outside-staff-padding . 0.6)
- (padding . 0.6)
- (side-axis . ,Y)
- (slur-padding . 0.3)
- (staff-padding . 0.1)
- (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- dynamic-interface
- dynamic-line-spanner-interface
- side-position-interface))))))
+ (axes . (,Y))
+ (cross-staff . ,ly:side-position-interface::calc-cross-staff)
+ (direction . ,DOWN)
+ (minimum-space . 1.2)
+ (outside-staff-priority . 250)
+ (outside-staff-padding . 0.6)
+ (padding . 0.6)
+ (side-axis . ,Y)
+ (slur-padding . 0.3)
+ (staff-padding . 0.1)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ dynamic-interface
+ dynamic-line-spanner-interface
+ side-position-interface))))))
(DynamicText
. (
- ;; todo.
-
- (collision-bias . -2.0)
- (collision-padding . 0.5)
- (direction . ,ly:script-interface::calc-direction)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (font-encoding . fetaText)
- (font-series . bold)
- (font-shape . italic)
- (positioning-done . ,ly:script-interface::calc-positioning-done)
- (right-padding . 0.5)
- (self-alignment-X . ,CENTER)
- (self-alignment-Y . ,CENTER)
- (stencil . ,ly:text-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-offset . ,self-alignment-interface::y-aligned-on-self)
- (meta . ((class . Item)
- (interfaces . (dynamic-interface
- dynamic-text-interface
- font-interface
- script-interface
- self-alignment-interface
- text-interface))))))
+ ;; todo.
+
+ (collision-bias . -2.0)
+ (collision-padding . 0.5)
+ (direction . ,ly:script-interface::calc-direction)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (font-encoding . fetaText)
+ (font-series . bold)
+ (font-shape . italic)
+ (positioning-done . ,ly:script-interface::calc-positioning-done)
+ (right-padding . 0.5)
+ (self-alignment-X . ,CENTER)
+ (self-alignment-Y . ,CENTER)
+ (stencil . ,ly:text-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-offset . ,self-alignment-interface::y-aligned-on-self)
+ (meta . ((class . Item)
+ (interfaces . (dynamic-interface
+ dynamic-text-interface
+ font-interface
+ script-interface
+ self-alignment-interface
+ text-interface))))))
(DynamicTextSpanner
. (
- (before-line-breaking . ,dynamic-text-spanner::before-line-breaking)
- (bound-details . ((right . ((attach-dir . ,LEFT)
- (Y . 0)
- (padding . 0.75)
- ))
- (right-broken . ((attach-dir . ,RIGHT)
- (padding . 0.0)
- ))
-
- (left . ((attach-dir . ,LEFT)
- (Y . 0)
- (stencil-offset . (-0.75 . -0.5))
- (padding . 0.75)
- ))
- (left-broken . ((attach-dir . ,RIGHT)
- ))
- ))
- (dash-fraction . 0.2)
- (dash-period . 3.0)
-
- ;; rather ugh with NCSB
- ;; (font-series . bold)
- (font-shape . italic)
-
- ;; need to blend with dynamic texts.
- (font-size . 1)
-
- (left-bound-info . ,ly:line-spanner::calc-left-bound-info-and-text)
-
- (minimum-length . 2.0)
- ;; make sure the spanner doesn't get too close to notes
- (minimum-Y-extent . (-1 . 1))
-
- (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
- (skyline-horizontal-padding . 0.2)
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:line-spanner::print)
- (style . dashed-line)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (meta . ((class . Spanner)
- (interfaces . (dynamic-interface
- dynamic-text-spanner-interface
- font-interface
- line-interface
- line-spanner-interface
- spanner-interface
- text-interface))))))
+ (before-line-breaking . ,dynamic-text-spanner::before-line-breaking)
+ (bound-details . ((right . ((attach-dir . ,LEFT)
+ (Y . 0)
+ (padding . 0.75)
+ ))
+ (right-broken . ((attach-dir . ,RIGHT)
+ (padding . 0.0)
+ ))
+
+ (left . ((attach-dir . ,LEFT)
+ (Y . 0)
+ (stencil-offset . (-0.75 . -0.5))
+ (padding . 0.75)
+ ))
+ (left-broken . ((attach-dir . ,RIGHT)
+ ))
+ ))
+ (dash-fraction . 0.2)
+ (dash-period . 3.0)
+
+ ;; rather ugh with NCSB
+ ;; (font-series . bold)
+ (font-shape . italic)
+
+ ;; need to blend with dynamic texts.
+ (font-size . 1)
+
+ (left-bound-info . ,ly:line-spanner::calc-left-bound-info-and-text)
+
+ (minimum-length . 2.0)
+ ;; make sure the spanner doesn't get too close to notes
+ (minimum-Y-extent . (-1 . 1))
+
+ (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
+ (skyline-horizontal-padding . 0.2)
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:line-spanner::print)
+ (style . dashed-line)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (meta . ((class . Spanner)
+ (interfaces . (dynamic-interface
+ dynamic-text-spanner-interface
+ font-interface
+ line-interface
+ line-spanner-interface
+ spanner-interface
+ text-interface))))))
(Episema
. (
- (bound-details . ((left . ((Y . 0)
- (padding . 0)
- (attach-dir . ,LEFT)
- ))
- (right . ((Y . 0)
- (padding . 0)
- (attach-dir . ,RIGHT)
- ))
- ))
- (direction . ,UP)
- (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
- (quantize-position . #t)
- (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
- (side-axis . ,Y)
- (stencil . ,ly:line-spanner::print)
- (style . line)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (interfaces . (episema-interface
- font-interface
- line-interface
- line-spanner-interface
- side-position-interface))))))
+ (bound-details . ((left . ((Y . 0)
+ (padding . 0)
+ (attach-dir . ,LEFT)
+ ))
+ (right . ((Y . 0)
+ (padding . 0)
+ (attach-dir . ,RIGHT)
+ ))
+ ))
+ (direction . ,UP)
+ (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
+ (quantize-position . #t)
+ (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
+ (side-axis . ,Y)
+ (stencil . ,ly:line-spanner::print)
+ (style . line)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (interfaces . (episema-interface
+ font-interface
+ line-interface
+ line-spanner-interface
+ side-position-interface))))))
(Fingering
. (
- ;; sync with TextScript (?)
- (add-stem-support . ,only-if-beamed)
- (avoid-slur . around)
- (cross-staff . ,script-or-side-position-cross-staff)
- (direction . ,ly:script-interface::calc-direction)
- (font-encoding . fetaText)
- (font-size . -5) ; don't overlap when next to heads.
- (padding . 0.5)
- (positioning-done . ,ly:script-interface::calc-positioning-done)
- (script-priority . 100)
- (self-alignment-X . ,CENTER)
- (self-alignment-Y . ,CENTER)
- (slur-padding . 0.2)
- (staff-padding . 0.5)
- (stencil . ,ly:text-interface::print)
- (text . ,fingering::calc-text)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (finger-interface
- font-interface
- self-alignment-interface
- side-position-interface
- text-interface
- text-script-interface))))))
+ ;; sync with TextScript (?)
+ (add-stem-support . ,only-if-beamed)
+ (avoid-slur . around)
+ (cross-staff . ,script-or-side-position-cross-staff)
+ (direction . ,ly:script-interface::calc-direction)
+ (font-encoding . fetaText)
+ (font-size . -5) ; don't overlap when next to heads.
+ (padding . 0.5)
+ (positioning-done . ,ly:script-interface::calc-positioning-done)
+ (script-priority . 100)
+ (self-alignment-X . ,CENTER)
+ (self-alignment-Y . ,CENTER)
+ (slur-padding . 0.2)
+ (staff-padding . 0.5)
+ (stencil . ,ly:text-interface::print)
+ (text . ,fingering::calc-text)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (finger-interface
+ font-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface
+ text-script-interface))))))
(FingeringColumn
. (
- (padding . 0.2)
- (positioning-done . ,ly:fingering-column::calc-positioning-done)
- (snap-radius . 0.3)
- (meta . ((class . Item)
- (interfaces . (fingering-column-interface))))))
+ (padding . 0.2)
+ (positioning-done . ,ly:fingering-column::calc-positioning-done)
+ (snap-radius . 0.3)
+ (meta . ((class . Item)
+ (interfaces . (fingering-column-interface))))))
(Flag
. (
- (glyph-name . ,ly:flag::glyph-name)
- (stencil . ,ly:flag::print)
- (X-extent . ,ly:flag::width)
- (X-offset . ,ly:flag::calc-x-offset)
- (Y-offset . ,(ly:make-unpure-pure-container ly:flag::calc-y-offset ly:flag::pure-calc-y-offset))
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (meta . ((class . Item)
- (interfaces . (flag-interface
+ (glyph-name . ,ly:flag::glyph-name)
+ (stencil . ,ly:flag::print)
+ (X-extent . ,ly:flag::width)
+ (X-offset . ,ly:flag::calc-x-offset)
+ (Y-offset . ,(ly:make-unpure-pure-container ly:flag::calc-y-offset ly:flag::pure-calc-y-offset))
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (flag-interface
font-interface))))))
(FootnoteItem
. (
- (annotation-balloon . #f)
- (annotation-line . #t)
- (automatically-numbered . ,(grob::calc-property-by-copy 'automatically-numbered))
- (break-visibility . ,(grob::inherit-parent-property
+ (annotation-balloon . #f)
+ (annotation-line . #t)
+ (automatically-numbered . ,(grob::calc-property-by-copy 'automatically-numbered))
+ (break-visibility . ,(grob::inherit-parent-property
X 'break-visibility))
- (footnote . #t)
- (footnote-text . ,(grob::calc-property-by-copy 'footnote-text))
- (stencil . ,ly:balloon-interface::print)
- (text . ,(grob::calc-property-by-copy 'text))
- (X-extent . #f)
- (Y-extent . #f)
- (X-offset . ,(grob::calc-property-by-copy 'X-offset))
- (Y-offset . ,(grob::calc-property-by-copy 'Y-offset))
- (meta . ((class . Item)
- (interfaces . (balloon-interface
- footnote-interface
- font-interface
- text-interface))))))
+ (footnote . #t)
+ (footnote-text . ,(grob::calc-property-by-copy 'footnote-text))
+ (stencil . ,ly:balloon-interface::print)
+ (text . ,(grob::calc-property-by-copy 'text))
+ (X-extent . #f)
+ (Y-extent . #f)
+ (X-offset . ,(grob::calc-property-by-copy 'X-offset))
+ (Y-offset . ,(grob::calc-property-by-copy 'Y-offset))
+ (meta . ((class . Item)
+ (interfaces . (balloon-interface
+ footnote-interface
+ font-interface
+ text-interface))))))
(FootnoteSpanner
. (
- (annotation-balloon . #f)
- (annotation-line . #t)
- (automatically-numbered . ,(grob::calc-property-by-copy 'automatically-numbered))
- (footnote . #t)
- (footnote-text . ,(grob::calc-property-by-copy 'footnote-text))
- (spanner-placement . ,LEFT)
- (stencil . ,ly:balloon-interface::print-spanner)
- (text . ,(grob::calc-property-by-copy 'text))
- (X-extent . #f)
- (Y-extent . #f)
- (X-offset . ,(grob::calc-property-by-copy 'X-offset))
- (Y-offset . ,(grob::calc-property-by-copy 'Y-offset))
- (meta . ((class . Spanner)
- (interfaces . (balloon-interface
+ (annotation-balloon . #f)
+ (annotation-line . #t)
+ (automatically-numbered . ,(grob::calc-property-by-copy 'automatically-numbered))
+ (footnote . #t)
+ (footnote-text . ,(grob::calc-property-by-copy 'footnote-text))
+ (spanner-placement . ,LEFT)
+ (stencil . ,ly:balloon-interface::print-spanner)
+ (text . ,(grob::calc-property-by-copy 'text))
+ (X-extent . #f)
+ (Y-extent . #f)
+ (X-offset . ,(grob::calc-property-by-copy 'X-offset))
+ (Y-offset . ,(grob::calc-property-by-copy 'Y-offset))
+ (meta . ((class . Spanner)
+ (interfaces . (balloon-interface
footnote-interface
- footnote-spanner-interface
- font-interface
- text-interface))))))
+ footnote-spanner-interface
+ font-interface
+ text-interface))))))
(FretBoard
. (
- (after-line-breaking . ,ly:chord-name::after-line-breaking)
- (fret-diagram-details . ((finger-code . below-string)))
- (stencil . ,fret-board::calc-stencil)
- (extra-spacing-height . (0.2 . -0.2))
- (extra-spacing-width . (-0.5 . 0.5))
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (chord-name-interface
- font-interface
- fret-diagram-interface
- rhythmic-grob-interface))))))
+ (after-line-breaking . ,ly:chord-name::after-line-breaking)
+ (fret-diagram-details . ((finger-code . below-string)))
+ (stencil . ,fret-board::calc-stencil)
+ (extra-spacing-height . (0.2 . -0.2))
+ (extra-spacing-width . (-0.5 . 0.5))
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (chord-name-interface
+ font-interface
+ fret-diagram-interface
+ rhythmic-grob-interface))))))
(Glissando
. (
- (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
- (bound-details . ((right . ((attach-dir . ,LEFT)
- (end-on-accidental . #t)
- (padding . 0.5)
- ))
- (left . ((attach-dir . ,RIGHT)
- (padding . 0.5)
- ))
- ))
- (cross-staff . ,ly:line-spanner::calc-cross-staff)
- (gap . 0.5)
- (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
- (normalized-endpoints . ,ly:spanner::calc-normalized-endpoints)
- (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
- (simple-Y . #t)
- (stencil . ,ly:line-spanner::print)
- (style . line)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (X-extent . #f)
- (Y-extent . #f)
- (zigzag-width . 0.75)
- (meta . ((class . Spanner)
- (interfaces . (glissando-interface
- line-interface
- line-spanner-interface
- unbreakable-spanner-interface))))))
+ (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
+ (bound-details . ((right . ((attach-dir . ,LEFT)
+ (end-on-accidental . #t)
+ (padding . 0.5)
+ ))
+ (left . ((attach-dir . ,RIGHT)
+ (padding . 0.5)
+ ))
+ ))
+ (cross-staff . ,ly:line-spanner::calc-cross-staff)
+ (gap . 0.5)
+ (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
+ (normalized-endpoints . ,ly:spanner::calc-normalized-endpoints)
+ (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
+ (simple-Y . #t)
+ (stencil . ,ly:line-spanner::print)
+ (style . line)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (zigzag-width . 0.75)
+ (meta . ((class . Spanner)
+ (interfaces . (glissando-interface
+ line-interface
+ line-spanner-interface
+ unbreakable-spanner-interface))))))
(GraceSpacing
. (
- (common-shortest-duration . ,grace-spacing::calc-shortest-duration)
- (shortest-duration-space . 1.6)
- (spacing-increment . 0.8)
- (meta . ((class . Spanner)
- (interfaces . (grace-spacing-interface
- spacing-options-interface
- spanner-interface))))))
+ (common-shortest-duration . ,grace-spacing::calc-shortest-duration)
+ (shortest-duration-space . 1.6)
+ (spacing-increment . 0.8)
+ (meta . ((class . Spanner)
+ (interfaces . (grace-spacing-interface
+ spacing-options-interface
+ spanner-interface))))))
(GridLine
. (
- (layer . 0)
- (self-alignment-X . ,CENTER)
- (stencil . ,ly:grid-line-interface::print)
- (X-extent . ,ly:grid-line-interface::width)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::centered-on-x-parent))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (meta . ((class . Item)
- (interfaces . (grid-line-interface
- self-alignment-interface))))))
+ (layer . 0)
+ (self-alignment-X . ,CENTER)
+ (stencil . ,ly:grid-line-interface::print)
+ (X-extent . ,ly:grid-line-interface::width)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::centered-on-x-parent))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (meta . ((class . Item)
+ (interfaces . (grid-line-interface
+ self-alignment-interface))))))
(GridPoint
. (
- (X-extent . (0 . 0))
- (Y-extent . (0 . 0))
- (meta . ((class . Item)
- (interfaces . (grid-point-interface))))))
+ (X-extent . (0 . 0))
+ (Y-extent . (0 . 0))
+ (meta . ((class . Item)
+ (interfaces . (grid-point-interface))))))
(Hairpin
. (
- (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
- (bound-padding . 1.0)
- (broken-bound-padding . ,ly:hairpin::broken-bound-padding)
- (circled-tip . #f)
- (grow-direction . ,hairpin::calc-grow-direction)
- (height . 0.6666)
- (minimum-length . 2.0)
- (self-alignment-Y . ,CENTER)
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:hairpin::print)
- (thickness . 1.0)
- (to-barline . #t)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (Y-extent . ,(grob::unpure-Y-extent-from-stencil ly:hairpin::pure-height))
- (Y-offset . ,self-alignment-interface::y-aligned-on-self)
- (meta . ((class . Spanner)
- (interfaces . (dynamic-interface
- hairpin-interface
- line-interface
- self-alignment-interface
- spanner-interface))))))
+ (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
+ (bound-padding . 1.0)
+ (broken-bound-padding . ,ly:hairpin::broken-bound-padding)
+ (circled-tip . #f)
+ (grow-direction . ,hairpin::calc-grow-direction)
+ (height . 0.6666)
+ (minimum-length . 2.0)
+ (self-alignment-Y . ,CENTER)
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:hairpin::print)
+ (thickness . 1.0)
+ (to-barline . #t)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (Y-extent . ,(grob::unpure-Y-extent-from-stencil ly:hairpin::pure-height))
+ (Y-offset . ,self-alignment-interface::y-aligned-on-self)
+ (meta . ((class . Spanner)
+ (interfaces . (dynamic-interface
+ hairpin-interface
+ line-interface
+ self-alignment-interface
+ spanner-interface))))))
(HorizontalBracket
. (
- (bracket-flare . (0.5 . 0.5))
- (connect-to-neighbor . ,ly:tuplet-bracket::calc-connect-to-neighbors)
- (direction . ,DOWN)
- (padding . 0.2)
- (side-axis . ,Y)
- (staff-padding . 0.2)
- (stencil . ,ly:horizontal-bracket::print)
- (thickness . 1.0)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (interfaces . (horizontal-bracket-interface
- line-interface
- side-position-interface
- spanner-interface))))))
+ (bracket-flare . (0.5 . 0.5))
+ (connect-to-neighbor . ,ly:tuplet-bracket::calc-connect-to-neighbors)
+ (direction . ,DOWN)
+ (padding . 0.2)
+ (side-axis . ,Y)
+ (staff-padding . 0.2)
+ (stencil . ,ly:horizontal-bracket::print)
+ (thickness . 1.0)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (interfaces . (horizontal-bracket-interface
+ line-interface
+ side-position-interface
+ spanner-interface))))))
(InstrumentName
. (
- (direction . ,LEFT)
- (padding . 0.3)
- (self-alignment-X . ,CENTER)
- (self-alignment-Y . ,CENTER)
- (stencil . ,system-start-text::print)
- (X-offset . ,system-start-text::calc-x-offset)
- (Y-offset . ,system-start-text::calc-y-offset)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- self-alignment-interface
- side-position-interface
- system-start-text-interface))))))
+ (direction . ,LEFT)
+ (padding . 0.3)
+ (self-alignment-X . ,CENTER)
+ (self-alignment-Y . ,CENTER)
+ (stencil . ,system-start-text::print)
+ (X-offset . ,system-start-text::calc-x-offset)
+ (Y-offset . ,system-start-text::calc-y-offset)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ self-alignment-interface
+ side-position-interface
+ system-start-text-interface))))))
(InstrumentSwitch
. (
- (direction . ,UP)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (outside-staff-priority . 500)
- (padding . 0.5)
- (self-alignment-X . ,LEFT)
- (side-axis . ,Y)
- (staff-padding . 0.5)
- (stencil . ,ly:text-interface::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Item)
- (interfaces . (font-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (direction . ,UP)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (outside-staff-priority . 500)
+ (padding . 0.5)
+ (self-alignment-X . ,LEFT)
+ (side-axis . ,Y)
+ (staff-padding . 0.5)
+ (stencil . ,ly:text-interface::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(KeyCancellation
. (
- (break-align-symbol . key-cancellation)
- (break-visibility . ,begin-of-line-invisible)
- (glyph-name-alist . ,cancellation-glyph-name-alist)
- (non-musical . #t)
- (flat-positions . (2 3 4 2 1 2 1))
- (sharp-positions . (4 5 4 2 3 2 3))
- (space-alist . (
- (time-signature . (extra-space . 1.25))
- (staff-bar . (extra-space . 0.6))
- (key-signature . (extra-space . 0.5))
- (cue-clef . (extra-space . 0.5))
- (right-edge . (extra-space . 0.5))
- (first-note . (fixed-space . 2.5))))
- (stencil . ,ly:key-signature-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (extra-spacing-width . (0.0 . 1.0))
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-including-staff)
- (Y-offset . ,staff-symbol-referencer::callback)
- (meta . ((class . Item)
+ (break-align-symbol . key-cancellation)
+ (break-visibility . ,begin-of-line-invisible)
+ (glyph-name-alist . ,cancellation-glyph-name-alist)
+ (non-musical . #t)
+ (flat-positions . (2 3 4 2 1 2 1))
+ (sharp-positions . (4 5 4 2 3 2 3))
+ (space-alist . (
+ (time-signature . (extra-space . 1.25))
+ (staff-bar . (extra-space . 0.6))
+ (key-signature . (extra-space . 0.5))
+ (cue-clef . (extra-space . 0.5))
+ (right-edge . (extra-space . 0.5))
+ (first-note . (fixed-space . 2.5))))
+ (stencil . ,ly:key-signature-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (extra-spacing-width . (0.0 . 1.0))
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-including-staff)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (break-aligned-interface
- font-interface
- key-cancellation-interface
- key-signature-interface
- pure-from-neighbor-interface
- staff-symbol-referencer-interface))))))
+ (interfaces . (break-aligned-interface
+ font-interface
+ key-cancellation-interface
+ key-signature-interface
+ pure-from-neighbor-interface
+ staff-symbol-referencer-interface))))))
(KeySignature
. (
- (avoid-slur . inside)
- (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
- (break-align-anchor-alignment . ,RIGHT)
- (break-align-symbol . key-signature)
- (break-visibility . ,begin-of-line-visible)
- (glyph-name-alist . ,standard-alteration-glyph-name-alist)
- (non-musical . #t)
- (flat-positions . (2 3 4 2 1 2 1))
- (sharp-positions . (4 5 4 2 3 2 3))
- (space-alist . (
- (time-signature . (extra-space . 1.15))
- (staff-bar . (extra-space . 1.1))
- (cue-clef . (extra-space . 0.5))
- (right-edge . (extra-space . 0.5))
- (first-note . (fixed-space . 2.5))))
- (stencil . ,ly:key-signature-interface::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (extra-spacing-width . (0.0 . 1.0))
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-including-staff)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-offset . ,staff-symbol-referencer::callback)
- (meta . ((class . Item)
+ (avoid-slur . inside)
+ (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
+ (break-align-anchor-alignment . ,RIGHT)
+ (break-align-symbol . key-signature)
+ (break-visibility . ,begin-of-line-visible)
+ (glyph-name-alist . ,standard-alteration-glyph-name-alist)
+ (non-musical . #t)
+ (flat-positions . (2 3 4 2 1 2 1))
+ (sharp-positions . (4 5 4 2 3 2 3))
+ (space-alist . (
+ (time-signature . (extra-space . 1.15))
+ (staff-bar . (extra-space . 1.1))
+ (cue-clef . (extra-space . 0.5))
+ (right-edge . (extra-space . 0.5))
+ (first-note . (fixed-space . 2.5))))
+ (stencil . ,ly:key-signature-interface::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (extra-spacing-width . (0.0 . 1.0))
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-including-staff)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (break-aligned-interface
- font-interface
- key-signature-interface
- pure-from-neighbor-interface
- staff-symbol-referencer-interface))))))
+ (interfaces . (break-aligned-interface
+ font-interface
+ key-signature-interface
+ pure-from-neighbor-interface
+ staff-symbol-referencer-interface))))))
(KievanLigature
. (
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:kievan-ligature::print)
- (padding . 0.5)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- kievan-ligature-interface))))))
-
- (LaissezVibrerTie
- . (
- (control-points . ,ly:semi-tie::calc-control-points)
- (cross-staff . ,semi-tie::calc-cross-staff)
- (details . ((ratio . 0.333)
- (height-limit . 1.0)))
- (direction . ,ly:tie::calc-direction)
- (head-direction . ,LEFT)
- (stencil . ,laissez-vibrer::print)
- (thickness . 1.0)
- (extra-spacing-height . (-0.5 . 0.5))
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (semi-tie-interface))))))
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:kievan-ligature::print)
+ (padding . 0.5)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ kievan-ligature-interface))))))
+
+ (LaissezVibrerTie
+ . (
+ (control-points . ,ly:semi-tie::calc-control-points)
+ (cross-staff . ,semi-tie::calc-cross-staff)
+ (details . ((ratio . 0.333)
+ (height-limit . 1.0)))
+ (direction . ,ly:tie::calc-direction)
+ (head-direction . ,LEFT)
+ (stencil . ,laissez-vibrer::print)
+ (thickness . 1.0)
+ (extra-spacing-height . (-0.5 . 0.5))
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (semi-tie-interface))))))
(LaissezVibrerTieColumn
. (
- (head-direction . ,ly:semi-tie-column::calc-head-direction)
- (positioning-done . ,ly:semi-tie-column::calc-positioning-done)
- (X-extent . #f)
- (Y-extent . #f)
- (meta . ((class . Item)
- (interfaces . (semi-tie-column-interface))))))
+ (head-direction . ,ly:semi-tie-column::calc-head-direction)
+ (positioning-done . ,ly:semi-tie-column::calc-positioning-done)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (meta . ((class . Item)
+ (interfaces . (semi-tie-column-interface))))))
(LedgerLineSpanner
. (
- (layer . 0)
- (length-fraction . 0.25)
- (minimum-length-fraction . 0.25)
- (springs-and-rods . ,ly:ledger-line-spanner::set-spacing-rods)
- (stencil . ,ly:ledger-line-spanner::print)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (X-extent . #f)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (ledger-line-spanner-interface))))))
+ (layer . 0)
+ (length-fraction . 0.25)
+ (minimum-length-fraction . 0.25)
+ (springs-and-rods . ,ly:ledger-line-spanner::set-spacing-rods)
+ (stencil . ,ly:ledger-line-spanner::print)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (ledger-line-spanner-interface))))))
(LeftEdge
. (
- (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
- (break-align-symbol . left-edge)
- (break-visibility . ,center-invisible)
- (non-musical . #t)
- (extra-spacing-height . (+inf.0 . -inf.0))
- (space-alist . (
- (ambitus . (extra-space . 2.0))
- (breathing-sign . (minimum-space . 0.0))
- (cue-end-clef . (extra-space . 0.8))
- (clef . (extra-space . 0.8))
- (cue-clef . (extra-space . 0.8))
- (staff-bar . (extra-space . 0.0))
- (key-cancellation . (extra-space . 0.0))
- (key-signature . (extra-space . 0.8))
- (time-signature . (extra-space . 1.0))
- (custos . (extra-space . 0.0))
- (first-note . (fixed-space . 2.0))
- (right-edge . (extra-space . 0.0))
- ))
- (X-extent . (0 . 0))
- (meta . ((class . Item)
- (interfaces . (break-aligned-interface))))))
+ (break-align-anchor . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
+ (break-align-symbol . left-edge)
+ (break-visibility . ,center-invisible)
+ (non-musical . #t)
+ (extra-spacing-height . (+inf.0 . -inf.0))
+ (space-alist . (
+ (ambitus . (extra-space . 2.0))
+ (breathing-sign . (minimum-space . 0.0))
+ (cue-end-clef . (extra-space . 0.8))
+ (clef . (extra-space . 0.8))
+ (cue-clef . (extra-space . 0.8))
+ (staff-bar . (extra-space . 0.0))
+ (key-cancellation . (extra-space . 0.0))
+ (key-signature . (extra-space . 0.8))
+ (time-signature . (extra-space . 1.0))
+ (custos . (extra-space . 0.0))
+ (first-note . (fixed-space . 2.0))
+ (right-edge . (extra-space . 0.0))
+ ))
+ (X-extent . (0 . 0))
+ (meta . ((class . Item)
+ (interfaces . (break-aligned-interface))))))
(LigatureBracket
. (
- ;; ugh. A ligature bracket is totally different from
- ;; a tuplet bracket.
-
- (bracket-visibility . #t)
- (connect-to-neighbor . ,ly:tuplet-bracket::calc-connect-to-neighbors)
- (direction . ,UP)
- (edge-height . (0.7 . 0.7))
- (padding . 2.0)
- (positions . ,ly:tuplet-bracket::calc-positions)
- (shorten-pair . (-0.2 . -0.2))
- (staff-padding . 0.25)
- (stencil . ,ly:tuplet-bracket::print)
- (thickness . 1.6)
- (X-positions . ,ly:tuplet-bracket::calc-x-positions)
- (meta . ((class . Spanner)
- (interfaces . (line-interface
- tuplet-bracket-interface))))))
+ ;; ugh. A ligature bracket is totally different from
+ ;; a tuplet bracket.
+
+ (bracket-visibility . #t)
+ (connect-to-neighbor . ,ly:tuplet-bracket::calc-connect-to-neighbors)
+ (direction . ,UP)
+ (edge-height . (0.7 . 0.7))
+ (padding . 2.0)
+ (positions . ,ly:tuplet-bracket::calc-positions)
+ (shorten-pair . (-0.2 . -0.2))
+ (staff-padding . 0.25)
+ (stencil . ,ly:tuplet-bracket::print)
+ (thickness . 1.6)
+ (X-positions . ,ly:tuplet-bracket::calc-x-positions)
+ (meta . ((class . Spanner)
+ (interfaces . (line-interface
+ tuplet-bracket-interface))))))
(LyricExtender
. (
- (minimum-length . 1.5)
- (stencil . ,ly:lyric-extender::print)
- (thickness . 0.8) ; line-thickness
- (Y-extent . (0 . 0))
- (meta . ((class . Spanner)
- (interfaces . (lyric-extender-interface
- lyric-interface))))))
+ (minimum-length . 1.5)
+ (stencil . ,ly:lyric-extender::print)
+ (thickness . 0.8) ; line-thickness
+ (Y-extent . (0 . 0))
+ (meta . ((class . Spanner)
+ (interfaces . (lyric-extender-interface
+ lyric-interface))))))
(LyricHyphen
. (
- (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
- (dash-period . 10.0)
- (height . 0.42)
- (length . 0.66)
- (minimum-distance . 0.1)
- (minimum-length . 0.3)
- (padding . 0.07)
- (springs-and-rods . ,ly:lyric-hyphen::set-spacing-rods)
- (stencil . ,ly:lyric-hyphen::print)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (thickness . 1.3)
- (Y-extent . (0 . 0))
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- lyric-hyphen-interface
- lyric-interface
- spanner-interface))))))
+ (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
+ (dash-period . 10.0)
+ (height . 0.42)
+ (length . 0.66)
+ (minimum-distance . 0.1)
+ (minimum-length . 0.3)
+ (padding . 0.07)
+ (springs-and-rods . ,ly:lyric-hyphen::set-spacing-rods)
+ (stencil . ,ly:lyric-hyphen::print)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (thickness . 1.3)
+ (Y-extent . (0 . 0))
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ lyric-hyphen-interface
+ lyric-interface
+ spanner-interface))))))
(LyricSpace
. (
- (minimum-distance . 0.45)
- (padding . 0.0)
- (springs-and-rods . ,ly:lyric-hyphen::set-spacing-rods)
- (X-extent . #f)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (lyric-hyphen-interface
- spanner-interface))))))
+ (minimum-distance . 0.45)
+ (padding . 0.0)
+ (springs-and-rods . ,ly:lyric-hyphen::set-spacing-rods)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (lyric-hyphen-interface
+ spanner-interface))))))
(LyricText
. (
- (extra-spacing-width . (0.0 . 0.0))
- ;; Recede in height for purposes of note spacing,
- ;; so notes in melismata can be freely spaced above lyrics
- (extra-spacing-height . (0.2 . -0.2))
- (font-series . medium)
- (font-size . 1.0)
- (self-alignment-X . ,CENTER)
- (stencil . ,lyric-text::print)
- (text . ,(grob::calc-property-by-copy 'text))
- (word-space . 0.6)
- (skyline-horizontal-padding . 0.1)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (X-offset . ,ly:self-alignment-interface::aligned-on-x-parent)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- lyric-syllable-interface
- rhythmic-grob-interface
- self-alignment-interface
- text-interface))))))
+ (extra-spacing-width . (0.0 . 0.0))
+ ;; Recede in height for purposes of note spacing,
+ ;; so notes in melismata can be freely spaced above lyrics
+ (extra-spacing-height . (0.2 . -0.2))
+ (font-series . medium)
+ (font-size . 1.0)
+ (self-alignment-X . ,CENTER)
+ (stencil . ,lyric-text::print)
+ (text . ,(grob::calc-property-by-copy 'text))
+ (word-space . 0.6)
+ (skyline-horizontal-padding . 0.1)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::aligned-on-x-parent)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ lyric-syllable-interface
+ rhythmic-grob-interface
+ self-alignment-interface
+ text-interface))))))
(MeasureCounter
. (
@@ -1411,1347 +1411,1347 @@
(outside-staff-padding . 0.5)
(outside-staff-priority . 750)
(self-alignment-X . ,CENTER)
- (side-axis . ,Y)
+ (side-axis . ,Y)
(staff-padding . 0.5)
(stencil . ,measure-counter-stencil)
(meta . ((class . Spanner)
(interfaces . (font-interface
measure-counter-interface
self-alignment-interface
- side-position-interface
+ side-position-interface
text-interface))))))
(MeasureGrouping
. (
- (direction . ,UP)
- (height . 2.0)
- (padding . 2)
- (side-axis . ,Y)
- (staff-padding . 3)
- (stencil . ,ly:measure-grouping::print)
- (thickness . 1)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (interfaces . (measure-grouping-interface
- side-position-interface))))))
+ (direction . ,UP)
+ (height . 2.0)
+ (padding . 2)
+ (side-axis . ,Y)
+ (staff-padding . 3)
+ (stencil . ,ly:measure-grouping::print)
+ (thickness . 1)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (interfaces . (measure-grouping-interface
+ side-position-interface))))))
(MelodyItem
. (
- (neutral-direction . ,DOWN)
- (meta . ((class . Item)
- (interfaces . (melody-spanner-interface))))))
+ (neutral-direction . ,DOWN)
+ (meta . ((class . Item)
+ (interfaces . (melody-spanner-interface))))))
(MensuralLigature
. (
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:mensural-ligature::print)
- (thickness . 1.3)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- mensural-ligature-interface))))))
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:mensural-ligature::print)
+ (thickness . 1.3)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ mensural-ligature-interface))))))
(MetronomeMark
. (
- (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
- (break-visibility . ,end-of-line-invisible)
- (direction . ,UP)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (outside-staff-horizontal-padding . 0.2)
- (outside-staff-priority . 1000)
- (padding . 0.8)
- (side-axis . ,Y)
- (stencil . ,ly:text-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:break-alignable-interface::self-align-callback))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (self-alignment-X . ,LEFT)
- (break-align-symbols . (time-signature))
- (non-break-align-symbols . (paper-column-interface))
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (break-alignable-interface
- font-interface
- metronome-mark-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
+ (break-visibility . ,end-of-line-invisible)
+ (direction . ,UP)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (outside-staff-horizontal-padding . 0.2)
+ (outside-staff-priority . 1000)
+ (padding . 0.8)
+ (side-axis . ,Y)
+ (stencil . ,ly:text-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:break-alignable-interface::self-align-callback))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (self-alignment-X . ,LEFT)
+ (break-align-symbols . (time-signature))
+ (non-break-align-symbols . (paper-column-interface))
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (break-alignable-interface
+ font-interface
+ metronome-mark-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(MultiMeasureRest
. (
- (expand-limit . 10)
- (hair-thickness . 2.0)
- (round-up-exceptions . ())
- (padding . 1)
- (spacing-pair . (break-alignment . break-alignment))
- (springs-and-rods . ,ly:multi-measure-rest::set-spacing-rods)
- (stencil . ,ly:multi-measure-rest::print)
- (thick-thickness . 6.6)
- ;; See Wanske pp. 125
- (usable-duration-logs . ,(iota 4 -3))
- (Y-extent . ,(ly:make-unpure-pure-container ly:multi-measure-rest::height))
- (Y-offset . ,staff-symbol-referencer::callback)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- multi-measure-interface
- multi-measure-rest-interface
- rest-interface
- staff-symbol-referencer-interface))))))
+ (expand-limit . 10)
+ (hair-thickness . 2.0)
+ (round-up-exceptions . ())
+ (padding . 1)
+ (spacing-pair . (break-alignment . break-alignment))
+ (springs-and-rods . ,ly:multi-measure-rest::set-spacing-rods)
+ (stencil . ,ly:multi-measure-rest::print)
+ (thick-thickness . 6.6)
+ ;; See Wanske pp. 125
+ (usable-duration-logs . ,(iota 4 -3))
+ (Y-extent . ,(ly:make-unpure-pure-container ly:multi-measure-rest::height))
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ multi-measure-interface
+ multi-measure-rest-interface
+ rest-interface
+ staff-symbol-referencer-interface))))))
(MultiMeasureRestNumber
. (
- (bound-padding . 2.0)
- (direction . ,UP)
- (font-encoding . fetaText)
- (padding . 0.4)
- (self-alignment-X . ,CENTER)
- (side-axis . ,Y)
- (springs-and-rods . ,ly:multi-measure-rest::set-text-rods)
- (staff-padding . 0.4)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-centered-on-y-parent)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- multi-measure-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (bound-padding . 2.0)
+ (direction . ,UP)
+ (font-encoding . fetaText)
+ (padding . 0.4)
+ (self-alignment-X . ,CENTER)
+ (side-axis . ,Y)
+ (springs-and-rods . ,ly:multi-measure-rest::set-text-rods)
+ (staff-padding . 0.4)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-centered-on-y-parent)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ multi-measure-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(MultiMeasureRestText
. (
- (direction . ,UP)
- (outside-staff-priority . 450)
- (padding . 0.2)
- (self-alignment-X . ,CENTER)
- (skyline-horizontal-padding . 0.2)
- (staff-padding . 0.25)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-centered-on-y-parent))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- multi-measure-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (direction . ,UP)
+ (outside-staff-priority . 450)
+ (padding . 0.2)
+ (self-alignment-X . ,CENTER)
+ (skyline-horizontal-padding . 0.2)
+ (staff-padding . 0.25)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-centered-on-y-parent))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ multi-measure-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(NonMusicalPaperColumn
. (
- (allow-loose-spacing . #t)
- (axes . (,X))
- (before-line-breaking . ,ly:paper-column::before-line-breaking)
- (bound-alignment-interfaces . (break-alignment-interface))
- (full-measure-extra-space . 1.0)
- (horizontal-skylines . ,ly:separation-item::calc-skylines)
- ;; (stencil . ,ly:paper-column::print)
-
- (keep-inside-line . #t)
- (line-break-permission . allow)
- (non-musical . #t)
- (page-break-permission . allow)
-
- ;; debugging stuff: print column number.
- ;; (font-size . -6) (font-name . "sans") (Y-extent . #f)
-
- (X-extent . ,ly:axis-group-interface::width)
- (meta . ((class . Paper_column)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- font-interface
- paper-column-interface
- separation-item-interface
- spaceable-grob-interface))))))
+ (allow-loose-spacing . #t)
+ (axes . (,X))
+ (before-line-breaking . ,ly:paper-column::before-line-breaking)
+ (bound-alignment-interfaces . (break-alignment-interface))
+ (full-measure-extra-space . 1.0)
+ (horizontal-skylines . ,ly:separation-item::calc-skylines)
+ ;; (stencil . ,ly:paper-column::print)
+
+ (keep-inside-line . #t)
+ (line-break-permission . allow)
+ (non-musical . #t)
+ (page-break-permission . allow)
+
+ ;; debugging stuff: print column number.
+ ;; (font-size . -6) (font-name . "sans") (Y-extent . #f)
+
+ (X-extent . ,ly:axis-group-interface::width)
+ (meta . ((class . Paper_column)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ font-interface
+ paper-column-interface
+ separation-item-interface
+ spaceable-grob-interface))))))
(NoteCollision
. (
- (axes . (,X ,Y))
- (positioning-done . ,ly:note-collision-interface::calc-positioning-done)
- (prefer-dotted-right . #t)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (meta . ((class . Item)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- note-collision-interface))))))
+ (axes . (,X ,Y))
+ (positioning-done . ,ly:note-collision-interface::calc-positioning-done)
+ (prefer-dotted-right . #t)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (meta . ((class . Item)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ note-collision-interface))))))
(NoteColumn
. (
- (axes . (,X ,Y))
- (bound-alignment-interfaces . (rhythmic-head-interface stem-interface))
- (cross-staff . ,ly:axis-group-interface::cross-staff)
- (horizontal-skylines . ,ly:separation-item::calc-skylines)
- (skyline-vertical-padding . 0.15)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (meta . ((class . Item)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- note-column-interface
- separation-item-interface))))))
+ (axes . (,X ,Y))
+ (bound-alignment-interfaces . (rhythmic-head-interface stem-interface))
+ (cross-staff . ,ly:axis-group-interface::cross-staff)
+ (horizontal-skylines . ,ly:separation-item::calc-skylines)
+ (skyline-vertical-padding . 0.15)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (meta . ((class . Item)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ note-column-interface
+ separation-item-interface))))))
(NoteHead
. (
- (flexa-width . 2.0)
- (duration-log . ,note-head::calc-duration-log)
- (extra-spacing-height . ,ly:note-head::include-ledger-line-height)
- (glyph-name . ,note-head::calc-glyph-name)
- (ligature-flexa . #f)
- (stem-attachment . ,ly:note-head::calc-stem-attachment)
- (stencil . ,ly:note-head::print)
- (X-offset . ,ly:note-head::stem-x-shift)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- gregorian-ligature-interface
- ledgered-interface
+ (flexa-width . 2.0)
+ (duration-log . ,note-head::calc-duration-log)
+ (extra-spacing-height . ,ly:note-head::include-ledger-line-height)
+ (glyph-name . ,note-head::calc-glyph-name)
+ (ligature-flexa . #f)
+ (stem-attachment . ,ly:note-head::calc-stem-attachment)
+ (stencil . ,ly:note-head::print)
+ (X-offset . ,ly:note-head::stem-x-shift)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ gregorian-ligature-interface
+ ledgered-interface
ligature-head-interface
- mensural-ligature-interface
- note-head-interface
- rhythmic-grob-interface
- rhythmic-head-interface
- staff-symbol-referencer-interface
- vaticana-ligature-interface))))))
+ mensural-ligature-interface
+ note-head-interface
+ rhythmic-grob-interface
+ rhythmic-head-interface
+ staff-symbol-referencer-interface
+ vaticana-ligature-interface))))))
(NoteName
. (
- (stencil . ,ly:text-interface::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- note-name-interface
- text-interface))))))
+ (stencil . ,ly:text-interface::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ note-name-interface
+ text-interface))))))
(NoteSpacing
. (
- ;; Changed this from 0.75.
- ;; If you ever change this back, please document! --hwn
- (knee-spacing-correction . 1.0)
- (same-direction-correction . 0.25)
- (space-to-barline . #t)
- (stem-spacing-correction . 0.5)
- (meta . ((class . Item)
- (interfaces . (note-spacing-interface
- spacing-interface))))))
+ ;; Changed this from 0.75.
+ ;; If you ever change this back, please document! --hwn
+ (knee-spacing-correction . 1.0)
+ (same-direction-correction . 0.25)
+ (space-to-barline . #t)
+ (stem-spacing-correction . 0.5)
+ (meta . ((class . Item)
+ (interfaces . (note-spacing-interface
+ spacing-interface))))))
(OttavaBracket
. (
- (dash-fraction . 0.3)
- (direction . ,UP)
- (edge-height . (0 . 1.2))
- (font-shape . italic)
- (minimum-length . 1.0)
- (outside-staff-priority . 400)
- (padding . 0.5)
- (shorten-pair . (0.0 . -0.6))
- (staff-padding . 1.0)
- (stencil . ,ly:ottava-bracket::print)
- (style . dashed-line)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- horizontal-bracket-interface
- line-interface
- ottava-bracket-interface
- side-position-interface
- text-interface))))))
+ (dash-fraction . 0.3)
+ (direction . ,UP)
+ (edge-height . (0 . 1.2))
+ (font-shape . italic)
+ (minimum-length . 1.0)
+ (outside-staff-priority . 400)
+ (padding . 0.5)
+ (shorten-pair . (0.0 . -0.6))
+ (staff-padding . 1.0)
+ (stencil . ,ly:ottava-bracket::print)
+ (style . dashed-line)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ horizontal-bracket-interface
+ line-interface
+ ottava-bracket-interface
+ side-position-interface
+ text-interface))))))
(PaperColumn
. (
- (allow-loose-spacing . #t)
- (axes . (,X))
- (before-line-breaking . ,ly:paper-column::before-line-breaking)
- (bound-alignment-interfaces . (note-column-interface))
- (horizontal-skylines . ,ly:separation-item::calc-skylines)
- (keep-inside-line . #t)
- ; 0.08 comes from spacing-horizontal-skyline.ly
- ; allows double flat of F to be nestled over dots of C
- (skyline-vertical-padding . 0.08)
- ;; (stencil . ,ly:paper-column::print)
- (X-extent . ,ly:axis-group-interface::width)
-
- ;; debugging
- ;; (font-size . -6) (font-name . "sans") (Y-extent . #f)
- (meta . ((class . Paper_column)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- font-interface
- paper-column-interface
- separation-item-interface
- spaceable-grob-interface))))))
+ (allow-loose-spacing . #t)
+ (axes . (,X))
+ (before-line-breaking . ,ly:paper-column::before-line-breaking)
+ (bound-alignment-interfaces . (note-column-interface))
+ (horizontal-skylines . ,ly:separation-item::calc-skylines)
+ (keep-inside-line . #t)
+ ; 0.08 comes from spacing-horizontal-skyline.ly
+ ; allows double flat of F to be nestled over dots of C
+ (skyline-vertical-padding . 0.08)
+ ;; (stencil . ,ly:paper-column::print)
+ (X-extent . ,ly:axis-group-interface::width)
+
+ ;; debugging
+ ;; (font-size . -6) (font-name . "sans") (Y-extent . #f)
+ (meta . ((class . Paper_column)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ font-interface
+ paper-column-interface
+ separation-item-interface
+ spaceable-grob-interface))))))
(ParenthesesItem
. (
- (font-size . -6)
- (padding . 0.2)
- (stencil . ,parentheses-item::print)
- (stencils . ,parentheses-item::calc-parenthesis-stencils)
- (meta . ((class . Item)
- (interfaces . (font-interface
- parentheses-interface))))))
+ (font-size . -6)
+ (padding . 0.2)
+ (stencil . ,parentheses-item::print)
+ (stencils . ,parentheses-item::calc-parenthesis-stencils)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ parentheses-interface))))))
(PercentRepeat
. (
- (dot-negative-kern . 0.75)
- (font-encoding . fetaMusic)
- (slope . 1.0)
- (spacing-pair . (break-alignment . staff-bar))
- (springs-and-rods . ,ly:multi-measure-rest::set-spacing-rods)
- (stencil . ,ly:multi-measure-rest::percent)
- (thickness . 0.48)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- multi-measure-rest-interface
- percent-repeat-interface))))))
+ (dot-negative-kern . 0.75)
+ (font-encoding . fetaMusic)
+ (slope . 1.0)
+ (spacing-pair . (break-alignment . staff-bar))
+ (springs-and-rods . ,ly:multi-measure-rest::set-spacing-rods)
+ (stencil . ,ly:multi-measure-rest::percent)
+ (thickness . 0.48)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ multi-measure-rest-interface
+ percent-repeat-interface))))))
(PercentRepeatCounter
. (
- (direction . ,UP)
- (font-encoding . fetaText)
- (font-size . -2)
- (padding . 0.2)
- (self-alignment-X . ,CENTER)
- (staff-padding . 0.25)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-centered-on-y-parent))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- percent-repeat-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (direction . ,UP)
+ (font-encoding . fetaText)
+ (font-size . -2)
+ (padding . 0.2)
+ (self-alignment-X . ,CENTER)
+ (staff-padding . 0.25)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-centered-on-y-parent))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ percent-repeat-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(PhrasingSlur
. (
- (control-points . ,ly:slur::calc-control-points)
- (cross-staff . ,ly:slur::calc-cross-staff)
- (details . ,default-slur-details)
- (direction . ,ly:slur::calc-direction)
- (height-limit . 2.0)
- (minimum-length . 1.5)
- (ratio . 0.333)
- (spanner-id . "")
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:slur::print)
- (thickness . 1.1)
- (vertical-skylines . ,(ly:make-unpure-pure-container ly:slur::vertical-skylines ly:grob::pure-simple-vertical-skylines-from-extents))
- (Y-extent . ,slur::height)
- (meta . ((class . Spanner)
- (interfaces . (slur-interface))))))
+ (control-points . ,ly:slur::calc-control-points)
+ (cross-staff . ,ly:slur::calc-cross-staff)
+ (details . ,default-slur-details)
+ (direction . ,ly:slur::calc-direction)
+ (height-limit . 2.0)
+ (minimum-length . 1.5)
+ (ratio . 0.333)
+ (spanner-id . "")
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:slur::print)
+ (thickness . 1.1)
+ (vertical-skylines . ,(ly:make-unpure-pure-container ly:slur::vertical-skylines ly:grob::pure-simple-vertical-skylines-from-extents))
+ (Y-extent . ,slur::height)
+ (meta . ((class . Spanner)
+ (interfaces . (slur-interface))))))
;; an example of a text spanner
(PianoPedalBracket
. (
- (bound-padding . 1.0)
- (bracket-flare . (0.5 . 0.5))
- (direction . ,DOWN)
- (edge-height . (1.0 . 1.0))
- (shorten-pair . (0.0 . 0.0))
- (stencil . ,ly:piano-pedal-bracket::print)
- (style . line)
- (thickness . 1.0)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (meta . ((class . Spanner)
- (interfaces . (line-interface
- piano-pedal-bracket-interface
- piano-pedal-interface))))))
+ (bound-padding . 1.0)
+ (bracket-flare . (0.5 . 0.5))
+ (direction . ,DOWN)
+ (edge-height . (1.0 . 1.0))
+ (shorten-pair . (0.0 . 0.0))
+ (stencil . ,ly:piano-pedal-bracket::print)
+ (style . line)
+ (thickness . 1.0)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (meta . ((class . Spanner)
+ (interfaces . (line-interface
+ piano-pedal-bracket-interface
+ piano-pedal-interface))))))
(RehearsalMark
. (
- (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
- (baseline-skip . 2)
- (break-align-symbols . (staff-bar key-signature clef))
- (break-visibility . ,end-of-line-invisible)
- (direction . ,UP)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (font-size . 2)
- (non-musical . #t)
- (outside-staff-horizontal-padding . 0.12)
- (outside-staff-priority . 1500)
- (padding . 0.8)
- (self-alignment-X . ,CENTER)
- (stencil . ,ly:text-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:break-alignable-interface::self-align-callback))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
- (Y-offset . ,side-position-interface::y-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (break-alignable-interface
- font-interface
- mark-interface
- self-alignment-interface
- side-position-interface
- text-interface))))))
+ (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
+ (baseline-skip . 2)
+ (break-align-symbols . (staff-bar key-signature clef))
+ (break-visibility . ,end-of-line-invisible)
+ (direction . ,UP)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (font-size . 2)
+ (non-musical . #t)
+ (outside-staff-horizontal-padding . 0.12)
+ (outside-staff-priority . 1500)
+ (padding . 0.8)
+ (self-alignment-X . ,CENTER)
+ (stencil . ,ly:text-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:break-alignable-interface::self-align-callback))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (break-alignable-interface
+ font-interface
+ mark-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface))))))
(RepeatSlash
. (
- (slash-negative-kern . 0.85)
- (slope . 1.7)
- (stencil . ,ly:percent-repeat-item-interface::beat-slash)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (thickness . 0.48)
- (meta . ((class . Item)
- (interfaces . (percent-repeat-interface
- percent-repeat-item-interface
- rhythmic-grob-interface))))))
+ (slash-negative-kern . 0.85)
+ (slope . 1.7)
+ (stencil . ,ly:percent-repeat-item-interface::beat-slash)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (thickness . 0.48)
+ (meta . ((class . Item)
+ (interfaces . (percent-repeat-interface
+ percent-repeat-item-interface
+ rhythmic-grob-interface))))))
(RepeatTie
. (
- (cross-staff . ,semi-tie::calc-cross-staff)
- (control-points . ,ly:semi-tie::calc-control-points)
- (details . ((ratio . 0.333)
- (height-limit . 1.0)))
- (direction . ,ly:tie::calc-direction)
- (head-direction . ,RIGHT)
- (stencil . ,ly:tie::print)
- (thickness . 1.0)
- (extra-spacing-height . (-0.5 . 0.5))
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (meta . ((class . Item)
- (interfaces . (semi-tie-interface))))))
+ (cross-staff . ,semi-tie::calc-cross-staff)
+ (control-points . ,ly:semi-tie::calc-control-points)
+ (details . ((ratio . 0.333)
+ (height-limit . 1.0)))
+ (direction . ,ly:tie::calc-direction)
+ (head-direction . ,RIGHT)
+ (stencil . ,ly:tie::print)
+ (thickness . 1.0)
+ (extra-spacing-height . (-0.5 . 0.5))
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (semi-tie-interface))))))
(RepeatTieColumn
. (
- (direction . ,ly:tie::calc-direction)
- (head-direction . ,ly:semi-tie-column::calc-head-direction)
- (positioning-done . ,ly:semi-tie-column::calc-positioning-done)
- (X-extent . #f)
- (Y-extent . #f)
- (meta . ((class . Item)
- (interfaces . (semi-tie-column-interface))))))
+ (direction . ,ly:tie::calc-direction)
+ (head-direction . ,ly:semi-tie-column::calc-head-direction)
+ (positioning-done . ,ly:semi-tie-column::calc-positioning-done)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (meta . ((class . Item)
+ (interfaces . (semi-tie-column-interface))))))
(Rest
. (
- (cross-staff . ,ly:rest::calc-cross-staff)
- (duration-log . ,stem::calc-duration-log)
- (minimum-distance . 0.25)
- (stencil . ,ly:rest::print)
- (X-extent . ,ly:rest::width)
- (Y-extent . ,(ly:make-unpure-pure-container ly:rest::height ly:rest::pure-height))
- (Y-offset . ,(ly:make-unpure-pure-container ly:rest::y-offset-callback))
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- rest-interface
- rhythmic-grob-interface
- rhythmic-head-interface
- staff-symbol-referencer-interface))))))
+ (cross-staff . ,ly:rest::calc-cross-staff)
+ (duration-log . ,stem::calc-duration-log)
+ (minimum-distance . 0.25)
+ (stencil . ,ly:rest::print)
+ (X-extent . ,ly:rest::width)
+ (Y-extent . ,(ly:make-unpure-pure-container ly:rest::height ly:rest::pure-height))
+ (Y-offset . ,(ly:make-unpure-pure-container ly:rest::y-offset-callback))
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ rest-interface
+ rhythmic-grob-interface
+ rhythmic-head-interface
+ staff-symbol-referencer-interface))))))
(RestCollision
. (
- (minimum-distance . 0.75)
- (positioning-done . ,ly:rest-collision::calc-positioning-done)
- (meta . ((class . Item)
- (interfaces . (rest-collision-interface))))))
+ (minimum-distance . 0.75)
+ (positioning-done . ,ly:rest-collision::calc-positioning-done)
+ (meta . ((class . Item)
+ (interfaces . (rest-collision-interface))))))
(Script
. (
- (add-stem-support . #t)
- (cross-staff . ,ly:script-interface::calc-cross-staff)
- (direction . ,ly:script-interface::calc-direction)
- (font-encoding . fetaMusic)
- (positioning-done . ,ly:script-interface::calc-positioning-done)
- (side-axis . ,Y)
-
- ;; padding set in script definitions.
- (slur-padding . 0.2)
- (staff-padding . 0.25)
-
- (stencil . ,ly:script-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (X-offset . ,script-interface::calc-x-offset)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Item)
- (interfaces . (font-interface
- script-interface
- side-position-interface))))))
+ (add-stem-support . #t)
+ (cross-staff . ,ly:script-interface::calc-cross-staff)
+ (direction . ,ly:script-interface::calc-direction)
+ (font-encoding . fetaMusic)
+ (positioning-done . ,ly:script-interface::calc-positioning-done)
+ (side-axis . ,Y)
+
+ ;; padding set in script definitions.
+ (slur-padding . 0.2)
+ (staff-padding . 0.25)
+
+ (stencil . ,ly:script-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (X-offset . ,script-interface::calc-x-offset)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ script-interface
+ side-position-interface))))))
(ScriptColumn
. (
- (before-line-breaking . ,ly:script-column::before-line-breaking)
- (meta . ((class . Item)
- (interfaces . (script-column-interface))))))
+ (before-line-breaking . ,ly:script-column::before-line-breaking)
+ (meta . ((class . Item)
+ (interfaces . (script-column-interface))))))
(ScriptRow
. (
- (before-line-breaking . ,ly:script-column::row-before-line-breaking)
- (meta . ((class . Item)
- (interfaces . (script-column-interface))))))
+ (before-line-breaking . ,ly:script-column::row-before-line-breaking)
+ (meta . ((class . Item)
+ (interfaces . (script-column-interface))))))
(Slur
. (
- (avoid-slur . inside)
- (control-points . ,ly:slur::calc-control-points)
- (cross-staff . ,ly:slur::calc-cross-staff)
- (details . ,default-slur-details)
- (direction . ,ly:slur::calc-direction)
- (height-limit . 2.0)
- (line-thickness . 0.8)
- (minimum-length . 1.5)
- (ratio . 0.25)
- (spanner-id . "")
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:slur::print)
- (thickness . 1.2)
- (vertical-skylines . ,(ly:make-unpure-pure-container ly:slur::vertical-skylines ly:grob::pure-simple-vertical-skylines-from-extents))
- (Y-extent . ,slur::height)
- (meta . ((class . Spanner)
- (interfaces . (slur-interface))))))
+ (avoid-slur . inside)
+ (control-points . ,ly:slur::calc-control-points)
+ (cross-staff . ,ly:slur::calc-cross-staff)
+ (details . ,default-slur-details)
+ (direction . ,ly:slur::calc-direction)
+ (height-limit . 2.0)
+ (line-thickness . 0.8)
+ (minimum-length . 1.5)
+ (ratio . 0.25)
+ (spanner-id . "")
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:slur::print)
+ (thickness . 1.2)
+ (vertical-skylines . ,(ly:make-unpure-pure-container ly:slur::vertical-skylines ly:grob::pure-simple-vertical-skylines-from-extents))
+ (Y-extent . ,slur::height)
+ (meta . ((class . Spanner)
+ (interfaces . (slur-interface))))))
(SostenutoPedal
. (
- (direction . ,RIGHT)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (font-shape . italic)
- (padding . 0.0) ;; padding relative to SostenutoPedalLineSpanner
- (self-alignment-X . ,CENTER)
- (stencil . ,ly:text-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- piano-pedal-script-interface
- self-alignment-interface
- text-interface))))))
+ (direction . ,RIGHT)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (font-shape . italic)
+ (padding . 0.0) ;; padding relative to SostenutoPedalLineSpanner
+ (self-alignment-X . ,CENTER)
+ (stencil . ,ly:text-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ piano-pedal-script-interface
+ self-alignment-interface
+ text-interface))))))
(SostenutoPedalLineSpanner
. (
- (axes . (,Y))
- (cross-staff . ,ly:side-position-interface::calc-cross-staff)
- (direction . ,DOWN)
- (minimum-space . 1.0)
- (outside-staff-priority . 1000)
- (padding . 1.2)
- (side-axis . ,Y)
- (staff-padding . 1.0)
- (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- piano-pedal-interface
- side-position-interface))))))
+ (axes . (,Y))
+ (cross-staff . ,ly:side-position-interface::calc-cross-staff)
+ (direction . ,DOWN)
+ (minimum-space . 1.0)
+ (outside-staff-priority . 1000)
+ (padding . 1.2)
+ (side-axis . ,Y)
+ (staff-padding . 1.0)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ piano-pedal-interface
+ side-position-interface))))))
(SpacingSpanner
. (
- (average-spacing-wishes . #t)
- (base-shortest-duration . ,(ly:make-moment 3 16))
- (common-shortest-duration . ,ly:spacing-spanner::calc-common-shortest-duration)
- (shortest-duration-space . 2.0)
- (spacing-increment . 1.2)
- (springs-and-rods . ,ly:spacing-spanner::set-springs)
- (meta . ((class . Spanner)
- (interfaces . (spacing-options-interface
- spacing-spanner-interface))))))
+ (average-spacing-wishes . #t)
+ (base-shortest-duration . ,(ly:make-moment 3 16))
+ (common-shortest-duration . ,ly:spacing-spanner::calc-common-shortest-duration)
+ (shortest-duration-space . 2.0)
+ (spacing-increment . 1.2)
+ (springs-and-rods . ,ly:spacing-spanner::set-springs)
+ (meta . ((class . Spanner)
+ (interfaces . (spacing-options-interface
+ spacing-spanner-interface))))))
(SpanBar
. (
- (allow-span-bar . #t)
- (bar-extent . ,axis-group-interface::height)
- (before-line-breaking . ,ly:span-bar::before-line-breaking)
- (break-align-symbol . staff-bar)
- (cross-staff . #t)
- (glyph-name . ,ly:span-bar::calc-glyph-name)
- (layer . 0)
- (non-musical . #t)
- (stencil . ,ly:span-bar::print)
- (X-extent . ,ly:span-bar::width)
- (Y-extent . (+inf.0 . -inf.0))
- (meta . ((class . Item)
- (interfaces . (bar-line-interface
- font-interface
- span-bar-interface))))))
+ (allow-span-bar . #t)
+ (bar-extent . ,axis-group-interface::height)
+ (before-line-breaking . ,ly:span-bar::before-line-breaking)
+ (break-align-symbol . staff-bar)
+ (cross-staff . #t)
+ (glyph-name . ,ly:span-bar::calc-glyph-name)
+ (layer . 0)
+ (non-musical . #t)
+ (stencil . ,ly:span-bar::print)
+ (X-extent . ,ly:span-bar::width)
+ (Y-extent . (+inf.0 . -inf.0))
+ (meta . ((class . Item)
+ (interfaces . (bar-line-interface
+ font-interface
+ span-bar-interface))))))
(SpanBarStub
. (
(X-extent . ,(grob::inherit-parent-property
X 'X-extent))
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height)
- ; we want this to be ignored, so empty, but the extra spacing height
- ; should preserve the span bar's presence for horizontal spacing
- (Y-extent . ,pure-from-neighbor-interface::height-if-pure)
- (meta . ((class . Item)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (pure-from-neighbor-interface))))))
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height)
+ ; we want this to be ignored, so empty, but the extra spacing height
+ ; should preserve the span bar's presence for horizontal spacing
+ (Y-extent . ,pure-from-neighbor-interface::height-if-pure)
+ (meta . ((class . Item)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
+ (interfaces . (pure-from-neighbor-interface))))))
(StaffGrouper
. (
- (staff-staff-spacing . ((basic-distance . 9)
- (minimum-distance . 7)
- (padding . 1)
+ (staff-staff-spacing . ((basic-distance . 9)
+ (minimum-distance . 7)
+ (padding . 1)
(stretchability . 5)))
- (staffgroup-staff-spacing . ((basic-distance . 10.5)
- (minimum-distance . 8)
- (padding . 1)
+ (staffgroup-staff-spacing . ((basic-distance . 10.5)
+ (minimum-distance . 8)
+ (padding . 1)
(stretchability . 9)))
- (meta . ((class . Spanner)
- (interfaces . (staff-grouper-interface))))))
+ (meta . ((class . Spanner)
+ (interfaces . (staff-grouper-interface))))))
(StaffSpacing
. (
- (non-musical . #t)
- (stem-spacing-correction . 0.4)
- (meta . ((class . Item)
- (interfaces . (spacing-interface
- staff-spacing-interface))))))
+ (non-musical . #t)
+ (stem-spacing-correction . 0.4)
+ (meta . ((class . Item)
+ (interfaces . (spacing-interface
+ staff-spacing-interface))))))
(StaffSymbol
. (
- (layer . 0)
- (ledger-line-thickness . (1.0 . 0.1))
- (line-count . 5)
- (stencil . ,ly:staff-symbol::print)
- (Y-extent . ,(ly:make-unpure-pure-container ly:staff-symbol::height))
- (meta . ((class . Spanner)
- (interfaces . (staff-symbol-interface))))))
+ (layer . 0)
+ (ledger-line-thickness . (1.0 . 0.1))
+ (line-count . 5)
+ (stencil . ,ly:staff-symbol::print)
+ (Y-extent . ,(ly:make-unpure-pure-container ly:staff-symbol::height))
+ (meta . ((class . Spanner)
+ (interfaces . (staff-symbol-interface))))))
(StanzaNumber
. (
- (direction . ,LEFT)
- (font-series . bold)
- (padding . 1.0)
- (side-axis . ,X)
- (stencil . ,ly:text-interface::print)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- side-position-interface
- stanza-number-interface
- text-interface))))))
+ (direction . ,LEFT)
+ (font-series . bold)
+ (padding . 1.0)
+ (side-axis . ,X)
+ (stencil . ,ly:text-interface::print)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ side-position-interface
+ stanza-number-interface
+ text-interface))))))
(Stem
. (
- (beamlet-default-length . (1.1 . 1.1))
- (beamlet-max-length-proportion . (0.75 . 0.75))
- (cross-staff . ,ly:stem::calc-cross-staff)
- (default-direction . ,ly:stem::calc-default-direction)
- (details
- . (
- ;; 3.5 (or 3 measured from note head) is standard length
- ;; 32nd, 64th, 128th flagged stems should be longer
- (lengths . (3.5 3.5 3.5 4.25 5.0 6.0))
+ (beamlet-default-length . (1.1 . 1.1))
+ (beamlet-max-length-proportion . (0.75 . 0.75))
+ (cross-staff . ,ly:stem::calc-cross-staff)
+ (default-direction . ,ly:stem::calc-default-direction)
+ (details
+ . (
+ ;; 3.5 (or 3 measured from note head) is standard length
+ ;; 32nd, 64th, 128th flagged stems should be longer
+ (lengths . (3.5 3.5 3.5 4.25 5.0 6.0))
- ;; FIXME. 3.5 yields too long beams (according to Ross and
- ;; looking at Baerenreiter examples) for a number of common
- ;; boundary cases. Subtracting half a beam thickness fixes
- ;; this, but the bug may well be somewhere else.
+ ;; FIXME. 3.5 yields too long beams (according to Ross and
+ ;; looking at Baerenreiter examples) for a number of common
+ ;; boundary cases. Subtracting half a beam thickness fixes
+ ;; this, but the bug may well be somewhere else.
- ;; FIXME this should come from 'lengths
- (beamed-lengths . (3.26 3.5 3.6))
+ ;; FIXME this should come from 'lengths
+ (beamed-lengths . (3.26 3.5 3.6))
- ;; The 'normal' minima
- (beamed-minimum-free-lengths . (1.83 1.5 1.25))
- ;(beamed-minimum-free-lengths . (2.0 1.83 1.25))
+ ;; The 'normal' minima
+ (beamed-minimum-free-lengths . (1.83 1.5 1.25))
+ ;(beamed-minimum-free-lengths . (2.0 1.83 1.25))
- ;; The 'extreme case' minima
- (beamed-extreme-minimum-free-lengths . (2.0 1.25))
+ ;; The 'extreme case' minima
+ (beamed-extreme-minimum-free-lengths . (2.0 1.25))
- ;; Stems in unnatural (forced) direction should be shortened by
- ;; one staff space, according to [Roush & Gourlay].
- ;; Flagged stems we shorten only half a staff space.
- (stem-shorten . (1.0 0.5))
+ ;; Stems in unnatural (forced) direction should be shortened by
+ ;; one staff space, according to [Roush & Gourlay].
+ ;; Flagged stems we shorten only half a staff space.
+ (stem-shorten . (1.0 0.5))
- ))
+ ))
- ;; We use the normal minima as minimum for the ideal lengths,
- ;; and the extreme minima as abolute minimum length.
+ ;; We use the normal minima as minimum for the ideal lengths,
+ ;; and the extreme minima as abolute minimum length.
- (direction . ,ly:stem::calc-direction)
- (duration-log . ,stem::calc-duration-log)
+ (direction . ,ly:stem::calc-direction)
+ (duration-log . ,stem::calc-duration-log)
(length . ,(ly:make-unpure-pure-container ly:stem::calc-length ly:stem::pure-calc-length))
- (neutral-direction . ,DOWN)
- (positioning-done . ,ly:stem::calc-positioning-done)
- (stem-info . ,ly:stem::calc-stem-info)
- (stem-begin-position . ,(ly:make-unpure-pure-container ly:stem::calc-stem-begin-position ly:stem::pure-calc-stem-begin-position))
- (stencil . ,ly:stem::print)
- (thickness . 1.3)
- (X-extent . ,ly:stem::width)
- (X-offset . ,ly:stem::offset-callback)
- (Y-extent . ,(ly:make-unpure-pure-container ly:stem::height ly:stem::pure-height))
- (Y-offset . ,staff-symbol-referencer::callback)
- (meta . ((class . Item)
- (interfaces . (stem-interface))))))
+ (neutral-direction . ,DOWN)
+ (positioning-done . ,ly:stem::calc-positioning-done)
+ (stem-info . ,ly:stem::calc-stem-info)
+ (stem-begin-position . ,(ly:make-unpure-pure-container ly:stem::calc-stem-begin-position ly:stem::pure-calc-stem-begin-position))
+ (stencil . ,ly:stem::print)
+ (thickness . 1.3)
+ (X-extent . ,ly:stem::width)
+ (X-offset . ,ly:stem::offset-callback)
+ (Y-extent . ,(ly:make-unpure-pure-container ly:stem::height ly:stem::pure-height))
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (meta . ((class . Item)
+ (interfaces . (stem-interface))))))
(StemStub
. (
(X-extent . ,stem-stub::width)
- (extra-spacing-height . ,stem-stub::extra-spacing-height)
- (Y-extent . ,(ly:make-unpure-pure-container #f stem-stub::pure-height))
- (meta . ((class . Item)
- (interfaces . ())))))
+ (extra-spacing-height . ,stem-stub::extra-spacing-height)
+ (Y-extent . ,(ly:make-unpure-pure-container #f stem-stub::pure-height))
+ (meta . ((class . Item)
+ (interfaces . ())))))
(StemTremolo
. (
- (beam-thickness . 0.48) ; staff-space
- (beam-width . ,ly:stem-tremolo::calc-width) ; staff-space
- (direction . ,ly:stem-tremolo::calc-direction)
- (slope . ,ly:stem-tremolo::calc-slope)
- (stencil . ,ly:stem-tremolo::print)
- (style . ,ly:stem-tremolo::calc-style)
- (X-extent . ,ly:stem-tremolo::width)
- (Y-extent . ,(grob::unpure-Y-extent-from-stencil ly:stem-tremolo::pure-height))
- (X-offset . ,(ly:make-simple-closure
- `(,+
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::centered-on-x-parent))
- ,(ly:make-simple-closure
- (list ly:self-alignment-interface::x-aligned-on-self)))))
+ (beam-thickness . 0.48) ; staff-space
+ (beam-width . ,ly:stem-tremolo::calc-width) ; staff-space
+ (direction . ,ly:stem-tremolo::calc-direction)
+ (slope . ,ly:stem-tremolo::calc-slope)
+ (stencil . ,ly:stem-tremolo::print)
+ (style . ,ly:stem-tremolo::calc-style)
+ (X-extent . ,ly:stem-tremolo::width)
+ (Y-extent . ,(grob::unpure-Y-extent-from-stencil ly:stem-tremolo::pure-height))
+ (X-offset . ,(ly:make-simple-closure
+ `(,+
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::centered-on-x-parent))
+ ,(ly:make-simple-closure
+ (list ly:self-alignment-interface::x-aligned-on-self)))))
(Y-offset . ,(ly:make-unpure-pure-container ly:stem-tremolo::calc-y-offset ly:stem-tremolo::pure-calc-y-offset))
- (meta . ((class . Item)
- (interfaces . (self-alignment-interface
+ (meta . ((class . Item)
+ (interfaces . (self-alignment-interface
stem-tremolo-interface))))))
(StringNumber
. (
- (avoid-slur . around)
- (cross-staff . ,script-or-side-position-cross-staff)
- (font-encoding . fetaText)
- (font-size . -5) ; don't overlap when next to heads.
- (padding . 0.5)
- (script-priority . 100)
- (self-alignment-X . ,CENTER)
- (self-alignment-Y . ,CENTER)
- (staff-padding . 0.5)
- (stencil . ,print-circled-text-callback)
- (text . ,string-number::calc-text)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- self-alignment-interface
- side-position-interface
- string-number-interface
- text-interface
- text-script-interface))))))
+ (avoid-slur . around)
+ (cross-staff . ,script-or-side-position-cross-staff)
+ (font-encoding . fetaText)
+ (font-size . -5) ; don't overlap when next to heads.
+ (padding . 0.5)
+ (script-priority . 100)
+ (self-alignment-X . ,CENTER)
+ (self-alignment-Y . ,CENTER)
+ (staff-padding . 0.5)
+ (stencil . ,print-circled-text-callback)
+ (text . ,string-number::calc-text)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ self-alignment-interface
+ side-position-interface
+ string-number-interface
+ text-interface
+ text-script-interface))))))
(StrokeFinger
. (
- (digit-names . #("p" "i" "m" "a" "x"))
- (font-shape . italic)
- (font-size . -4) ; don't overlap when next to heads.
- (padding . 0.5)
- (script-priority . 100)
- (self-alignment-X . ,CENTER)
- (self-alignment-Y . ,CENTER)
- (staff-padding . 0.5)
- (stencil . ,ly:text-interface::print)
- (text . ,stroke-finger::calc-text)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- self-alignment-interface
- side-position-interface
- stroke-finger-interface
- text-interface
- text-script-interface))))))
+ (digit-names . #("p" "i" "m" "a" "x"))
+ (font-shape . italic)
+ (font-size . -4) ; don't overlap when next to heads.
+ (padding . 0.5)
+ (script-priority . 100)
+ (self-alignment-X . ,CENTER)
+ (self-alignment-Y . ,CENTER)
+ (staff-padding . 0.5)
+ (stencil . ,ly:text-interface::print)
+ (text . ,stroke-finger::calc-text)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ self-alignment-interface
+ side-position-interface
+ stroke-finger-interface
+ text-interface
+ text-script-interface))))))
(SustainPedal
. (
- (direction . ,RIGHT)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (padding . 0.0) ;; padding relative to SustainPedalLineSpanner
- (self-alignment-X . ,CENTER)
- (stencil . ,ly:sustain-pedal::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- piano-pedal-interface
- piano-pedal-script-interface
- self-alignment-interface
- text-interface))))))
+ (direction . ,RIGHT)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (padding . 0.0) ;; padding relative to SustainPedalLineSpanner
+ (self-alignment-X . ,CENTER)
+ (stencil . ,ly:sustain-pedal::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ piano-pedal-interface
+ piano-pedal-script-interface
+ self-alignment-interface
+ text-interface))))))
(SustainPedalLineSpanner
. (
- (axes . (,Y))
- (cross-staff . ,ly:side-position-interface::calc-cross-staff)
- (direction . ,DOWN)
- (minimum-space . 1.0)
- (outside-staff-priority . 1000)
- (padding . 1.2)
- (side-axis . ,Y)
- (staff-padding . 1.2)
- (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- piano-pedal-interface
- side-position-interface))))))
+ (axes . (,Y))
+ (cross-staff . ,ly:side-position-interface::calc-cross-staff)
+ (direction . ,DOWN)
+ (minimum-space . 1.0)
+ (outside-staff-priority . 1000)
+ (padding . 1.2)
+ (side-axis . ,Y)
+ (staff-padding . 1.2)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ piano-pedal-interface
+ side-position-interface))))))
(System
. (
- (adjacent-pure-heights . ,ly:axis-group-interface::adjacent-pure-heights)
- (axes . (,X ,Y))
- (outside-staff-placement-directive . left-to-right-polite)
- (skyline-horizontal-padding . 1.0)
- (vertical-skylines . ,ly:axis-group-interface::calc-skylines)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,(ly:make-unpure-pure-container ly:system::height ly:system::calc-pure-height))
- (meta . ((class . System)
- (object-callbacks . ((footnotes-before-line-breaking . ,ly:system::footnotes-before-line-breaking)
- (footnotes-after-line-breaking . ,ly:system::footnotes-after-line-breaking)
- (pure-relevant-grobs . ,ly:system::calc-pure-relevant-grobs)
- (pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (vertical-skyline-elements . ,ly:system::vertical-skyline-elements)
+ (adjacent-pure-heights . ,ly:axis-group-interface::adjacent-pure-heights)
+ (axes . (,X ,Y))
+ (outside-staff-placement-directive . left-to-right-polite)
+ (skyline-horizontal-padding . 1.0)
+ (vertical-skylines . ,ly:axis-group-interface::calc-skylines)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,(ly:make-unpure-pure-container ly:system::height ly:system::calc-pure-height))
+ (meta . ((class . System)
+ (object-callbacks . ((footnotes-before-line-breaking . ,ly:system::footnotes-before-line-breaking)
+ (footnotes-after-line-breaking . ,ly:system::footnotes-after-line-breaking)
+ (pure-relevant-grobs . ,ly:system::calc-pure-relevant-grobs)
+ (pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (vertical-skyline-elements . ,ly:system::vertical-skyline-elements)
(vertical-alignment . ,ly:system::get-vertical-alignment)))
- (interfaces . (axis-group-interface
- system-interface))))))
+ (interfaces . (axis-group-interface
+ system-interface))))))
(SystemStartBar
. (
- (collapse-height . 5.0)
- (direction . ,LEFT)
-
- (cross-staff . #t)
- ;; ugh--hardcoded.
- (padding . -0.1) ;; bar must cover rounded ending of staff line.
- (stencil . ,ly:system-start-delimiter::print)
- (style . bar-line)
- (thickness . 1.6)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (side-position-interface
- system-start-delimiter-interface))))))
+ (collapse-height . 5.0)
+ (direction . ,LEFT)
+
+ (cross-staff . #t)
+ ;; ugh--hardcoded.
+ (padding . -0.1) ;; bar must cover rounded ending of staff line.
+ (stencil . ,ly:system-start-delimiter::print)
+ (style . bar-line)
+ (thickness . 1.6)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (side-position-interface
+ system-start-delimiter-interface))))))
(SystemStartBrace
. (
- (collapse-height . 5.0)
- (direction . ,LEFT)
- (font-encoding . fetaBraces)
- (cross-staff . #t)
- (padding . 0.3)
- (stencil . ,ly:system-start-delimiter::print)
- (style . brace)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- side-position-interface
- system-start-delimiter-interface))))))
+ (collapse-height . 5.0)
+ (direction . ,LEFT)
+ (font-encoding . fetaBraces)
+ (cross-staff . #t)
+ (padding . 0.3)
+ (stencil . ,ly:system-start-delimiter::print)
+ (style . brace)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ side-position-interface
+ system-start-delimiter-interface))))))
(SystemStartBracket
. (
- (collapse-height . 5.0)
- (direction . ,LEFT)
- (cross-staff . #t)
- (padding . 0.8)
- (stencil . ,ly:system-start-delimiter::print)
- (style . bracket)
- (thickness . 0.45)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- side-position-interface
- system-start-delimiter-interface))))))
+ (collapse-height . 5.0)
+ (direction . ,LEFT)
+ (cross-staff . #t)
+ (padding . 0.8)
+ (stencil . ,ly:system-start-delimiter::print)
+ (style . bracket)
+ (thickness . 0.45)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ side-position-interface
+ system-start-delimiter-interface))))))
(SystemStartSquare
. (
- (direction . ,LEFT)
- (cross-staff . #t)
- (stencil . ,ly:system-start-delimiter::print)
- (style . line-bracket)
- (thickness . 1.0)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- side-position-interface
- system-start-delimiter-interface))))))
+ (direction . ,LEFT)
+ (cross-staff . #t)
+ (stencil . ,ly:system-start-delimiter::print)
+ (style . line-bracket)
+ (thickness . 1.0)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ side-position-interface
+ system-start-delimiter-interface))))))
(TabNoteHead
. (
- (details . ((cautionary-properties . ((angularity . 0.4)
- (half-thickness . 0.075)
- (padding . 0)
- (procedure . ,parenthesize-stencil)
- (width . 0.25)))
- (head-offset . 3/5)
- (harmonic-properties . ((angularity . 2)
- (half-thickness . 0.075)
- (padding . 0)
- (procedure . ,parenthesize-stencil)
- (width . 0.25)))
- (repeat-tied-properties . ((note-head-visible . #t)
- (parenthesize . #t)))
- (tied-properties . ((break-visibility . ,begin-of-line-visible)
- (parenthesize . #t)))))
-
- (direction . ,CENTER)
- (duration-log . ,note-head::calc-duration-log)
- (font-series . bold)
- (font-size . -2)
- (stem-attachment . (0.0 . 1.35))
- (stencil . ,tab-note-head::print)
- (whiteout . #t)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- note-head-interface
- rhythmic-grob-interface
- rhythmic-head-interface
- staff-symbol-referencer-interface
- tab-note-head-interface
- text-interface))))))
+ (details . ((cautionary-properties . ((angularity . 0.4)
+ (half-thickness . 0.075)
+ (padding . 0)
+ (procedure . ,parenthesize-stencil)
+ (width . 0.25)))
+ (head-offset . 3/5)
+ (harmonic-properties . ((angularity . 2)
+ (half-thickness . 0.075)
+ (padding . 0)
+ (procedure . ,parenthesize-stencil)
+ (width . 0.25)))
+ (repeat-tied-properties . ((note-head-visible . #t)
+ (parenthesize . #t)))
+ (tied-properties . ((break-visibility . ,begin-of-line-visible)
+ (parenthesize . #t)))))
+
+ (direction . ,CENTER)
+ (duration-log . ,note-head::calc-duration-log)
+ (font-series . bold)
+ (font-size . -2)
+ (stem-attachment . (0.0 . 1.35))
+ (stencil . ,tab-note-head::print)
+ (whiteout . #t)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ note-head-interface
+ rhythmic-grob-interface
+ rhythmic-head-interface
+ staff-symbol-referencer-interface
+ tab-note-head-interface
+ text-interface))))))
(TextScript
. (
- (avoid-slur . around)
- (cross-staff . ,script-or-side-position-cross-staff)
- (direction . ,DOWN)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (outside-staff-horizontal-padding . 0.12)
- (outside-staff-priority . 450)
-
- ;; sync with Fingering ?
- (padding . 0.3)
-
- (script-priority . 200)
- (side-axis . ,Y)
- (slur-padding . 0.5)
- (staff-padding . 0.5)
- (stencil . ,ly:text-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- ;; todo: add X self alignment?
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Item)
- (interfaces . (font-interface
- instrument-specific-markup-interface
- self-alignment-interface
- side-position-interface
- text-interface
- text-script-interface))))))
+ (avoid-slur . around)
+ (cross-staff . ,script-or-side-position-cross-staff)
+ (direction . ,DOWN)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (outside-staff-horizontal-padding . 0.12)
+ (outside-staff-priority . 450)
+
+ ;; sync with Fingering ?
+ (padding . 0.3)
+
+ (script-priority . 200)
+ (side-axis . ,Y)
+ (slur-padding . 0.5)
+ (staff-padding . 0.5)
+ (stencil . ,ly:text-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ ;; todo: add X self alignment?
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ instrument-specific-markup-interface
+ self-alignment-interface
+ side-position-interface
+ text-interface
+ text-script-interface))))))
(TextSpanner
. (
- (bound-details . ((left . ((Y . 0)
- (padding . 0.25)
- (attach-dir . ,LEFT)
- ))
- (left-broken . ((attach-dir . ,RIGHT)))
- (right . ((Y . 0)
- (padding . 0.25)
- ))
- ))
- (dash-fraction . 0.2)
- (dash-period . 3.0)
- (direction . ,UP)
- (font-shape . italic)
- (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
- (outside-staff-priority . 350)
- (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
- (side-axis . ,Y)
- (staff-padding . 0.8)
- (stencil . ,ly:line-spanner::print)
- (style . dashed-line)
- (Y-offset . ,side-position-interface::y-aligned-side)
-
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- line-interface
- line-spanner-interface
- side-position-interface))))))
+ (bound-details . ((left . ((Y . 0)
+ (padding . 0.25)
+ (attach-dir . ,LEFT)
+ ))
+ (left-broken . ((attach-dir . ,RIGHT)))
+ (right . ((Y . 0)
+ (padding . 0.25)
+ ))
+ ))
+ (dash-fraction . 0.2)
+ (dash-period . 3.0)
+ (direction . ,UP)
+ (font-shape . italic)
+ (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
+ (outside-staff-priority . 350)
+ (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
+ (side-axis . ,Y)
+ (staff-padding . 0.8)
+ (stencil . ,ly:line-spanner::print)
+ (style . dashed-line)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ line-interface
+ line-spanner-interface
+ side-position-interface))))))
(Tie
. (
- (avoid-slur . inside)
- (control-points . ,ly:tie::calc-control-points)
- (details . (
- ;; for a full list, see tie-details.cc
- (ratio . 0.333)
- (center-staff-line-clearance . 0.6)
- (tip-staff-line-clearance . 0.45)
- (note-head-gap . 0.2)
- (stem-gap . 0.35)
- (height-limit . 1.0)
- (horizontal-distance-penalty-factor . 10)
- (same-dir-as-stem-penalty . 8)
- (min-length-penalty-factor . 26)
- (tie-tie-collision-distance . 0.45)
- (tie-tie-collision-penalty . 25.0)
- (intra-space-threshold . 1.25)
- (outer-tie-vertical-distance-symmetry-penalty-factor . 10)
- (outer-tie-length-symmetry-penalty-factor . 10)
- (vertical-distance-penalty-factor . 7)
- (outer-tie-vertical-gap . 0.25)
- (multi-tie-region-size . 3)
- (single-tie-region-size . 4)
- (between-length-limit . 1.0)))
-
- (direction . ,ly:tie::calc-direction)
- (font-size . -6)
- (line-thickness . 0.8)
- (neutral-direction . ,UP)
- (springs-and-rods . ,ly:spanner::set-spacing-rods)
- (stencil . ,ly:tie::print)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (thickness . 1.2)
- (meta . ((class . Spanner)
- (interfaces . (tie-interface))))))
+ (avoid-slur . inside)
+ (control-points . ,ly:tie::calc-control-points)
+ (details . (
+ ;; for a full list, see tie-details.cc
+ (ratio . 0.333)
+ (center-staff-line-clearance . 0.6)
+ (tip-staff-line-clearance . 0.45)
+ (note-head-gap . 0.2)
+ (stem-gap . 0.35)
+ (height-limit . 1.0)
+ (horizontal-distance-penalty-factor . 10)
+ (same-dir-as-stem-penalty . 8)
+ (min-length-penalty-factor . 26)
+ (tie-tie-collision-distance . 0.45)
+ (tie-tie-collision-penalty . 25.0)
+ (intra-space-threshold . 1.25)
+ (outer-tie-vertical-distance-symmetry-penalty-factor . 10)
+ (outer-tie-length-symmetry-penalty-factor . 10)
+ (vertical-distance-penalty-factor . 7)
+ (outer-tie-vertical-gap . 0.25)
+ (multi-tie-region-size . 3)
+ (single-tie-region-size . 4)
+ (between-length-limit . 1.0)))
+
+ (direction . ,ly:tie::calc-direction)
+ (font-size . -6)
+ (line-thickness . 0.8)
+ (neutral-direction . ,UP)
+ (springs-and-rods . ,ly:spanner::set-spacing-rods)
+ (stencil . ,ly:tie::print)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (thickness . 1.2)
+ (meta . ((class . Spanner)
+ (interfaces . (tie-interface))))))
(TieColumn
. (
- (before-line-breaking . ,ly:tie-column::before-line-breaking)
- (positioning-done . ,ly:tie-column::calc-positioning-done)
- (X-extent . #f)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (tie-column-interface))))))
+ (before-line-breaking . ,ly:tie-column::before-line-breaking)
+ (positioning-done . ,ly:tie-column::calc-positioning-done)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (tie-column-interface))))))
(TimeSignature
. (
- (avoid-slur . inside)
- (break-align-anchor
- . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
- (break-align-symbol . time-signature)
- (break-align-anchor-alignment . ,LEFT)
- (break-visibility . ,all-visible)
- (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-including-staff)
- (extra-spacing-width . (0.0 . 0.8))
- (non-musical . #t)
- (space-alist . (
- (cue-clef . (extra-space . 1.5))
- (first-note . (fixed-space . 2.0))
- (right-edge . (extra-space . 0.5))
- (staff-bar . (extra-space . 1.0))))
- (stencil . ,ly:time-signature::print)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (style . C)
- (meta . ((class . Item)
+ (avoid-slur . inside)
+ (break-align-anchor
+ . ,ly:break-aligned-interface::calc-extent-aligned-anchor)
+ (break-align-symbol . time-signature)
+ (break-align-anchor-alignment . ,LEFT)
+ (break-visibility . ,all-visible)
+ (extra-spacing-height . ,pure-from-neighbor-interface::extra-spacing-height-including-staff)
+ (extra-spacing-width . (0.0 . 0.8))
+ (non-musical . #t)
+ (space-alist . (
+ (cue-clef . (extra-space . 1.5))
+ (first-note . (fixed-space . 2.0))
+ (right-edge . (extra-space . 0.5))
+ (staff-bar . (extra-space . 1.0))))
+ (stencil . ,ly:time-signature::print)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (style . C)
+ (meta . ((class . Item)
(object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
(pure-relevant-grobs . ,ly:pure-from-neighbor-interface::calc-pure-relevant-grobs)))
- (interfaces . (break-aligned-interface
- font-interface
- pure-from-neighbor-interface
- time-signature-interface))))))
+ (interfaces . (break-aligned-interface
+ font-interface
+ pure-from-neighbor-interface
+ time-signature-interface))))))
(TrillPitchAccidental
. (
- (direction . ,LEFT)
- (font-size . -4)
- (glyph-name-alist . ,standard-alteration-glyph-name-alist)
- (padding . 0.2)
- (side-axis . ,X)
- (stencil . ,ly:accidental-interface::print)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . ,accidental-interface::height)
- (meta . ((class . Item)
- (interfaces . (accidental-interface
- font-interface
- inline-accidental-interface
- side-position-interface
- trill-pitch-accidental-interface))))))
+ (direction . ,LEFT)
+ (font-size . -4)
+ (glyph-name-alist . ,standard-alteration-glyph-name-alist)
+ (padding . 0.2)
+ (side-axis . ,X)
+ (stencil . ,ly:accidental-interface::print)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . ,accidental-interface::height)
+ (meta . ((class . Item)
+ (interfaces . (accidental-interface
+ font-interface
+ inline-accidental-interface
+ side-position-interface
+ trill-pitch-accidental-interface))))))
(TrillPitchGroup
. (
- (axes . (,X))
- (direction . ,RIGHT)
- (font-size . -4)
- (padding . 0.3)
- (side-axis . ,X)
- (stencil . ,parenthesize-elements)
- (stencils . ,parentheses-item::calc-parenthesis-stencils)
- (X-offset . ,ly:side-position-interface::x-aligned-side)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (axis-group-interface
- font-interface
- note-head-interface
- parentheses-interface
- side-position-interface))))))
+ (axes . (,X))
+ (direction . ,RIGHT)
+ (font-size . -4)
+ (padding . 0.3)
+ (side-axis . ,X)
+ (stencil . ,parenthesize-elements)
+ (stencils . ,parentheses-item::calc-parenthesis-stencils)
+ (X-offset . ,ly:side-position-interface::x-aligned-side)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (axis-group-interface
+ font-interface
+ note-head-interface
+ parentheses-interface
+ side-position-interface))))))
(TrillPitchHead
. (
- (duration-log . 2)
- (font-size . -4)
- (stencil . ,ly:note-head::print)
- (Y-offset . ,staff-symbol-referencer::callback)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (meta . ((class . Item)
- (interfaces . (font-interface
- ledgered-interface
- pitched-trill-interface
- rhythmic-head-interface
- staff-symbol-referencer-interface))))))
+ (duration-log . 2)
+ (font-size . -4)
+ (stencil . ,ly:note-head::print)
+ (Y-offset . ,staff-symbol-referencer::callback)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ ledgered-interface
+ pitched-trill-interface
+ rhythmic-head-interface
+ staff-symbol-referencer-interface))))))
(TrillSpanner
. (
- (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
- (bound-details . ((left . ((text . ,(make-musicglyph-markup "scripts.trill"))
- (Y . 0)
- (stencil-offset . (-0.5 . -1))
- (padding . 0.5)
- (attach-dir . ,CENTER)
- ))
- (left-broken . ((end-on-note . #t)))
- (right . ((Y . 0)))
- ))
- (direction . ,UP)
- (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
- (outside-staff-priority . 50)
- (padding . 0.5)
- (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
- (side-axis . ,Y)
- (staff-padding . 1.0)
- (stencil . ,ly:line-spanner::print)
- (style . trill)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- line-interface
- line-spanner-interface
- side-position-interface
- trill-spanner-interface))))))
+ (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
+ (bound-details . ((left . ((text . ,(make-musicglyph-markup "scripts.trill"))
+ (Y . 0)
+ (stencil-offset . (-0.5 . -1))
+ (padding . 0.5)
+ (attach-dir . ,CENTER)
+ ))
+ (left-broken . ((end-on-note . #t)))
+ (right . ((Y . 0)))
+ ))
+ (direction . ,UP)
+ (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
+ (outside-staff-priority . 50)
+ (padding . 0.5)
+ (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
+ (side-axis . ,Y)
+ (staff-padding . 1.0)
+ (stencil . ,ly:line-spanner::print)
+ (style . trill)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ line-interface
+ line-spanner-interface
+ side-position-interface
+ trill-spanner-interface))))))
(TupletBracket
. (
- (avoid-scripts . #t)
- (connect-to-neighbor . ,ly:tuplet-bracket::calc-connect-to-neighbors)
- (cross-staff . ,ly:tuplet-bracket::calc-cross-staff)
- (direction . ,ly:tuplet-bracket::calc-direction)
- (edge-height . (0.7 . 0.7))
- (full-length-to-extent . #t)
- (padding . 1.1)
- (positions . ,ly:tuplet-bracket::calc-positions)
- (shorten-pair . (-0.2 . -0.2))
- (staff-padding . 0.25)
- (stencil . ,ly:tuplet-bracket::print)
- (thickness . 1.6)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (X-positions . ,ly:tuplet-bracket::calc-x-positions)
-
- (meta . ((class . Spanner)
- (interfaces . (line-interface
- tuplet-bracket-interface))))))
+ (avoid-scripts . #t)
+ (connect-to-neighbor . ,ly:tuplet-bracket::calc-connect-to-neighbors)
+ (cross-staff . ,ly:tuplet-bracket::calc-cross-staff)
+ (direction . ,ly:tuplet-bracket::calc-direction)
+ (edge-height . (0.7 . 0.7))
+ (full-length-to-extent . #t)
+ (padding . 1.1)
+ (positions . ,ly:tuplet-bracket::calc-positions)
+ (shorten-pair . (-0.2 . -0.2))
+ (staff-padding . 0.25)
+ (stencil . ,ly:tuplet-bracket::print)
+ (thickness . 1.6)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (X-positions . ,ly:tuplet-bracket::calc-x-positions)
+
+ (meta . ((class . Spanner)
+ (interfaces . (line-interface
+ tuplet-bracket-interface))))))
(TupletNumber
. (
- (avoid-slur . inside)
- (cross-staff . ,ly:tuplet-number::calc-cross-staff)
- (direction . ,tuplet-number::calc-direction)
- (font-shape . italic)
- (font-size . -2)
- (stencil . ,ly:tuplet-number::print)
- (text . ,tuplet-number::calc-denominator-text)
- (X-offset . ,ly:tuplet-number::calc-x-offset)
- (Y-offset . ,ly:tuplet-number::calc-y-offset)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- text-interface
- tuplet-number-interface))))))
+ (avoid-slur . inside)
+ (cross-staff . ,ly:tuplet-number::calc-cross-staff)
+ (direction . ,tuplet-number::calc-direction)
+ (font-shape . italic)
+ (font-size . -2)
+ (stencil . ,ly:tuplet-number::print)
+ (text . ,tuplet-number::calc-denominator-text)
+ (X-offset . ,ly:tuplet-number::calc-x-offset)
+ (Y-offset . ,ly:tuplet-number::calc-y-offset)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ text-interface
+ tuplet-number-interface))))))
(UnaCordaPedal
. (
- (direction . ,RIGHT)
- (extra-spacing-width . (+inf.0 . -inf.0))
- (font-shape . italic)
- (padding . 0.0) ;; padding relative to UnaCordaPedalLineSpanner
- (self-alignment-X . ,CENTER)
- (stencil . ,ly:text-interface::print)
- (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
- (Y-extent . ,grob::always-Y-extent-from-stencil)
- (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
- (meta . ((class . Item)
- (interfaces . (font-interface
- piano-pedal-script-interface
- self-alignment-interface
- text-interface))))))
+ (direction . ,RIGHT)
+ (extra-spacing-width . (+inf.0 . -inf.0))
+ (font-shape . italic)
+ (padding . 0.0) ;; padding relative to UnaCordaPedalLineSpanner
+ (self-alignment-X . ,CENTER)
+ (stencil . ,ly:text-interface::print)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-stencil)
+ (Y-extent . ,grob::always-Y-extent-from-stencil)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (meta . ((class . Item)
+ (interfaces . (font-interface
+ piano-pedal-script-interface
+ self-alignment-interface
+ text-interface))))))
(UnaCordaPedalLineSpanner
. (
- (axes . (,Y))
- (cross-staff . ,ly:side-position-interface::calc-cross-staff)
- (direction . ,DOWN)
- (minimum-space . 1.0)
- (outside-staff-priority . 1000)
- (padding . 1.2)
- (side-axis . ,Y)
- (staff-padding . 1.2)
- (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- piano-pedal-interface
- side-position-interface))))))
+ (axes . (,Y))
+ (cross-staff . ,ly:side-position-interface::calc-cross-staff)
+ (direction . ,DOWN)
+ (minimum-space . 1.0)
+ (outside-staff-priority . 1000)
+ (padding . 1.2)
+ (side-axis . ,Y)
+ (staff-padding . 1.2)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (Y-offset . ,side-position-interface::y-aligned-side)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ piano-pedal-interface
+ side-position-interface))))))
(VaticanaLigature
. (
- (flexa-width . 2.0)
- (stencil . ,ly:vaticana-ligature::print)
- (thickness . 0.6)
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- vaticana-ligature-interface))))))
+ (flexa-width . 2.0)
+ (stencil . ,ly:vaticana-ligature::print)
+ (thickness . 0.6)
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ vaticana-ligature-interface))))))
(VerticalAlignment
. (
- (axes . (,Y))
- (positioning-done . ,ly:align-interface::align-to-ideal-distances)
- (stacking-dir . -1)
- (vertical-skylines . ,ly:axis-group-interface::combine-skylines)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
- (meta . ((class . Spanner)
- (object-callbacks . ((Y-common . ,ly:axis-group-interface::calc-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)
- (pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)))
- (interfaces . (align-interface
- axis-group-interface))))))
+ (axes . (,Y))
+ (positioning-done . ,ly:align-interface::align-to-ideal-distances)
+ (stacking-dir . -1)
+ (vertical-skylines . ,ly:axis-group-interface::combine-skylines)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
+ (meta . ((class . Spanner)
+ (object-callbacks . ((Y-common . ,ly:axis-group-interface::calc-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)
+ (pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)))
+ (interfaces . (align-interface
+ axis-group-interface))))))
(VerticalAxisGroup
. (
- (adjacent-pure-heights . ,ly:axis-group-interface::adjacent-pure-heights)
- (axes . (,Y))
- (default-staff-staff-spacing . ((basic-distance . 9)
- (minimum-distance . 8)
- (padding . 1)))
- (nonstaff-unrelatedstaff-spacing . ((padding . 0.5)))
- (outside-staff-placement-directive . left-to-right-polite)
- (staff-staff-spacing . ,(ly:make-unpure-pure-container ly:axis-group-interface::calc-staff-staff-spacing ly:axis-group-interface::calc-pure-staff-staff-spacing))
- (stencil . ,ly:axis-group-interface::print)
- (skyline-horizontal-padding . 0.1)
- (vertical-skylines . ,ly:hara-kiri-group-spanner::calc-skylines)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,(ly:make-unpure-pure-container ly:hara-kiri-group-spanner::y-extent ly:hara-kiri-group-spanner::pure-height))
- (Y-offset . ,ly:hara-kiri-group-spanner::force-hara-kiri-callback)
- (meta . ((class . Spanner)
- (object-callbacks . (
- (X-common . ,ly:axis-group-interface::calc-x-common)
- (pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
-
- (interfaces . (axis-group-interface
- hara-kiri-group-spanner-interface))))))
+ (adjacent-pure-heights . ,ly:axis-group-interface::adjacent-pure-heights)
+ (axes . (,Y))
+ (default-staff-staff-spacing . ((basic-distance . 9)
+ (minimum-distance . 8)
+ (padding . 1)))
+ (nonstaff-unrelatedstaff-spacing . ((padding . 0.5)))
+ (outside-staff-placement-directive . left-to-right-polite)
+ (staff-staff-spacing . ,(ly:make-unpure-pure-container ly:axis-group-interface::calc-staff-staff-spacing ly:axis-group-interface::calc-pure-staff-staff-spacing))
+ (stencil . ,ly:axis-group-interface::print)
+ (skyline-horizontal-padding . 0.1)
+ (vertical-skylines . ,ly:hara-kiri-group-spanner::calc-skylines)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,(ly:make-unpure-pure-container ly:hara-kiri-group-spanner::y-extent ly:hara-kiri-group-spanner::pure-height))
+ (Y-offset . ,ly:hara-kiri-group-spanner::force-hara-kiri-callback)
+ (meta . ((class . Spanner)
+ (object-callbacks . (
+ (X-common . ,ly:axis-group-interface::calc-x-common)
+ (pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+
+ (interfaces . (axis-group-interface
+ hara-kiri-group-spanner-interface))))))
(VoiceFollower
. (
- (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
- (bound-details . ((right . ((attach-dir . ,CENTER)
- (padding . 1.5)
- ))
- (left . ((attach-dir . ,CENTER)
- (padding . 1.5)
- ))
- ))
- (cross-staff . #t)
- (gap . 0.5)
- (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
- (non-musical . #t)
- (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
- (stencil . ,ly:line-spanner::print)
- (style . line)
- (X-extent . #f)
- (Y-extent . #f)
- (meta . ((class . Spanner)
- (interfaces . (line-interface
- line-spanner-interface))))))
+ (after-line-breaking . ,ly:spanner::kill-zero-spanned-time)
+ (bound-details . ((right . ((attach-dir . ,CENTER)
+ (padding . 1.5)
+ ))
+ (left . ((attach-dir . ,CENTER)
+ (padding . 1.5)
+ ))
+ ))
+ (cross-staff . #t)
+ (gap . 0.5)
+ (left-bound-info . ,ly:line-spanner::calc-left-bound-info)
+ (non-musical . #t)
+ (right-bound-info . ,ly:line-spanner::calc-right-bound-info)
+ (stencil . ,ly:line-spanner::print)
+ (style . line)
+ (X-extent . #f)
+ (Y-extent . #f)
+ (meta . ((class . Spanner)
+ (interfaces . (line-interface
+ line-spanner-interface))))))
(VoltaBracket
. (
- (direction . ,UP)
- (edge-height . (2.0 . 2.0)) ;; staff-space;
- (font-encoding . fetaText)
- (font-size . -4)
- (shorten-pair . ,ly:volta-bracket::calc-shorten-pair)
- (stencil . ,ly:volta-bracket-interface::print)
- (thickness . 1.6) ;; line-thickness
- (word-space . 0.6)
- (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
- (Y-extent . ,(grob::unpure-Y-extent-from-stencil volta-bracket-interface::pure-height))
- (meta . ((class . Spanner)
- (interfaces . (font-interface
- horizontal-bracket-interface
- line-interface
- side-position-interface
- text-interface
- volta-bracket-interface
- volta-interface))))))
+ (direction . ,UP)
+ (edge-height . (2.0 . 2.0)) ;; staff-space;
+ (font-encoding . fetaText)
+ (font-size . -4)
+ (shorten-pair . ,ly:volta-bracket::calc-shorten-pair)
+ (stencil . ,ly:volta-bracket-interface::print)
+ (thickness . 1.6) ;; line-thickness
+ (word-space . 0.6)
+ (vertical-skylines . ,grob::unpure-vertical-skylines-from-stencil)
+ (Y-extent . ,(grob::unpure-Y-extent-from-stencil volta-bracket-interface::pure-height))
+ (meta . ((class . Spanner)
+ (interfaces . (font-interface
+ horizontal-bracket-interface
+ line-interface
+ side-position-interface
+ text-interface
+ volta-bracket-interface
+ volta-interface))))))
(VoltaBracketSpanner
. (
- (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
- (axes . (,Y))
- (direction . ,UP)
- (no-alignment . #t)
- (outside-staff-priority . 600)
- (padding . 1)
- (side-axis . ,Y)
- (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
- (X-extent . ,ly:axis-group-interface::width)
- (Y-extent . ,axis-group-interface::height)
+ (after-line-breaking . ,ly:side-position-interface::move-to-extremal-staff)
+ (axes . (,Y))
+ (direction . ,UP)
+ (no-alignment . #t)
+ (outside-staff-priority . 600)
+ (padding . 1)
+ (side-axis . ,Y)
+ (vertical-skylines . ,grob::always-vertical-skylines-from-element-stencils)
+ (X-extent . ,ly:axis-group-interface::width)
+ (Y-extent . ,axis-group-interface::height)
(Y-offset . ,side-position-interface::y-aligned-side)
- (meta . ((class . Spanner)
- (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
- (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
- (interfaces . (axis-group-interface
- side-position-interface
- volta-interface))))))
+ (meta . ((class . Spanner)
+ (object-callbacks . ((pure-Y-common . ,ly:axis-group-interface::calc-pure-y-common)
+ (pure-relevant-grobs . ,ly:axis-group-interface::calc-pure-relevant-grobs)))
+ (interfaces . (axis-group-interface
+ side-position-interface
+ volta-interface))))))
-))
+ ))
(define (completize-grob-entry x)
"Transplant assoc key into 'name entry of 'meta of X. Set interfaces for Item, Spanner etc.
@@ -2759,11 +2759,11 @@
;; (display (car x))
;; (newline)
(let* ((name-sym (car x))
- (grob-entry (cdr x))
- (meta-entry (assoc-get 'meta grob-entry))
- (class (assoc-get 'class meta-entry))
- (ifaces-entry
- (assoc-get 'interfaces meta-entry)))
+ (grob-entry (cdr x))
+ (meta-entry (assoc-get 'meta grob-entry))
+ (class (assoc-get 'class meta-entry))
+ (ifaces-entry
+ (assoc-get 'interfaces meta-entry)))
(cond
((eq? 'Item class)
@@ -2772,10 +2772,10 @@
(set! ifaces-entry (cons 'spanner-interface ifaces-entry)))
((eq? 'Paper_column class)
(set! ifaces-entry (cons 'item-interface
- (cons 'paper-column-interface ifaces-entry))))
+ (cons 'paper-column-interface ifaces-entry))))
((eq? 'System class)
(set! ifaces-entry (cons 'system-interface
- (cons 'spanner-interface ifaces-entry))))
+ (cons 'spanner-interface ifaces-entry))))
(else
(ly:warning "Unknown class ~a" class)))
@@ -2784,7 +2784,7 @@
(set! meta-entry (assoc-set! meta-entry 'name name-sym))
(set! meta-entry (assoc-set! meta-entry 'interfaces
- ifaces-entry))
+ ifaces-entry))
(set! grob-entry (assoc-set! grob-entry 'meta meta-entry))
(cons name-sym grob-entry)))
diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm
index ecbe876ffa..fd7ce3eff8 100755
--- a/scm/define-markup-commands.scm
+++ b/scm/define-markup-commands.scm
@@ -194,40 +194,40 @@ Manual settings for @code{on},@code{off} and @code{phase} are possible.
;; line-length.
(new-off (/ (- line-length corr (* (1+ guess) on)) guess))
)
- (cond
-
- ;; Settings for (= on 0). Resulting in a dotted line.
-
- ;; If line-length isn't shorter than `th´, change the given
- ;; value for `off´ to fit the line-length.
- ((and (= on 0) (< th line-length))
- (set! off new-off))
-
- ;; If the line-length is shorter than `th´, it makes no
- ;; sense to adjust `off´. The rounded edges of the lines
- ;; would prevent any nice output.
- ;; Do nothing.
- ;; This will result in a single dot for very short lines.
- ((and (= on 0) (>= th line-length))
- #f)
-
- ;; Settings for (not (= on 0)). Resulting in a dashed line.
-
- ;; If line-length isn't shorter than one go of on-off-on,
- ;; change the given value for `off´ to fit the line-length.
- ((< (+ (* 2 on) off) line-length)
- (set! off new-off))
- ;; If the line-length is too short, but greater than
- ;; (* 4 th) set on/off to (/ line-length 3)
- ((< (* 4 th) line-length)
- (set! on (/ line-length 3))
- (set! off (/ line-length 3)))
- ;; If the line-length is shorter than (* 4 th), it makes
- ;; no sense trying to adjust on/off. The rounded edges of
- ;; the lines would prevent any nice output.
- ;; Simply set `on´ to line-length.
- (else
- (set! on line-length))))))
+ (cond
+
+ ;; Settings for (= on 0). Resulting in a dotted line.
+
+ ;; If line-length isn't shorter than `th´, change the given
+ ;; value for `off´ to fit the line-length.
+ ((and (= on 0) (< th line-length))
+ (set! off new-off))
+
+ ;; If the line-length is shorter than `th´, it makes no
+ ;; sense to adjust `off´. The rounded edges of the lines
+ ;; would prevent any nice output.
+ ;; Do nothing.
+ ;; This will result in a single dot for very short lines.
+ ((and (= on 0) (>= th line-length))
+ #f)
+
+ ;; Settings for (not (= on 0)). Resulting in a dashed line.
+
+ ;; If line-length isn't shorter than one go of on-off-on,
+ ;; change the given value for `off´ to fit the line-length.
+ ((< (+ (* 2 on) off) line-length)
+ (set! off new-off))
+ ;; If the line-length is too short, but greater than
+ ;; (* 4 th) set on/off to (/ line-length 3)
+ ((< (* 4 th) line-length)
+ (set! on (/ line-length 3))
+ (set! off (/ line-length 3)))
+ ;; If the line-length is shorter than (* 4 th), it makes
+ ;; no sense trying to adjust on/off. The rounded edges of
+ ;; the lines would prevent any nice output.
+ ;; Simply set `on´ to line-length.
+ (else
+ (set! on line-length))))))
;; If `on´ or `off´ is negative, or the sum of `on' and `off' equals zero a
;; ghostscript-error occurs while calling
@@ -244,9 +244,9 @@ Manual settings for @code{on},@code{off} and @code{phase} are possible.
;; To give the lines produced by \draw-line and \draw-dashed-line the same
;; length, half-thick has to be added to the stencil-extensions.
(ly:make-stencil
- (list 'dashed-line th on off x y phase)
- (interval-widen (ordered-cons 0 x) half-thick)
- (interval-widen (ordered-cons 0 y) half-thick))))
+ (list 'dashed-line th on off x y phase)
+ (interval-widen (ordered-cons 0 x) half-thick)
+ (interval-widen (ordered-cons 0 y) half-thick))))
(define-markup-command (draw-dotted-line layout props dest)
(number-pair?)
@@ -275,11 +275,11 @@ line-length.
@end lilypond"
(let ((new-props (prepend-alist-chain 'on 0
- (prepend-alist-chain 'full-length #t props))))
+ (prepend-alist-chain 'full-length #t props))))
- (interpret-markup layout
- new-props
- (markup #:draw-dashed-line dest))))
+ (interpret-markup layout
+ new-props
+ (markup #:draw-dashed-line dest))))
(define-markup-command (draw-hline layout props)
()
@@ -304,8 +304,8 @@ controls what fraction of the page is taken up.
(interpret-markup layout
props
(markup #:draw-line (cons (* line-width
- span-factor)
- 0))))
+ span-factor)
+ 0))))
(define-markup-command (draw-circle layout props radius thickness filled)
(number? number? boolean?)
@@ -329,8 +329,8 @@ optionally filled.
(boolean?)
#:category graphic
#:properties ((thickness 0.1)
- (font-size 0)
- (baseline-skip 2))
+ (font-size 0)
+ (baseline-skip 2))
"
@cindex drawing triangles within text
@@ -349,8 +349,8 @@ A triangle, either filled or empty.
,ex 0.0
,(* 0.5 ex)
,(* 0.86 ex))
- ,thickness
- ,filled)
+ ,thickness
+ ,filled)
(cons 0 ex)
(cons 0 (* .86 ex)))))
@@ -358,8 +358,8 @@ A triangle, either filled or empty.
(markup?)
#:category graphic
#:properties ((thickness 1)
- (font-size 0)
- (circle-padding 0.2))
+ (font-size 0)
+ (circle-padding 0.2))
"
@cindex circling text
@@ -376,8 +376,8 @@ thickness and padding around the markup.
@end lilypond"
(let ((th (* (ly:output-def-lookup layout 'line-thickness)
thickness))
- (pad (* (magstep font-size) circle-padding))
- (m (interpret-markup layout props arg)))
+ (pad (* (magstep font-size) circle-padding))
+ (m (interpret-markup layout props arg)))
(circle-stencil m th pad)))
(define-markup-command (with-url layout props url arg)
@@ -399,10 +399,10 @@ the PDF backend.
}
@end lilypond"
(let* ((stil (interpret-markup layout props arg))
- (xextent (ly:stencil-extent stil X))
- (yextent (ly:stencil-extent stil Y))
- (old-expr (ly:stencil-expr stil))
- (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
+ (xextent (ly:stencil-extent stil X))
+ (yextent (ly:stencil-extent stil Y))
+ (old-expr (ly:stencil-expr stil))
+ (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
(ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
@@ -421,10 +421,10 @@ in the PDF backend.
}
@end lilypond"
(let* ((stil (interpret-markup layout props arg))
- (xextent (ly:stencil-extent stil X))
- (yextent (ly:stencil-extent stil Y))
- (old-expr (ly:stencil-expr stil))
- (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent))))
+ (xextent (ly:stencil-extent stil X))
+ (yextent (ly:stencil-extent stil Y))
+ (old-expr (ly:stencil-expr stil))
+ (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent))))
(ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil)))
@@ -457,7 +457,7 @@ only works in the PDF backend.
(link-expr (list 'page-link page-number
`(quote ,x-ext) `(quote ,y-ext))))
(ly:stencil-add (ly:make-stencil link-expr x-ext y-ext)
-arg-stencil)))))
+ arg-stencil)))))
x-ext
y-ext)))
@@ -475,20 +475,20 @@ Create a beam with the specified parameters.
}
@end lilypond"
(let* ((y (* slope width))
- (yext (cons (min 0 y) (max 0 y)))
- (half (/ thickness 2)))
+ (yext (cons (min 0 y) (max 0 y)))
+ (half (/ thickness 2)))
(ly:make-stencil
`(polygon ',(list
- 0 (/ thickness -2)
- width (+ (* width slope) (/ thickness -2))
- width (+ (* width slope) (/ thickness 2))
- 0 (/ thickness 2))
- ,(ly:output-def-lookup layout 'blot-diameter)
- #t)
+ 0 (/ thickness -2)
+ width (+ (* width slope) (/ thickness -2))
+ width (+ (* width slope) (/ thickness 2))
+ 0 (/ thickness 2))
+ ,(ly:output-def-lookup layout 'blot-diameter)
+ #t)
(cons 0 width)
(cons (+ (- half) (car yext))
- (+ half (cdr yext))))))
+ (+ half (cdr yext))))))
(define-markup-command (underline layout props arg)
(markup?)
@@ -524,8 +524,8 @@ thickness, and @code{offset} to determine line y-offset.
(markup?)
#:category font
#:properties ((thickness 1)
- (font-size 0)
- (box-padding 0.2))
+ (font-size 0)
+ (box-padding 0.2))
"
@cindex enclosing text within a box
@@ -578,9 +578,9 @@ circle of diameter@tie{}0 (i.e., sharp corners).
(markup?)
#:category graphic
#:properties ((thickness 1)
- (corner-radius 1)
- (font-size 0)
- (box-padding 0.5))
+ (corner-radius 1)
+ (font-size 0)
+ (box-padding 0.5))
"@cindex enclosing text in a box with rounded corners
@cindex drawing boxes with rounded corners around text
Draw a box with rounded corners around @var{arg}. Looks at @code{thickness},
@@ -686,9 +686,9 @@ Add space around a markup object.
Create a box of the same height as the space in the current font."
(let ((m (ly:text-interface::interpret-markup layout props " ")))
(ly:make-stencil (ly:stencil-expr m)
- '(0 . 0)
- (ly:stencil-extent m X)
- )))
+ '(0 . 0)
+ (ly:stencil-extent m X)
+ )))
(define-markup-command (hspace layout props amount)
(number?)
@@ -710,9 +710,9 @@ Create an invisible object taking up horizontal space @var{amount}.
(ly:make-stencil "" (cons 0 amount) empty-interval))
(define-markup-command (vspace layout props amount)
- (number?)
- #:category align
- "
+ (number?)
+ #:category align
+ "
@cindex creating vertical spaces in text
Create an invisible object taking up vertical space
@@ -761,11 +761,11 @@ Use a stencil as markup.
((match (regexp-exec bbox-regexp string)))
(if match
- (map (lambda (x)
- (string->number (match:substring match x)))
- (cdr (iota 5)))
+ (map (lambda (x)
+ (string->number (match:substring match x)))
+ (cdr (iota 5)))
- #f)))
+ #f)))
(define-markup-command (epsfile layout props axis size file-name)
(number? number? string?)
@@ -820,20 +820,20 @@ rings = \\markup {
;; FIXME
(ly:make-stencil
(list 'embedded-ps
- (format #f "
+ (format #f "
gsave currentpoint translate
0.1 setlinewidth
~a
grestore
"
- str))
+ str))
'(0 . 0) '(0 . 0)))
(define-markup-command (path layout props thickness commands) (number? list?)
#:category graphic
#:properties ((line-cap-style 'round)
- (line-join-style 'round)
- (filled #f))
+ (line-join-style 'round)
+ (filled #f))
"
@cindex paths, drawing
@cindex drawing paths
@@ -888,77 +888,77 @@ samplePath =
}
@end lilypond"
(let* ((half-thickness (/ thickness 2))
- (current-point '(0 . 0))
- (set-point (lambda (lst) (set! current-point lst)))
- (relative? (lambda (x)
- (string-prefix? "r" (symbol->string (car x)))))
- ;; For calculating extents, we want to modify the command
- ;; list so that all coordinates are absolute.
- (new-commands (map (lambda (x)
- (cond
- ;; for rmoveto, rlineto
- ((and (relative? x) (= 3 (length x)))
- (let ((cp (cons
- (+ (car current-point)
- (second x))
- (+ (cdr current-point)
- (third x)))))
- (set-point cp)
- (list (car cp)
- (cdr cp))))
- ;; for rcurveto
- ((and (relative? x) (= 7 (length x)))
- (let* ((old-cp current-point)
- (cp (cons
- (+ (car old-cp)
- (sixth x))
- (+ (cdr old-cp)
- (seventh x)))))
- (set-point cp)
- (list (+ (car old-cp) (second x))
- (+ (cdr old-cp) (third x))
- (+ (car old-cp) (fourth x))
- (+ (cdr old-cp) (fifth x))
- (car cp)
- (cdr cp))))
- ;; for moveto, lineto
- ((= 3 (length x))
- (set-point (cons (second x)
- (third x)))
- (drop x 1))
- ;; for curveto
- ((= 7 (length x))
- (set-point (cons (sixth x)
- (seventh x)))
- (drop x 1))
- ;; keep closepath for filtering;
- ;; see `without-closepath'.
- (else x)))
- commands))
- ;; path-min-max does not accept 0-arg lists,
- ;; and since closepath does not affect extents, filter
- ;; out those commands here.
- (without-closepath (filter (lambda (x)
- (not (equal? 'closepath (car x))))
- new-commands))
- (extents (path-min-max
- ;; set the origin to the first moveto
- (list (list-ref (car without-closepath) 0)
- (list-ref (car without-closepath) 1))
- without-closepath))
- (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
- (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
- (command-list (fold-right append '() commands)))
+ (current-point '(0 . 0))
+ (set-point (lambda (lst) (set! current-point lst)))
+ (relative? (lambda (x)
+ (string-prefix? "r" (symbol->string (car x)))))
+ ;; For calculating extents, we want to modify the command
+ ;; list so that all coordinates are absolute.
+ (new-commands (map (lambda (x)
+ (cond
+ ;; for rmoveto, rlineto
+ ((and (relative? x) (= 3 (length x)))
+ (let ((cp (cons
+ (+ (car current-point)
+ (second x))
+ (+ (cdr current-point)
+ (third x)))))
+ (set-point cp)
+ (list (car cp)
+ (cdr cp))))
+ ;; for rcurveto
+ ((and (relative? x) (= 7 (length x)))
+ (let* ((old-cp current-point)
+ (cp (cons
+ (+ (car old-cp)
+ (sixth x))
+ (+ (cdr old-cp)
+ (seventh x)))))
+ (set-point cp)
+ (list (+ (car old-cp) (second x))
+ (+ (cdr old-cp) (third x))
+ (+ (car old-cp) (fourth x))
+ (+ (cdr old-cp) (fifth x))
+ (car cp)
+ (cdr cp))))
+ ;; for moveto, lineto
+ ((= 3 (length x))
+ (set-point (cons (second x)
+ (third x)))
+ (drop x 1))
+ ;; for curveto
+ ((= 7 (length x))
+ (set-point (cons (sixth x)
+ (seventh x)))
+ (drop x 1))
+ ;; keep closepath for filtering;
+ ;; see `without-closepath'.
+ (else x)))
+ commands))
+ ;; path-min-max does not accept 0-arg lists,
+ ;; and since closepath does not affect extents, filter
+ ;; out those commands here.
+ (without-closepath (filter (lambda (x)
+ (not (equal? 'closepath (car x))))
+ new-commands))
+ (extents (path-min-max
+ ;; set the origin to the first moveto
+ (list (list-ref (car without-closepath) 0)
+ (list-ref (car without-closepath) 1))
+ without-closepath))
+ (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
+ (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
+ (command-list (fold-right append '() commands)))
;; account for line thickness
(set! X-extent (interval-widen X-extent half-thickness))
(set! Y-extent (interval-widen Y-extent half-thickness))
(ly:make-stencil
- `(path ,thickness `(,@',command-list)
- ',line-cap-style ',line-join-style ,filled)
- X-extent
- Y-extent)))
+ `(path ,thickness `(,@',command-list)
+ ',line-cap-style ',line-join-style ,filled)
+ X-extent
+ Y-extent)))
(define-markup-list-command (score-lines layout props score)
(ly:score?)
@@ -981,8 +981,8 @@ be split across pages."
(- (car (paper-system-staff-extents paper-system)))
Y))
(vector->list (ly:paper-score-paper-systems output)))
- (begin
- (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
+ (begin
+ (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
'()))))
(define-markup-command (score layout props score)
@@ -1099,12 +1099,12 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols.
(define (replace-ties tie str)
(if (string-contains str "~")
(let*
- ((half-space (/ word-space 2))
- (parts (string-split str #\~))
- (tie-str (markup #:hspace half-space
- #:musicglyph tie
- #:hspace half-space))
- (joined (list-join parts tie-str)))
+ ((half-space (/ word-space 2))
+ (parts (string-split str #\~))
+ (tie-str (markup #:hspace half-space
+ #:musicglyph tie
+ #:hspace half-space))
+ (joined (list-join parts tie-str)))
(make-concat-markup joined))
str))
@@ -1115,16 +1115,16 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols.
(let ((match (match-short str)))
(if (not match)
(make-concat-markup (list
- mkp
- (replace-ties "ties.lyric.default" str)))
+ mkp
+ (replace-ties "ties.lyric.default" str)))
(let ((new-str (match:suffix match))
(new-mkp (make-concat-markup (list
- mkp
- (replace-ties "ties.lyric.default"
- (match:prefix match))
- (replace-ties "ties.lyric.short"
- (match:substring match))))))
- (replace-short new-str new-mkp)))))
+ mkp
+ (replace-ties "ties.lyric.default"
+ (match:prefix match))
+ (replace-ties "ties.lyric.short"
+ (match:substring match))))))
+ (replace-short new-str new-mkp)))))
(interpret-markup layout
props
@@ -1151,12 +1151,12 @@ Like simple-markup, but use tie characters for @q{~} tilde symbols.
((= (length text-widths) word-count)
(cons
(- (- (/ line-width (1- word-count)) (car text-widths))
- (/ (car (cdr text-widths)) 2))
+ (/ (car (cdr text-widths)) 2))
(get-fill-space word-count line-width word-space (cdr text-widths))))
;; special case last padding
((= (length text-widths) 2)
(list (- (/ line-width (1- word-count))
- (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
+ (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
(else
(let ((default-padding
(- (/ line-width (1- word-count))
@@ -1252,7 +1252,7 @@ If there are no arguments, return an empty stencil.
(markup-list?)
#:category align
#:properties ((word-space)
- (text-direction RIGHT))
+ (text-direction RIGHT))
"Put @var{args} in a horizontal line. The property @code{word-space}
determines the space between markups in @var{args}.
@@ -1293,12 +1293,12 @@ equivalent to @code{\"fi\"}.
(fold-right (lambda (arg result-list)
(let ((result (if (pair? result-list)
(car result-list)
- '())))
+ '())))
(if (and (pair? arg) (eqv? (car arg) simple-markup))
- (set! arg (cadr arg)))
+ (set! arg (cadr arg)))
(if (and (string? result) (string? arg))
(cons (string-append arg result) (cdr result-list))
- (cons arg result-list))))
+ (cons arg result-list))))
'()
arg-list))
@@ -1313,12 +1313,12 @@ equivalent to @code{\"fi\"}.
(concat-string-args args))))))
(define (wordwrap-stencils stencils
- justify base-space line-width text-dir)
+ justify base-space line-width text-dir)
"Perform simple wordwrap, return stencil of each line."
(define space (if justify
;; justify only stretches lines.
- (* 0.7 base-space)
- base-space))
+ (* 0.7 base-space)
+ base-space))
(define (stencil-space stencil line-start)
(if (ly:stencil-empty? stencil X)
0
@@ -1329,17 +1329,17 @@ equivalent to @code{\"fi\"}.
X RIGHT stencil)
X))))
(define (take-list width space stencils
- accumulator accumulated-width)
+ accumulator accumulated-width)
"Return (head-list . tail) pair, with head-list fitting into width"
(if (null? stencils)
- (cons accumulator stencils)
- (let* ((first (car stencils))
+ (cons accumulator stencils)
+ (let* ((first (car stencils))
(first-wid (stencil-space first (null? accumulator)))
(newwid (+ (if (or (ly:stencil-empty? first Y)
(ly:stencil-empty? first X))
0 space)
first-wid accumulated-width)))
- (if (or (null? accumulator)
+ (if (or (null? accumulator)
(< newwid width))
(take-list width space
(cdr stencils)
@@ -1350,15 +1350,15 @@ equivalent to @code{\"fi\"}.
(todo stencils))
(let* ((line-break (take-list line-width space todo
'() 0.0))
- (line-stencils (car line-break))
- (space-left (- line-width
+ (line-stencils (car line-break))
+ (space-left (- line-width
(stencil-space
(stack-stencil-line 0 line-stencils)
#t)))
(line-words (count (lambda (s) (not (or (ly:stencil-empty? s Y)
(ly:stencil-empty? s X))))
line-stencils))
- (line-word-space (cond ((not justify) space)
+ (line-word-space (cond ((not justify) space)
;; don't stretch last line of paragraph.
;; hmmm . bug - will overstretch the last line in some case.
((null? (cdr line-break))
@@ -1384,8 +1384,8 @@ equivalent to @code{\"fi\"}.
(define-markup-list-command (wordwrap-internal layout props justify args)
(boolean? markup-list?)
#:properties ((line-width #f)
- (word-space)
- (text-direction RIGHT))
+ (word-space)
+ (text-direction RIGHT))
"Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
(wordwrap-stencils (interpret-markup-list layout props args)
justify
@@ -1398,7 +1398,7 @@ equivalent to @code{\"fi\"}.
(markup-list?)
#:category align
#:properties ((baseline-skip)
- wordwrap-internal-markup-list)
+ wordwrap-internal-markup-list)
"
@cindex justifying text
@@ -1423,7 +1423,7 @@ Use @code{\\override #'(line-width . @var{X})} to set the line width;
(markup-list?)
#:category align
#:properties ((baseline-skip)
- wordwrap-internal-markup-list)
+ wordwrap-internal-markup-list)
"Simple wordwrap. Use @code{\\override #'(line-width . @var{X})} to set
the line width, where @var{X} is the number of staff spaces.
@@ -1438,13 +1438,13 @@ the line width, where @var{X} is the number of staff spaces.
}
@end lilypond"
(stack-lines DOWN 0.0 baseline-skip
- (wordwrap-internal-markup-list layout props #f args)))
+ (wordwrap-internal-markup-list layout props #f args)))
(define-markup-list-command (wordwrap-string-internal layout props justify arg)
(boolean? string?)
#:properties ((line-width)
- (word-space)
- (text-direction RIGHT))
+ (word-space)
+ (text-direction RIGHT))
"Internal markup list command used to define @code{\\justify-string} and
@code{\\wordwrap-string}."
(let* ((para-strings (regexp-split
@@ -1470,7 +1470,7 @@ the line width, where @var{X} is the number of staff spaces.
(string?)
#:category align
#:properties ((baseline-skip)
- wordwrap-string-internal-markup-list)
+ wordwrap-string-internal-markup-list)
"Wordwrap a string. Paragraphs may be separated with double newlines.
@lilypond[verbatim,quote]
@@ -1496,7 +1496,7 @@ the line width, where @var{X} is the number of staff spaces.
(string?)
#:category align
#:properties ((baseline-skip)
- wordwrap-string-internal-markup-list)
+ wordwrap-string-internal-markup-list)
"Justify a string. Paragraphs may be separated with double newlines
@lilypond[verbatim,quote]
@@ -1610,7 +1610,7 @@ curly braces as an argument; the follow example will not compile:
}
@end lilypond"
(let* ((s1 (interpret-markup layout props arg1))
- (s2 (interpret-markup layout props arg2)))
+ (s2 (interpret-markup layout props arg2)))
(ly:stencil-add s1 s2)))
;;
@@ -1643,7 +1643,7 @@ in @var{args}.
(markup-list?)
#:category align
#:properties ((direction)
- (baseline-skip))
+ (baseline-skip))
"
@cindex changing direction of text columns
@@ -1706,7 +1706,7 @@ Put @code{args} in a centered column.
(markup-list?)
#:category align
#:properties ((baseline-skip))
- "
+ "
@cindex text columns, left-aligned
Put @code{args} in a left-aligned column.
@@ -1726,7 +1726,7 @@ Put @code{args} in a left-aligned column.
(markup-list?)
#:category align
#:properties ((baseline-skip))
- "
+ "
@cindex text columns, right-aligned
Put @code{args} in a right-aligned column.
@@ -2091,8 +2091,8 @@ returns an empty markup.
@var{procedure} should take a single argument."
(let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
(set-object-property! anonymous-with-signature
- 'markup-signature
- (list markup?))
+ 'markup-signature
+ (list markup?))
(interpret-markup layout props (list anonymous-with-signature arg))))
(define-markup-command (footnote layout props mkup note)
@@ -2109,14 +2109,14 @@ returns an empty markup.
@end lilypond
The footnote will not be annotated automatically."
(ly:stencil-combine-at-edge
- (interpret-markup layout props mkup)
- X
- RIGHT
- (ly:make-stencil
- `(footnote (gensym "footnote") #f ,(interpret-markup layout props note))
- '(0 . 0)
- '(0 . 0))
- 0.0))
+ (interpret-markup layout props mkup)
+ X
+ RIGHT
+ (ly:make-stencil
+ `(footnote (gensym "footnote") #f ,(interpret-markup layout props note))
+ '(0 . 0)
+ '(0 . 0))
+ 0.0))
(define-markup-command (auto-footnote layout props mkup note)
(markup? markup?)
@@ -2137,49 +2137,49 @@ The footnote will be annotated automatically."
(footnote-hash (gensym "footnote"))
(stencil-seed 0)
(gauge-stencil (interpret-markup
+ layout
+ props
+ ((ly:output-def-lookup
layout
- props
- ((ly:output-def-lookup
- layout
- 'footnote-numbering-function)
- stencil-seed)))
+ 'footnote-numbering-function)
+ stencil-seed)))
(x-ext (ly:stencil-extent gauge-stencil X))
- (y-ext (ly:stencil-extent gauge-stencil Y))
+ (y-ext (ly:stencil-extent gauge-stencil Y))
(footnote-number
- `(delay-stencil-evaluation
- ,(delay
- (ly:stencil-expr
- (let* ((table
- (ly:output-def-lookup layout
- 'number-footnote-table))
- (footnote-stencil (if (list? table)
- (assoc-get footnote-hash
- table)
- empty-stencil))
- (footnote-stencil (if (ly:stencil? footnote-stencil)
- footnote-stencil
- (begin
- (ly:programming-error
-"Cannot find correct footnote for a markup object.")
- empty-stencil)))
- (gap (- (interval-length x-ext)
- (interval-length
- (ly:stencil-extent footnote-stencil X))))
- (y-trans (- (+ (cdr y-ext)
- raise)
- (cdr (ly:stencil-extent footnote-stencil
- Y)))))
- (ly:stencil-translate footnote-stencil
- (cons gap y-trans)))))))
+ `(delay-stencil-evaluation
+ ,(delay
+ (ly:stencil-expr
+ (let* ((table
+ (ly:output-def-lookup layout
+ 'number-footnote-table))
+ (footnote-stencil (if (list? table)
+ (assoc-get footnote-hash
+ table)
+ empty-stencil))
+ (footnote-stencil (if (ly:stencil? footnote-stencil)
+ footnote-stencil
+ (begin
+ (ly:programming-error
+ "Cannot find correct footnote for a markup object.")
+ empty-stencil)))
+ (gap (- (interval-length x-ext)
+ (interval-length
+ (ly:stencil-extent footnote-stencil X))))
+ (y-trans (- (+ (cdr y-ext)
+ raise)
+ (cdr (ly:stencil-extent footnote-stencil
+ Y)))))
+ (ly:stencil-translate footnote-stencil
+ (cons gap y-trans)))))))
(main-stencil (ly:stencil-combine-at-edge
- markup-stencil
- X
- RIGHT
- (ly:make-stencil footnote-number x-ext y-ext)
- padding)))
- (ly:stencil-add
- main-stencil
- (ly:make-stencil
+ markup-stencil
+ X
+ RIGHT
+ (ly:make-stencil footnote-number x-ext y-ext)
+ padding)))
+ (ly:stencil-add
+ main-stencil
+ (ly:make-stencil
`(footnote ,footnote-hash #t ,(interpret-markup layout props note))
'(0 . 0)
'(0 . 0)))))
@@ -2260,7 +2260,7 @@ may be any property supported by @rinternals{font-interface},
}
@end lilypond"
(interpret-markup layout props
- `(,fontsize-markup -1 ,arg)))
+ `(,fontsize-markup -1 ,arg)))
(define-markup-command (larger layout props arg)
(markup?)
@@ -2276,7 +2276,7 @@ may be any property supported by @rinternals{font-interface},
}
@end lilypond"
(interpret-markup layout props
- `(,fontsize-markup 1 ,arg)))
+ `(,fontsize-markup 1 ,arg)))
(define-markup-command (finger layout props arg)
(markup?)
@@ -2314,21 +2314,21 @@ Adjusts @code{baseline-skip} and @code{word-space} accordingly.
(ref-word-space (chain-assoc-get 'word-space text-props 0.6))
(ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
(magnification (/ size ref-size)))
- (interpret-markup
- layout
- (cons
- `((baseline-skip . ,(* magnification ref-baseline))
- (word-space . ,(* magnification ref-word-space))
- (font-size . ,(magnification->font-size magnification)))
- props)
- arg)))
+ (interpret-markup
+ layout
+ (cons
+ `((baseline-skip . ,(* magnification ref-baseline))
+ (word-space . ,(* magnification ref-word-space))
+ (font-size . ,(magnification->font-size magnification)))
+ props)
+ arg)))
(define-markup-command (fontsize layout props increment arg)
(number? markup?)
#:category font
#:properties ((font-size 0)
- (word-space 1)
- (baseline-skip 2))
+ (word-space 1)
+ (baseline-skip 2))
"Add @var{increment} to the font-size. Adjusts @code{baseline-skip}
accordingly.
@@ -2570,33 +2570,33 @@ Note: @code{\\smallCaps} does not support accented characters.
(define (char-list->markup chars lower)
(let ((final-string (string-upcase (reverse-list->string chars))))
(if lower
- (markup #:fontsize -2 final-string)
- final-string)))
+ (markup #:fontsize -2 final-string)
+ final-string)))
(define (make-small-caps rest-chars currents current-is-lower prev-result)
(if (null? rest-chars)
- (make-concat-markup
- (reverse! (cons (char-list->markup currents current-is-lower)
- prev-result)))
- (let* ((ch (car rest-chars))
- (is-lower (char-lower-case? ch)))
- (if (or (and current-is-lower is-lower)
- (and (not current-is-lower) (not is-lower)))
- (make-small-caps (cdr rest-chars)
- (cons ch currents)
- is-lower
- prev-result)
- (make-small-caps (cdr rest-chars)
- (list ch)
- is-lower
- (if (null? currents)
- prev-result
- (cons (char-list->markup
- currents current-is-lower)
- prev-result)))))))
+ (make-concat-markup
+ (reverse! (cons (char-list->markup currents current-is-lower)
+ prev-result)))
+ (let* ((ch (car rest-chars))
+ (is-lower (char-lower-case? ch)))
+ (if (or (and current-is-lower is-lower)
+ (and (not current-is-lower) (not is-lower)))
+ (make-small-caps (cdr rest-chars)
+ (cons ch currents)
+ is-lower
+ prev-result)
+ (make-small-caps (cdr rest-chars)
+ (list ch)
+ is-lower
+ (if (null? currents)
+ prev-result
+ (cons (char-list->markup
+ currents current-is-lower)
+ prev-result)))))))
(interpret-markup layout props
- (if (string? arg)
- (make-small-caps (string->list arg) (list) #f (list))
- arg)))
+ (if (string? arg)
+ (make-small-caps (string->list arg) (list) #f (list))
+ arg)))
(define-markup-command (caps layout props arg)
(markup?)
@@ -2650,7 +2650,7 @@ done in a different font. The recommended font for this is bold and italic.
;; ugh - latin1
(interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
- arg))
+ arg))
(define-markup-command (italic layout props arg)
(markup?)
@@ -2724,7 +2724,7 @@ of @code{italic}.
}
@end lilypond"
(interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
- arg))
+ arg))
(define-markup-command (normal-text layout props arg)
(markup?)
@@ -2748,8 +2748,8 @@ normal text font, no matter what font was used earlier.
;; ugh - latin1
(interpret-markup layout
(cons '((font-family . roman) (font-shape . upright)
- (font-series . medium) (font-encoding . latin1))
- props)
+ (font-series . medium) (font-encoding . latin1))
+ props)
arg))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -2772,13 +2772,13 @@ the possible glyphs.
}
@end lilypond"
(let* ((font (ly:paper-get-font layout
- (cons '((font-encoding . fetaMusic)
- (font-name . #f))
+ (cons '((font-encoding . fetaMusic)
+ (font-name . #f))
- props)))
- (glyph (ly:font-get-glyph font glyph-name)))
+ props)))
+ (glyph (ly:font-get-glyph font glyph-name)))
(if (null? (ly:stencil-expr glyph))
- (ly:warning (_ "Cannot find glyph ~a") glyph-name))
+ (ly:warning (_ "Cannot find glyph ~a") glyph-name))
glyph))
@@ -2912,8 +2912,8 @@ Draw @var{arg} in color specified by @var{color}.
@end lilypond"
(let ((stil (interpret-markup layout props arg)))
(ly:make-stencil (list 'color color (ly:stencil-expr stil))
- (ly:stencil-extent stil X)
- (ly:stencil-extent stil Y))))
+ (ly:stencil-extent stil X)
+ (ly:stencil-extent stil Y))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; glyphs
@@ -2939,14 +2939,14 @@ Use the filled head if @var{filled} is specified.
@end lilypond"
(let*
((name (format #f "arrowheads.~a.~a~a"
- (if filled
- "close"
- "open")
- axis
- dir)))
+ (if filled
+ "close"
+ "open")
+ axis
+ dir)))
(ly:font-get-glyph
(ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
- props))
+ props))
name)))
(define-markup-command (lookup layout props glyph-name)
@@ -2965,7 +2965,7 @@ Use the filled head if @var{filled} is specified.
}
@end lilypond"
(ly:font-get-glyph (ly:paper-get-font layout props)
- glyph-name))
+ glyph-name))
(define-markup-command (char layout props num)
(integer?)
@@ -2991,16 +2991,16 @@ format require the prefix @code{#x}.
(integer->char (+ i (char->integer #\A)))))
(define number->mark-alphabet-vector (list->vector
- (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
+ (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
(define (number->markletter-string vec n)
"Double letters for big marks."
(let* ((lst (vector-length vec)))
(if (>= n lst)
- (string-append (number->markletter-string vec (1- (quotient n lst)))
- (number->markletter-string vec (remainder n lst)))
- (make-string 1 (vector-ref vec n)))))
+ (string-append (number->markletter-string vec (1- (quotient n lst)))
+ (number->markletter-string vec (remainder n lst)))
+ (make-string 1 (vector-ref vec n)))))
(define-markup-command (markletter layout props num)
(integer?)
@@ -3010,10 +3010,10 @@ format require the prefix @code{#x}.
@lilypond[verbatim,quote]
\\markup {
- \\markletter #8
- \\hspace #2
- \\markletter #26
-}
+ \\markletter #8
+ \\hspace #2
+ \\markletter #26
+ }
@end lilypond"
(ly:text-interface::interpret-markup layout props
(number->markletter-string number->mark-letter-vector num)))
@@ -3021,7 +3021,7 @@ format require the prefix @code{#x}.
(define-markup-command (markalphabet layout props num)
(integer?)
#:category other
- "Make a markup letter for @var{num}. The letters start with A to@tie{}Z
+ "Make a markup letter for @var{num}. The letters start with A to@tie{}Z
and continue with double letters.
@lilypond[verbatim,quote]
@@ -3031,67 +3031,67 @@ and continue with double letters.
\\markalphabet #26
}
@end lilypond"
- (ly:text-interface::interpret-markup layout props
- (number->markletter-string number->mark-alphabet-vector num)))
+ (ly:text-interface::interpret-markup layout props
+ (number->markletter-string number->mark-alphabet-vector num)))
(define-public (horizontal-slash-interval num forward number-interval mag)
(if forward
- (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
- ;((= num 5) (interval-widen number-interval (* mag 0.5)))
- (else (interval-widen number-interval (* mag 0.25))))
- (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
- ;((= num 5) (interval-widen number-interval (* mag 0.5)))
- (else (interval-widen number-interval (* mag 0.25))))
- ))
+ (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
+ ;((= num 5) (interval-widen number-interval (* mag 0.5)))
+ (else (interval-widen number-interval (* mag 0.25))))
+ (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
+ ;((= num 5) (interval-widen number-interval (* mag 0.5)))
+ (else (interval-widen number-interval (* mag 0.25))))
+ ))
(define-public (adjust-slash-stencil num forward stencil mag)
(if forward
- (cond ((= num 2)
- (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
- ((= num 3)
- (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
- ;((= num 5)
- ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
- ;((= num 7)
- ; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
- (else stencil))
- (cond ((= num 6)
- (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
- ;((= num 8)
- ; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
- (else stencil))
+ (cond ((= num 2)
+ (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
+ ((= num 3)
+ (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
+ ;((= num 5)
+ ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
+ ;((= num 7)
+ ; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
+ (else stencil))
+ (cond ((= num 6)
+ (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
+ ;((= num 8)
+ ; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
+ (else stencil))
+ )
)
-)
(define (slashed-digit-internal layout props num forward font-size thickness)
(let* ((mag (magstep font-size))
(thickness (* mag
(ly:output-def-lookup layout 'line-thickness)
thickness))
- ; backward slashes might use slope and point in the other direction!
+ ; backward slashes might use slope and point in the other direction!
(dy (* mag (if forward 0.4 -0.4)))
(number-stencil (interpret-markup layout
(prepend-alist-chain 'font-encoding 'fetaText props)
(number->string num)))
(num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
(center (interval-center (ly:stencil-extent number-stencil Y)))
- ; Use the real extents of the slash, not the whole number, because we
- ; might translate the slash later on!
+ ; Use the real extents of the slash, not the whole number, because we
+ ; might translate the slash later on!
(num-y (interval-widen (cons center center) (abs dy)))
(is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
(slash-stencil (if is-sane
(make-line-stencil thickness
- (car num-x) (- (interval-center num-y) dy)
- (cdr num-x) (+ (interval-center num-y) dy))
+ (car num-x) (- (interval-center num-y) dy)
+ (cdr num-x) (+ (interval-center num-y) dy))
#f)))
(if (ly:stencil? slash-stencil)
- (begin
- ; for some numbers we need to shift the slash/backslash up or down to make
- ; the slashed digit look better
- (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
- (set! number-stencil
- (ly:stencil-add number-stencil slash-stencil)))
- (ly:warning "Unable to create slashed digit ~a" num))
+ (begin
+ ; for some numbers we need to shift the slash/backslash up or down to make
+ ; the slashed digit look better
+ (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
+ (set! number-stencil
+ (ly:stencil-add number-stencil slash-stencil)))
+ (ly:warning "Unable to create slashed digit ~a" num))
number-stencil))
@@ -3099,7 +3099,7 @@ and continue with double letters.
(integer?)
#:category other
#:properties ((font-size 0)
- (thickness 1.6))
+ (thickness 1.6))
"
@cindex slashed digits
@@ -3119,7 +3119,7 @@ figured bass notation.
(integer?)
#:category other
#:properties ((font-size 0)
- (thickness 1.6))
+ (thickness 1.6))
"
@cindex backslashed digits
@@ -3167,8 +3167,8 @@ figured bass notation.
\\markup { \\eyeglasses }
@end lilypond"
(interpret-markup layout props
- (make-override-markup '(line-cap-style . butt)
- (make-path-markup 0.15 eyeglassespath))))
+ (make-override-markup '(line-cap-style . butt)
+ (make-path-markup 0.15 eyeglassespath))))
(define-markup-command (left-brace layout props size)
(number?)
@@ -3187,28 +3187,28 @@ A feta brace in point size @var{size}.
(cons '((font-encoding . fetaBraces)
(font-name . #f))
props)))
- (glyph-count (1- (ly:otf-glyph-count font)))
+ (glyph-count (1- (ly:otf-glyph-count font)))
(scale (ly:output-def-lookup layout 'output-scale))
(scaled-size (/ (ly:pt size) scale))
(glyph (lambda (n)
(ly:font-get-glyph font (string-append "brace"
- (number->string n)))))
- (get-y-from-brace (lambda (brace)
- (interval-length
- (ly:stencil-extent (glyph brace) Y))))
+ (number->string n)))))
+ (get-y-from-brace (lambda (brace)
+ (interval-length
+ (ly:stencil-extent (glyph brace) Y))))
(find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
(glyph-found (glyph find-brace)))
(if (or (null? (ly:stencil-expr glyph-found))
- (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
- (> scaled-size (interval-length
- (ly:stencil-extent (glyph glyph-count) Y))))
+ (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
+ (> scaled-size (interval-length
+ (ly:stencil-extent (glyph glyph-count) Y))))
(begin
(ly:warning (_ "no brace found for point size ~S ") size)
(ly:warning (_ "defaulting to ~S pt")
- (/ (* scale (interval-length
- (ly:stencil-extent glyph-found Y)))
- (ly:pt 1)))))
+ (/ (* scale (interval-length
+ (ly:stencil-extent glyph-found Y)))
+ (ly:pt 1)))))
glyph-found))
(define-markup-command (right-brace layout props size)
@@ -3256,94 +3256,94 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and
@end lilypond"
(define (get-glyph-name-candidates dir log style)
(map (lambda (dir-name)
- (format #f "noteheads.~a~a" dir-name
- (if (and (symbol? style)
- (not (equal? 'default style)))
- (select-head-glyph style (min log 2))
- (min log 2))))
- (list (if (= dir UP) "u" "d")
- "s")))
+ (format #f "noteheads.~a~a" dir-name
+ (if (and (symbol? style)
+ (not (equal? 'default style)))
+ (select-head-glyph style (min log 2))
+ (min log 2))))
+ (list (if (= dir UP) "u" "d")
+ "s")))
(define (get-glyph-name font cands)
(if (null? cands)
- ""
- (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
- (get-glyph-name font (cdr cands))
- (car cands))))
+ ""
+ (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
+ (get-glyph-name font (cdr cands))
+ (car cands))))
(define (buildflags flag-stencil remain curr-stencil spacing)
- ;; Function to recursively create a stencil with @code{remain} flags
- ;; from the single-flag stencil @code{curr-stencil}, which is already
- ;; translated to the position of the previous flag position.
- ;;
- ;; Copy and paste from /scm/flag-styles.scm
+ ;; Function to recursively create a stencil with @code{remain} flags
+ ;; from the single-flag stencil @code{curr-stencil}, which is already
+ ;; translated to the position of the previous flag position.
+ ;;
+ ;; Copy and paste from /scm/flag-styles.scm
(if (> remain 0)
(let* ((translated-stencil
- (ly:stencil-translate-axis curr-stencil spacing Y))
+ (ly:stencil-translate-axis curr-stencil spacing Y))
(new-stencil (ly:stencil-add flag-stencil translated-stencil)))
(buildflags new-stencil (- remain 1) translated-stencil spacing))
flag-stencil))
(define (straight-flag-mrkp flag-thickness flag-spacing
- upflag-angle upflag-length
- downflag-angle downflag-length
- dir)
- ;; Create a stencil for a straight flag. @var{flag-thickness} and
- ;; @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
- ;; @var{downflag-angle} are given in degrees, and @var{upflag-length} and
- ;; @var{downflag-length} are given in staff spaces.
- ;;
- ;; All lengths are scaled according to the font size of the note.
- ;;
- ;; From /scm/flag-styles.scm, modified to fit here.
-
- (let* ((stem-up (> dir 0))
- ; scale with the note size
- (factor (magstep font-size))
- (stem-thickness (* factor 0.1))
- (line-thickness (ly:output-def-lookup layout 'line-thickness))
- (half-stem-thickness (/ (* stem-thickness line-thickness) 2))
- (raw-length (if stem-up upflag-length downflag-length))
- (angle (if stem-up upflag-angle downflag-angle))
- (flag-length (+ (* raw-length factor) half-stem-thickness))
- (flag-end (polar->rectangular flag-length angle))
- (thickness (* flag-thickness factor))
- (thickness-offset (cons 0 (* -1 thickness dir)))
- (spacing (* -1 flag-spacing factor dir))
- (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
- ; The points of a round-filled-polygon need to be given in
- ; clockwise order, otherwise the polygon will be enlarged by
- ; blot-size*2!
- (points (if stem-up (list start flag-end
- (offset-add flag-end thickness-offset)
- (offset-add start thickness-offset))
- (list start
- (offset-add start thickness-offset)
- (offset-add flag-end thickness-offset)
- flag-end)))
- (stencil (ly:round-filled-polygon points half-stem-thickness))
- ; Log for 1/8 is 3, so we need to subtract 3
- (flag-stencil (buildflags stencil (- log 3) stencil spacing)))
- flag-stencil))
+ upflag-angle upflag-length
+ downflag-angle downflag-length
+ dir)
+ ;; Create a stencil for a straight flag. @var{flag-thickness} and
+ ;; @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
+ ;; @var{downflag-angle} are given in degrees, and @var{upflag-length} and
+ ;; @var{downflag-length} are given in staff spaces.
+ ;;
+ ;; All lengths are scaled according to the font size of the note.
+ ;;
+ ;; From /scm/flag-styles.scm, modified to fit here.
+
+ (let* ((stem-up (> dir 0))
+ ; scale with the note size
+ (factor (magstep font-size))
+ (stem-thickness (* factor 0.1))
+ (line-thickness (ly:output-def-lookup layout 'line-thickness))
+ (half-stem-thickness (/ (* stem-thickness line-thickness) 2))
+ (raw-length (if stem-up upflag-length downflag-length))
+ (angle (if stem-up upflag-angle downflag-angle))
+ (flag-length (+ (* raw-length factor) half-stem-thickness))
+ (flag-end (polar->rectangular flag-length angle))
+ (thickness (* flag-thickness factor))
+ (thickness-offset (cons 0 (* -1 thickness dir)))
+ (spacing (* -1 flag-spacing factor dir))
+ (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
+ ; The points of a round-filled-polygon need to be given in
+ ; clockwise order, otherwise the polygon will be enlarged by
+ ; blot-size*2!
+ (points (if stem-up (list start flag-end
+ (offset-add flag-end thickness-offset)
+ (offset-add start thickness-offset))
+ (list start
+ (offset-add start thickness-offset)
+ (offset-add flag-end thickness-offset)
+ flag-end)))
+ (stencil (ly:round-filled-polygon points half-stem-thickness))
+ ; Log for 1/8 is 3, so we need to subtract 3
+ (flag-stencil (buildflags stencil (- log 3) stencil spacing)))
+ flag-stencil))
(let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
- props)))
+ props)))
(size-factor (magstep font-size))
(blot (ly:output-def-lookup layout 'blot-diameter))
(head-glyph-name
- (let ((result (get-glyph-name font
- (get-glyph-name-candidates
- (sign dir) log style))))
- (if (string-null? result)
- ;; If no glyph name can be found, select default heads.
- ;; Though this usually means an unsupported style has been
- ;; chosen, it also prevents unrelated 'style settings from
- ;; other grobs (e.g., TextSpanner and TimeSignature) leaking
- ;; into markup.
- (get-glyph-name font
- (get-glyph-name-candidates
- (sign dir) log 'default))
- result)))
+ (let ((result (get-glyph-name font
+ (get-glyph-name-candidates
+ (sign dir) log style))))
+ (if (string-null? result)
+ ;; If no glyph name can be found, select default heads.
+ ;; Though this usually means an unsupported style has been
+ ;; chosen, it also prevents unrelated 'style settings from
+ ;; other grobs (e.g., TextSpanner and TimeSignature) leaking
+ ;; into markup.
+ (get-glyph-name font
+ (get-glyph-name-candidates
+ (sign dir) log 'default))
+ result)))
(head-glyph (ly:font-get-glyph font head-glyph-name))
(ancient-flags? (or (eq? style 'mensural) (eq? style 'neomensural)))
(attach-indices (ly:note-head::stem-attachment font head-glyph-name))
@@ -3352,9 +3352,9 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and
(stem-thickness (* size-factor (if ancient-flags? 0.1 0.13)))
(stemy (* dir stem-length))
(attach-off (cons (interval-index
- (ly:stencil-extent head-glyph X)
- (* (sign dir) (car attach-indices)))
- ; fixme, this is inconsistent between X & Y.
+ (ly:stencil-extent head-glyph X)
+ (* (sign dir) (car attach-indices)))
+ ; fixme, this is inconsistent between X & Y.
(* (sign dir)
(interval-index
(ly:stencil-extent head-glyph Y)
@@ -3364,12 +3364,12 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and
(stem-X-corr (if ancient-flags? (* 0.5 dir stem-thickness) 0))
(stem-glyph (and (> log 0)
(ly:round-filled-box
- (ordered-cons (+ stem-X-corr (car attach-off))
- (+ stem-X-corr (car attach-off)
- (* (- (sign dir)) stem-thickness)))
- (cons (min stemy (cdr attach-off))
- (max stemy (cdr attach-off)))
- (/ stem-thickness 3))))
+ (ordered-cons (+ stem-X-corr (car attach-off))
+ (+ stem-X-corr (car attach-off)
+ (* (- (sign dir)) stem-thickness)))
+ (cons (min stemy (cdr attach-off))
+ (max stemy (cdr attach-off)))
+ (/ stem-thickness 3))))
(dot (ly:font-get-glyph font "dots.dot"))
(dotwid (interval-length (ly:stencil-extent dot X)))
(dots (and (> dot-count 0)
@@ -3389,34 +3389,34 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and
0))
(flaggl (and (> log 2)
(ly:stencil-translate
- (cond ((eq? flag-style 'modern-straight-flag)
- modern-straight-flag)
- ((eq? flag-style 'old-straight-flag)
- old-straight-flag)
- (else
- (ly:font-get-glyph font
- (format #f (if ancient-flags?
- "flags.mensural~a2~a"
- "flags.~a~a")
- (if (> dir 0) "u" "d")
- log))))
- (cons (+ (car attach-off)
- ;; For tighter stems (with ancient-flags) the
- ;; flag has to be adjusted different.
- (if (and (not ancient-flags?) (< dir 0))
- stem-thickness
- 0))
- (+ stemy flag-style-Y-corr))))))
+ (cond ((eq? flag-style 'modern-straight-flag)
+ modern-straight-flag)
+ ((eq? flag-style 'old-straight-flag)
+ old-straight-flag)
+ (else
+ (ly:font-get-glyph font
+ (format #f (if ancient-flags?
+ "flags.mensural~a2~a"
+ "flags.~a~a")
+ (if (> dir 0) "u" "d")
+ log))))
+ (cons (+ (car attach-off)
+ ;; For tighter stems (with ancient-flags) the
+ ;; flag has to be adjusted different.
+ (if (and (not ancient-flags?) (< dir 0))
+ stem-thickness
+ 0))
+ (+ stemy flag-style-Y-corr))))))
;; If there is a flag on an upstem and the stem is short, move the dots
;; to avoid the flag. 16th notes get a special case because their flags
;; hang lower than any other flags.
;; Not with ancient flags or straight-flags.
(if (and dots (> dir 0) (> log 2)
- (or (eq? flag-style 'default) (null? flag-style))
- (not ancient-flags?)
- (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
- (set! dots (ly:stencil-translate-axis dots 0.5 X)))
+ (or (eq? flag-style 'default) (null? flag-style))
+ (not ancient-flags?)
+ (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
+ (set! dots (ly:stencil-translate-axis dots 0.5 X)))
(if flaggl
(set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
(if (ly:stencil? stem-glyph)
@@ -3425,11 +3425,11 @@ Supported flag-styles are @code{default}, @code{old-straight-flag} and
(if (ly:stencil? dots)
(set! stem-glyph
(ly:stencil-add
- (ly:stencil-translate-axis
- dots
- (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
- X)
- stem-glyph)))
+ (ly:stencil-translate-axis
+ dots
+ (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
+ X)
+ stem-glyph)))
stem-glyph))
(define-public log2
@@ -3506,44 +3506,44 @@ A rest or multi-measure-rest symbol.
;; If no glyph exists, select others for the specified styles
;; otherwise defaulting.
(style-strg
- (cond (
+ (cond (
;; 'baroque needs to be special-cased, otherwise
;; `select-head-glyph´ would catch neomensural-glyphs for
;; this style, if (< log 0).
(eq? style 'baroque)
- (string-append (number->string log) ""))
- ((eq? style 'petrucci)
- (string-append (number->string log) "mensural"))
- ;; In other cases `select-head-glyph´ from output-lib.scm
- ;; works for rest-glyphs, too.
- ((and (symbol? style) (not (eq? style 'default)))
- (select-head-glyph style log))
- (else log)))
+ (string-append (number->string log) ""))
+ ((eq? style 'petrucci)
+ (string-append (number->string log) "mensural"))
+ ;; In other cases `select-head-glyph´ from output-lib.scm
+ ;; works for rest-glyphs, too.
+ ((and (symbol? style) (not (eq? style 'default)))
+ (select-head-glyph style log))
+ (else log)))
;; Choose ledgered glyphs for whole and half rest.
;; Except for the specified styles, logs and MultiMeasureRests.
(ledger-style-rests
- (if (and (or (list? style)
- (not (member style
- '(neomensural mensural petrucci))))
- (not multi-measure-rest)
- (or (= log 0) (= log 1)))
+ (if (and (or (list? style)
+ (not (member style
+ '(neomensural mensural petrucci))))
+ (not multi-measure-rest)
+ (or (= log 0) (= log 1)))
"o"
"")))
(format #f "rests.~a~a" style-strg ledger-style-rests)))
(define (get-glyph-name font cands)
- (if (ly:stencil-empty? (ly:font-get-glyph font cands))
+ (if (ly:stencil-empty? (ly:font-get-glyph font cands))
""
cands))
(let* ((font
- (ly:paper-get-font layout
- (cons '((font-encoding . fetaMusic)) props)))
+ (ly:paper-get-font layout
+ (cons '((font-encoding . fetaMusic)) props)))
(rest-glyph-name
- (let ((result
- (get-glyph-name font
- (get-glyph-name-candidates log style))))
- (if (string-null? result)
+ (let ((result
+ (get-glyph-name font
+ (get-glyph-name-candidates log style))))
+ (if (string-null? result)
;; If no glyph name can be found, select default rests. Though
;; this usually means an unsupported style has been chosen, it
;; also prevents unrelated 'style settings from other grobs
@@ -3567,7 +3567,7 @@ A rest or multi-measure-rest symbol.
(< log 2)
(>= log 0)
(not (member style '(neomensural mensural petrucci))))
- (set! dots (ly:stencil-translate-axis dots dot-width X)))
+ (set! dots (ly:stencil-translate-axis dots dot-width X)))
;; Add dots to the rest-glyph.
;;
@@ -3581,13 +3581,13 @@ A rest or multi-measure-rest symbol.
(set! rest-glyph
(ly:stencil-add
(ly:stencil-translate
- dots
- (cons
- (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width)
- (if (< log 2)
- (interval-center (ly:stencil-extent rest-glyph Y))
- (- (interval-end (ly:stencil-extent rest-glyph Y))
- (/ (* 2 dot-width) 3)))))
+ dots
+ (cons
+ (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width)
+ (if (< log 2)
+ (interval-center (ly:stencil-extent rest-glyph Y))
+ (- (interval-end (ly:stencil-extent rest-glyph Y))
+ (/ (* 2 dot-width) 3)))))
rest-glyph)))
rest-glyph))
@@ -3631,14 +3631,14 @@ Could be disabled with @code{\\override #'(multi-measure-rest-number . #f)}
;; Store them in a list.
;; example: (mmr-numbers 25) -> '(3 0 0 1)
(define (mmr-numbers nmbr)
- (let* ((8-bar-glyph (floor (/ nmbr 8)))
- (8-remainder (remainder nmbr 8))
- (4-bar-glyph (floor (/ 8-remainder 4)))
- (4-remainder (remainder nmbr 4))
- (2-bar-glyph (floor (/ 4-remainder 2)))
- (2-remainder (remainder 4-remainder 2))
- (1-bar-glyph (floor (/ 2-remainder 1))))
- (list 8-bar-glyph 4-bar-glyph 2-bar-glyph 1-bar-glyph)))
+ (let* ((8-bar-glyph (floor (/ nmbr 8)))
+ (8-remainder (remainder nmbr 8))
+ (4-bar-glyph (floor (/ 8-remainder 4)))
+ (4-remainder (remainder nmbr 4))
+ (2-bar-glyph (floor (/ 4-remainder 2)))
+ (2-remainder (remainder 4-remainder 2))
+ (1-bar-glyph (floor (/ 2-remainder 1))))
+ (list 8-bar-glyph 4-bar-glyph 2-bar-glyph 1-bar-glyph)))
;; Get the correct mmr-glyphs.
;; Store them in a list.
@@ -3646,93 +3646,93 @@ Could be disabled with @code{\\override #'(multi-measure-rest-number . #f)}
;; (get-mmr-glyphs '(1 0 1 0) '("rests.M3" "rests.M2" "rests.M1" "rests.0"))
;; -> ("rests.M3" "rests.M1")
(define (get-mmr-glyphs lst1 lst2)
- (define (helper l1 l2 l3)
- (if (null? l1)
- (reverse l3)
- (helper (cdr l1)
- (cdr l2)
- (append (make-list (car l1) (car l2)) l3))))
- (helper lst1 lst2 '()))
+ (define (helper l1 l2 l3)
+ (if (null? l1)
+ (reverse l3)
+ (helper (cdr l1)
+ (cdr l2)
+ (append (make-list (car l1) (car l2)) l3))))
+ (helper lst1 lst2 '()))
;; If duration is not valid, print a warning and return empty-stencil
(if (or (and (not (integer? (car (parse-simple-duration duration))))
(not multi-measure-rest))
(and (= (string-length (car (string-split duration #\. ))) 1)
(= (string->number (car (string-split duration #\. ))) 0)))
- (begin
- (ly:warning (_ "not a valid duration string: ~a - ignoring") duration)
- empty-stencil)
- (let* (
- ;; For simple rests:
- ;; Get a (log dots) list.
- (parsed (parse-simple-duration duration))
- ;; Create the rest-stencil
- (stil
+ (begin
+ (ly:warning (_ "not a valid duration string: ~a - ignoring") duration)
+ empty-stencil)
+ (let* (
+ ;; For simple rests:
+ ;; Get a (log dots) list.
+ (parsed (parse-simple-duration duration))
+ ;; Create the rest-stencil
+ (stil
(rest-by-number-markup layout props (car parsed) (cadr parsed)))
- ;; For MultiMeasureRests:
- ;; Get the duration-part of duration
- (dur-part-string (car (string-split duration #\. )))
- ;; Get the duration of MMR:
- ;; If not a number (eg. "maxima") calculate it.
- (mmr-duration
- (or (string->number dur-part-string) (expt 2 (abs (car parsed)))))
- ;; Get a list of the correct number of each mmr-glyph.
- (count-mmr-glyphs-list (mmr-numbers mmr-duration))
- ;; Create a list of mmr-stencils,
- ;; translating the glyph for a whole rest.
- (mmr-stils-list
+ ;; For MultiMeasureRests:
+ ;; Get the duration-part of duration
+ (dur-part-string (car (string-split duration #\. )))
+ ;; Get the duration of MMR:
+ ;; If not a number (eg. "maxima") calculate it.
+ (mmr-duration
+ (or (string->number dur-part-string) (expt 2 (abs (car parsed)))))
+ ;; Get a list of the correct number of each mmr-glyph.
+ (count-mmr-glyphs-list (mmr-numbers mmr-duration))
+ ;; Create a list of mmr-stencils,
+ ;; translating the glyph for a whole rest.
+ (mmr-stils-list
(map
- (lambda (x)
- (let ((single-mmr-stil
- (rest-by-number-markup layout props (* -1 x) 0)))
- (if (= x 0)
- (ly:stencil-translate-axis
- single-mmr-stil
- ;; Ugh, hard-coded, why 1?
- 1
- Y)
- single-mmr-stil)))
- (get-mmr-glyphs count-mmr-glyphs-list (reverse (iota 4)))))
- ;; Adjust the space between the mmr-glyphs,
- ;; if not default-glyphs are used.
- (word-space (if (member style
- '(neomensural mensural petrucci))
- (/ (* word-space 2) 3)
- word-space))
- ;; Create the final mmr-stencil
- ;; via `stack-stencil-line´ from /scm/markup.scm
- (mmr-stil (stack-stencil-line word-space mmr-stils-list)))
-
- ;; Print the number above a multi-measure-rest
- ;; Depends on duration, style and multi-measure-rest-number set #t
- (if (and multi-measure-rest
- multi-measure-rest-number
- (> mmr-duration 1)
- (not (member style '(neomensural mensural petrucci))))
- (let* ((mmr-stil-x-center
- (interval-center (ly:stencil-extent mmr-stil X)))
- (duration-markup
- (markup
- #:fontsize -2
- #:override '(font-encoding . fetaText)
- (number->string mmr-duration)))
- (mmr-number-stil
- (interpret-markup layout props duration-markup))
- (mmr-number-stil-x-center
- (interval-center (ly:stencil-extent mmr-number-stil X))))
-
- (set! mmr-stil (ly:stencil-combine-at-edge
- mmr-stil
- Y UP
- (ly:stencil-translate-axis
- mmr-number-stil
- (- mmr-stil-x-center mmr-number-stil-x-center)
- X)
- ;; Ugh, hardcoded
- 0.8))))
- (if multi-measure-rest
- mmr-stil
- stil))))
+ (lambda (x)
+ (let ((single-mmr-stil
+ (rest-by-number-markup layout props (* -1 x) 0)))
+ (if (= x 0)
+ (ly:stencil-translate-axis
+ single-mmr-stil
+ ;; Ugh, hard-coded, why 1?
+ 1
+ Y)
+ single-mmr-stil)))
+ (get-mmr-glyphs count-mmr-glyphs-list (reverse (iota 4)))))
+ ;; Adjust the space between the mmr-glyphs,
+ ;; if not default-glyphs are used.
+ (word-space (if (member style
+ '(neomensural mensural petrucci))
+ (/ (* word-space 2) 3)
+ word-space))
+ ;; Create the final mmr-stencil
+ ;; via `stack-stencil-line´ from /scm/markup.scm
+ (mmr-stil (stack-stencil-line word-space mmr-stils-list)))
+
+ ;; Print the number above a multi-measure-rest
+ ;; Depends on duration, style and multi-measure-rest-number set #t
+ (if (and multi-measure-rest
+ multi-measure-rest-number
+ (> mmr-duration 1)
+ (not (member style '(neomensural mensural petrucci))))
+ (let* ((mmr-stil-x-center
+ (interval-center (ly:stencil-extent mmr-stil X)))
+ (duration-markup
+ (markup
+ #:fontsize -2
+ #:override '(font-encoding . fetaText)
+ (number->string mmr-duration)))
+ (mmr-number-stil
+ (interpret-markup layout props duration-markup))
+ (mmr-number-stil-x-center
+ (interval-center (ly:stencil-extent mmr-number-stil X))))
+
+ (set! mmr-stil (ly:stencil-combine-at-edge
+ mmr-stil
+ Y UP
+ (ly:stencil-translate-axis
+ mmr-number-stil
+ (- mmr-stil-x-center mmr-number-stil-x-center)
+ X)
+ ;; Ugh, hardcoded
+ 0.8))))
+ (if multi-measure-rest
+ mmr-stil
+ stil))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; translating.
@@ -3756,7 +3756,7 @@ A negative @var{amount} indicates raising; see also @code{\\raise}.
}
@end lilypond"
(ly:stencil-translate-axis (interpret-markup layout props arg)
- (- amount) Y))
+ (- amount) Y))
(define-markup-command (translate-scaled layout props offset arg)
(number-pair? markup?)
@@ -3843,9 +3843,9 @@ Make a fraction of two markups.
;; should stack mols separately, to maintain LINE on baseline
(stack (stack-lines DOWN padding baseline (list m1 line m2))))
(set! stack
- (ly:stencil-aligned-to stack Y CENTER))
+ (ly:stencil-aligned-to stack Y CENTER))
(set! stack
- (ly:stencil-aligned-to stack X LEFT))
+ (ly:stencil-aligned-to stack X LEFT))
;; should have EX dimension
;; empirical anyway
(ly:stencil-translate-axis stack offset Y))))
@@ -3875,7 +3875,7 @@ Set @var{arg} in superscript with a normal font size.
(markup?)
#:category font
#:properties ((font-size 0)
- (baseline-skip))
+ (baseline-skip))
"
@cindex superscript text
@@ -3916,13 +3916,13 @@ is a pair of numbers representing the displacement in the X and Y axis.
}
@end lilypond"
(ly:stencil-translate (interpret-markup layout props arg)
- offset))
+ offset))
(define-markup-command (sub layout props arg)
(markup?)
#:category font
#:properties ((font-size 0)
- (baseline-skip))
+ (baseline-skip))
"
@cindex subscript text
@@ -4017,10 +4017,10 @@ Draw vertical brackets around @var{arg}.
(markup?)
#:category graphic
#:properties ((angularity 0)
- (padding)
- (size 1)
- (thickness 1)
- (width 0.25))
+ (padding)
+ (size 1)
+ (thickness 1)
+ (width 0.25))
"
@cindex placing parentheses around text
@@ -4048,14 +4048,14 @@ a column containing several lines of text.
}
@end lilypond"
(let* ((markup (interpret-markup layout props arg))
- (scaled-width (* size width))
- (scaled-thickness
- (* (chain-assoc-get 'line-thickness props 0.1)
- thickness))
- (half-thickness
- (min (* size 0.5 scaled-thickness)
- (* (/ 4 3.0) scaled-width)))
- (padding (chain-assoc-get 'padding props half-thickness)))
+ (scaled-width (* size width))
+ (scaled-thickness
+ (* (chain-assoc-get 'line-thickness props 0.1)
+ thickness))
+ (half-thickness
+ (min (* size 0.5 scaled-thickness)
+ (* (/ 4 3.0) scaled-width)))
+ (padding (chain-assoc-get 'padding props half-thickness)))
(parenthesize-stencil
markup half-thickness scaled-width angularity padding)))
@@ -4075,21 +4075,21 @@ page (using the @code{\\label} command), @var{gauge} a markup used to estimate
the maximum width of the page number, and @var{default} the value to display
when @var{label} is not found."
(let* ((gauge-stencil (interpret-markup layout props gauge))
- (x-ext (ly:stencil-extent gauge-stencil X))
- (y-ext (ly:stencil-extent gauge-stencil Y)))
+ (x-ext (ly:stencil-extent gauge-stencil X))
+ (y-ext (ly:stencil-extent gauge-stencil Y)))
(ly:make-stencil
`(delay-stencil-evaluation
,(delay (ly:stencil-expr
- (let* ((table (ly:output-def-lookup layout 'label-page-table))
- (page-number (if (list? table)
- (assoc-get label table)
- #f))
- (page-markup (if page-number (format #f "~a" page-number) default))
- (page-stencil (interpret-markup layout props page-markup))
- (gap (- (interval-length x-ext)
- (interval-length (ly:stencil-extent page-stencil X)))))
- (interpret-markup layout props
- (markup #:hspace gap page-markup))))))
+ (let* ((table (ly:output-def-lookup layout 'label-page-table))
+ (page-number (if (list? table)
+ (assoc-get label table)
+ #f))
+ (page-markup (if page-number (format #f "~a" page-number) default))
+ (page-stencil (interpret-markup layout props page-markup))
+ (gap (- (interval-length x-ext)
+ (interval-length (ly:stencil-extent page-stencil X)))))
+ (interpret-markup layout props
+ (markup #:hspace gap page-markup))))))
x-ext
y-ext)))
@@ -4119,8 +4119,8 @@ Negative values may be used to produce mirror images.
}
@end lilypond"
(let ((stil (interpret-markup layout props arg))
- (sx (car factor-pair))
- (sy (cdr factor-pair)))
+ (sx (car factor-pair))
+ (sy (cdr factor-pair)))
(ly:stencil-scale stil sx sy)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -4145,20 +4145,20 @@ Patterns are distributed on @var{axis}.
}
@end lilypond"
(let ((pattern-width (interval-length
- (ly:stencil-extent (interpret-markup layout props pattern) X)))
+ (ly:stencil-extent (interpret-markup layout props pattern) X)))
(new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
(let loop ((i (1- count)) (patterns (markup)))
(if (zero? i)
(interpret-markup
- layout
- new-props
- (if (= axis X)
- (markup patterns pattern)
- (markup #:column (patterns pattern))))
+ layout
+ new-props
+ (if (= axis X)
+ (markup patterns pattern)
+ (markup #:column (patterns pattern))))
(loop (1- i)
- (if (= axis X)
- (markup patterns pattern #:hspace space)
- (markup #:column (patterns pattern #:vspace space))))))))
+ (if (= axis X)
+ (markup patterns pattern #:hspace space)
+ (markup #:column (patterns pattern #:vspace space))))))))
(define-markup-command (fill-with-pattern layout props space dir pattern left right)
(number? ly:dir? markup? markup? markup?)
@@ -4230,29 +4230,29 @@ The @code{key} is the string to be replaced by the @code{value} string.
(define-public (space-lines baseline stils)
(let space-stil ((stils stils)
- (result (list)))
+ (result (list)))
(if (null? stils)
- (reverse! result)
- (let* ((stil (car stils))
- (dy-top (max (- (/ baseline 1.5)
- (interval-bound (ly:stencil-extent stil Y) UP))
- 0.0))
- (dy-bottom (max (+ (/ baseline 3.0)
- (interval-bound (ly:stencil-extent stil Y) DOWN))
- 0.0))
- (new-stil (ly:make-stencil
- (ly:stencil-expr stil)
- (ly:stencil-extent stil X)
- (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
- dy-bottom)
- (+ (interval-bound (ly:stencil-extent stil Y) UP)
- dy-top)))))
- (space-stil (cdr stils) (cons new-stil result))))))
+ (reverse! result)
+ (let* ((stil (car stils))
+ (dy-top (max (- (/ baseline 1.5)
+ (interval-bound (ly:stencil-extent stil Y) UP))
+ 0.0))
+ (dy-bottom (max (+ (/ baseline 3.0)
+ (interval-bound (ly:stencil-extent stil Y) DOWN))
+ 0.0))
+ (new-stil (ly:make-stencil
+ (ly:stencil-expr stil)
+ (ly:stencil-extent stil X)
+ (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
+ dy-bottom)
+ (+ (interval-bound (ly:stencil-extent stil Y) UP)
+ dy-top)))))
+ (space-stil (cdr stils) (cons new-stil result))))))
(define-markup-list-command (justified-lines layout props args)
(markup-list?)
#:properties ((baseline-skip)
- wordwrap-internal-markup-list)
+ wordwrap-internal-markup-list)
"
@cindex justifying lines of text
@@ -4266,7 +4266,7 @@ Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
(define-markup-list-command (wordwrap-lines layout props args)
(markup-list?)
#:properties ((baseline-skip)
- wordwrap-internal-markup-list)
+ wordwrap-internal-markup-list)
"Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
where @var{X} is the number of staff spaces."
@@ -4280,7 +4280,7 @@ where @var{X} is the number of staff spaces."
"Like @code{\\column}, but return a list of lines instead of a single markup.
@code{baseline-skip} determines the space between each markup in @var{args}."
(space-lines baseline-skip
- (interpret-markup-list layout props args)))
+ (interpret-markup-list layout props args)))
(define-markup-list-command (override-lines layout props new-prop args)
(pair? markup-list?)
diff --git a/scm/define-music-callbacks.scm b/scm/define-music-callbacks.scm
index 723ed130ec..42aaf58ace 100644
--- a/scm/define-music-callbacks.scm
+++ b/scm/define-music-callbacks.scm
@@ -1,7 +1,7 @@
;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
;;;; Copyright (C) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
-;;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Neil Puttock <n.puttock@gmail.com>
;;;; Carl Sorensen <c_sorensen@byu.edu>
;;;;
@@ -24,15 +24,15 @@
"Generate events for multimeasure rests,
to be used by the sequential-iterator"
(let ((location (ly:music-property music 'origin))
- (duration (ly:music-property music 'duration)))
+ (duration (ly:music-property music 'duration)))
(list (make-music 'BarCheck
- 'origin location)
- (make-event-chord (cons (make-music 'MultiMeasureRestEvent
- 'origin location
- 'duration duration)
- (ly:music-property music 'articulations)))
- (make-music 'BarCheck
- 'origin location))))
+ 'origin location)
+ (make-event-chord (cons (make-music 'MultiMeasureRestEvent
+ 'origin location
+ 'duration duration)
+ (ly:music-property music 'articulations)))
+ (make-music 'BarCheck
+ 'origin location))))
(define (make-volta-set music)
(let* ((alts (ly:music-property music 'elements))
@@ -40,25 +40,25 @@ to be used by the sequential-iterator"
(times (ly:music-property music 'repeat-count)))
(map (lambda (x y)
(make-music
- 'SequentialMusic
- 'elements
- ;; set properties for proper bar numbering
- (append
+ 'SequentialMusic
+ 'elements
+ ;; set properties for proper bar numbering
+ (append
+ (list (make-music 'AlternativeEvent
+ 'alternative-dir (if (= y 0)
+ -1
+ 0)
+ 'alternative-increment
+ (if (= 0 y)
+ (1+ (- times
+ lalts))
+ 1)))
+ (list x)
+ (if (= y (1- lalts))
(list (make-music 'AlternativeEvent
- 'alternative-dir (if (= y 0)
- -1
- 0)
- 'alternative-increment
- (if (= 0 y)
- (1+ (- times
- lalts))
- 1)))
- (list x)
- (if (= y (1- lalts))
- (list (make-music 'AlternativeEvent
- 'alternative-dir 1
- 'alternative-increment 0))
- '()))))
+ 'alternative-dir 1
+ 'alternative-increment 0))
+ '()))))
alts
(iota lalts))))
@@ -67,18 +67,18 @@ to be used by the sequential-iterator"
(let ((octavation (ly:music-property music 'ottava-number)))
(list (context-spec-music
- (make-apply-context
- (lambda (context)
- (let ((offset (* -7 octavation))
- (string (assoc-get octavation '((2 . "15ma")
- (1 . "8va")
- (0 . #f)
- (-1 . "8vb")
- (-2 . "15mb")))))
- (set! (ly:context-property context 'middleCOffset) offset)
- (set! (ly:context-property context 'ottavation) string)
- (ly:set-middle-C! context))))
- 'Staff))))
+ (make-apply-context
+ (lambda (context)
+ (let ((offset (* -7 octavation))
+ (string (assoc-get octavation '((2 . "15ma")
+ (1 . "8va")
+ (0 . #f)
+ (-1 . "8vb")
+ (-2 . "15mb")))))
+ (set! (ly:context-property context 'middleCOffset) offset)
+ (set! (ly:context-property context 'ottavation) string)
+ (ly:set-middle-C! context))))
+ 'Staff))))
(define (make-time-signature-set music)
"Set context properties for a time signature."
@@ -87,31 +87,31 @@ to be used by the sequential-iterator"
(structure (ly:music-property music 'beat-structure))
(fraction (cons num den)))
(list (descend-to-context
- (context-spec-music
- (make-apply-context
- (lambda (context)
- (let* ((time-signature-settings
- (ly:context-property context 'timeSignatureSettings))
- (my-base-length
- (base-length fraction time-signature-settings))
- (my-beat-structure
- (if (null? structure)
- (beat-structure my-base-length
- fraction
- time-signature-settings)
- structure))
- (beaming-exception
- (beam-exceptions fraction time-signature-settings))
- (new-measure-length (ly:make-moment num den)))
- (ly:context-set-property!
- context 'timeSignatureFraction fraction)
- (ly:context-set-property!
- context 'baseMoment (ly:make-moment my-base-length))
- (ly:context-set-property!
- context 'beatStructure my-beat-structure)
- (ly:context-set-property!
- context 'beamExceptions beaming-exception)
- (ly:context-set-property!
- context 'measureLength new-measure-length))))
- 'Timing)
- 'Score))))
+ (context-spec-music
+ (make-apply-context
+ (lambda (context)
+ (let* ((time-signature-settings
+ (ly:context-property context 'timeSignatureSettings))
+ (my-base-length
+ (base-length fraction time-signature-settings))
+ (my-beat-structure
+ (if (null? structure)
+ (beat-structure my-base-length
+ fraction
+ time-signature-settings)
+ structure))
+ (beaming-exception
+ (beam-exceptions fraction time-signature-settings))
+ (new-measure-length (ly:make-moment num den)))
+ (ly:context-set-property!
+ context 'timeSignatureFraction fraction)
+ (ly:context-set-property!
+ context 'baseMoment (ly:make-moment my-base-length))
+ (ly:context-set-property!
+ context 'beatStructure my-beat-structure)
+ (ly:context-set-property!
+ context 'beamExceptions beaming-exception)
+ (ly:context-set-property!
+ context 'measureLength new-measure-length))))
+ 'Timing)
+ 'Score))))
diff --git a/scm/define-music-display-methods.scm b/scm/define-music-display-methods.scm
index 82e227c8f5..6d9dc82506 100644
--- a/scm/define-music-display-methods.scm
+++ b/scm/define-music-display-methods.scm
@@ -18,21 +18,21 @@
(cond ((or (number? scm-arg)
(string? scm-arg)
(boolean? scm-arg))
- (format #f "~s" scm-arg))
- ((or (symbol? scm-arg)
- (list? scm-arg))
- (format #f "'~s" scm-arg))
- ((procedure? scm-arg)
- (format #f "~a"
- (or (procedure-name scm-arg)
- (with-output-to-string
- (lambda ()
- (pretty-print (procedure-source scm-arg)))))))
- (else
- (format #f "~a"
- (with-output-to-string
- (lambda ()
- (display-scheme-music scm-arg)))))))
+ (format #f "~s" scm-arg))
+ ((or (symbol? scm-arg)
+ (list? scm-arg))
+ (format #f "'~s" scm-arg))
+ ((procedure? scm-arg)
+ (format #f "~a"
+ (or (procedure-name scm-arg)
+ (with-output-to-string
+ (lambda ()
+ (pretty-print (procedure-source scm-arg)))))))
+ (else
+ (format #f "~a"
+ (with-output-to-string
+ (lambda ()
+ (display-scheme-music scm-arg)))))))
;;;
;;; Markups
;;;
@@ -43,33 +43,33 @@ expression."
(define (proc->command proc)
(let ((cmd-markup (symbol->string (procedure-name proc))))
(substring cmd-markup 0 (- (string-length cmd-markup)
- (string-length "-markup")))))
+ (string-length "-markup")))))
(define (arg->string arg)
(cond ((string? arg)
- (format #f "~s" arg))
- ((markup? arg) ;; a markup
- (markup->lily-string-aux arg))
- ((and (pair? arg) (every markup? arg)) ;; a markup list
- (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
- (else ;; a scheme argument
- (format #f "#~a" (scheme-expr->lily-string arg)))))
+ (format #f "~s" arg))
+ ((markup? arg) ;; a markup
+ (markup->lily-string-aux arg))
+ ((and (pair? arg) (every markup? arg)) ;; a markup list
+ (format #f "{~{ ~a~}}" (map-in-order markup->lily-string-aux arg)))
+ (else ;; a scheme argument
+ (format #f "#~a" (scheme-expr->lily-string arg)))))
(define (markup->lily-string-aux expr)
(if (string? expr)
- (format #f "~s" expr)
- (let ((cmd (car expr))
- (args (cdr expr)))
- (if (eqv? cmd simple-markup) ;; a simple markup
- (format #f "~s" (car args))
- (format #f "\\~a~{ ~a~}"
- (proc->command cmd)
- (map-in-order arg->string args))))))
+ (format #f "~s" expr)
+ (let ((cmd (car expr))
+ (args (cdr expr)))
+ (if (eqv? cmd simple-markup) ;; a simple markup
+ (format #f "~s" (car args))
+ (format #f "\\~a~{ ~a~}"
+ (proc->command cmd)
+ (map-in-order arg->string args))))))
(cond ((string? markup-expr)
- (format #f "~s" markup-expr))
- ((eqv? (car markup-expr) simple-markup)
- (format #f "~s" (second markup-expr)))
- (else
- (format #f "\\markup ~a"
- (markup->lily-string-aux markup-expr)))))
+ (format #f "~s" markup-expr))
+ ((eqv? (car markup-expr) simple-markup)
+ (format #f "~s" (second markup-expr)))
+ (else
+ (format #f "\\markup ~a"
+ (markup->lily-string-aux markup-expr)))))
;;;
;;; pitch names
@@ -81,49 +81,49 @@ expression."
(result #f result))
((or result (null? alist)) result)
(if (and (car alist) (test item (cdar alist)))
- (set! result (car alist)))))
+ (set! result (car alist)))))
(define-public (note-name->lily-string ly-pitch parser)
;; here we define a custom pitch= function, since we do not want to
;; test whether octaves are also equal. (otherwise, we would be using equal?)
(define (pitch= pitch1 pitch2)
(and (= (ly:pitch-notename pitch1) (ly:pitch-notename pitch2))
- (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
+ (= (ly:pitch-alteration pitch1) (ly:pitch-alteration pitch2))))
(let ((result (rassoc ly-pitch (ly:parser-lookup parser 'pitchnames) pitch=)))
(if result
- (car result)
- #f)))
+ (car result)
+ #f)))
(define-public (octave->lily-string pitch)
(let ((octave (ly:pitch-octave pitch)))
(cond ((>= octave 0)
- (make-string (1+ octave) #\'))
- ((< octave -1)
- (make-string (1- (* -1 octave)) #\,))
- (else ""))))
+ (make-string (1+ octave) #\'))
+ ((< octave -1)
+ (make-string (1- (* -1 octave)) #\,))
+ (else ""))))
;;;
;;; durations
;;;
(define*-public (duration->lily-string ly-duration #:key (prev-duration (*previous-duration*))
- (force-duration (*force-duration*))
- (time-scale (*time-scale*))
- remember)
+ (force-duration (*force-duration*))
+ (time-scale (*time-scale*))
+ remember)
(if remember (*previous-duration* ly-duration))
- (let ((log2 (ly:duration-log ly-duration))
- (dots (ly:duration-dot-count ly-duration))
- (scale (ly:duration-scale ly-duration)))
+ (let ((log2 (ly:duration-log ly-duration))
+ (dots (ly:duration-dot-count ly-duration))
+ (scale (ly:duration-scale ly-duration)))
(if (or force-duration (not prev-duration) (not (equal? ly-duration prev-duration)))
- (string-append (case log2
- ((-1) "\\breve")
- ((-2) "\\longa")
- ((-3) "\\maxima")
- (else (number->string (expt 2 log2))))
- (make-string dots #\.)
- (let ((end-scale (/ scale time-scale)))
- (if (= end-scale 1) ""
- (format #f "*~a" end-scale))))
- "")))
+ (string-append (case log2
+ ((-1) "\\breve")
+ ((-2) "\\longa")
+ ((-3) "\\maxima")
+ (else (number->string (expt 2 log2))))
+ (make-string dots #\.)
+ (let ((end-scale (/ scale time-scale)))
+ (if (= end-scale 1) ""
+ (format #f "*~a" end-scale))))
+ "")))
;;;
;;; post events
@@ -135,24 +135,24 @@ expression."
(define* (event-direction->lily-string event #:optional (required #t))
(let ((direction (ly:music-property event 'direction)))
(cond ((or (not direction) (null? direction) (= CENTER direction))
- (if required "-" ""))
- ((= UP direction) "^")
- ((= DOWN direction) "_")
- (else ""))))
+ (if required "-" ""))
+ ((= UP direction) "^")
+ ((= DOWN direction) "_")
+ (else ""))))
(define-macro (define-post-event-display-method type vars direction-required str)
`(define-display-method ,type ,vars
(format #f "~a~a"
- (event-direction->lily-string ,(car vars) ,direction-required)
- ,str)))
+ (event-direction->lily-string ,(car vars) ,direction-required)
+ ,str)))
(define-macro (define-span-event-display-method type vars direction-required str-start str-stop)
`(define-display-method ,type ,vars
(format #f "~a~a"
- (event-direction->lily-string ,(car vars) ,direction-required)
- (if (= START (ly:music-property ,(car vars) 'span-direction))
- ,str-start
- ,str-stop))))
+ (event-direction->lily-string ,(car vars) ,direction-required)
+ (if (= START (ly:music-property ,(car vars) 'span-direction))
+ ,str-start
+ ,str-stop))))
(define-display-method HyphenEvent (event parser)
" --")
@@ -169,25 +169,25 @@ expression."
(define-display-method TremoloEvent (event parser)
(let ((tremolo-type (ly:music-property event 'tremolo-type)))
(format #f ":~a" (if (= 0 tremolo-type)
- ""
- tremolo-type))))
+ ""
+ tremolo-type))))
(define-display-method ArticulationEvent (event parser) #t
(let* ((articulation (ly:music-property event 'articulation-type))
- (shorthand
- (case (string->symbol articulation)
- ((marcato) "^")
- ((stopped) "+")
- ((tenuto) "-")
- ((staccatissimo) "|")
- ((accent) ">")
- ((staccato) ".")
- ((portato) "_")
- (else #f))))
+ (shorthand
+ (case (string->symbol articulation)
+ ((marcato) "^")
+ ((stopped) "+")
+ ((tenuto) "-")
+ ((staccatissimo) "|")
+ ((accent) ">")
+ ((staccato) ".")
+ ((portato) "_")
+ (else #f))))
(format #f "~a~:[\\~;~]~a"
- (event-direction->lily-string event shorthand)
- shorthand
- (or shorthand articulation))))
+ (event-direction->lily-string event shorthand)
+ shorthand
+ (or shorthand articulation))))
(define-post-event-display-method FingeringEvent (event parser) #t
(ly:music-property event 'digit))
@@ -230,7 +230,7 @@ expression."
(define-display-method GraceMusic (expr parser)
(format #f "\\grace ~a"
- (music->lily-string (ly:music-property expr 'element) parser)))
+ (music->lily-string (ly:music-property expr 'element) parser)))
;; \acciaccatura \appoggiatura \grace
;; TODO: it would be better to compare ?start and ?stop
@@ -239,92 +239,92 @@ expression."
(define-extra-display-method GraceMusic (expr parser)
"Display method for appoggiatura."
(with-music-match (expr (music
- 'GraceMusic
- element (music
- 'SequentialMusic
- elements (?start
- ?music
- ?stop))))
- ;; we check whether ?start and ?stop look like
- ;; startAppoggiaturaMusic stopAppoggiaturaMusic
- (and (with-music-match (?start (music
- 'SequentialMusic
- elements ((music
- 'EventChord
- elements
- ((music
- 'SlurEvent
- span-direction START))))))
- #t)
- (with-music-match (?stop (music
- 'SequentialMusic
- elements ((music
- 'EventChord
- elements
- ((music
- 'SlurEvent
- span-direction STOP))))))
- (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
+ 'GraceMusic
+ element (music
+ 'SequentialMusic
+ elements (?start
+ ?music
+ ?stop))))
+ ;; we check whether ?start and ?stop look like
+ ;; startAppoggiaturaMusic stopAppoggiaturaMusic
+ (and (with-music-match (?start (music
+ 'SequentialMusic
+ elements ((music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction START))))))
+ #t)
+ (with-music-match (?stop (music
+ 'SequentialMusic
+ elements ((music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction STOP))))))
+ (format #f "\\appoggiatura ~a" (music->lily-string ?music parser))))))
(define-extra-display-method GraceMusic (expr parser)
"Display method for acciaccatura."
(with-music-match (expr (music
- 'GraceMusic
- element (music
- 'SequentialMusic
- elements (?start
- ?music
- ?stop))))
- ;; we check whether ?start and ?stop look like
- ;; startAcciaccaturaMusic stopAcciaccaturaMusic
- (and (with-music-match (?start (music
- 'SequentialMusic
- elements ((music
- 'EventChord
- elements
- ((music
- 'SlurEvent
- span-direction START)))
- (music
- 'ContextSpeccedMusic
- element (music
- 'OverrideProperty
- grob-property-path '(stroke-style)
- grob-value "grace"
- symbol 'Flag)))))
- #t)
- (with-music-match (?stop (music
- 'SequentialMusic
- elements ((music
- 'ContextSpeccedMusic
- element (music
- 'RevertProperty
- grob-property-path '(stroke-style)
- symbol 'Flag))
-
- (music
- 'EventChord
- elements
- ((music
- 'SlurEvent
- span-direction STOP))))))
- (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
+ 'GraceMusic
+ element (music
+ 'SequentialMusic
+ elements (?start
+ ?music
+ ?stop))))
+ ;; we check whether ?start and ?stop look like
+ ;; startAcciaccaturaMusic stopAcciaccaturaMusic
+ (and (with-music-match (?start (music
+ 'SequentialMusic
+ elements ((music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction START)))
+ (music
+ 'ContextSpeccedMusic
+ element (music
+ 'OverrideProperty
+ grob-property-path '(stroke-style)
+ grob-value "grace"
+ symbol 'Flag)))))
+ #t)
+ (with-music-match (?stop (music
+ 'SequentialMusic
+ elements ((music
+ 'ContextSpeccedMusic
+ element (music
+ 'RevertProperty
+ grob-property-path '(stroke-style)
+ symbol 'Flag))
+
+ (music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction STOP))))))
+ (format #f "\\acciaccatura ~a" (music->lily-string ?music parser))))))
(define-extra-display-method GraceMusic (expr parser)
"Display method for grace."
(with-music-match (expr (music
- 'GraceMusic
- element (music
- 'SequentialMusic
- elements (?start
- ?music
- ?stop))))
- ;; we check whether ?start and ?stop look like
- ;; startGraceMusic stopGraceMusic
- (and (null? (ly:music-property ?start 'elements))
- (null? (ly:music-property ?stop 'elements))
- (format #f "\\grace ~a" (music->lily-string ?music parser)))))
+ 'GraceMusic
+ element (music
+ 'SequentialMusic
+ elements (?start
+ ?music
+ ?stop))))
+ ;; we check whether ?start and ?stop look like
+ ;; startGraceMusic stopGraceMusic
+ (and (null? (ly:music-property ?start 'elements))
+ (null? (ly:music-property ?stop 'elements))
+ (format #f "\\grace ~a" (music->lily-string ?music parser)))))
;;;
;;; Music sequences
@@ -332,79 +332,79 @@ expression."
(define-display-method SequentialMusic (seq parser)
(let ((force-line-break (and (*force-line-break*)
- ;; hm
- (> (length (ly:music-property seq 'elements))
- (*max-element-number-before-break*))))
- (elements (ly:music-property seq 'elements))
- (chord? (make-music-type-predicate 'EventChord))
- (note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent
- 'LyricEvent 'RestEvent
- 'ClusterNoteEvent))
- (cluster? (make-music-type-predicate 'ClusterNoteEvent))
- (note? (make-music-type-predicate 'NoteEvent)))
+ ;; hm
+ (> (length (ly:music-property seq 'elements))
+ (*max-element-number-before-break*))))
+ (elements (ly:music-property seq 'elements))
+ (chord? (make-music-type-predicate 'EventChord))
+ (note-or-chord? (make-music-type-predicate 'EventChord 'NoteEvent
+ 'LyricEvent 'RestEvent
+ 'ClusterNoteEvent))
+ (cluster? (make-music-type-predicate 'ClusterNoteEvent))
+ (note? (make-music-type-predicate 'NoteEvent)))
(format #f "~a~a{~v%~v_~{~a~^ ~}~v%~v_}"
- (if (any (lambda (e)
- (or (cluster? e)
- (and (chord? e)
- (any cluster? (ly:music-property e 'elements)))))
- elements)
- "\\makeClusters "
- "")
- (if (*explicit-mode*)
- ;; if the sequence contains EventChord which contains figures ==> figuremode
- ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
- ;; if the sequence contains EventChord which contains drum notes ==> drummode
- (cond ((any (lambda (chord)
- (any (make-music-type-predicate 'BassFigureEvent)
- (ly:music-property chord 'elements)))
- (filter chord? elements))
- "\\figuremode ")
- ((any (lambda (chord)
- (any (make-music-type-predicate 'LyricEvent)
- (cons chord
- (ly:music-property chord 'elements))))
- (filter note-or-chord? elements))
- "\\lyricmode ")
- ((any (lambda (chord)
- (any (lambda (event)
- (and (note? event)
- (not (null? (ly:music-property event 'drum-type)))))
- (cons chord
- (ly:music-property chord 'elements))))
- (filter note-or-chord? elements))
- "\\drummode ")
- (else ;; TODO: other modes?
- ""))
- "")
- (if force-line-break 1 0)
- (if force-line-break (+ 2 (*indent*)) 1)
- (parameterize ((*indent* (+ 2 (*indent*))))
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- elements))
- (if force-line-break 1 0)
- (if force-line-break (*indent*) 1))))
+ (if (any (lambda (e)
+ (or (cluster? e)
+ (and (chord? e)
+ (any cluster? (ly:music-property e 'elements)))))
+ elements)
+ "\\makeClusters "
+ "")
+ (if (*explicit-mode*)
+ ;; if the sequence contains EventChord which contains figures ==> figuremode
+ ;; if the sequence contains EventChord which contains lyrics ==> lyricmode
+ ;; if the sequence contains EventChord which contains drum notes ==> drummode
+ (cond ((any (lambda (chord)
+ (any (make-music-type-predicate 'BassFigureEvent)
+ (ly:music-property chord 'elements)))
+ (filter chord? elements))
+ "\\figuremode ")
+ ((any (lambda (chord)
+ (any (make-music-type-predicate 'LyricEvent)
+ (cons chord
+ (ly:music-property chord 'elements))))
+ (filter note-or-chord? elements))
+ "\\lyricmode ")
+ ((any (lambda (chord)
+ (any (lambda (event)
+ (and (note? event)
+ (not (null? (ly:music-property event 'drum-type)))))
+ (cons chord
+ (ly:music-property chord 'elements))))
+ (filter note-or-chord? elements))
+ "\\drummode ")
+ (else ;; TODO: other modes?
+ ""))
+ "")
+ (if force-line-break 1 0)
+ (if force-line-break (+ 2 (*indent*)) 1)
+ (parameterize ((*indent* (+ 2 (*indent*))))
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ elements))
+ (if force-line-break 1 0)
+ (if force-line-break (*indent*) 1))))
(define-display-method SimultaneousMusic (sim parser)
(parameterize ((*indent* (+ 3 (*indent*))))
- (format #f "<< ~{~a ~}>>"
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- (ly:music-property sim 'elements)))))
+ (format #f "<< ~{~a ~}>>"
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ (ly:music-property sim 'elements)))))
(define-extra-display-method SimultaneousMusic (expr parser)
"If `sim' is an \afterGrace expression, return \"\\afterGrace ...\".
Otherwise, return #f."
;; TODO: do something with afterGraceFraction?
(with-music-match (expr (music 'SimultaneousMusic
- elements (?before-grace
- (music 'SequentialMusic
- elements ((music 'SkipMusic)
- (music 'GraceMusic
- element ?grace))))))
- (format #f "\\afterGrace ~a ~a"
- (music->lily-string ?before-grace parser)
- (music->lily-string ?grace parser))))
+ elements (?before-grace
+ (music 'SequentialMusic
+ elements ((music 'SkipMusic)
+ (music 'GraceMusic
+ element ?grace))))))
+ (format #f "\\afterGrace ~a ~a"
+ (music->lily-string ?before-grace parser)
+ (music->lily-string ?grace parser))))
;;;
;;; Chords
@@ -412,68 +412,68 @@ Otherwise, return #f."
(define-display-method EventChord (chord parser)
;; event_chord : command_element
- ;; | note_chord_element
+ ;; | note_chord_element
;; TODO : tagged post_events
;; post_events : ( post_event | tagged_post_event )*
;; tagged_post_event: '-' \tag embedded_scm post_event
(let* ((elements (append (ly:music-property chord 'elements)
- (ly:music-property chord 'articulations)))
- (chord-repeat (ly:music-property chord 'duration)))
+ (ly:music-property chord 'articulations)))
+ (chord-repeat (ly:music-property chord 'duration)))
(call-with-values
- (lambda ()
- (partition (lambda (m) (music-is-of-type? m 'rhythmic-event))
- elements))
+ (lambda ()
+ (partition (lambda (m) (music-is-of-type? m 'rhythmic-event))
+ elements))
(lambda (chord-elements other-elements)
- (cond ((pair? chord-elements)
- ;; note_chord_element :
- ;; '<' (notepitch | drumpitch)* '>" duration post_events
- (let ((duration (duration->lily-string (ly:music-property
- (car chord-elements)
- 'duration)
- #:remember #t)))
- ;; Format duration first so that it does not appear on
- ;; chord elements
- (format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}"
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- chord-elements)
- duration
- (map-in-order (lambda (music)
- (list
- (post-event? music)
- (music->lily-string music parser)))
- other-elements))))
- ((ly:duration? chord-repeat)
- (let ((duration (duration->lily-string chord-repeat
- #:remember #t)))
- (format #f "q~a~:{~:[-~;~]~a~^ ~}"
- duration
- (map-in-order (lambda (music)
- (list
- (post-event? music)
- (music->lily-string music parser)))
- other-elements))))
-
- ((and (= 1 (length other-elements))
- (not (post-event? (car other-elements))))
- (format #f (music->lily-string (car other-elements) parser)))
- (else
- (format #f "< >~:{~:[-~;~]~a~^ ~}"
- (map-in-order (lambda (music)
- (list
- (post-event? music)
- (music->lily-string music parser)))
- other-elements))))))))
+ (cond ((pair? chord-elements)
+ ;; note_chord_element :
+ ;; '<' (notepitch | drumpitch)* '>" duration post_events
+ (let ((duration (duration->lily-string (ly:music-property
+ (car chord-elements)
+ 'duration)
+ #:remember #t)))
+ ;; Format duration first so that it does not appear on
+ ;; chord elements
+ (format #f "< ~{~a ~}>~a~:{~:[-~;~]~a~^ ~}"
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ chord-elements)
+ duration
+ (map-in-order (lambda (music)
+ (list
+ (post-event? music)
+ (music->lily-string music parser)))
+ other-elements))))
+ ((ly:duration? chord-repeat)
+ (let ((duration (duration->lily-string chord-repeat
+ #:remember #t)))
+ (format #f "q~a~:{~:[-~;~]~a~^ ~}"
+ duration
+ (map-in-order (lambda (music)
+ (list
+ (post-event? music)
+ (music->lily-string music parser)))
+ other-elements))))
+
+ ((and (= 1 (length other-elements))
+ (not (post-event? (car other-elements))))
+ (format #f (music->lily-string (car other-elements) parser)))
+ (else
+ (format #f "< >~:{~:[-~;~]~a~^ ~}"
+ (map-in-order (lambda (music)
+ (list
+ (post-event? music)
+ (music->lily-string music parser)))
+ other-elements))))))))
(define-display-method MultiMeasureRestMusic (mmrest parser)
(format #f "R~a~{~a~^ ~}"
- (duration->lily-string (ly:music-property mmrest 'duration)
- #:remember #t)
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- (ly:music-property mmrest 'articulations))))
+ (duration->lily-string (ly:music-property mmrest 'duration)
+ #:remember #t)
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ (ly:music-property mmrest 'articulations))))
(define-display-method SkipMusic (skip parser)
(format #f "\\skip ~a" (duration->lily-string (ly:music-property skip 'duration) #:force-duration #t)))
@@ -487,47 +487,47 @@ Otherwise, return #f."
(define (simple-note->lily-string event parser)
(format #f "~a~a~a~a~a~a~:{~:[-~;~]~a~}" ; pitchname octave !? octave-check duration optional_rest articulations
- (note-name->lily-string (ly:music-property event 'pitch) parser)
- (octave->lily-string (ly:music-property event 'pitch))
- (let ((forced (ly:music-property event 'force-accidental))
- (cautionary (ly:music-property event 'cautionary)))
- (cond ((and (not (null? forced))
- forced
- (not (null? cautionary))
- cautionary)
- "?")
- ((and (not (null? forced)) forced) "!")
- (else "")))
- (let ((octave-check (ly:music-property event 'absolute-octave)))
- (if (not (null? octave-check))
- (format #f "=~a" (cond ((>= octave-check 0)
- (make-string (1+ octave-check) #\'))
- ((< octave-check -1)
- (make-string (1- (* -1 octave-check)) #\,))
- (else "")))
- ""))
- (duration->lily-string (ly:music-property event 'duration)
- #:remember #t)
- (if ((make-music-type-predicate 'RestEvent) event)
- "\\rest" "")
- (map-in-order (lambda (event)
- (list
- (post-event? event)
- (music->lily-string event parser)))
- (ly:music-property event 'articulations))))
+ (note-name->lily-string (ly:music-property event 'pitch) parser)
+ (octave->lily-string (ly:music-property event 'pitch))
+ (let ((forced (ly:music-property event 'force-accidental))
+ (cautionary (ly:music-property event 'cautionary)))
+ (cond ((and (not (null? forced))
+ forced
+ (not (null? cautionary))
+ cautionary)
+ "?")
+ ((and (not (null? forced)) forced) "!")
+ (else "")))
+ (let ((octave-check (ly:music-property event 'absolute-octave)))
+ (if (not (null? octave-check))
+ (format #f "=~a" (cond ((>= octave-check 0)
+ (make-string (1+ octave-check) #\'))
+ ((< octave-check -1)
+ (make-string (1- (* -1 octave-check)) #\,))
+ (else "")))
+ ""))
+ (duration->lily-string (ly:music-property event 'duration)
+ #:remember #t)
+ (if ((make-music-type-predicate 'RestEvent) event)
+ "\\rest" "")
+ (map-in-order (lambda (event)
+ (list
+ (post-event? event)
+ (music->lily-string event parser)))
+ (ly:music-property event 'articulations))))
(define-display-method NoteEvent (note parser)
(cond ((not (null? (ly:music-property note 'pitch))) ;; note
- (simple-note->lily-string note parser))
- ((not (null? (ly:music-property note 'drum-type))) ;; drum
- (format #f "~a~a~{~a~}" (ly:music-property note 'drum-type)
- (duration->lily-string (ly:music-property note 'duration)
- #:remember #t)
- (map-in-order (lambda (event)
- (music->lily-string event parser))
- (ly:music-property note 'articulations))))
- (else ;; unknown?
- "")))
+ (simple-note->lily-string note parser))
+ ((not (null? (ly:music-property note 'drum-type))) ;; drum
+ (format #f "~a~a~{~a~}" (ly:music-property note 'drum-type)
+ (duration->lily-string (ly:music-property note 'duration)
+ #:remember #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property note 'articulations))))
+ (else ;; unknown?
+ "")))
(define-display-method ClusterNoteEvent (note parser)
(simple-note->lily-string note parser))
@@ -536,23 +536,23 @@ Otherwise, return #f."
(if (not (null? (ly:music-property rest 'pitch)))
(simple-note->lily-string rest parser)
(format #f "r~a~{~a~}"
- (duration->lily-string (ly:music-property rest 'duration)
- #:remember #t)
- (map-in-order (lambda (event)
- (music->lily-string event parser))
- (ly:music-property rest 'articulations)))))
+ (duration->lily-string (ly:music-property rest 'duration)
+ #:remember #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property rest 'articulations)))))
(define-display-method MultiMeasureRestEvent (rest parser)
(string-append "R" (duration->lily-string (ly:music-property rest 'duration)
- #:remember #t)))
+ #:remember #t)))
(define-display-method SkipEvent (rest parser)
(format #f "s~a~{~a~}"
- (duration->lily-string (ly:music-property rest 'duration)
- #:remember #t)
- (map-in-order (lambda (event)
- (music->lily-string event parser))
- (ly:music-property rest 'articulations))))
+ (duration->lily-string (ly:music-property rest 'duration)
+ #:remember #t)
+ (map-in-order (lambda (event)
+ (music->lily-string event parser))
+ (ly:music-property rest 'articulations))))
(define-display-method RepeatedChord (chord parser)
(music->lily-string (ly:music-property chord 'element) parser))
@@ -560,32 +560,32 @@ Otherwise, return #f."
(define-display-method MarkEvent (mark parser)
(let ((label (ly:music-property mark 'label)))
(if (null? label)
- "\\mark \\default"
- (format #f "\\mark ~a" (markup->lily-string label)))))
+ "\\mark \\default"
+ (format #f "\\mark ~a" (markup->lily-string label)))))
(define-display-method KeyChangeEvent (key parser)
(let ((pitch-alist (ly:music-property key 'pitch-alist))
- (tonic (ly:music-property key 'tonic)))
+ (tonic (ly:music-property key 'tonic)))
(if (or (null? pitch-alist)
- (null? tonic))
- "\\key \\default"
- (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
- (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
- (format #f "\\key ~a \\~a~a"
- (note-name->lily-string (ly:music-property key 'tonic) parser)
- (any (lambda (mode)
- (if (and parser
- (equal? (ly:parser-lookup parser mode) c-pitch-alist))
- (symbol->string mode)
- #f))
- '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
- (new-line->lily-string))))))
+ (null? tonic))
+ "\\key \\default"
+ (let ((c-pitch-alist (ly:transpose-key-alist pitch-alist
+ (ly:pitch-diff (ly:make-pitch 0 0 0) tonic))))
+ (format #f "\\key ~a \\~a~a"
+ (note-name->lily-string (ly:music-property key 'tonic) parser)
+ (any (lambda (mode)
+ (if (and parser
+ (equal? (ly:parser-lookup parser mode) c-pitch-alist))
+ (symbol->string mode)
+ #f))
+ '(major minor ionian locrian aeolian mixolydian lydian phrygian dorian))
+ (new-line->lily-string))))))
(define-display-method RelativeOctaveCheck (octave parser)
(let ((pitch (ly:music-property octave 'pitch)))
(format #f "\\octaveCheck ~a~a"
- (note-name->lily-string pitch parser)
- (octave->lily-string pitch))))
+ (note-name->lily-string pitch parser)
+ (octave->lily-string pitch))))
(define-display-method VoiceSeparator (sep parser)
"\\\\")
@@ -603,42 +603,42 @@ Otherwise, return #f."
(define-display-method BassFigureEvent (figure parser)
(let ((alteration (ly:music-property figure 'alteration))
- (fig (ly:music-property figure 'figure))
- (bracket-start (ly:music-property figure 'bracket-start))
- (bracket-stop (ly:music-property figure 'bracket-stop)))
+ (fig (ly:music-property figure 'figure))
+ (bracket-start (ly:music-property figure 'bracket-start))
+ (bracket-stop (ly:music-property figure 'bracket-stop)))
(format #f "~a~a~a~a"
- (if (null? bracket-start) "" "[")
- (cond ((null? fig) "_")
- ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
- (else fig))
- (if (null? alteration)
- ""
- (cond
- ((= alteration DOUBLE-FLAT) "--")
- ((= alteration FLAT) "-")
- ((= alteration NATURAL) "!")
- ((= alteration SHARP) "+")
- ((= alteration DOUBLE-SHARP) "++")
- (else "")))
- (if (null? bracket-stop) "" "]"))))
+ (if (null? bracket-start) "" "[")
+ (cond ((null? fig) "_")
+ ((markup? fig) (second fig)) ;; fig: (<number-markup> "number")
+ (else fig))
+ (if (null? alteration)
+ ""
+ (cond
+ ((= alteration DOUBLE-FLAT) "--")
+ ((= alteration FLAT) "-")
+ ((= alteration NATURAL) "!")
+ ((= alteration SHARP) "+")
+ ((= alteration DOUBLE-SHARP) "++")
+ (else "")))
+ (if (null? bracket-stop) "" "]"))))
(define-display-method LyricEvent (lyric parser)
(format "~a~{~a~^ ~}"
- (let ((text (ly:music-property lyric 'text)))
- (if (or (string? text)
- (eqv? (first text) simple-markup))
- ;; a string or a simple markup
- (let ((string (if (string? text)
- text
- (second text))))
- (if (string-match "(\"| |[0-9])" string)
- ;; TODO check exactly in which cases double quotes should be used
- (format #f "~s" string)
- string))
- (markup->lily-string text)))
- (map-in-order (lambda (m) (music->lily-string m parser))
- (ly:music-property lyric 'articulations))))
+ (let ((text (ly:music-property lyric 'text)))
+ (if (or (string? text)
+ (eqv? (first text) simple-markup))
+ ;; a string or a simple markup
+ (let ((string (if (string? text)
+ text
+ (second text))))
+ (if (string-match "(\"| |[0-9])" string)
+ ;; TODO check exactly in which cases double quotes should be used
+ (format #f "~s" string)
+ string))
+ (markup->lily-string text)))
+ (map-in-order (lambda (m) (music->lily-string m parser))
+ (ly:music-property lyric 'articulations))))
(define-display-method BreathingEvent (event parser)
"\\breathe")
@@ -649,33 +649,33 @@ Otherwise, return #f."
(define-display-method AutoChangeMusic (m parser)
(format #f "\\autochange ~a"
- (music->lily-string (ly:music-property m 'element) parser)))
+ (music->lily-string (ly:music-property m 'element) parser)))
(define-display-method ContextChange (m parser)
(format #f "\\change ~a = \"~a\""
- (ly:music-property m 'change-to-type)
- (ly:music-property m 'change-to-id)))
+ (ly:music-property m 'change-to-type)
+ (ly:music-property m 'change-to-id)))
;;;
(define-display-method TimeScaledMusic (times parser)
(let* ((num (ly:music-property times 'numerator))
- (den (ly:music-property times 'denominator))
+ (den (ly:music-property times 'denominator))
(span (ly:music-property times 'duration #f))
;; need to format before changing time scale
(formatted-span
(and span (duration->lily-string span #:force-duration #t)))
- (scale (/ num den))
- (time-scale (*time-scale*)))
+ (scale (/ num den))
+ (time-scale (*time-scale*)))
(*previous-duration* #f)
(let ((result
(parameterize ((*force-line-break* #f)
(*time-scale* (* time-scale scale)))
- (format #f "\\tuplet ~a/~a ~@[~a ~]~a"
- den
- num
- formatted-span
- (music->lily-string (ly:music-property times 'element) parser)))))
+ (format #f "\\tuplet ~a/~a ~@[~a ~]~a"
+ den
+ num
+ formatted-span
+ (music->lily-string (ly:music-property times 'element) parser)))))
(*previous-duration* #f)
result)))
@@ -694,16 +694,16 @@ Otherwise, return #f."
(define (repeat->lily-string expr repeat-type parser)
(let* ((main (music->lily-string (ly:music-property expr 'element) parser)))
(format #f "\\repeat ~a ~a ~a ~a"
- repeat-type
- (ly:music-property expr 'repeat-count)
- main
- (let ((alternatives (ly:music-property expr 'elements)))
- (if (null? alternatives)
- ""
- (format #f "\\alternative { ~{~a ~}}"
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- alternatives)))))))
+ repeat-type
+ (ly:music-property expr 'repeat-count)
+ main
+ (let ((alternatives (ly:music-property expr 'elements)))
+ (if (null? alternatives)
+ ""
+ (format #f "\\alternative { ~{~a ~}}"
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ alternatives)))))))
(define-display-method VoltaRepeatedMusic (expr parser)
(repeat->lily-string expr "volta" parser))
@@ -716,28 +716,28 @@ Otherwise, return #f."
(define-display-method TremoloRepeatedMusic (expr parser)
(let* ((main (ly:music-property expr 'element))
- (children (if (music-is-of-type? main 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music main '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- (times (ly:music-property expr 'repeat-count))
-
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
- ;; times * children
- (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult)))))
+ (children (if (music-is-of-type? main 'sequential-music)
+ ;; \repeat tremolo n { ... }
+ (length (extract-named-music main '(EventChord
+ NoteEvent)))
+ ;; \repeat tremolo n c4
+ 1))
+ (times (ly:music-property expr 'repeat-count))
+
+ ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+ (dots (1- (logcount (* times children))))
+ ;; The remaining missing multiplicator to scale the notes by
+ ;; times * children
+ (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
+ (shift (- (ly:intlog2 (floor mult)))))
(set! main (ly:music-deep-copy main))
;; Adjust the time of the notes
(ly:music-compress main (ly:make-moment children 1))
;; Adjust the displayed note durations
(shift-duration-log main (- shift) (- dots))
(format #f "\\repeat tremolo ~a ~a"
- times
- (music->lily-string main parser))))
+ times
+ (music->lily-string main parser))))
;;;
;;; Contexts
@@ -745,131 +745,131 @@ Otherwise, return #f."
(define-display-method ContextSpeccedMusic (expr parser)
(let ((id (ly:music-property expr 'context-id))
- (create-new (ly:music-property expr 'create-new))
- (music (ly:music-property expr 'element))
- (operations (ly:music-property expr 'property-operations))
- (ctype (ly:music-property expr 'context-type)))
+ (create-new (ly:music-property expr 'create-new))
+ (music (ly:music-property expr 'element))
+ (operations (ly:music-property expr 'property-operations))
+ (ctype (ly:music-property expr 'context-type)))
(format #f "~a ~a~a~a ~a"
- (if (and (not (null? create-new)) create-new)
- "\\new"
- "\\context")
- ctype
- (if (null? id)
- ""
- (format #f " = ~s" id))
- (if (null? operations)
- ""
- (format #f " \\with {~{~a~}~%~v_}"
- (parameterize ((*indent* (+ (*indent*) 2)))
- (map (lambda (op)
- (format #f "~%~v_\\~a ~s"
- (*indent*)
- (first op)
- (second op)))
- operations))
- (*indent*)))
- (parameterize ((*current-context* ctype))
- (music->lily-string music parser)))))
+ (if (and (not (null? create-new)) create-new)
+ "\\new"
+ "\\context")
+ ctype
+ (if (null? id)
+ ""
+ (format #f " = ~s" id))
+ (if (null? operations)
+ ""
+ (format #f " \\with {~{~a~}~%~v_}"
+ (parameterize ((*indent* (+ (*indent*) 2)))
+ (map (lambda (op)
+ (format #f "~%~v_\\~a ~s"
+ (*indent*)
+ (first op)
+ (second op)))
+ operations))
+ (*indent*)))
+ (parameterize ((*current-context* ctype))
+ (music->lily-string music parser)))))
;; special cases: \figures \lyrics \drums
(define-extra-display-method ContextSpeccedMusic (expr parser)
(with-music-match (expr (music 'ContextSpeccedMusic
- create-new #t
- property-operations ?op
- context-type ?context-type
- element ?sequence))
- (if (null? ?op)
- (parameterize ((*explicit-mode* #f))
- (case ?context-type
- ((FiguredBass)
- (format #f "\\figures ~a" (music->lily-string ?sequence parser)))
- ((Lyrics)
- (format #f "\\lyrics ~a" (music->lily-string ?sequence parser)))
- ((DrumStaff)
- (format #f "\\drums ~a" (music->lily-string ?sequence parser)))
- (else
- #f)))
- #f)))
+ create-new #t
+ property-operations ?op
+ context-type ?context-type
+ element ?sequence))
+ (if (null? ?op)
+ (parameterize ((*explicit-mode* #f))
+ (case ?context-type
+ ((FiguredBass)
+ (format #f "\\figures ~a" (music->lily-string ?sequence parser)))
+ ((Lyrics)
+ (format #f "\\lyrics ~a" (music->lily-string ?sequence parser)))
+ ((DrumStaff)
+ (format #f "\\drums ~a" (music->lily-string ?sequence parser)))
+ (else
+ #f)))
+ #f)))
;;; Context properties
(define-extra-display-method ContextSpeccedMusic (expr parser)
(let ((element (ly:music-property expr 'element))
- (property-tuning? (make-music-type-predicate 'PropertySet
- 'PropertyUnset
- 'OverrideProperty
- 'RevertProperty))
- (sequence? (make-music-type-predicate 'SequentialMusic)))
+ (property-tuning? (make-music-type-predicate 'PropertySet
+ 'PropertyUnset
+ 'OverrideProperty
+ 'RevertProperty))
+ (sequence? (make-music-type-predicate 'SequentialMusic)))
(if (and (ly:music? element)
- (or (property-tuning? element)
- (and (sequence? element)
- (every property-tuning? (ly:music-property element 'elements)))))
- (parameterize ((*current-context* (ly:music-property expr 'context-type)))
- (music->lily-string element parser))
- #f)))
+ (or (property-tuning? element)
+ (and (sequence? element)
+ (every property-tuning? (ly:music-property element 'elements)))))
+ (parameterize ((*current-context* (ly:music-property expr 'context-type)))
+ (music->lily-string element parser))
+ #f)))
(define (property-value->lily-string arg parser)
(cond ((ly:music? arg)
- (music->lily-string arg parser))
- ((string? arg)
- (format #f "#~s" arg))
- ((markup? arg)
- (markup->lily-string arg))
- (else
- (format #f "#~a" (scheme-expr->lily-string arg)))))
+ (music->lily-string arg parser))
+ ((string? arg)
+ (format #f "#~s" arg))
+ ((markup? arg)
+ (markup->lily-string arg))
+ (else
+ (format #f "#~a" (scheme-expr->lily-string arg)))))
(define-display-method PropertySet (expr parser)
(let ((property (ly:music-property expr 'symbol))
- (value (ly:music-property expr 'value))
- (once (ly:music-property expr 'once)))
+ (value (ly:music-property expr 'value))
+ (once (ly:music-property expr 'once)))
(format #f "~a\\set ~a~a = ~a~a"
- (if (and (not (null? once)))
- "\\once "
- "")
- (if (eqv? (*current-context*) 'Bottom)
- ""
- (format #f "~a . " (*current-context*)))
- property
- (property-value->lily-string value parser)
- (new-line->lily-string))))
+ (if (and (not (null? once)))
+ "\\once "
+ "")
+ (if (eqv? (*current-context*) 'Bottom)
+ ""
+ (format #f "~a . " (*current-context*)))
+ property
+ (property-value->lily-string value parser)
+ (new-line->lily-string))))
(define-display-method PropertyUnset (expr parser)
(format #f "\\unset ~a~a~a"
- (if (eqv? (*current-context*) 'Bottom)
- ""
- (format #f "~a . " (*current-context*)))
- (ly:music-property expr 'symbol)
- (new-line->lily-string)))
+ (if (eqv? (*current-context*) 'Bottom)
+ ""
+ (format #f "~a . " (*current-context*)))
+ (ly:music-property expr 'symbol)
+ (new-line->lily-string)))
;;; Layout properties
(define-display-method OverrideProperty (expr parser)
- (let* ((symbol (ly:music-property expr 'symbol))
- (properties (ly:music-property expr 'grob-property-path
- (list (ly:music-property expr 'grob-property))))
- (value (ly:music-property expr 'grob-value))
- (once (ly:music-property expr 'once)))
+ (let* ((symbol (ly:music-property expr 'symbol))
+ (properties (ly:music-property expr 'grob-property-path
+ (list (ly:music-property expr 'grob-property))))
+ (value (ly:music-property expr 'grob-value))
+ (once (ly:music-property expr 'once)))
(format #f "~a\\override ~{~a~^.~} = ~a~a"
- (if (or (null? once)
- (not once))
- ""
- "\\once ")
+ (if (or (null? once)
+ (not once))
+ ""
+ "\\once ")
(if (eqv? (*current-context*) 'Bottom)
(cons symbol properties)
(cons* (*current-context*) symbol properties))
(property-value->lily-string value parser)
- (new-line->lily-string))))
+ (new-line->lily-string))))
(define-display-method RevertProperty (expr parser)
(let* ((symbol (ly:music-property expr 'symbol))
(properties (ly:music-property expr 'grob-property-path
- (list (ly:music-property expr 'grob-property)))))
+ (list (ly:music-property expr 'grob-property)))))
(format #f "\\revert ~{~a~^.~}~a"
(if (eqv? (*current-context*) 'Bottom)
(cons symbol properties)
(cons* (*current-context*) symbol properties))
- (new-line->lily-string))))
+ (new-line->lily-string))))
(define-display-method TimeSignatureMusic (expr parser)
(let* ((num (ly:music-property expr 'numerator))
@@ -881,7 +881,7 @@ Otherwise, return #f."
num den
(new-line->lily-string))
(format #f
- "\\time #'~a ~a/~a~a"
+ "\\time #'~a ~a/~a~a"
structure num den
(new-line->lily-string)))))
@@ -889,43 +889,43 @@ Otherwise, return #f."
(define-extra-display-method ContextSpeccedMusic (expr parser)
"If expr is a melisma, return \"\\melisma\", otherwise, return #f."
(with-music-match (expr (music 'ContextSpeccedMusic
- element (music 'PropertySet
- value #t
- symbol 'melismaBusy)))
- "\\melisma"))
+ element (music 'PropertySet
+ value #t
+ symbol 'melismaBusy)))
+ "\\melisma"))
(define-extra-display-method ContextSpeccedMusic (expr parser)
"If expr is a melisma end, return \"\\melismaEnd\", otherwise, return #f."
(with-music-match (expr (music 'ContextSpeccedMusic
- element (music 'PropertyUnset
- symbol 'melismaBusy)))
- "\\melismaEnd"))
+ element (music 'PropertyUnset
+ symbol 'melismaBusy)))
+ "\\melismaEnd"))
;;; \tempo
(define-extra-display-method SequentialMusic (expr parser)
(with-music-match (expr (music 'SequentialMusic
- elements ((music 'TempoChangeEvent
- text ?text
- tempo-unit ?unit
- metronome-count ?count)
- (music 'ContextSpeccedMusic
- element (music 'PropertySet
- symbol 'tempoWholesPerMinute)))))
- (format #f "\\tempo ~{~a~a~}~a = ~a~a"
- (if (markup? ?text)
- (list (markup->lily-string ?text) " ")
- '())
- (duration->lily-string ?unit #:force-duration #t)
- (if (pair? ?count)
- (format #f "~a ~~ ~a" (car ?count) (cdr ?count))
- ?count)
- (new-line->lily-string))))
+ elements ((music 'TempoChangeEvent
+ text ?text
+ tempo-unit ?unit
+ metronome-count ?count)
+ (music 'ContextSpeccedMusic
+ element (music 'PropertySet
+ symbol 'tempoWholesPerMinute)))))
+ (format #f "\\tempo ~{~a~a~}~a = ~a~a"
+ (if (markup? ?text)
+ (list (markup->lily-string ?text) " ")
+ '())
+ (duration->lily-string ?unit #:force-duration #t)
+ (if (pair? ?count)
+ (format #f "~a ~~ ~a" (car ?count) (cdr ?count))
+ ?count)
+ (new-line->lily-string))))
(define-display-method TempoChangeEvent (expr parser)
(let ((text (ly:music-property expr 'text)))
(format #f "\\tempo ~a~a"
- (markup->lily-string text)
- (new-line->lily-string))))
+ (markup->lily-string text)
+ (new-line->lily-string))))
;;; \clef
(define clef-name-alist #f)
@@ -942,107 +942,107 @@ Otherwise, return #f."
"If @var{expr} is a clef change, return \"\\clef ...\".
Otherwise, return @code{#f}."
(with-music-match (expr (music 'ContextSpeccedMusic
- context-type 'Staff
- element (music 'SequentialMusic
- elements ((music 'PropertySet
- value ?clef-glyph
- symbol 'clefGlyph)
- (music 'PropertySet
- symbol 'middleCClefPosition)
- (music 'PropertySet
- value ?clef-position
- symbol 'clefPosition)
- (music 'PropertySet
- value ?clef-transposition
- symbol 'clefTransposition)
- (music 'ApplyContext
- procedure ly:set-middle-C!)))))
- (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
- clef-name-alist)))
- (if clef-name
- (format #f "\\clef \"~a~{~a~a~}\"~a"
- clef-name
- (cond ((= 0 ?clef-transposition)
- (list "" ""))
- ((> ?clef-transposition 0)
- (list "^" (1+ ?clef-transposition)))
- (else
- (list "_" (- 1 ?clef-transposition))))
- (new-line->lily-string))
- #f))))
+ context-type 'Staff
+ element (music 'SequentialMusic
+ elements ((music 'PropertySet
+ value ?clef-glyph
+ symbol 'clefGlyph)
+ (music 'PropertySet
+ symbol 'middleCClefPosition)
+ (music 'PropertySet
+ value ?clef-position
+ symbol 'clefPosition)
+ (music 'PropertySet
+ value ?clef-transposition
+ symbol 'clefTransposition)
+ (music 'ApplyContext
+ procedure ly:set-middle-C!)))))
+ (let ((clef-name (assoc-get (list ?clef-glyph ?clef-position 0)
+ clef-name-alist)))
+ (if clef-name
+ (format #f "\\clef \"~a~{~a~a~}\"~a"
+ clef-name
+ (cond ((= 0 ?clef-transposition)
+ (list "" ""))
+ ((> ?clef-transposition 0)
+ (list "^" (1+ ?clef-transposition)))
+ (else
+ (list "_" (- 1 ?clef-transposition))))
+ (new-line->lily-string))
+ #f))))
;;; \bar
(define-extra-display-method ContextSpeccedMusic (expr parser)
"If `expr' is a bar, return \"\\bar ...\".
Otherwise, return #f."
(with-music-match (expr (music 'ContextSpeccedMusic
- context-type 'Timing
- element (music 'PropertySet
- value ?bar-type
- symbol 'whichBar)))
- (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
+ context-type 'Timing
+ element (music 'PropertySet
+ value ?bar-type
+ symbol 'whichBar)))
+ (format #f "\\bar \"~a\"~a" ?bar-type (new-line->lily-string))))
;;; \partial
(define-extra-display-method ContextSpeccedMusic (expr parser)
"If `expr' is a partial measure, return \"\\partial ...\".
Otherwise, return #f."
(with-music-match (expr (music
- 'ContextSpeccedMusic
- element (music
- 'ContextSpeccedMusic
- context-type 'Timing
- element (music
- 'PartialSet
- partial-duration ?duration))))
-
- (and ?duration
- (format #f "\\partial ~a"
- (duration->lily-string ?duration #:force-duration #t)))))
+ 'ContextSpeccedMusic
+ element (music
+ 'ContextSpeccedMusic
+ context-type 'Timing
+ element (music
+ 'PartialSet
+ partial-duration ?duration))))
+
+ (and ?duration
+ (format #f "\\partial ~a"
+ (duration->lily-string ?duration #:force-duration #t)))))
;;;
;;;
(define-display-method ApplyOutputEvent (applyoutput parser)
(let ((proc (ly:music-property applyoutput 'procedure))
- (ctx (ly:music-property applyoutput 'context-type)))
+ (ctx (ly:music-property applyoutput 'context-type)))
(format #f "\\applyOutput #'~a #~a"
- ctx
- (or (procedure-name proc)
- (with-output-to-string
- (lambda ()
- (pretty-print (procedure-source proc))))))))
+ ctx
+ (or (procedure-name proc)
+ (with-output-to-string
+ (lambda ()
+ (pretty-print (procedure-source proc))))))))
(define-display-method ApplyContext (applycontext parser)
(let ((proc (ly:music-property applycontext 'procedure)))
(format #f "\\applyContext #~a"
- (or (procedure-name proc)
- (with-output-to-string
- (lambda ()
- (pretty-print (procedure-source proc))))))))
+ (or (procedure-name proc)
+ (with-output-to-string
+ (lambda ()
+ (pretty-print (procedure-source proc))))))))
;;; \partcombine
(define-display-method PartCombineMusic (expr parser)
(format #f "\\partcombine ~{~a ~}"
- (map-in-order (lambda (music)
- (music->lily-string music parser))
- (ly:music-property expr 'elements))))
+ (map-in-order (lambda (music)
+ (music->lily-string music parser))
+ (ly:music-property expr 'elements))))
(define-extra-display-method PartCombineMusic (expr parser)
(with-music-match (expr (music 'PartCombineMusic
- elements ((music 'UnrelativableMusic
- element (music 'ContextSpeccedMusic
- context-id "one"
- context-type 'Voice
- element ?sequence1))
- (music 'UnrelativableMusic
- element (music 'ContextSpeccedMusic
- context-id "two"
- context-type 'Voice
- element ?sequence2)))))
- (format #f "\\partcombine ~a~a~a"
- (music->lily-string ?sequence1 parser)
- (new-line->lily-string)
- (music->lily-string ?sequence2 parser))))
+ elements ((music 'UnrelativableMusic
+ element (music 'ContextSpeccedMusic
+ context-id "one"
+ context-type 'Voice
+ element ?sequence1))
+ (music 'UnrelativableMusic
+ element (music 'ContextSpeccedMusic
+ context-id "two"
+ context-type 'Voice
+ element ?sequence2)))))
+ (format #f "\\partcombine ~a~a~a"
+ (music->lily-string ?sequence1 parser)
+ (new-line->lily-string)
+ (music->lily-string ?sequence2 parser))))
(define-display-method UnrelativableMusic (expr parser)
(music->lily-string (ly:music-property expr 'element) parser))
@@ -1050,19 +1050,19 @@ Otherwise, return #f."
;;; Cue notes
(define-display-method QuoteMusic (expr parser)
(or (with-music-match (expr (music
- 'QuoteMusic
- quoted-voice-direction ?quoted-voice-direction
- quoted-music-name ?quoted-music-name
- quoted-context-id "cue"
- quoted-context-type 'Voice
- element ?music))
- (format #f "\\cueDuring #~s #~a ~a"
- ?quoted-music-name
- ?quoted-voice-direction
- (music->lily-string ?music parser)))
+ 'QuoteMusic
+ quoted-voice-direction ?quoted-voice-direction
+ quoted-music-name ?quoted-music-name
+ quoted-context-id "cue"
+ quoted-context-type 'Voice
+ element ?music))
+ (format #f "\\cueDuring #~s #~a ~a"
+ ?quoted-music-name
+ ?quoted-voice-direction
+ (music->lily-string ?music parser)))
(format #f "\\quoteDuring #~s ~a"
- (ly:music-property expr 'quoted-music-name)
- (music->lily-string (ly:music-property expr 'element) parser))))
+ (ly:music-property expr 'quoted-music-name)
+ (music->lily-string (ly:music-property expr 'element) parser))))
;;;
;;; Breaks
@@ -1084,21 +1084,21 @@ Otherwise, return #f."
(define-extra-display-method EventChord (expr parser)
(with-music-match (expr (music 'EventChord
- elements ((music 'LineBreakEvent
- break-permission 'force)
- (music 'PageBreakEvent
- break-permission 'force))))
- "\\pageBreak"))
+ elements ((music 'LineBreakEvent
+ break-permission 'force)
+ (music 'PageBreakEvent
+ break-permission 'force))))
+ "\\pageBreak"))
(define-extra-display-method EventChord (expr parser)
(with-music-match (expr (music 'EventChord
- elements ((music 'LineBreakEvent
- break-permission 'force)
- (music 'PageBreakEvent
- break-permission 'force)
- (music 'PageTurnEvent
- break-permission 'force))))
- "\\pageTurn"))
+ elements ((music 'LineBreakEvent
+ break-permission 'force)
+ (music 'PageBreakEvent
+ break-permission 'force)
+ (music 'PageTurnEvent
+ break-permission 'force))))
+ "\\pageTurn"))
;;;
;;; Lyrics
@@ -1107,30 +1107,30 @@ Otherwise, return #f."
;;; \lyricsto
(define-display-method LyricCombineMusic (expr parser)
(format #f "\\lyricsto ~s ~a"
- (ly:music-property expr 'associated-context)
- (parameterize ((*explicit-mode* #f))
- (music->lily-string (ly:music-property expr 'element) parser))))
+ (ly:music-property expr 'associated-context)
+ (parameterize ((*explicit-mode* #f))
+ (music->lily-string (ly:music-property expr 'element) parser))))
;; \addlyrics
(define-extra-display-method SimultaneousMusic (expr parser)
(with-music-match (expr (music 'SimultaneousMusic
- elements ((music 'ContextSpeccedMusic
- context-id ?id
- context-type 'Voice
- element ?note-sequence)
- (music 'ContextSpeccedMusic
- context-type 'Lyrics
- create-new #t
- element (music 'LyricCombineMusic
- associated-context ?associated-id
- element ?lyric-sequence)))))
- (if (string=? ?id ?associated-id)
- (format #f "~a~a \\addlyrics ~a"
- (music->lily-string ?note-sequence parser)
- (new-line->lily-string)
- (parameterize ((*explicit-mode* #f))
- (music->lily-string ?lyric-sequence parser)))
- #f)))
+ elements ((music 'ContextSpeccedMusic
+ context-id ?id
+ context-type 'Voice
+ element ?note-sequence)
+ (music 'ContextSpeccedMusic
+ context-type 'Lyrics
+ create-new #t
+ element (music 'LyricCombineMusic
+ associated-context ?associated-id
+ element ?lyric-sequence)))))
+ (if (string=? ?id ?associated-id)
+ (format #f "~a~a \\addlyrics ~a"
+ (music->lily-string ?note-sequence parser)
+ (new-line->lily-string)
+ (parameterize ((*explicit-mode* #f))
+ (music->lily-string ?lyric-sequence parser)))
+ #f)))
;; Silence internal event sent at end of each lyrics block
(define-display-method CompletizeExtenderEvent (expr parser)
diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm
index dbad0cf092..c796323c67 100644
--- a/scm/define-music-properties.scm
+++ b/scm/define-music-properties.scm
@@ -28,7 +28,7 @@
(lambda (x) (apply music-property-description x))
`(
(absolute-octave ,integer?
- "The absolute octave for a octave check note.")
+ "The absolute octave for a octave check note.")
(alteration ,number? "Alteration for figured bass.")
(alternative-dir ,ly:dir? "Indicates if an AlternativeMusic is the
First (-1), Middle (0), or Last (1) of group of alternate endings.")
@@ -38,7 +38,7 @@ lettering should be incremented.")
TODO: Consider making type into symbol.")
(articulations ,ly:music-list?
- "Articulation events specifically for this note.")
+ "Articulation events specifically for this note.")
(associated-context ,string? "Name of the Voice context associated with
this @code{\\lyricsto} section.")
(augmented ,boolean? "This figure is for an augmented figured bass
@@ -58,7 +58,7 @@ TODO: Use SpanEvents?")
(bracket-stop ,boolean? "Stop a bracket here.")
(break-penalty ,number? "Penalty for line break hint.")
(break-permission ,symbol?
- "Whether to allow, forbid or force a line break.")
+ "Whether to allow, forbid or force a line break.")
(cautionary ,boolean? "If set, this alteration needs a
cautionary accidental.")
@@ -89,7 +89,7 @@ simultaneous music, or the alternatives of repeated music.")
(elements-callback ,procedure? "Return a list of children, for use by
a sequential iterator. Takes a single music parameter.")
(error-found ,boolean?
- "If true, a parsing error was found in this expression.")
+ "If true, a parsing error was found in this expression.")
(events ,list? "A list of events contained in this event.")
(figure ,integer? "A bass figure.")
@@ -220,8 +220,8 @@ repeat element list.")
FIXME: Naming.")
(X-offset ,number?
- "Offset of resulting grob; only used for balloon texts.")
+ "Offset of resulting grob; only used for balloon texts.")
- (Y-offset ,number?
- "Offset of resulting grob; only used for balloon texts.")
- )))
+(Y-offset ,number?
+ "Offset of resulting grob; only used for balloon texts.")
+)))
diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm
index e9c06e77d5..5cc5907fbc 100644
--- a/scm/define-music-types.scm
+++ b/scm/define-music-types.scm
@@ -1,7 +1,7 @@
;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
;;;; Copyright (C) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
-;;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; 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
@@ -29,25 +29,25 @@
Syntax: @var{note}@code{\\x}, where @code{\\x} is a dynamic mark like
@code{\\ppp} or @code{\\sfz}. A complete list is in file
@file{ly/@/dynamic-scripts-init.ly}.")
- (types . (general-music post-event event dynamic-event absolute-dynamic-event))
- ))
+ (types . (general-music post-event event dynamic-event absolute-dynamic-event))
+ ))
(AlternativeEvent
. ((description . "Create a alternative event.")
(types . (general-music event alternative-event))
- ))
+ ))
(AnnotateOutputEvent
. ((description . "Print an annotation of an output element.")
- (types . (general-music event annotate-output-event post-event))
- ))
+ (types . (general-music event annotate-output-event post-event))
+ ))
(ApplyContext
. ((description . "Call the argument with the current context during
interpreting phase.")
- (types . (general-music apply-context))
- (iterator-ctor . ,ly:apply-context-iterator::constructor)
- ))
+ (types . (general-music apply-context))
+ (iterator-ctor . ,ly:apply-context-iterator::constructor)
+ ))
(ApplyOutputEvent
. ((description . "Call the argument with all current grobs during
@@ -57,15 +57,15 @@ Syntax: @code{\\applyOutput #'@var{context} @var{func}}
Arguments to @var{func} are 1.@tie{}the grob, 2.@tie{}the originating
context, and 3.@tie{}the context where @var{func} is called.")
- (types . (general-music event apply-output-event))
- ))
+ (types . (general-music event apply-output-event))
+ ))
(ArpeggioEvent
. ((description . "Make an arpeggio on this note.
Syntax: @w{@var{note}@code{-\\arpeggio}}")
- (types . (general-music post-event arpeggio-event event))
- ))
+ (types . (general-music post-event arpeggio-event event))
+ ))
;; todo: use articulation-event for slur as well.
;; separate non articulation scripts
@@ -77,90 +77,90 @@ Syntax: @var{note}@code{x}@code{y}, where @code{x} is a direction\
\n(no direction specified), and where @code{y} is an articulation\
\n(such as @w{@code{-.}}, @w{@code{->}}, @code{\\tenuto}, @code{\\downbow}).
See the Notation Reference for details.")
- (types . (general-music post-event event articulation-event script-event))
- ))
+ (types . (general-music post-event event articulation-event script-event))
+ ))
(AutoChangeMusic
. ((description . "Used for making voices that switch between
piano staves automatically.")
- (iterator-ctor . ,ly:auto-change-iterator::constructor)
- (start-callback . ,ly:music-wrapper::start-callback)
- (length-callback . ,ly:music-wrapper::length-callback)
- (types . (general-music music-wrapper-music auto-change-instruction))
- ))
+ (iterator-ctor . ,ly:auto-change-iterator::constructor)
+ (start-callback . ,ly:music-wrapper::start-callback)
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (types . (general-music music-wrapper-music auto-change-instruction))
+ ))
(BarCheck
. ((description . "Check whether this music coincides with
the start of the measure.")
- (types . (general-music bar-check))
- (iterator-ctor . ,ly:bar-check-iterator::constructor)
- ))
+ (types . (general-music bar-check))
+ (iterator-ctor . ,ly:bar-check-iterator::constructor)
+ ))
(BassFigureEvent
. ((description . "Print a bass-figure text.")
- (types . (general-music event rhythmic-event bass-figure-event))
- ))
+ (types . (general-music event rhythmic-event bass-figure-event))
+ ))
(BeamEvent
. ((description . "Start or stop a beam.
Syntax for manual control: @code{c8-[ c c-] c8}")
- (types . (general-music post-event event beam-event span-event))
- ))
+ (types . (general-music post-event event beam-event span-event))
+ ))
(BeamForbidEvent
. ((description . "Specify that a note may not auto-beamed.")
- (types . (general-music post-event event beam-forbid-event))
- ))
+ (types . (general-music post-event event beam-forbid-event))
+ ))
(BreakDynamicSpanEvent
. ((description . "End an alignment spanner for dynamics here.")
- (types . (general-music post-event break-span-event break-dynamic-span-event event))
- ))
+ (types . (general-music post-event break-span-event break-dynamic-span-event event))
+ ))
(BendAfterEvent
. ((description . "A drop/@/fall/@/doit jazz articulation.")
- (types . (general-music post-event bend-after-event event))))
+ (types . (general-music post-event bend-after-event event))))
(BreathingEvent
. ((description . "Create a @q{breath mark} or @q{comma}.
Syntax: @var{note}@code{\\breathe}")
- (types . (general-music event breathing-event))
- ))
+ (types . (general-music event breathing-event))
+ ))
(ClusterNoteEvent
. ((description . "A note that is part of a cluster.")
- ;; not a note-event, to ensure that Note_heads_engraver doesn't eat it.
- (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
- (types . (general-music cluster-note-event melodic-event
- rhythmic-event event))
- ))
+ ;; not a note-event, to ensure that Note_heads_engraver doesn't eat it.
+ (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
+ (types . (general-music cluster-note-event melodic-event
+ rhythmic-event event))
+ ))
(CompletizeExtenderEvent
. ((description . "Used internally to signal the end of a lyrics block to
ensure extenders are completed correctly when a @code{Lyrics} context ends
before its associated @code{Voice} context.")
- (types . (general-music completize-extender-event event))
- ))
+ (types . (general-music completize-extender-event event))
+ ))
(ContextChange
. ((description . "Change staves in Piano staff.
Syntax: @code{\\change Staff = @var{new-id}}")
- (iterator-ctor . ,ly:change-iterator::constructor)
- (types . (general-music translator-change-instruction))
- ))
+ (iterator-ctor . ,ly:change-iterator::constructor)
+ (types . (general-music translator-change-instruction))
+ ))
(ContextSpeccedMusic
. ((description . "Interpret the argument music within a
specific context.")
- (iterator-ctor . ,ly:context-specced-music-iterator::constructor)
- (length-callback . ,ly:music-wrapper::length-callback)
- (start-callback . ,ly:music-wrapper::start-callback)
- (types . (context-specification general-music music-wrapper-music))
- ))
+ (iterator-ctor . ,ly:context-specced-music-iterator::constructor)
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (start-callback . ,ly:music-wrapper::start-callback)
+ (types . (context-specification general-music music-wrapper-music))
+ ))
(CrescendoEvent
. ((description . "Begin or end a crescendo.
@@ -169,9 +169,9 @@ Syntax: @var{note}@code{\\<} @dots{} @var{note}@code{\\!}
An alternative syntax is @var{note}@code{\\cr} @dots{}
@var{note}@code{\\endcr}.")
- (types . (general-music post-event span-event span-dynamic-event crescendo-event
- event))
- ))
+ (types . (general-music post-event span-event span-dynamic-event crescendo-event
+ event))
+ ))
(DecrescendoEvent
. ((description . "Begin or end a decrescendo.
@@ -180,24 +180,24 @@ Syntax: @var{note}@code{\\>} @dots{} @var{note}@code{\\!}
An alternative syntax is @var{note}@code{\\decr} @dots{}
@var{note}@code{\\enddecr}.")
- (types . (general-music post-event span-event span-dynamic-event decrescendo-event
- event))
- ))
+ (types . (general-music post-event span-event span-dynamic-event decrescendo-event
+ event))
+ ))
(DoublePercentEvent
. ((description . "Used internally to signal double percent repeats.")
- (types . (general-music event double-percent-event rhythmic-event))
- ))
+ (types . (general-music event double-percent-event rhythmic-event))
+ ))
(EpisemaEvent
. ((description . "Begin or end an episema.")
- (types . (general-music post-event span-event event episema-event))
- ))
+ (types . (general-music post-event span-event event episema-event))
+ ))
(Event
. ((description . "Atomic music event.")
- (types . (general-music event))
- ))
+ (types . (general-music event))
+ ))
(EventChord
. ((description . "Explicitly entered chords.
@@ -209,96 +209,96 @@ attached by the parser just follow any rhythmic events in
An unexpanded chord repetition @samp{q} is recognizable by having its
duration stored in @code{duration}.")
- (iterator-ctor . ,ly:event-chord-iterator::constructor)
- (length-callback . ,ly:music-sequence::event-chord-length-callback)
- (to-relative-callback .
- ,ly:music-sequence::event-chord-relative-callback)
- (types . (general-music event-chord simultaneous-music))
- ))
+ (iterator-ctor . ,ly:event-chord-iterator::constructor)
+ (length-callback . ,ly:music-sequence::event-chord-length-callback)
+ (to-relative-callback .
+ ,ly:music-sequence::event-chord-relative-callback)
+ (types . (general-music event-chord simultaneous-music))
+ ))
(ExtenderEvent
. ((description . "Extend lyrics.")
- (types . (general-music post-event extender-event event))
- ))
+ (types . (general-music post-event extender-event event))
+ ))
(FingeringEvent
. ((description . "Specify what finger to use for this note.")
- (types . (general-music post-event fingering-event event))
- ))
+ (types . (general-music post-event fingering-event event))
+ ))
(FootnoteEvent
. ((description . "Footnote a grob.")
- (types . (general-music event footnote-event))
- ))
+ (types . (general-music event footnote-event))
+ ))
(GlissandoEvent
. ((description . "Start a glissando on this note.")
- (types . (general-music post-event glissando-event event))
- ))
+ (types . (general-music post-event glissando-event event))
+ ))
(GraceMusic
. ((description . "Interpret the argument as grace notes.")
- (start-callback . ,ly:grace-music::start-callback)
- (length . ,ZERO-MOMENT)
- (iterator-ctor . ,ly:grace-iterator::constructor)
- (types . (grace-music music-wrapper-music general-music))
- ))
+ (start-callback . ,ly:grace-music::start-callback)
+ (length . ,ZERO-MOMENT)
+ (iterator-ctor . ,ly:grace-iterator::constructor)
+ (types . (grace-music music-wrapper-music general-music))
+ ))
(HarmonicEvent
. ((description . "Mark a note as harmonic.")
- (types . (general-music post-event event harmonic-event))
- ))
+ (types . (general-music post-event event harmonic-event))
+ ))
(HyphenEvent
. ((description . "A hyphen between lyric syllables.")
- (types . (general-music post-event hyphen-event event))
- ))
+ (types . (general-music post-event hyphen-event event))
+ ))
(KeyChangeEvent
. ((description . "Change the key signature.
Syntax: @code{\\key} @var{name} @var{scale}")
- (to-relative-callback . ,(lambda (x p) p))
- (types . (general-music key-change-event event))
- ))
+ (to-relative-callback . ,(lambda (x p) p))
+ (types . (general-music key-change-event event))
+ ))
(LabelEvent
. ((description . "Place a bookmarking label.")
- (types . (general-music label-event event))
- ))
+ (types . (general-music label-event event))
+ ))
(LaissezVibrerEvent
. ((description . "Don't damp this chord.
Syntax: @var{note}@code{\\laissezVibrer}")
- (types . (general-music post-event event laissez-vibrer-event))
- ))
+ (types . (general-music post-event event laissez-vibrer-event))
+ ))
(LigatureEvent
. ((description . "Start or end a ligature.")
- (types . (general-music span-event ligature-event event))
- ))
+ (types . (general-music span-event ligature-event event))
+ ))
(LineBreakEvent
. ((description . "Allow, forbid or force a line break.")
- (types . (general-music line-break-event break-event event))
- ))
+ (types . (general-music line-break-event break-event event))
+ ))
(LyricCombineMusic
. ((description . "Align lyrics to the start of notes.
Syntax: @code{\\lyricsto} @var{voicename} @var{lyrics}")
- (length . ,ZERO-MOMENT)
- (types . (general-music lyric-combine-music))
- (iterator-ctor . ,ly:lyric-combine-music-iterator::constructor)
- ))
+ (length . ,ZERO-MOMENT)
+ (types . (general-music lyric-combine-music))
+ (iterator-ctor . ,ly:lyric-combine-music-iterator::constructor)
+ ))
(LyricEvent
. ((description . "A lyric syllable. Must be entered in lyrics mode,
i.e., @code{\\lyrics @{ twinkle4 twinkle4 @} }.")
- (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
- (types . (general-music rhythmic-event lyric-event event))
- ))
+ (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
+ (types . (general-music rhythmic-event lyric-event event))
+ ))
(MarkEvent
. ((description . "Insert a rehearsal mark.
@@ -306,8 +306,8 @@ i.e., @code{\\lyrics @{ twinkle4 twinkle4 @} }.")
Syntax: @code{\\mark} @var{marker}
Example: @code{\\mark \"A\"}")
- (types . (general-music mark-event event))
- ))
+ (types . (general-music mark-event event))
+ ))
(MeasureCounterEvent
. ((description . "Used to signal the start and end of a measure count.")
@@ -317,18 +317,18 @@ Example: @code{\\mark \"A\"}")
(MultiMeasureRestEvent
. ((description . "Used internally by @code{MultiMeasureRestMusic}
to signal rests.")
- (types . (general-music event rhythmic-event
- multi-measure-rest-event))
- ))
+ (types . (general-music event rhythmic-event
+ multi-measure-rest-event))
+ ))
(MultiMeasureRestMusic
. ((description . "Rests that may be compressed into Multi rests.
Syntax: @code{R2.*4} for 4 measures in 3/4 time.")
- (iterator-ctor . ,ly:sequential-iterator::constructor)
- (elements-callback . ,mm-rest-child-list)
- (types . (general-music multi-measure-rest))
- ))
+ (iterator-ctor . ,ly:sequential-iterator::constructor)
+ (elements-callback . ,mm-rest-child-list)
+ (types . (general-music multi-measure-rest))
+ ))
(MultiMeasureTextEvent
. ((description . "Texts on multi measure rests.
@@ -336,13 +336,13 @@ Syntax: @code{R2.*4} for 4 measures in 3/4 time.")
Syntax: @code{R-\\markup @{ \\roman \"bla\" @}}
Note the explicit font switch.")
- (types . (general-music post-event event multi-measure-text-event))
- ))
+ (types . (general-music post-event event multi-measure-text-event))
+ ))
(Music
. ((description . "Generic type for music expressions.")
- (types . (general-music))
- ))
+ (types . (general-music))
+ ))
(NoteEvent
. ((description . "A note.
@@ -351,91 +351,91 @@ Outside of chords, any events in @code{articulations} with a listener
are broadcast like chord articulations, the others are retained.
For iteration inside of chords, @xref{EventChord}.")
- (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
- (types . (general-music event note-event rhythmic-event
- melodic-event))
- ))
+ (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
+ (types . (general-music event note-event rhythmic-event
+ melodic-event))
+ ))
(NoteGroupingEvent
. ((description . "Start or stop grouping brackets.")
- (types . (general-music post-event event note-grouping-event))
- ))
+ (types . (general-music post-event event note-grouping-event))
+ ))
(OttavaMusic
. ((description . "Start or stop an ottava bracket.")
- (iterator-ctor . ,ly:sequential-iterator::constructor)
- (elements-callback . ,make-ottava-set)
- (types . (general-music ottava-music))
- ))
+ (iterator-ctor . ,ly:sequential-iterator::constructor)
+ (elements-callback . ,make-ottava-set)
+ (types . (general-music ottava-music))
+ ))
(OverrideProperty
. ((description . "Extend the definition of a graphical object.
Syntax: @code{\\override} [ @var{context} @code{.} ]
@var{object} @var{property} @code{=} @var{value}")
- (types . (general-music layout-instruction-event
- override-property-event))
- (iterator-ctor . ,ly:push-property-iterator::constructor)
- (untransposable . #t)
- ))
+ (types . (general-music layout-instruction-event
+ override-property-event))
+ (iterator-ctor . ,ly:push-property-iterator::constructor)
+ (untransposable . #t)
+ ))
(PageBreakEvent
. ((description . "Allow, forbid or force a page break.")
- (types . (general-music break-event page-break-event event))
- ))
+ (types . (general-music break-event page-break-event event))
+ ))
(PageTurnEvent
. ((description . "Allow, forbid or force a page turn.")
- (types . (general-music break-event page-turn-event event))
- ))
+ (types . (general-music break-event page-turn-event event))
+ ))
(PartCombineForceEvent
. ((description . "Override the part-combiner's strategy.")
- (types . (general-music part-combine-force-event event))
- ))
+ (types . (general-music part-combine-force-event event))
+ ))
(PartialSet
. ((description . "Create an anacrusis or upbeat (partial measure).")
- (iterator-ctor . ,ly:partial-iterator::constructor)
- (types . (general-music partial-set))
+ (iterator-ctor . ,ly:partial-iterator::constructor)
+ (types . (general-music partial-set))
))
(PartCombineMusic
. ((description . "Combine two parts on a staff, either merged or
as separate voices.")
- (length-callback . ,ly:music-sequence::maximum-length-callback)
- (start-callback . ,ly:music-sequence::minimum-start-callback)
- (types . (general-music part-combine-music))
- (iterator-ctor . ,ly:part-combine-iterator::constructor)
- ))
+ (length-callback . ,ly:music-sequence::maximum-length-callback)
+ (start-callback . ,ly:music-sequence::minimum-start-callback)
+ (types . (general-music part-combine-music))
+ (iterator-ctor . ,ly:part-combine-iterator::constructor)
+ ))
(PercentEvent
. ((description . "Used internally to signal percent repeats.")
- (types . (general-music event percent-event rhythmic-event))
- ))
+ (types . (general-music event percent-event rhythmic-event))
+ ))
(PercentRepeatedMusic
. ((description . "Repeats encoded by percents and slashes.")
- (iterator-ctor . ,ly:percent-repeat-iterator::constructor)
- (start-callback . ,ly:repeated-music::first-start)
- (length-callback . ,ly:repeated-music::unfolded-music-length)
- (types . (general-music repeated-music percent-repeated-music))
- ))
+ (iterator-ctor . ,ly:percent-repeat-iterator::constructor)
+ (start-callback . ,ly:repeated-music::first-start)
+ (length-callback . ,ly:repeated-music::unfolded-music-length)
+ (types . (general-music repeated-music percent-repeated-music))
+ ))
(PesOrFlexaEvent
. ((description . "Within a ligature, mark the previous and the
following note to form a pes (if melody goes up) or a flexa (if melody
goes down).")
- (types . (general-music pes-or-flexa-event event))
- ))
+ (types . (general-music pes-or-flexa-event event))
+ ))
(PhrasingSlurEvent
. ((description . "Start or end phrasing slur.
Syntax: @var{note}@code{\\(} and @var{note}@code{\\)}")
(spanner-id . "")
- (types . (general-music post-event span-event event phrasing-slur-event))
- ))
+ (types . (general-music post-event span-event event phrasing-slur-event))
+ ))
(PostEvents
. ((description . "Container for several postevents.
@@ -447,212 +447,212 @@ This can be used to package several events into a single one. Should not be see
. ((description . "Set a context property.
Syntax: @code{\\set @var{context}.@var{prop} = @var{scheme-val}}")
- (types . (layout-instruction-event general-music))
- (iterator-ctor . ,ly:property-iterator::constructor)
- (untransposable . #t)
- ))
+ (types . (layout-instruction-event general-music))
+ (iterator-ctor . ,ly:property-iterator::constructor)
+ (untransposable . #t)
+ ))
(PropertyUnset
. ((description . "Restore the default setting for a context
property. See @ref{PropertySet}.
Syntax: @code{\\unset @var{context}.@var{prop}}")
- (types . (layout-instruction-event general-music))
- (iterator-ctor . ,ly:property-unset-iterator::constructor)
- ))
+ (types . (layout-instruction-event general-music))
+ (iterator-ctor . ,ly:property-unset-iterator::constructor)
+ ))
(QuoteMusic
. ((description . "Quote preprocessed snippets of music.")
- (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
- (length-callback . ,ly:music-wrapper::length-callback)
- (start-callback . ,ly:music-wrapper::start-callback)
- (types . (general-music music-wrapper-music))
- ))
+ (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (start-callback . ,ly:music-wrapper::start-callback)
+ (types . (general-music music-wrapper-music))
+ ))
(RelativeOctaveCheck
. ((description . "Check if a pitch is in the correct octave.")
- (to-relative-callback . ,ly:relative-octave-check::relative-callback)
- (types . (general-music relative-octave-check))
- ))
+ (to-relative-callback . ,ly:relative-octave-check::relative-callback)
+ (types . (general-music relative-octave-check))
+ ))
(RelativeOctaveMusic
. ((description . "Music that was entered in relative octave notation.")
- (to-relative-callback . ,ly:relative-octave-music::relative-callback)
- (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
- (length-callback . ,ly:music-wrapper::length-callback)
- (start-callback . ,ly:music-wrapper::start-callback)
- (types . (music-wrapper-music general-music relative-octave-music))
- ))
+ (to-relative-callback . ,ly:relative-octave-music::relative-callback)
+ (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (start-callback . ,ly:music-wrapper::start-callback)
+ (types . (music-wrapper-music general-music relative-octave-music))
+ ))
(RepeatedMusic
. ((description . "Repeat music in different ways.")
- (types . (general-music repeated-music))
- ))
+ (types . (general-music repeated-music))
+ ))
(RepeatSlashEvent
. ((description . "Used internally to signal beat repeats.")
- (types . (general-music event repeat-slash-event rhythmic-event))
- ))
+ (types . (general-music event repeat-slash-event rhythmic-event))
+ ))
(RepeatTieEvent
. ((description . "Ties for starting a second volta bracket.")
- (types . (general-music post-event event repeat-tie-event))
- ))
+ (types . (general-music post-event event repeat-tie-event))
+ ))
(RestEvent
. ((description . "A Rest.
Syntax: @code{r4} for a quarter rest.")
- (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
- (types . (general-music event rhythmic-event rest-event))
- ))
+ (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
+ (types . (general-music event rhythmic-event rest-event))
+ ))
(RevertProperty
. ((description . "The opposite of @ref{OverrideProperty}: remove a
previously added property from a graphical object definition.")
- (types . (general-music layout-instruction-event))
- (iterator-ctor . ,ly:pop-property-iterator::constructor)
- ))
+ (types . (general-music layout-instruction-event))
+ (iterator-ctor . ,ly:pop-property-iterator::constructor)
+ ))
(ScriptEvent
. ((description . "Add an articulation mark to a note.")
- (types . (general-music event))
- ))
+ (types . (general-music event))
+ ))
(SequentialMusic
. ((description . "Music expressions concatenated.
Syntax: @code{\\sequential @{ @dots{} @}} or simply @code{@{ @dots{} @}}")
- (length-callback . ,ly:music-sequence::cumulative-length-callback)
- (start-callback . ,ly:music-sequence::first-start-callback)
- (elements-callback . ,(lambda (m) (ly:music-property m 'elements)))
- (iterator-ctor . ,ly:sequential-iterator::constructor)
- (types . (general-music sequential-music))
- ))
+ (length-callback . ,ly:music-sequence::cumulative-length-callback)
+ (start-callback . ,ly:music-sequence::first-start-callback)
+ (elements-callback . ,(lambda (m) (ly:music-property m 'elements)))
+ (iterator-ctor . ,ly:sequential-iterator::constructor)
+ (types . (general-music sequential-music))
+ ))
(SimultaneousMusic
. ((description . "Music playing together.
Syntax: @code{\\simultaneous @{ @dots{} @}} or @code{<< @dots{} >>}")
- (iterator-ctor . ,ly:simultaneous-music-iterator::constructor)
- (start-callback . ,ly:music-sequence::minimum-start-callback)
- (length-callback . ,ly:music-sequence::maximum-length-callback)
- (to-relative-callback .
- ,ly:music-sequence::simultaneous-relative-callback)
- (types . (general-music simultaneous-music))
- ))
+ (iterator-ctor . ,ly:simultaneous-music-iterator::constructor)
+ (start-callback . ,ly:music-sequence::minimum-start-callback)
+ (length-callback . ,ly:music-sequence::maximum-length-callback)
+ (to-relative-callback .
+ ,ly:music-sequence::simultaneous-relative-callback)
+ (types . (general-music simultaneous-music))
+ ))
(SkipEvent
. ((description . "Filler that takes up duration, but does not
print anything.
Syntax: @code{s4} for a skip equivalent to a quarter rest.")
- (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
- (types . (general-music event rhythmic-event skip-event))
- ))
+ (iterator-ctor . ,ly:rhythmic-music-iterator::constructor)
+ (types . (general-music event rhythmic-event skip-event))
+ ))
(SkipMusic
. ((description . "Filler that takes up duration, does not
print anything, and also does not create staves or voices implicitly.
Syntax: @code{\\skip} @var{duration}")
- (length-callback . ,ly:music-duration-length)
- (iterator-ctor . ,ly:simple-music-iterator::constructor)
- (types . (general-music event skip-event))
- ))
+ (length-callback . ,ly:music-duration-length)
+ (iterator-ctor . ,ly:simple-music-iterator::constructor)
+ (types . (general-music event skip-event))
+ ))
(SlurEvent
. ((description . "Start or end slur.
Syntax: @var{note}@code{(} and @var{note}@code{)}")
(spanner-id . "")
- (types . (general-music post-event span-event event slur-event))
- ))
+ (types . (general-music post-event span-event event slur-event))
+ ))
(SoloOneEvent
. ((description . "Print @q{Solo@tie{}1}.")
- (part-combine-status . solo1)
- (types . (general-music event part-combine-event solo-one-event))
- ))
+ (part-combine-status . solo1)
+ (types . (general-music event part-combine-event solo-one-event))
+ ))
(SoloTwoEvent
. ((description . "Print @q{Solo@tie{}2}.")
- (part-combine-status . solo2)
- (types . (general-music event part-combine-event solo-two-event))
- ))
+ (part-combine-status . solo2)
+ (types . (general-music event part-combine-event solo-two-event))
+ ))
(SostenutoEvent
. ((description . "Depress or release sostenuto pedal.")
- (types . (general-music post-event event pedal-event sostenuto-event))
- ))
+ (types . (general-music post-event event pedal-event sostenuto-event))
+ ))
(SpacingSectionEvent
. ((description . "Start a new spacing section.")
- (types . (general-music event spacing-section-event))))
+ (types . (general-music event spacing-section-event))))
(SpanEvent
. ((description . "Event for anything that is started at a
different time than stopped.")
- (types . (general-music event))
- ))
+ (types . (general-music event))
+ ))
(StaffSpanEvent
. ((description . "Start or stop a staff symbol.")
- (types . (general-music event span-event staff-span-event))
- ))
+ (types . (general-music event span-event staff-span-event))
+ ))
(StringNumberEvent
. ((description . "Specify on which string to play this note.
Syntax: @code{\\@var{number}}")
- (types . (general-music post-event string-number-event event))
- ))
+ (types . (general-music post-event string-number-event event))
+ ))
(StrokeFingerEvent
. ((description . "Specify with which finger to pluck a string.
Syntax: @code{\\rightHandFinger @var{text}}")
- (types . (general-music post-event stroke-finger-event event))
- ))
+ (types . (general-music post-event stroke-finger-event event))
+ ))
(SustainEvent
. ((description . "Depress or release sustain pedal.")
- (types . (general-music post-event event pedal-event sustain-event))
- ))
+ (types . (general-music post-event event pedal-event sustain-event))
+ ))
(TempoChangeEvent
. ((description . "A metronome mark or tempo indication.")
- (types . (general-music event tempo-change-event))
- ))
+ (types . (general-music event tempo-change-event))
+ ))
(TextScriptEvent
. ((description . "Print text.")
- (types . (general-music post-event script-event text-script-event event))
- ))
+ (types . (general-music post-event script-event text-script-event event))
+ ))
(TextSpanEvent
. ((description . "Start a text spanner, for example, an
octavation.")
- (types . (general-music post-event span-event event text-span-event))
- ))
+ (types . (general-music post-event span-event event text-span-event))
+ ))
(TieEvent
. ((description . "A tie.
Syntax: @w{@var{note}@code{-~}}")
- (types . (general-music post-event tie-event event))
- ))
+ (types . (general-music post-event tie-event event))
+ ))
(TimeScaledMusic
. ((description . "Multiply durations, as in tuplets.
Syntax: @code{\\times @var{fraction} @var{music}}, e.g.,
@code{\\times 2/3 @{ @dots{} @}} for triplets.")
- (length-callback . ,ly:music-wrapper::length-callback)
- (start-callback . ,ly:music-wrapper::start-callback)
- (iterator-ctor . ,ly:tuplet-iterator::constructor)
- (types . (time-scaled-music music-wrapper-music general-music))
- ))
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (start-callback . ,ly:music-wrapper::start-callback)
+ (iterator-ctor . ,ly:tuplet-iterator::constructor)
+ (types . (time-scaled-music music-wrapper-music general-music))
+ ))
(TimeSignatureMusic
. ((description . "Set a new time signature")
@@ -663,87 +663,87 @@ Syntax: @code{\\times @var{fraction} @var{music}}, e.g.,
(TransposedMusic
. ((description . "Music that has been transposed.")
- (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
- (start-callback . ,ly:music-wrapper::start-callback)
- (length-callback . ,ly:music-wrapper::length-callback)
- (to-relative-callback .
- ,ly:relative-octave-music::no-relative-callback)
- (types . (music-wrapper-music general-music transposed-music))
- ))
+ (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
+ (start-callback . ,ly:music-wrapper::start-callback)
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (to-relative-callback .
+ ,ly:relative-octave-music::no-relative-callback)
+ (types . (music-wrapper-music general-music transposed-music))
+ ))
(TremoloEvent
. ((description . "Unmeasured tremolo.")
- (types . (general-music post-event event tremolo-event))
- ))
+ (types . (general-music post-event event tremolo-event))
+ ))
(TremoloRepeatedMusic
. ((description . "Repeated notes denoted by tremolo beams.")
- (iterator-ctor . ,ly:chord-tremolo-iterator::constructor)
- (start-callback . ,ly:repeated-music::first-start)
- ;; the length of the repeat is handled by shifting the note logs
- (length-callback . ,ly:repeated-music::folded-music-length)
- (types . (general-music repeated-music tremolo-repeated-music))
- ))
+ (iterator-ctor . ,ly:chord-tremolo-iterator::constructor)
+ (start-callback . ,ly:repeated-music::first-start)
+ ;; the length of the repeat is handled by shifting the note logs
+ (length-callback . ,ly:repeated-music::folded-music-length)
+ (types . (general-music repeated-music tremolo-repeated-music))
+ ))
(TremoloSpanEvent
. ((description . "Tremolo over two stems.")
- (types . (general-music event span-event tremolo-span-event))
- ))
+ (types . (general-music event span-event tremolo-span-event))
+ ))
(TrillSpanEvent
. ((description . "Start a trill spanner.")
- (types . (general-music post-event span-event event trill-span-event))
- ))
+ (types . (general-music post-event span-event event trill-span-event))
+ ))
(TupletSpanEvent
. ((description . "Used internally to signal where tuplet
brackets start and stop.")
- (types . (tuplet-span-event span-event event general-music post-event))
- ))
+ (types . (tuplet-span-event span-event event general-music post-event))
+ ))
(UnaCordaEvent
. ((description . "Depress or release una-corda pedal.")
- (types . (general-music post-event event pedal-event una-corda-event))
- ))
+ (types . (general-music post-event event pedal-event una-corda-event))
+ ))
(UnfoldedRepeatedMusic
. ((description . "Repeated music which is fully written
(and played) out.")
- (iterator-ctor . ,ly:unfolded-repeat-iterator::constructor)
- (start-callback . ,ly:repeated-music::first-start)
- (types . (general-music repeated-music unfolded-repeated-music))
- (length-callback . ,ly:repeated-music::unfolded-music-length)
- ))
+ (iterator-ctor . ,ly:unfolded-repeat-iterator::constructor)
+ (start-callback . ,ly:repeated-music::first-start)
+ (types . (general-music repeated-music unfolded-repeated-music))
+ (length-callback . ,ly:repeated-music::unfolded-music-length)
+ ))
(UnisonoEvent
. ((description . "Print @q{a@tie{}2}.")
- (part-combine-status . unisono)
- (types . (general-music event part-combine-event unisono-event))))
+ (part-combine-status . unisono)
+ (types . (general-music event part-combine-event unisono-event))))
(UnrelativableMusic
. ((description . "Music that cannot be converted from relative
to absolute notation. For example, transposed music.")
- (to-relative-callback . ,ly:relative-octave-music::no-relative-callback)
- (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
- (length-callback . ,ly:music-wrapper::length-callback)
- (types . (music-wrapper-music general-music unrelativable-music))
- ))
+ (to-relative-callback . ,ly:relative-octave-music::no-relative-callback)
+ (iterator-ctor . ,ly:music-wrapper-iterator::constructor)
+ (length-callback . ,ly:music-wrapper::length-callback)
+ (types . (music-wrapper-music general-music unrelativable-music))
+ ))
(VoiceSeparator
. ((description . "Separate polyphonic voices in simultaneous music.
Syntax: @code{\\\\}")
- (types . (separator general-music))
- ))
+ (types . (separator general-music))
+ ))
(VoltaRepeatedMusic
. ((description . "Repeats with alternatives placed sequentially.")
- (iterator-ctor . ,ly:volta-repeat-iterator::constructor)
- (elements-callback . ,make-volta-set)
- (start-callback . ,ly:repeated-music::first-start)
- (length-callback . ,ly:repeated-music::volta-music-length)
- (types . (general-music repeated-music volta-repeated-music))
- ))
+ (iterator-ctor . ,ly:volta-repeat-iterator::constructor)
+ (elements-callback . ,make-volta-set)
+ (start-callback . ,ly:repeated-music::first-start)
+ (length-callback . ,ly:repeated-music::volta-music-length)
+ (types . (general-music repeated-music volta-repeated-music))
+ ))
))
(set! music-descriptions
@@ -756,14 +756,14 @@ Syntax: @code{\\\\}")
(set!
music-descriptions
(map (lambda (x)
- (set-object-property! (car x)
- 'music-description
- (cdr (assq 'description (cdr x))))
- (let ((lst (cdr x)))
- (set! lst (assoc-set! lst 'name (car x)))
- (set! lst (assq-remove! lst 'description))
- (hashq-set! music-name-to-property-table (car x) lst)
- (cons (car x) lst)))
+ (set-object-property! (car x)
+ 'music-description
+ (cdr (assq 'description (cdr x))))
+ (let ((lst (cdr x)))
+ (set! lst (assoc-set! lst 'name (car x)))
+ (set! lst (assq-remove! lst 'description))
+ (hashq-set! music-name-to-property-table (car x) lst)
+ (cons (car x) lst)))
music-descriptions))
(define-safe-public (make-music name . music-properties)
@@ -771,33 +771,33 @@ Syntax: @code{\\\\}")
according to @code{music-properties}, a list of alternating property symbols
and values. E.g:
(make-music 'OverrideProperty
- 'symbol 'Stem
- 'grob-property 'thickness
- 'grob-value (* 2 1.5))"
+ 'symbol 'Stem
+ 'grob-property 'thickness
+ 'grob-value (* 2 1.5))"
(if (not (symbol? name))
(ly:error (_ "symbol expected: ~S") name))
(let ((props (hashq-ref music-name-to-property-table name '())))
(if (not (pair? props))
- (ly:error (_ "cannot find music object: ~S") name))
+ (ly:error (_ "cannot find music object: ~S") name))
(let ((m (ly:make-music props)))
(define (set-props mus-props)
- (if (and (not (null? mus-props))
- (not (null? (cdr mus-props))))
- (begin
- (set! (ly:music-property m (car mus-props)) (cadr mus-props))
- (set-props (cddr mus-props)))))
+ (if (and (not (null? mus-props))
+ (not (null? (cdr mus-props))))
+ (begin
+ (set! (ly:music-property m (car mus-props)) (cadr mus-props))
+ (set-props (cddr mus-props)))))
(set-props music-properties)
m)))
(define-public (make-repeated-music name)
(let* ((repeated-music (assoc-get name '(("volta" . VoltaRepeatedMusic)
- ("unfold" . UnfoldedRepeatedMusic)
- ("percent" . PercentRepeatedMusic)
- ("tremolo" . TremoloRepeatedMusic))))
- (repeated-music-name (if repeated-music
- repeated-music
- (begin
- (ly:warning (_ "unknown repeat type `~S'") name)
- (ly:warning (_ "See define-music-types.scm for supported repeats"))
- 'VoltaRepeatedMusic))))
+ ("unfold" . UnfoldedRepeatedMusic)
+ ("percent" . PercentRepeatedMusic)
+ ("tremolo" . TremoloRepeatedMusic))))
+ (repeated-music-name (if repeated-music
+ repeated-music
+ (begin
+ (ly:warning (_ "unknown repeat type `~S'") name)
+ (ly:warning (_ "See define-music-types.scm for supported repeats"))
+ 'VoltaRepeatedMusic))))
(make-music repeated-music-name)))
diff --git a/scm/define-note-names.scm b/scm/define-note-names.scm
index f8b6dad6a4..6136af0c51 100644
--- a/scm/define-note-names.scm
+++ b/scm/define-note-names.scm
@@ -57,80 +57,80 @@
;; Dutch: c d e f g a b h
(nederlands . (
- (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (ceh . ,(ly:make-pitch -1 0 SEMI-FLAT))
- (ces . ,(ly:make-pitch -1 0 FLAT))
- (ceseh . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (cis . ,(ly:make-pitch -1 0 SHARP))
- (cih . ,(ly:make-pitch -1 0 SEMI-SHARP))
- (cisih . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
- (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
-
- (deh . ,(ly:make-pitch -1 1 SEMI-FLAT))
- (des . ,(ly:make-pitch -1 1 FLAT))
- (deseh . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (dis . ,(ly:make-pitch -1 1 SHARP))
- (dih . ,(ly:make-pitch -1 1 SEMI-SHARP))
- (disih . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
- (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (eeses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
-
- (eeh . ,(ly:make-pitch -1 2 SEMI-FLAT))
- (ees . ,(ly:make-pitch -1 2 FLAT))
- (eeseh . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
- (es . ,(ly:make-pitch -1 2 FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (eis . ,(ly:make-pitch -1 2 SHARP))
- (eih . ,(ly:make-pitch -1 2 SEMI-SHARP))
- (eisih . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
- (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
-
- (feh . ,(ly:make-pitch -1 3 SEMI-FLAT))
- (fes . ,(ly:make-pitch -1 3 FLAT))
- (feseh . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fis . ,(ly:make-pitch -1 3 SHARP))
- (fih . ,(ly:make-pitch -1 3 SEMI-SHARP))
- (fisih . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
- (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
-
- (geh . ,(ly:make-pitch -1 4 SEMI-FLAT))
- (ges . ,(ly:make-pitch -1 4 FLAT))
- (geseh . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (gis . ,(ly:make-pitch -1 4 SHARP))
- (gih . ,(ly:make-pitch -1 4 SEMI-SHARP))
- (gisih . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
- (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (aeses . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
-
- (aeh . ,(ly:make-pitch -1 5 SEMI-FLAT))
- (aes . ,(ly:make-pitch -1 5 FLAT))
- (aeseh . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (as . ,(ly:make-pitch -1 5 FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (ais . ,(ly:make-pitch -1 5 SHARP))
- (aih . ,(ly:make-pitch -1 5 SEMI-SHARP))
- (aisih . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
- (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (beses . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
-
- (beh . ,(ly:make-pitch -1 6 SEMI-FLAT))
- (bes . ,(ly:make-pitch -1 6 FLAT))
- (beseh . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
- (b . ,(ly:make-pitch -1 6 NATURAL))
- (bis . ,(ly:make-pitch -1 6 SHARP))
- (bih . ,(ly:make-pitch -1 6 SEMI-SHARP))
- (bisih . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
- (bisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (ceh . ,(ly:make-pitch -1 0 SEMI-FLAT))
+ (ces . ,(ly:make-pitch -1 0 FLAT))
+ (ceseh . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (cis . ,(ly:make-pitch -1 0 SHARP))
+ (cih . ,(ly:make-pitch -1 0 SEMI-SHARP))
+ (cisih . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
+ (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+
+ (deh . ,(ly:make-pitch -1 1 SEMI-FLAT))
+ (des . ,(ly:make-pitch -1 1 FLAT))
+ (deseh . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (dis . ,(ly:make-pitch -1 1 SHARP))
+ (dih . ,(ly:make-pitch -1 1 SEMI-SHARP))
+ (disih . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
+ (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (eeses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+
+ (eeh . ,(ly:make-pitch -1 2 SEMI-FLAT))
+ (ees . ,(ly:make-pitch -1 2 FLAT))
+ (eeseh . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
+ (es . ,(ly:make-pitch -1 2 FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (eis . ,(ly:make-pitch -1 2 SHARP))
+ (eih . ,(ly:make-pitch -1 2 SEMI-SHARP))
+ (eisih . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
+ (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+
+ (feh . ,(ly:make-pitch -1 3 SEMI-FLAT))
+ (fes . ,(ly:make-pitch -1 3 FLAT))
+ (feseh . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fis . ,(ly:make-pitch -1 3 SHARP))
+ (fih . ,(ly:make-pitch -1 3 SEMI-SHARP))
+ (fisih . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
+ (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+
+ (geh . ,(ly:make-pitch -1 4 SEMI-FLAT))
+ (ges . ,(ly:make-pitch -1 4 FLAT))
+ (geseh . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (gis . ,(ly:make-pitch -1 4 SHARP))
+ (gih . ,(ly:make-pitch -1 4 SEMI-SHARP))
+ (gisih . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
+ (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (aeses . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+
+ (aeh . ,(ly:make-pitch -1 5 SEMI-FLAT))
+ (aes . ,(ly:make-pitch -1 5 FLAT))
+ (aeseh . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (as . ,(ly:make-pitch -1 5 FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (ais . ,(ly:make-pitch -1 5 SHARP))
+ (aih . ,(ly:make-pitch -1 5 SEMI-SHARP))
+ (aisih . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
+ (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (beses . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+
+ (beh . ,(ly:make-pitch -1 6 SEMI-FLAT))
+ (bes . ,(ly:make-pitch -1 6 FLAT))
+ (beseh . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
+ (b . ,(ly:make-pitch -1 6 NATURAL))
+ (bis . ,(ly:make-pitch -1 6 SHARP))
+ (bih . ,(ly:make-pitch -1 6 SEMI-SHARP))
+ (bisih . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
+ (bisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Catalan -----------------------------------------------;
@@ -149,58 +149,58 @@
;; Catalan: do re mi fa sol la si
(catalan . (
- (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (dob . ,(ly:make-pitch -1 0 FLAT))
- (do . ,(ly:make-pitch -1 0 NATURAL))
- (dod . ,(ly:make-pitch -1 0 SHARP))
- (dodd . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (reb . ,(ly:make-pitch -1 1 FLAT))
- (re . ,(ly:make-pitch -1 1 NATURAL))
- (red . ,(ly:make-pitch -1 1 SHARP))
- (redd . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (mib . ,(ly:make-pitch -1 2 FLAT))
- (mi . ,(ly:make-pitch -1 2 NATURAL))
- (mid . ,(ly:make-pitch -1 2 SHARP))
- (midd . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fab . ,(ly:make-pitch -1 3 FLAT))
- (fa . ,(ly:make-pitch -1 3 NATURAL))
- (fad . ,(ly:make-pitch -1 3 SHARP))
- (fadd . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (solb . ,(ly:make-pitch -1 4 FLAT))
- (sol . ,(ly:make-pitch -1 4 NATURAL))
- (sold . ,(ly:make-pitch -1 4 SHARP))
- (soldd . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (lab . ,(ly:make-pitch -1 5 FLAT))
- (la . ,(ly:make-pitch -1 5 NATURAL))
- (lad . ,(ly:make-pitch -1 5 SHARP))
- (ladd . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (sib . ,(ly:make-pitch -1 6 FLAT))
- (si . ,(ly:make-pitch -1 6 NATURAL))
- (sid . ,(ly:make-pitch -1 6 SHARP))
- (sidd . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
-
- ;; Now that we have espanol.ly, should these be junked? --jcn
- (dos . ,(ly:make-pitch -1 0 SHARP))
- (doss . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (res . ,(ly:make-pitch -1 1 SHARP))
- (ress . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (mis . ,(ly:make-pitch -1 2 SHARP))
- (miss . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (fas . ,(ly:make-pitch -1 3 SHARP))
- (fass . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (sols . ,(ly:make-pitch -1 4 SHARP))
- (solss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (las . ,(ly:make-pitch -1 5 SHARP))
- (lass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (sis . ,(ly:make-pitch -1 6 SHARP))
- (siss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (dob . ,(ly:make-pitch -1 0 FLAT))
+ (do . ,(ly:make-pitch -1 0 NATURAL))
+ (dod . ,(ly:make-pitch -1 0 SHARP))
+ (dodd . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (reb . ,(ly:make-pitch -1 1 FLAT))
+ (re . ,(ly:make-pitch -1 1 NATURAL))
+ (red . ,(ly:make-pitch -1 1 SHARP))
+ (redd . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (mib . ,(ly:make-pitch -1 2 FLAT))
+ (mi . ,(ly:make-pitch -1 2 NATURAL))
+ (mid . ,(ly:make-pitch -1 2 SHARP))
+ (midd . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fab . ,(ly:make-pitch -1 3 FLAT))
+ (fa . ,(ly:make-pitch -1 3 NATURAL))
+ (fad . ,(ly:make-pitch -1 3 SHARP))
+ (fadd . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (solb . ,(ly:make-pitch -1 4 FLAT))
+ (sol . ,(ly:make-pitch -1 4 NATURAL))
+ (sold . ,(ly:make-pitch -1 4 SHARP))
+ (soldd . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (lab . ,(ly:make-pitch -1 5 FLAT))
+ (la . ,(ly:make-pitch -1 5 NATURAL))
+ (lad . ,(ly:make-pitch -1 5 SHARP))
+ (ladd . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (sib . ,(ly:make-pitch -1 6 FLAT))
+ (si . ,(ly:make-pitch -1 6 NATURAL))
+ (sid . ,(ly:make-pitch -1 6 SHARP))
+ (sidd . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+
+ ;; Now that we have espanol.ly, should these be junked? --jcn
+ (dos . ,(ly:make-pitch -1 0 SHARP))
+ (doss . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (res . ,(ly:make-pitch -1 1 SHARP))
+ (ress . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (mis . ,(ly:make-pitch -1 2 SHARP))
+ (miss . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (fas . ,(ly:make-pitch -1 3 SHARP))
+ (fass . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (sols . ,(ly:make-pitch -1 4 SHARP))
+ (solss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (las . ,(ly:make-pitch -1 5 SHARP))
+ (lass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (sis . ,(ly:make-pitch -1 6 SHARP))
+ (siss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Deutsch -----------------------------------------------;
@@ -221,78 +221,78 @@
;; German: c d e f g a b h
(deutsch . (
- (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (ceseh . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
- (ces . ,(ly:make-pitch -1 0 FLAT))
- (ceh . ,(ly:make-pitch -1 0 SEMI-FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (cih . ,(ly:make-pitch -1 0 SEMI-SHARP))
- (cis . ,(ly:make-pitch -1 0 SHARP))
- (cisih . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
- (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
-
- (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (deseh . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
- (des . ,(ly:make-pitch -1 1 FLAT))
- (deh . ,(ly:make-pitch -1 1 SEMI-FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (dih . ,(ly:make-pitch -1 1 SEMI-SHARP))
- (dis . ,(ly:make-pitch -1 1 SHARP))
- (disih . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
- (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
-
- (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (eseh . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
- (es . ,(ly:make-pitch -1 2 FLAT))
- (eeh . ,(ly:make-pitch -1 2 SEMI-FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (eih . ,(ly:make-pitch -1 2 SEMI-SHARP))
- (eis . ,(ly:make-pitch -1 2 SHARP))
- (eisih . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
- (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
-
- (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (feseh . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
- (fes . ,(ly:make-pitch -1 3 FLAT))
- (feh . ,(ly:make-pitch -1 3 SEMI-FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fih . ,(ly:make-pitch -1 3 SEMI-SHARP))
- (fis . ,(ly:make-pitch -1 3 SHARP))
- (fisih . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
- (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
-
- (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (geseh . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
- (ges . ,(ly:make-pitch -1 4 FLAT))
- (geh . ,(ly:make-pitch -1 4 SEMI-FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (gih . ,(ly:make-pitch -1 4 SEMI-SHARP))
- (gis . ,(ly:make-pitch -1 4 SHARP))
- (gisih . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
- (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
-
- (asas . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (asah . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT)) ;;non-standard name for asas
- (aseh . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (as . ,(ly:make-pitch -1 5 FLAT))
- (aeh . ,(ly:make-pitch -1 5 SEMI-FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (aih . ,(ly:make-pitch -1 5 SEMI-SHARP))
- (ais . ,(ly:make-pitch -1 5 SHARP))
- (aisih . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
- (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
-
- (heses . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (heseh . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
- (b . ,(ly:make-pitch -1 6 FLAT))
- (beh . ,(ly:make-pitch -1 6 SEMI-FLAT))
- (h . ,(ly:make-pitch -1 6 NATURAL))
- (hih . ,(ly:make-pitch -1 6 SEMI-SHARP))
- (his . ,(ly:make-pitch -1 6 SHARP))
- (hisih . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
- (hisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (ceseh . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
+ (ces . ,(ly:make-pitch -1 0 FLAT))
+ (ceh . ,(ly:make-pitch -1 0 SEMI-FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (cih . ,(ly:make-pitch -1 0 SEMI-SHARP))
+ (cis . ,(ly:make-pitch -1 0 SHARP))
+ (cisih . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
+ (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+
+ (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (deseh . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
+ (des . ,(ly:make-pitch -1 1 FLAT))
+ (deh . ,(ly:make-pitch -1 1 SEMI-FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (dih . ,(ly:make-pitch -1 1 SEMI-SHARP))
+ (dis . ,(ly:make-pitch -1 1 SHARP))
+ (disih . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
+ (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+
+ (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (eseh . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
+ (es . ,(ly:make-pitch -1 2 FLAT))
+ (eeh . ,(ly:make-pitch -1 2 SEMI-FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (eih . ,(ly:make-pitch -1 2 SEMI-SHARP))
+ (eis . ,(ly:make-pitch -1 2 SHARP))
+ (eisih . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
+ (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+
+ (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (feseh . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
+ (fes . ,(ly:make-pitch -1 3 FLAT))
+ (feh . ,(ly:make-pitch -1 3 SEMI-FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fih . ,(ly:make-pitch -1 3 SEMI-SHARP))
+ (fis . ,(ly:make-pitch -1 3 SHARP))
+ (fisih . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
+ (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+
+ (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (geseh . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
+ (ges . ,(ly:make-pitch -1 4 FLAT))
+ (geh . ,(ly:make-pitch -1 4 SEMI-FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (gih . ,(ly:make-pitch -1 4 SEMI-SHARP))
+ (gis . ,(ly:make-pitch -1 4 SHARP))
+ (gisih . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
+ (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+
+ (asas . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (asah . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT)) ;;non-standard name for asas
+ (aseh . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (as . ,(ly:make-pitch -1 5 FLAT))
+ (aeh . ,(ly:make-pitch -1 5 SEMI-FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (aih . ,(ly:make-pitch -1 5 SEMI-SHARP))
+ (ais . ,(ly:make-pitch -1 5 SHARP))
+ (aisih . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
+ (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+
+ (heses . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (heseh . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
+ (b . ,(ly:make-pitch -1 6 FLAT))
+ (beh . ,(ly:make-pitch -1 6 SEMI-FLAT))
+ (h . ,(ly:make-pitch -1 6 NATURAL))
+ (hih . ,(ly:make-pitch -1 6 SEMI-SHARP))
+ (his . ,(ly:make-pitch -1 6 SHARP))
+ (hisih . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
+ (hisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: English -----------------------------------------------;
@@ -310,119 +310,119 @@
;; tqs = three-quarter[-tones] sharp
(english . (
- (cflatflat . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (cflat . ,(ly:make-pitch -1 0 FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (csharp . ,(ly:make-pitch -1 0 SHARP))
- (csharpsharp . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (dflatflat . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (dflat . ,(ly:make-pitch -1 1 FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (dsharp . ,(ly:make-pitch -1 1 SHARP))
- (dsharpsharp . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (eflatflat . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (eflat . ,(ly:make-pitch -1 2 FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (esharp . ,(ly:make-pitch -1 2 SHARP))
- (esharpsharp . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (fflatflat . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fflat . ,(ly:make-pitch -1 3 FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fsharp . ,(ly:make-pitch -1 3 SHARP))
- (fsharpsharp . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (gflatflat . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (gflat . ,(ly:make-pitch -1 4 FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (gsharp . ,(ly:make-pitch -1 4 SHARP))
- (gsharpsharp . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (aflatflat . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (aflat . ,(ly:make-pitch -1 5 FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (asharp . ,(ly:make-pitch -1 5 SHARP))
- (asharpsharp . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (bflatflat . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (bflat . ,(ly:make-pitch -1 6 FLAT))
- (b . ,(ly:make-pitch -1 6 NATURAL))
- (bsharp . ,(ly:make-pitch -1 6 SHARP))
- (bsharpsharp . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
-
- (cff . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (ctqf . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
- (cf . ,(ly:make-pitch -1 0 FLAT))
- (cqf . ,(ly:make-pitch -1 0 SEMI-FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (cqs . ,(ly:make-pitch -1 0 SEMI-SHARP))
- (cs . ,(ly:make-pitch -1 0 SHARP))
- (ctqs . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
- (css . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (cx . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
-
- (dff . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (dtqf . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
- (df . ,(ly:make-pitch -1 1 FLAT))
- (dqf . ,(ly:make-pitch -1 1 SEMI-FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (dqs . ,(ly:make-pitch -1 1 SEMI-SHARP))
- (ds . ,(ly:make-pitch -1 1 SHARP))
- (dtqs . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
- (dss . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (dx . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
-
- (eff . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (etqf . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
- (ef . ,(ly:make-pitch -1 2 FLAT))
- (eqf . ,(ly:make-pitch -1 2 SEMI-FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (eqs . ,(ly:make-pitch -1 2 SEMI-SHARP))
- (es . ,(ly:make-pitch -1 2 SHARP))
- (etqs . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
- (ess . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (ex . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
-
- (fff . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (ftqf . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
- (ff . ,(ly:make-pitch -1 3 FLAT))
- (fqf . ,(ly:make-pitch -1 3 SEMI-FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fqs . ,(ly:make-pitch -1 3 SEMI-SHARP))
- (fs . ,(ly:make-pitch -1 3 SHARP))
- (ftqs . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
- (fss . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (fx . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
-
- (gff . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (gtqf . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
- (gf . ,(ly:make-pitch -1 4 FLAT))
- (gqf . ,(ly:make-pitch -1 4 SEMI-FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (gqs . ,(ly:make-pitch -1 4 SEMI-SHARP))
- (gs . ,(ly:make-pitch -1 4 SHARP))
- (gtqs . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
- (gss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (gx . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
-
- (aff . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (atqf . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (af . ,(ly:make-pitch -1 5 FLAT))
- (aqf . ,(ly:make-pitch -1 5 SEMI-FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (aqs . ,(ly:make-pitch -1 5 SEMI-SHARP))
- (as . ,(ly:make-pitch -1 5 SHARP))
- (atqs . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
- (ass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (ax . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
-
- (bff . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (btqf . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
- (bf . ,(ly:make-pitch -1 6 FLAT))
- (bqf . ,(ly:make-pitch -1 6 SEMI-FLAT))
- (b . ,(ly:make-pitch -1 6 NATURAL))
- (bqs . ,(ly:make-pitch -1 6 SEMI-SHARP))
- (bs . ,(ly:make-pitch -1 6 SHARP))
- (btqs . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
- (bss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- (bx . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (cflatflat . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (cflat . ,(ly:make-pitch -1 0 FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (csharp . ,(ly:make-pitch -1 0 SHARP))
+ (csharpsharp . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (dflatflat . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (dflat . ,(ly:make-pitch -1 1 FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (dsharp . ,(ly:make-pitch -1 1 SHARP))
+ (dsharpsharp . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (eflatflat . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (eflat . ,(ly:make-pitch -1 2 FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (esharp . ,(ly:make-pitch -1 2 SHARP))
+ (esharpsharp . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (fflatflat . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fflat . ,(ly:make-pitch -1 3 FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fsharp . ,(ly:make-pitch -1 3 SHARP))
+ (fsharpsharp . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (gflatflat . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (gflat . ,(ly:make-pitch -1 4 FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (gsharp . ,(ly:make-pitch -1 4 SHARP))
+ (gsharpsharp . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (aflatflat . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (aflat . ,(ly:make-pitch -1 5 FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (asharp . ,(ly:make-pitch -1 5 SHARP))
+ (asharpsharp . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (bflatflat . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (bflat . ,(ly:make-pitch -1 6 FLAT))
+ (b . ,(ly:make-pitch -1 6 NATURAL))
+ (bsharp . ,(ly:make-pitch -1 6 SHARP))
+ (bsharpsharp . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+
+ (cff . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (ctqf . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
+ (cf . ,(ly:make-pitch -1 0 FLAT))
+ (cqf . ,(ly:make-pitch -1 0 SEMI-FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (cqs . ,(ly:make-pitch -1 0 SEMI-SHARP))
+ (cs . ,(ly:make-pitch -1 0 SHARP))
+ (ctqs . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
+ (css . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (cx . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+
+ (dff . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (dtqf . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
+ (df . ,(ly:make-pitch -1 1 FLAT))
+ (dqf . ,(ly:make-pitch -1 1 SEMI-FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (dqs . ,(ly:make-pitch -1 1 SEMI-SHARP))
+ (ds . ,(ly:make-pitch -1 1 SHARP))
+ (dtqs . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
+ (dss . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (dx . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+
+ (eff . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (etqf . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
+ (ef . ,(ly:make-pitch -1 2 FLAT))
+ (eqf . ,(ly:make-pitch -1 2 SEMI-FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (eqs . ,(ly:make-pitch -1 2 SEMI-SHARP))
+ (es . ,(ly:make-pitch -1 2 SHARP))
+ (etqs . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
+ (ess . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (ex . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+
+ (fff . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (ftqf . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
+ (ff . ,(ly:make-pitch -1 3 FLAT))
+ (fqf . ,(ly:make-pitch -1 3 SEMI-FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fqs . ,(ly:make-pitch -1 3 SEMI-SHARP))
+ (fs . ,(ly:make-pitch -1 3 SHARP))
+ (ftqs . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
+ (fss . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (fx . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+
+ (gff . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (gtqf . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
+ (gf . ,(ly:make-pitch -1 4 FLAT))
+ (gqf . ,(ly:make-pitch -1 4 SEMI-FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (gqs . ,(ly:make-pitch -1 4 SEMI-SHARP))
+ (gs . ,(ly:make-pitch -1 4 SHARP))
+ (gtqs . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
+ (gss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (gx . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+
+ (aff . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (atqf . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (af . ,(ly:make-pitch -1 5 FLAT))
+ (aqf . ,(ly:make-pitch -1 5 SEMI-FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (aqs . ,(ly:make-pitch -1 5 SEMI-SHARP))
+ (as . ,(ly:make-pitch -1 5 SHARP))
+ (atqs . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
+ (ass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (ax . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+
+ (bff . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (btqf . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
+ (bf . ,(ly:make-pitch -1 6 FLAT))
+ (bqf . ,(ly:make-pitch -1 6 SEMI-FLAT))
+ (b . ,(ly:make-pitch -1 6 NATURAL))
+ (bqs . ,(ly:make-pitch -1 6 SEMI-SHARP))
+ (bs . ,(ly:make-pitch -1 6 SHARP))
+ (btqs . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
+ (bss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ (bx . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Espanol -----------------------------------------------;
@@ -444,83 +444,83 @@
;; Spanish: do re mi fa sol la si
(espanol . (
- (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (dotcb . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
- (dob . ,(ly:make-pitch -1 0 FLAT))
- (docb . ,(ly:make-pitch -1 0 SEMI-FLAT))
- (do . ,(ly:make-pitch -1 0 NATURAL))
- (docs . ,(ly:make-pitch -1 0 SEMI-SHARP))
- (dos . ,(ly:make-pitch -1 0 SHARP))
- (dotcs . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
- (doss . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (dox . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
-
- (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (retcb . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
- (reb . ,(ly:make-pitch -1 1 FLAT))
- (recb . ,(ly:make-pitch -1 1 SEMI-FLAT))
- (re . ,(ly:make-pitch -1 1 NATURAL))
- (recs . ,(ly:make-pitch -1 1 SEMI-SHARP))
- (res . ,(ly:make-pitch -1 1 SHARP))
- (retcs . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
- (ress . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (rex . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
-
- (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (mitcb . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
- (mib . ,(ly:make-pitch -1 2 FLAT))
- (micb . ,(ly:make-pitch -1 2 SEMI-FLAT))
- (mi . ,(ly:make-pitch -1 2 NATURAL))
- (mics . ,(ly:make-pitch -1 2 SEMI-SHARP))
- (mis . ,(ly:make-pitch -1 2 SHARP))
- (mitcs . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
- (miss . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (mix . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
-
- (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fatcb . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
- (fab . ,(ly:make-pitch -1 3 FLAT))
- (facb . ,(ly:make-pitch -1 3 SEMI-FLAT))
- (fa . ,(ly:make-pitch -1 3 NATURAL))
- (facs . ,(ly:make-pitch -1 3 SEMI-SHARP))
- (fas . ,(ly:make-pitch -1 3 SHARP))
- (fatcs . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
- (fass . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (fax . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
-
- (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (soltcb . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
- (solb . ,(ly:make-pitch -1 4 FLAT))
- (solcb . ,(ly:make-pitch -1 4 SEMI-FLAT))
- (sol . ,(ly:make-pitch -1 4 NATURAL))
- (solcs . ,(ly:make-pitch -1 4 SEMI-SHARP))
- (sols . ,(ly:make-pitch -1 4 SHARP))
- (soltcs . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
- (solss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (solx . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
-
- (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (latcb . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (lab . ,(ly:make-pitch -1 5 FLAT))
- (lacb . ,(ly:make-pitch -1 5 SEMI-FLAT))
- (la . ,(ly:make-pitch -1 5 NATURAL))
- (lacs . ,(ly:make-pitch -1 5 SEMI-SHARP))
- (las . ,(ly:make-pitch -1 5 SHARP))
- (latcs . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
- (lass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (lax . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
-
- (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (sitcb . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
- (sib . ,(ly:make-pitch -1 6 FLAT))
- (sicb . ,(ly:make-pitch -1 6 SEMI-FLAT))
- (si . ,(ly:make-pitch -1 6 NATURAL))
- (sics . ,(ly:make-pitch -1 6 SEMI-SHARP))
- (sis . ,(ly:make-pitch -1 6 SHARP))
- (sitcs . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
- (siss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- (six . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (dotcb . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
+ (dob . ,(ly:make-pitch -1 0 FLAT))
+ (docb . ,(ly:make-pitch -1 0 SEMI-FLAT))
+ (do . ,(ly:make-pitch -1 0 NATURAL))
+ (docs . ,(ly:make-pitch -1 0 SEMI-SHARP))
+ (dos . ,(ly:make-pitch -1 0 SHARP))
+ (dotcs . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
+ (doss . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (dox . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+
+ (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (retcb . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
+ (reb . ,(ly:make-pitch -1 1 FLAT))
+ (recb . ,(ly:make-pitch -1 1 SEMI-FLAT))
+ (re . ,(ly:make-pitch -1 1 NATURAL))
+ (recs . ,(ly:make-pitch -1 1 SEMI-SHARP))
+ (res . ,(ly:make-pitch -1 1 SHARP))
+ (retcs . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
+ (ress . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (rex . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+
+ (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (mitcb . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
+ (mib . ,(ly:make-pitch -1 2 FLAT))
+ (micb . ,(ly:make-pitch -1 2 SEMI-FLAT))
+ (mi . ,(ly:make-pitch -1 2 NATURAL))
+ (mics . ,(ly:make-pitch -1 2 SEMI-SHARP))
+ (mis . ,(ly:make-pitch -1 2 SHARP))
+ (mitcs . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
+ (miss . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (mix . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+
+ (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fatcb . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
+ (fab . ,(ly:make-pitch -1 3 FLAT))
+ (facb . ,(ly:make-pitch -1 3 SEMI-FLAT))
+ (fa . ,(ly:make-pitch -1 3 NATURAL))
+ (facs . ,(ly:make-pitch -1 3 SEMI-SHARP))
+ (fas . ,(ly:make-pitch -1 3 SHARP))
+ (fatcs . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
+ (fass . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (fax . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+
+ (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (soltcb . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
+ (solb . ,(ly:make-pitch -1 4 FLAT))
+ (solcb . ,(ly:make-pitch -1 4 SEMI-FLAT))
+ (sol . ,(ly:make-pitch -1 4 NATURAL))
+ (solcs . ,(ly:make-pitch -1 4 SEMI-SHARP))
+ (sols . ,(ly:make-pitch -1 4 SHARP))
+ (soltcs . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
+ (solss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (solx . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+
+ (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (latcb . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (lab . ,(ly:make-pitch -1 5 FLAT))
+ (lacb . ,(ly:make-pitch -1 5 SEMI-FLAT))
+ (la . ,(ly:make-pitch -1 5 NATURAL))
+ (lacs . ,(ly:make-pitch -1 5 SEMI-SHARP))
+ (las . ,(ly:make-pitch -1 5 SHARP))
+ (latcs . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
+ (lass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (lax . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+
+ (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (sitcb . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
+ (sib . ,(ly:make-pitch -1 6 FLAT))
+ (sicb . ,(ly:make-pitch -1 6 SEMI-FLAT))
+ (si . ,(ly:make-pitch -1 6 NATURAL))
+ (sics . ,(ly:make-pitch -1 6 SEMI-SHARP))
+ (sis . ,(ly:make-pitch -1 6 SHARP))
+ (sitcs . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
+ (siss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ (six . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Italiano ----------------------------------------------;
@@ -541,77 +541,77 @@
;; Italian: do re mi fa sol la si
(italiano . (
- (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (dobsb . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
- (dob . ,(ly:make-pitch -1 0 FLAT))
- (dosb . ,(ly:make-pitch -1 0 SEMI-FLAT))
- (do . ,(ly:make-pitch -1 0 NATURAL))
- (dosd . ,(ly:make-pitch -1 0 SEMI-SHARP))
- (dod . ,(ly:make-pitch -1 0 SHARP))
- (dodsd . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
- (dodd . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
-
- (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (rebsb . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
- (reb . ,(ly:make-pitch -1 1 FLAT))
- (resb . ,(ly:make-pitch -1 1 SEMI-FLAT))
- (re . ,(ly:make-pitch -1 1 NATURAL))
- (resd . ,(ly:make-pitch -1 1 SEMI-SHARP))
- (red . ,(ly:make-pitch -1 1 SHARP))
- (redsd . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
- (redd . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
-
- (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (mibsb . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
- (mib . ,(ly:make-pitch -1 2 FLAT))
- (misb . ,(ly:make-pitch -1 2 SEMI-FLAT))
- (mi . ,(ly:make-pitch -1 2 NATURAL))
- (misd . ,(ly:make-pitch -1 2 SEMI-SHARP))
- (mid . ,(ly:make-pitch -1 2 SHARP))
- (midsd . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
- (midd . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
-
- (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fabsb . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
- (fab . ,(ly:make-pitch -1 3 FLAT))
- (fasb . ,(ly:make-pitch -1 3 SEMI-FLAT))
- (fa . ,(ly:make-pitch -1 3 NATURAL))
- (fasd . ,(ly:make-pitch -1 3 SEMI-SHARP))
- (fad . ,(ly:make-pitch -1 3 SHARP))
- (fadsd . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
- (fadd . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
-
- (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (solbsb . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
- (solb . ,(ly:make-pitch -1 4 FLAT))
- (solsb . ,(ly:make-pitch -1 4 SEMI-FLAT))
- (sol . ,(ly:make-pitch -1 4 NATURAL))
- (solsd . ,(ly:make-pitch -1 4 SEMI-SHARP))
- (sold . ,(ly:make-pitch -1 4 SHARP))
- (soldsd . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
- (soldd . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
-
- (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (labsb . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (lab . ,(ly:make-pitch -1 5 FLAT))
- (lasb . ,(ly:make-pitch -1 5 SEMI-FLAT))
- (la . ,(ly:make-pitch -1 5 NATURAL))
- (lasd . ,(ly:make-pitch -1 5 SEMI-SHARP))
- (lad . ,(ly:make-pitch -1 5 SHARP))
- (ladsd . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
- (ladd . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
-
- (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (sibsb . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
- (sib . ,(ly:make-pitch -1 6 FLAT))
- (sisb . ,(ly:make-pitch -1 6 SEMI-FLAT))
- (si . ,(ly:make-pitch -1 6 NATURAL))
- (sisd . ,(ly:make-pitch -1 6 SEMI-SHARP))
- (sid . ,(ly:make-pitch -1 6 SHARP))
- (sidsd . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
- (sidd . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
-
- ))
+ (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (dobsb . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
+ (dob . ,(ly:make-pitch -1 0 FLAT))
+ (dosb . ,(ly:make-pitch -1 0 SEMI-FLAT))
+ (do . ,(ly:make-pitch -1 0 NATURAL))
+ (dosd . ,(ly:make-pitch -1 0 SEMI-SHARP))
+ (dod . ,(ly:make-pitch -1 0 SHARP))
+ (dodsd . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
+ (dodd . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+
+ (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (rebsb . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
+ (reb . ,(ly:make-pitch -1 1 FLAT))
+ (resb . ,(ly:make-pitch -1 1 SEMI-FLAT))
+ (re . ,(ly:make-pitch -1 1 NATURAL))
+ (resd . ,(ly:make-pitch -1 1 SEMI-SHARP))
+ (red . ,(ly:make-pitch -1 1 SHARP))
+ (redsd . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
+ (redd . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+
+ (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (mibsb . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
+ (mib . ,(ly:make-pitch -1 2 FLAT))
+ (misb . ,(ly:make-pitch -1 2 SEMI-FLAT))
+ (mi . ,(ly:make-pitch -1 2 NATURAL))
+ (misd . ,(ly:make-pitch -1 2 SEMI-SHARP))
+ (mid . ,(ly:make-pitch -1 2 SHARP))
+ (midsd . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
+ (midd . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+
+ (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fabsb . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
+ (fab . ,(ly:make-pitch -1 3 FLAT))
+ (fasb . ,(ly:make-pitch -1 3 SEMI-FLAT))
+ (fa . ,(ly:make-pitch -1 3 NATURAL))
+ (fasd . ,(ly:make-pitch -1 3 SEMI-SHARP))
+ (fad . ,(ly:make-pitch -1 3 SHARP))
+ (fadsd . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
+ (fadd . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+
+ (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (solbsb . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
+ (solb . ,(ly:make-pitch -1 4 FLAT))
+ (solsb . ,(ly:make-pitch -1 4 SEMI-FLAT))
+ (sol . ,(ly:make-pitch -1 4 NATURAL))
+ (solsd . ,(ly:make-pitch -1 4 SEMI-SHARP))
+ (sold . ,(ly:make-pitch -1 4 SHARP))
+ (soldsd . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
+ (soldd . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+
+ (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (labsb . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (lab . ,(ly:make-pitch -1 5 FLAT))
+ (lasb . ,(ly:make-pitch -1 5 SEMI-FLAT))
+ (la . ,(ly:make-pitch -1 5 NATURAL))
+ (lasd . ,(ly:make-pitch -1 5 SEMI-SHARP))
+ (lad . ,(ly:make-pitch -1 5 SHARP))
+ (ladsd . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
+ (ladd . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+
+ (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (sibsb . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
+ (sib . ,(ly:make-pitch -1 6 FLAT))
+ (sisb . ,(ly:make-pitch -1 6 SEMI-FLAT))
+ (si . ,(ly:make-pitch -1 6 NATURAL))
+ (sisd . ,(ly:make-pitch -1 6 SEMI-SHARP))
+ (sid . ,(ly:make-pitch -1 6 SHARP))
+ (sidsd . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
+ (sidd . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+
+ ))
;; Language: Norsk -------------------------------------------------;
@@ -631,79 +631,79 @@
;; Norwegian: c d e f g a b h
(norsk . (
- (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (cessess . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (ces . ,(ly:make-pitch -1 0 FLAT))
- (cess . ,(ly:make-pitch -1 0 FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (cis . ,(ly:make-pitch -1 0 SHARP))
- (ciss . ,(ly:make-pitch -1 0 SHARP))
- (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (cississ . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (dessess . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (des . ,(ly:make-pitch -1 1 FLAT))
- (dess . ,(ly:make-pitch -1 1 FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (dis . ,(ly:make-pitch -1 1 SHARP))
- (diss . ,(ly:make-pitch -1 1 SHARP))
- (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (dississ . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (eeses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (eessess . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (essess . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (ees . ,(ly:make-pitch -1 2 FLAT))
- (eess . ,(ly:make-pitch -1 2 FLAT))
- (es . ,(ly:make-pitch -1 2 FLAT))
- (ess . ,(ly:make-pitch -1 2 FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (eis . ,(ly:make-pitch -1 2 SHARP))
- (eiss . ,(ly:make-pitch -1 2 SHARP))
- (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (eississ . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fessess . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fes . ,(ly:make-pitch -1 3 FLAT))
- (fess . ,(ly:make-pitch -1 3 FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fis . ,(ly:make-pitch -1 3 SHARP))
- (fiss . ,(ly:make-pitch -1 3 SHARP))
- (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (fississ . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (gessess . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (ges . ,(ly:make-pitch -1 4 FLAT))
- (gess . ,(ly:make-pitch -1 4 FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (gis . ,(ly:make-pitch -1 4 SHARP))
- (giss . ,(ly:make-pitch -1 4 SHARP))
- (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (gississ . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (aeses . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (aessess . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (assess . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (aes . ,(ly:make-pitch -1 5 FLAT))
- (aess . ,(ly:make-pitch -1 5 FLAT))
- (as . ,(ly:make-pitch -1 5 FLAT))
- (ass . ,(ly:make-pitch -1 5 FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (ais . ,(ly:make-pitch -1 5 SHARP))
- (aiss . ,(ly:make-pitch -1 5 SHARP))
- (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (aississ . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (bes . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (bess . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (b . ,(ly:make-pitch -1 6 FLAT))
- (b . ,(ly:make-pitch -1 6 FLAT))
- (h . ,(ly:make-pitch -1 6 NATURAL))
- (his . ,(ly:make-pitch -1 6 SHARP))
- (hiss . ,(ly:make-pitch -1 6 SHARP))
- (hisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- (hississ . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (cessess . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (ces . ,(ly:make-pitch -1 0 FLAT))
+ (cess . ,(ly:make-pitch -1 0 FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (cis . ,(ly:make-pitch -1 0 SHARP))
+ (ciss . ,(ly:make-pitch -1 0 SHARP))
+ (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (cississ . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (dessess . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (des . ,(ly:make-pitch -1 1 FLAT))
+ (dess . ,(ly:make-pitch -1 1 FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (dis . ,(ly:make-pitch -1 1 SHARP))
+ (diss . ,(ly:make-pitch -1 1 SHARP))
+ (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (dississ . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (eeses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (eessess . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (essess . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (ees . ,(ly:make-pitch -1 2 FLAT))
+ (eess . ,(ly:make-pitch -1 2 FLAT))
+ (es . ,(ly:make-pitch -1 2 FLAT))
+ (ess . ,(ly:make-pitch -1 2 FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (eis . ,(ly:make-pitch -1 2 SHARP))
+ (eiss . ,(ly:make-pitch -1 2 SHARP))
+ (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (eississ . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fessess . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fes . ,(ly:make-pitch -1 3 FLAT))
+ (fess . ,(ly:make-pitch -1 3 FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fis . ,(ly:make-pitch -1 3 SHARP))
+ (fiss . ,(ly:make-pitch -1 3 SHARP))
+ (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (fississ . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (gessess . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (ges . ,(ly:make-pitch -1 4 FLAT))
+ (gess . ,(ly:make-pitch -1 4 FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (gis . ,(ly:make-pitch -1 4 SHARP))
+ (giss . ,(ly:make-pitch -1 4 SHARP))
+ (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (gississ . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (aeses . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (aessess . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (assess . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (aes . ,(ly:make-pitch -1 5 FLAT))
+ (aess . ,(ly:make-pitch -1 5 FLAT))
+ (as . ,(ly:make-pitch -1 5 FLAT))
+ (ass . ,(ly:make-pitch -1 5 FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (ais . ,(ly:make-pitch -1 5 SHARP))
+ (aiss . ,(ly:make-pitch -1 5 SHARP))
+ (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (aississ . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (bes . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (bess . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (b . ,(ly:make-pitch -1 6 FLAT))
+ (b . ,(ly:make-pitch -1 6 FLAT))
+ (h . ,(ly:make-pitch -1 6 NATURAL))
+ (his . ,(ly:make-pitch -1 6 SHARP))
+ (hiss . ,(ly:make-pitch -1 6 SHARP))
+ (hisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ (hississ . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Portugues ---------------------------------------------;
@@ -723,77 +723,77 @@
;; Portuguese: do re mi fa sol la si
(portugues . (
- (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (dobtqt . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
- (dob . ,(ly:make-pitch -1 0 FLAT))
- (dobqt . ,(ly:make-pitch -1 0 SEMI-FLAT))
- (do . ,(ly:make-pitch -1 0 NATURAL))
- (dosqt . ,(ly:make-pitch -1 0 SEMI-SHARP))
- (dos . ,(ly:make-pitch -1 0 SHARP))
- (dostqt . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
- (doss . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
-
- (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (rebtqt . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
- (reb . ,(ly:make-pitch -1 1 FLAT))
- (rebqt . ,(ly:make-pitch -1 1 SEMI-FLAT))
- (re . ,(ly:make-pitch -1 1 NATURAL))
- (resqt . ,(ly:make-pitch -1 1 SEMI-SHARP))
- (res . ,(ly:make-pitch -1 1 SHARP))
- (restqt . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
- (ress . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
-
- (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (mibtqt . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
- (mib . ,(ly:make-pitch -1 2 FLAT))
- (mibqt . ,(ly:make-pitch -1 2 SEMI-FLAT))
- (mi . ,(ly:make-pitch -1 2 NATURAL))
- (misqt . ,(ly:make-pitch -1 2 SEMI-SHARP))
- (mis . ,(ly:make-pitch -1 2 SHARP))
- (mistqt . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
- (miss . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
-
- (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fabtqt . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
- (fab . ,(ly:make-pitch -1 3 FLAT))
- (fabqt . ,(ly:make-pitch -1 3 SEMI-FLAT))
- (fa . ,(ly:make-pitch -1 3 NATURAL))
- (fasqt . ,(ly:make-pitch -1 3 SEMI-SHARP))
- (fas . ,(ly:make-pitch -1 3 SHARP))
- (fastqt . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
- (fass . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
-
- (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (solbtqt . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
- (solb . ,(ly:make-pitch -1 4 FLAT))
- (solbqt . ,(ly:make-pitch -1 4 SEMI-FLAT))
- (sol . ,(ly:make-pitch -1 4 NATURAL))
- (solsqt . ,(ly:make-pitch -1 4 SEMI-SHARP))
- (sols . ,(ly:make-pitch -1 4 SHARP))
- (solstqt . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
- (solss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
-
- (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (labtqt . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
- (lab . ,(ly:make-pitch -1 5 FLAT))
- (labqt . ,(ly:make-pitch -1 5 SEMI-FLAT))
- (la . ,(ly:make-pitch -1 5 NATURAL))
- (lasqt . ,(ly:make-pitch -1 5 SEMI-SHARP))
- (las . ,(ly:make-pitch -1 5 SHARP))
- (lastqt . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
- (lass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
-
- (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (sibtqt . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
- (sib . ,(ly:make-pitch -1 6 FLAT))
- (sibqt . ,(ly:make-pitch -1 6 SEMI-FLAT))
- (si . ,(ly:make-pitch -1 6 NATURAL))
- (sisqt . ,(ly:make-pitch -1 6 SEMI-SHARP))
- (sis . ,(ly:make-pitch -1 6 SHARP))
- (sistqt . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
- (siss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
-
- ))
+ (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (dobtqt . ,(ly:make-pitch -1 0 THREE-Q-FLAT))
+ (dob . ,(ly:make-pitch -1 0 FLAT))
+ (dobqt . ,(ly:make-pitch -1 0 SEMI-FLAT))
+ (do . ,(ly:make-pitch -1 0 NATURAL))
+ (dosqt . ,(ly:make-pitch -1 0 SEMI-SHARP))
+ (dos . ,(ly:make-pitch -1 0 SHARP))
+ (dostqt . ,(ly:make-pitch -1 0 THREE-Q-SHARP))
+ (doss . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+
+ (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (rebtqt . ,(ly:make-pitch -1 1 THREE-Q-FLAT))
+ (reb . ,(ly:make-pitch -1 1 FLAT))
+ (rebqt . ,(ly:make-pitch -1 1 SEMI-FLAT))
+ (re . ,(ly:make-pitch -1 1 NATURAL))
+ (resqt . ,(ly:make-pitch -1 1 SEMI-SHARP))
+ (res . ,(ly:make-pitch -1 1 SHARP))
+ (restqt . ,(ly:make-pitch -1 1 THREE-Q-SHARP))
+ (ress . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+
+ (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (mibtqt . ,(ly:make-pitch -1 2 THREE-Q-FLAT))
+ (mib . ,(ly:make-pitch -1 2 FLAT))
+ (mibqt . ,(ly:make-pitch -1 2 SEMI-FLAT))
+ (mi . ,(ly:make-pitch -1 2 NATURAL))
+ (misqt . ,(ly:make-pitch -1 2 SEMI-SHARP))
+ (mis . ,(ly:make-pitch -1 2 SHARP))
+ (mistqt . ,(ly:make-pitch -1 2 THREE-Q-SHARP))
+ (miss . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+
+ (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fabtqt . ,(ly:make-pitch -1 3 THREE-Q-FLAT))
+ (fab . ,(ly:make-pitch -1 3 FLAT))
+ (fabqt . ,(ly:make-pitch -1 3 SEMI-FLAT))
+ (fa . ,(ly:make-pitch -1 3 NATURAL))
+ (fasqt . ,(ly:make-pitch -1 3 SEMI-SHARP))
+ (fas . ,(ly:make-pitch -1 3 SHARP))
+ (fastqt . ,(ly:make-pitch -1 3 THREE-Q-SHARP))
+ (fass . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+
+ (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (solbtqt . ,(ly:make-pitch -1 4 THREE-Q-FLAT))
+ (solb . ,(ly:make-pitch -1 4 FLAT))
+ (solbqt . ,(ly:make-pitch -1 4 SEMI-FLAT))
+ (sol . ,(ly:make-pitch -1 4 NATURAL))
+ (solsqt . ,(ly:make-pitch -1 4 SEMI-SHARP))
+ (sols . ,(ly:make-pitch -1 4 SHARP))
+ (solstqt . ,(ly:make-pitch -1 4 THREE-Q-SHARP))
+ (solss . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+
+ (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (labtqt . ,(ly:make-pitch -1 5 THREE-Q-FLAT))
+ (lab . ,(ly:make-pitch -1 5 FLAT))
+ (labqt . ,(ly:make-pitch -1 5 SEMI-FLAT))
+ (la . ,(ly:make-pitch -1 5 NATURAL))
+ (lasqt . ,(ly:make-pitch -1 5 SEMI-SHARP))
+ (las . ,(ly:make-pitch -1 5 SHARP))
+ (lastqt . ,(ly:make-pitch -1 5 THREE-Q-SHARP))
+ (lass . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+
+ (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (sibtqt . ,(ly:make-pitch -1 6 THREE-Q-FLAT))
+ (sib . ,(ly:make-pitch -1 6 FLAT))
+ (sibqt . ,(ly:make-pitch -1 6 SEMI-FLAT))
+ (si . ,(ly:make-pitch -1 6 NATURAL))
+ (sisqt . ,(ly:make-pitch -1 6 SEMI-SHARP))
+ (sis . ,(ly:make-pitch -1 6 SHARP))
+ (sistqt . ,(ly:make-pitch -1 6 THREE-Q-SHARP))
+ (siss . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+
+ ))
;; Language: Suomi -------------------------------------------------;
@@ -809,45 +809,45 @@
;; Finnish: c d e f g a b h
(suomi . (
- (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (ces . ,(ly:make-pitch -1 0 FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (cis . ,(ly:make-pitch -1 0 SHARP))
- (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (des . ,(ly:make-pitch -1 1 FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (dis . ,(ly:make-pitch -1 1 SHARP))
- (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (es . ,(ly:make-pitch -1 2 FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (eis . ,(ly:make-pitch -1 2 SHARP))
- (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fes . ,(ly:make-pitch -1 3 FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fis . ,(ly:make-pitch -1 3 SHARP))
- (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (ges . ,(ly:make-pitch -1 4 FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (gis . ,(ly:make-pitch -1 4 SHARP))
- (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (asas . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT)) ;;non-standard name for asas
- (as . ,(ly:make-pitch -1 5 FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (ais . ,(ly:make-pitch -1 5 SHARP))
- (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (bb . ,(ly:make-pitch -1 6 DOUBLE-FLAT)) ;; should be bes. Kept for downwards compatibility
- (bes . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (heses . ,(ly:make-pitch -1 6 DOUBLE-FLAT)) ;;non-standard name for bb
- (b . ,(ly:make-pitch -1 6 FLAT))
- (h . ,(ly:make-pitch -1 6 NATURAL))
- (his . ,(ly:make-pitch -1 6 SHARP))
- (hisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (ceses . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (ces . ,(ly:make-pitch -1 0 FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (cis . ,(ly:make-pitch -1 0 SHARP))
+ (cisis . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (deses . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (des . ,(ly:make-pitch -1 1 FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (dis . ,(ly:make-pitch -1 1 SHARP))
+ (disis . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (eses . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (es . ,(ly:make-pitch -1 2 FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (eis . ,(ly:make-pitch -1 2 SHARP))
+ (eisis . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (feses . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fes . ,(ly:make-pitch -1 3 FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fis . ,(ly:make-pitch -1 3 SHARP))
+ (fisis . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (geses . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (ges . ,(ly:make-pitch -1 4 FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (gis . ,(ly:make-pitch -1 4 SHARP))
+ (gisis . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (asas . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (ases . ,(ly:make-pitch -1 5 DOUBLE-FLAT)) ;;non-standard name for asas
+ (as . ,(ly:make-pitch -1 5 FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (ais . ,(ly:make-pitch -1 5 SHARP))
+ (aisis . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (bb . ,(ly:make-pitch -1 6 DOUBLE-FLAT)) ;; should be bes. Kept for downwards compatibility
+ (bes . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (heses . ,(ly:make-pitch -1 6 DOUBLE-FLAT)) ;;non-standard name for bb
+ (b . ,(ly:make-pitch -1 6 FLAT))
+ (h . ,(ly:make-pitch -1 6 NATURAL))
+ (his . ,(ly:make-pitch -1 6 SHARP))
+ (hisis . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Svenska -----------------------------------------------;
@@ -863,42 +863,42 @@
;; Swedish: c d e f g a b h
(svenska . (
- (cessess . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (cess . ,(ly:make-pitch -1 0 FLAT))
- (c . ,(ly:make-pitch -1 0 NATURAL))
- (ciss . ,(ly:make-pitch -1 0 SHARP))
- (cississ . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
- (dessess . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (dess . ,(ly:make-pitch -1 1 FLAT))
- (d . ,(ly:make-pitch -1 1 NATURAL))
- (diss . ,(ly:make-pitch -1 1 SHARP))
- (dississ . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
- (essess . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (ess . ,(ly:make-pitch -1 2 FLAT))
- (e . ,(ly:make-pitch -1 2 NATURAL))
- (eiss . ,(ly:make-pitch -1 2 SHARP))
- (eississ . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
- (fessess . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fess . ,(ly:make-pitch -1 3 FLAT))
- (f . ,(ly:make-pitch -1 3 NATURAL))
- (fiss . ,(ly:make-pitch -1 3 SHARP))
- (fississ . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
- (gessess . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (gess . ,(ly:make-pitch -1 4 FLAT))
- (g . ,(ly:make-pitch -1 4 NATURAL))
- (giss . ,(ly:make-pitch -1 4 SHARP))
- (gississ . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
- (assess . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (ass . ,(ly:make-pitch -1 5 FLAT))
- (a . ,(ly:make-pitch -1 5 NATURAL))
- (aiss . ,(ly:make-pitch -1 5 SHARP))
- (aississ . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
- (hessess . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (b . ,(ly:make-pitch -1 6 FLAT))
- (h . ,(ly:make-pitch -1 6 NATURAL))
- (hiss . ,(ly:make-pitch -1 6 SHARP))
- (hississ . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (cessess . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (cess . ,(ly:make-pitch -1 0 FLAT))
+ (c . ,(ly:make-pitch -1 0 NATURAL))
+ (ciss . ,(ly:make-pitch -1 0 SHARP))
+ (cississ . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+ (dessess . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (dess . ,(ly:make-pitch -1 1 FLAT))
+ (d . ,(ly:make-pitch -1 1 NATURAL))
+ (diss . ,(ly:make-pitch -1 1 SHARP))
+ (dississ . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+ (essess . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (ess . ,(ly:make-pitch -1 2 FLAT))
+ (e . ,(ly:make-pitch -1 2 NATURAL))
+ (eiss . ,(ly:make-pitch -1 2 SHARP))
+ (eississ . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+ (fessess . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fess . ,(ly:make-pitch -1 3 FLAT))
+ (f . ,(ly:make-pitch -1 3 NATURAL))
+ (fiss . ,(ly:make-pitch -1 3 SHARP))
+ (fississ . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+ (gessess . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (gess . ,(ly:make-pitch -1 4 FLAT))
+ (g . ,(ly:make-pitch -1 4 NATURAL))
+ (giss . ,(ly:make-pitch -1 4 SHARP))
+ (gississ . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+ (assess . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (ass . ,(ly:make-pitch -1 5 FLAT))
+ (a . ,(ly:make-pitch -1 5 NATURAL))
+ (aiss . ,(ly:make-pitch -1 5 SHARP))
+ (aississ . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+ (hessess . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (b . ,(ly:make-pitch -1 6 FLAT))
+ (h . ,(ly:make-pitch -1 6 NATURAL))
+ (hiss . ,(ly:make-pitch -1 6 SHARP))
+ (hississ . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
;; Language: Vlaams ------------------------------------------------;
@@ -914,48 +914,48 @@
;; Flemish: do re mi fa sol la si
(vlaams . (
- (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
- (dob . ,(ly:make-pitch -1 0 FLAT))
- (do . ,(ly:make-pitch -1 0 NATURAL))
- (dok . ,(ly:make-pitch -1 0 SHARP))
- (dokk . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
-
- (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
- (reb . ,(ly:make-pitch -1 1 FLAT))
- (re . ,(ly:make-pitch -1 1 NATURAL))
- (rek . ,(ly:make-pitch -1 1 SHARP))
- (rekk . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
-
- (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
- (mib . ,(ly:make-pitch -1 2 FLAT))
- (mi . ,(ly:make-pitch -1 2 NATURAL))
- (mik . ,(ly:make-pitch -1 2 SHARP))
- (mikk . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
-
- (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
- (fab . ,(ly:make-pitch -1 3 FLAT))
- (fa . ,(ly:make-pitch -1 3 NATURAL))
- (fak . ,(ly:make-pitch -1 3 SHARP))
- (fakk . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
-
- (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
- (solb . ,(ly:make-pitch -1 4 FLAT))
- (sol . ,(ly:make-pitch -1 4 NATURAL))
- (solk . ,(ly:make-pitch -1 4 SHARP))
- (solkk . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
-
- (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
- (lab . ,(ly:make-pitch -1 5 FLAT))
- (la . ,(ly:make-pitch -1 5 NATURAL))
- (lak . ,(ly:make-pitch -1 5 SHARP))
- (lakk . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
-
- (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
- (sib . ,(ly:make-pitch -1 6 FLAT))
- (si . ,(ly:make-pitch -1 6 NATURAL))
- (sik . ,(ly:make-pitch -1 6 SHARP))
- (sikk . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
- ))
+ (dobb . ,(ly:make-pitch -1 0 DOUBLE-FLAT))
+ (dob . ,(ly:make-pitch -1 0 FLAT))
+ (do . ,(ly:make-pitch -1 0 NATURAL))
+ (dok . ,(ly:make-pitch -1 0 SHARP))
+ (dokk . ,(ly:make-pitch -1 0 DOUBLE-SHARP))
+
+ (rebb . ,(ly:make-pitch -1 1 DOUBLE-FLAT))
+ (reb . ,(ly:make-pitch -1 1 FLAT))
+ (re . ,(ly:make-pitch -1 1 NATURAL))
+ (rek . ,(ly:make-pitch -1 1 SHARP))
+ (rekk . ,(ly:make-pitch -1 1 DOUBLE-SHARP))
+
+ (mibb . ,(ly:make-pitch -1 2 DOUBLE-FLAT))
+ (mib . ,(ly:make-pitch -1 2 FLAT))
+ (mi . ,(ly:make-pitch -1 2 NATURAL))
+ (mik . ,(ly:make-pitch -1 2 SHARP))
+ (mikk . ,(ly:make-pitch -1 2 DOUBLE-SHARP))
+
+ (fabb . ,(ly:make-pitch -1 3 DOUBLE-FLAT))
+ (fab . ,(ly:make-pitch -1 3 FLAT))
+ (fa . ,(ly:make-pitch -1 3 NATURAL))
+ (fak . ,(ly:make-pitch -1 3 SHARP))
+ (fakk . ,(ly:make-pitch -1 3 DOUBLE-SHARP))
+
+ (solbb . ,(ly:make-pitch -1 4 DOUBLE-FLAT))
+ (solb . ,(ly:make-pitch -1 4 FLAT))
+ (sol . ,(ly:make-pitch -1 4 NATURAL))
+ (solk . ,(ly:make-pitch -1 4 SHARP))
+ (solkk . ,(ly:make-pitch -1 4 DOUBLE-SHARP))
+
+ (labb . ,(ly:make-pitch -1 5 DOUBLE-FLAT))
+ (lab . ,(ly:make-pitch -1 5 FLAT))
+ (la . ,(ly:make-pitch -1 5 NATURAL))
+ (lak . ,(ly:make-pitch -1 5 SHARP))
+ (lakk . ,(ly:make-pitch -1 5 DOUBLE-SHARP))
+
+ (sibb . ,(ly:make-pitch -1 6 DOUBLE-FLAT))
+ (sib . ,(ly:make-pitch -1 6 FLAT))
+ (si . ,(ly:make-pitch -1 6 NATURAL))
+ (sik . ,(ly:make-pitch -1 6 SHARP))
+ (sikk . ,(ly:make-pitch -1 6 DOUBLE-SHARP))
+ ))
))
;; add two native utf-8 aliases. Pairs obey cp-like order: '(old new)
@@ -970,11 +970,11 @@
(define-public (note-names-language parser str)
(_ "Select note names language.")
(let ((alist (assoc-get (string->symbol str)
- language-pitch-names
- '())))
+ language-pitch-names
+ '())))
(if (pair? alist)
- (begin
- (ly:debug (_ "Using `~a' note names...") str)
- (set! pitchnames alist)
- (ly:parser-set-note-names parser alist))
- (ly:warning (_ "Could not find language `~a'. Ignoring.") str))))
+ (begin
+ (ly:debug (_ "Using `~a' note names...") str)
+ (set! pitchnames alist)
+ (ly:parser-set-note-names parser alist))
+ (ly:warning (_ "Could not find language `~a'. Ignoring.") str))))
diff --git a/scm/define-stencil-commands.scm b/scm/define-stencil-commands.scm
index fddd6855b2..dffb578c6e 100644
--- a/scm/define-stencil-commands.scm
+++ b/scm/define-stencil-commands.scm
@@ -70,5 +70,5 @@ are used internally in @file{lily/@/stencil-interpret.cc}."
))
(map ly:register-stencil-expression
- (append (ly:all-stencil-commands)
- (ly:all-output-backend-commands)))
+ (append (ly:all-stencil-commands)
+ (ly:all-output-backend-commands)))
diff --git a/scm/define-woodwind-diagrams.scm b/scm/define-woodwind-diagrams.scm
index 513fca520d..cffe25c07d 100644
--- a/scm/define-woodwind-diagrams.scm
+++ b/scm/define-woodwind-diagrams.scm
@@ -34,10 +34,10 @@ are provided in @var{function-list}.
Example: Executing @samp{(function-chain 1 `((,+ 1) (,- 2) (,+ 3) (,/)))}
returns @samp{1/3}."
(if (null? function-list)
- arg
- (function-chain
- (apply (caar function-list) (append `(,arg) (cdar function-list)))
- (cdr function-list))))
+ arg
+ (function-chain
+ (apply (caar function-list) (append `(,arg) (cdar function-list)))
+ (cdr function-list))))
(define (rotunda-map function inlist rotunda)
"Like map, but with a rotating last argument to function.
@@ -46,12 +46,12 @@ returns @samp{1/3}."
@code{(2 -8 4 -6)}"
(define (rotunda-map-chain function inlist outlist rotunda)
(if (null? inlist)
- outlist
- (rotunda-map-chain
- function
- (cdr inlist)
- (append outlist (list (function (car inlist) (car rotunda))))
- (append (cdr rotunda) (list (car rotunda))))))
+ outlist
+ (rotunda-map-chain
+ function
+ (cdr inlist)
+ (append outlist (list (function (car inlist) (car rotunda))))
+ (append (cdr rotunda) (list (car rotunda))))))
(rotunda-map-chain function inlist '() rotunda))
(define (assoc-keys alist)
@@ -68,9 +68,9 @@ returns @samp{1/3}."
@code{(get-slope-offset '(1 . 2) '(3 . -5.1))}
@code{(-3.55 . 5.55)}"
(let*
- ((slope (/ (- (cdr p1) (cdr p2)) (- (car p1) (car p2))))
- (offset (- (cdr p1) (* slope (car p1)))))
- `(,slope . ,offset)))
+ ((slope (/ (- (cdr p1) (cdr p2)) (- (car p1) (car p2))))
+ (offset (- (cdr p1) (* slope (car p1)))))
+ `(,slope . ,offset)))
(define (is-square? x input-list)
"Returns true if x is the square of a value in input-list."
@@ -97,17 +97,17 @@ returns @samp{1/3}."
;; Translates a "normal" key (open, closed, trill)
(define (key-fill-translate fill)
(cond
- ((= fill 1) #f)
- ((= fill 2) #f)
- ((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5)
- ((= fill (assoc-get 'F HOLE-FILL-LIST)) #t)))
+ ((= fill 1) #f)
+ ((= fill 2) #f)
+ ((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5)
+ ((= fill (assoc-get 'F HOLE-FILL-LIST)) #t)))
;; Similar to above, but trans vs opaque doesn't matter
(define (text-fill-translate fill)
(cond
- ((< fill 3) 1.0)
- ((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5)
- ((= fill (assoc-get 'F HOLE-FILL-LIST)) 0.0)))
+ ((< fill 3) 1.0)
+ ((= fill (expt (assoc-get 'F HOLE-FILL-LIST) 2)) 0.5)
+ ((= fill (assoc-get 'F HOLE-FILL-LIST)) 0.0)))
;; Emits a list for the central-column-hole maker
;; (not-full?, 1-quarter-full?, 1-half-full?, 3-quarters-full?, full?)
@@ -115,8 +115,8 @@ returns @samp{1/3}."
;; not-full and 3-quarters-full
(define (process-fill-value fill)
(let* ((avals (list-tail (assoc-values HOLE-FILL-LIST) 1)))
- (append `(,(or (< fill 3) (is-square? fill avals)))
- (map (lambda (x) (= 0 (remainder fill x))) avals))))
+ (append `(,(or (< fill 3) (is-square? fill avals)))
+ (map (lambda (x) (= 0 (remainder fill x))) avals))))
;; Color a stencil gray
(define (gray-colorize stencil)
@@ -126,26 +126,26 @@ returns @samp{1/3}."
(define (rich-path-stencil ls x-stretch y-stretch proc)
(lambda (radius thick fill layout props)
(let*
- ((fill-translate (key-fill-translate fill))
- (gray? (eqv? fill-translate 0.5)))
- (ly:stencil-add
- ((if gray? gray-colorize identity)
- (proc
- (make-connected-path-stencil
- ls
- thick
- (* x-stretch radius)
- (* y-stretch radius)
- #f
- (if gray? #t fill-translate))))
- (if (not gray?)
- empty-stencil
- ((rich-path-stencil ls x-stretch y-stretch proc)
- radius
- thick
- 1
- layout
- props))))))
+ ((fill-translate (key-fill-translate fill))
+ (gray? (eqv? fill-translate 0.5)))
+ (ly:stencil-add
+ ((if gray? gray-colorize identity)
+ (proc
+ (make-connected-path-stencil
+ ls
+ thick
+ (* x-stretch radius)
+ (* y-stretch radius)
+ #f
+ (if gray? #t fill-translate))))
+ (if (not gray?)
+ empty-stencil
+ ((rich-path-stencil ls x-stretch y-stretch proc)
+ radius
+ thick
+ 1
+ layout
+ props))))))
;; A connected path stencil without a surrounding proc
(define (standard-path-stencil ls x-stretch y-stretch)
@@ -155,49 +155,49 @@ returns @samp{1/3}."
(define (rich-pe-stencil x-stretch y-stretch start end proc)
(lambda (radius thick fill layout props)
(let*
- ((fill-translate (key-fill-translate fill))
- (gray? (eqv? fill-translate 0.5)))
- (ly:stencil-add
- ((if gray? gray-colorize identity)
- (proc
- (make-partial-ellipse-stencil
- (* x-stretch radius)
- (* y-stretch radius)
- start
- end
- thick
- #t
- (if gray? #t fill-translate))))
- (if (not gray?)
- empty-stencil
- ((rich-pe-stencil x-stretch y-stretch start end proc)
- radius
- thick
- 1
- layout
- props))))))
+ ((fill-translate (key-fill-translate fill))
+ (gray? (eqv? fill-translate 0.5)))
+ (ly:stencil-add
+ ((if gray? gray-colorize identity)
+ (proc
+ (make-partial-ellipse-stencil
+ (* x-stretch radius)
+ (* y-stretch radius)
+ start
+ end
+ thick
+ #t
+ (if gray? #t fill-translate))))
+ (if (not gray?)
+ empty-stencil
+ ((rich-pe-stencil x-stretch y-stretch start end proc)
+ radius
+ thick
+ 1
+ layout
+ props))))))
(define (rich-e-stencil x-stretch y-stretch proc)
(lambda (radius thick fill layout props)
(let*
- ((fill-translate (key-fill-translate fill))
- (gray? (eqv? fill-translate 0.5)))
- (ly:stencil-add
- ((if gray? gray-colorize identity)
- (proc
- (make-ellipse-stencil
+ ((fill-translate (key-fill-translate fill))
+ (gray? (eqv? fill-translate 0.5)))
+ (ly:stencil-add
+ ((if gray? gray-colorize identity)
+ (proc
+ (make-ellipse-stencil
(* x-stretch radius)
(* y-stretch radius)
thick
(if gray? #t fill-translate))))
- (if (not gray?)
- empty-stencil
- ((rich-e-stencil x-stretch y-stretch proc)
- radius
- thick
- 1
- layout
- props))))))
+ (if (not gray?)
+ empty-stencil
+ ((rich-e-stencil x-stretch y-stretch proc)
+ radius
+ thick
+ 1
+ layout
+ props))))))
;; An ellipse stencil without a surrounding proc
(define (standard-e-stencil x-stretch y-stretch)
@@ -210,36 +210,36 @@ returns @samp{1/3}."
(define (make-symbol-alist symbol simple? ring?)
(filter (lambda (x)
(not
- (equal?
- x
- `(,(symbol-concatenate symbol 'T 'F) .
- ,(expt (assoc-get 'F HOLE-FILL-LIST) 2)))))
+ (equal?
+ x
+ `(,(symbol-concatenate symbol 'T 'F) .
+ ,(expt (assoc-get 'F HOLE-FILL-LIST) 2)))))
(append
- `((,symbol . ,(assoc-get 'F HOLE-FILL-LIST))
- (,(symbol-concatenate symbol 'T) .
- ,(expt (assoc-get 'F HOLE-FILL-LIST) 2)))
- (if simple?
- '()
- (apply append
- (map (lambda (x)
- (append
- `((,(symbol-concatenate symbol (car x) 'T)
- . ,(expt (cdr x) 2))
- (,(symbol-concatenate symbol 'T (car x))
- . ,(* (cdr x) (assoc-get 'F HOLE-FILL-LIST)))
- (,(symbol-concatenate symbol (car x))
- . ,(cdr x)))
- (apply append
- (map (lambda (y)
- (map (lambda (a b)
- `(,(symbol-concatenate symbol
- (car a)
- 'T
- (car b))
- . ,(* (cdr a) (cdr b))))
- `(,x ,y) `(,y ,x)))
- (cdr (member x HOLE-FILL-LIST))))))
- (if ring? HOLE-FILL-LIST (cdr HOLE-FILL-LIST))))))))
+ `((,symbol . ,(assoc-get 'F HOLE-FILL-LIST))
+ (,(symbol-concatenate symbol 'T) .
+ ,(expt (assoc-get 'F HOLE-FILL-LIST) 2)))
+ (if simple?
+ '()
+ (apply append
+ (map (lambda (x)
+ (append
+ `((,(symbol-concatenate symbol (car x) 'T)
+ . ,(expt (cdr x) 2))
+ (,(symbol-concatenate symbol 'T (car x))
+ . ,(* (cdr x) (assoc-get 'F HOLE-FILL-LIST)))
+ (,(symbol-concatenate symbol (car x))
+ . ,(cdr x)))
+ (apply append
+ (map (lambda (y)
+ (map (lambda (a b)
+ `(,(symbol-concatenate symbol
+ (car a)
+ 'T
+ (car b))
+ . ,(* (cdr a) (cdr b))))
+ `(,x ,y) `(,y ,x)))
+ (cdr (member x HOLE-FILL-LIST))))))
+ (if ring? HOLE-FILL-LIST (cdr HOLE-FILL-LIST))))))))
;;; Commands for text layout
@@ -248,50 +248,50 @@ returns @samp{1/3}."
(conditional-circle-markup layout props trigger in-markup)
(number? markup?)
(interpret-markup layout props
- (if (eqv? trigger 0.5)
- (markup #:circle (markup in-markup))
- (markup in-markup))))
+ (if (eqv? trigger 0.5)
+ (markup #:circle (markup in-markup))
+ (markup in-markup))))
;; Makes a list of named-keys
(define (make-name-keylist input-list key-list font-size)
(map (lambda (x y)
(if (< x 1)
- (markup #:conditional-circle-markup
- x
- (make-concat-markup
- (list
- (markup #:abs-fontsize font-size (car y))
- (if (and (< x 1) (cdr y))
- (if (eqv? (cdr y) 1)
- (markup
- #:abs-fontsize
- font-size
- #:raise
- 1
- #:fontsize
- -2
- #:sharp)
- (markup
- #:abs-fontsize
- font-size
- #:raise
- 1
- #:fontsize
- -2
- #:flat))
- (markup #:null)))))
- (markup #:null)))
- input-list key-list))
+ (markup #:conditional-circle-markup
+ x
+ (make-concat-markup
+ (list
+ (markup #:abs-fontsize font-size (car y))
+ (if (and (< x 1) (cdr y))
+ (if (eqv? (cdr y) 1)
+ (markup
+ #:abs-fontsize
+ font-size
+ #:raise
+ 1
+ #:fontsize
+ -2
+ #:sharp)
+ (markup
+ #:abs-fontsize
+ font-size
+ #:raise
+ 1
+ #:fontsize
+ -2
+ #:flat))
+ (markup #:null)))))
+ (markup #:null)))
+ input-list key-list))
;; Makes a list of number-keys
(define (make-number-keylist input-list key-list font-size)
(map (lambda (x y)
(if (< x 1)
- (markup
- #:conditional-circle-markup
- x
- (markup #:abs-fontsize font-size #:number y))
- (markup #:null)))
+ (markup
+ #:conditional-circle-markup
+ x
+ (markup #:abs-fontsize font-size #:number y))
+ (markup #:null)))
input-list
key-list))
@@ -299,35 +299,35 @@ returns @samp{1/3}."
(define (aligned-text-stencil-function dir hv)
(lambda (key-name-list radius fill-list layout props)
(interpret-markup
- layout
- props
- (make-general-align-markup
- X
- dir
- ((if hv make-concat-markup make-center-column-markup)
- (make-name-keylist
- (map text-fill-translate fill-list)
- key-name-list
- (* 12 radius)))))))
+ layout
+ props
+ (make-general-align-markup
+ X
+ dir
+ ((if hv make-concat-markup make-center-column-markup)
+ (make-name-keylist
+ (map text-fill-translate fill-list)
+ key-name-list
+ (* 12 radius)))))))
(define number-column-stencil
(lambda (key-name-list radius fill-list layout props)
(interpret-markup
- layout
- props
+ layout
+ props
+ (make-general-align-markup
+ Y
+ CENTER
(make-general-align-markup
- Y
- CENTER
- (make-general-align-markup
- X
- RIGHT
- (make-override-markup
- '(baseline-skip . 0)
- (make-column-markup
- (make-number-keylist
- (map text-fill-translate fill-list)
- key-name-list
- (* radius 8)))))))))
+ X
+ RIGHT
+ (make-override-markup
+ '(baseline-skip . 0)
+ (make-column-markup
+ (make-number-keylist
+ (map text-fill-translate fill-list)
+ key-name-list
+ (* radius 8)))))))))
;; Utility function for the left-hand keys
(define lh-woodwind-text-stencil
@@ -344,17 +344,17 @@ returns @samp{1/3}."
(define (rich-group-draw-rule alist target-part change-part)
(if
- (entry-greater-than-x?
- (map (lambda (key) (assoc-get key alist)) target-part) 3)
- (map-selected-alist-keys (lambda (x) (if (= x 0) 1 x)) change-part alist)
- alist))
+ (entry-greater-than-x?
+ (map (lambda (key) (assoc-get key alist)) target-part) 3)
+ (map-selected-alist-keys (lambda (x) (if (= x 0) 1 x)) change-part alist)
+ alist))
(define (bassoon-midline-rule alist target-part)
(if
- (entry-greater-than-x?
- (map (lambda (key) (assoc-get key alist)) target-part) 0)
- (map-selected-alist-keys (lambda (x) 1) '((hidden . long-midline)) alist)
- (map-selected-alist-keys (lambda (x) 1) '((hidden . midline)) alist)))
+ (entry-greater-than-x?
+ (map (lambda (key) (assoc-get key alist)) target-part) 0)
+ (map-selected-alist-keys (lambda (x) 1) '((hidden . long-midline)) alist)
+ (map-selected-alist-keys (lambda (x) 1) '((hidden . midline)) alist)))
(define (group-draw-rule alist target-part)
(rich-group-draw-rule alist target-part target-part))
@@ -364,28 +364,28 @@ returns @samp{1/3}."
(define (apply-group-draw-rule-series alist target-part-list)
(if (null? target-part-list)
- alist
- (apply-group-draw-rule-series
- (group-draw-rule alist (car target-part-list))
- (cdr target-part-list))))
+ alist
+ (apply-group-draw-rule-series
+ (group-draw-rule alist (car target-part-list))
+ (cdr target-part-list))))
;; Extra-offset rules
(define (rich-group-extra-offset-rule alist target-part change-part eos)
(if
- (entry-greater-than-x?
- (map (lambda (key) (assoc-get key alist)) target-part) 0)
- (map-selected-alist-keys (lambda (x) eos) change-part alist)
- alist))
+ (entry-greater-than-x?
+ (map (lambda (key) (assoc-get key alist)) target-part) 0)
+ (map-selected-alist-keys (lambda (x) eos) change-part alist)
+ alist))
(define (group-extra-offset-rule alist target-part eos)
(rich-group-extra-offset-rule alist target-part target-part eos))
(define (uniform-extra-offset-rule alist eos)
(map-selected-alist-keys
- (lambda (x) (if (pair? x) x eos))
- (assoc-keys alist)
- alist))
+ (lambda (x) (if (pair? x) x eos))
+ (assoc-keys alist)
+ alist))
;;; General drawing commands
@@ -402,29 +402,29 @@ returns @samp{1/3}."
;; Used for several upper keys in the clarinet and sax
(define (upper-key-stencil tailw tailh bodyw bodyh)
(let*
- ((xmove (lambda (x) (+ tailw (+ 0.2 (* bodyw (- x 0.2))))))
- (ymove (lambda (x) (+ (- tailh) (+ -0.05 (* bodyh (+ x 0.05)))))))
- (standard-path-stencil
- `((,(xmove 0.7)
- ,(ymove -0.2)
- ,(xmove 1.0)
- ,(ymove -1.0)
- ,(xmove 0.5)
- ,(ymove -1.0))
- (,(xmove 0.2)
- ,(ymove -1.0)
- ,(xmove 0.2)
- ,(ymove -0.2)
- ,(xmove 0.3)
- ,(ymove -0.1))
- (,(+ 0.2 tailw)
- ,(- -0.05 tailh)
- ,(+ 0.1 (/ tailw 2))
- ,(- -0.025 (/ tailh 2))
- 0.0
- 0.0))
- 1.0
- 1.0)))
+ ((xmove (lambda (x) (+ tailw (+ 0.2 (* bodyw (- x 0.2))))))
+ (ymove (lambda (x) (+ (- tailh) (+ -0.05 (* bodyh (+ x 0.05)))))))
+ (standard-path-stencil
+ `((,(xmove 0.7)
+ ,(ymove -0.2)
+ ,(xmove 1.0)
+ ,(ymove -1.0)
+ ,(xmove 0.5)
+ ,(ymove -1.0))
+ (,(xmove 0.2)
+ ,(ymove -1.0)
+ ,(xmove 0.2)
+ ,(ymove -0.2)
+ ,(xmove 0.3)
+ ,(ymove -0.1))
+ (,(+ 0.2 tailw)
+ ,(- -0.05 tailh)
+ ,(+ 0.1 (/ tailw 2))
+ ,(- -0.025 (/ tailh 2))
+ 0.0
+ 0.0))
+ 1.0
+ 1.0)))
;; Utility function for the column-hole maker.
;; Returns the left and right degrees for the drawing of a given
@@ -432,23 +432,23 @@ returns @samp{1/3}."
(define (degree-first-true fill-list left? reverse?)
(define (dfl-crawler fill-list os-list left?)
(if (car fill-list)
- ((if left? car cdr) (car os-list))
- (dfl-crawler (cdr fill-list) (cdr os-list) left?)))
+ ((if left? car cdr) (car os-list))
+ (dfl-crawler (cdr fill-list) (cdr os-list) left?)))
(dfl-crawler
- ((if reverse? reverse identity) fill-list)
- ((if reverse? reverse identity)
- '((0 . 0) (215 . 325) (180 . 0) (145 . 35) (90 . 90)))
- left?))
+ ((if reverse? reverse identity) fill-list)
+ ((if reverse? reverse identity)
+ '((0 . 0) (215 . 325) (180 . 0) (145 . 35) (90 . 90)))
+ left?))
;; Gets the position of the first (or last if reverse?) element of a list.
(define (position-true-endpoint in-list reverse?)
(define (pte-crawler in-list n)
(if (car in-list)
- n
- (pte-crawler (cdr in-list) (+ n 1))))
+ n
+ (pte-crawler (cdr in-list) (+ n 1))))
((if reverse? - +)
- (if reverse? (length in-list) 0)
- (pte-crawler ((if reverse? reverse identity) in-list) 0)))
+ (if reverse? (length in-list) 0)
+ (pte-crawler ((if reverse? reverse identity) in-list) 0)))
;; Huge, kind-of-ugly maker of a circle in a column.
;; I think this is the clearest way to write it, though...
@@ -456,57 +456,57 @@ returns @samp{1/3}."
(define (column-circle-stencil radius thick fill layout props)
(let* ((fill-list (process-fill-value fill)))
(cond
- ((and
- (list-ref fill-list 0)
- (not (true-entry? (list-tail fill-list 1)))) ; is it empty?
- ((standard-e-stencil 1.0 1.0) radius thick fill layout props))
- ((and
- (list-ref fill-list 4)
- (not (true-entry? (list-head fill-list 4)))) ; is it full?
- ((standard-e-stencil 1.0 1.0) radius thick fill layout props))
- ((and
- (list-ref fill-list 0)
- (list-ref fill-list 4)) ; is it a trill between empty and full?
- ((standard-e-stencil 1.0 1.0) radius thick fill layout props))
- (else ;If none of these, it is partially full.
- (ly:stencil-add
- ((rich-pe-stencil 1.0 1.0 0 360 identity)
- radius
- thick
- (if (list-ref fill-list 4)
- (expt (assoc-get 'F HOLE-FILL-LIST) 2)
- 1)
- layout
- props)
- ((rich-pe-stencil
- 1.0
- 1.0
- (degree-first-true fill-list #t #t)
- (degree-first-true fill-list #f #t)
- identity)
- radius
- thick
- (if
- (true-entry?
- (list-head fill-list (position-true-endpoint fill-list #t)))
- (expt (assoc-get 'F HOLE-FILL-LIST) 2)
- (assoc-get 'F HOLE-FILL-LIST))
- layout
- props)
- (if
- (= 2 (n-true-entries (list-tail fill-list 1))) ; trill?
- ((rich-pe-stencil
- 1.0
- 1.0
- (degree-first-true fill-list #t #f)
- (degree-first-true fill-list #f #f)
- identity)
- radius
- thick
- (assoc-get 'F HOLE-FILL-LIST)
- layout
- props)
- empty-stencil))))))
+ ((and
+ (list-ref fill-list 0)
+ (not (true-entry? (list-tail fill-list 1)))) ; is it empty?
+ ((standard-e-stencil 1.0 1.0) radius thick fill layout props))
+ ((and
+ (list-ref fill-list 4)
+ (not (true-entry? (list-head fill-list 4)))) ; is it full?
+ ((standard-e-stencil 1.0 1.0) radius thick fill layout props))
+ ((and
+ (list-ref fill-list 0)
+ (list-ref fill-list 4)) ; is it a trill between empty and full?
+ ((standard-e-stencil 1.0 1.0) radius thick fill layout props))
+ (else ;If none of these, it is partially full.
+ (ly:stencil-add
+ ((rich-pe-stencil 1.0 1.0 0 360 identity)
+ radius
+ thick
+ (if (list-ref fill-list 4)
+ (expt (assoc-get 'F HOLE-FILL-LIST) 2)
+ 1)
+ layout
+ props)
+ ((rich-pe-stencil
+ 1.0
+ 1.0
+ (degree-first-true fill-list #t #t)
+ (degree-first-true fill-list #f #t)
+ identity)
+ radius
+ thick
+ (if
+ (true-entry?
+ (list-head fill-list (position-true-endpoint fill-list #t)))
+ (expt (assoc-get 'F HOLE-FILL-LIST) 2)
+ (assoc-get 'F HOLE-FILL-LIST))
+ layout
+ props)
+ (if
+ (= 2 (n-true-entries (list-tail fill-list 1))) ; trill?
+ ((rich-pe-stencil
+ 1.0
+ 1.0
+ (degree-first-true fill-list #t #f)
+ (degree-first-true fill-list #f #f)
+ identity)
+ radius
+ thick
+ (assoc-get 'F HOLE-FILL-LIST)
+ layout
+ props)
+ empty-stencil))))))
(define (variable-column-circle-stencil scaler)
(lambda (radius thick fill layout props)
@@ -515,62 +515,62 @@ returns @samp{1/3}."
;; A stencil for ring-column circles that combines two of the above
(define (ring-column-circle-stencil radius thick fill layout props)
(if (= 0 (remainder fill (assoc-get 'R HOLE-FILL-LIST)))
- (ly:stencil-add
- ((if
- (= fill (expt (assoc-get 'R HOLE-FILL-LIST) 2))
- gray-colorize
- identity)
+ (ly:stencil-add
+ ((if
+ (= fill (expt (assoc-get 'R HOLE-FILL-LIST) 2))
+ gray-colorize
+ identity)
((standard-e-stencil
- (* (+ (- 1.0 (* 2 thick)) (/ thick 2)))
- (* (+ (- 1.0 (* 2 thick)) (/ thick 2))))
- radius
- (* (* 4 radius) thick)
- 1
- layout
- props))
- ((standard-e-stencil 1.0 1.0) radius thick 1 layout props)
- (column-circle-stencil
+ (* (+ (- 1.0 (* 2 thick)) (/ thick 2)))
+ (* (+ (- 1.0 (* 2 thick)) (/ thick 2))))
+ radius
+ (* (* 4 radius) thick)
+ 1
+ layout
+ props))
+ ((standard-e-stencil 1.0 1.0) radius thick 1 layout props)
+ (column-circle-stencil
(+ (* (- 1.0 (* 4 thick)) radius) (/ thick 2))
thick
(*
- (if (= 0 (remainder fill (assoc-get 'F HOLE-FILL-LIST)))
- (assoc-get 'F HOLE-FILL-LIST)
- 1)
- (if (= fill (expt (assoc-get 'R HOLE-FILL-LIST) 2))
- (/ fill (expt (assoc-get 'R HOLE-FILL-LIST) 2))
- (/ fill (assoc-get 'R HOLE-FILL-LIST))))
+ (if (= 0 (remainder fill (assoc-get 'F HOLE-FILL-LIST)))
+ (assoc-get 'F HOLE-FILL-LIST)
+ 1)
+ (if (= fill (expt (assoc-get 'R HOLE-FILL-LIST) 2))
+ (/ fill (expt (assoc-get 'R HOLE-FILL-LIST) 2))
+ (/ fill (assoc-get 'R HOLE-FILL-LIST))))
layout
props))
- (column-circle-stencil radius thick fill layout props)))
+ (column-circle-stencil radius thick fill layout props)))
;;; Flute family stencils
(define flute-lh-b-key-stencil
(standard-path-stencil
- '((0 1.3)
- (0 1.625 -0.125 1.75 -0.25 1.75)
- (-0.55 1.75 -0.55 0.95 -0.25 0.7)
- (0 0.4 0 0.125 0 0))
- 2
- 1.55))
+ '((0 1.3)
+ (0 1.625 -0.125 1.75 -0.25 1.75)
+ (-0.55 1.75 -0.55 0.95 -0.25 0.7)
+ (0 0.4 0 0.125 0 0))
+ 2
+ 1.55))
(define flute-lh-bes-key-stencil
(standard-path-stencil
- '((0 1.3)
- (0 1.625 -0.125 1.75 -0.25 1.75)
- (-0.55 1.75 -0.55 0.95 -0.25 0.7)
- (0 0.4 0 0.125 0 0))
- 2.0
- 1.3))
+ '((0 1.3)
+ (0 1.625 -0.125 1.75 -0.25 1.75)
+ (-0.55 1.75 -0.55 0.95 -0.25 0.7)
+ (0 0.4 0 0.125 0 0))
+ 2.0
+ 1.3))
(define (flute-lh-gis-rh-bes-key-stencil deg)
(rich-path-stencil
- '((0.1 0.1 0.2 0.4 0.3 0.6)
- (0.3 1.0 0.8 1.0 0.8 0.7)
- (0.8 0.3 0.5 0.3 0 0))
- 1.0
- 1.0
- (lambda (stencil) (ly:stencil-rotate stencil deg 0 0))))
+ '((0.1 0.1 0.2 0.4 0.3 0.6)
+ (0.3 1.0 0.8 1.0 0.8 0.7)
+ (0.8 0.3 0.5 0.3 0 0))
+ 1.0
+ 1.0
+ (lambda (stencil) (ly:stencil-rotate stencil deg 0 0))))
(define flute-lh-gis-key-stencil (flute-lh-gis-rh-bes-key-stencil 0))
@@ -582,97 +582,97 @@ returns @samp{1/3}."
(define flute-rh-ees-key-stencil
(standard-path-stencil
- '((0.8 0) (1.1 0 1.1 0.75 0.7 0.75) (0.5 0.75) (0.15 0.75 0.1 0.2 0 0))
- -2.38
- 1.4))
+ '((0.8 0) (1.1 0 1.1 0.75 0.7 0.75) (0.5 0.75) (0.15 0.75 0.1 0.2 0 0))
+ -2.38
+ 1.4))
(define (piccolo-rh-x-key-stencil radius thick fill layout props)
(interpret-markup
- layout
- props
- (make-general-align-markup
- Y
- DOWN
- (make-concat-markup
- (make-name-keylist
- `(,(text-fill-translate fill))
- '(("X" . #f))
- (* 9 radius))))))
+ layout
+ props
+ (make-general-align-markup
+ Y
+ DOWN
+ (make-concat-markup
+ (make-name-keylist
+ `(,(text-fill-translate fill))
+ '(("X" . #f))
+ (* 9 radius))))))
(define flute-lower-row-stretch 1.4)
(define flute-rh-cis-key-stencil
(standard-path-stencil
- '((0 0.75) (-0.8 0.75 -0.8 0 0 0))
- flute-lower-row-stretch
- flute-lower-row-stretch))
+ '((0 0.75) (-0.8 0.75 -0.8 0 0 0))
+ flute-lower-row-stretch
+ flute-lower-row-stretch))
(define flute-rh-c-key-stencil
(standard-path-stencil
- '((0 0.75) (0.4 0.75) (0.4 0) (0 0))
- flute-lower-row-stretch
- flute-lower-row-stretch))
+ '((0 0.75) (0.4 0.75) (0.4 0) (0 0))
+ flute-lower-row-stretch
+ flute-lower-row-stretch))
(define flute-rh-b-key-stencil
(standard-path-stencil
- '((0 0.75) (0.25 0.75) (0.25 0) (0 0))
- flute-lower-row-stretch
- flute-lower-row-stretch))
+ '((0 0.75) (0.25 0.75) (0.25 0) (0 0))
+ flute-lower-row-stretch
+ flute-lower-row-stretch))
(define flute-rh-gz-key-stencil
(rich-path-stencil
- '((0.1 0.1 0.4 0.2 0.6 0.3)
- (1.0 0.3 1.0 0.8 0.7 0.8)
- (0.3 0.8 0.3 0.5 0 0))
- flute-lower-row-stretch
- flute-lower-row-stretch
- (lambda (stencil) (ly:stencil-rotate stencil 160 0 0))))
+ '((0.1 0.1 0.4 0.2 0.6 0.3)
+ (1.0 0.3 1.0 0.8 0.7 0.8)
+ (0.3 0.8 0.3 0.5 0 0))
+ flute-lower-row-stretch
+ flute-lower-row-stretch
+ (lambda (stencil) (ly:stencil-rotate stencil 160 0 0))))
;;; Shared oboe/clarinet stencils
(define (oboe-lh-gis-lh-low-b-key-stencil gis?)
(let*
- ((x 1.2)
- (y 0.4)
- (scaling-factor 1.7)
- (up-part
- (car
+ ((x 1.2)
+ (y 0.4)
+ (scaling-factor 1.7)
+ (up-part
+ (car
(split-bezier
- `((0.0 . 0.0) (0.0 . ,y) (,x . ,y) (,x . 0.0))
- 0.8)))
- (down-part
- (cdr
+ `((0.0 . 0.0) (0.0 . ,y) (,x . ,y) (,x . 0.0))
+ 0.8)))
+ (down-part
+ (cdr
(split-bezier
- `((,x . 0.0) (,x . ,(- y)) (0.0 . ,(- y)) (0.0 . 0.0))
- 0.2))))
+ `((,x . 0.0) (,x . ,(- y)) (0.0 . ,(- y)) (0.0 . 0.0))
+ 0.2))))
(if gis?
- (standard-path-stencil
- (append
+ (standard-path-stencil
+ (append
(append
- `((0.25 ,(/ y -2) 0.75 ,(/ y -2) 1.0 0.0))
- (map (lambda (l)
- (flatten-list
- (map (lambda (x)
- (coord-translate
- (coord-rotate x (atan (/ y (* 2 0.25))))
- '(1.0 . 0)))
- l)))
- `(((0 . ,y) (,x . ,y) (,x . 0))
- ((,x . ,(- y)) (0 . ,(- y)) (0 . 0)))))
+ `((0.25 ,(/ y -2) 0.75 ,(/ y -2) 1.0 0.0))
+ (map (lambda (l)
+ (flatten-list
+ (map (lambda (x)
+ (coord-translate
+ (coord-rotate x (atan (/ y (* 2 0.25))))
+ '(1.0 . 0)))
+ l)))
+ `(((0 . ,y) (,x . ,y) (,x . 0))
+ ((,x . ,(- y)) (0 . ,(- y)) (0 . 0)))))
`((0.75 ,(/ y -2) 0.25 ,(/ y -2) 0.0 0.0)))
- scaling-factor
- scaling-factor)
- (standard-path-stencil
- (map (lambda (l)
- (flatten-list
+ scaling-factor
+ scaling-factor)
+ (standard-path-stencil
+ (map (lambda (l)
+ (flatten-list
(map (lambda (x)
(coord-rotate x (atan (/ y (* 2 0.25)))))
l)))
- `(,(list-tail up-part 1)
- ,(list-head down-part 1)
- ,(list-tail down-part 1)))
- (- scaling-factor)
- (- scaling-factor)))))
+ `(,(list-tail up-part 1)
+ ,(list-head down-part 1)
+ ,(list-tail down-part 1)))
+ (- scaling-factor)
+ (- scaling-factor)))))
(define oboe-lh-gis-key-stencil (oboe-lh-gis-lh-low-b-key-stencil #t))
@@ -680,13 +680,13 @@ returns @samp{1/3}."
(define (oboe-lh-ees-lh-bes-key-stencil ees?)
(standard-path-stencil
- `((0 1.5)
- (0 1.625 -0.125 1.75 -0.25 1.75)
- (-0.5 1.75 -0.5 0.816 -0.25 0.5)
- (0 0.25 0 0.125 0 0)
- (0 ,(if ees? -0.6 -0.3)))
- (* (if ees? -1.0 1.0) -1.8)
- 1.8))
+ `((0 1.5)
+ (0 1.625 -0.125 1.75 -0.25 1.75)
+ (-0.5 1.75 -0.5 0.816 -0.25 0.5)
+ (0 0.25 0 0.125 0 0)
+ (0 ,(if ees? -0.6 -0.3)))
+ (* (if ees? -1.0 1.0) -1.8)
+ 1.8))
(define oboe-lh-ees-key-stencil (oboe-lh-ees-lh-bes-key-stencil #t))
@@ -697,13 +697,13 @@ returns @samp{1/3}."
(define (oboe-lh-octave-key-stencil long?)
(let* ((h (if long? 1.4 1.2)))
(standard-path-stencil
- `((-0.4 0 -0.4 1.0 -0.1 1.0)
- (-0.1 ,h)
- (0.1 ,h)
- (0.1 1.0)
- (0.4 1.0 0.4 0 0 0))
- 2.0
- 2.0)))
+ `((-0.4 0 -0.4 1.0 -0.1 1.0)
+ (-0.1 ,h)
+ (0.1 ,h)
+ (0.1 1.0)
+ (0.4 1.0 0.4 0 0 0))
+ 2.0
+ 2.0)))
(define oboe-lh-I-key-stencil (oboe-lh-octave-key-stencil #f))
@@ -729,13 +729,13 @@ returns @samp{1/3}."
(define (oboe-rh-c-rh-ees-key-stencil c?)
(rich-path-stencil
- '((1.0 0.0 1.0 0.70 1.5 0.70)
- (2.25 0.70 2.25 -0.4 1.5 -0.4)
- (1.0 -0.4 1.0 0 0 0)
- (-0.15 0))
- 2.0
- 1.4
- (lambda (stencil) (ly:stencil-rotate stencil (if c? 170 180) 0 0))))
+ '((1.0 0.0 1.0 0.70 1.5 0.70)
+ (2.25 0.70 2.25 -0.4 1.5 -0.4)
+ (1.0 -0.4 1.0 0 0 0)
+ (-0.15 0))
+ 2.0
+ 1.4
+ (lambda (stencil) (ly:stencil-rotate stencil (if c? 170 180) 0 0))))
(define oboe-rh-banana-key-stencil oboe-rh-gis-key-stencil)
@@ -743,12 +743,12 @@ returns @samp{1/3}."
(define oboe-rh-cis-key-stencil
(rich-path-stencil
- '((0.6 0.0 0.6 0.50 1.25 0.50)
- (2.25 0.50 2.25 -0.4 1.25 -0.4)
- (0.6 -0.4 0.6 0 0 0))
- -0.9
- 1.0
- (lambda (stencil) (ly:stencil-rotate stencil 0 0 0))))
+ '((0.6 0.0 0.6 0.50 1.25 0.50)
+ (2.25 0.50 2.25 -0.4 1.25 -0.4)
+ (0.6 -0.4 0.6 0 0 0))
+ -0.9
+ 1.0
+ (lambda (stencil) (ly:stencil-rotate stencil 0 0 0))))
(define oboe-rh-ees-key-stencil (oboe-rh-c-rh-ees-key-stencil #f))
@@ -759,22 +759,22 @@ returns @samp{1/3}."
(define clarinet-lh-R-key-stencil
(let* ((halfbase (cos (/ PI 10)))
- (height (*
- halfbase
- (/ (sin (/ (* 4 PI) 10)) (cos (/ (* 4 PI) 10))))))
- (standard-path-stencil
- `(
- (0 ,(/ -4.0 3.0) -2.0 ,(/ -4.0 3.0) -2.0 0.0)
- (-1.5 ,(* 0.5 height) -1.25 ,(* 0.75 height) -1.0 ,height)
- (-0.75 ,(* 0.75 height) -0.5 ,(* 0.5 height) 0.0 0.0))
- 0.9
- 0.9)))
+ (height (*
+ halfbase
+ (/ (sin (/ (* 4 PI) 10)) (cos (/ (* 4 PI) 10))))))
+ (standard-path-stencil
+ `(
+ (0 ,(/ -4.0 3.0) -2.0 ,(/ -4.0 3.0) -2.0 0.0)
+ (-1.5 ,(* 0.5 height) -1.25 ,(* 0.75 height) -1.0 ,height)
+ (-0.75 ,(* 0.75 height) -0.5 ,(* 0.5 height) 0.0 0.0))
+ 0.9
+ 0.9)))
(define (clarinet-lh-a-key-stencil radius thick fill layout props)
(let* ((width 0.4) (height 0.75) (linelen 0.45))
- (ly:stencil-add
- ((standard-e-stencil width height) radius thick fill layout props)
- (ly:stencil-translate
+ (ly:stencil-add
+ ((standard-e-stencil width height) radius thick fill layout props)
+ (ly:stencil-translate
(make-line-stencil thick 0 0 0 (* linelen radius))
(cons 0 (* height radius))))))
@@ -794,30 +794,30 @@ returns @samp{1/3}."
(define clarinet-rh-low-c-key-stencil
(standard-path-stencil
- '((0.0 1.5)
- (0.0 2.5 -1.0 2.5 -1.0 0.75)
- (-1.0 0.1 0.0 0.25 0.0 0.3)
- (0.0 0.0))
- 0.8
- 0.8))
+ '((0.0 1.5)
+ (0.0 2.5 -1.0 2.5 -1.0 0.75)
+ (-1.0 0.1 0.0 0.25 0.0 0.3)
+ (0.0 0.0))
+ 0.8
+ 0.8))
(define clarinet-rh-low-cis-key-stencil
(standard-path-stencil
- '((0.0 1.17)
- (0.0 1.67 -1.0 1.67 -1.0 0.92)
- (-1.0 0.47 0.0 0.52 0.0 0.62)
- (0.0 0.0))
- 0.8
- 0.8))
+ '((0.0 1.17)
+ (0.0 1.67 -1.0 1.67 -1.0 0.92)
+ (-1.0 0.47 0.0 0.52 0.0 0.62)
+ (0.0 0.0))
+ 0.8
+ 0.8))
(define clarinet-rh-low-d-key-stencil
(standard-path-stencil
- '((0.0 1.05)
- (0.0 1.55 -1.0 1.55 -1.0 0.8)
- (-1.0 0.35 0.0 0.4 0.0 0.5)
- (0.0 0.0))
- 0.8
- 0.8))
+ '((0.0 1.05)
+ (0.0 1.55 -1.0 1.55 -1.0 0.8)
+ (-1.0 0.35 0.0 0.4 0.0 0.5)
+ (0.0 0.0))
+ 0.8
+ 0.8))
(define clarinet-rh-one-key-stencil (standard-e-stencil 0.5 0.25))
@@ -841,52 +841,52 @@ returns @samp{1/3}."
(define clarinet-rh-fis-key-stencil
(standard-path-stencil
- `(,(bezier-head-for-stencil
- '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
- 0.5)
- ,(bezier-head-for-stencil
- '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75))
- 0.5)
- (1.0 1.0 0.0 1.0 0.0 0.0))
- CL-RH-H-STRETCH
- CL-RH-V-STRETCH))
+ `(,(bezier-head-for-stencil
+ '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
+ 0.5)
+ ,(bezier-head-for-stencil
+ '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75))
+ 0.5)
+ (1.0 1.0 0.0 1.0 0.0 0.0))
+ CL-RH-H-STRETCH
+ CL-RH-V-STRETCH))
(define clarinet-rh-gis-key-stencil
(standard-path-stencil
- '((0.0 1.0 1.0 1.0 1.0 0.0) (1.0 -1.0 0.0 -1.0 0.0 0.0))
- CL-RH-H-STRETCH
- CL-RH-V-STRETCH))
+ '((0.0 1.0 1.0 1.0 1.0 0.0) (1.0 -1.0 0.0 -1.0 0.0 0.0))
+ CL-RH-H-STRETCH
+ CL-RH-V-STRETCH))
(define clarinet-rh-e-key-stencil
(standard-path-stencil
- `(,(bezier-head-for-stencil
- '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
- 0.5)
- ,(bezier-head-for-stencil
- '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75))
- 0.5)
- ,(bezier-head-for-stencil
- `((1.0 . 0.0) (,(/ 1 3) . 0.0) (,(/ 1 3) . 1.5) (1.0 . 1.5))
- 0.5)
- ,(bezier-head-for-stencil
- `((0.5 . 0.75) (,(/ -1 6) . 0.75) (,(/ -1 6) . -0.75) (0.5 . -0.75))
- 0.5))
- CL-RH-H-STRETCH
- CL-RH-V-STRETCH))
+ `(,(bezier-head-for-stencil
+ '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
+ 0.5)
+ ,(bezier-head-for-stencil
+ '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75))
+ 0.5)
+ ,(bezier-head-for-stencil
+ `((1.0 . 0.0) (,(/ 1 3) . 0.0) (,(/ 1 3) . 1.5) (1.0 . 1.5))
+ 0.5)
+ ,(bezier-head-for-stencil
+ `((0.5 . 0.75) (,(/ -1 6) . 0.75) (,(/ -1 6) . -0.75) (0.5 . -0.75))
+ 0.5))
+ CL-RH-H-STRETCH
+ CL-RH-V-STRETCH))
(define clarinet-rh-f-key-stencil clarinet-rh-gis-key-stencil)
(define bass-clarinet-rh-ees-key-stencil
(standard-path-stencil
- `(,(bezier-head-for-stencil
- '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
- 0.5)
- ,(bezier-head-for-stencil
- '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75))
- 0.5)
- (1.0 1.0 0.0 1.0 0.0 0.0))
- CL-RH-H-STRETCH
- (- CL-RH-V-STRETCH)))
+ `(,(bezier-head-for-stencil
+ '((0.0 . 0.0) (0.0 . -1.0) (1.0 . -1.0) (1.0 . 0.0))
+ 0.5)
+ ,(bezier-head-for-stencil
+ '((0.5 . -0.75) (0.5 . 0.25) (1.5 . 0.25) (1.5 . -0.75))
+ 0.5)
+ (1.0 1.0 0.0 1.0 0.0 0.0))
+ CL-RH-H-STRETCH
+ (- CL-RH-V-STRETCH)))
(define low-bass-clarinet-rh-ees-key-stencil clarinet-rh-e-key-stencil)
@@ -908,21 +908,21 @@ returns @samp{1/3}."
(define saxophone-lh-gis-key-stencil
(standard-path-stencil
- '((0.0 0.4)
- (0.0 0.8 3.0 0.8 3.0 0.4)
- (3.0 0.0)
- (3.0 -0.4 0.0 -0.4 0.0 0.0))
- 0.8
- 0.8))
+ '((0.0 0.4)
+ (0.0 0.8 3.0 0.8 3.0 0.4)
+ (3.0 0.0)
+ (3.0 -0.4 0.0 -0.4 0.0 0.0))
+ 0.8
+ 0.8))
(define (saxophone-lh-b-cis-key-stencil flip?)
(standard-path-stencil
- '((0.0 1.0)
- (0.4 1.0 0.8 0.9 1.35 0.8)
- (1.35 0.0)
- (0.0 0.0))
- (* (if flip? -1 1) 0.8)
- 0.8))
+ '((0.0 1.0)
+ (0.4 1.0 0.8 0.9 1.35 0.8)
+ (1.35 0.0)
+ (0.0 0.0))
+ (* (if flip? -1 1) 0.8)
+ 0.8))
(define saxophone-lh-cis-key-stencil (saxophone-lh-b-cis-key-stencil #t))
@@ -930,27 +930,27 @@ returns @samp{1/3}."
(define saxophone-lh-low-bes-key-stencil
(standard-path-stencil
- '((3.0 0.0) (3.0 -1.5 0.0 -1.5 0.0 0.0))
- 0.8
- 0.8))
+ '((3.0 0.0) (3.0 -1.5 0.0 -1.5 0.0 0.0))
+ 0.8
+ 0.8))
(define (saxophone-rh-side-key-stencil width height)
(standard-path-stencil
- `((0.0 ,height)
- (0.05 ,(+ height 0.05) 0.1 ,(+ height 0.1) 0.15 ,(+ height 0.15))
- (,(- width 0.15) ,(+ height 0.15))
- (,(- width 0.1)
- ,(+ height 0.1)
- ,(- width 0.05)
- ,(+ height 0.05)
- ,width
- ,height)
- (,width 0.0)
- (,(- width 0.05) -0.05 ,(- width 0.1) -0.1 ,(- width 0.15) -0.15)
- (0.15 -0.15)
- (0.1 -0.1 0.05 -0.05 0.0 0.0))
- 1.0
- 1.0))
+ `((0.0 ,height)
+ (0.05 ,(+ height 0.05) 0.1 ,(+ height 0.1) 0.15 ,(+ height 0.15))
+ (,(- width 0.15) ,(+ height 0.15))
+ (,(- width 0.1)
+ ,(+ height 0.1)
+ ,(- width 0.05)
+ ,(+ height 0.05)
+ ,width
+ ,height)
+ (,width 0.0)
+ (,(- width 0.05) -0.05 ,(- width 0.1) -0.1 ,(- width 0.15) -0.15)
+ (0.15 -0.15)
+ (0.1 -0.1 0.05 -0.05 0.0 0.0))
+ 1.0
+ 1.0))
(define saxophone-rh-e-key-stencil (saxophone-rh-side-key-stencil 0.9 1.2))
@@ -960,18 +960,18 @@ returns @samp{1/3}."
(define saxophone-rh-high-fis-key-stencil
(standard-path-stencil
- (append
- '((0.0 1.0) (0.0 1.4 0.6 1.4 0.6 1.0) (0.6 0.0))
- (map (lambda (l)
- (flatten-list
- (map (lambda (x)
- (coord-rotate x (atan (* -1 (/ PI 6)))))
- l)))
- '(((0.6 . -1.0))
- ((0.6 . -1.4) (0.0 . -1.4) (0.0 . -1.0))
- ((0.0 . 0.0)))))
- 0.75
- 0.75))
+ (append
+ '((0.0 1.0) (0.0 1.4 0.6 1.4 0.6 1.0) (0.6 0.0))
+ (map (lambda (l)
+ (flatten-list
+ (map (lambda (x)
+ (coord-rotate x (atan (* -1 (/ PI 6)))))
+ l)))
+ '(((0.6 . -1.0))
+ ((0.6 . -1.4) (0.0 . -1.4) (0.0 . -1.0))
+ ((0.0 . 0.0)))))
+ 0.75
+ 0.75))
(define saxophone-rh-fis-key-stencil (standard-e-stencil 1.0 0.5))
@@ -979,112 +979,112 @@ returns @samp{1/3}."
(define saxophone-rh-low-c-key-stencil
(standard-path-stencil
- '((3.0 0.0) (3.0 -1.5 0.0 -1.5 0.0 0.0))
- 0.8
- 0.8))
+ '((3.0 0.0) (3.0 -1.5 0.0 -1.5 0.0 0.0))
+ 0.8
+ 0.8))
(define (saxophone-lh-low-a-key-stencil radius thick fill layout props)
(interpret-markup
- layout
- props
- (make-general-align-markup
- Y
- DOWN
- (make-concat-markup
- (make-name-keylist
- `(,(text-fill-translate fill))
- '(("lowA" . #f))
- (* 9 radius))))))
+ layout
+ props
+ (make-general-align-markup
+ Y
+ DOWN
+ (make-concat-markup
+ (make-name-keylist
+ `(,(text-fill-translate fill))
+ '(("lowA" . #f))
+ (* 9 radius))))))
;;; Bassoon family stencils
(define (bassoon-bend-info-maker height gap cut)
(let* (
- (first-bezier
- (flatten-list
- (car
- (split-bezier
- `((0.0 . ,(+ height gap))
- (0.0 . ,(+ height (+ gap 1.0)))
- (1.0 . ,(+ height (+ gap 2.0)))
- (2.0 . ,(+ height (+ gap 2.0))))
- cut))))
- (second-bezier
- (flatten-list
- (reverse
- (car
+ (first-bezier
+ (flatten-list
+ (car
(split-bezier
+ `((0.0 . ,(+ height gap))
+ (0.0 . ,(+ height (+ gap 1.0)))
+ (1.0 . ,(+ height (+ gap 2.0)))
+ (2.0 . ,(+ height (+ gap 2.0))))
+ cut))))
+ (second-bezier
+ (flatten-list
+ (reverse
+ (car
+ (split-bezier
`((1.0 . ,height)
- (1.0 . ,(+ 0.5 height))
- (1.5 . ,(+ 1.0 height))
- (2.0 . ,(+ 1.0 height)))
+ (1.0 . ,(+ 0.5 height))
+ (1.5 . ,(+ 1.0 height))
+ (2.0 . ,(+ 1.0 height)))
cut)))))
- (slope-offset1
- (get-slope-offset
- `(,(list-ref first-bezier 4) . ,(list-ref first-bezier 5))
- `(,(list-ref first-bezier 6) . ,(list-ref first-bezier 7))))
- (slope-offset2
- (get-slope-offset
- `(,(list-ref second-bezier 0) . ,(list-ref second-bezier 1))
- `(,(list-ref second-bezier 2) . ,(list-ref second-bezier 3)))))
- (list first-bezier second-bezier slope-offset1 slope-offset2)))
+ (slope-offset1
+ (get-slope-offset
+ `(,(list-ref first-bezier 4) . ,(list-ref first-bezier 5))
+ `(,(list-ref first-bezier 6) . ,(list-ref first-bezier 7))))
+ (slope-offset2
+ (get-slope-offset
+ `(,(list-ref second-bezier 0) . ,(list-ref second-bezier 1))
+ `(,(list-ref second-bezier 2) . ,(list-ref second-bezier 3)))))
+ (list first-bezier second-bezier slope-offset1 slope-offset2)))
(define
(make-tilted-portion
- first-bezier
- second-bezier
- slope-offset1
- slope-offset2
- keylen
- bezier?)
+ first-bezier
+ second-bezier
+ slope-offset1
+ slope-offset2
+ keylen
+ bezier?)
(append
- `((,(+ keylen (list-ref first-bezier 6))
- ,(+
+ `((,(+ keylen (list-ref first-bezier 6))
+ ,(+
(*
+ (car slope-offset1)
+ (+ keylen (list-ref first-bezier 6))) (cdr slope-offset1))))
+ ((if bezier? (lambda (x) `(,(apply append x))) identity)
+ `((,(+ (+ keylen 1.75) (list-ref first-bezier 6))
+ ,(+
+ (*
(car slope-offset1)
- (+ keylen (list-ref first-bezier 6))) (cdr slope-offset1))))
- ((if bezier? (lambda (x) `(,(apply append x))) identity)
- `((,(+ (+ keylen 1.75) (list-ref first-bezier 6))
+ (+ (+ keylen 1.75) (list-ref first-bezier 6)))
+ (cdr slope-offset1)))
+ (,(+ (+ keylen 1.75) (list-ref second-bezier 0))
,(+
- (*
- (car slope-offset1)
- (+ (+ keylen 1.75) (list-ref first-bezier 6)))
- (cdr slope-offset1)))
- (,(+ (+ keylen 1.75) (list-ref second-bezier 0))
+ (*
+ (car slope-offset2)
+ (+ (+ keylen 1.75) (list-ref second-bezier 0)))
+ (cdr slope-offset2)))
+ (,(+ keylen (list-ref second-bezier 0))
,(+
- (*
- (car slope-offset2)
- (+ (+ keylen 1.75) (list-ref second-bezier 0)))
- (cdr slope-offset2)))
- (,(+ keylen (list-ref second-bezier 0))
- ,(+
- (* (car slope-offset2) (+ keylen (list-ref second-bezier 0)))
- (cdr slope-offset2)))))
- `(,(list-head second-bezier 2))))
+ (* (car slope-offset2) (+ keylen (list-ref second-bezier 0)))
+ (cdr slope-offset2)))))
+ `(,(list-head second-bezier 2))))
(define (rich-bassoon-uber-key-stencil height gap cut keylen d1 d2 proc bezier?)
(let* ((info-list (bassoon-bend-info-maker height gap cut))
- (first-bezier (car info-list))
- (second-bezier (cadr info-list))
- (slope-offset1 (caddr info-list))
- (slope-offset2 (cadddr info-list)))
- (rich-path-stencil
- (append
+ (first-bezier (car info-list))
+ (second-bezier (cadr info-list))
+ (slope-offset1 (caddr info-list))
+ (slope-offset2 (cadddr info-list)))
+ (rich-path-stencil
+ (append
`((0.0 ,(+ height gap))
- ,(list-tail first-bezier 2))
+ ,(list-tail first-bezier 2))
(make-tilted-portion
- first-bezier
- second-bezier
- slope-offset1
- slope-offset2
- keylen
- bezier?)
+ first-bezier
+ second-bezier
+ slope-offset1
+ slope-offset2
+ keylen
+ bezier?)
`(,(list-tail second-bezier 2)
- (1.0 0.0)
- (0.0 0.0)))
- d1
- d2
- proc)))
+ (1.0 0.0)
+ (0.0 0.0)))
+ d1
+ d2
+ proc)))
(define (bassoon-uber-key-stencil height gap cut keylen d1 d2)
(rich-bassoon-uber-key-stencil height gap cut keylen d1 d2 identity #t))
@@ -1097,15 +1097,15 @@ returns @samp{1/3}."
(define bassoon-lh-ees-key-stencil
(rich-e-stencil
- 1.2
- 0.6
+ 1.2
+ 0.6
(lambda (stencil) (ly:stencil-rotate stencil 30 0 0))))
(define bassoon-lh-cis-key-stencil
(rich-e-stencil
- 1.0
- 0.5
- (lambda (stencil) (ly:stencil-rotate stencil 30 0 0))))
+ 1.0
+ 0.5
+ (lambda (stencil) (ly:stencil-rotate stencil 30 0 0))))
(define bassoon-lh-lbes-key-stencil
(bassoon-uber-key-stencil 1.0 0.5 0.7 0.5 0.6 -0.6))
@@ -1118,40 +1118,40 @@ returns @samp{1/3}."
(define bassoon-lh-ld-key-stencil
(standard-path-stencil
- '((-0.8 4.0 1.4 4.0 0.6 0.0)
- (0.5 -0.5 0.5 -0.8 0.6 -1.0)
- (0.7 -1.2 0.8 -1.3 0.8 -1.8)
- (0.5 -1.8)
- (0.5 -1.4 0.4 -1.2 0.3 -1.1)
- (0.2 -1.0 0.1 -0.5 0.0 0.0))
- 1.0
- 1.0))
+ '((-0.8 4.0 1.4 4.0 0.6 0.0)
+ (0.5 -0.5 0.5 -0.8 0.6 -1.0)
+ (0.7 -1.2 0.8 -1.3 0.8 -1.8)
+ (0.5 -1.8)
+ (0.5 -1.4 0.4 -1.2 0.3 -1.1)
+ (0.2 -1.0 0.1 -0.5 0.0 0.0))
+ 1.0
+ 1.0))
(define bassoon-lh-d-flick-key-stencil
(let ((height 3.0))
(standard-path-stencil
- `((0.0 ,height)
+ `((0.0 ,height)
(0.2 ,(+ height 1.6) 0.8 ,(+ height 1.8) 1.0 ,(+ height 1.8))
(1.4 ,(+ height 1.8) 1.9 ,(+ height 1.3) 1.9 ,(+ height 1.0))
(1.9 ,(+ height 0.7) 1.0 ,(+ height 0.4) 0.8 ,(+ height 0.3))
(0.6 ,(+ height 0.2) 0.4 ,(+ height 0.1) 0.4 ,(- height 0.1))
(0.4 0.0)
(0.0 0.0))
- -1.0
- -1.0)))
+ -1.0
+ -1.0)))
(define bassoon-lh-c-flick-key-stencil
(let ((height 3.0))
(standard-path-stencil
- `((0.0 ,height)
- (0.0 ,(+ height 1.6) 0.4 ,(+ height 1.8) 0.5 ,(+ height 1.8))
- (0.7 ,(+ height 1.8) 0.9 ,(+ height 1.3) 0.9 ,(+ height 1.0))
- (0.9 ,(+ height 0.5) 0.7 ,(+ height 0.4) 0.6 ,(+ height 0.3))
- (0.5 ,(+ height 0.2) 0.4 ,(+ height 0.1) 0.4 ,(- height 0.1))
- (0.4 0.0)
- (0.0 0.0))
- -1.0
- -1.0)))
+ `((0.0 ,height)
+ (0.0 ,(+ height 1.6) 0.4 ,(+ height 1.8) 0.5 ,(+ height 1.8))
+ (0.7 ,(+ height 1.8) 0.9 ,(+ height 1.3) 0.9 ,(+ height 1.0))
+ (0.9 ,(+ height 0.5) 0.7 ,(+ height 0.4) 0.6 ,(+ height 0.3))
+ (0.5 ,(+ height 0.2) 0.4 ,(+ height 0.1) 0.4 ,(- height 0.1))
+ (0.4 0.0)
+ (0.0 0.0))
+ -1.0
+ -1.0)))
(define bassoon-lh-a-flick-key-stencil
(bassoon-uber-key-stencil 5.0 1.0 0.3 0.6 -0.5 -0.5))
@@ -1163,14 +1163,14 @@ returns @samp{1/3}."
(define bassoon-rh-cis-key-stencil
(rich-bassoon-uber-key-stencil
- 1.1
- 1.5
- 0.9
- 0.3
- 0.5
- 0.5
- (lambda (stencil) (ly:stencil-rotate stencil -76 0 0))
- #t))
+ 1.1
+ 1.5
+ 0.9
+ 0.3
+ 0.5
+ 0.5
+ (lambda (stencil) (ly:stencil-rotate stencil -76 0 0))
+ #t))
(define bassoon-rh-bes-key-stencil little-elliptical-key-stencil)
@@ -1179,29 +1179,29 @@ returns @samp{1/3}."
(define bassoon-rh-f-key-stencil
(let* ((height 0.5) (gap 1.0) (cut 0.8) (keylen 1.5)
- (info-list (bassoon-bend-info-maker height gap cut))
- (first-bezier (car info-list))
- (second-bezier (cadr info-list))
- (slope-offset1 (caddr info-list))
- (slope-offset2 (cadddr info-list)))
- (standard-path-stencil
- (append
+ (info-list (bassoon-bend-info-maker height gap cut))
+ (first-bezier (car info-list))
+ (second-bezier (cadr info-list))
+ (slope-offset1 (caddr info-list))
+ (slope-offset2 (cadddr info-list)))
+ (standard-path-stencil
+ (append
(map
- (lambda (l)
- (rotunda-map
- -
- l
- (list-tail first-bezier 6)))
- (make-tilted-portion
- first-bezier
- second-bezier
- slope-offset1
- slope-offset2
- keylen
- #t))
+ (lambda (l)
+ (rotunda-map
+ -
+ l
+ (list-tail first-bezier 6)))
+ (make-tilted-portion
+ first-bezier
+ second-bezier
+ slope-offset1
+ slope-offset2
+ keylen
+ #t))
'((0.0 0.0)))
- -0.7
- 0.7)))
+ -0.7
+ 0.7)))
(define bassoon-rh-gis-key-stencil
(bassoon-uber-key-stencil 0.3 1.0 0.8 1.0 -0.7 0.7))
diff --git a/scm/display-lily.scm b/scm/display-lily.scm
index 788f89e359..7c1ec41925 100644
--- a/scm/display-lily.scm
+++ b/scm/display-lily.scm
@@ -40,18 +40,18 @@
"Define a display method for a music type and store it in the
`display-methods' property of the music type entry found in the
`music-name-to-property-table' hash table. Print methods previously
-defined for that music type are lost.
+defined for that music type are lost.
Syntax: (define-display-method MusicType (expression parser)
- ...body...))"
+ ...body...))"
`(let ((type-props (hashq-ref music-name-to-property-table
- ',music-type '()))
- (method (lambda ,vars
- ,@body)))
+ ',music-type '()))
+ (method (lambda ,vars
+ ,@body)))
(set! type-props
- (assoc-set! type-props 'display-methods (list method)))
+ (assoc-set! type-props 'display-methods (list method)))
(hashq-set! music-name-to-property-table
- ',music-type
- type-props)
+ ',music-type
+ type-props)
method))
(define-macro (define-extra-display-method music-type vars . body)
@@ -60,24 +60,24 @@ is supposed to have been previously defined with `define-display-method'.
This new method should return a string or #f. If #f is returned, the next
display method will be called."
`(let* ((type-props (hashq-ref music-name-to-property-table
- ',music-type '()))
- (methods (assoc-ref type-props 'display-methods))
- (new-method (lambda ,vars
- ,@body)))
+ ',music-type '()))
+ (methods (assoc-ref type-props 'display-methods))
+ (new-method (lambda ,vars
+ ,@body)))
(set! type-props
- (assoc-set! type-props
- 'display-methods
- (cons new-method methods)))
+ (assoc-set! type-props
+ 'display-methods
+ (cons new-method methods)))
(hashq-set! music-name-to-property-table
- ',music-type
- type-props)
+ ',music-type
+ type-props)
new-method))
(define* (tag->lily-string expr #:optional (post-event? #f))
(format #f "~{~a ~}"
- (map (lambda (tag)
- (format #f "~a\\tag #'~a" (if post-event? "-" "") tag))
- (ly:music-property expr 'tags))))
+ (map (lambda (tag)
+ (format #f "~a\\tag #'~a" (if post-event? "-" "") tag))
+ (ly:music-property expr 'tags))))
(define* (tweaks->lily-string expr #:optional (post-event? #f))
(format #f "~{~a ~}"
@@ -103,25 +103,25 @@ display method will be called."
"Print @var{expr}, a music expression, in LilyPond syntax."
(if (ly:music? expr)
(let* ((music-type (ly:music-property expr 'name))
- (procs (assoc-ref (hashq-ref music-name-to-property-table
- music-type '())
- 'display-methods))
- (result-string (and procs (any (lambda (proc)
- (proc expr parser))
- procs))))
- (if result-string
- (format #f "~a~a~a"
+ (procs (assoc-ref (hashq-ref music-name-to-property-table
+ music-type '())
+ 'display-methods))
+ (result-string (and procs (any (lambda (proc)
+ (proc expr parser))
+ procs))))
+ (if result-string
+ (format #f "~a~a~a"
(tag->lily-string expr (post-event? expr))
(tweaks->lily-string expr (post-event? expr))
- result-string)
- (format #f "%{ Print method not implemented for music type ~a %}"
- music-type)))
+ result-string)
+ (format #f "%{ Print method not implemented for music type ~a %}"
+ music-type)))
(format #f "%{ expecting a music expression: ~a %}" expr)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Music pattern matching
-;;;
+;;;
(define (var? x)
(and (symbol? x) (char=? #\? (string-ref (symbol->string x) 0))))
@@ -136,16 +136,16 @@ display method will be called."
(define (music-or-var-list? x)
(and (pair? x)
(every (lambda (e)
- (or (music? e) (var? e)))
- x)))
+ (or (music? e) (var? e)))
+ x)))
(define (key-val-list->alist lst)
(define (key-val-list->alist-aux lst prev-result)
(if (null? lst)
- prev-result
- (key-val-list->alist-aux (cddr lst)
- (cons (cons (first lst) (second lst))
- prev-result))))
+ prev-result
+ (key-val-list->alist-aux (cddr lst)
+ (cons (cons (first lst) (second lst))
+ prev-result))))
(reverse! (key-val-list->alist-aux lst (list))))
(define (gen-condition expr pattern)
@@ -153,100 +153,100 @@ display method will be called."
Generate an form that checks if the properties of `expr'
match thoses described in `pattern'."
(let* (;; all (property . value) found at the first depth in pattern,
- ;; including a (name . <Musictype>) pair.
- (pat-all-props (cons (cons 'name (second pattern))
- (key-val-list->alist (cddr pattern))))
- ;; all (property . value) pairs found in pattern, where value is not
- ;; a ?var, a music expression or a music list.
- (prop-vals (remove (lambda (kons)
- (or (var? (cdr kons))
- (music? (cdr kons))
- (music-or-var-list? (cdr kons))))
- pat-all-props))
- ;; list of (property . element) pairs, where element is a music expression
- (element-list (filter (lambda (kons) (music? (cdr kons)))
- pat-all-props))
- ;; list of (property . (e1 e2 ..)) pairs, where (e1 e2 ...) is a
- ;; list a music expressions
- (elements-list (filter (lambda (kons) (music-or-var-list? (cdr kons)))
- pat-all-props)))
- `(and
+ ;; including a (name . <Musictype>) pair.
+ (pat-all-props (cons (cons 'name (second pattern))
+ (key-val-list->alist (cddr pattern))))
+ ;; all (property . value) pairs found in pattern, where value is not
+ ;; a ?var, a music expression or a music list.
+ (prop-vals (remove (lambda (kons)
+ (or (var? (cdr kons))
+ (music? (cdr kons))
+ (music-or-var-list? (cdr kons))))
+ pat-all-props))
+ ;; list of (property . element) pairs, where element is a music expression
+ (element-list (filter (lambda (kons) (music? (cdr kons)))
+ pat-all-props))
+ ;; list of (property . (e1 e2 ..)) pairs, where (e1 e2 ...) is a
+ ;; list a music expressions
+ (elements-list (filter (lambda (kons) (music-or-var-list? (cdr kons)))
+ pat-all-props)))
+ `(and
;; a form that checks that `expr' is a music expression
;; before actually accessing its properties...
(ly:music? ,expr)
;; a form that checks that `expr' properties have the same
;; values as those given in `pattern'
,@(map (lambda (prop-val)
- (let ((prop (car prop-val))
- (val (cdr prop-val)))
- `(and (not (null? (ly:music-property ,expr ',prop)))
- (equal? (ly:music-property ,expr ',prop) ,val))))
- prop-vals)
+ (let ((prop (car prop-val))
+ (val (cdr prop-val)))
+ `(and (not (null? (ly:music-property ,expr ',prop)))
+ (equal? (ly:music-property ,expr ',prop) ,val))))
+ prop-vals)
;; build the test condition for each element found in a (property . element) pair.
;; (typically, property will be 'element)
,@(map (lambda (prop-element)
- (gen-condition `(ly:music-property ,expr ',(car prop-element)) (cdr prop-element)))
- element-list)
+ (gen-condition `(ly:music-property ,expr ',(car prop-element)) (cdr prop-element)))
+ element-list)
;; build the test conditions for each element found in a (property . (e1 e2 ...)) pair.
;; this requires accessing to an element of a list, hence the index.
;; (typically, property will be 'elements)
,@(map (lambda (prop-elements)
- (let ((ges (gensym))
- (index -1))
- `(and ,@(map (lambda (e)
- (set! index (1+ index))
- (if (music? e)
- (gen-condition `(and (> (length (ly:music-property ,expr ',(car prop-elements)))
- ,index)
- (list-ref (ly:music-property ,expr ',(car prop-elements))
- ,index))
- e)
- #t))
- (cdr prop-elements)))))
- elements-list))))
+ (let ((ges (gensym))
+ (index -1))
+ `(and ,@(map (lambda (e)
+ (set! index (1+ index))
+ (if (music? e)
+ (gen-condition `(and (> (length (ly:music-property ,expr ',(car prop-elements)))
+ ,index)
+ (list-ref (ly:music-property ,expr ',(car prop-elements))
+ ,index))
+ e)
+ #t))
+ (cdr prop-elements)))))
+ elements-list))))
(define (gen-bindings expr pattern)
"Helper function for `with-music-match'.
Generate binding forms by looking for ?var symbol in pattern."
(let* (;; all (property . value) found at the first depth of pattern,
- ;; including a (name . <Musictype>) pair.
- (pat-all-props (cons (cons 'name (second pattern))
- (key-val-list->alist (cddr pattern))))
- ;; all (property . ?var) pairs
- (prop-vars (filter (lambda (kons) (var? (cdr kons)))
- pat-all-props))
- ;; list of (property . element) pairs, where element is a music expression
- (element-list (filter (lambda (kons) (music? (cdr kons)))
- pat-all-props))
- ;; list of (property . (e1 e2 ..)) pairs, where (e1 e2 ...) is a
- ;; list a music expressions
- (elements-list (filter (lambda (kons) (music-or-var-list? (cdr kons)))
- pat-all-props)))
- (append
+ ;; including a (name . <Musictype>) pair.
+ (pat-all-props (cons (cons 'name (second pattern))
+ (key-val-list->alist (cddr pattern))))
+ ;; all (property . ?var) pairs
+ (prop-vars (filter (lambda (kons) (var? (cdr kons)))
+ pat-all-props))
+ ;; list of (property . element) pairs, where element is a music expression
+ (element-list (filter (lambda (kons) (music? (cdr kons)))
+ pat-all-props))
+ ;; list of (property . (e1 e2 ..)) pairs, where (e1 e2 ...) is a
+ ;; list a music expressions
+ (elements-list (filter (lambda (kons) (music-or-var-list? (cdr kons)))
+ pat-all-props)))
+ (append
;; the binding form for the ?var variable found in pattern (first depth).
;; ?var is bound to the value of `expr' property
(map (lambda (prop-var)
- `(,(cdr prop-var) (ly:music-property ,expr ',(car prop-var))))
- prop-vars)
+ `(,(cdr prop-var) (ly:music-property ,expr ',(car prop-var))))
+ prop-vars)
;; generate bindings for each element found in a (property . element) pair.
;; (typically, property will be 'element)
(append-map (lambda (prop-element)
- (gen-bindings `(ly:music-property ,expr ',(car prop-element))
- (cdr prop-element)))
- element-list)
+ (gen-bindings `(ly:music-property ,expr ',(car prop-element))
+ (cdr prop-element)))
+ element-list)
;; generate bindings for each element found in a (property . (e1 e2 ...)) pair
;; (typically, property will be 'elements)
- (append-map (lambda (prop-elements)
- (let ((index -1))
- (append-map (lambda (e)
- (set! index (1+ index))
- (if (var? e)
- `((,e (list-ref (ly:music-property ,expr ',(car prop-elements)) ,index)))
- (gen-bindings `(list-ref (ly:music-property ,expr ',(car prop-elements))
- ,index)
- e)))
- (cdr prop-elements))))
- elements-list))))
+ (append-map (lambda (prop-elements)
+ (let ((index -1))
+ (append-map (lambda (e)
+ (set! index (1+ index))
+ (if (var? e)
+ `((,e (list-ref (ly:music-property ,expr ',(car prop-elements)) ,index)))
+ (gen-bindings `(list-ref (ly:music-property ,expr ',(car prop-elements))
+ ,index)
+ e)))
+ (cdr prop-elements))))
+ elements-list))))
(define-macro (with-music-match music-expr+pattern . body)
"If `music-expr' matches `pattern', call `body'. `pattern' should look like:
@@ -255,24 +255,24 @@ Generate binding forms by looking for ?var symbol in pattern."
property ?var1
element (music <MusicType> ...)
elements ((music <MusicType> ...)
- ?var2
- (music <MusicType> ...)))
+ ?var2
+ (music <MusicType> ...)))
The properties of `music-expr' are checked against the values given in the
pattern (the name property being the <MusicType> symbol after the `music'
keyword), then all music expression found in its properties (such as 'element
or 'elements).
When ?var is found instead of a property value, ?var is bound that property value,
-as read inside `music-expr'. ?var may also be used to refere to a whole music
-expression inside an elements list for instance. These bindings are accessible
+as read inside `music-expr'. ?var may also be used to refere to a whole music
+expression inside an elements list for instance. These bindings are accessible
inside body."
(let ((music-expr (first music-expr+pattern))
- (pattern (second music-expr+pattern))
- (expr-sym (gensym)))
+ (pattern (second music-expr+pattern))
+ (expr-sym (gensym)))
`(let ((,expr-sym ,music-expr))
(if ,(gen-condition expr-sym pattern)
- (let ,(gen-bindings expr-sym pattern)
- ,@body)
- #f))))
+ (let ,(gen-bindings expr-sym pattern)
+ ,@body)
+ #f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
@@ -310,11 +310,11 @@ inside body."
(define make-music-type-predicate-aux
(lambda (mtypes)
(lambda (expr)
- (if (null? mtypes)
- #f
- (or (eqv? (car mtypes) (ly:music-property expr 'name))
- ((make-music-type-predicate-aux (cdr mtypes)) expr))))))
- (make-music-type-predicate-aux music-types))
+ (if (null? mtypes)
+ #f
+ (or (eqv? (car mtypes) (ly:music-property expr 'name))
+ ((make-music-type-predicate-aux (cdr mtypes)) expr))))))
+ (make-music-type-predicate-aux music-types))
(ly:load "define-music-display-methods.scm")
diff --git a/scm/display-woodwind-diagrams.scm b/scm/display-woodwind-diagrams.scm
index 463e081009..c5eeaefbb3 100644
--- a/scm/display-woodwind-diagrams.scm
+++ b/scm/display-woodwind-diagrams.scm
@@ -64,10 +64,10 @@
(lambda (ls)
(map (lambda (list-to-translate)
`(,(list-ref list-to-translate 0)
- . ,(map (lambda (name element)
- `(,name . ,element))
- parameter-list
- (list-tail list-to-translate 1))))
+ . ,(map (lambda (name element)
+ `(,name . ,element))
+ parameter-list
+ (list-tail list-to-translate 1))))
ls)))
(define (get-named-spreadsheet-column column spreadsheet)
@@ -77,8 +77,8 @@
@code{guile> (get-spreadsheet-column 'bar ((make-named-spreadsheet '(foo bar)) '((x . (1 2)) (y . (3 4)) (z . (5 6)))))}
@code{((x . 2) (y . 4) (z . 6))}"
(map
- (lambda (row) (cons (car row) (assoc-get column (cdr row))))
- spreadsheet))
+ (lambda (row) (cons (car row) (assoc-get column (cdr row))))
+ spreadsheet))
(define make-key-alist
(make-named-spreadsheet '(name offset graphical textual)))
@@ -94,8 +94,8 @@
(define (make-central-column-hole-addresses keys)
"Takes @code{keys} and ascribes them to the central column."
(map
- (lambda (key) `(central-column . ,key))
- keys))
+ (lambda (key) `(central-column . ,key))
+ keys))
(define (make-key-symbols hand)
"Takes @code{hand} and ascribes @code{key} to it."
@@ -111,63 +111,63 @@
(define flute-change-points
((make-named-spreadsheet '(piccolo flute flute-b-extension))
- `((bottom-group-key-names
- . (((x
- . ((offset . (-0.45 . -1.05))
- (stencil . ,piccolo-rh-x-key-stencil)
- (text? . ("X" . #f))
- (complexity . trill))))
- ((cis
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-rh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (c
- . ((offset . (0.3 . 0.0))
- (stencil . ,flute-rh-c-key-stencil)
- (text? . ("C" . #f))
- (complexity . trill)))
- (gz
- . ((offset . (0.0 . -1.2))
- (stencil . ,flute-rh-gz-key-stencil)
- (text? . ("gz" . #f))
- (complexity . trill))))
- ((cis
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-rh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (c
- . ((offset . (0.3 . 0.0))
- (stencil . ,flute-rh-c-key-stencil)
- (text? . ("C" . #f))
- (complexity . trill)))
- (b
- . ((offset . (1.0 . 0.0))
- (stencil . ,flute-rh-b-key-stencil)
- (text? . ("B" . #f))
- (complexity . trill)))
- (gz
- . ((offset . (0.0 . -1.2))
- (stencil . ,flute-rh-gz-key-stencil)
- (text? . ("gz" . #f))
- (complexity . trill))))))
- (bottom-group-graphical-stencil
- . (((right-hand . ees) (right-hand . x))
- ,(make-right-hand-key-addresses '(ees cis c gz))
- ,(make-right-hand-key-addresses '(ees cis c b gz))))
+ `((bottom-group-key-names
+ . (((x
+ . ((offset . (-0.45 . -1.05))
+ (stencil . ,piccolo-rh-x-key-stencil)
+ (text? . ("X" . #f))
+ (complexity . trill))))
+ ((cis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-rh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (c
+ . ((offset . (0.3 . 0.0))
+ (stencil . ,flute-rh-c-key-stencil)
+ (text? . ("C" . #f))
+ (complexity . trill)))
+ (gz
+ . ((offset . (0.0 . -1.2))
+ (stencil . ,flute-rh-gz-key-stencil)
+ (text? . ("gz" . #f))
+ (complexity . trill))))
+ ((cis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-rh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (c
+ . ((offset . (0.3 . 0.0))
+ (stencil . ,flute-rh-c-key-stencil)
+ (text? . ("C" . #f))
+ (complexity . trill)))
+ (b
+ . ((offset . (1.0 . 0.0))
+ (stencil . ,flute-rh-b-key-stencil)
+ (text? . ("B" . #f))
+ (complexity . trill)))
+ (gz
+ . ((offset . (0.0 . -1.2))
+ (stencil . ,flute-rh-gz-key-stencil)
+ (text? . ("gz" . #f))
+ (complexity . trill))))))
+ (bottom-group-graphical-stencil
+ . (((right-hand . ees) (right-hand . x))
+ ,(make-right-hand-key-addresses '(ees cis c gz))
+ ,(make-right-hand-key-addresses '(ees cis c b gz))))
(bottom-group-graphical-draw-instruction
- . (((right-hand . ees))
- ,(make-right-hand-key-addresses '(ees cis c))
- ,(make-right-hand-key-addresses '(ees cis c b))))
+ . (((right-hand . ees))
+ ,(make-right-hand-key-addresses '(ees cis c))
+ ,(make-right-hand-key-addresses '(ees cis c b))))
(bottom-group-special-key-instruction
. ((,rich-group-draw-rule ((right-hand . x)) ((right-hand . ees)))
(,rich-group-draw-rule ((right-hand . gz))
,(make-right-hand-key-addresses
- '(ees cis c)))
+ '(ees cis c)))
(,rich-group-draw-rule ((right-hand . gz))
,(make-right-hand-key-addresses
- '(ees cis c b)))))
+ '(ees cis c b)))))
(bottom-group-text-stencil
. (,(make-right-hand-key-addresses '(bes d dis ees x))
,(make-right-hand-key-addresses '(bes d dis ees cis c gz))
@@ -177,153 +177,153 @@
(let*
((change-points
(get-named-spreadsheet-column
- flute-name
- flute-change-points)))
- `(,flute-name
- . ((keys
- . ((hidden
- . ((midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,midline-stencil)
- (text? . #f)
- (complexity . basic)))))
- (central-column
- . ((one
- . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (two
- . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (three
- . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (four
- . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (five
- . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (six
- . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))))
- (left-hand
- . ((bes
- . ((offset . (0.5 . 1.8))
- (stencil . ,flute-lh-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (b
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-lh-b-key-stencil)
- (text? . ("B" . #f))
- (complexity . trill)))
- (gis
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-lh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))))
- (right-hand
- . ,(append `((bes
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-rh-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (d
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-rh-d-key-stencil)
- (text? . ("D" . #f))
- (complexity . trill)))
- (dis
- . ((offset . (0.0 . 0.0))
- (stencil . ,flute-rh-dis-key-stencil)
- (text? . ("D" . 1))
- (complexity . trill)))
- (ees
- . ((offset . (1.5 . 1.3))
- (stencil . ,flute-rh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill))))
- (assoc-get 'bottom-group-key-names change-points)))))
- (graphical-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
+ flute-name
+ flute-change-points)))
+ `(,flute-name
+ . ((keys
+ . ((hidden
+ . ((midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,midline-stencil)
+ (text? . #f)
+ (complexity . basic)))))
+ (central-column
+ . ((one
+ . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (two
+ . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (three
+ . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (four
+ . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (five
+ . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (six
+ . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))))
+ (left-hand
+ . ((bes
+ . ((offset . (0.5 . 1.8))
+ (stencil . ,flute-lh-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (b
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-lh-b-key-stencil)
+ (text? . ("B" . #f))
+ (complexity . trill)))
+ (gis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-lh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))))
+ (right-hand
+ . ,(append `((bes
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-rh-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (d
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-rh-d-key-stencil)
+ (text? . ("D" . #f))
+ (complexity . trill)))
+ (dis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,flute-rh-dis-key-stencil)
+ (text? . ("D" . 1))
+ (complexity . trill)))
+ (ees
+ . ((offset . (1.5 . 1.3))
+ (stencil . ,flute-rh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill))))
+ (assoc-get 'bottom-group-key-names change-points)))))
+ (graphical-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils . ((left-hand . bes) (left-hand . b)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-1.5 . 6.5)))
- ,(simple-stencil-alist '(left-hand . gis) '(1.0 . 4.0))
- ,(simple-stencil-alist '(right-hand . bes) '(-1.75 . 3.05))
- ,(simple-stencil-alist '(right-hand . d) '(-1.0 . 2.5))
- ,(simple-stencil-alist '(right-hand . dis) '(-1.0 . 1.5))
- ((stencils
- . ,(assoc-get 'bottom-group-graphical-stencil
- change-points))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (0.0 . -0.6)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (((left-hand . bes) (left-hand . b))
- ,(assoc-get 'bottom-group-graphical-draw-instruction
- change-points)))
- ,(assoc-get 'bottom-group-special-key-instruction
- change-points)
- (,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,uniform-extra-offset-rule (0.0 . 0.0))))))
- (text-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils . ((left-hand . bes) (left-hand . b)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-1.5 . 6.5)))
+ ,(simple-stencil-alist '(left-hand . gis) '(1.0 . 4.0))
+ ,(simple-stencil-alist '(right-hand . bes) '(-1.75 . 3.05))
+ ,(simple-stencil-alist '(right-hand . d) '(-1.0 . 2.5))
+ ,(simple-stencil-alist '(right-hand . dis) '(-1.0 . 1.5))
+ ((stencils
+ . ,(assoc-get 'bottom-group-graphical-stencil
+ change-points))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (0.0 . -0.6)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (((left-hand . bes) (left-hand . b))
+ ,(assoc-get 'bottom-group-graphical-draw-instruction
+ change-points)))
+ ,(assoc-get 'bottom-group-special-key-instruction
+ change-points)
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,uniform-extra-offset-rule (0.0 . 0.0))))))
+ (text-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils . ,(make-left-hand-key-addresses '(bes b gis)))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (1.5 . 3.75)))
- ((stencils . ,(assoc-get 'bottom-group-text-stencil
- change-points))
- (textual? . ,rh-woodwind-text-stencil)
- (offset . (-1.25 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(make-left-hand-key-addresses '(bes b gis))
- ,(assoc-get 'bottom-group-text-stencil change-points)))
- (,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils . ,(make-left-hand-key-addresses '(bes b gis)))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (1.5 . 3.75)))
+ ((stencils . ,(assoc-get 'bottom-group-text-stencil
+ change-points))
+ (textual? . ,rh-woodwind-text-stencil)
+ (offset . (-1.25 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(make-left-hand-key-addresses '(bes b gis))
+ ,(assoc-get 'bottom-group-text-stencil change-points)))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
;;; Tin whistle assembly instructions
@@ -332,87 +332,87 @@
(define (generate-tin-whistle-family-entry tin-whistle-name)
(let*
- ((change-points
- (get-named-spreadsheet-column tin-whistle-name tin-whistle-change-points)))
- `(,tin-whistle-name
- . ((keys
- . ((hidden
- . ((midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,midline-stencil)
- (text? . #f)
- (complexity . basic)))))
- (central-column
- . ((one
- . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (two
- . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (three
- . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (four
- . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (five
- . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (six
- . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))))
- (left-hand . ())
- (right-hand . ())))
- (graphical-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,uniform-extra-offset-rule (0.0 . 0.0))))))
- (text-commands
- . ((stencil-alist
- . ((stencils .
- (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-H-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
+ ((change-points
+ (get-named-spreadsheet-column tin-whistle-name tin-whistle-change-points)))
+ `(,tin-whistle-name
+ . ((keys
+ . ((hidden
+ . ((midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,midline-stencil)
+ (text? . #f)
+ (complexity . basic)))))
+ (central-column
+ . ((one
+ . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (two
+ . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (three
+ . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (four
+ . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (five
+ . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (six
+ . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))))
+ (left-hand . ())
+ (right-hand . ())))
+ (graphical-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,uniform-extra-offset-rule (0.0 . 0.0))))))
+ (text-commands
+ . ((stencil-alist
+ . ((stencils .
+ (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-H-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
;;; Oboe assembly instructions
@@ -421,600 +421,600 @@
(define (generate-oboe-family-entry oboe-name)
(let*
- ((change-points
- (get-named-spreadsheet-column oboe-name oboe-change-points)))
- `(,oboe-name
- . ((keys
- . ((hidden
- . ((midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,midline-stencil)
- (text? . #f)
- (complexity . basic)))))
- (central-column
- . ((one
- . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (two
- . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (three
- . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (four
- . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (five
- . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (six
- . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (h
- . ((offset . (0.0 . 6.25))
- (stencil . ,(variable-column-circle-stencil 0.4))
- (text? . #f)
- (complexity . trill)))))
- (left-hand
- . ((I
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-lh-I-key-stencil)
- (text? . ("I" . #f))
- (complexity . trill)))
- (III
- . ((offset . (0.0 . 2.6))
- (stencil . ,oboe-lh-III-key-stencil)
- (text? . ("III" . #f))
- (complexity . trill)))
- (II
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-lh-II-key-stencil)
- (text? . ("II" . #f))
- (complexity . trill)))
- (b
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-lh-b-key-stencil)
- (text? . ("B" . #f))
- (complexity . trill)))
- (d
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-lh-d-key-stencil)
- (text? . ("D" . #f))
- (complexity . trill)))
- (cis
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-lh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (gis
- . ((offset . (-0.85 . 0.2))
- (stencil . ,oboe-lh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))
- (ees
- . ((offset . (2.05 . -3.65))
- (stencil . ,oboe-lh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))
- (low-b
- . ((offset . (3.6 . 0.5))
- (stencil . ,oboe-lh-low-b-key-stencil)
- (text? . ("b" . #f))
- (complexity . trill)))
- (bes
- . ((offset . (2.25 . -4.15))
- (stencil . ,oboe-lh-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (f
- . ((offset . (2.15 . -3.85))
- (stencil . ,oboe-lh-f-key-stencil)
- (text? . ("F" . #f))
- (complexity . trill)))))
- (right-hand
- . ((a
- . ((offset . (1.5 . 1.2))
- (stencil . ,oboe-rh-a-key-stencil)
- (text? . ("A" . #f))
- (complexity . trill)))
- (gis
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-rh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))
- (d
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-rh-d-key-stencil)
- (text? . ("D" . #f))
- (complexity . trill)))
- (f
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-rh-f-key-stencil)
- (text? . ("F" . #f))
- (complexity . trill)))
- (banana
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-rh-banana-key-stencil)
- (text? . ("ban" . #f))
- (complexity . trill)))
- (c
- . ((offset . (0.0 . 0.0))
- (stencil . ,oboe-rh-c-key-stencil)
- (text? . ("C" . #f))
- (complexity . trill)))
- (cis
- . ((offset . (3.8 . -0.6))
- (stencil . ,oboe-rh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (ees
- . ((offset . (0.0 . -1.8))
- (stencil . ,oboe-rh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))))))
- (graphical-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-H-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils . ((left-hand . I) (left-hand . III)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-2.5 . 6.5)))
- ,(simple-stencil-alist '(left-hand . II) '(2.5 . 6.0))
- ,(simple-stencil-alist '(left-hand . b) '(-1.35 . 6.0))
- ,(simple-stencil-alist '(left-hand . d) '(1.0 . 6.0))
- ,(simple-stencil-alist '(left-hand . cis) '(1.0 . 5.0))
- ((stencils
- . ,(make-left-hand-key-addresses '(gis bes low-b ees f)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (0.0 . 3.9)))
- ((stencils .
- ,(make-right-hand-key-addresses '(a gis)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-3.5 . 3.5)))
- ,(simple-stencil-alist '(right-hand . d) '(1.0 . 2.5))
- ,(simple-stencil-alist '(right-hand . f) '(-1.0 . 1.5))
- ,(simple-stencil-alist '(right-hand . banana) '(1.7 . 1.0))
- ((stencils . ,(make-right-hand-key-addresses '(c cis ees)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-3.4 . 0.3)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (((right-hand . a) (right-hand . gis))
- ,(make-left-hand-key-addresses '(gis bes low-b ees))
- ,(make-right-hand-key-addresses '(cis c ees))))
- (,rich-group-draw-rule
- ((left-hand . III))
- ((left-hand . I)))
- (,rich-group-draw-rule
- ((left-hand . f))
- ,(make-left-hand-key-addresses '(gis bes low-b ees)))
- (,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,rich-group-extra-offset-rule
- ((central-column . h)) ((central-column . one)) (0.0 . 0.8))
- (,uniform-extra-offset-rule (0.0 . 0.0))))))
- (text-commands
- . ((stencil-alist
- . ((stencils .
- (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-H-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils . ,(make-left-hand-key-addresses '(III I)))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (-2.8 . 7.0)))
- ((stencils . ,(make-left-hand-key-addresses '(II)))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (2.2 . 7.0)))
- ((stencils
- . ,(make-left-hand-key-addresses
- '(b d cis gis ees low-b bes f)))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (1.5 . 3.75)))
- ((stencils
- . ,(make-right-hand-key-addresses
- '(a gis d f banana c cis ees)))
- (textual? . ,rh-woodwind-text-stencil)
- (offset . (-1.25 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(make-left-hand-key-addresses '(b d cis gis ees low-b bes f))
- ,(make-left-hand-key-addresses '(III I))
- ,(make-right-hand-key-addresses '(a gis d f banana c cis ees))))
- (,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,rich-group-extra-offset-rule
- ((central-column . h))
- ((central-column . one))
- (0.0 . 0.8))
- (,uniform-extra-offset-rule (0.0 . 0.0))))))))))
+ ((change-points
+ (get-named-spreadsheet-column oboe-name oboe-change-points)))
+ `(,oboe-name
+ . ((keys
+ . ((hidden
+ . ((midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,midline-stencil)
+ (text? . #f)
+ (complexity . basic)))))
+ (central-column
+ . ((one
+ . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (two
+ . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (three
+ . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (four
+ . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (five
+ . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (six
+ . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (h
+ . ((offset . (0.0 . 6.25))
+ (stencil . ,(variable-column-circle-stencil 0.4))
+ (text? . #f)
+ (complexity . trill)))))
+ (left-hand
+ . ((I
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-lh-I-key-stencil)
+ (text? . ("I" . #f))
+ (complexity . trill)))
+ (III
+ . ((offset . (0.0 . 2.6))
+ (stencil . ,oboe-lh-III-key-stencil)
+ (text? . ("III" . #f))
+ (complexity . trill)))
+ (II
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-lh-II-key-stencil)
+ (text? . ("II" . #f))
+ (complexity . trill)))
+ (b
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-lh-b-key-stencil)
+ (text? . ("B" . #f))
+ (complexity . trill)))
+ (d
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-lh-d-key-stencil)
+ (text? . ("D" . #f))
+ (complexity . trill)))
+ (cis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-lh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (gis
+ . ((offset . (-0.85 . 0.2))
+ (stencil . ,oboe-lh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))
+ (ees
+ . ((offset . (2.05 . -3.65))
+ (stencil . ,oboe-lh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))
+ (low-b
+ . ((offset . (3.6 . 0.5))
+ (stencil . ,oboe-lh-low-b-key-stencil)
+ (text? . ("b" . #f))
+ (complexity . trill)))
+ (bes
+ . ((offset . (2.25 . -4.15))
+ (stencil . ,oboe-lh-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (f
+ . ((offset . (2.15 . -3.85))
+ (stencil . ,oboe-lh-f-key-stencil)
+ (text? . ("F" . #f))
+ (complexity . trill)))))
+ (right-hand
+ . ((a
+ . ((offset . (1.5 . 1.2))
+ (stencil . ,oboe-rh-a-key-stencil)
+ (text? . ("A" . #f))
+ (complexity . trill)))
+ (gis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-rh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))
+ (d
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-rh-d-key-stencil)
+ (text? . ("D" . #f))
+ (complexity . trill)))
+ (f
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-rh-f-key-stencil)
+ (text? . ("F" . #f))
+ (complexity . trill)))
+ (banana
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-rh-banana-key-stencil)
+ (text? . ("ban" . #f))
+ (complexity . trill)))
+ (c
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,oboe-rh-c-key-stencil)
+ (text? . ("C" . #f))
+ (complexity . trill)))
+ (cis
+ . ((offset . (3.8 . -0.6))
+ (stencil . ,oboe-rh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (ees
+ . ((offset . (0.0 . -1.8))
+ (stencil . ,oboe-rh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))))))
+ (graphical-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-H-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils . ((left-hand . I) (left-hand . III)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-2.5 . 6.5)))
+ ,(simple-stencil-alist '(left-hand . II) '(2.5 . 6.0))
+ ,(simple-stencil-alist '(left-hand . b) '(-1.35 . 6.0))
+ ,(simple-stencil-alist '(left-hand . d) '(1.0 . 6.0))
+ ,(simple-stencil-alist '(left-hand . cis) '(1.0 . 5.0))
+ ((stencils
+ . ,(make-left-hand-key-addresses '(gis bes low-b ees f)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (0.0 . 3.9)))
+ ((stencils .
+ ,(make-right-hand-key-addresses '(a gis)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-3.5 . 3.5)))
+ ,(simple-stencil-alist '(right-hand . d) '(1.0 . 2.5))
+ ,(simple-stencil-alist '(right-hand . f) '(-1.0 . 1.5))
+ ,(simple-stencil-alist '(right-hand . banana) '(1.7 . 1.0))
+ ((stencils . ,(make-right-hand-key-addresses '(c cis ees)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-3.4 . 0.3)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (((right-hand . a) (right-hand . gis))
+ ,(make-left-hand-key-addresses '(gis bes low-b ees))
+ ,(make-right-hand-key-addresses '(cis c ees))))
+ (,rich-group-draw-rule
+ ((left-hand . III))
+ ((left-hand . I)))
+ (,rich-group-draw-rule
+ ((left-hand . f))
+ ,(make-left-hand-key-addresses '(gis bes low-b ees)))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,rich-group-extra-offset-rule
+ ((central-column . h)) ((central-column . one)) (0.0 . 0.8))
+ (,uniform-extra-offset-rule (0.0 . 0.0))))))
+ (text-commands
+ . ((stencil-alist
+ . ((stencils .
+ (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-H-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils . ,(make-left-hand-key-addresses '(III I)))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (-2.8 . 7.0)))
+ ((stencils . ,(make-left-hand-key-addresses '(II)))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (2.2 . 7.0)))
+ ((stencils
+ . ,(make-left-hand-key-addresses
+ '(b d cis gis ees low-b bes f)))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (1.5 . 3.75)))
+ ((stencils
+ . ,(make-right-hand-key-addresses
+ '(a gis d f banana c cis ees)))
+ (textual? . ,rh-woodwind-text-stencil)
+ (offset . (-1.25 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(make-left-hand-key-addresses '(b d cis gis ees low-b bes f))
+ ,(make-left-hand-key-addresses '(III I))
+ ,(make-right-hand-key-addresses '(a gis d f banana c cis ees))))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,rich-group-extra-offset-rule
+ ((central-column . h))
+ ((central-column . one))
+ (0.0 . 0.8))
+ (,uniform-extra-offset-rule (0.0 . 0.0))))))))))
;; Clarinet assembly instructions
(define clarinet-change-points
((make-named-spreadsheet '(clarinet bass-clarinet low-bass-clarinet))
- `((bottom-group-key-names
- . (()
- ((ees
- . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,bass-clarinet-rh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill))))
- ((ees
- . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,low-bass-clarinet-rh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))
- (d
- . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* -1 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,clarinet-rh-d-key-stencil)
- (text? . ("d" . #f))
- (complexity . trill)))
- (low-cis
- . ((offset . (0.0 . 1.4))
- (stencil . ,clarinet-rh-low-cis-key-stencil)
- (text? . ("c" . 1))
- (complexity . trill)))
- (low-d
- . ((offset . (0.0 . 2.4))
- (stencil . ,clarinet-rh-low-d-key-stencil)
- (text? . ("d" . #f))
- (complexity . trill)))
- (low-c
- . ((offset . (0.0 . 0.0))
- (stencil . ,clarinet-rh-low-c-key-stencil)
- (text? . ("c" . #f))
- (complexity . trill))))))
- (left-extra-key-names
- . (()
- ()
- ((d
- . ((offset . (4.0 . -0.8))
- (stencil . ,clarinet-lh-d-key-stencil)
- (text? . ("D" . #f))
- (complexity . trill))))))
- (right-thumb-group
- . (()
- ()
- (((stencils
+ `((bottom-group-key-names
+ . (()
+ ((ees
+ . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,bass-clarinet-rh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill))))
+ ((ees
+ . ((offset . (0.0 . ,(* 0 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,low-bass-clarinet-rh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))
+ (d
+ . ((offset . (,(+ 1.5 CL-RH-HAIR) . ,(* -1 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,clarinet-rh-d-key-stencil)
+ (text? . ("d" . #f))
+ (complexity . trill)))
+ (low-cis
+ . ((offset . (0.0 . 1.4))
+ (stencil . ,clarinet-rh-low-cis-key-stencil)
+ (text? . ("c" . 1))
+ (complexity . trill)))
+ (low-d
+ . ((offset . (0.0 . 2.4))
+ (stencil . ,clarinet-rh-low-d-key-stencil)
+ (text? . ("d" . #f))
+ (complexity . trill)))
+ (low-c
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,clarinet-rh-low-c-key-stencil)
+ (text? . ("c" . #f))
+ (complexity . trill))))))
+ (left-extra-key-names
+ . (()
+ ()
+ ((d
+ . ((offset . (4.0 . -0.8))
+ (stencil . ,clarinet-lh-d-key-stencil)
+ (text? . ("D" . #f))
+ (complexity . trill))))))
+ (right-thumb-group
+ . (()
+ ()
+ (((stencils
. ,(make-right-hand-key-addresses '(low-c low-cis)))
(xy-scale-function . (,return-1 . ,return-1))
(textual? . #f)
(offset . (-1.3 . 4.0))))))
- (low-left-hand-key-addresses
- . (,(make-left-hand-key-addresses '(cis f e fis))
- ,(make-left-hand-key-addresses '(cis f e fis))
- ,(make-left-hand-key-addresses '(cis f e fis d))))
- (all-left-hand-key-addresses
- . (,(make-left-hand-key-addresses '(a gis ees cis f e fis))
- ,(make-left-hand-key-addresses '(a gis ees cis f e fis))
- ,(make-left-hand-key-addresses '(a gis ees cis f e fis d))))
- (low-key-group
- . (()
- ()
- (,(make-right-hand-key-addresses '(low-c low-cis)))))
- (low-rich-draw-rules
- . (()
- ()
- ((,rich-group-draw-rule
- ((left-hand . d))
- ,(make-left-hand-key-addresses '(cis f e fis)))
- (,rich-group-draw-rule
- ((right-hand . low-d))
- ((right-hand . low-cis) (right-hand . low-c))))))
- (low-extra-offset-rule
- . (()
- ()
- ((,rich-group-extra-offset-rule
- ,(make-right-hand-key-addresses '(low-c low-d low-cis))
- ,(make-right-hand-key-addresses '(one two three four))
- (-0.5 . -0.7)))))
- (bottom-right-group-key-addresses
- . (,(make-right-hand-key-addresses '(fis e f gis))
- ,(make-right-hand-key-addresses '(fis e ees gis f))
- ,(make-right-hand-key-addresses '(fis e ees gis f d))))
- (right-hand-key-addresses
- . (,(make-right-hand-key-addresses '(fis e f gis))
- ,(make-right-hand-key-addresses '(fis e ees gis f))
- ,(make-right-hand-key-addresses
- '(low-d low-cis low-c fis e ees gis f d)))))))
+ (low-left-hand-key-addresses
+ . (,(make-left-hand-key-addresses '(cis f e fis))
+ ,(make-left-hand-key-addresses '(cis f e fis))
+ ,(make-left-hand-key-addresses '(cis f e fis d))))
+ (all-left-hand-key-addresses
+ . (,(make-left-hand-key-addresses '(a gis ees cis f e fis))
+ ,(make-left-hand-key-addresses '(a gis ees cis f e fis))
+ ,(make-left-hand-key-addresses '(a gis ees cis f e fis d))))
+ (low-key-group
+ . (()
+ ()
+ (,(make-right-hand-key-addresses '(low-c low-cis)))))
+ (low-rich-draw-rules
+ . (()
+ ()
+ ((,rich-group-draw-rule
+ ((left-hand . d))
+ ,(make-left-hand-key-addresses '(cis f e fis)))
+ (,rich-group-draw-rule
+ ((right-hand . low-d))
+ ((right-hand . low-cis) (right-hand . low-c))))))
+ (low-extra-offset-rule
+ . (()
+ ()
+ ((,rich-group-extra-offset-rule
+ ,(make-right-hand-key-addresses '(low-c low-d low-cis))
+ ,(make-right-hand-key-addresses '(one two three four))
+ (-0.5 . -0.7)))))
+ (bottom-right-group-key-addresses
+ . (,(make-right-hand-key-addresses '(fis e f gis))
+ ,(make-right-hand-key-addresses '(fis e ees gis f))
+ ,(make-right-hand-key-addresses '(fis e ees gis f d))))
+ (right-hand-key-addresses
+ . (,(make-right-hand-key-addresses '(fis e f gis))
+ ,(make-right-hand-key-addresses '(fis e ees gis f))
+ ,(make-right-hand-key-addresses
+ '(low-d low-cis low-c fis e ees gis f d)))))))
(define (generate-clarinet-family-entry clarinet-name)
(let*
- ((change-points
- (get-named-spreadsheet-column clarinet-name clarinet-change-points)))
- `(,clarinet-name
- . ((keys
- . ((hidden
- . ((midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,midline-stencil)
- (text? . #f)
- (complexity . basic)))))
- (central-column
- . ((one
- . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (two
- . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (three
- . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (four
- . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (five
- . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (six
- . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . covered)))
- (h
- . ((offset . (0.0 . 6.25))
- (stencil . ,(variable-column-circle-stencil 0.4))
- (text? . #f)
- (complexity . covered)))))
- (left-hand
- . ,(append `((thumb
- . ((offset . (0.0 . 0.0))
- (stencil . ,clarinet-lh-thumb-key-stencil)
- (text? . #f)
- (complexity . trill)))
- (R
- . ((offset . (1.0 . 1.0))
- (stencil . ,clarinet-lh-R-key-stencil)
- (text? . #f)
- (complexity . trill)))
- (a
- . ((offset . (0.0 . 0.0))
- (stencil . ,clarinet-lh-a-key-stencil)
- (text? . ("A" . #f))
- (complexity . trill)))
- (gis
- . ((offset . (0.8 . 1.0))
- (stencil . ,clarinet-lh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))
- (ees
- . ((offset . (0.0 . 0.0))
- (stencil . ,clarinet-lh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))
- (cis
- . ((offset . (-0.85 . 0.2))
- (stencil . ,clarinet-lh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (f
- . ((offset . (3.6 . 0.5))
- (stencil . ,clarinet-lh-f-key-stencil)
- (text? . ("F" . #f))
- (complexity . trill)))
- (e
- . ((offset . (2.05 . -3.65))
- (stencil . ,clarinet-lh-e-key-stencil)
- (text? . ("E" . #f))
- (complexity . trill)))
- (fis
- . ((offset . (2.25 . -4.15))
- (stencil . ,clarinet-lh-fis-key-stencil)
- (text? . ("F" . 1))
- (complexity . trill))))
- (assoc-get 'left-extra-key-names change-points)))
- (right-hand
- . ,(append `((one
- . ((offset . (0.0 . 0.75))
- (stencil . ,clarinet-rh-one-key-stencil)
- (text? . "1")
- (complexity . trill)))
- (two
- . ((offset . (0.0 . 0.25))
- (stencil . ,clarinet-rh-two-key-stencil)
- (text? . "2")
- (complexity . trill)))
- (three
- . ((offset . (0.0 . -0.25))
- (stencil . ,clarinet-rh-three-key-stencil)
- (text? . "3")
- (complexity . trill)))
- (four
- . ((offset . (0.0 . -0.75))
- (stencil . ,clarinet-rh-four-key-stencil)
- (text? . "4")
- (complexity . trill)))
- (b
- . ((offset . (0.0 . 0.0))
- (stencil . ,clarinet-rh-b-key-stencil)
- (text? . ("B" . #f))
- (complexity . trill)))
- (fis
- . ((offset . (0.0 . ,(* 4 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,clarinet-rh-fis-key-stencil)
- (text? . ("F" . 1))
- (complexity . trill)))
- (gis
- . ((offset . (,(+ 1.5 CL-RH-HAIR)
- . ,(* 3 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,clarinet-rh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))
- (e
- . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,clarinet-rh-e-key-stencil)
- (text? . ("E" . #f))
- (complexity . trill)))
- (f
- . ((offset . (,(+ 1.5 CL-RH-HAIR)
- . ,(* 1 (+ 0.75 CL-RH-HAIR))))
- (stencil . ,clarinet-rh-f-key-stencil)
- (text? . ("F" . #f))
- (complexity . trill))))
- (assoc-get 'bottom-group-key-names change-points)))))
- (graphical-commands
- . ((stencil-alist
- . ((stencils
- . ,(append (assoc-get 'right-thumb-group change-points)
- `(,(simple-stencil-alist '(hidden . midline)
- '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-H-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils
- . ,(make-left-hand-key-addresses '(thumb R)))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (-2.5 . 6.5)))
- ((stencils
- . ((left-hand . a) (left-hand . gis)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (0.0 . 7.5)))
- ,(simple-stencil-alist '(left-hand . ees)
- '(1.0 . 5.0))
- ((stencils
- . ,(make-left-hand-key-addresses '(cis f e fis)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (0.0 . 3.9)))
- ((stencils
- . ,(make-right-hand-key-addresses
- '(one two three four)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-1.25 . 3.75)))
- ,(simple-stencil-alist '(right-hand . b)
- '(-1.0 . 1.5))
- ((stencils
- . ,(assoc-get 'bottom-right-group-key-addresses
- change-points))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-4.0 . -0.75))))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ,(append (assoc-get 'low-rich-draw-rules change-points)
- `((,apply-group-draw-rule-series
- ,(append (assoc-get 'low-key-group change-points)
- `(((left-hand . a) (left-hand . gis))
- ,(make-right-hand-key-addresses
+ ((change-points
+ (get-named-spreadsheet-column clarinet-name clarinet-change-points)))
+ `(,clarinet-name
+ . ((keys
+ . ((hidden
+ . ((midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,midline-stencil)
+ (text? . #f)
+ (complexity . basic)))))
+ (central-column
+ . ((one
+ . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (two
+ . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (three
+ . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (four
+ . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (five
+ . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (six
+ . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . covered)))
+ (h
+ . ((offset . (0.0 . 6.25))
+ (stencil . ,(variable-column-circle-stencil 0.4))
+ (text? . #f)
+ (complexity . covered)))))
+ (left-hand
+ . ,(append `((thumb
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,clarinet-lh-thumb-key-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (R
+ . ((offset . (1.0 . 1.0))
+ (stencil . ,clarinet-lh-R-key-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (a
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,clarinet-lh-a-key-stencil)
+ (text? . ("A" . #f))
+ (complexity . trill)))
+ (gis
+ . ((offset . (0.8 . 1.0))
+ (stencil . ,clarinet-lh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))
+ (ees
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,clarinet-lh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))
+ (cis
+ . ((offset . (-0.85 . 0.2))
+ (stencil . ,clarinet-lh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (f
+ . ((offset . (3.6 . 0.5))
+ (stencil . ,clarinet-lh-f-key-stencil)
+ (text? . ("F" . #f))
+ (complexity . trill)))
+ (e
+ . ((offset . (2.05 . -3.65))
+ (stencil . ,clarinet-lh-e-key-stencil)
+ (text? . ("E" . #f))
+ (complexity . trill)))
+ (fis
+ . ((offset . (2.25 . -4.15))
+ (stencil . ,clarinet-lh-fis-key-stencil)
+ (text? . ("F" . 1))
+ (complexity . trill))))
+ (assoc-get 'left-extra-key-names change-points)))
+ (right-hand
+ . ,(append `((one
+ . ((offset . (0.0 . 0.75))
+ (stencil . ,clarinet-rh-one-key-stencil)
+ (text? . "1")
+ (complexity . trill)))
+ (two
+ . ((offset . (0.0 . 0.25))
+ (stencil . ,clarinet-rh-two-key-stencil)
+ (text? . "2")
+ (complexity . trill)))
+ (three
+ . ((offset . (0.0 . -0.25))
+ (stencil . ,clarinet-rh-three-key-stencil)
+ (text? . "3")
+ (complexity . trill)))
+ (four
+ . ((offset . (0.0 . -0.75))
+ (stencil . ,clarinet-rh-four-key-stencil)
+ (text? . "4")
+ (complexity . trill)))
+ (b
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,clarinet-rh-b-key-stencil)
+ (text? . ("B" . #f))
+ (complexity . trill)))
+ (fis
+ . ((offset . (0.0 . ,(* 4 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,clarinet-rh-fis-key-stencil)
+ (text? . ("F" . 1))
+ (complexity . trill)))
+ (gis
+ . ((offset . (,(+ 1.5 CL-RH-HAIR)
+ . ,(* 3 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,clarinet-rh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))
+ (e
+ . ((offset . (0.0 . ,(* 2 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,clarinet-rh-e-key-stencil)
+ (text? . ("E" . #f))
+ (complexity . trill)))
+ (f
+ . ((offset . (,(+ 1.5 CL-RH-HAIR)
+ . ,(* 1 (+ 0.75 CL-RH-HAIR))))
+ (stencil . ,clarinet-rh-f-key-stencil)
+ (text? . ("F" . #f))
+ (complexity . trill))))
+ (assoc-get 'bottom-group-key-names change-points)))))
+ (graphical-commands
+ . ((stencil-alist
+ . ((stencils
+ . ,(append (assoc-get 'right-thumb-group change-points)
+ `(,(simple-stencil-alist '(hidden . midline)
+ '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-H-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils
+ . ,(make-left-hand-key-addresses '(thumb R)))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (-2.5 . 6.5)))
+ ((stencils
+ . ((left-hand . a) (left-hand . gis)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (0.0 . 7.5)))
+ ,(simple-stencil-alist '(left-hand . ees)
+ '(1.0 . 5.0))
+ ((stencils
+ . ,(make-left-hand-key-addresses '(cis f e fis)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (0.0 . 3.9)))
+ ((stencils
+ . ,(make-right-hand-key-addresses
+ '(one two three four)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-1.25 . 3.75)))
+ ,(simple-stencil-alist '(right-hand . b)
+ '(-1.0 . 1.5))
+ ((stencils
+ . ,(assoc-get 'bottom-right-group-key-addresses
+ change-points))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-4.0 . -0.75))))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ,(append (assoc-get 'low-rich-draw-rules change-points)
+ `((,apply-group-draw-rule-series
+ ,(append (assoc-get 'low-key-group change-points)
+ `(((left-hand . a) (left-hand . gis))
+ ,(make-right-hand-key-addresses
'(one two three four))
- ,(assoc-get 'low-left-hand-key-addresses
- change-points)
- ,(assoc-get 'right-hand-key-addresses
- change-points))))
- (,rich-group-draw-rule
- ((left-hand . R))
- ((left-hand . thumb)))
- (,group-automate-rule
- ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline))))))
- (extra-offset-instructions
- . ,(append (assoc-get 'low-extra-offset-rule change-points)
- `((,rich-group-extra-offset-rule
- ((central-column . h))
- ((central-column . one)
- (left-hand . a)
- (left-hand . gis))
- (0.0 . 0.8))
- (,uniform-extra-offset-rule (0.0 . 0.0)))))))
- (text-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
+ ,(assoc-get 'low-left-hand-key-addresses
+ change-points)
+ ,(assoc-get 'right-hand-key-addresses
+ change-points))))
+ (,rich-group-draw-rule
+ ((left-hand . R))
+ ((left-hand . thumb)))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline))))))
+ (extra-offset-instructions
+ . ,(append (assoc-get 'low-extra-offset-rule change-points)
+ `((,rich-group-extra-offset-rule
+ ((central-column . h))
+ ((central-column . one)
+ (left-hand . a)
+ (left-hand . gis))
+ (0.0 . 0.8))
+ (,uniform-extra-offset-rule (0.0 . 0.0)))))))
+ (text-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils . ((left-hand . thumb) (left-hand . R)))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (-2.5 . 6.5)))
- ((stencils
- . ,(assoc-get 'all-left-hand-key-addresses change-points))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (1.5 . 3.75)))
- ((stencils
- . ,(make-right-hand-key-addresses '(one two three four)))
- (textual? . ,number-column-stencil)
- (offset . (-1.25 . 3.75)))
- ((stencils . ,(assoc-get 'right-hand-key-addresses
- change-points))
- (textual? . ,rh-woodwind-text-stencil)
- (offset . (-1.25 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(assoc-get 'all-left-hand-key-addresses change-points)
- ,(make-right-hand-key-addresses '(one two three four))
- ,(assoc-get 'right-hand-key-addresses change-points)))
- (,group-automate-rule
- ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,rich-group-extra-offset-rule
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils . ((left-hand . thumb) (left-hand . R)))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (-2.5 . 6.5)))
+ ((stencils
+ . ,(assoc-get 'all-left-hand-key-addresses change-points))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (1.5 . 3.75)))
+ ((stencils
+ . ,(make-right-hand-key-addresses '(one two three four)))
+ (textual? . ,number-column-stencil)
+ (offset . (-1.25 . 3.75)))
+ ((stencils . ,(assoc-get 'right-hand-key-addresses
+ change-points))
+ (textual? . ,rh-woodwind-text-stencil)
+ (offset . (-1.25 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(assoc-get 'all-left-hand-key-addresses change-points)
+ ,(make-right-hand-key-addresses '(one two three four))
+ ,(assoc-get 'right-hand-key-addresses change-points)))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,rich-group-extra-offset-rule
((central-column . h))
((central-column . one) (left-hand . a) (left-hand . gis))
(0.0 . 0.8))
- (,uniform-extra-offset-rule (0.0 . 0.0))))))))))
+ (,uniform-extra-offset-rule (0.0 . 0.0))))))))))
;; Saxophone assembly instructions
@@ -1027,618 +1027,618 @@
(define saxophone-change-points
((make-named-spreadsheet '(saxophone baritone-saxophone))
- `((low-a-key-definition
- . (()
- ((low-a
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-lh-low-a-key-stencil)
- (text? . #f)
- (complexity . trill))))))
+ `((low-a-key-definition
+ . (()
+ ((low-a
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-lh-low-a-key-stencil)
+ (text? . #f)
+ (complexity . trill))))))
(low-a-key-group
- . (()
- (,(simple-stencil-alist '(left-hand . low-a) '(-5.0 . 7.0)))))
+ . (()
+ (,(simple-stencil-alist '(left-hand . low-a) '(-5.0 . 7.0)))))
(low-a-presence
- . (()
- ((left-hand . low-a))))
+ . (()
+ ((left-hand . low-a))))
(left-hand-key-names
- . (,(make-right-hand-key-addresses
- '(ees d f front-f bes gis cis b low-bes))
- ,(make-right-hand-key-addresses
- '(ees d f front-f bes gis cis b low-bes low-a)))))))
+ . (,(make-right-hand-key-addresses
+ '(ees d f front-f bes gis cis b low-bes))
+ ,(make-right-hand-key-addresses
+ '(ees d f front-f bes gis cis b low-bes low-a)))))))
(define (generate-saxophone-family-entry saxophone-name)
(let*
- ((change-points
- (get-named-spreadsheet-column
- (saxophone-name-passerelle saxophone-name) saxophone-change-points)))
- `(,saxophone-name
- . ((keys
- . ((hidden
- . ((midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,midline-stencil)
- (text? . #f)
- (complexity . basic)))))
- (central-column
- . ((one
- . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . trill)))
- (two
- . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . trill)))
- (three
- . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . trill)))
- (four
- . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . trill)))
- (five
- . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . trill)))
- (six
- . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,column-circle-stencil)
- (text? . #f)
- (complexity . trill)))))
- (left-hand
- . ,(append (assoc-get 'low-a-key-definition change-points)
- `((T
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-lh-T-key-stencil)
- (text? . ("T" . #f))
- (complexity . trill)))
- (ees
- . ((offset . (0.4 . 1.6))
- (stencil . ,saxophone-lh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))
- (d
- . ((offset . (1.5 . 0.5))
- (stencil . ,saxophone-lh-d-key-stencil)
- (text? . ("D" . #f))
- (complexity . trill)))
- (f
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-lh-f-key-stencil)
- (text? . ("F" . #f))
- (complexity . trill)))
- (front-f
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-lh-front-f-key-stencil)
- (text? . ("f" . #f))
- (complexity . trill)))
- (bes
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-lh-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (gis
- . ((offset . (0.0 . 1.1))
- (stencil . ,saxophone-lh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))
- (cis
- . ((offset . (2.4 . 0.0))
- (stencil . ,saxophone-lh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (b
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-lh-b-key-stencil)
- (text? . ("B" . #f))
- (complexity . trill)))
- (low-bes
- . ((offset . (0.0 . -0.2))
- (stencil . ,saxophone-lh-low-bes-key-stencil)
- (text? . ("b" . 0))
- (complexity . trill))))))
- (right-hand
- . ((e
- . ((offset . (0.0 . 2.0))
- (stencil . ,saxophone-rh-e-key-stencil)
- (text? . ("E" . #f))
- (complexity . trill)))
- (c
- . ((offset . (0.0 . 0.9))
- (stencil . ,saxophone-rh-c-key-stencil)
- (text? . ("C" . #f))
- (complexity . trill)))
- (bes
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-rh-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (high-fis
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-rh-high-fis-key-stencil)
- (text? . ("hF" . 1))
- (complexity . trill)))
- (fis
- . ((offset . (0.0 . 0.0))
- (stencil . ,saxophone-rh-fis-key-stencil)
- (text? . ("F" . 1))
- (complexity . trill)))
- (ees
- . ((offset . (0.0 . 0.7))
- (stencil . ,saxophone-rh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))
- (low-c
- . ((offset . (-1.2 . -0.1))
- (stencil . ,saxophone-rh-low-c-key-stencil)
- (text? . ("c" . #f))
- (complexity . trill)))))))
- (graphical-commands
- . ((stencil-alist
- . ((stencils
- . ,(append (assoc-get 'low-a-key-group change-points)
- `(,(simple-stencil-alist '(hidden . midline)
- '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils
- . ,(make-left-hand-key-addresses '(ees d f)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (1.5 . 6.8)))
- ,(simple-stencil-alist '(left-hand . front-f)
- '(0.0 . 7.35))
- ,(simple-stencil-alist '(left-hand . T)
- '(-2.2 . 6.5))
- ,(simple-stencil-alist '(left-hand . bes)
- '(0.0 . 6.2))
- ((stencils
- . ,(make-left-hand-key-addresses
- '(gis cis b low-bes)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (1.2 . 3.5)))
- ((stencils
- . ,(make-right-hand-key-addresses '(e c bes)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-2.3 . 3.4)))
- ,(simple-stencil-alist '(right-hand . high-fis)
- '(-1.8 . 2.5))
- ,(simple-stencil-alist '(right-hand . fis)
- '(-1.5 . 1.5))
- ((stencils
- . ,(make-right-hand-key-addresses '(ees low-c)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-2.0 . 0.3))))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(make-left-hand-key-addresses '(ees d f))
- ,(make-left-hand-key-addresses '(gis cis b low-bes))
- ,(make-right-hand-key-addresses '(e c bes))
- ,(make-right-hand-key-addresses '(ees low-c))))
- (,group-automate-rule
- ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,rich-group-extra-offset-rule
- ((left-hand . bes))
- ,(append (assoc-get 'low-a-presence change-points)
- '((central-column . one)
- (left-hand . front-f)
- (left-hand . T)
- (left-hand . ees)
- (left-hand . d)
- (left-hand . f)))
- (0.0 . 1.0))
- (,uniform-extra-offset-rule (0.0 . 0.0))))))
- (text-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ,(simple-stencil-alist '(left-hand . T) '(-1.0 . 7.0))
- ((stencils
- . ,(assoc-get 'left-hand-key-names change-points))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (1.5 . 3.75)))
- ((stencils
- . ,(make-right-hand-key-addresses
- '(e c bes high-fis fis ees low-c)))
- (textual? . ,rh-woodwind-text-stencil)
- (offset . (-1.25 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(make-left-hand-key-addresses
- '(ees d f front-f bes gis cis b low-bes))
- ,(make-right-hand-key-addresses
- '(e c bes high-fis fis ees low-c))))
- (,group-automate-rule
- ,(make-central-column-hole-addresses
+ ((change-points
+ (get-named-spreadsheet-column
+ (saxophone-name-passerelle saxophone-name) saxophone-change-points)))
+ `(,saxophone-name
+ . ((keys
+ . ((hidden
+ . ((midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,midline-stencil)
+ (text? . #f)
+ (complexity . basic)))))
+ (central-column
+ . ((one
+ . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (two
+ . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (three
+ . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (four
+ . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (five
+ . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (six
+ . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,column-circle-stencil)
+ (text? . #f)
+ (complexity . trill)))))
+ (left-hand
+ . ,(append (assoc-get 'low-a-key-definition change-points)
+ `((T
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-lh-T-key-stencil)
+ (text? . ("T" . #f))
+ (complexity . trill)))
+ (ees
+ . ((offset . (0.4 . 1.6))
+ (stencil . ,saxophone-lh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))
+ (d
+ . ((offset . (1.5 . 0.5))
+ (stencil . ,saxophone-lh-d-key-stencil)
+ (text? . ("D" . #f))
+ (complexity . trill)))
+ (f
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-lh-f-key-stencil)
+ (text? . ("F" . #f))
+ (complexity . trill)))
+ (front-f
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-lh-front-f-key-stencil)
+ (text? . ("f" . #f))
+ (complexity . trill)))
+ (bes
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-lh-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (gis
+ . ((offset . (0.0 . 1.1))
+ (stencil . ,saxophone-lh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))
+ (cis
+ . ((offset . (2.4 . 0.0))
+ (stencil . ,saxophone-lh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (b
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-lh-b-key-stencil)
+ (text? . ("B" . #f))
+ (complexity . trill)))
+ (low-bes
+ . ((offset . (0.0 . -0.2))
+ (stencil . ,saxophone-lh-low-bes-key-stencil)
+ (text? . ("b" . 0))
+ (complexity . trill))))))
+ (right-hand
+ . ((e
+ . ((offset . (0.0 . 2.0))
+ (stencil . ,saxophone-rh-e-key-stencil)
+ (text? . ("E" . #f))
+ (complexity . trill)))
+ (c
+ . ((offset . (0.0 . 0.9))
+ (stencil . ,saxophone-rh-c-key-stencil)
+ (text? . ("C" . #f))
+ (complexity . trill)))
+ (bes
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-rh-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (high-fis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-rh-high-fis-key-stencil)
+ (text? . ("hF" . 1))
+ (complexity . trill)))
+ (fis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,saxophone-rh-fis-key-stencil)
+ (text? . ("F" . 1))
+ (complexity . trill)))
+ (ees
+ . ((offset . (0.0 . 0.7))
+ (stencil . ,saxophone-rh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))
+ (low-c
+ . ((offset . (-1.2 . -0.1))
+ (stencil . ,saxophone-rh-low-c-key-stencil)
+ (text? . ("c" . #f))
+ (complexity . trill)))))))
+ (graphical-commands
+ . ((stencil-alist
+ . ((stencils
+ . ,(append (assoc-get 'low-a-key-group change-points)
+ `(,(simple-stencil-alist '(hidden . midline)
+ '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils
+ . ,(make-left-hand-key-addresses '(ees d f)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (1.5 . 6.8)))
+ ,(simple-stencil-alist '(left-hand . front-f)
+ '(0.0 . 7.35))
+ ,(simple-stencil-alist '(left-hand . T)
+ '(-2.2 . 6.5))
+ ,(simple-stencil-alist '(left-hand . bes)
+ '(0.0 . 6.2))
+ ((stencils
+ . ,(make-left-hand-key-addresses
+ '(gis cis b low-bes)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (1.2 . 3.5)))
+ ((stencils
+ . ,(make-right-hand-key-addresses '(e c bes)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-2.3 . 3.4)))
+ ,(simple-stencil-alist '(right-hand . high-fis)
+ '(-1.8 . 2.5))
+ ,(simple-stencil-alist '(right-hand . fis)
+ '(-1.5 . 1.5))
+ ((stencils
+ . ,(make-right-hand-key-addresses '(ees low-c)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-2.0 . 0.3))))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(make-left-hand-key-addresses '(ees d f))
+ ,(make-left-hand-key-addresses '(gis cis b low-bes))
+ ,(make-right-hand-key-addresses '(e c bes))
+ ,(make-right-hand-key-addresses '(ees low-c))))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,rich-group-extra-offset-rule
+ ((left-hand . bes))
+ ,(append (assoc-get 'low-a-presence change-points)
+ '((central-column . one)
+ (left-hand . front-f)
+ (left-hand . T)
+ (left-hand . ees)
+ (left-hand . d)
+ (left-hand . f)))
+ (0.0 . 1.0))
+ (,uniform-extra-offset-rule (0.0 . 0.0))))))
+ (text-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ,(simple-stencil-alist '(left-hand . T) '(-1.0 . 7.0))
+ ((stencils
+ . ,(assoc-get 'left-hand-key-names change-points))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (1.5 . 3.75)))
+ ((stencils
+ . ,(make-right-hand-key-addresses
+ '(e c bes high-fis fis ees low-c)))
+ (textual? . ,rh-woodwind-text-stencil)
+ (offset . (-1.25 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(make-left-hand-key-addresses
+ '(ees d f front-f bes gis cis b low-bes))
+ ,(make-right-hand-key-addresses
+ '(e c bes high-fis fis ees low-c))))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses
CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
;; Bassoon assembly instructions
(define bassoon-change-points
((make-named-spreadsheet '(bassoon contrabassoon))
- `((left-hand-additional-keys .
- (((a .
- ((offset . (0.0 . -0.3))
- (stencil . ,bassoon-lh-a-flick-key-stencil)
- (text? . ("A" . #f))
- (complexity . trill)))
- (w .
- ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-whisper-key-stencil)
- (text? . ("w" . #f))
- (complexity . trill))))
- ()))
- (right-hand-additional-keys .
- (((cis .
- ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-rh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (thumb-gis .
- ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-rh-thumb-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill))))
- ()))
+ `((left-hand-additional-keys .
+ (((a .
+ ((offset . (0.0 . -0.3))
+ (stencil . ,bassoon-lh-a-flick-key-stencil)
+ (text? . ("A" . #f))
+ (complexity . trill)))
+ (w .
+ ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-whisper-key-stencil)
+ (text? . ("w" . #f))
+ (complexity . trill))))
+ ()))
+ (right-hand-additional-keys .
+ (((cis .
+ ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-rh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (thumb-gis .
+ ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-rh-thumb-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill))))
+ ()))
(left-hand-flick-group .
- (((left-hand . d) (left-hand . c) (left-hand . a))
- ((left-hand . d) (left-hand . c))))
+ (((left-hand . d) (left-hand . c) (left-hand . a))
+ ((left-hand . d) (left-hand . c))))
(left-hand-thumb-group .
- (((left-hand . w) (left-hand . thumb-cis))
- ((left-hand . thumb-cis))))
+ (((left-hand . w) (left-hand . thumb-cis))
+ ((left-hand . thumb-cis))))
(cis-offset-instruction .
- (((,rich-group-extra-offset-rule
- ((right-hand . cis))
- ,(append
- '((hidden . midline) (hidden . long-midline))
- (make-central-column-hole-addresses '(three two one))
- (make-left-hand-key-addresses
- '(low-b low-bes low-c low-d d a c w thumb-cis
- high-ees high-e cis ees)))
- (0.0 . 0.9)))
- ()))
+ (((,rich-group-extra-offset-rule
+ ((right-hand . cis))
+ ,(append
+ '((hidden . midline) (hidden . long-midline))
+ (make-central-column-hole-addresses '(three two one))
+ (make-left-hand-key-addresses
+ '(low-b low-bes low-c low-d d a c w thumb-cis
+ high-ees high-e cis ees)))
+ (0.0 . 0.9)))
+ ()))
(right-hand-lower-thumb-group .
- (((right-hand . thumb-gis) (right-hand . thumb-fis))
- ((right-hand . thumb-fis))))
+ (((right-hand . thumb-gis) (right-hand . thumb-fis))
+ ((right-hand . thumb-fis))))
(right-hand-cis-key .
- ((,(simple-stencil-alist '(right-hand . cis) '(-2.3 . 3.22)))
- ()))
+ ((,(simple-stencil-alist '(right-hand . cis) '(-2.3 . 3.22)))
+ ()))
(back-left-hand-key-addresses .
- ((low-b low-bes low-c low-d d a c w thumb-cis)
- (low-b low-bes low-c low-d d c thumb-cis)))
+ ((low-b low-bes low-c low-d d a c w thumb-cis)
+ (low-b low-bes low-c low-d d c thumb-cis)))
(front-right-hand-key-addresses .
- ((cis bes fis f gis) (bes fis f gis)))
+ ((cis bes fis f gis) (bes fis f gis)))
(back-right-hand-key-addresses .
- ((thumb-bes thumb-gis thumb-e thumb-fis)
- (thumb-bes thumb-e thumb-fis))))))
+ ((thumb-bes thumb-gis thumb-e thumb-fis)
+ (thumb-bes thumb-e thumb-fis))))))
(define (generate-bassoon-family-entry bassoon-name)
(let*
- ((change-points
- (get-named-spreadsheet-column bassoon-name bassoon-change-points)))
- `(,bassoon-name
- . ((keys
- . ((hidden
- . ((midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,midline-stencil)
- (text? . #f)
- (complexity . basic)))
- (long-midline
- . ((offset . (0.0 . 0.0))
- (stencil . ,long-midline-stencil)
- (text? . #f)
- (complexity . basic)))))
- (central-column
- . ((one
- . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,bassoon-cc-one-key-stencil)
- (text? . #f)
- (complexity . trill)))
- (two
- . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (three
- . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (four
- . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (five
- . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))
- (six
- . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
- (stencil . ,ring-column-circle-stencil)
- (text? . #f)
- (complexity . ring)))))
- (left-hand
- . ,(append (assoc-get 'left-hand-additional-keys
- change-points)
- `((high-e
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-he-key-stencil)
- (text? . ("hE" . #f))
- (complexity . trill)))
- (high-ees
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-hees-key-stencil)
- (text? . ("hE" . 0))
- (complexity . trill)))
- (ees
- . ((offset . (-1.0 . 1.0))
- (stencil . ,bassoon-lh-ees-key-stencil)
- (text? . ("E" . 0))
- (complexity . trill)))
- (cis
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill)))
- (low-bes
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-lbes-key-stencil)
- (text? . ("b" . 0))
- (complexity . trill)))
- (low-b
- . ((offset . (-1.0 . -0.7))
- (stencil . ,bassoon-lh-lb-key-stencil)
- (text? . ("b" . #f))
- (complexity . trill)))
- (low-c
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-lc-key-stencil)
- (text? . ("c" . #f))
- (complexity . trill)))
- (low-d
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-lh-ld-key-stencil)
- (text? . ("d" . #f))
- (complexity . trill)))
- (d
- . ((offset . (-1.5 . 2.0))
- (stencil . ,bassoon-lh-d-flick-key-stencil)
- (text? . ("D" . #f))
- (complexity . trill)))
- (c
- . ((offset . (-0.8 . 1.1))
- (stencil . ,bassoon-lh-c-flick-key-stencil)
- (text? . ("C" . #f))
- (complexity . trill)))
- (thumb-cis
- . ((offset . (2.0 . -1.0))
- (stencil . ,bassoon-lh-thumb-cis-key-stencil)
- (text? . ("C" . 1))
- (complexity . trill))))))
- (right-hand
- . ,(append (assoc-get 'right-hand-additional-keys
- change-points)
- `((bes
- . ((offset . (0.0 . 0.8))
- (stencil . ,bassoon-rh-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (f
- . ((offset . (-2.2 . 4.35))
- (stencil . ,bassoon-rh-f-key-stencil)
- (text? . ("F" . #f))
- (complexity . trill)))
- (fis
- . ((offset . (1.5 . 1.0))
- (stencil . ,bassoon-rh-fis-key-stencil)
- (text? . ("F" . 1))
- (complexity . trill)))
- (gis
- . ((offset . (0.0 . -0.15))
- (stencil . ,bassoon-rh-gis-key-stencil)
- (text? . ("G" . 1))
- (complexity . trill)))
- (thumb-bes
- . ((offset . (0.0 . 0.0))
- (stencil . ,bassoon-rh-thumb-bes-key-stencil)
- (text? . ("B" . 0))
- (complexity . trill)))
- (thumb-e
- . ((offset . (1.75 . 0.4))
- (stencil . ,bassoon-rh-thumb-e-key-stencil)
- (text? . ("E" . #f))
- (complexity . trill)))
- (thumb-fis
- . ((offset . (-1.0 . 1.6))
- (stencil . ,bassoon-rh-thumb-fis-key-stencil)
- (text? . ("F" . 1))
- (complexity . trill))))))))
- (graphical-commands
- . ((stencil-alist
- . ((stencils
- . ,(append (assoc-get 'right-hand-cis-key change-points)
- `(,(simple-stencil-alist '(hidden . midline)
- '(0.0 . 3.75))
- ,(simple-stencil-alist '(hidden . long-midline)
- '(0.0 . 3.80))
- ((stencils
- . ,(make-central-column-hole-addresses
+ ((change-points
+ (get-named-spreadsheet-column bassoon-name bassoon-change-points)))
+ `(,bassoon-name
+ . ((keys
+ . ((hidden
+ . ((midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,midline-stencil)
+ (text? . #f)
+ (complexity . basic)))
+ (long-midline
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,long-midline-stencil)
+ (text? . #f)
+ (complexity . basic)))))
+ (central-column
+ . ((one
+ . ((offset . ,(assoc-get 'one CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,bassoon-cc-one-key-stencil)
+ (text? . #f)
+ (complexity . trill)))
+ (two
+ . ((offset . ,(assoc-get 'two CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (three
+ . ((offset . ,(assoc-get 'three CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (four
+ . ((offset . ,(assoc-get 'four CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (five
+ . ((offset . ,(assoc-get 'five CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))
+ (six
+ . ((offset . ,(assoc-get 'six CENTRAL-COLUMN-HOLE-PLACEMENTS))
+ (stencil . ,ring-column-circle-stencil)
+ (text? . #f)
+ (complexity . ring)))))
+ (left-hand
+ . ,(append (assoc-get 'left-hand-additional-keys
+ change-points)
+ `((high-e
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-he-key-stencil)
+ (text? . ("hE" . #f))
+ (complexity . trill)))
+ (high-ees
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-hees-key-stencil)
+ (text? . ("hE" . 0))
+ (complexity . trill)))
+ (ees
+ . ((offset . (-1.0 . 1.0))
+ (stencil . ,bassoon-lh-ees-key-stencil)
+ (text? . ("E" . 0))
+ (complexity . trill)))
+ (cis
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill)))
+ (low-bes
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-lbes-key-stencil)
+ (text? . ("b" . 0))
+ (complexity . trill)))
+ (low-b
+ . ((offset . (-1.0 . -0.7))
+ (stencil . ,bassoon-lh-lb-key-stencil)
+ (text? . ("b" . #f))
+ (complexity . trill)))
+ (low-c
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-lc-key-stencil)
+ (text? . ("c" . #f))
+ (complexity . trill)))
+ (low-d
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-lh-ld-key-stencil)
+ (text? . ("d" . #f))
+ (complexity . trill)))
+ (d
+ . ((offset . (-1.5 . 2.0))
+ (stencil . ,bassoon-lh-d-flick-key-stencil)
+ (text? . ("D" . #f))
+ (complexity . trill)))
+ (c
+ . ((offset . (-0.8 . 1.1))
+ (stencil . ,bassoon-lh-c-flick-key-stencil)
+ (text? . ("C" . #f))
+ (complexity . trill)))
+ (thumb-cis
+ . ((offset . (2.0 . -1.0))
+ (stencil . ,bassoon-lh-thumb-cis-key-stencil)
+ (text? . ("C" . 1))
+ (complexity . trill))))))
+ (right-hand
+ . ,(append (assoc-get 'right-hand-additional-keys
+ change-points)
+ `((bes
+ . ((offset . (0.0 . 0.8))
+ (stencil . ,bassoon-rh-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (f
+ . ((offset . (-2.2 . 4.35))
+ (stencil . ,bassoon-rh-f-key-stencil)
+ (text? . ("F" . #f))
+ (complexity . trill)))
+ (fis
+ . ((offset . (1.5 . 1.0))
+ (stencil . ,bassoon-rh-fis-key-stencil)
+ (text? . ("F" . 1))
+ (complexity . trill)))
+ (gis
+ . ((offset . (0.0 . -0.15))
+ (stencil . ,bassoon-rh-gis-key-stencil)
+ (text? . ("G" . 1))
+ (complexity . trill)))
+ (thumb-bes
+ . ((offset . (0.0 . 0.0))
+ (stencil . ,bassoon-rh-thumb-bes-key-stencil)
+ (text? . ("B" . 0))
+ (complexity . trill)))
+ (thumb-e
+ . ((offset . (1.75 . 0.4))
+ (stencil . ,bassoon-rh-thumb-e-key-stencil)
+ (text? . ("E" . #f))
+ (complexity . trill)))
+ (thumb-fis
+ . ((offset . (-1.0 . 1.6))
+ (stencil . ,bassoon-rh-thumb-fis-key-stencil)
+ (text? . ("F" . 1))
+ (complexity . trill))))))))
+ (graphical-commands
+ . ((stencil-alist
+ . ((stencils
+ . ,(append (assoc-get 'right-hand-cis-key change-points)
+ `(,(simple-stencil-alist '(hidden . midline)
+ '(0.0 . 3.75))
+ ,(simple-stencil-alist '(hidden . long-midline)
+ '(0.0 . 3.80))
+ ((stencils
+ . ,(make-central-column-hole-addresses
CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ,(simple-stencil-alist '(left-hand . high-e)
- '(-1.0 . 7.0))
- ,(simple-stencil-alist '(left-hand . high-ees)
- '(-1.0 . 6.0))
- ((stencils
- . ((left-hand . ees) (left-hand . cis)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (3.0 . 3.75)))
- ((stencils
- . (((stencils
- . ((left-hand . low-b)
- (left-hand . low-bes)))
- (xy-scale-function
- . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-2.0 . 9.0)))
- ((stencils
- . ,(assoc-get 'left-hand-flick-group
- change-points))
- (xy-scale-function
- . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (3.0 . 7.0)))
- ,(simple-stencil-alist '(left-hand . low-c)
- '(-1.0 . 4.5))
- ,(simple-stencil-alist '(left-hand . low-d)
- '(-1.0 . 0.1))
- ((stencils
- . ,(assoc-get 'left-hand-thumb-group
- change-points))
- (xy-scale-function
- . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (1.5 . -0.6)))))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-5.5 . 4.7)))
- ,(simple-stencil-alist '(right-hand . bes)
- '(1.0 . 1.2))
- ((stencils
- . ,(make-right-hand-key-addresses '(gis f fis)))
- (xy-scale-function . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (2.0 . -1.25)))
- ((stencils
- . (((stencils
- . ((right-hand . thumb-bes)
- (right-hand . thumb-e)))
- (xy-scale-function
- . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-1.22 . 5.25)))
- ((stencils
- . ,(assoc-get 'right-hand-lower-thumb-group
- change-points))
- (xy-scale-function
- . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (0.0 . 0.0)))))
- (xy-scale-function
- . (,return-1 . ,return-1))
- (textual? . #f)
- (offset . (-5.0 . 0.0))))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(make-left-hand-key-addresses '(ees cis))
- ,(make-left-hand-key-addresses
- (assoc-get 'back-left-hand-key-addresses change-points))
- ,(make-right-hand-key-addresses '(f fis gis))
- ,(make-right-hand-key-addresses
- (assoc-get 'back-right-hand-key-addresses change-points))))
- (,group-automate-rule
- ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (,bassoon-midline-rule
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ,(simple-stencil-alist '(left-hand . high-e)
+ '(-1.0 . 7.0))
+ ,(simple-stencil-alist '(left-hand . high-ees)
+ '(-1.0 . 6.0))
+ ((stencils
+ . ((left-hand . ees) (left-hand . cis)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (3.0 . 3.75)))
+ ((stencils
+ . (((stencils
+ . ((left-hand . low-b)
+ (left-hand . low-bes)))
+ (xy-scale-function
+ . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-2.0 . 9.0)))
+ ((stencils
+ . ,(assoc-get 'left-hand-flick-group
+ change-points))
+ (xy-scale-function
+ . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (3.0 . 7.0)))
+ ,(simple-stencil-alist '(left-hand . low-c)
+ '(-1.0 . 4.5))
+ ,(simple-stencil-alist '(left-hand . low-d)
+ '(-1.0 . 0.1))
+ ((stencils
+ . ,(assoc-get 'left-hand-thumb-group
+ change-points))
+ (xy-scale-function
+ . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (1.5 . -0.6)))))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-5.5 . 4.7)))
+ ,(simple-stencil-alist '(right-hand . bes)
+ '(1.0 . 1.2))
+ ((stencils
+ . ,(make-right-hand-key-addresses '(gis f fis)))
+ (xy-scale-function . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (2.0 . -1.25)))
+ ((stencils
+ . (((stencils
+ . ((right-hand . thumb-bes)
+ (right-hand . thumb-e)))
+ (xy-scale-function
+ . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-1.22 . 5.25)))
+ ((stencils
+ . ,(assoc-get 'right-hand-lower-thumb-group
+ change-points))
+ (xy-scale-function
+ . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))))
+ (xy-scale-function
+ . (,return-1 . ,return-1))
+ (textual? . #f)
+ (offset . (-5.0 . 0.0))))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(make-left-hand-key-addresses '(ees cis))
+ ,(make-left-hand-key-addresses
+ (assoc-get 'back-left-hand-key-addresses change-points))
+ ,(make-right-hand-key-addresses '(f fis gis))
+ ,(make-right-hand-key-addresses
+ (assoc-get 'back-right-hand-key-addresses change-points))))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (,bassoon-midline-rule
,(append
- (make-left-hand-key-addresses
- (assoc-get 'back-left-hand-key-addresses change-points))
- (make-right-hand-key-addresses
- (assoc-get 'back-right-hand-key-addresses
- change-points))))))
- (extra-offset-instructions
- . ,(append
- (assoc-get 'cis-offset-instruction change-points)
- `((,uniform-extra-offset-rule (0.0 . 0.0)))))))
- (text-commands
- . ((stencil-alist
- . ((stencils
- . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
- ((stencils
- . ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0)))
- ((stencils
- . ,(make-left-hand-key-addresses
+ (make-left-hand-key-addresses
+ (assoc-get 'back-left-hand-key-addresses change-points))
+ (make-right-hand-key-addresses
+ (assoc-get 'back-right-hand-key-addresses
+ change-points))))))
+ (extra-offset-instructions
+ . ,(append
+ (assoc-get 'cis-offset-instruction change-points)
+ `((,uniform-extra-offset-rule (0.0 . 0.0)))))))
+ (text-commands
+ . ((stencil-alist
+ . ((stencils
+ . (,(simple-stencil-alist '(hidden . midline) '(0.0 . 3.75))
+ ((stencils
+ . ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0)))
+ ((stencils
+ . ,(make-left-hand-key-addresses
'(high-e high-ees ees cis)))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (1.5 . 3.75)))
- ((stencils
- . ,(make-left-hand-key-addresses
- (assoc-get 'back-left-hand-key-addresses
- change-points)))
- (textual? . ,rh-woodwind-text-stencil)
- (offset . (-1.25 . 3.75)))
- ((stencils
- . ,(make-right-hand-key-addresses
- (assoc-get 'front-right-hand-key-addresses
- change-points)))
- (textual? . ,lh-woodwind-text-stencil)
- (offset . (1.5 . 0.0)))
- ((stencils .
- ,(make-right-hand-key-addresses
- (assoc-get 'back-right-hand-key-addresses
- change-points)))
- (textual? . ,rh-woodwind-text-stencil)
- (offset . (-1.25 . 0.0)))))
- (xy-scale-function . (,identity . ,identity))
- (textual? . #f)
- (offset . (0.0 . 0.0))))
- (draw-instructions
- . ((,apply-group-draw-rule-series
- (,(make-left-hand-key-addresses
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (1.5 . 3.75)))
+ ((stencils
+ . ,(make-left-hand-key-addresses
+ (assoc-get 'back-left-hand-key-addresses
+ change-points)))
+ (textual? . ,rh-woodwind-text-stencil)
+ (offset . (-1.25 . 3.75)))
+ ((stencils
+ . ,(make-right-hand-key-addresses
+ (assoc-get 'front-right-hand-key-addresses
+ change-points)))
+ (textual? . ,lh-woodwind-text-stencil)
+ (offset . (1.5 . 0.0)))
+ ((stencils .
+ ,(make-right-hand-key-addresses
+ (assoc-get 'back-right-hand-key-addresses
+ change-points)))
+ (textual? . ,rh-woodwind-text-stencil)
+ (offset . (-1.25 . 0.0)))))
+ (xy-scale-function . (,identity . ,identity))
+ (textual? . #f)
+ (offset . (0.0 . 0.0))))
+ (draw-instructions
+ . ((,apply-group-draw-rule-series
+ (,(make-left-hand-key-addresses
(assoc-get 'back-left-hand-key-addresses change-points))
- ,(make-right-hand-key-addresses
+ ,(make-right-hand-key-addresses
(assoc-get 'front-right-hand-key-addresses change-points))
- ,(make-right-hand-key-addresses
- (assoc-get 'back-right-hand-key-addresses change-points))
- ,(make-left-hand-key-addresses '(high-e high-ees ees cis))))
- (,group-automate-rule
- ,(make-central-column-hole-addresses
- CENTRAL-COLUMN-HOLE-LIST))
- (,group-automate-rule ((hidden . midline)))))
- (extra-offset-instructions
- . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
+ ,(make-right-hand-key-addresses
+ (assoc-get 'back-right-hand-key-addresses change-points))
+ ,(make-left-hand-key-addresses '(high-e high-ees ees cis))))
+ (,group-automate-rule
+ ,(make-central-column-hole-addresses
+ CENTRAL-COLUMN-HOLE-LIST))
+ (,group-automate-rule ((hidden . midline)))))
+ (extra-offset-instructions
+ . ((,uniform-extra-offset-rule (0.0 . 0.0))))))))))
;; Assembly functions
@@ -1650,60 +1650,60 @@
(define (translate-key-instruction key-instruction)
(let*
- ((key-name (car key-instruction))
- (key-complexity (assoc-get 'complexity (cdr key-instruction))))
- (cond
- ((eqv? key-complexity 'basic)
+ ((key-name (car key-instruction))
+ (key-complexity (assoc-get 'complexity (cdr key-instruction))))
+ (cond
+ ((eqv? key-complexity 'basic)
`((,key-name . ,(assoc-get 'F HOLE-FILL-LIST))))
- ((eqv? key-complexity 'trill)
- (make-symbol-alist key-name #t #f))
- ((eqv? key-complexity 'covered)
- (make-symbol-alist key-name #f #f))
- ((eqv? key-complexity 'ring)
- (make-symbol-alist key-name #f #t)))))
+ ((eqv? key-complexity 'trill)
+ (make-symbol-alist key-name #t #f))
+ ((eqv? key-complexity 'covered)
+ (make-symbol-alist key-name #f #f))
+ ((eqv? key-complexity 'ring)
+ (make-symbol-alist key-name #f #t)))))
(define (update-possb-list input-key possibility-list canonic-list)
(if (null? possibility-list)
- (ly:error "woodwind markup error - invalid key or hole requested")
- (if
- (assoc-get input-key (cdar possibility-list))
- (append
+ (ly:error "woodwind markup error - invalid key or hole requested")
+ (if
+ (assoc-get input-key (cdar possibility-list))
+ (append
`(((,(caaar possibility-list) .
,(assoc-get input-key (cdar possibility-list))) .
- ,(assoc-get (caar possibility-list) canonic-list)))
- (assoc-remove (caar possibility-list) canonic-list))
- (update-possb-list input-key (cdr possibility-list) canonic-list))))
+ ,(assoc-get (caar possibility-list) canonic-list)))
+ (assoc-remove (caar possibility-list) canonic-list))
+ (update-possb-list input-key (cdr possibility-list) canonic-list))))
(define (key-crawler input-list possibility-list)
(if (null? input-list)
- (map car possibility-list)
- (key-crawler
- (cdr input-list)
- (update-possb-list
+ (map car possibility-list)
+ (key-crawler
+ (cdr input-list)
+ (update-possb-list
(car input-list)
possibility-list
possibility-list))))
(define (translate-draw-instructions input-alist key-name-alist)
(apply append
- (map (lambda (short long)
- (let*
- ((key-instructions
- (map (lambda (instr)
- `(((,long . ,(car instr)) . 0)
- . ,(translate-key-instruction instr)))
- (assoc-get long key-name-alist))))
- (key-crawler (assoc-get short input-alist) key-instructions)))
- '(hd cc lh rh)
- '(hidden central-column left-hand right-hand))))
+ (map (lambda (short long)
+ (let*
+ ((key-instructions
+ (map (lambda (instr)
+ `(((,long . ,(car instr)) . 0)
+ . ,(translate-key-instruction instr)))
+ (assoc-get long key-name-alist))))
+ (key-crawler (assoc-get short input-alist) key-instructions)))
+ '(hd cc lh rh)
+ '(hidden central-column left-hand right-hand))))
(define (uniform-draw-instructions key-name-alist)
- (apply append
- (map (lambda (long)
- (map (lambda (key-instructions)
- `((,long . ,(car key-instructions)) . 1))
- (assoc-get long key-name-alist)))
- '(hidden central-column left-hand right-hand))))
+ (apply append
+ (map (lambda (long)
+ (map (lambda (key-instructions)
+ `((,long . ,(car key-instructions)) . 1))
+ (assoc-get long key-name-alist)))
+ '(hidden central-column left-hand right-hand))))
(define (list-all-possible-keys key-name-alist)
(map (lambda (short long)
@@ -1756,94 +1756,94 @@
(define
(assemble-stencils
- stencil-alist
- key-bank
- draw-instructions
- extra-offset-instructions
- radius
- thick
- xy-stretch
- layout
- props)
+ stencil-alist
+ key-bank
+ draw-instructions
+ extra-offset-instructions
+ radius
+ thick
+ xy-stretch
+ layout
+ props)
(apply
- ly:stencil-add
- (map (lambda (node)
- (ly:stencil-translate
- (if (pair? (cdr node))
- (if (assoc-get 'textual? node)
- ((assoc-get 'textual? node) (map (lambda (key)
- (assoc-get 'text? key))
- (map (lambda (instr)
- (get-key
- instr
- key-bank))
- (assoc-get 'stencils node)))
- radius
- (map (lambda (key)
- (assoc-get
- key
- draw-instructions))
- (assoc-get 'stencils
- node))
- layout
- props)
- (assemble-stencils
- node
- key-bank
- draw-instructions
- extra-offset-instructions
- radius
- thick
- (coord-apply (assoc-get 'xy-scale-function stencil-alist)
- xy-stretch)
- layout
- props))
+ ly:stencil-add
+ (map (lambda (node)
+ (ly:stencil-translate
+ (if (pair? (cdr node))
+ (if (assoc-get 'textual? node)
+ ((assoc-get 'textual? node) (map (lambda (key)
+ (assoc-get 'text? key))
+ (map (lambda (instr)
+ (get-key
+ instr
+ key-bank))
+ (assoc-get 'stencils node)))
+ radius
+ (map (lambda (key)
+ (assoc-get
+ key
+ draw-instructions))
+ (assoc-get 'stencils
+ node))
+ layout
+ props)
+ (assemble-stencils
+ node
+ key-bank
+ draw-instructions
+ extra-offset-instructions
+ radius
+ thick
+ (coord-apply (assoc-get 'xy-scale-function stencil-alist)
+ xy-stretch)
+ layout
+ props))
(if (= 0 (assoc-get node draw-instructions))
empty-stencil
((assoc-get 'stencil (get-key node key-bank))
- radius
- thick
- (assoc-get node draw-instructions)
- layout
- props)))
+ radius
+ thick
+ (assoc-get node draw-instructions)
+ layout
+ props)))
+ (coord-scale
+ (coord-translate
(coord-scale
- (coord-translate
- (coord-scale
- (assoc-get
- 'offset
- (if (pair? (cdr node))
- node
- (get-key node key-bank)))
- (coord-apply
- (assoc-get 'xy-scale-function stencil-alist)
- xy-stretch))
- (if
- (assoc-get node extra-offset-instructions)
- (assoc-get node extra-offset-instructions)
- '(0.0 . 0.0)))
- radius)))
- (assoc-get 'stencils stencil-alist))))
+ (assoc-get
+ 'offset
+ (if (pair? (cdr node))
+ node
+ (get-key node key-bank)))
+ (coord-apply
+ (assoc-get 'xy-scale-function stencil-alist)
+ xy-stretch))
+ (if
+ (assoc-get node extra-offset-instructions)
+ (assoc-get node extra-offset-instructions)
+ '(0.0 . 0.0)))
+ radius)))
+ (assoc-get 'stencils stencil-alist))))
(define*-public (print-keys instrument #:optional (port (current-output-port)))
(format port "\nPrinting keys for: ~a\n" instrument)
(let ((chosen-instrument (assoc-get instrument woodwind-data-alist)))
- (do ((key-list
- (list-all-possible-keys (assoc-get 'keys chosen-instrument))
- (cdr key-list)))
- ((null? key-list))
+ (do ((key-list
+ (list-all-possible-keys (assoc-get 'keys chosen-instrument))
+ (cdr key-list)))
+ ((null? key-list))
(format port "~a\n ~a\n" (caar key-list) (cdar key-list)))))
(define-public (get-woodwind-key-list instrument)
(list-all-possible-keys-verbose
- (assoc-get
- 'keys
- (assoc-get instrument woodwind-data-alist))))
+ (assoc-get
+ 'keys
+ (assoc-get instrument woodwind-data-alist))))
(define*-public (print-keys-verbose instrument
- #:optional (port (current-output-port)))
+ #:optional (port (current-output-port)))
(format port "\nPrinting keys in verbose mode for: ~a\n" instrument)
(do ((key-list (get-woodwind-key-list instrument)
- (cdr key-list)))
+ (cdr key-list)))
((null? key-list))
(format port "~a\n" (caar key-list))
(for-each
@@ -1945,35 +1945,35 @@ a diagram with all of the keys drawn but none filled, for example:
(xy-stretch `(1.0 . 2.5))
(chosen-instrument (assoc-get instrument woodwind-data-alist))
(chosen-instrument
- (if (not chosen-instrument)
- (ly:error "~a is not a valid woodwind instrument."
- instrument)
- chosen-instrument))
+ (if (not chosen-instrument)
+ (ly:error "~a is not a valid woodwind instrument."
+ instrument)
+ chosen-instrument))
(stencil-info
- (assoc-get
- (if display-graphic 'graphical-commands 'text-commands)
- chosen-instrument))
+ (assoc-get
+ (if display-graphic 'graphical-commands 'text-commands)
+ chosen-instrument))
(pressed-info
- (if (null? user-draw-commands)
- (uniform-draw-instructions (assoc-get 'keys chosen-instrument))
- (translate-draw-instructions
- (append '((hd . ())) user-draw-commands)
- (assoc-get 'keys chosen-instrument))))
+ (if (null? user-draw-commands)
+ (uniform-draw-instructions (assoc-get 'keys chosen-instrument))
+ (translate-draw-instructions
+ (append '((hd . ())) user-draw-commands)
+ (assoc-get 'keys chosen-instrument))))
(draw-info
- (function-chain
- pressed-info
- (assoc-get 'draw-instructions stencil-info)))
+ (function-chain
+ pressed-info
+ (assoc-get 'draw-instructions stencil-info)))
(extra-offset-info
- (function-chain
- pressed-info
- (assoc-get 'extra-offset-instructions stencil-info))))
+ (function-chain
+ pressed-info
+ (assoc-get 'extra-offset-instructions stencil-info))))
(assemble-stencils
- (assoc-get 'stencil-alist stencil-info)
- (assoc-get 'keys chosen-instrument)
- draw-info
- extra-offset-info
- radius
- thick
- xy-stretch
- layout
- props)))
+ (assoc-get 'stencil-alist stencil-info)
+ (assoc-get 'keys chosen-instrument)
+ draw-info
+ extra-offset-info
+ radius
+ thick
+ xy-stretch
+ layout
+ props)))
diff --git a/scm/document-backend.scm b/scm/document-backend.scm
index 71ba5a274f..a4c25cfe3c 100644
--- a/scm/document-backend.scm
+++ b/scm/document-backend.scm
@@ -25,95 +25,95 @@
;; properly sort all grobs, properties, and interfaces
;; within the all-grob-descriptions alist
(map
- (lambda (x)
- (let* ((props (assoc-ref all-grob-descriptions (car x)))
- (meta (assoc-ref props 'meta))
- (interfaces (assoc-ref meta 'interfaces)))
- (set! all-grob-descriptions
- (sort (assoc-set! all-grob-descriptions (car x)
- (sort-grob-properties
- (assoc-set! props 'meta
- (assoc-set! meta 'interfaces
- (sort interfaces ly:symbol-ci<?)))))
- ly:alist-ci<?))))
- all-grob-descriptions)
+ (lambda (x)
+ (let* ((props (assoc-ref all-grob-descriptions (car x)))
+ (meta (assoc-ref props 'meta))
+ (interfaces (assoc-ref meta 'interfaces)))
+ (set! all-grob-descriptions
+ (sort (assoc-set! all-grob-descriptions (car x)
+ (sort-grob-properties
+ (assoc-set! props 'meta
+ (assoc-set! meta 'interfaces
+ (sort interfaces ly:symbol-ci<?)))))
+ ly:alist-ci<?))))
+ all-grob-descriptions)
(define (interface-doc-string interface grob-description)
(let* ((name (car interface))
- (desc (cadr interface))
- (props (caddr interface))
- (docfunc (lambda (pr)
- (property->texi
- 'backend pr grob-description)))
- (iprops (filter (lambda (x) (object-property x 'backend-internal))
- props))
- (uprops (filter
- (lambda (x) (not (object-property x 'backend-internal)))
- props))
- (user-propdocs (map docfunc uprops))
- (internal-propdocs (map docfunc iprops)))
+ (desc (cadr interface))
+ (props (caddr interface))
+ (docfunc (lambda (pr)
+ (property->texi
+ 'backend pr grob-description)))
+ (iprops (filter (lambda (x) (object-property x 'backend-internal))
+ props))
+ (uprops (filter
+ (lambda (x) (not (object-property x 'backend-internal)))
+ props))
+ (user-propdocs (map docfunc uprops))
+ (internal-propdocs (map docfunc iprops)))
(string-append
desc
(if (pair? uprops)
- (string-append
- "\n\n@subsubheading User settable properties:\n"
- (description-list->texi user-propdocs #t))
- "")
+ (string-append
+ "\n\n@subsubheading User settable properties:\n"
+ (description-list->texi user-propdocs #t))
+ "")
(if (pair? iprops)
- (string-append
- "\n\n@subsubheading Internal properties:\n"
- (description-list->texi internal-propdocs #t))
- ""))))
+ (string-append
+ "\n\n@subsubheading Internal properties:\n"
+ (description-list->texi internal-propdocs #t))
+ ""))))
(define iface->grob-table (make-hash-table 61))
;; extract ifaces, and put grob into the hash table.
(map
(lambda (x)
(let* ((meta (assoc-get 'meta (cdr x)))
- (ifaces (assoc-get 'interfaces meta)))
+ (ifaces (assoc-get 'interfaces meta)))
(map (lambda (iface)
- (hashq-set!
- iface->grob-table iface
- (cons (car x)
- (hashq-ref iface->grob-table iface '()))))
- ifaces)))
+ (hashq-set!
+ iface->grob-table iface
+ (cons (car x)
+ (hashq-ref iface->grob-table iface '()))))
+ ifaces)))
all-grob-descriptions)
;; First level Interface description
(define (interface-doc interface)
(let* ((name (symbol->string (car interface)))
- (interface-list (human-listify
- (map ref-ify
- (sort
- (map symbol->string
- (hashq-ref iface->grob-table
- (car interface)
- '()))
- ly:string-ci<?)))))
+ (interface-list (human-listify
+ (map ref-ify
+ (sort
+ (map symbol->string
+ (hashq-ref iface->grob-table
+ (car interface)
+ '()))
+ ly:string-ci<?)))))
(make <texi-node>
#:name name
#:text (string-append
- (interface-doc-string (cdr interface) '())
- "\n\n"
- "This grob interface "
- (if (equal? interface-list "none")
- "is not used in any graphical object"
- (string-append
- "is used in the following graphical object(s): "
- interface-list))
- "."))))
+ (interface-doc-string (cdr interface) '())
+ "\n\n"
+ "This grob interface "
+ (if (equal? interface-list "none")
+ "is not used in any graphical object"
+ (string-append
+ "is used in the following graphical object(s): "
+ interface-list))
+ "."))))
(define (grob-alist->texi alist)
(let* ((uprops (filter (lambda (x) (not (object-property x 'backend-internal)))
- (map car alist))))
+ (map car alist))))
(description-list->texi
(map (lambda (y) (property->texi 'backend y alist))
- uprops)
+ uprops)
#t)))
(define (grob-doc description)
@@ -121,26 +121,26 @@
node."
(let* ((meta (assoc-get 'meta description))
- (name (assoc-get 'name meta))
- ;; (bla (display name))
- (ifaces (map lookup-interface (assoc-get 'interfaces meta)))
- (ifacedoc (map ref-ify
- (sort
- (map (lambda (iface)
- (if (pair? iface)
- (symbol->string (car iface))
- (ly:error (_ "pair expected in doc ~s") name)))
- ifaces)
- ly:string-ci<?)))
- (engravers (filter
- (lambda (x) (engraver-makes-grob? name x))
- all-engravers-list))
- (namestr (symbol->string name))
- (engraver-names (map symbol->string
- (map ly:translator-name engravers)))
- (engraver-list (human-listify
- (map ref-ify
- (map engraver-name engraver-names)))))
+ (name (assoc-get 'name meta))
+ ;; (bla (display name))
+ (ifaces (map lookup-interface (assoc-get 'interfaces meta)))
+ (ifacedoc (map ref-ify
+ (sort
+ (map (lambda (iface)
+ (if (pair? iface)
+ (symbol->string (car iface))
+ (ly:error (_ "pair expected in doc ~s") name)))
+ ifaces)
+ ly:string-ci<?)))
+ (engravers (filter
+ (lambda (x) (engraver-makes-grob? name x))
+ all-engravers-list))
+ (namestr (symbol->string name))
+ (engraver-names (map symbol->string
+ (map ly:translator-name engravers)))
+ (engraver-list (human-listify
+ (map ref-ify
+ (map engraver-name engraver-names)))))
(make <texi-node>
#:name namestr
@@ -148,10 +148,10 @@ node."
(string-append
namestr " objects "
(if (equal? engraver-list "none")
- "are not created by any engraver"
- (string-append
- "are created by: "
- engraver-list))
+ "are not created by any engraver"
+ (string-append
+ "are created by: "
+ engraver-list))
"."
"\n\nStandard settings:\n\n"
@@ -174,7 +174,7 @@ node."
'() (ly:all-grob-interfaces)))
(set! interface-description-alist
- (sort interface-description-alist ly:alist-ci<?))
+ (sort interface-description-alist ly:alist-ci<?))
;;;;;;;;;; check for dangling backend properties.
(define (mark-interface-properties entry)
@@ -186,7 +186,7 @@ node."
(define (check-dangling-properties prop)
(if (not (object-property prop 'iface-marked))
(ly:error (string-append "define-grob-properties.scm: "
- (_ "cannot find interface for property: ~S")) prop)))
+ (_ "cannot find interface for property: ~S")) prop)))
(map check-dangling-properties all-backend-properties)
@@ -195,8 +195,8 @@ node."
(define (lookup-interface name)
(let* ((entry (hashq-ref (ly:all-grob-interfaces) name #f)))
(if entry
- entry
- (ly:error (_ "unknown Grob interface: ~S") name))))
+ entry
+ (ly:error (_ "unknown Grob interface: ~S") name))))
(define (all-interfaces-doc)
(make <texi-node>
@@ -207,9 +207,9 @@ node."
(define (backend-properties-doc-string lst)
(let* ((ps (sort (map symbol->string lst) ly:string-ci<?))
- (descs (map (lambda (prop)
- (property->texi 'backend (string->symbol prop) '())) ps))
- (texi (description-list->texi descs #f)))
+ (descs (map (lambda (prop)
+ (property->texi 'backend (string->symbol prop) '())) ps))
+ (texi (description-list->texi descs #f)))
texi))
;;(dump-node (grob-doc (cdadr all-grob-descriptions)) (current-output-port) 0 )
diff --git a/scm/document-context-mods.scm b/scm/document-context-mods.scm
index d115389a1f..fc3c4ad28a 100644
--- a/scm/document-context-mods.scm
+++ b/scm/document-context-mods.scm
@@ -73,8 +73,8 @@
"
name-sym
name-sym
- (if (pair? docstring)
- (cadar docstring)
+ (if (pair? docstring)
+ (cadar docstring)
(begin
(ly:warning "context modification `~a' not documented." name-sym)
"(undocumented; fixme)"))
diff --git a/scm/document-functions.scm b/scm/document-functions.scm
index 1fdabaeacf..282bf24044 100644
--- a/scm/document-functions.scm
+++ b/scm/document-functions.scm
@@ -20,13 +20,13 @@
(ice-9 regex))
(define (dashify-underscores str)
- (regexp-substitute/global #f "_" str 'pre "-" 'post))
+ (regexp-substitute/global #f "_" str 'pre "-" 'post))
(define (format-c-header c-h)
(regexp-substitute/global
- #f ","
+ #f ","
(regexp-substitute/global #f "(SCM|\\)|\\() *" (dashify-underscores c-h)
- 'pre "" 'post)
+ 'pre "" 'post)
'pre " " 'post))
(define (document-scheme-function name c-header doc-string)
@@ -36,16 +36,16 @@
"\n@end defun\n\n"))
(define all-scheme-functions
- (hash-fold
- (lambda (key val prior)
- (cons (cons key val) prior))
- '() (ly:get-all-function-documentation)))
+ (hash-fold
+ (lambda (key val prior)
+ (cons (cons key val) prior))
+ '() (ly:get-all-function-documentation)))
(define (all-scheme-functions-doc)
(let* ((fdocs (map (lambda (x)
- (document-scheme-function (car x) (cadr x) (cddr x)))
- all-scheme-functions))
- (sfdocs (sort fdocs ly:string-ci<?)))
+ (document-scheme-function (car x) (cadr x) (cddr x)))
+ all-scheme-functions))
+ (sfdocs (sort fdocs ly:string-ci<?)))
(make <texi-node>
#:name "Scheme functions"
#:desc "Primitive functions exported by LilyPond."
diff --git a/scm/document-identifiers.scm b/scm/document-identifiers.scm
index fcd8f93214..e17f7d308c 100644
--- a/scm/document-identifiers.scm
+++ b/scm/document-identifiers.scm
@@ -23,32 +23,32 @@
(music-func (cdr music-func-pair))
(func (ly:music-function-extract music-func))
(arg-names
- (map symbol->string
- (cddr (cadr (procedure-source func)))))
+ (map symbol->string
+ (cddr (cadr (procedure-source func)))))
(doc (procedure-documentation func))
(sign (ly:music-function-signature music-func))
(type-names (map (lambda (pred)
- (if (pair? pred)
- (format #f "[~a]" (type-name (car pred)))
- (format #f "(~a)" (type-name pred))))
- sign))
+ (if (pair? pred)
+ (format #f "[~a]" (type-name (car pred)))
+ (format #f "(~a)" (type-name pred))))
+ sign))
(signature-str
- (string-join
- (map (lambda (arg type) (format #f "@var{~a} ~a" arg type))
- arg-names (cdr type-names)))))
+ (string-join
+ (map (lambda (arg type) (format #f "@var{~a} ~a" arg type))
+ arg-names (cdr type-names)))))
(format #f
- "@item @code{~a} ~a ~a~a
+ "@item @code{~a} ~a ~a~a
@funindex ~a
~a
"
- name-sym (car type-names)
- (if (equal? "" signature-str) "" " - ") signature-str
- name-sym
- (if doc
- doc
- (begin
- (ly:warning "music function `~a' not documented." name-sym)
- "(undocumented; fixme)")))))
+ name-sym (car type-names)
+ (if (equal? "" signature-str) "" " - ") signature-str
+ name-sym
+ (if doc
+ doc
+ (begin
+ (ly:warning "music function `~a' not documented." name-sym)
+ "(undocumented; fixme)")))))
(define (document-object obj-pair)
@@ -60,16 +60,16 @@
(define-public (identifiers-doc-string)
(format #f
- "@table @asis
+ "@table @asis
~a
@end table
"
- (string-join
- (filter
- identity
- (map
- document-object
- (sort
- (ly:module->alist (current-module))
- identifier<?)))
- "")))
+ (string-join
+ (filter
+ identity
+ (map
+ document-object
+ (sort
+ (ly:module->alist (current-module))
+ identifier<?)))
+ "")))
diff --git a/scm/document-markup.scm b/scm/document-markup.scm
index ea335f7e29..fd8f012b43 100644
--- a/scm/document-markup.scm
+++ b/scm/document-markup.scm
@@ -78,13 +78,13 @@
(define (markup-category-doc-node category)
(let* ((category-string (symbol->string category))
(category-name (string-capitalize
- (regexp-substitute/global
- #f "-" category-string 'pre " " 'post)))
- (markup-functions (hash-fold (lambda (markup-function dummy functions)
- (cons markup-function functions))
- '()
- (hashq-ref markup-functions-by-category
- category))))
+ (regexp-substitute/global
+ #f "-" category-string 'pre " " 'post)))
+ (markup-functions (hash-fold (lambda (markup-function dummy functions)
+ (cons markup-function functions))
+ '()
+ (hashq-ref markup-functions-by-category
+ category))))
(make <texi-node>
#:appendix #t
#:name category-name
@@ -118,12 +118,12 @@
(string-append
"@table @asis"
(apply string-append
- (map doc-markup-function
- (sort (hash-fold (lambda (markup-list-function dummy functions)
- (cons markup-list-function functions))
- '()
- markup-list-functions)
- markup-function<?)))
+ (map doc-markup-function
+ (sort (hash-fold (lambda (markup-list-function dummy functions)
+ (cons markup-list-function functions))
+ '()
+ markup-list-functions)
+ markup-function<?)))
"\n@end table"))
diff --git a/scm/document-music.scm b/scm/document-music.scm
index 7d7e2a9942..92c2b52487 100644
--- a/scm/document-music.scm
+++ b/scm/document-music.scm
@@ -24,40 +24,40 @@
#:desc "All music properties, including descriptions."
#:text
(let* ((ps (sort (map symbol->string all-music-properties) ly:string-ci<?))
- (descs (map (lambda (prop)
- (property->texi 'music (string->symbol prop)))
- ps))
- (texi (description-list->texi descs #f)))
+ (descs (map (lambda (prop)
+ (property->texi 'music (string->symbol prop)))
+ ps))
+ (texi (description-list->texi descs #f)))
texi)))
(define music-types->names (make-hash-table 61))
(filter-map (lambda (entry)
- (let* ((class (ly:camel-case->lisp-identifier (car entry)))
- (classes (ly:make-event-class doc-context class)))
- (if classes
- (map
- (lambda (cl)
- (hashq-set! music-types->names cl
- (cons (car entry)
- (hashq-ref music-types->names cl '()))))
- classes)
- #f)))
-
- music-descriptions)
+ (let* ((class (ly:camel-case->lisp-identifier (car entry)))
+ (classes (ly:make-event-class doc-context class)))
+ (if classes
+ (map
+ (lambda (cl)
+ (hashq-set! music-types->names cl
+ (cons (car entry)
+ (hashq-ref music-types->names cl '()))))
+ classes)
+ #f)))
+
+ music-descriptions)
(define (strip-description x)
(cons (symbol->string (car x))
- ""))
+ ""))
(define (music-type-doc entry)
(let* ((accept-list (human-listify
- (map ref-ify
- (map symbol->string
- (map ly:translator-name
- (filter
- (lambda (x)
- (engraver-accepts-music-type? (car entry) x))
- all-engravers-list)))))))
+ (map ref-ify
+ (map symbol->string
+ (map ly:translator-name
+ (filter
+ (lambda (x)
+ (engraver-accepts-music-type? (car entry) x))
+ all-engravers-list)))))))
(make <texi-node>
#:name (symbol->string (car entry))
#:text
@@ -66,16 +66,16 @@
(symbol->string (car entry))
"} is in music objects of type "
(human-listify
- (map ref-ify (sort (map symbol->string (cdr entry))
- ly:string-ci<?)))
+ (map ref-ify (sort (map symbol->string (cdr entry))
+ ly:string-ci<?)))
"."
"\n\n"
(if (equal? accept-list "none")
- "Not accepted by any engraver or performer"
- (string-append
- "Accepted by: "
- accept-list))
+ "Not accepted by any engraver or performer"
+ (string-append
+ "Accepted by: "
+ accept-list))
"."))))
(define (music-types-doc)
@@ -83,40 +83,40 @@
#:name "Music classes"
#:children
(map music-type-doc
- (sort
- (hash-table->alist music-types->names) ly:alist-ci<?))))
+ (sort
+ (hash-table->alist music-types->names) ly:alist-ci<?))))
(define (music-doc-str obj)
(let* ((namesym (car obj))
- (props (cdr obj))
- (class (ly:camel-case->lisp-identifier namesym))
- (classes (ly:make-event-class doc-context class))
- (accept-list (if classes
- (human-listify
- (map ref-ify
- (map symbol->string
- (map ly:translator-name
- (filter
- (lambda (x)
- (engraver-accepts-music-types? classes x))
- all-engravers-list)))))
- ""))
- (event-texi (if classes
- (string-append
- "\n\nEvent classes:\n"
- (human-listify
- (map ref-ify (sort (map symbol->string classes)
- ly:string-ci<?)))
- "."
+ (props (cdr obj))
+ (class (ly:camel-case->lisp-identifier namesym))
+ (classes (ly:make-event-class doc-context class))
+ (accept-list (if classes
+ (human-listify
+ (map ref-ify
+ (map symbol->string
+ (map ly:translator-name
+ (filter
+ (lambda (x)
+ (engraver-accepts-music-types? classes x))
+ all-engravers-list)))))
+ ""))
+ (event-texi (if classes
+ (string-append
+ "\n\nEvent classes:\n"
+ (human-listify
+ (map ref-ify (sort (map symbol->string classes)
+ ly:string-ci<?)))
+ "."
- "\n\n"
- (if (equal? accept-list "none")
- "Not accepted by any engraver or performer"
- (string-append
- "Accepted by: "
- accept-list))
- ".")
- "")))
+ "\n\n"
+ (if (equal? accept-list "none")
+ "Not accepted by any engraver or performer"
+ (string-append
+ "Accepted by: "
+ accept-list))
+ ".")
+ "")))
(string-append
(object-property namesym 'music-description)
diff --git a/scm/document-translation.scm b/scm/document-translation.scm
index 00b22be7a3..8237260c45 100644
--- a/scm/document-translation.scm
+++ b/scm/document-translation.scm
@@ -31,80 +31,80 @@
(define (engraver-doc-string engraver in-which-contexts)
(let* ((propsr (assoc-get 'properties-read (ly:translator-description engraver)))
- (propsw (assoc-get 'properties-written (ly:translator-description engraver)))
- (accepted (assoc-get 'events-accepted (ly:translator-description engraver)))
- (name-sym (ly:translator-name engraver))
- (name-str (symbol->string name-sym))
- (desc (assoc-get 'description (ly:translator-description engraver)))
- (grobs (engraver-grobs engraver)))
+ (propsw (assoc-get 'properties-written (ly:translator-description engraver)))
+ (accepted (assoc-get 'events-accepted (ly:translator-description engraver)))
+ (name-sym (ly:translator-name engraver))
+ (name-str (symbol->string name-sym))
+ (desc (assoc-get 'description (ly:translator-description engraver)))
+ (grobs (engraver-grobs engraver)))
(string-append
desc
"\n\n"
(if (pair? accepted)
- (string-append
- "Music types accepted:\n\n"
- (human-listify
- (map ref-ify (sort (map symbol->string accepted) ly:string-ci<?))))
- "")
+ (string-append
+ "Music types accepted:\n\n"
+ (human-listify
+ (map ref-ify (sort (map symbol->string accepted) ly:string-ci<?))))
+ "")
"\n\n"
(if (pair? propsr)
- (string-append
- "Properties (read)"
- (description-list->texi
- (map (lambda (x) (property->texi 'translation x '()))
- (sort propsr ly:symbol-ci<?))
- #t))
- "")
+ (string-append
+ "Properties (read)"
+ (description-list->texi
+ (map (lambda (x) (property->texi 'translation x '()))
+ (sort propsr ly:symbol-ci<?))
+ #t))
+ "")
(if (null? propsw)
- ""
- (string-append
- "Properties (write)"
- (description-list->texi
- (map (lambda (x) (property->texi 'translation x '()))
- (sort propsw ly:symbol-ci<?))
- #t)))
+ ""
+ (string-append
+ "Properties (write)"
+ (description-list->texi
+ (map (lambda (x) (property->texi 'translation x '()))
+ (sort propsw ly:symbol-ci<?))
+ #t)))
(if (null? grobs)
- ""
- (string-append
- "\n\nThis engraver creates the following layout object(s):\n\n"
- (human-listify (map ref-ify (uniq-list (sort grobs ly:string-ci<?))))
- "."))
+ ""
+ (string-append
+ "\n\nThis engraver creates the following layout object(s):\n\n"
+ (human-listify (map ref-ify (uniq-list (sort grobs ly:string-ci<?))))
+ "."))
"\n\n"
(if in-which-contexts
- (let* ((layout-alist (ly:output-description $defaultlayout))
- (context-description-alist (map cdr layout-alist))
- (contexts
- (apply append
- (map
- (lambda (x)
- (let* ((context (assoc-get 'context-name x))
- (group (assq-ref x 'group-type))
- (consists (append
- (if group
- (list group)
- '())
- (assoc-get 'consists x))))
- (if (member name-sym consists)
- (list context)
- '())))
- context-description-alist)))
- (context-list (human-listify (map ref-ify
- (sort
- (map symbol->string contexts)
- ly:string-ci<?)))))
- (string-append
- "@code{" name-str "} "
- (if (equal? context-list "none")
- "is not part of any context"
- (string-append
- "is part of the following context(s): "
- context-list))
- "."))
- ""))))
+ (let* ((layout-alist (ly:output-description $defaultlayout))
+ (context-description-alist (map cdr layout-alist))
+ (contexts
+ (apply append
+ (map
+ (lambda (x)
+ (let* ((context (assoc-get 'context-name x))
+ (group (assq-ref x 'group-type))
+ (consists (append
+ (if group
+ (list group)
+ '())
+ (assoc-get 'consists x))))
+ (if (member name-sym consists)
+ (list context)
+ '())))
+ context-description-alist)))
+ (context-list (human-listify (map ref-ify
+ (sort
+ (map symbol->string contexts)
+ ly:string-ci<?)))))
+ (string-append
+ "@code{" name-str "} "
+ (if (equal? context-list "none")
+ "is not part of any context"
+ (string-append
+ "is part of the following context(s): "
+ context-list))
+ "."))
+ ""))))
;; First level Engraver description
(define (engraver-doc grav)
@@ -129,45 +129,45 @@
(let* ((eg (find-engraver-by-name name)))
(cons (string-append "@code{" (ref-ify (symbol->string name)) "}")
- (engraver-doc-string eg #f))))
+ (engraver-doc-string eg #f))))
(define (document-property-operation op)
(let ((tag (car op))
- (context-sym (cadr op))
- (args (cddr op))
- )
+ (context-sym (cadr op))
+ (args (cddr op))
+ )
(cond
((equal? tag 'push)
(let*
- ((value (car args))
- (path (cdr args)))
-
- (string-append
- "@item Set "
- (format #f "grob-property @code{~a} "
- (string-join (map symbol->string path) " "))
- (format #f "in @ref{~a} to ~a."
- context-sym (scm->texi value))
- "\n")))
+ ((value (car args))
+ (path (cdr args)))
+
+ (string-append
+ "@item Set "
+ (format #f "grob-property @code{~a} "
+ (string-join (map symbol->string path) " "))
+ (format #f "in @ref{~a} to ~a."
+ context-sym (scm->texi value))
+ "\n")))
((equal? (object-property context-sym 'is-grob?) #t) "")
((equal? tag 'assign)
(format #f "@item Set translator property @code{~a} to ~a.\n"
- context-sym
- (scm->texi (car args))))
+ context-sym
+ (scm->texi (car args))))
)))
(define (context-doc context-desc)
(let* ((name-sym (assoc-get 'context-name context-desc))
- (name (symbol->string name-sym))
- (aliases (map symbol->string (assoc-get 'aliases context-desc)))
- (desc (assoc-get 'description context-desc "(not documented"))
- (accepts (assoc-get 'accepts context-desc))
- (consists (assoc-get 'consists context-desc))
- (props (assoc-get 'property-ops context-desc))
- (grobs (context-grobs context-desc))
- (grob-refs (map ref-ify (sort grobs ly:string-ci<?))))
+ (name (symbol->string name-sym))
+ (aliases (map symbol->string (assoc-get 'aliases context-desc)))
+ (desc (assoc-get 'description context-desc "(not documented"))
+ (accepts (assoc-get 'accepts context-desc))
+ (consists (assoc-get 'consists context-desc))
+ (props (assoc-get 'property-ops context-desc))
+ (grobs (context-grobs context-desc))
+ (grob-refs (map ref-ify (sort grobs ly:string-ci<?))))
(make <texi-node>
#:name name
@@ -175,72 +175,72 @@
(string-append
desc
(if (pair? aliases)
- (string-append
- "\n\nThis context also accepts commands for the following context(s):\n\n"
- (human-listify (sort aliases ly:string-ci<?))
- ".")
- "")
+ (string-append
+ "\n\nThis context also accepts commands for the following context(s):\n\n"
+ (human-listify (sort aliases ly:string-ci<?))
+ ".")
+ "")
"\n\nThis context creates the following layout object(s):\n\n"
(human-listify (uniq-list grob-refs))
"."
(if (and (pair? props) (not (null? props)))
- (let ((str (apply string-append
- (sort (map document-property-operation props)
- ly:string-ci<?))))
- (if (string-null? str)
- ""
- (string-append
- "\n\nThis context sets the following properties:\n\n"
- "@itemize @bullet\n"
- str
- "@end itemize\n")))
- "")
+ (let ((str (apply string-append
+ (sort (map document-property-operation props)
+ ly:string-ci<?))))
+ (if (string-null? str)
+ ""
+ (string-append
+ "\n\nThis context sets the following properties:\n\n"
+ "@itemize @bullet\n"
+ str
+ "@end itemize\n")))
+ "")
(if (null? accepts)
- "\n\nThis context is a `bottom' context; it cannot contain other contexts."
- (string-append
- "\n\nContext "
- name
- " can contain\n"
- (human-listify (map ref-ify (sort (map symbol->string accepts)
- ly:string-ci<?)))
- "."))
+ "\n\nThis context is a `bottom' context; it cannot contain other contexts."
+ (string-append
+ "\n\nContext "
+ name
+ " can contain\n"
+ (human-listify (map ref-ify (sort (map symbol->string accepts)
+ ly:string-ci<?)))
+ "."))
(if (null? consists)
- ""
- (string-append
- "\n\nThis context is built from the following engraver(s):"
- (description-list->texi
- (map document-engraver-by-name (sort consists ly:symbol-ci<?))
- #t)))))))
+ ""
+ (string-append
+ "\n\nThis context is built from the following engraver(s):"
+ (description-list->texi
+ (map document-engraver-by-name (sort consists ly:symbol-ci<?))
+ #t)))))))
(define (engraver-grobs grav)
(let* ((eg (if (symbol? grav)
- (find-engraver-by-name grav)
- grav)))
+ (find-engraver-by-name grav)
+ grav)))
(if (eq? eg #f)
- '()
- (map symbol->string (assoc-get 'grobs-created (ly:translator-description eg))))))
+ '()
+ (map symbol->string (assoc-get 'grobs-created (ly:translator-description eg))))))
(define (context-grobs context-desc)
(let* ((group (assq-ref context-desc 'group-type))
- (consists (append
- (if group
- (list group)
- '())
- (assoc-get 'consists context-desc)))
- (grobs (apply append
- (map engraver-grobs consists))))
+ (consists (append
+ (if group
+ (list group)
+ '())
+ (assoc-get 'consists context-desc)))
+ (grobs (apply append
+ (map engraver-grobs consists))))
grobs))
(define (all-contexts-doc)
(let* ((layout-alist
- (sort (ly:output-description $defaultlayout)
- (lambda (x y) (ly:symbol-ci<? (car x) (car y)))))
- (names (sort (map symbol->string (map car layout-alist)) ly:string-ci<?))
- (contexts (map cdr layout-alist)))
+ (sort (ly:output-description $defaultlayout)
+ (lambda (x y) (ly:symbol-ci<? (car x) (car y)))))
+ (names (sort (map symbol->string (map car layout-alist)) ly:string-ci<?))
+ (contexts (map cdr layout-alist)))
(make <texi-node>
#:name "Contexts"
@@ -251,8 +251,8 @@
(define all-engravers-list (ly:get-all-translators))
(set! all-engravers-list
(sort all-engravers-list
- (lambda (a b) (ly:string-ci<? (symbol->string (ly:translator-name a))
- (symbol->string (ly:translator-name b))))))
+ (lambda (a b) (ly:string-ci<? (symbol->string (ly:translator-name a))
+ (symbol->string (ly:translator-name b))))))
(define (all-engravers-doc)
(make <texi-node>
@@ -264,12 +264,12 @@
(define (translation-properties-doc-string lst)
(let* ((ps (sort (map symbol->string lst) ly:string-ci<?))
- (sortedsyms (map string->symbol ps))
- (propdescs
- (map
- (lambda (x) (property->texi 'translation x '()))
- sortedsyms))
- (texi (description-list->texi propdescs #f)))
+ (sortedsyms (map string->symbol ps))
+ (propdescs
+ (map
+ (lambda (x) (property->texi 'translation x '()))
+ sortedsyms))
+ (texi (description-list->texi propdescs #f)))
texi))
(define (translation-doc-node)
@@ -284,10 +284,10 @@
#:name "Tunable context properties"
#:desc "All tunable context properties."
#:text (translation-properties-doc-string
- all-user-translation-properties))
+ all-user-translation-properties))
(make <texi-node>
#:name "Internal context properties"
#:desc "All internal context properties."
#:text (translation-properties-doc-string
- all-internal-translation-properties)))))
+ all-internal-translation-properties)))))
diff --git a/scm/documentation-generate.scm b/scm/documentation-generate.scm
index 88016c92ae..00286238b3 100644
--- a/scm/documentation-generate.scm
+++ b/scm/documentation-generate.scm
@@ -28,15 +28,15 @@
;; todo: naming: grob vs. layout property
(map ly:load '("documentation-lib.scm"
- "lily-sort.scm"
- "document-functions.scm"
- "document-translation.scm"
- "document-music.scm"
- "document-type-predicates.scm"
- "document-identifiers.scm"
- "document-context-mods.scm"
- "document-backend.scm"
- "document-markup.scm"))
+ "lily-sort.scm"
+ "document-functions.scm"
+ "document-translation.scm"
+ "document-music.scm"
+ "document-type-predicates.scm"
+ "document-identifiers.scm"
+ "document-context-mods.scm"
+ "document-backend.scm"
+ "document-markup.scm"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -97,7 +97,7 @@
(display
(string-append
(texi-file-head "LilyPond Internals Reference" file-name
- "(lilypond-internals.info)")
+ "(lilypond-internals.info)")
"
@include macros.itexi
@@ -156,8 +156,8 @@ This document is also available as a
@end ifhtml
This is the Internals Reference (IR) for version "
- (lilypond-version)
- " of LilyPond, the GNU music typesetter.")
+ (lilypond-version)
+ " of LilyPond, the GNU music typesetter.")
#:children
(list
diff --git a/scm/documentation-lib.scm b/scm/documentation-lib.scm
index 182f581272..b8c0f097a6 100644
--- a/scm/documentation-lib.scm
+++ b/scm/documentation-lib.scm
@@ -17,8 +17,8 @@
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
(use-modules (oop goops)
- (srfi srfi-13)
- (srfi srfi-1))
+ (srfi srfi-13)
+ (srfi srfi-1))
(define-class <texi-node> ()
(appendix #:init-value #f #:accessor appendix? #:init-keyword #:appendix)
@@ -47,10 +47,10 @@
(node-text node)
"\n\n"
(if (pair? (node-children node))
- (texi-menu
- (map (lambda (x) (menu-entry x))
- (node-children node)))
- ""))
+ (texi-menu
+ (map (lambda (x) (menu-entry x))
+ (node-children node)))
+ ""))
port)
(map (lambda (x) (dump-node x port (+ 1 level)))
(node-children node)))
@@ -71,21 +71,21 @@
(define (texi-section-command level)
(assoc-get level '(
- ;; Hmm, texinfo doesn't have ``part''
- (0 . "@top")
- (1 . "@chapter")
- (2 . "@section")
- (3 . "@subsection")
- (4 . "@unnumberedsubsubsec")
- (5 . "@unnumberedsubsubsec"))))
+ ;; Hmm, texinfo doesn't have ``part''
+ (0 . "@top")
+ (1 . "@chapter")
+ (2 . "@section")
+ (3 . "@subsection")
+ (4 . "@unnumberedsubsubsec")
+ (5 . "@unnumberedsubsubsec"))))
(define (texi-appendix-section-command level)
(assoc-get level '((0 . "@top")
- (1 . "@appendix")
- (2 . "@appendixsec")
- (3 . "@appendixsubsec")
- (4 . "@appendixsubsubsec")
- (5 . "@appendixsubsubsec"))))
+ (1 . "@appendix")
+ (2 . "@appendixsec")
+ (3 . "@appendixsubsec")
+ (4 . "@appendixsubsubsec")
+ (5 . "@appendixsubsubsec"))))
(define (one-item->texi label-desc-pair)
"Document one (LABEL . DESC); return empty string if LABEL is empty string."
@@ -109,25 +109,25 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment."
(define (texi-menu items-alist)
"Generate what is between @menu and @end menu."
(let ((maxwid
- (apply max (map (lambda (x) (string-length (car x))) items-alist))))
+ (apply max (map (lambda (x) (string-length (car x))) items-alist))))
(string-append
"\n@menu"
(apply string-append
- (map (lambda (x)
- (string-append
- (string-pad-right
- (string-append "\n* " (car x) ":: ")
- (+ maxwid 8))
- (cdr x)))
- items-alist))
+ (map (lambda (x)
+ (string-append
+ (string-pad-right
+ (string-append "\n* " (car x) ":: ")
+ (+ maxwid 8))
+ (cdr x)))
+ items-alist))
"\n@end menu\n"
;; Menus don't appear in html, so we make a list ourselves
"\n@ignore\n"
"\n@ifhtml\n"
(description-list->texi (map (lambda (x) (cons (ref-ify (car x)) (cdr x)))
- items-alist)
- #t)
+ items-alist)
+ #t)
"\n@end ifhtml\n"
"\n@end ignore\n")))
@@ -195,27 +195,27 @@ string-to-use). If QUOTE? is #t, embed table in a @quotation environment."
with init values from ALIST (1st optional argument)
"
(let* ((name (symbol->string sym))
- (alist (if (pair? rest) (car rest) '()))
- (type?-name (string->symbol
- (string-append (symbol->string where) "-type?")))
- (doc-name (string->symbol
- (string-append (symbol->string where) "-doc")))
- (type (object-property sym type?-name))
- (typename (verify-type-name where sym type))
- (desc (object-property sym doc-name))
- (init-value (assoc-get sym alist)))
+ (alist (if (pair? rest) (car rest) '()))
+ (type?-name (string->symbol
+ (string-append (symbol->string where) "-type?")))
+ (doc-name (string->symbol
+ (string-append (symbol->string where) "-doc")))
+ (type (object-property sym type?-name))
+ (typename (verify-type-name where sym type))
+ (desc (object-property sym doc-name))
+ (init-value (assoc-get sym alist)))
(if (eq? desc #f)
- (ly:error (_ "cannot find description for property ~S (~S)") sym where))
+ (ly:error (_ "cannot find description for property ~S (~S)") sym where))
(cons
(string-append "@code{" name "} "
- "(" typename ")"
- (if init-value
- (string-append
- ":\n\n"
- (scm->texi init-value)
- "\n\n")
- ""))
+ "(" typename ")"
+ (if init-value
+ (string-append
+ ":\n\n"
+ (scm->texi init-value)
+ "\n\n")
+ ""))
desc)))
diff --git a/scm/editor.scm b/scm/editor.scm
index 66c3709fb2..e474a557e5 100644
--- a/scm/editor.scm
+++ b/scm/editor.scm
@@ -36,9 +36,9 @@
;; FIXME: how are default/preferred editors specified on
;; different platforms?
(case PLATFORM
- ((windows) "lilypad")
- (else
- "emacs"))))
+ ((windows) "lilypad")
+ (else
+ "emacs"))))
(define editor-command-template-alist
'(("emacs" . "emacsclient --no-wait +%(line)s:%(column)s %(file)s || (emacs +%(line)s:%(column)s %(file)s&)")
@@ -53,12 +53,12 @@
(define (get-command-template alist editor)
(define (get-command-template-helper)
(if (null? alist)
- (if (string-match "%\\(file\\)s" editor)
- editor
- (string-append editor " %(file)s"))
- (if (string-match (caar alist) editor)
- (cdar alist)
- (get-command-template (cdr alist) editor))))
+ (if (string-match "%\\(file\\)s" editor)
+ editor
+ (string-append editor " %(file)s"))
+ (if (string-match (caar alist) editor)
+ (cdar alist)
+ (get-command-template (cdr alist) editor))))
(if (string-match "%\\(file\\)s" editor)
editor
(get-command-template-helper)))
@@ -67,18 +67,18 @@
(regexp-substitute/global #f re string 'pre sub 'post))
(define (slashify x)
- (if (string-index x #\/)
- x
- (re-sub "\\\\" "/" x)))
+ (if (string-index x #\/)
+ x
+ (re-sub "\\\\" "/" x)))
(define-public (get-editor-command file-name line char column)
(let* ((editor (get-editor))
- (template (get-command-template editor-command-template-alist editor))
- (command
- (re-sub "%\\(file\\)s" (format #f "~S" file-name)
- (re-sub "%\\(line\\)s" (format #f "~a" line)
- (re-sub "%\\(char\\)s" (format #f "~a" char)
- (re-sub
- "%\\(column\\)s" (format #f "~a" column)
- (slashify template)))))))
+ (template (get-command-template editor-command-template-alist editor))
+ (command
+ (re-sub "%\\(file\\)s" (format #f "~S" file-name)
+ (re-sub "%\\(line\\)s" (format #f "~a" line)
+ (re-sub "%\\(char\\)s" (format #f "~a" char)
+ (re-sub
+ "%\\(column\\)s" (format #f "~a" column)
+ (slashify template)))))))
command))
diff --git a/scm/encoding.scm b/scm/encoding.scm
index 1868e7600f..aaeed727b1 100644
--- a/scm/encoding.scm
+++ b/scm/encoding.scm
@@ -17,44 +17,44 @@
(define-public latin1-coding-vector
#(.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
- .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
- .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
- .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
- %% 0x20
- space exclam quotedbl numbersign dollar percent ampersand quoteright
- parenleft parenright asterisk plus comma hyphen period slash
- zero one two three four five six seven
- eight nine colon semicolon less equal greater question
- %% 0x40
- at A B C D E F G
- H I J K L M N O
- P Q R S T U V W
- X Y Z bracketleft backslash bracketright asciicircum underscore
- %% 0x60
- `quoteleft a b c d e f g
- h i j k l m n o
- p q r s t u v w
- x y z braceleft bar braceright asciitilde .notdef
- %% 0x80
- .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
- .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
- dotlessi grave acute circumflex tilde macron breve dotaccent
- dieresis .notdef ring cedilla .notdef hungarumlaut ogonek caron
- %% 0xA0
- space exclamdown cent sterling currency yen brokenbar section
- dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron
- degree plusminus twosuperior threesuperior acute mu paragraph periodcentered
- cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown
- %% 0xC0
- Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla
- Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis
- Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply
- Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls
- %% 0xE0
- agrave aacute acircumflex atilde adieresis aring ae ccedilla
- egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis
- eth ntilde ograve oacute ocircumflex otilde odieresis divide
- oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis))
+ .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
+ .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
+ .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
+ %% 0x20
+ space exclam quotedbl numbersign dollar percent ampersand quoteright
+ parenleft parenright asterisk plus comma hyphen period slash
+ zero one two three four five six seven
+ eight nine colon semicolon less equal greater question
+ %% 0x40
+ at A B C D E F G
+ H I J K L M N O
+ P Q R S T U V W
+ X Y Z bracketleft backslash bracketright asciicircum underscore
+ %% 0x60
+ `quoteleft a b c d e f g
+ h i j k l m n o
+ p q r s t u v w
+ x y z braceleft bar braceright asciitilde .notdef
+ %% 0x80
+ .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
+ .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef
+ dotlessi grave acute circumflex tilde macron breve dotaccent
+ dieresis .notdef ring cedilla .notdef hungarumlaut ogonek caron
+ %% 0xA0
+ space exclamdown cent sterling currency yen brokenbar section
+ dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron
+ degree plusminus twosuperior threesuperior acute mu paragraph periodcentered
+ cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown
+ %% 0xC0
+ Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla
+ Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis
+ Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply
+ Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls
+ %% 0xE0
+ agrave aacute acircumflex atilde adieresis aring ae ccedilla
+ egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis
+ eth ntilde ograve oacute ocircumflex otilde odieresis divide
+ oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis))
(define-public (decode-byte-string str)
@@ -62,10 +62,10 @@
assuming that @var{str} is byte-coded using latin-1 encoding."
(let* ((len (string-length str))
- (output-vector (make-vector len '.notdef)))
+ (output-vector (make-vector len '.notdef)))
(do
- ((idx 0 (1+ idx)))
- ((>= idx len) output-vector)
+ ((idx 0 (1+ idx)))
+ ((>= idx len) output-vector)
(vector-set! output-vector idx
- (vector-ref latin1-coding-vector
- (char->integer (string-ref str idx)))))))
+ (vector-ref latin1-coding-vector
+ (char->integer (string-ref str idx)))))))
diff --git a/scm/file-cache.scm b/scm/file-cache.scm
index 221a6e2837..21db866eb8 100644
--- a/scm/file-cache.scm
+++ b/scm/file-cache.scm
@@ -22,7 +22,7 @@
((contents (hash-ref cache-hash-tab filename #f)))
(if (not (string? contents))
- (begin
- (set! contents (ly:gulp-file filename))
- (hash-set! cache-hash-tab filename contents)))
+ (begin
+ (set! contents (ly:gulp-file filename))
+ (hash-set! cache-hash-tab filename contents)))
contents))
diff --git a/scm/flag-styles.scm b/scm/flag-styles.scm
index 6027161995..0b5750280f 100644
--- a/scm/flag-styles.scm
+++ b/scm/flag-styles.scm
@@ -90,22 +90,22 @@ All lengths are scaled according to the font size of the note."
(points (if stem-up (list start flag-end
(offset-add flag-end thickness-offset)
(offset-add start thickness-offset))
- (list start
- (offset-add start thickness-offset)
- (offset-add flag-end thickness-offset)
- flag-end)))
+ (list start
+ (offset-add start thickness-offset)
+ (offset-add flag-end thickness-offset)
+ flag-end)))
(stencil (ly:round-filled-polygon points half-stem-thickness))
;; Log for 1/8 is 3, so we need to subtract 3
(flag-stencil (buildflag stencil (- log 3) stencil spacing))
(stroke-style (ly:grob-property grob 'stroke-style)))
- (if (equal? stroke-style "grace")
- (add-stroke-straight flag-stencil grob
- dir log
- stroke-style
- flag-end flag-length
- thickness
- (* half-stem-thickness 2))
- flag-stencil))))
+ (if (equal? stroke-style "grace")
+ (add-stroke-straight flag-stencil grob
+ dir log
+ stroke-style
+ flag-end flag-length
+ thickness
+ (* half-stem-thickness 2))
+ flag-stencil))))
(define-public (modern-straight-flag grob)
"Modern straight flag style (for composers like Stockhausen, Boulez, etc.).
@@ -136,21 +136,21 @@ flags are both 45 degrees."
"Load and add a stroke (represented by a glyph in the font) to the given
flag stencil."
(if (not (string? stroke-style))
- stencil
- ;; Otherwise: look up the stroke glyph and combine it with the flag
- (let* ((stem-grob (ly:grob-parent grob X))
- (font-char (string-append "flags." flag-style dir stroke-style))
- (alt-font-char (string-append "flags." dir stroke-style))
- (font (ly:grob-default-font grob))
- (tmpstencil (ly:font-get-glyph font font-char))
- (stroke-stencil (if (ly:stencil-empty? tmpstencil)
- (ly:font-get-glyph font alt-font-char)
- tmpstencil)))
- (if (ly:stencil-empty? stroke-stencil)
- (begin
- (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
- stencil)
- (ly:stencil-add stencil stroke-stencil)))))
+ stencil
+ ;; Otherwise: look up the stroke glyph and combine it with the flag
+ (let* ((stem-grob (ly:grob-parent grob X))
+ (font-char (string-append "flags." flag-style dir stroke-style))
+ (alt-font-char (string-append "flags." dir stroke-style))
+ (font (ly:grob-default-font grob))
+ (tmpstencil (ly:font-get-glyph font font-char))
+ (stroke-stencil (if (ly:stencil-empty? tmpstencil)
+ (ly:font-get-glyph font alt-font-char)
+ tmpstencil)))
+ (if (ly:stencil-empty? stroke-stencil)
+ (begin
+ (ly:warning (_ "flag stroke `~a' or `~a' not found") font-char alt-font-char)
+ stencil)
+ (ly:stencil-add stencil stroke-stencil)))))
(define-public (retrieve-glyph-flag flag-style dir dir-modifier grob)
@@ -161,7 +161,7 @@ flag stencil."
(font-char (string-append "flags." flag-style dir dir-modifier (number->string log)))
(flag (ly:font-get-glyph font font-char)))
(if (ly:stencil-empty? flag)
- (ly:warning "flag ~a not found" font-char))
+ (ly:warning "flag ~a not found" font-char))
flag))
@@ -172,8 +172,8 @@ flag stencil."
(flag (retrieve-glyph-flag flag-style dir dir-modifier grob))
(stroke-style (ly:grob-property grob 'stroke-style)))
(if (null? stroke-style)
- flag
- (add-stroke-glyph flag grob dir stroke-style flag-style))))
+ flag
+ (add-stroke-glyph flag grob dir stroke-style flag-style))))
@@ -191,10 +191,10 @@ a flag always touches a staff line."
(d (ly:grob-property stem-grob 'direction))
(ss (ly:staff-symbol-staff-space stem-grob))
(stem-end (inexact->exact (round (* (index-cell
- (ly:grob-extent stem-grob
- stem-grob
- Y)
- d)
+ (ly:grob-extent stem-grob
+ stem-grob
+ Y)
+ d)
(/ 2 ss)))))
;; For some reason the stem-end is a real instead of an integer...
(dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0"))
@@ -236,7 +236,7 @@ at will. The correct way to do this is:
(symbol->string flag-style-symbol)
"")))
(cond
- ((equal? flag-style "") (normal-flag grob))
- ((equal? flag-style "mensural") (mensural-flag grob))
- ((equal? flag-style "no-flag") (no-flag grob))
- (else ((glyph-flag flag-style) grob)))))
+ ((equal? flag-style "") (normal-flag grob))
+ ((equal? flag-style "mensural") (mensural-flag grob))
+ ((equal? flag-style "no-flag") (no-flag grob))
+ (else ((glyph-flag flag-style) grob)))))
diff --git a/scm/font.scm b/scm/font.scm
index d759d60934..8753019fa7 100644
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -43,7 +43,7 @@
(make <Font-tree-leaf> #:default-size size #:size-vector size-font-vector))
(define (make-font-tree-node
- qualifier default)
+ qualifier default)
(make <Font-tree-node>
#:qualifier qualifier
#:default default
@@ -52,11 +52,11 @@
(define-method (display (leaf <Font-tree-leaf>) port)
(map (lambda (x) (display x port))
(list
- "#<Font-size-family:\n"
- (slot-ref leaf 'default-size)
- (slot-ref leaf 'size-vector)
- "#>"
- )))
+ "#<Font-size-family:\n"
+ (slot-ref leaf 'default-size)
+ (slot-ref leaf 'size-vector)
+ "#>"
+ )))
(define-method (display (node <Font-tree-node>) port)
(map
@@ -84,10 +84,10 @@
(define (make-node fprops size-family)
(if (null? fprops)
- (make-font-tree-leaf (car size-family) (cdr size-family))
- (let* ((qual (next-qualifier default-qualifier-order fprops)))
- (make-font-tree-node qual
- (assoc-get qual fprops)))))
+ (make-font-tree-leaf (car size-family) (cdr size-family))
+ (let* ((qual (next-qualifier default-qualifier-order fprops)))
+ (make-font-tree-node qual
+ (assoc-get qual fprops)))))
(define (next-qualifier order props)
(cond
@@ -97,34 +97,34 @@
((null? order) (caar props))
(else
(if (assoc-get (car order) props)
- (car order)
- (next-qualifier (cdr order) props)))))
+ (car order)
+ (next-qualifier (cdr order) props)))))
(let* ((q (font-qualifier node))
- (d (font-default node))
- (v (assoc-get q fprops d))
- (new-fprops (assoc-delete q fprops))
- (child (hashq-ref (slot-ref node 'children)
- v #f)))
+ (d (font-default node))
+ (v (assoc-get q fprops d))
+ (new-fprops (assoc-delete q fprops))
+ (child (hashq-ref (slot-ref node 'children)
+ v #f)))
(if (not child)
- (begin
- (set! child (make-node new-fprops size-family))
- (hashq-set! (slot-ref node 'children) v child)))
+ (begin
+ (set! child (make-node new-fprops size-family))
+ (hashq-set! (slot-ref node 'children) v child)))
(if (pair? new-fprops)
- (add-font child new-fprops size-family))))
+ (add-font child new-fprops size-family))))
(define-method (add-font (node <Font-tree-leaf>) fprops size-family)
(throw "must add to node, not leaf"))
(define-method (g-lookup-font (node <Font-tree-node>) alist-chain)
(let* ((qual (font-qualifier node))
- (def (font-default node))
- (val (chain-assoc-get qual alist-chain def))
- (desired-child (hashq-ref (font-children node) val)))
+ (def (font-default node))
+ (val (chain-assoc-get qual alist-chain def))
+ (desired-child (hashq-ref (font-children node) val)))
(if desired-child
- (g-lookup-font desired-child alist-chain)
- (g-lookup-font (hashq-ref (font-children node) def) alist-chain))))
+ (g-lookup-font desired-child alist-chain)
+ (g-lookup-font (hashq-ref (font-children node) def) alist-chain))))
(define-method (g-lookup-font (node <Font-tree-leaf>) alist-chain)
node)
@@ -176,32 +176,32 @@ used. This is used to select the proper design size for the text fonts.
(for-each
(lambda (x)
(add-font node
- (list (cons 'font-encoding (car x))
- (cons 'font-family family))
- (cons (* factor (cadr x))
- (caddr x))))
-
+ (list (cons 'font-encoding (car x))
+ (cons 'font-family family))
+ (cons (* factor (cadr x))
+ (caddr x))))
+
`((fetaText ,(ly:pt 20.0)
- ,(list->vector
- (map (lambda (tup)
- (cons (ly:pt (cdr tup))
- (format #f "~a-~a ~a"
- name
- (car tup)
- (ly:pt (cdr tup)))))
- design-size-alist)))
+ ,(list->vector
+ (map (lambda (tup)
+ (cons (ly:pt (cdr tup))
+ (format #f "~a-~a ~a"
+ name
+ (car tup)
+ (ly:pt (cdr tup)))))
+ design-size-alist)))
(fetaMusic ,(ly:pt 20.0)
- ,(list->vector
- (map (lambda (size-tup)
- (delay (ly:system-font-load
- (format #f "~a-~a" name (car size-tup)))))
- design-size-alist
- )))
+ ,(list->vector
+ (map (lambda (size-tup)
+ (delay (ly:system-font-load
+ (format #f "~a-~a" name (car size-tup)))))
+ design-size-alist
+ )))
(fetaBraces ,(ly:pt 20.0)
- #(,(delay (ly:system-font-load
- (format #f "~a-brace" name)))))
+ #(,(delay (ly:system-font-load
+ (format #f "~a-brace" name)))))
)))
-
+
(define-public (add-pango-fonts node lily-family family factor)
;; Synchronized with the `text-font-size' variable in
;; layout-set-absolute-staff-size-in-module (see paper.scm).
@@ -209,19 +209,19 @@ used. This is used to select the proper design size for the text fonts.
(define (add-node shape series)
(add-font node
- `((font-family . ,lily-family)
- (font-shape . ,shape)
- (font-series . ,series)
- (font-encoding . latin1) ;; ugh.
- )
- `(,text-font-size
- . #(,(cons
- (ly:pt 12)
- (ly:make-pango-description-string
- `(((font-family . ,family)
- (font-series . ,series)
- (font-shape . ,shape)))
- (ly:pt 12)))))))
+ `((font-family . ,lily-family)
+ (font-shape . ,shape)
+ (font-series . ,series)
+ (font-encoding . latin1) ;; ugh.
+ )
+ `(,text-font-size
+ . #(,(cons
+ (ly:pt 12)
+ (ly:make-pango-description-string
+ `(((font-family . ,family)
+ (font-series . ,series)
+ (font-shape . ,shape)))
+ (ly:pt 12)))))))
(add-node 'upright 'normal)
(add-node 'caps 'normal)
@@ -239,8 +239,8 @@ used. This is used to select the proper design size for the text fonts.
(define-public (make-century-schoolbook-tree factor)
(make-pango-font-tree
- "Century Schoolbook L"
- "sans-serif" "monospace" factor))
+ "Century Schoolbook L"
+ "sans-serif" "monospace" factor))
(define-public all-text-font-encodings
'(latin1))
diff --git a/scm/framework-eps.scm b/scm/framework-eps.scm
index 697073642d..c0087f46d2 100644
--- a/scm/framework-eps.scm
+++ b/scm/framework-eps.scm
@@ -20,15 +20,15 @@
;;; this is still too big a mess.
(use-modules (ice-9 regex)
- (ice-9 string-fun)
- (guile)
- (scm framework-ps)
- (scm paper-system)
- (scm page)
- (scm output-ps)
- (srfi srfi-1)
- (srfi srfi-13)
- (lily))
+ (ice-9 string-fun)
+ (guile)
+ (scm framework-ps)
+ (scm paper-system)
+ (scm page)
+ (scm output-ps)
+ (srfi srfi-1)
+ (srfi srfi-13)
+ (lily))
(define format
ergonomic-simple-format)
@@ -42,18 +42,18 @@ stencil so that LaTeX's \\includegraphics command doesn't modify the
alignment."
(define left
(if (pair? stencils)
- (apply min
- (map (lambda (stc)
- (interval-start (ly:stencil-extent stc X)))
- stencils))
- 0.0))
+ (apply min
+ (map (lambda (stc)
+ (interval-start (ly:stencil-extent stc X)))
+ stencils))
+ 0.0))
(map (lambda (stil)
- (ly:make-stencil
- (ly:stencil-expr stil)
- (cons left
- (cdr (ly:stencil-extent stil X)))
- (ly:stencil-extent stil Y)))
+ (ly:make-stencil
+ (ly:stencil-expr stil)
+ (cons left
+ (cdr (ly:stencil-extent stil X)))
+ (ly:stencil-extent stil Y)))
stencils))
(define (dump-stencils-as-EPSes stencils book basename)
@@ -62,7 +62,7 @@ alignment."
(define paper
(ly:paper-book-paper book))
-
+
(define create-aux-files
(ly:get-option 'aux-files))
@@ -73,86 +73,86 @@ alignment."
(define (dump-counted-stencil stencil-count-pair)
"Return EPS filename."
(let* ((stencil (car stencil-count-pair))
- (number (cdr stencil-count-pair))
- (name (format #f "~a-~a" basename number)))
+ (number (cdr stencil-count-pair))
+ (name (format #f "~a-~a" basename number)))
(dump-stencil-as-EPS paper stencil name
- (ly:get-option 'include-eps-fonts))
+ (ly:get-option 'include-eps-fonts))
(string-append name ".eps")))
;; main body
- ;; First, create the output, then if necessary, individual staves and
+ ;; First, create the output, then if necessary, individual staves and
;; finally write some auxiliary files if desired
(dump-infinite-stack-EPS stencils)
(postprocess-output book framework-eps-module
- (format #f "~a.eps" basename) (ly:output-formats))
+ (format #f "~a.eps" basename) (ly:output-formats))
;; individual staves (*-1.eps etc.); only print if more than one stencil
;; Otherwise the .eps and the -1.eps file will be identical and waste space
;; Also always create if aux-files=##t
(if (or create-aux-files (< 1 (length stencils)))
- (let* ((widened-stencils (widen-left-stencil-edges stencils))
- (counted-systems (count-list widened-stencils))
- (eps-files (map dump-counted-stencil counted-systems)))
- (if do-pdf
- ;; par-for-each: a bit faster ...
- (for-each (lambda (y) (postscript->pdf 0 0 y))
- eps-files))))
+ (let* ((widened-stencils (widen-left-stencil-edges stencils))
+ (counted-systems (count-list widened-stencils))
+ (eps-files (map dump-counted-stencil counted-systems)))
+ (if do-pdf
+ ;; par-for-each: a bit faster ...
+ (for-each (lambda (y) (postscript->pdf 0 0 y))
+ eps-files))))
;; Now, write some aux files if requested: .texi, .tex and .count
;; for direct inclusion into latex and texinfo
(if create-aux-files
- (let* ((write-file (lambda (str-port ext)
- (if create-aux-files
- (let* ((name (format #f "~a-systems.~a" basename ext))
- (port (open-output-file name)))
- (ly:message (_ "Writing ~a...") name)
- (display (get-output-string str-port) port)
- (close-output-port port)))))
- (tex-system-port (open-output-string))
- (texi-system-port (open-output-string))
- (count-system-port (open-output-string)))
- (for-each (lambda (c)
- (if (< 0 c)
- (format tex-system-port
- "\\ifx\\betweenLilyPondSystem \\undefined
+ (let* ((write-file (lambda (str-port ext)
+ (if create-aux-files
+ (let* ((name (format #f "~a-systems.~a" basename ext))
+ (port (open-output-file name)))
+ (ly:message (_ "Writing ~a...") name)
+ (display (get-output-string str-port) port)
+ (close-output-port port)))))
+ (tex-system-port (open-output-string))
+ (texi-system-port (open-output-string))
+ (count-system-port (open-output-string)))
+ (for-each (lambda (c)
+ (if (< 0 c)
+ (format tex-system-port
+ "\\ifx\\betweenLilyPondSystem \\undefined
\\linebreak
\\else
\\expandafter\\betweenLilyPondSystem{~a}%
\\fi
" c))
- (format tex-system-port "\\includegraphics{~a-~a}%\n"
- basename (1+ c))
- (format texi-system-port "@image{~a-~a}\n"
- basename (1+ c)))
- (iota (length stencils)))
- (display "@c eof\n" texi-system-port)
- (display "% eof\n" tex-system-port)
- (format count-system-port "~a" (length stencils))
- (write-file texi-system-port "texi")
- (write-file tex-system-port "tex")
- ;; do this as the last action so we know the rest is complete if
- ;; this file is present.
- (write-file count-system-port "count"))))
+ (format tex-system-port "\\includegraphics{~a-~a}%\n"
+ basename (1+ c))
+ (format texi-system-port "@image{~a-~a}\n"
+ basename (1+ c)))
+ (iota (length stencils)))
+ (display "@c eof\n" texi-system-port)
+ (display "% eof\n" tex-system-port)
+ (format count-system-port "~a" (length stencils))
+ (write-file texi-system-port "texi")
+ (write-file tex-system-port "tex")
+ ;; do this as the last action so we know the rest is complete if
+ ;; this file is present.
+ (write-file count-system-port "count"))))
(define-public (output-classic-framework basename book scopes fields)
(output-scopes scopes fields basename)
(if (ly:get-option 'dump-signatures)
(write-system-signatures basename (ly:paper-book-systems book) 1))
(dump-stencils-as-EPSes (map paper-system-stencil
- (ly:paper-book-systems book))
- book
- basename))
+ (ly:paper-book-systems book))
+ book
+ basename))
(define-public (output-framework basename book scopes fields)
(output-scopes scopes fields basename)
(if (ly:get-option 'clip-systems)
(clip-system-EPSes basename book))
(dump-stencils-as-EPSes (map page-stencil
- (ly:paper-book-pages book))
- book
- basename))
+ (ly:paper-book-pages book))
+ book
+ basename))
-; redefine to imports from framework-ps
+ ; redefine to imports from framework-ps
(define convert-to-pdf
convert-to-pdf)
diff --git a/scm/framework-null.scm b/scm/framework-null.scm
index bcc58142e5..9671527185 100644
--- a/scm/framework-null.scm
+++ b/scm/framework-null.scm
@@ -5,16 +5,16 @@
)
(use-modules (ice-9 regex)
- (ice-9 string-fun)
- (guile)
- (srfi srfi-1)
- (ice-9 pretty-print)
- (srfi srfi-13)
- (lily))
+ (ice-9 string-fun)
+ (guile)
+ (srfi srfi-1)
+ (ice-9 pretty-print)
+ (srfi srfi-13)
+ (lily))
(define-public (output-framework channel book scopes fields)
-
+
#t)
(define-public output-classic-framework output-framework)
diff --git a/scm/framework-ps.scm b/scm/framework-ps.scm
index b412ab3269..7a9fb454ff 100644
--- a/scm/framework-ps.scm
+++ b/scm/framework-ps.scm
@@ -20,13 +20,13 @@
;;; this is still too big a mess.
(use-modules (ice-9 string-fun)
- (guile)
- (scm page)
- (scm paper-system)
- (srfi srfi-1)
- (srfi srfi-13)
- (scm clip-region)
- (lily))
+ (guile)
+ (scm page)
+ (scm paper-system)
+ (srfi srfi-1)
+ (srfi srfi-13)
+ (scm clip-region)
+ (lily))
(define format ergonomic-simple-format)
@@ -37,7 +37,7 @@
(define-public (ps-font-command font)
(let* ((name (ly:font-file-name font))
- (magnify (ly:font-magnification font)))
+ (magnify (ly:font-magnification font)))
(string-append
"magfont"
(ly:string-substitute
@@ -45,7 +45,7 @@
(ly:string-substitute
"/" "_"
(ly:string-substitute
- "%" "_" name)))
+ "%" "_" name)))
"m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
(define (ps-define-pango-pf pango-pf font-name scaling)
@@ -76,13 +76,13 @@
(string-append
"/lily-output-units "
- (number->string (/ (ly:bp 1))) " def %% millimeter\n"
+ (number->string (/ (ly:bp 1))) " def %% millimeter\n"
(output-entry "staff-line-thickness" 'line-thickness)
(output-entry "line-width" 'line-width)
(output-entry "paper-size" 'papersizename)
- (output-entry "staff-height" 'staff-height) ;junkme.
+ (output-entry "staff-height" 'staff-height) ;junkme.
"/output-scale "
- (number->string (ly:output-def-lookup layout 'output-scale)) " def\n"
+ (number->string (ly:output-def-lookup layout 'output-scale)) " def\n"
(output-entry "page-height" 'paper-height)
(output-entry "page-width" 'paper-width)))
@@ -93,8 +93,8 @@
(format #f "%%Page: ~a ~a\n" page-number page-number)
"%%BeginPageSetup\n"
(if landscape?
- "page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n"
- "")
+ "page-width output-scale lily-output-units mul mul 0 translate 90 rotate\n"
+ "")
"%%EndPageSetup\n"
"\n"
"true setstrokeadjust\n"
@@ -105,77 +105,77 @@
(define (supplies-or-needs paper load-fonts?)
(define (extract-names font)
(if (ly:pango-font? font)
- (map car (ly:pango-font-physical-fonts font))
- (list (ly:font-name font))))
+ (map car (ly:pango-font-physical-fonts font))
+ (list (ly:font-name font))))
(let* ((fonts (ly:paper-fonts paper))
- (names (apply append (map extract-names fonts))))
+ (names (apply append (map extract-names fonts))))
(apply string-append
- (map (lambda (f)
- (format #f
- (if load-fonts?
- "%%DocumentSuppliedResources: font ~a\n"
- "%%DocumentNeededResources: font ~a\n")
- f))
- (uniq-list (sort names string<?))))))
+ (map (lambda (f)
+ (format #f
+ (if load-fonts?
+ "%%DocumentSuppliedResources: font ~a\n"
+ "%%DocumentNeededResources: font ~a\n")
+ f))
+ (uniq-list (sort names string<?))))))
(define (eps-header paper bbox load-fonts?)
(string-append "%!PS-Adobe-2.0 EPSF-2.0\n"
- "%%Creator: LilyPond " (lilypond-version) "\n"
- "%%BoundingBox: "
- (string-join (map ly:number->string bbox) " ") "\n"
- "%%Orientation: "
- (if (eq? (ly:output-def-lookup paper 'landscape) #t)
- "Landscape\n"
- "Portrait\n")
- (supplies-or-needs paper load-fonts?)
- "%%EndComments\n"))
+ "%%Creator: LilyPond " (lilypond-version) "\n"
+ "%%BoundingBox: "
+ (string-join (map ly:number->string bbox) " ") "\n"
+ "%%Orientation: "
+ (if (eq? (ly:output-def-lookup paper 'landscape) #t)
+ "Landscape\n"
+ "Portrait\n")
+ (supplies-or-needs paper load-fonts?)
+ "%%EndComments\n"))
(define (ps-document-media paper)
(let* ((w (/ (*
- (ly:output-def-lookup paper 'output-scale)
- (ly:output-def-lookup paper 'paper-width)) (ly:bp 1)))
- (h (/ (*
- (ly:output-def-lookup paper 'paper-height)
- (ly:output-def-lookup paper 'output-scale))
- (ly:bp 1)))
- (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
+ (ly:output-def-lookup paper 'output-scale)
+ (ly:output-def-lookup paper 'paper-width)) (ly:bp 1)))
+ (h (/ (*
+ (ly:output-def-lookup paper 'paper-height)
+ (ly:output-def-lookup paper 'output-scale))
+ (ly:bp 1)))
+ (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t)))
(ly:format "%%DocumentMedia: ~a ~2f ~2f ~a ~a ~a\n"
- (ly:output-def-lookup paper 'papersizename)
- (if landscape? h w)
- (if landscape? w h)
- 80 ;; weight
- "()" ;; color
- "()" ;; type
- )))
+ (ly:output-def-lookup paper 'papersizename)
+ (if landscape? h w)
+ (if landscape? w h)
+ 80 ;; weight
+ "()" ;; color
+ "()" ;; type
+ )))
(define (file-header paper page-count load-fonts?)
(string-append "%!PS-Adobe-3.0\n"
- "%%Creator: LilyPond " (lilypond-version) "\n"
- "%%Pages: " (number->string page-count) "\n"
- "%%PageOrder: Ascend\n"
- "%%Orientation: "
- (if (eq? (ly:output-def-lookup paper 'landscape) #t)
- "Landscape\n"
- "Portrait\n")
- (ps-document-media paper)
- (supplies-or-needs paper load-fonts?)
- "%%EndComments\n"))
+ "%%Creator: LilyPond " (lilypond-version) "\n"
+ "%%Pages: " (number->string page-count) "\n"
+ "%%PageOrder: Ascend\n"
+ "%%Orientation: "
+ (if (eq? (ly:output-def-lookup paper 'landscape) #t)
+ "Landscape\n"
+ "Portrait\n")
+ (ps-document-media paper)
+ (supplies-or-needs paper load-fonts?)
+ "%%EndComments\n"))
(define (procset file-name)
(format #f
- "%%BeginResource: procset (~a) 1 0
+ "%%BeginResource: procset (~a) 1 0
~a
%%EndResource
"
- file-name (cached-file-contents file-name)))
+ file-name (cached-file-contents file-name)))
(define (embed-document file-name)
(format #f "%%BeginDocument: ~a
~a
%%EndDocument
"
- file-name (cached-file-contents file-name)))
+ file-name (cached-file-contents file-name)))
(define (setup-variables paper)
(string-append
@@ -189,12 +189,12 @@
(define-public (ps-embed-cff body font-set-name version)
(let* ((binary-data
- (string-append
- (format #f "/~a ~s StartData " font-set-name (string-length body))
- body))
- (header
- (format #f
- "%%BeginResource: font ~a
+ (string-append
+ (format #f "/~a ~s StartData " font-set-name (string-length body))
+ body))
+ (header
+ (format #f
+ "%%BeginResource: font ~a
%!PS-Adobe-3.0 Resource-FontSet
%%DocumentNeededResources: ProcSet (FontSetInit)
%%Title: (FontSet/~a)
@@ -205,70 +205,70 @@
/FontSetInit /ProcSet findresource begin
%%BeginData: ~s Binary Bytes
"
- font-set-name font-set-name version font-set-name
- (string-length binary-data)))
- (footer "\n%%EndData
+ font-set-name font-set-name version font-set-name
+ (string-length binary-data)))
+ (footer "\n%%EndData
%%EndResource
%%EndResource\n"))
(string-append header
- binary-data
- footer)))
+ binary-data
+ footer)))
(define (write-preamble paper load-fonts? port)
(define (internal-font? file-name)
(or (string-startswith file-name "Emmentaler")
- (string-startswith file-name "emmentaler")
- ))
+ (string-startswith file-name "emmentaler")
+ ))
(define (load-font-via-GS font-name-filename)
(define (ps-load-file file-name)
(if (string? file-name)
- (if (string-contains file-name (ly:get-option 'datadir))
- (begin
- (set! file-name (ly:string-substitute (ly:get-option 'datadir)
- "" file-name))
- (format #f
- "lilypond-datadir (~a) concatstrings (r) file .loadfont\n"
- file-name))
- (format #f "(~a) (r) file .loadfont\n" file-name))
- (format #f "% cannot find font file: ~a\n" file-name)))
+ (if (string-contains file-name (ly:get-option 'datadir))
+ (begin
+ (set! file-name (ly:string-substitute (ly:get-option 'datadir)
+ "" file-name))
+ (format #f
+ "lilypond-datadir (~a) concatstrings (r) file .loadfont\n"
+ file-name))
+ (format #f "(~a) (r) file .loadfont\n" file-name))
+ (format #f "% cannot find font file: ~a\n" file-name)))
(let* ((font (car font-name-filename))
- (name (cadr font-name-filename))
- (file-name (caddr font-name-filename))
- (bare-file-name (ly:find-file file-name)))
+ (name (cadr font-name-filename))
+ (file-name (caddr font-name-filename))
+ (bare-file-name (ly:find-file file-name)))
(cons name
- (if (mac-font? bare-file-name)
- (handle-mac-font name bare-file-name)
- (cond
- ((internal-font? file-name)
- (ps-load-file (ly:find-file
- (format #f "~a.otf" file-name))))
- ((string? bare-file-name)
- (ps-load-file file-name))
- (else
- (ly:warning (_ "cannot embed ~S=~S") name file-name)
- ""))))))
+ (if (mac-font? bare-file-name)
+ (handle-mac-font name bare-file-name)
+ (cond
+ ((internal-font? file-name)
+ (ps-load-file (ly:find-file
+ (format #f "~a.otf" file-name))))
+ ((string? bare-file-name)
+ (ps-load-file file-name))
+ (else
+ (ly:warning (_ "cannot embed ~S=~S") name file-name)
+ ""))))))
(define (dir-join a b)
(if (equal? a "")
- b
- (string-append a "/" b)))
+ b
+ (string-append a "/" b)))
(define (dir-listing dir-name)
(define (dir-helper dir lst)
(let ((e (readdir dir)))
- (if (eof-object? e)
- lst
- (dir-helper dir (cons e lst)))))
+ (if (eof-object? e)
+ lst
+ (dir-helper dir (cons e lst)))))
(reverse (dir-helper (opendir dir-name) '())))
(define (handle-mac-font name file-name)
(let* ((dir-name (tmpnam))
- (files '())
- (status 0)
- (embed #f)
- (cwd (getcwd)))
+ (files '())
+ (status 0)
+ (embed #f)
+ (cwd (getcwd)))
(mkdir dir-name #o700)
(chdir dir-name)
(set! status (ly:system (list "fondu" "-force" file-name)))
@@ -276,107 +276,107 @@
(set! files (dir-listing dir-name))
(for-each
(lambda (f)
- (let* ((full-name (dir-join dir-name f)))
- (if (and (not embed)
- (equal? 'regular (stat:type (stat full-name)))
- (equal? name (ly:ttf-ps-name full-name)))
- (set! embed (font-file-as-ps-string name full-name 0)))
- (if (or (equal? "." f)
- (equal? ".." f))
- #t
- (delete-file full-name))))
+ (let* ((full-name (dir-join dir-name f)))
+ (if (and (not embed)
+ (equal? 'regular (stat:type (stat full-name)))
+ (equal? name (ly:ttf-ps-name full-name)))
+ (set! embed (font-file-as-ps-string name full-name 0)))
+ (if (or (equal? "." f)
+ (equal? ".." f))
+ #t
+ (delete-file full-name))))
files)
(rmdir dir-name)
(if (not embed)
- (begin
- (set! embed "% failed\n")
- (ly:warning (_ "cannot extract file matching ~a from ~a")
- name file-name)))
+ (begin
+ (set! embed "% failed\n")
+ (ly:warning (_ "cannot extract file matching ~a from ~a")
+ name file-name)))
embed))
(define (font-file-as-ps-string name file-name font-index)
(let* ((downcase-file-name (string-downcase file-name)))
(cond
((and file-name (string-endswith downcase-file-name ".pfa"))
- (embed-document file-name))
+ (embed-document file-name))
((and file-name (string-endswith downcase-file-name ".pfb"))
- (ly:pfb->pfa file-name))
+ (ly:pfb->pfa file-name))
((and file-name (string-endswith downcase-file-name ".ttf"))
- (ly:ttf->pfa file-name))
+ (ly:ttf->pfa file-name))
((and file-name (string-endswith downcase-file-name ".ttc"))
- (ly:ttf->pfa file-name font-index))
+ (ly:ttf->pfa file-name font-index))
((and file-name (string-endswith downcase-file-name ".otf"))
- (ps-embed-cff (ly:otf->cff file-name) name 0))
+ (ps-embed-cff (ly:otf->cff file-name) name 0))
(else
- (ly:warning (_ "do not know how to embed ~S=~S") name file-name)
- ""))))
+ (ly:warning (_ "do not know how to embed ~S=~S") name file-name)
+ ""))))
(define (mac-font? bare-file-name)
(and (eq? PLATFORM 'darwin)
- bare-file-name
- (or (string-endswith bare-file-name ".dfont")
- (= (stat:size (stat bare-file-name)) 0))))
+ bare-file-name
+ (or (string-endswith bare-file-name ".dfont")
+ (= (stat:size (stat bare-file-name)) 0))))
(define (load-font font-psname-filename-fontindex)
(let* ((font (list-ref font-psname-filename-fontindex 0))
- (name (list-ref font-psname-filename-fontindex 1))
- (file-name (list-ref font-psname-filename-fontindex 2))
- (font-index (list-ref font-psname-filename-fontindex 3))
- (bare-file-name (ly:find-file file-name)))
+ (name (list-ref font-psname-filename-fontindex 1))
+ (file-name (list-ref font-psname-filename-fontindex 2))
+ (font-index (list-ref font-psname-filename-fontindex 3))
+ (bare-file-name (ly:find-file file-name)))
(cons name
- (cond ((mac-font? bare-file-name)
- (handle-mac-font name bare-file-name))
- ((and font (cff-font? font))
- (ps-embed-cff (ly:otf-font-table-data font "CFF ")
- name
- 0))
- (bare-file-name (font-file-as-ps-string
- name bare-file-name font-index))
- (else
- (ly:warning (_ "do not know how to embed font ~s ~s ~s")
- name file-name font))))))
+ (cond ((mac-font? bare-file-name)
+ (handle-mac-font name bare-file-name))
+ ((and font (cff-font? font))
+ (ps-embed-cff (ly:otf-font-table-data font "CFF ")
+ name
+ 0))
+ (bare-file-name (font-file-as-ps-string
+ name bare-file-name font-index))
+ (else
+ (ly:warning (_ "do not know how to embed font ~s ~s ~s")
+ name file-name font))))))
(define (load-fonts paper)
(let* ((fonts (ly:paper-fonts paper))
- ;; todo - doc format of list.
- (all-font-names
- (map
- (lambda (font)
- (cond ((string? (ly:font-file-name font))
- (list (list font
- (ly:font-name font)
- (ly:font-file-name font)
- #f)))
- ((ly:pango-font? font)
- (map (lambda (psname-filename-fontindex)
- (list #f
- (list-ref psname-filename-fontindex 0)
- (list-ref psname-filename-fontindex 1)
- (list-ref psname-filename-fontindex 2)))
- (ly:pango-font-physical-fonts font)))
- (else
- (ly:font-sub-fonts font))))
- fonts))
- (font-names (uniq-list
- (sort (apply append all-font-names)
- (lambda (x y) (string<? (cadr x) (cadr y))))))
-
- ;; slightly spaghetti-ish: deciding what to load where
- ;; is smeared out.
- (font-loader
- (lambda (name)
- (cond ((ly:get-option 'gs-load-fonts)
- (load-font-via-GS name))
- ((ly:get-option 'gs-load-lily-fonts)
- (if (or (string-contains (caddr name)
- (ly:get-option 'datadir))
- (internal-font? (caddr name)))
- (load-font-via-GS name)
- (load-font name)))
- (else
- (load-font name)))))
- (pfas (map font-loader font-names)))
+ ;; todo - doc format of list.
+ (all-font-names
+ (map
+ (lambda (font)
+ (cond ((string? (ly:font-file-name font))
+ (list (list font
+ (ly:font-name font)
+ (ly:font-file-name font)
+ #f)))
+ ((ly:pango-font? font)
+ (map (lambda (psname-filename-fontindex)
+ (list #f
+ (list-ref psname-filename-fontindex 0)
+ (list-ref psname-filename-fontindex 1)
+ (list-ref psname-filename-fontindex 2)))
+ (ly:pango-font-physical-fonts font)))
+ (else
+ (ly:font-sub-fonts font))))
+ fonts))
+ (font-names (uniq-list
+ (sort (apply append all-font-names)
+ (lambda (x y) (string<? (cadr x) (cadr y))))))
+
+ ;; slightly spaghetti-ish: deciding what to load where
+ ;; is smeared out.
+ (font-loader
+ (lambda (name)
+ (cond ((ly:get-option 'gs-load-fonts)
+ (load-font-via-GS name))
+ ((ly:get-option 'gs-load-lily-fonts)
+ (if (or (string-contains (caddr name)
+ (ly:get-option 'datadir))
+ (internal-font? (caddr name)))
+ (load-font-via-GS name)
+ (load-font name)))
+ (else
+ (load-font name)))))
+ (pfas (map font-loader font-names)))
pfas))
@@ -387,10 +387,10 @@
(ly:get-option 'datadir))
(if load-fonts?
(for-each (lambda (f)
- (format port "\n%%BeginFont: ~a\n" (car f))
- (display (cdr f) port)
- (display "%%EndFont\n" port))
- (load-fonts paper)))
+ (format port "\n%%BeginFont: ~a\n" (car f))
+ (display (cdr f) port)
+ (display "%%EndFont\n" port))
+ (load-fonts paper)))
(display (setup-variables paper) port)
;; adobe note 5002: should initialize variables before loading routines.
@@ -400,15 +400,15 @@
(display "%%BeginSetup\ninit-lilypond-parameters\n%%EndSetup\n\n" port))
(define (ps-quote str)
- (fold
- (lambda (replacement-list result)
- (string-join
- (string-split
- result
- (car replacement-list))
- (cadr replacement-list)))
- str
- '((#\\ "\\\\") (#\( "\\(") (#\) "\\)"))))
+ (fold
+ (lambda (replacement-list result)
+ (string-join
+ (string-split
+ result
+ (car replacement-list))
+ (cadr replacement-list)))
+ str
+ '((#\\ "\\\\") (#\( "\\(") (#\) "\\)"))))
;;; Create DOCINFO pdfmark containing metadata
;;; header fields with pdf prefix override those without the prefix
@@ -421,10 +421,10 @@
(ps-quote (ly:encode-string-for-pdf val)))
(define (metadata-lookup-output overridevar fallbackvar field)
(let* ((overrideval (ly:modules-lookup (list header) overridevar))
- (fallbackval (ly:modules-lookup (list header) fallbackvar))
- (val (if overrideval overrideval fallbackval)))
+ (fallbackval (ly:modules-lookup (list header) fallbackvar))
+ (val (if overrideval overrideval fallbackval)))
(if val
- (format port "/~a (~a)\n" field (metadata-encode (markup->string val (list header)))))))
+ (format port "/~a (~a)\n" field (metadata-encode (markup->string val (list header)))))))
(display "[ " port)
(metadata-lookup-output 'pdfcomposer 'composer "Author")
(format port "/Creator (LilyPond ~a)\n" (lilypond-version))
@@ -442,31 +442,31 @@
(define-public (output-framework basename book scopes fields)
(let* ((filename (format #f "~a.ps" basename))
- (outputter (ly:make-paper-outputter
- ;; FIXME: better wrap open/open-file,
- ;; content-mangling is always bad.
- ;; MINGW hack: need to have "b"inary for embedding CFFs
- (open-file filename "wb")
- 'ps))
- (paper (ly:paper-book-paper book))
- (header (ly:paper-book-header book))
- (systems (ly:paper-book-systems book))
- (page-stencils (map page-stencil (ly:paper-book-pages book)))
- (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
- (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
- (page-count (length page-stencils))
- (port (ly:outputter-port outputter)))
+ (outputter (ly:make-paper-outputter
+ ;; FIXME: better wrap open/open-file,
+ ;; content-mangling is always bad.
+ ;; MINGW hack: need to have "b"inary for embedding CFFs
+ (open-file filename "wb")
+ 'ps))
+ (paper (ly:paper-book-paper book))
+ (header (ly:paper-book-header book))
+ (systems (ly:paper-book-systems book))
+ (page-stencils (map page-stencil (ly:paper-book-pages book)))
+ (landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
+ (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
+ (page-count (length page-stencils))
+ (port (ly:outputter-port outputter)))
(if (ly:get-option 'clip-systems)
- (clip-system-EPSes basename book))
+ (clip-system-EPSes basename book))
(if (ly:get-option 'dump-signatures)
- (write-system-signatures basename (ly:paper-book-systems book) 1))
+ (write-system-signatures basename (ly:paper-book-systems book) 1))
(output-scopes scopes fields basename)
(display (file-header paper page-count #t) port)
;; don't do BeginDefaults PageMedia: A4
;; not necessary and wrong
(write-preamble paper #t port)
(if (module? header)
- (handle-metadata header port))
+ (handle-metadata header port))
(for-each
(lambda (page)
(set! page-number (1+ page-number))
@@ -475,68 +475,68 @@
(display "%%Trailer\n%%EOF\n" port)
(ly:outputter-close outputter)
(postprocess-output book framework-ps-module filename
- (ly:output-formats))))
+ (ly:output-formats))))
(define-public (dump-stencil-as-EPS paper dump-me filename
- load-fonts)
+ load-fonts)
(let* ((xext (ly:stencil-extent dump-me X))
- (yext (ly:stencil-extent dump-me Y))
- (padding (ly:get-option 'eps-box-padding))
- (left-overshoot (if (number? padding)
- (* -1 padding (ly:output-def-lookup paper 'mm))
- #f))
- (bbox
- (map
- (lambda (x)
- (if (or (nan? x) (inf? x)
- ;; FIXME: huh?
- (equal? (format #f "~S" x) "+#.#")
- (equal? (format #f "~S" x) "-#.#"))
- 0.0 x))
-
- ;; the left-overshoot is to make sure that
- ;; bar numbers stick out of margin uniformly.
- ;;
- (list
- (if (number? left-overshoot)
- (min left-overshoot (car xext))
- (car xext))
- (car yext) (cdr xext) (cdr yext)))))
+ (yext (ly:stencil-extent dump-me Y))
+ (padding (ly:get-option 'eps-box-padding))
+ (left-overshoot (if (number? padding)
+ (* -1 padding (ly:output-def-lookup paper 'mm))
+ #f))
+ (bbox
+ (map
+ (lambda (x)
+ (if (or (nan? x) (inf? x)
+ ;; FIXME: huh?
+ (equal? (format #f "~S" x) "+#.#")
+ (equal? (format #f "~S" x) "-#.#"))
+ 0.0 x))
+
+ ;; the left-overshoot is to make sure that
+ ;; bar numbers stick out of margin uniformly.
+ ;;
+ (list
+ (if (number? left-overshoot)
+ (min left-overshoot (car xext))
+ (car xext))
+ (car yext) (cdr xext) (cdr yext)))))
(dump-stencil-as-EPS-with-bbox paper dump-me filename load-fonts bbox)))
(define-public (dump-stencil-as-EPS-with-bbox paper dump-me filename
- load-fonts
- bbox)
+ load-fonts
+ bbox)
"Create an EPS file from stencil @var{dump-me} to @var{filename}.
@var{bbox} has format @code{(left-x, lower-y, right-x, upper-y)}. If
@var{load-fonts} set, include fonts inline."
(define (to-rounded-bp-box box)
"Convert box to 1/72 inch with rounding to enlarge the box."
(let* ((scale (ly:output-def-lookup paper 'output-scale))
- (strip-non-number (lambda (x)
- (if (or (nan? x)
- (inf? x))
- 0.0
- x)))
- (directed-round (lambda (x rounder)
- (inexact->exact
- (rounder (/ (* (strip-non-number x) scale)
- (ly:bp 1)))))))
+ (strip-non-number (lambda (x)
+ (if (or (nan? x)
+ (inf? x))
+ 0.0
+ x)))
+ (directed-round (lambda (x rounder)
+ (inexact->exact
+ (rounder (/ (* (strip-non-number x) scale)
+ (ly:bp 1)))))))
(list (directed-round (car box) floor)
- (directed-round (cadr box) floor)
- (directed-round (max (1+ (car box)) (caddr box)) ceiling)
- (directed-round (max (1+ (cadr box)) (cadddr box)) ceiling))))
+ (directed-round (cadr box) floor)
+ (directed-round (max (1+ (car box)) (caddr box)) ceiling)
+ (directed-round (max (1+ (cadr box)) (cadddr box)) ceiling))))
(let* ((outputter (ly:make-paper-outputter
- ;; FIXME: better wrap open/open-file,
- ;; content-mangling is always bad.
- ;; MINGW hack: need to have "b"inary for embedding CFFs
- (open-file (format #f "~a.eps" filename) "wb")
- 'ps))
- (port (ly:outputter-port outputter))
- (rounded-bbox (to-rounded-bp-box bbox))
- (port (ly:outputter-port outputter))
- (header (eps-header paper rounded-bbox load-fonts)))
+ ;; FIXME: better wrap open/open-file,
+ ;; content-mangling is always bad.
+ ;; MINGW hack: need to have "b"inary for embedding CFFs
+ (open-file (format #f "~a.eps" filename) "wb")
+ 'ps))
+ (port (ly:outputter-port outputter))
+ (rounded-bbox (to-rounded-bp-box bbox))
+ (port (ly:outputter-port outputter))
+ (header (eps-header paper rounded-bbox load-fonts)))
(display header port)
(write-preamble paper load-fonts port)
(display "gsave set-ps-scale-to-lily-scale\n" port)
@@ -546,36 +546,36 @@
(define (clip-systems-to-region basename paper systems region do-pdf do-png)
(let* ((extents-system-pairs
- (filtered-map (lambda (paper-system)
- (let* ((x-ext (system-clipped-x-extent
- (paper-system-system-grob paper-system)
- region)))
- (if x-ext
- (cons x-ext paper-system)
- #f)))
- systems))
- (count 0))
+ (filtered-map (lambda (paper-system)
+ (let* ((x-ext (system-clipped-x-extent
+ (paper-system-system-grob paper-system)
+ region)))
+ (if x-ext
+ (cons x-ext paper-system)
+ #f)))
+ systems))
+ (count 0))
(for-each
(lambda (ext-system-pair)
(let* ((xext (car ext-system-pair))
- (paper-system (cdr ext-system-pair))
- (yext (paper-system-extent paper-system Y))
- (bbox (list (car xext) (car yext)
- (cdr xext) (cdr yext)))
- (filename (if (< 0 count)
- (format #f "~a-~a" basename count)
- basename)))
- (set! count (1+ count))
- (dump-stencil-as-EPS-with-bbox paper
- (paper-system-stencil paper-system)
- filename
- (ly:get-option 'include-eps-fonts)
- bbox)
- (if do-pdf
- (postscript->pdf 0 0 (format #f "~a.eps" filename)))
- (if do-png
- (postscript->png (ly:get-option 'resolution) 0 0
- (format #f "~a.eps" filename)))))
+ (paper-system (cdr ext-system-pair))
+ (yext (paper-system-extent paper-system Y))
+ (bbox (list (car xext) (car yext)
+ (cdr xext) (cdr yext)))
+ (filename (if (< 0 count)
+ (format #f "~a-~a" basename count)
+ basename)))
+ (set! count (1+ count))
+ (dump-stencil-as-EPS-with-bbox paper
+ (paper-system-stencil paper-system)
+ filename
+ (ly:get-option 'include-eps-fonts)
+ bbox)
+ (if do-pdf
+ (postscript->pdf 0 0 (format #f "~a.eps" filename)))
+ (if do-png
+ (postscript->png (ly:get-option 'resolution) 0 0
+ (format #f "~a.eps" filename)))))
extents-system-pairs)))
(define-public (clip-system-EPSes basename paper-book)
@@ -586,76 +586,76 @@
(define (clip-score-systems basename systems)
(let* ((layout (ly:grob-layout (paper-system-system-grob (car systems))))
- (regions (ly:output-def-lookup layout 'clip-regions)))
+ (regions (ly:output-def-lookup layout 'clip-regions)))
(for-each
(lambda (region)
- (clip-systems-to-region
- (format #f "~a-from-~a-to-~a-clip"
- basename
- (rhythmic-location->file-string (car region))
- (rhythmic-location->file-string (cdr region)))
- layout systems region
- do-pdf do-png))
+ (clip-systems-to-region
+ (format #f "~a-from-~a-to-~a-clip"
+ basename
+ (rhythmic-location->file-string (car region))
+ (rhythmic-location->file-string (cdr region)))
+ layout systems region
+ do-pdf do-png))
regions)))
;; partition in system lists sharing their layout blocks
(let* ((systems (ly:paper-book-systems paper-book))
- (count 0)
- (score-system-list '()))
+ (count 0)
+ (score-system-list '()))
(fold
(lambda (system last-system)
(if (not (and last-system
- (equal? (paper-system-layout last-system)
- (paper-system-layout system))))
- (set! score-system-list (cons '() score-system-list)))
+ (equal? (paper-system-layout last-system)
+ (paper-system-layout system))))
+ (set! score-system-list (cons '() score-system-list)))
(if (paper-system-layout system)
- (set-car! score-system-list (cons system (car score-system-list))))
+ (set-car! score-system-list (cons system (car score-system-list))))
;; pass value.
system)
#f
systems)
(for-each (lambda (system-list)
- ;; filter out headers and top-level markup
- (if (pair? system-list)
- (clip-score-systems
- (if (> count 0)
- (format #f "~a-~a" basename count)
- basename)
- system-list)))
- score-system-list)))
+ ;; filter out headers and top-level markup
+ (if (pair? system-list)
+ (clip-score-systems
+ (if (> count 0)
+ (format #f "~a-~a" basename count)
+ basename)
+ system-list)))
+ score-system-list)))
(define-public (output-preview-framework basename book scopes fields)
(let* ((paper (ly:paper-book-paper book))
- (systems (relevant-book-systems book))
- (to-dump-systems (relevant-dump-systems systems)))
+ (systems (relevant-book-systems book))
+ (to-dump-systems (relevant-dump-systems systems)))
(dump-stencil-as-EPS paper
- (stack-stencils Y DOWN 0.0
- (map paper-system-stencil
- (reverse to-dump-systems)))
- (format #f "~a.preview" basename)
- #t)
+ (stack-stencils Y DOWN 0.0
+ (map paper-system-stencil
+ (reverse to-dump-systems)))
+ (format #f "~a.preview" basename)
+ #t)
(postprocess-output book framework-ps-module
- (format #f "~a.preview.eps" basename)
- (cons "png" (ly:output-formats)))))
+ (format #f "~a.preview.eps" basename)
+ (cons "png" (ly:output-formats)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (output-width-height defs)
(let* ((landscape (ly:output-def-lookup defs 'landscape))
- (output-scale (ly:output-def-lookup defs 'output-scale))
- (convert (lambda (x)
- (* x output-scale (/ (ly:bp 1)))))
- (paper-width (convert (ly:output-def-lookup defs 'paper-width)))
- (paper-height (convert (ly:output-def-lookup defs 'paper-height)))
- (w (if landscape paper-height paper-width))
- (h (if landscape paper-width paper-height)))
+ (output-scale (ly:output-def-lookup defs 'output-scale))
+ (convert (lambda (x)
+ (* x output-scale (/ (ly:bp 1)))))
+ (paper-width (convert (ly:output-def-lookup defs 'paper-width)))
+ (paper-height (convert (ly:output-def-lookup defs 'paper-height)))
+ (w (if landscape paper-height paper-width))
+ (h (if landscape paper-width paper-height)))
(cons w h)))
(define (output-resolution defs)
(let ((defs-resolution (ly:output-def-lookup defs 'pngresolution)))
(if (number? defs-resolution)
- defs-resolution
- (ly:get-option 'resolution))))
+ defs-resolution
+ (ly:get-option 'resolution))))
(define (output-filename name)
(if (equal? (basename name ".ps") "-")
@@ -664,19 +664,19 @@
(define-public (convert-to-pdf book name)
(let* ((defs (ly:paper-book-paper book))
- (width-height (output-width-height defs))
- (width (car width-height))
- (height (cdr width-height))
- (filename (output-filename name)))
+ (width-height (output-width-height defs))
+ (width (car width-height))
+ (height (cdr width-height))
+ (filename (output-filename name)))
(postscript->pdf width height filename)))
(define-public (convert-to-png book name)
(let* ((defs (ly:paper-book-paper book))
- (resolution (output-resolution defs))
- (width-height (output-width-height defs))
- (width (car width-height))
- (height (cdr width-height))
- (filename (output-filename name)))
+ (resolution (output-resolution defs))
+ (width-height (output-width-height defs))
+ (width (car width-height))
+ (height (cdr width-height))
+ (filename (output-filename name)))
(postscript->png resolution width height filename)))
(define-public (convert-to-ps book name)
diff --git a/scm/framework-scm.scm b/scm/framework-scm.scm
index a47eb185fd..325ef9a0bc 100644
--- a/scm/framework-scm.scm
+++ b/scm/framework-scm.scm
@@ -3,31 +3,31 @@
(define-module (scm framework-scm))
(use-modules
- (ice-9 regex)
- (ice-9 string-fun)
- (guile)
- (srfi srfi-1)
- (ice-9 pretty-print)
- (srfi srfi-13)
- (scm page)
- (lily))
+ (ice-9 regex)
+ (ice-9 string-fun)
+ (guile)
+ (srfi srfi-1)
+ (ice-9 pretty-print)
+ (srfi srfi-13)
+ (scm page)
+ (lily))
(define format ergonomic-simple-format)
(define-public (output-framework basename book scopes fields)
(let* ((file (open-output-file (format #f "~a.scm" basename))))
-
+
(display ";;Creator: LilyPond\n" file)
(display ";; raw SCM output\n" file)
-
+
(for-each
- (lambda (page)
- (display ";;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;PAGE\n" file)
- ;; The following two lines are alternates
- ;(pretty-print (ly:stencil-expr page) file)
- (write (ly:stencil-expr page) file)
- )
- (map page-stencil (ly:paper-book-pages book)))))
+ (lambda (page)
+ (display ";;;;;;;;;;;;;;;;;;;;;;;;;;\n;;;PAGE\n" file)
+ ;; The following two lines are alternates
+ ;(pretty-print (ly:stencil-expr page) file)
+ (write (ly:stencil-expr page) file)
+ )
+ (map page-stencil (ly:paper-book-pages book)))))
(define-public output-classic-framework output-framework)
diff --git a/scm/framework-socket.scm b/scm/framework-socket.scm
index dd54293555..3eaf4710d1 100644
--- a/scm/framework-socket.scm
+++ b/scm/framework-socket.scm
@@ -5,72 +5,72 @@
)
(use-modules (ice-9 regex)
- (ice-9 string-fun)
- (scm paper-system)
- (ice-9 format)
- (guile)
- (srfi srfi-1)
- (ice-9 pretty-print)
- (srfi srfi-13)
- (lily))
+ (ice-9 string-fun)
+ (scm paper-system)
+ (ice-9 format)
+ (guile)
+ (srfi srfi-1)
+ (ice-9 pretty-print)
+ (srfi srfi-13)
+ (lily))
(define (get-page-dimensions paper)
(let* ((landscape (ly:output-def-lookup paper 'landscape))
- (output-scale (ly:output-def-lookup paper 'output-scale))
- (paper-width (ly:output-def-lookup paper 'paper-width))
- (paper-height (ly:output-def-lookup paper 'paper-height))
- (indent (ly:output-def-lookup paper 'indent))
- (line-width (ly:output-def-lookup paper 'line-width))
- (plain-left-margin (ly:output-def-lookup paper 'left-margin))
- (top-margin (ly:output-def-lookup paper 'top-margin))
- (w (if landscape paper-height paper-width))
- (h (if landscape paper-width paper-height))
- (left-margin (if (null? plain-left-margin)
- (/ (- w line-width) 2)
- plain-left-margin))
-;; (list w h left-margin top-margin indent line-width)))
-;; (convert (lambda (x) (* x output-scale (/ (ly:bp 1))))))
- (unit-length (ly:output-def-lookup paper 'output-scale))
- (convert (lambda (x) (* x lily-unit->mm-factor unit-length))))
+ (output-scale (ly:output-def-lookup paper 'output-scale))
+ (paper-width (ly:output-def-lookup paper 'paper-width))
+ (paper-height (ly:output-def-lookup paper 'paper-height))
+ (indent (ly:output-def-lookup paper 'indent))
+ (line-width (ly:output-def-lookup paper 'line-width))
+ (plain-left-margin (ly:output-def-lookup paper 'left-margin))
+ (top-margin (ly:output-def-lookup paper 'top-margin))
+ (w (if landscape paper-height paper-width))
+ (h (if landscape paper-width paper-height))
+ (left-margin (if (null? plain-left-margin)
+ (/ (- w line-width) 2)
+ plain-left-margin))
+ ;; (list w h left-margin top-margin indent line-width)))
+ ;; (convert (lambda (x) (* x output-scale (/ (ly:bp 1))))))
+ (unit-length (ly:output-def-lookup paper 'output-scale))
+ (convert (lambda (x) (* x lily-unit->mm-factor unit-length))))
(map convert (list w h left-margin top-margin indent line-width))))
(define-public (output-framework channel book scopes fields)
(let* ((ctor-arg (if (string? channel)
- (open-output-file (format #f "~a.socket" channel))
- channel))
- (outputter (ly:make-paper-outputter
- ctor-arg
- 'socket))
- (systems (ly:paper-book-systems book))
- (paper (ly:paper-book-paper book))
- (pages (ly:paper-book-pages book)))
+ (open-output-file (format #f "~a.socket" channel))
+ channel))
+ (outputter (ly:make-paper-outputter
+ ctor-arg
+ 'socket))
+ (systems (ly:paper-book-systems book))
+ (paper (ly:paper-book-paper book))
+ (pages (ly:paper-book-pages book)))
(for-each (lambda (x)
- (let* ((system-stencil (paper-system-stencil x))
- (x-extent (ly:stencil-extent system-stencil X))
- (y-extent (ly:stencil-extent system-stencil Y)))
- (display (ly:format "system ~4l ~4l ~4l ~4l\n"
- (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg)
- (ly:outputter-dump-stencil outputter system-stencil)))
- systems)))
+ (let* ((system-stencil (paper-system-stencil x))
+ (x-extent (ly:stencil-extent system-stencil X))
+ (y-extent (ly:stencil-extent system-stencil Y)))
+ (display (ly:format "system ~4l ~4l ~4l ~4l\n"
+ (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg)
+ (ly:outputter-dump-stencil outputter system-stencil)))
+ systems)))
(define-public (output-classic-framework channel book scopes fields)
(let* ((ctor-arg (if (string? channel)
- (open-output-file (format #f "~a.socket" channel))
- channel))
- (outputter (ly:make-paper-outputter
- ctor-arg
- 'socket))
- (systems (ly:paper-book-systems book))
- (paper (ly:paper-book-paper book)))
+ (open-output-file (format #f "~a.socket" channel))
+ channel))
+ (outputter (ly:make-paper-outputter
+ ctor-arg
+ 'socket))
+ (systems (ly:paper-book-systems book))
+ (paper (ly:paper-book-paper book)))
(display (ly:format "paper ~4l\n" (get-page-dimensions paper)) ctor-arg)
(for-each (lambda (x)
- (let* ((system-stencil (paper-system-stencil x))
- (x-extent (ly:stencil-extent system-stencil X))
- (y-extent (ly:stencil-extent system-stencil Y)))
- (display (ly:format "system ~4l ~4l ~4l ~4l\n"
- (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg)
- (ly:outputter-dump-stencil outputter system-stencil)))
- systems)))
+ (let* ((system-stencil (paper-system-stencil x))
+ (x-extent (ly:stencil-extent system-stencil X))
+ (y-extent (ly:stencil-extent system-stencil Y)))
+ (display (ly:format "system ~4l ~4l ~4l ~4l\n"
+ (car x-extent) (car y-extent) (cdr x-extent) (cdr y-extent)) ctor-arg)
+ (ly:outputter-dump-stencil outputter system-stencil)))
+ systems)))
(define-public (convert-to-ps . args) #t)
(define-public (convert-to-pdf . args) #t)
diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm
index 84deff1b5f..dad8bfa0f7 100644
--- a/scm/framework-svg.scm
+++ b/scm/framework-svg.scm
@@ -32,15 +32,15 @@
(define-module (scm framework-svg))
(use-modules
- (guile)
- (lily)
- (scm page)
- (scm paper-system)
- (scm output-svg)
- (srfi srfi-1)
- (srfi srfi-2)
- (srfi srfi-13)
- (ice-9 regex))
+ (guile)
+ (lily)
+ (scm page)
+ (scm paper-system)
+ (scm output-svg)
+ (srfi srfi-1)
+ (srfi srfi-2)
+ (srfi srfi-13)
+ (ice-9 regex))
(define format ergonomic-simple-format)
@@ -52,8 +52,8 @@
`(width . ,(ly:format "~2fmm" (first rest)))
`(height . ,(ly:format "~2fmm" (second rest)))
`(viewBox . ,(ly:format "~4f ~4f ~4f ~4f"
- (third rest) (fourth rest)
- (fifth rest) (sixth rest)))))
+ (third rest) (fourth rest)
+ (fifth rest) (sixth rest)))))
(define (svg-end)
(ec 'svg))
@@ -61,40 +61,40 @@
(define (mkdirs dir-name mode)
(let loop ((dir-name (string-split dir-name #\/)) (root ""))
(if (pair? dir-name)
- (let ((dir (string-append root (car dir-name))))
- (if (not (file-exists? dir))
- (mkdir dir mode))
- (loop (cdr dir-name) (string-append dir "/"))))))
-
+ (let ((dir (string-append root (car dir-name))))
+ (if (not (file-exists? dir))
+ (mkdir dir mode))
+ (loop (cdr dir-name) (string-append dir "/"))))))
+
(define output-dir #f)
(define (svg-define-font font font-name scaling)
(let* ((base-file-name (basename (if (list? font) (pango-pf-file-name font)
- (ly:font-file-name font)) ".otf"))
- (woff-file-name (string-regexp-substitute "([.]otf)?$" ".woff"
- base-file-name))
- (woff-file (or (ly:find-file woff-file-name) "/no-such-file.woff"))
- (url (string-append output-dir "/fonts/" (lilypond-version) "/"
- (basename woff-file-name)))
- (lower-name (string-downcase font-name)))
+ (ly:font-file-name font)) ".otf"))
+ (woff-file-name (string-regexp-substitute "([.]otf)?$" ".woff"
+ base-file-name))
+ (woff-file (or (ly:find-file woff-file-name) "/no-such-file.woff"))
+ (url (string-append output-dir "/fonts/" (lilypond-version) "/"
+ (basename woff-file-name)))
+ (lower-name (string-downcase font-name)))
(if (file-exists? woff-file)
- (begin
- (if (not (file-exists? url))
- (begin
- (ly:message (_ "Updating font into: ~a") url)
- (mkdirs (string-append output-dir "/" (dirname url)) #o700)
- (copy-file woff-file url)
- (ly:progress "\n")))
- (ly:format
- "@font-face {
+ (begin
+ (if (not (file-exists? url))
+ (begin
+ (ly:message (_ "Updating font into: ~a") url)
+ (mkdirs (string-append output-dir "/" (dirname url)) #o700)
+ (copy-file woff-file url)
+ (ly:progress "\n")))
+ (ly:format
+ "@font-face {
font-family: '~a';
font-weight: normal;
font-style: normal;
src: url('~a');
}
"
- font-name url))
- "")))
+ font-name url))
+ "")))
(define (woff-header paper dir)
"TODO:
@@ -115,57 +115,57 @@ src: url('~a');
(define (dump-page paper filename page page-number page-count)
(let* ((outputter (ly:make-paper-outputter (open-file filename "wb") 'svg))
- (dump (lambda (str) (display str (ly:outputter-port outputter))))
- (lookup (lambda (x) (ly:output-def-lookup paper x)))
- (unit-length (lookup 'output-scale))
- (output-scale (* lily-unit->mm-factor unit-length))
- (device-width (lookup 'paper-width))
- (device-height (lookup 'paper-height))
- (page-width (* output-scale device-width))
- (page-height (* output-scale device-height)))
+ (dump (lambda (str) (display str (ly:outputter-port outputter))))
+ (lookup (lambda (x) (ly:output-def-lookup paper x)))
+ (unit-length (lookup 'output-scale))
+ (output-scale (* lily-unit->mm-factor unit-length))
+ (device-width (lookup 'paper-width))
+ (device-height (lookup 'paper-height))
+ (page-width (* output-scale device-width))
+ (page-height (* output-scale device-height)))
(if (ly:get-option 'svg-woff)
- (module-define! (ly:outputter-module outputter) 'paper paper))
+ (module-define! (ly:outputter-module outputter) 'paper paper))
(dump (svg-begin page-width page-height
- 0 0 device-width device-height))
+ 0 0 device-width device-height))
(if (ly:get-option 'svg-woff)
- (module-remove! (ly:outputter-module outputter) 'paper))
+ (module-remove! (ly:outputter-module outputter) 'paper))
(if (ly:get-option 'svg-woff)
- (dump (woff-header paper (dirname filename))))
+ (dump (woff-header paper (dirname filename))))
(dump (comment (format #f "Page: ~S/~S" page-number page-count)))
(ly:outputter-output-scheme outputter
- `(begin (set! lily-unit-length ,unit-length)
- ""))
+ `(begin (set! lily-unit-length ,unit-length)
+ ""))
(ly:outputter-dump-stencil outputter page)
(dump (svg-end))
(ly:outputter-close outputter)))
(define (dump-preview paper stencil filename)
(let* ((outputter (ly:make-paper-outputter (open-file filename "wb") 'svg))
- (dump (lambda (str) (display str (ly:outputter-port outputter))))
- (lookup (lambda (x) (ly:output-def-lookup paper x)))
- (unit-length (lookup 'output-scale))
- (x-extent (ly:stencil-extent stencil X))
- (y-extent (ly:stencil-extent stencil Y))
- (left-x (car x-extent))
- (top-y (cdr y-extent))
- (device-width (interval-length x-extent))
- (device-height (interval-length y-extent))
- (output-scale (* lily-unit->mm-factor unit-length))
- (svg-width (* output-scale device-width))
- (svg-height (* output-scale device-height)))
+ (dump (lambda (str) (display str (ly:outputter-port outputter))))
+ (lookup (lambda (x) (ly:output-def-lookup paper x)))
+ (unit-length (lookup 'output-scale))
+ (x-extent (ly:stencil-extent stencil X))
+ (y-extent (ly:stencil-extent stencil Y))
+ (left-x (car x-extent))
+ (top-y (cdr y-extent))
+ (device-width (interval-length x-extent))
+ (device-height (interval-length y-extent))
+ (output-scale (* lily-unit->mm-factor unit-length))
+ (svg-width (* output-scale device-width))
+ (svg-height (* output-scale device-height)))
(if (ly:get-option 'svg-woff)
- (module-define! (ly:outputter-module outputter) 'paper paper))
+ (module-define! (ly:outputter-module outputter) 'paper paper))
(dump (svg-begin svg-width svg-height
- left-x (- top-y) device-width device-height))
+ left-x (- top-y) device-width device-height))
(if (ly:get-option 'svg-woff)
- (module-remove! (ly:outputter-module outputter) 'paper))
+ (module-remove! (ly:outputter-module outputter) 'paper))
(if (ly:get-option 'svg-woff)
- (dump (woff-header paper (dirname filename))))
+ (dump (woff-header paper (dirname filename))))
(ly:outputter-output-scheme outputter
- `(begin (set! lily-unit-length ,unit-length)
- ""))
+ `(begin (set! lily-unit-length ,unit-length)
+ ""))
(ly:outputter-dump-stencil outputter stencil)
(dump (svg-end))
(ly:outputter-close outputter)))
@@ -173,27 +173,27 @@ src: url('~a');
(define (output-framework basename book scopes fields)
(let* ((paper (ly:paper-book-paper book))
- (page-stencils (map page-stencil (ly:paper-book-pages book)))
- (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
- (page-count (length page-stencils))
- (filename "")
- (file-suffix (lambda (num)
- (if (= page-count 1) "" (format #f "-page-~a" num)))))
+ (page-stencils (map page-stencil (ly:paper-book-pages book)))
+ (page-number (1- (ly:output-def-lookup paper 'first-page-number)))
+ (page-count (length page-stencils))
+ (filename "")
+ (file-suffix (lambda (num)
+ (if (= page-count 1) "" (format #f "-page-~a" num)))))
(for-each
- (lambda (page)
- (set! page-number (1+ page-number))
- (set! filename (format #f "~a~a.svg"
- basename
- (file-suffix page-number)))
- (dump-page paper filename page page-number page-count))
- page-stencils)))
+ (lambda (page)
+ (set! page-number (1+ page-number))
+ (set! filename (format #f "~a~a.svg"
+ basename
+ (file-suffix page-number)))
+ (dump-page paper filename page page-number page-count))
+ page-stencils)))
(define (output-preview-framework basename book scopes fields)
(let* ((paper (ly:paper-book-paper book))
- (systems (relevant-book-systems book))
- (to-dump-systems (relevant-dump-systems systems)))
+ (systems (relevant-book-systems book))
+ (to-dump-systems (relevant-dump-systems systems)))
(dump-preview paper
- (stack-stencils Y DOWN 0.0
- (map paper-system-stencil
- (reverse to-dump-systems)))
- (format #f "~a.preview.svg" basename))))
+ (stack-stencils Y DOWN 0.0
+ (map paper-system-stencil
+ (reverse to-dump-systems)))
+ (format #f "~a.preview.svg" basename))))
diff --git a/scm/fret-diagrams.scm b/scm/fret-diagrams.scm
index 7a6e6febd9..76a1801212 100644
--- a/scm/fret-diagrams.scm
+++ b/scm/fret-diagrams.scm
@@ -21,7 +21,7 @@
"Return the x-extent of a string that goes from start-point
to end-point."
(let ((x1 (car start-point))
- (x2 (car end-point)))
+ (x2 (car end-point)))
(if (> x1 x2)
(cons x2 x1)
(cons x1 x2))))
@@ -30,7 +30,7 @@ to end-point."
"Return the y-extent of a string that goes from start-point
to end-point."
(let ((y1 (cdr start-point))
- (y2 (cdr end-point)))
+ (y2 (cdr end-point)))
(if (> y1 y2)
(cons y2 y1)
(cons y1 y2))))
@@ -61,8 +61,8 @@ to end-point."
(* 6 (/ (log mag) (log 2))))
(define (fret-count fret-range)
- "Calculate the fret count for the diagram given the range of frets in the diagram."
- (1+ (- (cdr fret-range) (car fret-range))))
+ "Calculate the fret count for the diagram given the range of frets in the diagram."
+ (1+ (- (cdr fret-range) (car fret-range))))
(define (subtract-base-fret base-fret dot-list)
"Subtract @var{base-fret} from every fret in @var{dot-list}"
@@ -142,32 +142,32 @@ found."
(define (negate-extent extent)
"Return the extent in an axis opposite to the axis of @code{extent}."
- (cons (- (cdr extent)) (- (car extent))))
+ (cons (- (cdr extent)) (- (car extent))))
(define (stencil-fretboard-extent stencil fretboard-axis orientation)
"Return the extent of @code{stencil} in the @code{fretboard-axis}
direction."
(if (eq? fretboard-axis 'fret)
- (cond ((eq? orientation 'landscape)
- (ly:stencil-extent stencil X))
- ((eq? orientation 'opposing-landscape)
- (negate-extent (ly:stencil-extent stencil X)))
- (else
- (negate-extent (ly:stencil-extent stencil Y))))
- ;; else -- eq? fretboard-axis 'string
- (cond ((eq? orientation 'landscape)
- (ly:stencil-extent stencil Y))
- ((eq? orientation 'opposing-landscape)
- (negate-extent (ly:stencil-extent stencil Y)))
- (else
- (ly:stencil-extent stencil Y)))))
+ (cond ((eq? orientation 'landscape)
+ (ly:stencil-extent stencil X))
+ ((eq? orientation 'opposing-landscape)
+ (negate-extent (ly:stencil-extent stencil X)))
+ (else
+ (negate-extent (ly:stencil-extent stencil Y))))
+ ;; else -- eq? fretboard-axis 'string
+ (cond ((eq? orientation 'landscape)
+ (ly:stencil-extent stencil Y))
+ ((eq? orientation 'opposing-landscape)
+ (negate-extent (ly:stencil-extent stencil Y)))
+ (else
+ (ly:stencil-extent stencil Y)))))
(define (stencil-fretboard-offset stencil fretboard-axis orientation)
- "Return a the stencil coordinates of the center of @code{stencil}
+ "Return a the stencil coordinates of the center of @code{stencil}
in the @code{fretboard-axis} direction."
(* 0.5 (interval-length
- (stencil-fretboard-extent stencil fretboard-axis orientation))))
+ (stencil-fretboard-extent stencil fretboard-axis orientation))))
(define (string-thickness string thickness-factor)
@@ -187,8 +187,8 @@ with magnification @var{mag} of the string @var{text}."
;; markup commands and associated functions
(define (fret-parse-marking-list marking-list my-fret-count)
- "Parse a fret-diagram-verbose marking list into component sublists"
- (let* ((fret-range (cons 1 my-fret-count))
+ "Parse a fret-diagram-verbose marking list into component sublists"
+ (let* ((fret-range (cons 1 my-fret-count))
(capo-fret 0)
(barre-list '())
(dot-list '())
@@ -203,7 +203,7 @@ with magnification @var{mag} of the string @var{text}."
((eq? my-code 'barre)
(set! barre-list (cons* (cdr my-item) barre-list)))
((eq? my-code 'capo)
- (set! capo-fret (cadr my-item)))
+ (set! capo-fret (cadr my-item)))
((eq? my-code 'place-fret)
(set! dot-list (cons* (cdr my-item) dot-list))))
(parse-item (cdr mylist)))))
@@ -243,14 +243,14 @@ with magnification @var{mag} of the string @var{text}."
;; from FretBoard engraver, but not from markup call
(details (merge-details 'fret-diagram-details props '()))
(string-count
- (assoc-get 'string-count details 6)) ;; needed for everything
+ (assoc-get 'string-count details 6)) ;; needed for everything
(my-fret-count
- (assoc-get 'fret-count details 4)) ;; needed for everything
+ (assoc-get 'fret-count details 4)) ;; needed for everything
(orientation
- (assoc-get 'orientation details 'normal)) ;; needed for everything
+ (assoc-get 'orientation details 'normal)) ;; needed for everything
(finger-code
- (assoc-get
- 'finger-code details 'none)) ;; needed for draw-dots and draw-barre
+ (assoc-get
+ 'finger-code details 'none)) ;; needed for draw-dots and draw-barre
(default-dot-radius
(if (eq? finger-code 'in-dot) 0.425 0.25)) ;; bigger dots if labeled
(default-dot-position
@@ -258,21 +258,21 @@ with magnification @var{mag} of the string @var{text}."
(- 0.95 default-dot-radius)
0.6)) ; move up to make room for bigger dot if labeled
(dot-radius
- (assoc-get
- 'dot-radius details default-dot-radius))
- ;; needed for draw-dots and draw-barre
+ (assoc-get
+ 'dot-radius details default-dot-radius))
+ ;; needed for draw-dots and draw-barre
(dot-position
- (assoc-get
- 'dot-position details default-dot-position))
- ;; needed for draw-dots and draw-barre
+ (assoc-get
+ 'dot-position details default-dot-position))
+ ;; needed for draw-dots and draw-barre
(th
- (* (ly:output-def-lookup layout 'line-thickness)
- (chain-assoc-get 'thickness props 0.5)))
- ;; needed for draw-frets and draw-strings
+ (* (ly:output-def-lookup layout 'line-thickness)
+ (chain-assoc-get 'thickness props 0.5)))
+ ;; needed for draw-frets and draw-strings
(sth (* size th))
(thickness-factor (assoc-get 'string-thickness-factor details 0))
(alignment
- (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
+ (chain-assoc-get 'align-dir props -0.4)) ;; needed only here
(xo-padding (assoc-get 'xo-padding details 0.2)) ;; needed only here
(parameters (fret-parse-marking-list marking-list my-fret-count))
(capo-fret (assoc-get 'capo-fret parameters 0))
@@ -282,7 +282,7 @@ with magnification @var{mag} of the string @var{text}."
(my-fret-count (fret-count fret-range))
(barre-list (assoc-get 'barre-list parameters))
(barre-type
- (assoc-get 'barre-type details 'curved))
+ (assoc-get 'barre-type details 'curved))
(fret-diagram-stencil '()))
;; Here are the fret diagram helper functions that depend on the
@@ -293,24 +293,24 @@ with magnification @var{mag} of the string @var{text}."
"Return a pair @code{(x-coordinate . y-coordinate)}
in stencil coordinate system."
(cond
- ((eq? orientation 'landscape)
- (cons fret-coordinate
- (- string-coordinate (1- string-count))))
- ((eq? orientation 'opposing-landscape)
- (cons (- fret-coordinate) (- string-coordinate)))
- (else
- (cons string-coordinate (- fret-coordinate)))))
+ ((eq? orientation 'landscape)
+ (cons fret-coordinate
+ (- string-coordinate (1- string-count))))
+ ((eq? orientation 'opposing-landscape)
+ (cons (- fret-coordinate) (- string-coordinate)))
+ (else
+ (cons string-coordinate (- fret-coordinate)))))
(define (stencil-coordinate-offset fret-offset string-offset)
"Return a pair @code{(x-offset . y-offset)}
for translation in stencil coordinate system."
(cond
- ((eq? orientation 'landscape)
- (cons fret-offset (- string-offset)))
- ((eq? orientation 'opposing-landscape)
- (cons (- fret-offset) string-offset))
- (else
- (cons string-offset (- fret-offset)))))
+ ((eq? orientation 'landscape)
+ (cons fret-offset (- string-offset)))
+ ((eq? orientation 'opposing-landscape)
+ (cons (- fret-offset) string-offset))
+ (else
+ (cons string-offset (- fret-offset)))))
@@ -320,42 +320,42 @@ with magnification @var{mag} of the string @var{text}."
string coordinate @var{start} to string-coordinate @var{stop} with a
baseline at fret coordinate @var{base}, a height of
@var{height}, and a half thickness of @var{half-thickness}."
- (let* ((width (+ (- stop start) 1))
- (cp-left-width (+ (* width half-thickness) start))
- (cp-right-width (- stop (* width half-thickness)))
- (bottom-control-point-height
- (- base (- height half-thickness)))
- (top-control-point-height
- (- base height))
- (left-end-point
- (stencil-coordinates base start))
- (right-end-point
- (stencil-coordinates base stop))
- (left-upper-control-point
- (stencil-coordinates
+ (let* ((width (+ (- stop start) 1))
+ (cp-left-width (+ (* width half-thickness) start))
+ (cp-right-width (- stop (* width half-thickness)))
+ (bottom-control-point-height
+ (- base (- height half-thickness)))
+ (top-control-point-height
+ (- base height))
+ (left-end-point
+ (stencil-coordinates base start))
+ (right-end-point
+ (stencil-coordinates base stop))
+ (left-upper-control-point
+ (stencil-coordinates
top-control-point-height cp-left-width))
- (left-lower-control-point
- (stencil-coordinates
+ (left-lower-control-point
+ (stencil-coordinates
bottom-control-point-height cp-left-width))
- (right-upper-control-point
- (stencil-coordinates
+ (right-upper-control-point
+ (stencil-coordinates
top-control-point-height cp-right-width))
- (right-lower-control-point
- (stencil-coordinates
+ (right-lower-control-point
+ (stencil-coordinates
bottom-control-point-height cp-right-width)))
- ;; order of bezier control points is:
- ;; left cp low, right cp low, right end low, left end low
- ;; right cp high, left cp high, left end high, right end high.
+ ;; order of bezier control points is:
+ ;; left cp low, right cp low, right end low, left end low
+ ;; right cp high, left cp high, left end high, right end high.
- (list left-lower-control-point
- right-lower-control-point
- right-end-point
- left-end-point
- right-upper-control-point
- left-upper-control-point
- left-end-point
- right-end-point)))
+ (list left-lower-control-point
+ right-lower-control-point
+ right-end-point
+ left-end-point
+ right-upper-control-point
+ left-upper-control-point
+ left-end-point
+ right-end-point)))
(define (draw-strings)
"Draw the string lines for a fret diagram with
@@ -365,10 +365,10 @@ Line thickness is given by @var{th}, fret & string spacing by
(define (helper x)
(if (null? (cdr x))
- (string-stencil (car x))
- (ly:stencil-add
(string-stencil (car x))
- (helper (cdr x)))))
+ (ly:stencil-add
+ (string-stencil (car x))
+ (helper (cdr x)))))
(let* ( (string-list (map 1+ (iota string-count))))
(helper string-list)))
@@ -378,17 +378,17 @@ Line thickness is given by @var{th}, fret & string spacing by
overall parameters."
(let* ((string-coordinate (- string-count string))
(current-string-thickness
- (* th size (string-thickness string thickness-factor)))
+ (* th size (string-thickness string thickness-factor)))
(fret-half-thickness (* size th 0.5))
(half-string (* current-string-thickness 0.5))
(start-coordinates
- (stencil-coordinates
- (- fret-half-thickness)
- (- (* size string-coordinate) half-string)))
+ (stencil-coordinates
+ (- fret-half-thickness)
+ (- (* size string-coordinate) half-string)))
(end-coordinates
- (stencil-coordinates
- (+ fret-half-thickness (* size (1+ (fret-count fret-range))))
- (+ half-string (* size string-coordinate)))))
+ (stencil-coordinates
+ (+ fret-half-thickness (* size (1+ (fret-count fret-range))))
+ (+ half-string (* size string-coordinate)))))
(ly:round-filled-box
(string-x-extent start-coordinates end-coordinates)
(string-y-extent start-coordinates end-coordinates)
@@ -401,146 +401,146 @@ Line thickness is given by @var{th}, fret & string spacing by
@var{size}. Orientation is given by @var{orientation}."
(define (helper x)
(if (null? (cdr x))
- (fret-stencil (car x))
- (ly:stencil-add
(fret-stencil (car x))
- (helper (cdr x)))))
+ (ly:stencil-add
+ (fret-stencil (car x))
+ (helper (cdr x)))))
(let ((fret-list (iota (1+ my-fret-count))))
(helper fret-list)))
- (define (fret-stencil fret)
- "Make a stencil for @code{fret}, given the
+ (define (fret-stencil fret)
+ "Make a stencil for @code{fret}, given the
fret-diagram overall parameters."
- (let* ((low-string-half-thickness
- (* 0.5
- size
- th
- (string-thickness string-count thickness-factor)))
- (fret-half-thickness (* 0.5 size th))
- (start-coordinates
- (stencil-coordinates
- (* size fret)
- (- fret-half-thickness low-string-half-thickness)))
- (end-coordinates
- (stencil-coordinates
- (* size fret)
- (* size (1- string-count)))))
- (make-line-stencil
- (* size th)
- (car start-coordinates) (cdr start-coordinates)
- (car end-coordinates) (cdr end-coordinates))))
-
- (define (draw-barre barre-list)
- "Create barre indications for a fret diagram"
- (if (not (null? barre-list))
- (let* ((string1 (caar barre-list))
- (string2 (cadar barre-list))
- (barre-fret (caddar barre-list))
- (top-fret (cdr fret-range))
- (low-fret (car fret-range))
- (fret (1+ (- barre-fret low-fret)))
- (barre-vertical-offset 0.5)
- (dot-center-fret-coordinate (+ (1- fret) dot-position))
- (barre-fret-coordinate
+ (let* ((low-string-half-thickness
+ (* 0.5
+ size
+ th
+ (string-thickness string-count thickness-factor)))
+ (fret-half-thickness (* 0.5 size th))
+ (start-coordinates
+ (stencil-coordinates
+ (* size fret)
+ (- fret-half-thickness low-string-half-thickness)))
+ (end-coordinates
+ (stencil-coordinates
+ (* size fret)
+ (* size (1- string-count)))))
+ (make-line-stencil
+ (* size th)
+ (car start-coordinates) (cdr start-coordinates)
+ (car end-coordinates) (cdr end-coordinates))))
+
+ (define (draw-barre barre-list)
+ "Create barre indications for a fret diagram"
+ (if (not (null? barre-list))
+ (let* ((string1 (caar barre-list))
+ (string2 (cadar barre-list))
+ (barre-fret (caddar barre-list))
+ (top-fret (cdr fret-range))
+ (low-fret (car fret-range))
+ (fret (1+ (- barre-fret low-fret)))
+ (barre-vertical-offset 0.5)
+ (dot-center-fret-coordinate (+ (1- fret) dot-position))
+ (barre-fret-coordinate
(+ dot-center-fret-coordinate
(* (- barre-vertical-offset 0.5) dot-radius)))
- (barre-start-string-coordinate (- string-count string1))
- (barre-end-string-coordinate (- string-count string2))
- (scale-dot-radius (* size dot-radius))
- (barre-type (assoc-get 'barre-type details 'curved))
- (barre-stencil
+ (barre-start-string-coordinate (- string-count string1))
+ (barre-end-string-coordinate (- string-count string2))
+ (scale-dot-radius (* size dot-radius))
+ (barre-type (assoc-get 'barre-type details 'curved))
+ (barre-stencil
(cond
- ((eq? barre-type 'straight)
- (make-straight-barre-stencil
- barre-fret-coordinate
- barre-start-string-coordinate
- barre-end-string-coordinate
- scale-dot-radius))
- ((eq? barre-type 'curved)
- (make-curved-barre-stencil
- barre-fret-coordinate
- barre-start-string-coordinate
- barre-end-string-coordinate
- scale-dot-radius)))))
- (if (not (null? (cdr barre-list)))
- (ly:stencil-add
- barre-stencil
- (draw-barre (cdr barre-list)))
- barre-stencil ))))
-
- (define (make-straight-barre-stencil
- fret-coordinate
- start-string-coordinate
- end-string-coordinate
- half-thickness)
- "Create a straight barre stencil."
- (let ((start-point
- (stencil-coordinates
- (* size fret-coordinate)
- (* size start-string-coordinate)))
- (end-point
- (stencil-coordinates
- (* size fret-coordinate)
- (* size end-string-coordinate))))
- (make-line-stencil
- half-thickness
- (car start-point)
- (cdr start-point)
- (car end-point)
- (cdr end-point))))
-
- (define (make-curved-barre-stencil
- fret-coordinate
- start-string-coordinate
- end-string-coordinate
- half-thickness)
- "Create a curved barre stencil."
- (let* ((bezier-thick 0.1)
- (bezier-height 0.5)
- (bezier-list
- (make-bezier-sandwich-list
- (* size start-string-coordinate)
- (* size end-string-coordinate)
- (* size fret-coordinate)
+ ((eq? barre-type 'straight)
+ (make-straight-barre-stencil
+ barre-fret-coordinate
+ barre-start-string-coordinate
+ barre-end-string-coordinate
+ scale-dot-radius))
+ ((eq? barre-type 'curved)
+ (make-curved-barre-stencil
+ barre-fret-coordinate
+ barre-start-string-coordinate
+ barre-end-string-coordinate
+ scale-dot-radius)))))
+ (if (not (null? (cdr barre-list)))
+ (ly:stencil-add
+ barre-stencil
+ (draw-barre (cdr barre-list)))
+ barre-stencil ))))
+
+ (define (make-straight-barre-stencil
+ fret-coordinate
+ start-string-coordinate
+ end-string-coordinate
+ half-thickness)
+ "Create a straight barre stencil."
+ (let ((start-point
+ (stencil-coordinates
+ (* size fret-coordinate)
+ (* size start-string-coordinate)))
+ (end-point
+ (stencil-coordinates
+ (* size fret-coordinate)
+ (* size end-string-coordinate))))
+ (make-line-stencil
+ half-thickness
+ (car start-point)
+ (cdr start-point)
+ (car end-point)
+ (cdr end-point))))
+
+ (define (make-curved-barre-stencil
+ fret-coordinate
+ start-string-coordinate
+ end-string-coordinate
+ half-thickness)
+ "Create a curved barre stencil."
+ (let* ((bezier-thick 0.1)
+ (bezier-height 0.5)
+ (bezier-list
+ (make-bezier-sandwich-list
+ (* size start-string-coordinate)
+ (* size end-string-coordinate)
+ (* size fret-coordinate)
+ (* size bezier-height)
+ (* size bezier-thick)))
+ (box-lower-left
+ (stencil-coordinates
+ (+ (* size fret-coordinate) half-thickness)
+ (- (* size start-string-coordinate) half-thickness)))
+ (box-upper-right
+ (stencil-coordinates
+ (- (* size fret-coordinate)
(* size bezier-height)
- (* size bezier-thick)))
- (box-lower-left
- (stencil-coordinates
- (+ (* size fret-coordinate) half-thickness)
- (- (* size start-string-coordinate) half-thickness)))
- (box-upper-right
- (stencil-coordinates
- (- (* size fret-coordinate)
- (* size bezier-height)
- half-thickness)
- (+ (* size end-string-coordinate) half-thickness)))
- (x-extent (cons (car box-lower-left) (car box-upper-right)))
- (y-extent (cons (cdr box-lower-left) (cdr box-upper-right))))
- (make-bezier-sandwich-stencil
- bezier-list
- (* size bezier-thick)
- x-extent
- y-extent)))
-
- (define (draw-dots dot-list)
- "Make dots for fret diagram."
-
- (let* ( (scale-dot-radius (* size dot-radius))
+ half-thickness)
+ (+ (* size end-string-coordinate) half-thickness)))
+ (x-extent (cons (car box-lower-left) (car box-upper-right)))
+ (y-extent (cons (cdr box-lower-left) (cdr box-upper-right))))
+ (make-bezier-sandwich-stencil
+ bezier-list
+ (* size bezier-thick)
+ x-extent
+ y-extent)))
+
+ (define (draw-dots dot-list)
+ "Make dots for fret diagram."
+
+ (let* ( (scale-dot-radius (* size dot-radius))
(scale-dot-thick (* size th))
(default-dot-color (assoc-get 'dot-color details 'black))
(finger-label-padding 0.3)
(dot-label-font-mag
- (* scale-dot-radius
- (assoc-get 'dot-label-font-mag details 1.0)))
+ (* scale-dot-radius
+ (assoc-get 'dot-label-font-mag details 1.0)))
(string-label-font-mag
- (* size
- (assoc-get
- 'string-label-font-mag details
- (cond ((or (eq? orientation 'landscape)
- (eq? orientation 'opposing-landscape))
- 0.5)
- (else 0.6)))))
+ (* size
+ (assoc-get
+ 'string-label-font-mag details
+ (cond ((or (eq? orientation 'landscape)
+ (eq? orientation 'opposing-landscape))
+ 0.5)
+ (else 0.6)))))
(mypair (car dot-list))
(restlist (cdr dot-list))
(string (car mypair))
@@ -548,7 +548,7 @@ fret-diagram overall parameters."
(fret-coordinate (* size (+ (1- fret) dot-position)))
(string-coordinate (* size (- string-count string)))
(dot-coordinates
- (stencil-coordinates fret-coordinate string-coordinate))
+ (stencil-coordinates fret-coordinate string-coordinate))
(extent (cons (- scale-dot-radius) scale-dot-radius))
(finger (caddr mypair))
(finger (if (number? finger) (number->string finger) finger))
@@ -558,306 +558,306 @@ fret-diagram overall parameters."
'white
'black))
(dot-stencil (if (eq? dot-color 'white)
- (ly:stencil-add
- (make-circle-stencil
+ (ly:stencil-add
+ (make-circle-stencil
scale-dot-radius scale-dot-thick #t)
- (ly:stencil-in-color
+ (ly:stencil-in-color
(make-circle-stencil
- (- scale-dot-radius (* 0.5 scale-dot-thick))
- 0 #t)
+ (- scale-dot-radius (* 0.5 scale-dot-thick))
+ 0 #t)
1 1 1))
- (make-circle-stencil
- scale-dot-radius scale-dot-thick #t)))
+ (make-circle-stencil
+ scale-dot-radius scale-dot-thick #t)))
(positioned-dot
- (ly:stencil-translate dot-stencil dot-coordinates))
+ (ly:stencil-translate dot-stencil dot-coordinates))
(labeled-dot-stencil
- (cond
- ((or (eq? finger '())(eq? finger-code 'none))
- positioned-dot)
- ((eq? finger-code 'in-dot)
- (let ((finger-label
- (centered-stencil
- (sans-serif-stencil
- layout props dot-label-font-mag finger))))
- (ly:stencil-translate
- (ly:stencil-add
- dot-stencil
- (if (eq? dot-color 'white)
- finger-label
- (ly:stencil-in-color finger-label 1 1 1)))
- dot-coordinates)))
- ((eq? finger-code 'below-string)
- (let* ((label-stencil
- (centered-stencil
- (sans-serif-stencil
- layout props string-label-font-mag
- finger)))
- (label-fret-offset
- (stencil-fretboard-offset
- label-stencil 'fret orientation))
- (label-fret-coordinate
- (+ (* size
- (+ 1 my-fret-count finger-label-padding))
- label-fret-offset))
- (label-string-coordinate string-coordinate)
- (label-translation
- (stencil-coordinates
- label-fret-coordinate
- label-string-coordinate)))
- (ly:stencil-add
- positioned-dot
- (ly:stencil-translate
- label-stencil
- label-translation))))
- (else ;unknown finger-code
- positioned-dot))))
- (if (null? restlist)
- labeled-dot-stencil
- (ly:stencil-add
+ (cond
+ ((or (eq? finger '())(eq? finger-code 'none))
+ positioned-dot)
+ ((eq? finger-code 'in-dot)
+ (let ((finger-label
+ (centered-stencil
+ (sans-serif-stencil
+ layout props dot-label-font-mag finger))))
+ (ly:stencil-translate
+ (ly:stencil-add
+ dot-stencil
+ (if (eq? dot-color 'white)
+ finger-label
+ (ly:stencil-in-color finger-label 1 1 1)))
+ dot-coordinates)))
+ ((eq? finger-code 'below-string)
+ (let* ((label-stencil
+ (centered-stencil
+ (sans-serif-stencil
+ layout props string-label-font-mag
+ finger)))
+ (label-fret-offset
+ (stencil-fretboard-offset
+ label-stencil 'fret orientation))
+ (label-fret-coordinate
+ (+ (* size
+ (+ 1 my-fret-count finger-label-padding))
+ label-fret-offset))
+ (label-string-coordinate string-coordinate)
+ (label-translation
+ (stencil-coordinates
+ label-fret-coordinate
+ label-string-coordinate)))
+ (ly:stencil-add
+ positioned-dot
+ (ly:stencil-translate
+ label-stencil
+ label-translation))))
+ (else ;unknown finger-code
+ positioned-dot))))
+ (if (null? restlist)
+ labeled-dot-stencil
+ (ly:stencil-add
(draw-dots restlist)
labeled-dot-stencil))))
- (define (draw-thick-zero-fret)
- "Draw a thick zeroth fret for a fret diagram whose base fret is 1."
- (let* ((half-lowest-string-thickness
- (* 0.5 th (string-thickness string-count thickness-factor)))
- (half-thick (* 0.5 sth))
- (top-fret-thick
- (* sth (assoc-get 'top-fret-thickness details 3.0)))
- (start-string-coordinate (- half-lowest-string-thickness))
- (end-string-coordinate (+ (* size (1- string-count)) half-thick))
- (start-fret-coordinate half-thick)
- (end-fret-coordinate (- half-thick top-fret-thick))
- (lower-left
- (stencil-coordinates
- start-fret-coordinate start-string-coordinate))
- (upper-right
- (stencil-coordinates
- end-fret-coordinate end-string-coordinate)))
- (ly:round-filled-box
- ;; Put limits in order, or else the intervals are considered empty
- (ordered-cons (car lower-left) (car upper-right))
- (ordered-cons (cdr lower-left) (cdr upper-right))
- sth)))
-
- (define (draw-xo xo-list)
- "Put open and mute string indications on diagram, as contained in
+ (define (draw-thick-zero-fret)
+ "Draw a thick zeroth fret for a fret diagram whose base fret is 1."
+ (let* ((half-lowest-string-thickness
+ (* 0.5 th (string-thickness string-count thickness-factor)))
+ (half-thick (* 0.5 sth))
+ (top-fret-thick
+ (* sth (assoc-get 'top-fret-thickness details 3.0)))
+ (start-string-coordinate (- half-lowest-string-thickness))
+ (end-string-coordinate (+ (* size (1- string-count)) half-thick))
+ (start-fret-coordinate half-thick)
+ (end-fret-coordinate (- half-thick top-fret-thick))
+ (lower-left
+ (stencil-coordinates
+ start-fret-coordinate start-string-coordinate))
+ (upper-right
+ (stencil-coordinates
+ end-fret-coordinate end-string-coordinate)))
+ (ly:round-filled-box
+ ;; Put limits in order, or else the intervals are considered empty
+ (ordered-cons (car lower-left) (car upper-right))
+ (ordered-cons (cdr lower-left) (cdr upper-right))
+ sth)))
+
+ (define (draw-xo xo-list)
+ "Put open and mute string indications on diagram, as contained in
@var{xo-list}."
- (let* ((xo-font-mag
- (assoc-get 'xo-font-magnification details
- (cond ((or (eq? orientation 'landscape)
- (eq? orientation 'opposing-landscape))
- 0.4)
- (else 0.4))))
- (mypair (car xo-list))
- (restlist (cdr xo-list))
- (glyph-string (if (eq? (car mypair) 'mute)
- (assoc-get 'mute-string details "X")
- (assoc-get 'open-string details "O")))
- (glyph-string-coordinate (* (- string-count (cadr mypair)) size))
- (glyph-stencil
- (centered-stencil
- (sans-serif-stencil
- layout props (* size xo-font-mag) glyph-string)))
- (glyph-stencil-coordinates
- (stencil-coordinates 0 glyph-string-coordinate))
- (positioned-glyph
- (ly:stencil-translate
- glyph-stencil
- glyph-stencil-coordinates)))
- (if (null? restlist)
- positioned-glyph
- (ly:stencil-add
+ (let* ((xo-font-mag
+ (assoc-get 'xo-font-magnification details
+ (cond ((or (eq? orientation 'landscape)
+ (eq? orientation 'opposing-landscape))
+ 0.4)
+ (else 0.4))))
+ (mypair (car xo-list))
+ (restlist (cdr xo-list))
+ (glyph-string (if (eq? (car mypair) 'mute)
+ (assoc-get 'mute-string details "X")
+ (assoc-get 'open-string details "O")))
+ (glyph-string-coordinate (* (- string-count (cadr mypair)) size))
+ (glyph-stencil
+ (centered-stencil
+ (sans-serif-stencil
+ layout props (* size xo-font-mag) glyph-string)))
+ (glyph-stencil-coordinates
+ (stencil-coordinates 0 glyph-string-coordinate))
+ (positioned-glyph
+ (ly:stencil-translate
+ glyph-stencil
+ glyph-stencil-coordinates)))
+ (if (null? restlist)
+ positioned-glyph
+ (ly:stencil-add
positioned-glyph
(draw-xo restlist)))))
- (define (draw-capo fret)
- "Draw a capo indicator across the full width of the fret-board
+ (define (draw-capo fret)
+ "Draw a capo indicator across the full width of the fret-board
at @var{fret}."
- (let* ((capo-thick
- (* size (assoc-get 'capo-thickness details 0.5)))
- (half-thick (* capo-thick 0.5))
- (last-string-position 0)
- (first-string-position (* size (- string-count 1)))
- (fret-position ( * size (1- (+ dot-position fret))))
- (start-point
- (stencil-coordinates
- fret-position
- first-string-position))
- (end-point
- (stencil-coordinates
- fret-position
- last-string-position)))
- (make-line-stencil
- capo-thick
- (car start-point) (cdr start-point)
- (car end-point) (cdr end-point))))
-
- (define (label-fret fret-range)
- "Label the base fret on a fret diagram"
- (let* ((base-fret (car fret-range))
- (label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
- (label-space (* 0.5 size))
- (label-dir (assoc-get 'label-dir details RIGHT))
- (label-vertical-offset
- (assoc-get 'fret-label-vertical-offset details 0))
- (number-type
- (assoc-get 'number-type details 'roman-lower))
- (label-text
- (cond
- ((equal? number-type 'roman-lower)
- (fancy-format #f "~(~@r~)" base-fret))
- ((equal? number-type 'roman-upper)
- (fancy-format #f "~@r" base-fret))
- ((equal? 'arabic number-type)
- (fancy-format #f "~d" base-fret))
- ((equal? 'custom number-type)
- (fancy-format #f
- (assoc-get 'fret-label-custom-format
- details "~a")
- base-fret))
- (else (fancy-format #f "~(~@r~)" base-fret))))
- (label-stencil
- (centered-stencil
- (sans-serif-stencil
- layout props (* size label-font-mag) label-text)))
- (label-half-width
- (stencil-fretboard-offset
- label-stencil
- 'string
- orientation))
- (label-outside-diagram (+ label-space label-half-width)))
- (ly:stencil-translate
- label-stencil
+ (let* ((capo-thick
+ (* size (assoc-get 'capo-thickness details 0.5)))
+ (half-thick (* capo-thick 0.5))
+ (last-string-position 0)
+ (first-string-position (* size (- string-count 1)))
+ (fret-position ( * size (1- (+ dot-position fret))))
+ (start-point
(stencil-coordinates
- (* size (+ 1.0 label-vertical-offset))
- (if (eq? label-dir LEFT)
- (- label-outside-diagram)
- (+ (* size (1- string-count)) label-outside-diagram))))))
-
- ;; Here is the body of make-fret-diagram
+ fret-position
+ first-string-position))
+ (end-point
+ (stencil-coordinates
+ fret-position
+ last-string-position)))
+ (make-line-stencil
+ capo-thick
+ (car start-point) (cdr start-point)
+ (car end-point) (cdr end-point))))
+
+ (define (label-fret fret-range)
+ "Label the base fret on a fret diagram"
+ (let* ((base-fret (car fret-range))
+ (label-font-mag (assoc-get 'fret-label-font-mag details 0.5))
+ (label-space (* 0.5 size))
+ (label-dir (assoc-get 'label-dir details RIGHT))
+ (label-vertical-offset
+ (assoc-get 'fret-label-vertical-offset details 0))
+ (number-type
+ (assoc-get 'number-type details 'roman-lower))
+ (label-text
+ (cond
+ ((equal? number-type 'roman-lower)
+ (fancy-format #f "~(~@r~)" base-fret))
+ ((equal? number-type 'roman-upper)
+ (fancy-format #f "~@r" base-fret))
+ ((equal? 'arabic number-type)
+ (fancy-format #f "~d" base-fret))
+ ((equal? 'custom number-type)
+ (fancy-format #f
+ (assoc-get 'fret-label-custom-format
+ details "~a")
+ base-fret))
+ (else (fancy-format #f "~(~@r~)" base-fret))))
+ (label-stencil
+ (centered-stencil
+ (sans-serif-stencil
+ layout props (* size label-font-mag) label-text)))
+ (label-half-width
+ (stencil-fretboard-offset
+ label-stencil
+ 'string
+ orientation))
+ (label-outside-diagram (+ label-space label-half-width)))
+ (ly:stencil-translate
+ label-stencil
+ (stencil-coordinates
+ (* size (+ 1.0 label-vertical-offset))
+ (if (eq? label-dir LEFT)
+ (- label-outside-diagram)
+ (+ (* size (1- string-count)) label-outside-diagram))))))
+
+ ;; Here is the body of make-fret-diagram
(set! fret-diagram-stencil
- (ly:stencil-add (draw-strings) (draw-frets)))
+ (ly:stencil-add (draw-strings) (draw-frets)))
(if (and (not (null? barre-list))
(not (eq? 'none barre-type)))
- (set! fret-diagram-stencil
- (ly:stencil-add
- (draw-barre barre-list)
- fret-diagram-stencil)))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ (draw-barre barre-list)
+ fret-diagram-stencil)))
(if (not (null? dot-list))
- (set! fret-diagram-stencil
- (ly:stencil-add
- fret-diagram-stencil
- (draw-dots dot-list))))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-dots dot-list))))
(if (= (car fret-range) 1)
- (set! fret-diagram-stencil
- (ly:stencil-add
- fret-diagram-stencil
- (draw-thick-zero-fret))))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-thick-zero-fret))))
(if (not (null? xo-list))
- (let* ((diagram-fret-top
- (car (stencil-fretboard-extent
+ (let* ((diagram-fret-top
+ (car (stencil-fretboard-extent
fret-diagram-stencil
'fret
orientation)))
- (xo-stencil (draw-xo xo-list))
- (xo-fret-offset
- (stencil-fretboard-offset
+ (xo-stencil (draw-xo xo-list))
+ (xo-fret-offset
+ (stencil-fretboard-offset
xo-stencil 'fret orientation))
- (xo-stencil-offset
- (stencil-coordinate-offset
- (- diagram-fret-top
- xo-fret-offset
- (* size xo-padding))
- 0)))
- (set! fret-diagram-stencil
- (ly:stencil-add
- fret-diagram-stencil
- (ly:stencil-translate
- xo-stencil
- xo-stencil-offset)))))
+ (xo-stencil-offset
+ (stencil-coordinate-offset
+ (- diagram-fret-top
+ xo-fret-offset
+ (* size xo-padding))
+ 0)))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (ly:stencil-translate
+ xo-stencil
+ xo-stencil-offset)))))
(if (> capo-fret 0)
- (set! fret-diagram-stencil
- (ly:stencil-add
- fret-diagram-stencil
- (draw-capo capo-fret))))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (draw-capo capo-fret))))
(if (> (car fret-range) 1)
- (set! fret-diagram-stencil
- (ly:stencil-add
- fret-diagram-stencil
- (label-fret fret-range))))
+ (set! fret-diagram-stencil
+ (ly:stencil-add
+ fret-diagram-stencil
+ (label-fret fret-range))))
(ly:stencil-aligned-to fret-diagram-stencil X alignment)))
(define (fret-parse-definition-string props definition-string)
- "Parse a fret diagram string and return a pair containing:
+ "Parse a fret diagram string and return a pair containing:
@var{props}, modified as necessary by the definition-string
a fret-indication list with the appropriate values"
- (let* ((fret-count 4)
- (string-count 6)
- (fret-range (cons 1 fret-count))
- (barre-list '())
- (dot-list '())
- (xo-list '())
- (output-list '())
- (new-props '())
- (details (merge-details 'fret-diagram-details props '()))
- (items (string-split definition-string #\;)))
- (let parse-item ((myitems items))
- (if (not (null? (cdr myitems)))
- (let ((test-string (car myitems)))
- (case (car (string->list (substring test-string 0 1)))
- ((#\s) (let ((size (get-numeric-from-key test-string)))
- (set! props (prepend-alist-chain 'size size props))))
- ((#\t) (let ((th (get-numeric-from-key test-string)))
- (set! props (prepend-alist-chain 'thickness th props))))
- ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
- (finger-id (case finger-code
- ((0) 'none)
- ((1) 'in-dot)
- ((2) 'below-string))))
- (set! details
- (acons 'finger-code finger-id details))))
- ((#\c) (set! output-list
- (cons-fret
- (cons
- 'barre
- (numerify
- (string-split (substring test-string 2) #\-)))
- output-list)))
- ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
- (set! details
- (acons 'fret-count fret-count details))))
- ((#\w) (let ((string-count (get-numeric-from-key test-string)))
- (set! details
- (acons 'string-count string-count details))))
- ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
- (set! details
- (acons 'dot-radius dot-size details))))
- ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
- (set! details
- (acons 'dot-position dot-position details))))
- (else
- (let ((this-list (string-split test-string #\-)))
- (if (string->number (cadr this-list))
- (set! output-list
- (cons-fret
- (cons 'place-fret (numerify this-list))
- output-list))
- (if (equal? (cadr this-list) "x" )
- (set! output-list
- (cons-fret
- (list 'mute (string->number (car this-list)))
- output-list))
- (set! output-list
- (cons-fret
- (list 'open (string->number (car this-list)))
- output-list)))))))
- (parse-item (cdr myitems)))))
- ;; add the modified details
- (set! props
- (prepend-alist-chain 'fret-diagram-details details props))
- `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
+ (let* ((fret-count 4)
+ (string-count 6)
+ (fret-range (cons 1 fret-count))
+ (barre-list '())
+ (dot-list '())
+ (xo-list '())
+ (output-list '())
+ (new-props '())
+ (details (merge-details 'fret-diagram-details props '()))
+ (items (string-split definition-string #\;)))
+ (let parse-item ((myitems items))
+ (if (not (null? (cdr myitems)))
+ (let ((test-string (car myitems)))
+ (case (car (string->list (substring test-string 0 1)))
+ ((#\s) (let ((size (get-numeric-from-key test-string)))
+ (set! props (prepend-alist-chain 'size size props))))
+ ((#\t) (let ((th (get-numeric-from-key test-string)))
+ (set! props (prepend-alist-chain 'thickness th props))))
+ ((#\f) (let* ((finger-code (get-numeric-from-key test-string))
+ (finger-id (case finger-code
+ ((0) 'none)
+ ((1) 'in-dot)
+ ((2) 'below-string))))
+ (set! details
+ (acons 'finger-code finger-id details))))
+ ((#\c) (set! output-list
+ (cons-fret
+ (cons
+ 'barre
+ (numerify
+ (string-split (substring test-string 2) #\-)))
+ output-list)))
+ ((#\h) (let ((fret-count (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'fret-count fret-count details))))
+ ((#\w) (let ((string-count (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'string-count string-count details))))
+ ((#\d) (let ((dot-size (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'dot-radius dot-size details))))
+ ((#\p) (let ((dot-position (get-numeric-from-key test-string)))
+ (set! details
+ (acons 'dot-position dot-position details))))
+ (else
+ (let ((this-list (string-split test-string #\-)))
+ (if (string->number (cadr this-list))
+ (set! output-list
+ (cons-fret
+ (cons 'place-fret (numerify this-list))
+ output-list))
+ (if (equal? (cadr this-list) "x" )
+ (set! output-list
+ (cons-fret
+ (list 'mute (string->number (car this-list)))
+ output-list))
+ (set! output-list
+ (cons-fret
+ (list 'open (string->number (car this-list)))
+ output-list)))))))
+ (parse-item (cdr myitems)))))
+ ;; add the modified details
+ (set! props
+ (prepend-alist-chain 'fret-diagram-details details props))
+ `(,props . ,output-list))) ;ugh -- hard-coded spell -- procedure better
(define-public
(fret-parse-terse-definition-string props definition-string)
@@ -866,7 +866,7 @@ return a pair containing:
@var{props}, modified to include the string-count determined by the
definition-string, and
a fret-indication list with the appropriate values"
-;; TODO -- change syntax to fret\string-finger
+ ;; TODO -- change syntax to fret\string-finger
(let* ((details (merge-details 'fret-diagram-details props '()))
(barre-start-list '())
@@ -939,9 +939,9 @@ a fret-indication list with the appropriate values"
(pair?) ; argument type (list, but use pair? for speed)
#:category instrument-specific-markup ; markup type
#:properties ((align-dir -0.4) ; properties and defaults
- (size 1.0)
- (fret-diagram-details)
- (thickness 0.5))
+ (size 1.0)
+ (fret-diagram-details)
+ (thickness 0.5))
"Make a fret diagram containing the symbols indicated in @var{marking-list}.
For example,
diff --git a/scm/graphviz.scm b/scm/graphviz.scm
index 247d30c4a7..fc2076be24 100644
--- a/scm/graphviz.scm
+++ b/scm/graphviz.scm
@@ -20,8 +20,8 @@
#:use-module (lily)
#:export
(make-empty-graph add-node add-edge add-cluster
- graph-write
- ))
+ graph-write
+ ))
(define graph-type (make-record-type "graph" '(nodes edges clusters name)))
@@ -37,21 +37,21 @@
(define (add-cluster graph node-id cluster-name)
(let* ((cs (clusters graph))
- (cluster (assoc cluster-name cs))
- (already-in-cluster (if cluster
- (cdr cluster)
- '())))
+ (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)))))
+ 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)))
+ (string? (car cluster-name)))
+ (add-cluster graph id (car cluster-name)))
id))
(define (add-edge graph node1 node2)
@@ -59,19 +59,19 @@
(define (graph-write graph out)
(let ((ns (nodes graph))
- (es (edges graph))
- (cs (clusters graph)))
+ (es (edges graph))
+ (cs (clusters graph)))
(ly:message (format #f (_ "Writing graph `~a'...") (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)
+ ns)
(for-each (lambda (e) (format out "~a -> ~a\n" (car e) (cdr e)))
- es)
+ es)
(for-each (lambda (c)
- (format out "subgraph cluster_~a {\nlabel= \"~a\"\ncolor=blue\n"
- (string-filter (car c) char-alphabetic?)
- (car c))
- (for-each (lambda (n) (format out "~a\n" n)) (cdr c))
- (display "}\n" out))
- cs)
+ (format out "subgraph cluster_~a {\nlabel= \"~a\"\ncolor=blue\n"
+ (string-filter (car c) char-alphabetic?)
+ (car c))
+ (for-each (lambda (n) (format out "~a\n" n)) (cdr c))
+ (display "}\n" out))
+ cs)
(display "}" out)))
diff --git a/scm/guile-debugger.scm b/scm/guile-debugger.scm
index 8027b4f955..be77f2a48f 100644
--- a/scm/guile-debugger.scm
+++ b/scm/guile-debugger.scm
@@ -31,45 +31,45 @@
#: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))
+ 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)))
+ #:procedure proc
+ #:behaviour debug-trap)))
(define (clear-break! proc)
(uninstall-trap (make <procedure-trap>
- #:procedure proc
- #:behaviour debug-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))))
+ #: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))))
+ #: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))))
+ #: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))))
+ #: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")
diff --git a/scm/harp-pedals.scm b/scm/harp-pedals.scm
index 66f342c0cd..ee0ea419a4 100644
--- a/scm/harp-pedals.scm
+++ b/scm/harp-pedals.scm
@@ -20,8 +20,8 @@
(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))
+ (harp-pedal-details '())
+ (thickness 0.5))
"Make a harp pedal diagram.
Possible elements in @var{definition-string}:
@@ -132,15 +132,15 @@ It contains the following settings: @code{box-offset}
;; Parse the harp pedal definition string into list of directions (-1/0/1), #\o and #\|
(define (harp-pedals-parse-string definition-string)
- "Parse a harp pedals diagram string and return a list containing 1, 0, -1, #\\o or #\\|"
+ "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 definition-string)))
+ (case c
+ ((#\^) 1)
+ ((#\v) -1)
+ ((#\-) 0)
+ ((#\| #\o) c)
+ (else c)))
+ (string->list definition-string)))
;; Analyze the pedal-list: Return (pedalcount . (divider positions))
@@ -149,23 +149,23 @@ It contains the following settings: @code{box-offset}
(pedalcount 0)
(dividerpositions '()))
(if (null? pedals)
- (cons pedalcount (reverse dividerpositions))
+ (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))))))
+ (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:
+ ; 7 pedals:
(if (not (equal? (car info) 7))
- (ly:warning "Harp pedal diagram contains ~a pedals rather than the usual 7." (car info)))
- ; One divider after third pedal:
+ (ly:warning "Harp pedal diagram contains ~a pedals rather than the usual 7." (car info)))
+ ; One divider after third pedal:
(if (null? (cdr info))
- (ly:warning "Harp pedal diagram does not contain a divider (usually after third pedal).")
- (if (not (equal? (cdr info) '(3)))
- (ly:warning "Harp pedal diagram contains dividers at positions ~a. Normally, there is only one divider after the third pedal." (cdr info))))))
+ (ly:warning "Harp pedal diagram does not contain a divider (usually after third pedal).")
+ (if (not (equal? (cdr info) '(3)))
+ (ly:warning "Harp pedal diagram contains dividers at positions ~a. Normally, there is only one divider after the third pedal." (cdr info))))))
diff --git a/scm/layout-beam.scm b/scm/layout-beam.scm
index f72afacf0d..fe4fa4df43 100644
--- a/scm/layout-beam.scm
+++ b/scm/layout-beam.scm
@@ -18,57 +18,57 @@
(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)
+ "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 (_ "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))))
+ (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 (_ "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 (_ "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))))
+ "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 (_ "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))))
+ 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))))
+ grob
+ (beam::place-broken-parts-individually grob))))
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 48ee33cf50..b334517de1 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -84,35 +84,35 @@
;; durations
(define-public (duration-log-factor lognum)
-"Given a logarithmic duration number, return the length of the duration,
+ "Given a logarithmic duration number, return the length of the duration,
as a number of whole notes."
(or (and (exact? lognum) (integer? lognum))
- (scm-error 'wrong-type-arg "duration-log-factor" "Not an integer: ~S" (list lognum) #f))
+ (scm-error 'wrong-type-arg "duration-log-factor" "Not an integer: ~S" (list lognum) #f))
(if (<= lognum 0)
- (ash 1 (- lognum))
- (/ (ash 1 lognum))))
+ (ash 1 (- lognum))
+ (/ (ash 1 lognum))))
(define-public (duration-dot-factor dotcount)
-"Given a count of the dots used to extend a musical duration, return
+ "Given a count of the dots used to extend a musical duration, return
the numeric factor by which they increase the duration."
(or (and (exact? dotcount) (integer? dotcount) (>= dotcount 0))
- (scm-error 'wrong-type-arg "duration-dot-factor" "Not a count: ~S" (list dotcount) #f))
+ (scm-error 'wrong-type-arg "duration-dot-factor" "Not a count: ~S" (list dotcount) #f))
(- 2 (/ (ash 1 dotcount))))
(define-public (duration-length dur)
-"Return the overall length of a duration, as a number of whole notes.
+ "Return the overall length of a duration, as a number of whole notes.
(Not to be confused with ly:duration-length, which returns a less-useful
-moment object.)"
+ moment object.)"
(ly:moment-main (ly:duration-length dur)))
(define-public (duration-visual dur)
-"Given a duration object, return the visual part of the duration (base
+ "Given a duration object, return the visual part of the duration (base
note length and dot count), in the form of a duration object with
non-visual scale factor 1."
(ly:make-duration (ly:duration-log dur) (ly:duration-dot-count dur) 1))
(define-public (duration-visual-length dur)
-"Given a duration object, return the length of the visual part of the
+ "Given a duration object, return the length of the visual part of the
duration (base note length and dot count), as a number of whole notes."
(duration-length (duration-visual dur)))
@@ -128,15 +128,15 @@ duration (base note length and dot count), as a number of whole notes."
"Toplevel book-part handler."
(define (add-bookpart book-part)
(ly:parser-define!
- parser 'toplevel-bookparts
- (cons book-part (ly:parser-lookup parser 'toplevel-bookparts))))
+ parser 'toplevel-bookparts
+ (cons book-part (ly:parser-lookup parser 'toplevel-bookparts))))
;; If toplevel scores have been found before this \bookpart,
;; add them first to a dedicated bookpart
(if (pair? (ly:parser-lookup parser 'toplevel-scores))
(begin
- (add-bookpart (ly:make-book-part
- (ly:parser-lookup parser 'toplevel-scores)))
- (ly:parser-define! parser 'toplevel-scores (list))))
+ (add-bookpart (ly:make-book-part
+ (ly:parser-lookup parser 'toplevel-scores)))
+ (ly:parser-define! parser 'toplevel-scores (list))))
(add-bookpart book-part))
(define-public (collect-scores-for-book parser score)
@@ -148,7 +148,7 @@ duration (base note length and dot count), as a number of whole notes."
(define (music-property symbol)
(ly:music-property music symbol #f))
(cond ((music-property 'page-marker)
- ;; a page marker: set page break/turn permissions or label
+ ;; a page marker: set page break/turn permissions or label
(let ((label (music-property 'page-label)))
(if (symbol? label)
(score-handler (ly:make-page-label-marker label))))
@@ -163,23 +163,23 @@ duration (base note length and dot count), as a number of whole notes."
'(line-break-permission page-break-permission
page-turn-permission)))
((not (music-property 'void))
- ;; a regular music expression: make a score with this music
- ;; void music is discarded
- (score-handler (scorify-music music parser)))))
+ ;; a regular music expression: make a score with this music
+ ;; void music is discarded
+ (score-handler (scorify-music music parser)))))
(define-public (collect-music-for-book parser music)
"Top-level music handler."
(collect-music-aux (lambda (score)
- (collect-scores-for-book parser score))
+ (collect-scores-for-book parser score))
parser
- music))
+ music))
(define-public (collect-book-music-for-book parser book music)
"Book music handler."
(collect-music-aux (lambda (score)
- (ly:book-add-score! book score))
+ (ly:book-add-score! book score))
parser
- music))
+ music))
(define-public (scorify-music music parser)
"Preprocess @var{music}."
@@ -199,8 +199,8 @@ calls to bookOutputName function"
bookoutput function"
(let ((book-output-suffix (paper-variable parser book 'output-suffix)))
(if (not (string? book-output-suffix))
- (ly:parser-lookup parser 'output-suffix)
- book-output-suffix)))
+ (ly:parser-lookup parser 'output-suffix)
+ book-output-suffix)))
(define-public current-outfile-name #f) ; for use by regression tests
@@ -210,11 +210,11 @@ bookoutput function"
;; the file-name concatenated with any potential output-suffix value
;; as the key to out internal a-list
(let* ((base-name (get-current-filename parser book))
- (output-suffix (get-current-suffix parser book))
- (alist-key (format #f "~a~a" base-name output-suffix))
- (counter-alist (ly:parser-lookup parser 'counter-alist))
- (output-count (assoc-get alist-key counter-alist 0))
- (result base-name))
+ (output-suffix (get-current-suffix parser book))
+ (alist-key (format #f "~a~a" base-name output-suffix))
+ (counter-alist (ly:parser-lookup parser 'counter-alist))
+ (output-count (assoc-get alist-key counter-alist 0))
+ (result base-name))
;; Allow all ASCII alphanumerics, including accents
(if (string? output-suffix)
(set! result
@@ -237,8 +237,8 @@ bookoutput function"
(define (print-book-with parser book process-procedure)
(let* ((paper (ly:parser-lookup parser '$defaultpaper))
- (layout (ly:parser-lookup parser '$defaultlayout))
- (outfile-name (get-outfile-name parser book)))
+ (layout (ly:parser-lookup parser '$defaultlayout))
+ (outfile-name (get-outfile-name parser book)))
(process-procedure book paper layout outfile-name)))
(define-public (print-book-with-defaults parser book)
@@ -249,89 +249,89 @@ bookoutput function"
;; Add a score to the current bookpart, book or toplevel
(define-public (add-score parser score)
- (cond
- ((ly:parser-lookup parser '$current-bookpart)
- ((ly:parser-lookup parser 'bookpart-score-handler)
- (ly:parser-lookup parser '$current-bookpart) score))
- ((ly:parser-lookup parser '$current-book)
- ((ly:parser-lookup parser 'book-score-handler)
- (ly:parser-lookup parser '$current-book) score))
- (else
- ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
+ (cond
+ ((ly:parser-lookup parser '$current-bookpart)
+ ((ly:parser-lookup parser 'bookpart-score-handler)
+ (ly:parser-lookup parser '$current-bookpart) score))
+ ((ly:parser-lookup parser '$current-book)
+ ((ly:parser-lookup parser 'book-score-handler)
+ (ly:parser-lookup parser '$current-book) score))
+ (else
+ ((ly:parser-lookup parser 'toplevel-score-handler) parser score))))
(define-public paper-variable
(let
((get-papers
- (lambda (parser book)
- (append (if (and book (ly:output-def? (ly:book-paper book)))
- (list (ly:book-paper book))
- '())
- (ly:parser-lookup parser '$papers)
- (list (ly:parser-lookup parser '$defaultpaper))))))
+ (lambda (parser book)
+ (append (if (and book (ly:output-def? (ly:book-paper book)))
+ (list (ly:book-paper book))
+ '())
+ (ly:parser-lookup parser '$papers)
+ (list (ly:parser-lookup parser '$defaultpaper))))))
(make-procedure-with-setter
(lambda (parser book symbol)
(any (lambda (p) (ly:output-def-lookup p symbol #f))
- (get-papers parser book)))
+ (get-papers parser book)))
(lambda (parser book symbol value)
(ly:output-def-set-variable!
- (car (get-papers parser book))
- symbol value)))))
+ (car (get-papers parser book))
+ symbol value)))))
(define-public (add-text parser text)
(add-score parser (list text)))
(define-public (add-music parser music)
(collect-music-aux (lambda (score)
- (add-score parser score))
+ (add-score parser score))
parser
- music))
+ music))
(define-public (context-mod-from-music parser music)
(let ((warn #t) (mods (ly:make-context-mod)))
(let loop ((m music))
(if (music-is-of-type? m 'layout-instruction-event)
- (let ((symbol (ly:music-property m 'symbol)))
- (ly:add-context-mod
- mods
- (case (ly:music-property m 'name)
- ((PropertySet)
- (list 'assign
- symbol
- (ly:music-property m 'value)))
- ((PropertyUnset)
- (list 'unset symbol))
- ((OverrideProperty)
- (cons* 'push
- symbol
- (ly:music-property m 'grob-value)
+ (let ((symbol (ly:music-property m 'symbol)))
+ (ly:add-context-mod
+ mods
+ (case (ly:music-property m 'name)
+ ((PropertySet)
+ (list 'assign
+ symbol
+ (ly:music-property m 'value)))
+ ((PropertyUnset)
+ (list 'unset symbol))
+ ((OverrideProperty)
+ (cons* 'push
+ symbol
+ (ly:music-property m 'grob-value)
(cond
((ly:music-property m 'grob-property #f) => list)
(else
(ly:music-property m 'grob-property-path)))))
((RevertProperty)
- (cons* 'pop
- symbol
+ (cons* 'pop
+ symbol
(cond
((ly:music-property m 'grob-property #f) => list)
(else
(ly:music-property m 'grob-property-path))))))))
- (case (ly:music-property m 'name)
- ((ApplyContext)
- (ly:add-context-mod mods
- (list 'apply
- (ly:music-property m 'procedure))))
- ((ContextSpeccedMusic)
- (loop (ly:music-property m 'element)))
- (else
- (let ((callback (ly:music-property m 'elements-callback)))
- (if (procedure? callback)
- (for-each loop (callback m))
- (if (and warn (ly:duration? (ly:music-property m 'duration)))
- (begin
- (ly:music-warning
- music
- (_ "Music unsuitable for context-mod"))
- (set! warn #f)))))))))
+ (case (ly:music-property m 'name)
+ ((ApplyContext)
+ (ly:add-context-mod mods
+ (list 'apply
+ (ly:music-property m 'procedure))))
+ ((ContextSpeccedMusic)
+ (loop (ly:music-property m 'element)))
+ (else
+ (let ((callback (ly:music-property m 'elements-callback)))
+ (if (procedure? callback)
+ (for-each loop (callback m))
+ (if (and warn (ly:duration? (ly:music-property m 'duration)))
+ (begin
+ (ly:music-warning
+ music
+ (_ "Music unsuitable for context-mod"))
+ (set! warn #f)))))))))
mods))
(define-public (context-defs-from-music parser output-def music)
@@ -345,64 +345,64 @@ bookoutput function"
;; context modification results in a reasonably recognizable
;; error.
(if (music-is-of-type? m 'layout-instruction-event)
- (ly:add-context-mod
- mods
- (case (ly:music-property m 'name)
- ((PropertySet)
- (list 'assign
- (ly:music-property m 'symbol)
- (ly:music-property m 'value)))
- ((PropertyUnset)
- (list 'unset
- (ly:music-property m 'symbol)))
- ((OverrideProperty)
- (cons* 'push
- (ly:music-property m 'symbol)
- (ly:music-property m 'grob-value)
+ (ly:add-context-mod
+ mods
+ (case (ly:music-property m 'name)
+ ((PropertySet)
+ (list 'assign
+ (ly:music-property m 'symbol)
+ (ly:music-property m 'value)))
+ ((PropertyUnset)
+ (list 'unset
+ (ly:music-property m 'symbol)))
+ ((OverrideProperty)
+ (cons* 'push
+ (ly:music-property m 'symbol)
+ (ly:music-property m 'grob-value)
(cond
((ly:music-property m 'grob-property #f) => list)
(else
(ly:music-property m 'grob-property-path)))))
- ((RevertProperty)
- (cons* 'pop
- (ly:music-property m 'symbol)
+ ((RevertProperty)
+ (cons* 'pop
+ (ly:music-property m 'symbol)
(cond
((ly:music-property m 'grob-property #f) => list)
(else
(ly:music-property m 'grob-property-path)))))))
- (case (ly:music-property m 'name)
- ((ApplyContext)
- (ly:add-context-mod mods
- (list 'apply
- (ly:music-property m 'procedure))))
- ((ContextSpeccedMusic)
- ;; Use let* here to let defs catch up with modifications
- ;; to the context defs made in the recursion
- (let* ((mods (loop (ly:music-property m 'element)
- (ly:make-context-mod)))
- (defs (ly:output-find-context-def
- output-def (ly:music-property m 'context-type))))
- (if (null? defs)
- (ly:music-warning
- music
- (ly:format (_ "Cannot find context-def \\~a")
- (ly:music-property m 'context-type)))
- (for-each
- (lambda (entry)
- (ly:output-def-set-variable!
- output-def (car entry)
- (ly:context-def-modify (cdr entry) mods)))
- defs))))
- (else
- (let ((callback (ly:music-property m 'elements-callback)))
- (if (procedure? callback)
- (fold loop mods (callback m))
- (if (and warn (ly:duration? (ly:music-property m 'duration)))
- (begin
- (ly:music-warning
- music
- (_ "Music unsuitable for output-def"))
- (set! warn #f))))))))
+ (case (ly:music-property m 'name)
+ ((ApplyContext)
+ (ly:add-context-mod mods
+ (list 'apply
+ (ly:music-property m 'procedure))))
+ ((ContextSpeccedMusic)
+ ;; Use let* here to let defs catch up with modifications
+ ;; to the context defs made in the recursion
+ (let* ((mods (loop (ly:music-property m 'element)
+ (ly:make-context-mod)))
+ (defs (ly:output-find-context-def
+ output-def (ly:music-property m 'context-type))))
+ (if (null? defs)
+ (ly:music-warning
+ music
+ (ly:format (_ "Cannot find context-def \\~a")
+ (ly:music-property m 'context-type)))
+ (for-each
+ (lambda (entry)
+ (ly:output-def-set-variable!
+ output-def (car entry)
+ (ly:context-def-modify (cdr entry) mods)))
+ defs))))
+ (else
+ (let ((callback (ly:music-property m 'elements-callback)))
+ (if (procedure? callback)
+ (fold loop mods (callback m))
+ (if (and warn (ly:duration? (ly:music-property m 'duration)))
+ (begin
+ (ly:music-warning
+ music
+ (_ "Music unsuitable for output-def"))
+ (set! warn #f))))))))
mods)))
@@ -416,26 +416,26 @@ bookoutput function"
(define-public (uniqued-alist alist acc)
(if (null? alist) acc
(if (assoc (caar alist) acc)
- (uniqued-alist (cdr alist) acc)
- (uniqued-alist (cdr alist) (cons (car alist) acc)))))
+ (uniqued-alist (cdr alist) acc)
+ (uniqued-alist (cdr alist) (cons (car alist) acc)))))
(define-public (alist<? x y)
(string<? (symbol->string (car x))
- (symbol->string (car y))))
+ (symbol->string (car y))))
(define (map-alist-vals func list)
"map FUNC over the vals of LIST, leaving the keys."
(if (null? list)
'()
(cons (cons (caar list) (func (cdar list)))
- (map-alist-vals func (cdr list)))))
+ (map-alist-vals func (cdr list)))))
(define (map-alist-keys func list)
"map FUNC over the keys of an alist LIST, leaving the vals."
(if (null? list)
'()
(cons (cons (func (caar list)) (cdar list))
- (map-alist-keys func (cdr list)))))
+ (map-alist-keys func (cdr list)))))
(define-public (first-member members lst)
"Return first successful member (of member) from @var{members} in
@@ -450,8 +450,8 @@ bookoutput function"
(if (null? alist)
'()
(cons (caar alist)
- (cons (cdar alist)
- (flatten-alist (cdr alist))))))
+ (cons (cdar alist)
+ (flatten-alist (cdr alist))))))
(define (assoc-remove key alist)
"Remove key (and its corresponding value) from an alist.
@@ -473,19 +473,19 @@ For example:
@code{guile> (map-selected-alist-keys - '(a b) '((a . 1) (b . -2) (c . 3) (d . 4)))}
@code{((a . -1) (b . 2) (c . 3) (d . 4)}
@end example"
- (define (map-selected-alist-keys-helper function key alist)
- (map
+ (define (map-selected-alist-keys-helper function key alist)
+ (map
(lambda (pair)
(if (equal? key (car pair))
(cons key (function (cdr pair)))
pair))
alist))
- (if (null? keys)
- alist
- (map-selected-alist-keys
- function
- (cdr keys)
- (map-selected-alist-keys-helper function (car keys) alist))))
+ (if (null? keys)
+ alist
+ (map-selected-alist-keys
+ function
+ (cdr keys)
+ (map-selected-alist-keys-helper function (car keys) alist))))
;;;;;;;;;;;;;;;;
;; vector
@@ -523,13 +523,13 @@ For example:
(define (helper todo acc-vector k)
(if (null? todo)
- acc-vector
- (begin
- (if (< k 0)
- (set! k (+ n k)))
+ acc-vector
+ (begin
+ (if (< k 0)
+ (set! k (+ n k)))
- (vector-set! acc-vector k (cons (car todo) (vector-ref acc-vector k)))
- (helper (cdr todo) acc-vector (1- k)))))
+ (vector-set! acc-vector k (cons (car todo) (vector-ref acc-vector k)))
+ (helper (cdr todo) acc-vector (1- k)))))
(helper lst (make-vector n '()) (1- n)))
@@ -546,10 +546,10 @@ For example:
(fold-right
(lambda (elem prev)
- (if (pair? prev)
- (cons elem (cons intermediate prev))
- (list elem)))
- '() lst))
+ (if (pair? prev)
+ (cons elem (cons intermediate prev))
+ (list elem)))
+ '() lst))
(define-public (filtered-map proc lst)
(filter
@@ -573,12 +573,12 @@ for comparisons."
(reverse!
(fold (lambda (x acc)
- (if (null? acc)
- (list x)
- (if (equal? x (car acc))
- acc
- (cons x acc))))
- '() lst) '()))
+ (if (null? acc)
+ (list x)
+ (if (equal? x (car acc))
+ acc
+ (cons x acc))))
+ '() lst) '()))
(define (split-at-predicate pred lst)
"Split LST into two lists at the first element that returns #f for
@@ -608,20 +608,20 @@ executing @samp{(split-list-by-separator '(a 0 b c 1 d) number?)} returns
(define-public (offset-add a b)
(cons (+ (car a) (car b))
- (+ (cdr a) (cdr b))))
+ (+ (cdr a) (cdr b))))
(define-public (offset-flip-y o)
(cons (car o) (- (cdr o))))
(define-public (offset-scale o scale)
(cons (* (car o) scale)
- (* (cdr o) scale)))
+ (* (cdr o) scale)))
(define-public (ly:list->offsets accum coords)
(if (null? coords)
accum
(cons (cons (car coords) (cadr coords))
- (ly:list->offsets accum (cddr coords)))))
+ (ly:list->offsets accum (cddr coords)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; intervals
@@ -637,7 +637,7 @@ executing @samp{(split-list-by-separator '(a 0 b c 1 d) number?)} returns
(define-public (ordered-cons a b)
(cons (min a b)
- (max a b)))
+ (max a b)))
(define-public (interval-bound interval dir)
((if (= dir RIGHT) cdr car) interval))
@@ -647,7 +647,7 @@ executing @samp{(split-list-by-separator '(a 0 b c 1 d) number?)} returns
right (@var{dir}=+1)."
(* (+ (interval-start interval) (interval-end interval)
- (* dir (- (interval-end interval) (interval-start interval))))
+ (* dir (- (interval-end interval) (interval-start interval))))
0.5))
(define-public (interval-center x)
@@ -665,31 +665,31 @@ right (@var{dir}=+1)."
(define-public (interval-scale iv factor)
(cons (* (car iv) factor)
- (* (cdr iv) factor)))
+ (* (cdr iv) factor)))
(define-public (interval-widen iv amount)
(cons (- (car iv) amount)
- (+ (cdr iv) amount)))
+ (+ (cdr iv) amount)))
(define-public (interval-empty? iv)
- (> (car iv) (cdr iv)))
+ (> (car iv) (cdr iv)))
(define-public (interval-union i1 i2)
(cons
- (min (car i1) (car i2))
- (max (cdr i1) (cdr i2))))
+ (min (car i1) (car i2))
+ (max (cdr i1) (cdr i2))))
(define-public (interval-intersection i1 i2)
- (cons
- (max (car i1) (car i2))
- (min (cdr i1) (cdr i2))))
+ (cons
+ (max (car i1) (car i2))
+ (min (cdr i1) (cdr i2))))
(define-public (interval-sane? i)
(not (or (nan? (car i))
- (inf? (car i))
- (nan? (cdr i))
- (inf? (cdr i))
- (> (car i) (cdr i)))))
+ (inf? (car i))
+ (nan? (cdr i))
+ (inf? (cdr i))
+ (> (car i) (cdr i)))))
(define-public (add-point interval p)
(cons (min (interval-start interval) p)
@@ -706,19 +706,19 @@ right (@var{dir}=+1)."
(define (coord-operation operator operand coordinate)
(if (pair? operand)
- (cons (operator (coord-x operand) (coord-x coordinate))
- (operator (coord-y operand) (coord-y coordinate)))
- (cons (operator operand (coord-x coordinate))
- (operator operand (coord-y coordinate)))))
+ (cons (operator (coord-x operand) (coord-x coordinate))
+ (operator (coord-y operand) (coord-y coordinate)))
+ (cons (operator operand (coord-x coordinate))
+ (operator operand (coord-y coordinate)))))
(define (coord-apply function coordinate)
(if (pair? function)
- (cons
- ((coord-x function) (coord-x coordinate))
- ((coord-y function) (coord-y coordinate)))
- (cons
- (function (coord-x coordinate))
- (function (coord-y coordinate)))))
+ (cons
+ ((coord-x function) (coord-x coordinate))
+ ((coord-y function) (coord-y coordinate)))
+ (cons
+ (function (coord-x coordinate))
+ (function (coord-y coordinate)))))
(define-public (coord-translate coordinate amount)
(coord-operation + amount coordinate))
@@ -728,16 +728,16 @@ right (@var{dir}=+1)."
(define-public (coord-rotate coordinate degrees-in-radians)
(let*
- ((coordinate
- (cons
- (exact->inexact (coord-x coordinate))
- (exact->inexact (coord-y coordinate))))
- (radius
- (sqrt
- (+ (* (coord-x coordinate) (coord-x coordinate))
- (* (coord-y coordinate) (coord-y coordinate)))))
- (angle (angle-0-2pi (atan (coord-y coordinate) (coord-x coordinate)))))
- (cons
+ ((coordinate
+ (cons
+ (exact->inexact (coord-x coordinate))
+ (exact->inexact (coord-y coordinate))))
+ (radius
+ (sqrt
+ (+ (* (coord-x coordinate) (coord-x coordinate))
+ (* (coord-y coordinate) (coord-y coordinate)))))
+ (angle (angle-0-2pi (atan (coord-y coordinate) (coord-x coordinate)))))
+ (cons
(* radius (cos (+ angle degrees-in-radians)))
(* radius (sin (+ angle degrees-in-radians))))))
@@ -776,31 +776,31 @@ right (@var{dir}=+1)."
(define-public (ellipse-radius x-radius y-radius angle)
(/
- (* x-radius y-radius)
- (sqrt
- (+ (* (expt y-radius 2)
- (* (cos angle) (cos angle)))
- (* (expt x-radius 2)
- (* (sin angle) (sin angle)))))))
+ (* x-radius y-radius)
+ (sqrt
+ (+ (* (expt y-radius 2)
+ (* (cos angle) (cos angle)))
+ (* (expt x-radius 2)
+ (* (sin angle) (sin angle)))))))
(define-public (polar->rectangular radius angle-in-degrees)
"Return polar coordinates (@var{radius}, @var{angle-in-degrees})
as rectangular coordinates @ode{(x-length . y-length)}."
(let ((complex (make-polar
- radius
- (degrees->radians angle-in-degrees))))
- (cons
- (real-part complex)
- (imag-part complex))))
+ radius
+ (degrees->radians angle-in-degrees))))
+ (cons
+ (real-part complex)
+ (imag-part complex))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; string
(define-public (string-endswith s suffix)
(equal? suffix (substring s
- (max 0 (- (string-length s) (string-length suffix)))
- (string-length s))))
+ (max 0 (- (string-length s) (string-length suffix)))
+ (string-length s))))
(define-public (string-startswith s prefix)
(equal? prefix (substring s 0 (min (string-length s) (string-length prefix)))))
@@ -810,8 +810,8 @@ as rectangular coordinates @ode{(x-length . y-length)}."
((= i 0) "o")
((< i 0) (string-append "n" (string-encode-integer (- i))))
(else (string-append
- (make-string 1 (integer->char (+ 65 (modulo i 26))))
- (string-encode-integer (quotient i 26))))))
+ (make-string 1 (integer->char (+ 65 (modulo i 26))))
+ (string-encode-integer (quotient i 26))))))
(define (number->octal-string x)
(let* ((n (inexact->exact x))
@@ -828,14 +828,14 @@ as rectangular coordinates @ode{(x-length . y-length)}."
(define-public (ly:number-pair->string c)
(string-append (ly:number->string (car c)) " "
- (ly:number->string (cdr c))))
+ (ly:number->string (cdr c))))
(define-public (dir-basename file . rest)
"Strip suffixes in @var{rest}, but leave directory component for
@var{file}."
(define (inverse-basename x y) (basename y x))
(simple-format #f "~a/~a" (dirname file)
- (fold inverse-basename file rest)))
+ (fold inverse-basename file rest)))
(define-public (write-me message x)
"Return @var{x}. Display @var{message} and write @var{x}.
@@ -864,8 +864,8 @@ Handy for debugging, possibly turned off."
"Create new list, inserting @var{between} between elements of @var{lst}."
(define (conc x y )
(if (eq? y #f)
- (list x)
- (cons x (cons between y))))
+ (list x)
+ (cons x (cons between y))))
(fold-right conc #f lst))
(define-public (string-regexp-substitute a b str)
@@ -877,9 +877,9 @@ Handy for debugging, possibly turned off."
(define (notice match)
(set! matches (cons (substring (match:string match)
- end-of-prev-match
- (match:start match))
- matches))
+ end-of-prev-match
+ (match:start match))
+ matches))
(set! end-of-prev-match (match:end match)))
(regexp-substitute/global #f regex str notice 'post)
@@ -889,7 +889,7 @@ Handy for debugging, possibly turned off."
matches
(cons (substring str end-of-prev-match (string-length str)) matches)))
- (reverse matches))
+ (reverse matches))
;;;;;;;;;;;;;;;;
;; other
@@ -906,13 +906,13 @@ applied to function @var{getter}.")
(if (<= end start)
start
(let* ((compare (quotient (+ start end) 2))
- (get-val (getter compare)))
- (cond
- ((< target-val get-val)
- (set! end (1- compare)))
- ((< get-val target-val)
- (set! start (1+ compare))))
- (binary-search start end getter target-val))))
+ (get-val (getter compare)))
+ (cond
+ ((< target-val get-val)
+ (set! end (1- compare)))
+ ((< get-val target-val)
+ (set! start (1+ compare))))
+ (binary-search start end getter target-val))))
(define-public (car< a b)
(< (car a) (car b)))
@@ -932,7 +932,7 @@ in module @var{module}. In that case evaluate, otherwise
print a warning and set an optional @var{default}."
(let* ((unavailable? (lambda (sym)
(not (module-defined? module sym))))
- (sym-unavailable
+ (sym-unavailable
(filter
unavailable?
(filter symbol? (flatten-list symbol)))))
@@ -940,10 +940,10 @@ print a warning and set an optional @var{default}."
(eval symbol module)
(let* ((def (and (pair? default) (car default))))
(ly:programming-error
- "cannot evaluate ~S in module ~S, setting to ~S"
- (object->string symbol)
- (object->string module)
- (object->string def))
+ "cannot evaluate ~S in module ~S, setting to ~S"
+ (object->string symbol)
+ (object->string module)
+ (object->string def))
def))))
;;
@@ -951,18 +951,18 @@ print a warning and set an optional @var{default}."
;;
(define-public (scm->string val)
(if (and (procedure? val)
- (symbol? (procedure-name val)))
+ (symbol? (procedure-name val)))
(symbol->string (procedure-name val))
(string-append
(if (self-evaluating? val)
- (if (string? val)
- "\""
- "")
- "'")
+ (if (string? val)
+ "\""
+ "")
+ "'")
(call-with-output-string (lambda (port) (display val port)))
(if (string? val)
- "\""
- ""))))
+ "\""
+ ""))))
(define-public (!= lst r)
(not (= lst r)))
@@ -981,13 +981,13 @@ print a warning and set an optional @var{default}."
(if (string? font)
(string-downcase font)
(let* ((font-name (ly:font-name font))
- (full-name (if font-name font-name (ly:font-file-name font))))
- (string-downcase full-name))))
+ (full-name (if font-name font-name (ly:font-file-name font))))
+ (string-downcase full-name))))
(define-public (modified-font-metric-font-scaling font)
(let* ((designsize (ly:font-design-size font))
- (magnification (* (ly:font-magnification font)))
- (scaling (* magnification designsize)))
+ (magnification (* (ly:font-magnification font)))
+ (scaling (* magnification designsize)))
(debugf "scaling:~S\n" scaling)
(debugf "magnification:~S\n" magnification)
(debugf "design:~S\n" designsize)
@@ -995,6 +995,6 @@ print a warning and set an optional @var{default}."
(define-public (version-not-seen-message input-file-name)
(ly:warning-located
- (ly:format "~a:1" input-file-name)
- (_ "no \\version statement found, please add~afor future compatibility")
- (format #f "\n\n\\version ~s\n\n" (lilypond-version))))
+ (ly:format "~a:1" input-file-name)
+ (_ "no \\version statement found, please add~afor future compatibility")
+ (format #f "\n\n\\version ~s\n\n" (lilypond-version))))
diff --git a/scm/lily-sort.scm b/scm/lily-sort.scm
index 19fba423d4..95d3e33ffb 100644
--- a/scm/lily-sort.scm
+++ b/scm/lily-sort.scm
@@ -68,14 +68,14 @@
((null? a) (cons #f (car b)))
((null? b) (cons (car a) #f))
((not ((if ci char-ci=? char=?) (car a) (car b)))
- (cons (car a) (car b)))
+ (cons (car a) (car b)))
(else (find-mismatch (cdr a) (cdr b))))))
(define (ly:string-generic-<? a b ci)
(let ((mismatch (first-diff-chars a b ci)))
(cond ((and mismatch (car mismatch) (cdr mismatch))
- ((if ci ly:char-ci<? ly:char<?)
- (car mismatch) (cdr mismatch)))
+ ((if ci ly:char-ci<? ly:char<?)
+ (car mismatch) (cdr mismatch)))
((and mismatch (cdr mismatch)) #t)
(else #f))))
diff --git a/scm/lily.scm b/scm/lily.scm
index 2028f1c20e..f227adc5b9 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -120,13 +120,13 @@ variables in the current module as well as those defined with
ignore @var{thunk} and instead just reinitialize all recorded
variables to their value after the initial call of @var{thunk}."
-;; We need to save the variables of the current module along with
-;; their values: functions defined in the module might refer to the
-;; variables.
+ ;; We need to save the variables of the current module along with
+ ;; their values: functions defined in the module might refer to the
+ ;; variables.
-;; The entries in lilypond-declarations consist of a cons* consisting
-;; of symbol, variable, and value. Variables defined with
-;; define-session have the symbol set to #f.
+ ;; The entries in lilypond-declarations consist of a cons* consisting
+ ;; of symbol, variable, and value. Variables defined with
+ ;; define-session have the symbol set to #f.
(if (ly:undead? lilypond-declarations)
(begin
@@ -169,7 +169,7 @@ variables to their value after the initial call of @var{thunk}."
;; be longer than 48 characters per line.
(anti-alias-factor 1
-"Render at higher resolution
+ "Render at higher resolution
(using given factor) and scale down result to prevent jaggies in
PNG images.")
(aux-files
@@ -379,7 +379,7 @@ messages into errors.")
(scm clip-region)
(scm memory-trace)
(scm coverage)
- (scm safe-utility-defs))
+ (scm safe-utility-defs))
(define-public _ gettext)
;;; There are new modules defined in Guile V2.0 which we need to use.
@@ -389,11 +389,11 @@ messages into errors.")
;;
(cond
- ((guile-v2)
- (ly:debug (_ "Using (ice-9 curried-definitions) module\n"))
- (use-modules (ice-9 curried-definitions)))
- (else
- (ly:debug (_ "Guile 1.8\n"))))
+ ((guile-v2)
+ (ly:debug (_ "Using (ice-9 curried-definitions) module\n"))
+ (use-modules (ice-9 curried-definitions)))
+ (else
+ (ly:debug (_ "Guile 1.8\n"))))
;; TODO add in modules for V1.8.7 deprecated in V2.0 and integrated
;; into Guile base code, like (ice-9 syncase).
@@ -469,8 +469,8 @@ messages into errors.")
(if (string-index x #\\)
x
(string-regexp-substitute
- "//*" "/"
- (string-regexp-substitute "\\\\" "/" x))))
+ "//*" "/"
+ (string-regexp-substitute "\\\\" "/" x))))
(define-public (ly-getcwd)
(if (eq? PLATFORM 'windows)
@@ -588,7 +588,7 @@ messages into errors.")
"x11-color.scm"))
;; - Files to be loaded last
(define init-scheme-files-tail
-;; - must be after everything has been defined
+ ;; - must be after everything has been defined
'("safe-lily.scm"))
;;
;; Now construct the load list
@@ -643,7 +643,7 @@ messages into errors.")
(define-public guile-predicates
`((,hash-table? . "hash table")
- ))
+ ))
(define-public lilypond-scheme-predicates
`((,boolean-or-symbol? . "boolean or symbol")
@@ -777,10 +777,10 @@ messages into errors.")
(lambda (a b)
(< (object-address (car a))
(object-address (car b))))))
- (out-file-name (string-append
- "gcstat-" (number->string gc-protect-stat-count)
- ".scm"))
- (outfile (open-file out-file-name "w")))
+ (out-file-name (string-append
+ "gcstat-" (number->string gc-protect-stat-count)
+ ".scm"))
+ (outfile (open-file out-file-name "w")))
(set! gc-dumping #t)
(ly:progress "Dumping GC statistics ~a...\n" out-file-name)
(for-each (lambda (y)
@@ -810,13 +810,13 @@ messages into errors.")
(ly:set-option 'debug-gc-assert-parsed-dead #t)
(gc)
(ly:set-option 'debug-gc-assert-parsed-dead #f)
- (for-each
- (lambda (x)
- (if (not (hashq-ref gc-zombies x))
- (begin
- (ly:programming-error "Parsed object should be dead: ~a" x)
- (hashq-set! gc-zombies x #t))))
- (ly:parsed-undead-list!))
+ (for-each
+ (lambda (x)
+ (if (not (hashq-ref gc-zombies x))
+ (begin
+ (ly:programming-error "Parsed object should be dead: ~a" x)
+ (hashq-set! gc-zombies x #t))))
+ (ly:parsed-undead-list!))
(set! stats (gc-live-object-stats))
(ly:progress "Dumping live object statistics.\n")
(dump-live-object-stats outfile)))
@@ -862,9 +862,9 @@ PIDs or the number of the process."
(define (helper count acc)
(if (> count 0)
(let* ((pid (primitive-fork)))
- (if (= pid 0)
- (1- count)
- (helper (1- count) (cons pid acc))))
+ (if (= pid 0)
+ (1- count)
+ (helper (1- count) (cons pid acc))))
acc))
(helper count '()))
@@ -916,7 +916,7 @@ PIDs or the number of the process."
(begin (ly:set-option
'log-file (format #f "~a-~a"
(ly:get-option 'log-file) joblist))
- (set! files (vector-ref split-todo joblist)))
+ (set! files (vector-ref split-todo joblist)))
(begin (ly:progress "\nForking into jobs: ~a\n" joblist)
(for-each
(lambda (pid)
@@ -924,7 +924,7 @@ PIDs or the number of the process."
(if (not (= stat 0))
(set! errors
(acons (list-element-index joblist pid)
- stat errors)))))
+ stat errors)))))
joblist)
(for-each
(lambda (x)
@@ -943,17 +943,17 @@ PIDs or the number of the process."
(ly:message
(_ "logfile ~a (exit ~a):\n~a")
logfile (status:exit-val state) tail))))
- errors)
- (if (pair? errors)
- (ly:error "Children ~a exited with errors."
- (map car errors)))
- ;; must overwrite individual entries
- (if (ly:get-option 'dump-profile)
- (dump-profile "lily-run-total"
- '(0 0) (profile-measurements)))
- (if (null? errors)
- (ly:exit 0 #f)
- (ly:exit 1 #f))))))
+ errors)
+ (if (pair? errors)
+ (ly:error "Children ~a exited with errors."
+ (map car errors)))
+ ;; must overwrite individual entries
+ (if (ly:get-option 'dump-profile)
+ (dump-profile "lily-run-total"
+ '(0 0) (profile-measurements)))
+ (if (null? errors)
+ (ly:exit 0 #f)
+ (ly:exit 1 #f))))))
(if (string-or-symbol? (ly:get-option 'log-file))
(ly:stderr-redirect (format #f "~a.log" (ly:get-option 'log-file)) "w"))
diff --git a/scm/ly-syntax-constructors.scm b/scm/ly-syntax-constructors.scm
index 7817ec25c5..5f1583589b 100644
--- a/scm/ly-syntax-constructors.scm
+++ b/scm/ly-syntax-constructors.scm
@@ -35,9 +35,9 @@
;; report errors.
(defmacro define-ly-syntax-simple (args . body)
`(define-public ,(cons* (car args)
- 'parser
- 'location
- (cdr args))
+ 'parser
+ 'location
+ (cdr args))
(let ((m ,(cons 'begin body)))
(set! (ly:music-property m 'origin) location)
m)))
@@ -51,29 +51,29 @@
;; fallback.
(define-ly-syntax (music-function parser loc fun args . rest)
(let* ((sig (ly:music-function-signature fun))
- (pred (if (pair? (car sig)) (caar sig) (car sig)))
- (good (proper-list? args))
- (m (and good (apply (ly:music-function-extract fun)
- parser loc (reverse! args rest)))))
+ (pred (if (pair? (car sig)) (caar sig) (car sig)))
+ (good (proper-list? args))
+ (m (and good (apply (ly:music-function-extract fun)
+ parser loc (reverse! args rest)))))
(if (and good (pred m))
- (begin
- (if (ly:music? m)
- (set! (ly:music-property m 'origin) loc))
- m)
- (begin
- (if good
- (ly:parser-error parser
- (format #f (_ "~a function cannot return ~a")
- (type-name pred) m)
- loc))
- (and (pair? (car sig)) (cdar sig))))))
+ (begin
+ (if (ly:music? m)
+ (set! (ly:music-property m 'origin) loc))
+ m)
+ (begin
+ (if good
+ (ly:parser-error parser
+ (format #f (_ "~a function cannot return ~a")
+ (type-name pred) m)
+ loc))
+ (and (pair? (car sig)) (cdar sig))))))
(define-ly-syntax (argument-error parser location n pred arg)
(ly:parser-error
parser
(format #f
- (_ "wrong type for argument ~a. Expecting ~a, found ~s")
- n (type-name pred) arg)
+ (_ "wrong type for argument ~a. Expecting ~a, found ~s")
+ n (type-name pred) arg)
location))
(define-ly-syntax-simple (void-music)
@@ -87,16 +87,16 @@
(define-ly-syntax-simple (event-chord mlist)
(make-music 'EventChord
- 'elements mlist))
+ 'elements mlist))
(define-ly-syntax-simple (unrelativable-music mus)
(make-music 'UnrelativableMusic
- 'element mus))
+ 'element mus))
(define-ly-syntax-simple (context-change type id)
(make-music 'ContextChange
- 'change-to-type type
- 'change-to-id id))
+ 'change-to-type type
+ 'change-to-id id))
(define-ly-syntax-simple (voice-separator)
(make-music 'VoiceSeparator))
@@ -106,32 +106,32 @@
(define-ly-syntax (tempo parser location text . rest)
(let* ((unit (and (pair? rest)
- (car rest)))
- (count (and unit
- (cadr rest)))
- (range-tempo? (pair? count))
- (tempo-change (make-music 'TempoChangeEvent
- 'origin location
- 'text text
- 'tempo-unit unit
- 'metronome-count count))
- (tempo-set
- (and unit
- (context-spec-music
- (make-property-set 'tempoWholesPerMinute
- (ly:moment-mul
- (ly:make-moment
- (if range-tempo?
- (round (/ (+ (car count) (cdr count))
- 2))
- count)
- 1)
- (ly:duration-length unit)))
- 'Score))))
+ (car rest)))
+ (count (and unit
+ (cadr rest)))
+ (range-tempo? (pair? count))
+ (tempo-change (make-music 'TempoChangeEvent
+ 'origin location
+ 'text text
+ 'tempo-unit unit
+ 'metronome-count count))
+ (tempo-set
+ (and unit
+ (context-spec-music
+ (make-property-set 'tempoWholesPerMinute
+ (ly:moment-mul
+ (ly:make-moment
+ (if range-tempo?
+ (round (/ (+ (car count) (cdr count))
+ 2))
+ count)
+ 1)
+ (ly:duration-length unit)))
+ 'Score))))
(if tempo-set
- (make-sequential-music (list tempo-change tempo-set))
- tempo-change)))
+ (make-sequential-music (list tempo-change tempo-set))
+ tempo-change)))
(define-ly-syntax-simple (repeat type num body alts)
(make-repeat type num body alts))
@@ -142,35 +142,35 @@ into a @code{MultiMeasureTextEvent}."
(if (memq 'script-event (ly:music-property music 'types))
(apply make-music 'MultiMeasureTextEvent
- (flatten-alist (ly:music-mutable-properties music)))
+ (flatten-alist (ly:music-mutable-properties music)))
music))
(define-ly-syntax (multi-measure-rest parser location duration articulations)
(make-music 'MultiMeasureRestMusic
- 'articulations (map script-to-mmrest-text articulations)
- 'duration duration
- 'origin location))
+ 'articulations (map script-to-mmrest-text articulations)
+ 'duration duration
+ 'origin location))
(define-ly-syntax (repetition-chord parser location duration articulations)
(make-music 'EventChord
- 'duration duration
- 'elements articulations
- 'origin location))
+ 'duration duration
+ 'elements articulations
+ 'origin location))
(define-ly-syntax-simple (context-specification type id ops create-new mus)
(let* ((type-sym (if (symbol? type) type (string->symbol type)))
- (csm (context-spec-music mus type-sym id)))
+ (csm (context-spec-music mus type-sym id)))
(set! (ly:music-property csm 'property-operations) ops)
(if create-new (set! (ly:music-property csm 'create-new) #t))
csm))
(define-ly-syntax (composed-markup-list parser location commands markups)
-;; `markups' being a list of markups, eg (markup1 markup2 markup3),
-;; and `commands' a list of commands with their scheme arguments, in reverse order,
-;; eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
-;; ((bold (raise 4 (italic markup1)))
-;; (bold (raise 4 (italic markup2)))
-;; (bold (raise 4 (italic markup3))))
+ ;; `markups' being a list of markups, eg (markup1 markup2 markup3),
+ ;; and `commands' a list of commands with their scheme arguments, in reverse order,
+ ;; eg: ((italic) (raise 4) (bold)), maps the commands on each markup argument, eg:
+ ;; ((bold (raise 4 (italic markup1)))
+ ;; (bold (raise 4 (italic markup2)))
+ ;; (bold (raise 4 (italic markup3))))
(define (compose arg)
(fold
@@ -193,37 +193,37 @@ into a @code{MultiMeasureTextEvent}."
(define-ly-syntax (property-operation parser location ctx music-type symbol . args)
(let* ((props (case music-type
- ((PropertySet) (list 'value (car args)))
- ((PropertyUnset) '())
- ((OverrideProperty) (list 'grob-value (car args)
- 'grob-property-path (if (list? (cadr args))
- (cadr args)
- (cdr args))
- 'pop-first #t))
- ((RevertProperty)
- (if (list? (car args))
- (list 'grob-property-path (car args))
- (list 'grob-property-path args)))
- (else (ly:error (_ "Invalid property operation ~a") music-type))))
- (m (apply make-music music-type
- 'symbol symbol
- 'origin location
- props)))
+ ((PropertySet) (list 'value (car args)))
+ ((PropertyUnset) '())
+ ((OverrideProperty) (list 'grob-value (car args)
+ 'grob-property-path (if (list? (cadr args))
+ (cadr args)
+ (cdr args))
+ 'pop-first #t))
+ ((RevertProperty)
+ (if (list? (car args))
+ (list 'grob-property-path (car args))
+ (list 'grob-property-path args)))
+ (else (ly:error (_ "Invalid property operation ~a") music-type))))
+ (m (apply make-music music-type
+ 'symbol symbol
+ 'origin location
+ props)))
(make-music 'ContextSpeccedMusic
- 'element m
- 'context-type ctx
- 'origin location)))
+ 'element m
+ 'context-type ctx
+ 'origin location)))
;; TODO: It seems that this function rarely returns anything useful.
(define (get-first-context-id type mus)
"Find the name of a ContextSpeccedMusic with given type"
(let ((id (ly:music-property mus 'context-id)))
(if (and (eq? (ly:music-property mus 'type) 'ContextSpeccedMusic)
- (eq? (ly:music-property mus 'context-type) type)
- (string? id)
- (not (string-null? id)))
- id
- '())))
+ (eq? (ly:music-property mus 'context-type) type)
+ (string? id)
+ (not (string-null? id)))
+ id
+ '())))
(define unique-counter -1)
(define (get-next-unique-voice-name)
@@ -238,34 +238,34 @@ into a @code{MultiMeasureTextEvent}."
;; to signal to the Extender_engraver that any pending extender should
;; be completed if the lyrics end before the associated voice.
(append! (ly:music-property music 'elements)
- (list (make-music 'CompletizeExtenderEvent)))
+ (list (make-music 'CompletizeExtenderEvent)))
(make-music 'LyricCombineMusic
- 'element music
- 'associated-context sync
- 'origin loc))
+ 'element music
+ 'associated-context sync
+ 'origin loc))
(define-ly-syntax (lyric-combine parser location voice music)
(lyric-combine-music voice music location))
(define-ly-syntax (add-lyrics parser location music addlyrics-list)
(let* ((existing-voice-name (get-first-context-id 'Voice music))
- (voice-name (if (string? existing-voice-name)
- existing-voice-name
- (get-next-unique-voice-name)))
- (voice (if (string? existing-voice-name)
- (music)
- (make-music 'ContextSpeccedMusic
- 'element music
- 'context-type 'Voice
- 'context-id voice-name
- 'origin (ly:music-property music 'origin))))
- (lyricstos (map (lambda (mus)
- (let* ((loc (ly:music-property mus 'origin))
- (lyr (lyric-combine-music voice-name mus loc)))
- (make-music 'ContextSpeccedMusic
- 'create-new #t
- 'context-type 'Lyrics
- 'element lyr
- 'origin loc)))
- addlyrics-list)))
+ (voice-name (if (string? existing-voice-name)
+ existing-voice-name
+ (get-next-unique-voice-name)))
+ (voice (if (string? existing-voice-name)
+ (music)
+ (make-music 'ContextSpeccedMusic
+ 'element music
+ 'context-type 'Voice
+ 'context-id voice-name
+ 'origin (ly:music-property music 'origin))))
+ (lyricstos (map (lambda (mus)
+ (let* ((loc (ly:music-property mus 'origin))
+ (lyr (lyric-combine-music voice-name mus loc)))
+ (make-music 'ContextSpeccedMusic
+ 'create-new #t
+ 'context-type 'Lyrics
+ 'element lyr
+ 'origin loc)))
+ addlyrics-list)))
(make-simultaneous-music (cons voice lyricstos))))
diff --git a/scm/markup-macros.scm b/scm/markup-macros.scm
index 07194407c5..72b107f846 100644
--- a/scm/markup-macros.scm
+++ b/scm/markup-macros.scm
@@ -147,7 +147,7 @@ command. There is no protection against circular definitions.
((not (null? (cdr prop-spec)))
`(list ',(car prop-spec) ,(cadr prop-spec)))
(else
- `(list ',(car prop-spec)))))
+ `(list ',(car prop-spec)))))
(if (pair? args)
properties
(list)))))
@@ -197,7 +197,7 @@ interpreted, returns a list of stencils instead of a single one"
((not (null? (cdr prop-spec)))
`(list ',(car prop-spec) ,(cadr prop-spec)))
(else
- `(list ',(car prop-spec)))))
+ `(list ',(car prop-spec)))))
(if (pair? args)
properties
(list)))))
@@ -384,10 +384,10 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
(set! args (cons `(list ,@(compile-all-markup-expressions (car rest))) args))
(set! rest (cdr rest)))
(else
- ;; pick up one arg in `rest'
- (receive (a r) (compile-markup-arg rest)
- (set! args (cons a args))
- (set! rest r))))))))
+ ;; pick up one arg in `rest'
+ (receive (a r) (compile-markup-arg rest)
+ (set! args (cons a args))
+ (set! rest r))))))))
((and (pair? expr)
(pair? (car expr))
(keyword? (caar expr)))
@@ -398,9 +398,9 @@ against SIGNATURE, reporting MAKE-NAME as the user-invoked function.
(string? (car expr))) ;; expr === ("string" ...)
(values `(make-simple-markup ,(car expr)) (cdr expr)))
(else
- ;; expr === (symbol ...) or ((funcall ...) ...)
- (values (car expr)
- (cdr expr)))))
+ ;; expr === (symbol ...) or ((funcall ...) ...)
+ (values (car expr)
+ (cdr expr)))))
(define (compile-all-markup-args expr)
"Transform `expr' into markup arguments"
diff --git a/scm/markup.scm b/scm/markup.scm
index 45652c0a5c..69a6ad13ff 100644
--- a/scm/markup.scm
+++ b/scm/markup.scm
@@ -72,72 +72,72 @@ following stencil. Stencils with empty Y extent are not given
;;; convert a full markup object to an approximate pure string representation
(define-public (markup->string m . argscopes)
-(let* ((scopes (if (pair? argscopes) (car argscopes) '())))
- ;; markup commands with one markup argument, formatting ignored
- (define markups-first-argument '(list
- bold-markup box-markup caps-markup dynamic-markup finger-markup
- fontCaps-markup huge-markup italic-markup large-markup larger-markup
- medium-markup normal-size-sub-markup normal-size-super-markup
- normal-text-markup normalsize-markup number-markup roman-markup
- sans-markup simple-markup small-markup smallCaps-markup smaller-markup
- sub-markup super-markup teeny-markup text-markup tiny-markup
- typewriter-markup underline-markup upright-markup bracket-markup
- circle-markup hbracket-markup parenthesize-markup rounded-box-markup
-
- center-align-markup center-column-markup column-markup dir-column-markup
- fill-line-markup justify-markup justify-string-markup left-align-markup
- left-column-markup line-markup right-align-markup right-column-markup
- vcenter-markup wordwrap-markup wordwrap-string-markup ))
-
- ;; markup commands with markup as second argument, first argument
- ;; specifies some formatting and is ignored
- (define markups-second-argument '(list
- abs-fontsize-markup fontsize-markup magnify-markup lower-markup
- pad-around-markup pad-markup-markup pad-x-markup raise-markup
- halign-markup hcenter-in-markup rotate-markup translate-markup
- translate-scaled-markup with-url-markup scale-markup ))
-
- ;; helper functions to handle string cons like string lists
- (define (markup-cons->string-cons c scopes)
- (if (not (pair? c)) (markup->string c scopes)
- (cons (markup->string (car c) scopes) (markup-cons->string-cons (cdr c) scopes))))
- (define (string-cons-join c)
- (if (not (pair? c)) c
- (string-join (list (car c) (string-cons-join (cdr c))) "")))
-
- (cond
- ((string? m) m)
- ((null? m) "")
- ((not (pair? m)) "")
-
- ;; handle \concat (string-join without spaces)
- ((and (pair? m) (equal? (car m) concat-markup))
- (string-cons-join (markup-cons->string-cons (cadr m) scopes)) )
-
- ;; markup functions with the markup as first arg
- ((member (car m) (primitive-eval markups-first-argument))
- (markup->string (cadr m) scopes))
-
- ;; markup functions with markup as second arg
- ((member (car m) (primitive-eval markups-second-argument))
- (markup->string (cddr m) scopes))
-
- ;; fromproperty-markup reads property values from the header block:
- ((equal? (car m) fromproperty-markup)
- (let* ((varname (symbol->string (cadr m)))
- ;; cut off the header: prefix from the variable name:
- (newvarname (if (string-prefix? "header:" varname) (substring varname 7) varname))
- (var (string->symbol newvarname))
- (mod (make-module 1)))
- ;; Prevent loops by temporarily clearing the variable we have just looked up
- (module-define! mod var "")
- (markup->string (ly:modules-lookup scopes var) (cons mod scopes))))
-
- ;; ignore all other markup functions
- ((markup-function? (car m)) "")
-
- ;; handle markup lists
- ((list? m)
- (string-join (map (lambda (mm) (markup->string mm scopes)) m) " "))
-
- (else "ERROR, unable to extract string from markup"))))
+ (let* ((scopes (if (pair? argscopes) (car argscopes) '())))
+ ;; markup commands with one markup argument, formatting ignored
+ (define markups-first-argument '(list
+ bold-markup box-markup caps-markup dynamic-markup finger-markup
+ fontCaps-markup huge-markup italic-markup large-markup larger-markup
+ medium-markup normal-size-sub-markup normal-size-super-markup
+ normal-text-markup normalsize-markup number-markup roman-markup
+ sans-markup simple-markup small-markup smallCaps-markup smaller-markup
+ sub-markup super-markup teeny-markup text-markup tiny-markup
+ typewriter-markup underline-markup upright-markup bracket-markup
+ circle-markup hbracket-markup parenthesize-markup rounded-box-markup
+
+ center-align-markup center-column-markup column-markup dir-column-markup
+ fill-line-markup justify-markup justify-string-markup left-align-markup
+ left-column-markup line-markup right-align-markup right-column-markup
+ vcenter-markup wordwrap-markup wordwrap-string-markup ))
+
+ ;; markup commands with markup as second argument, first argument
+ ;; specifies some formatting and is ignored
+ (define markups-second-argument '(list
+ abs-fontsize-markup fontsize-markup magnify-markup lower-markup
+ pad-around-markup pad-markup-markup pad-x-markup raise-markup
+ halign-markup hcenter-in-markup rotate-markup translate-markup
+ translate-scaled-markup with-url-markup scale-markup ))
+
+ ;; helper functions to handle string cons like string lists
+ (define (markup-cons->string-cons c scopes)
+ (if (not (pair? c)) (markup->string c scopes)
+ (cons (markup->string (car c) scopes) (markup-cons->string-cons (cdr c) scopes))))
+ (define (string-cons-join c)
+ (if (not (pair? c)) c
+ (string-join (list (car c) (string-cons-join (cdr c))) "")))
+
+ (cond
+ ((string? m) m)
+ ((null? m) "")
+ ((not (pair? m)) "")
+
+ ;; handle \concat (string-join without spaces)
+ ((and (pair? m) (equal? (car m) concat-markup))
+ (string-cons-join (markup-cons->string-cons (cadr m) scopes)) )
+
+ ;; markup functions with the markup as first arg
+ ((member (car m) (primitive-eval markups-first-argument))
+ (markup->string (cadr m) scopes))
+
+ ;; markup functions with markup as second arg
+ ((member (car m) (primitive-eval markups-second-argument))
+ (markup->string (cddr m) scopes))
+
+ ;; fromproperty-markup reads property values from the header block:
+ ((equal? (car m) fromproperty-markup)
+ (let* ((varname (symbol->string (cadr m)))
+ ;; cut off the header: prefix from the variable name:
+ (newvarname (if (string-prefix? "header:" varname) (substring varname 7) varname))
+ (var (string->symbol newvarname))
+ (mod (make-module 1)))
+ ;; Prevent loops by temporarily clearing the variable we have just looked up
+ (module-define! mod var "")
+ (markup->string (ly:modules-lookup scopes var) (cons mod scopes))))
+
+ ;; ignore all other markup functions
+ ((markup-function? (car m)) "")
+
+ ;; handle markup lists
+ ((list? m)
+ (string-join (map (lambda (mm) (markup->string mm scopes)) m) " "))
+
+ (else "ERROR, unable to extract string from markup"))))
diff --git a/scm/memory-trace.scm b/scm/memory-trace.scm
index 345d1327f0..293aca61e4 100644
--- a/scm/memory-trace.scm
+++ b/scm/memory-trace.scm
@@ -2,7 +2,7 @@
(define-module (scm memory-trace))
(use-modules (lily)
- (ice-9 format))
+ (ice-9 format))
(define-public (mtrace:start-trace freq)
(set! usecond-interval (inexact->exact (/ 1000000 freq)))
@@ -26,41 +26,41 @@
(define usecond-interval 100000)
(define (arg-procedure args)
(if (and (pair? args)
- (pair? (cdr args))
- (pair? (cadr args)))
+ (pair? (cdr args))
+ (pair? (cadr args)))
(caadr args) #f))
(define last-count 0)
(define (record-stack key continuation . args)
(if (eq? (current-thread) trace-thread)
#t ;; do nothing.
(let*
- ((cells (assoc-get 'total-cells-allocated (gc-stats)))
- (proc (arg-procedure args))
- (time (tms:utime (times)))
- (stack (extract-trace continuation)))
-
- (set! busy-tracing #t)
- (trap-disable 'traps)
- (trap-disable 'enter-frame)
-
- (set! trace-count (1+ trace-count))
- (ly:progress "<~a: ~a/~a>\n"
- trace-count
- (- time start-time)
- (- cells last-count))
-
- (set! last-count cells)
- (set! trace-points
- (cons (list
- (cons 'cells cells)
- (cons 'proc proc)
- (cons 'stack stack)
- (cons 'time time)
- )
-
- trace-points))
-
- (set! busy-tracing #f))))
+ ((cells (assoc-get 'total-cells-allocated (gc-stats)))
+ (proc (arg-procedure args))
+ (time (tms:utime (times)))
+ (stack (extract-trace continuation)))
+
+ (set! busy-tracing #t)
+ (trap-disable 'traps)
+ (trap-disable 'enter-frame)
+
+ (set! trace-count (1+ trace-count))
+ (ly:progress "<~a: ~a/~a>\n"
+ trace-count
+ (- time start-time)
+ (- cells last-count))
+
+ (set! last-count cells)
+ (set! trace-points
+ (cons (list
+ (cons 'cells cells)
+ (cons 'proc proc)
+ (cons 'stack stack)
+ (cons 'time time)
+ )
+
+ trace-points))
+
+ (set! busy-tracing #f))))
(define (start-install-tracepoint)
(set! trace-thread (current-thread))
@@ -69,17 +69,17 @@
(set! trace-count 0)
(set! start-memory (assoc-get 'total-cells-allocated (gc-stats)))
(set! start-time (tms:utime (times)))
-
+
(install-tracepoint))
(define (install-tracepoint)
(if busy-tracing
(display "last trace not finished yet\n" (current-error-port))
(begin
- (trap-set! enter-frame-handler record-stack)
- (trap-enable 'enter-frame)
- (trap-enable 'traps)))
-
+ (trap-set! enter-frame-handler record-stack)
+ (trap-enable 'enter-frame)
+ (trap-enable 'traps)))
+
(usleep usecond-interval)
(if continue-tracing
(install-tracepoint)))
@@ -95,33 +95,33 @@
)
(ly:progress "Memory statistics to ~a and ~a..."
- stacks-name graph-name)
+ stacks-name graph-name)
(format graph-out "# memory trace with ~a points\n" (length trace-points))
(for-each
(lambda (r)
(let*
- ((mem (- (assoc-get 'cells r) start-memory))
- (proc (assoc-get 'proc r))
- (stack (assoc-get 'stack r))
- (time (- (assoc-get 'time r) start-time)))
-
- (format graph-out "~a ~a\n" time mem)
- (if stack
- (begin
- (format stacks-out "~5a t = ~5a - delta-mem: ~15a - ~a\n" i
- time
- (- mem last-mem) proc)
- (do
- ((j 0 (1+ j))
- (stack (assoc-get 'stack r) stack))
- ((>= j (vector-length stack)))
-
- (format stacks-out "\t~a\n"
- (vector-ref stack j)))))
-
- (set! i (1+ i))
- (set! last-mem mem)
- ))
+ ((mem (- (assoc-get 'cells r) start-memory))
+ (proc (assoc-get 'proc r))
+ (stack (assoc-get 'stack r))
+ (time (- (assoc-get 'time r) start-time)))
+
+ (format graph-out "~a ~a\n" time mem)
+ (if stack
+ (begin
+ (format stacks-out "~5a t = ~5a - delta-mem: ~15a - ~a\n" i
+ time
+ (- mem last-mem) proc)
+ (do
+ ((j 0 (1+ j))
+ (stack (assoc-get 'stack r) stack))
+ ((>= j (vector-length stack)))
+
+ (format stacks-out "\t~a\n"
+ (vector-ref stack j)))))
+
+ (set! i (1+ i))
+ (set! last-mem mem)
+ ))
(reverse trace-points))))
@@ -140,20 +140,20 @@
(trace (make-vector depth #f)))
(do
- ((i 0 (1+ i)))
- ((>= i depth))
+ ((i 0 (1+ i)))
+ ((>= i depth))
(vector-set!
trace i
(let*
- ((source (frame-source (stack-ref stack i))))
+ ((source (frame-source (stack-ref stack i))))
- (and source
- (cons (source-property source 'filename)
- (source-property source 'line))))))
+ (and source
+ (cons (source-property source 'filename)
+ (source-property source 'line))))))
trace))
-
-
+
+
diff --git a/scm/midi.scm b/scm/midi.scm
index 4807992822..e673555d93 100644
--- a/scm/midi.scm
+++ b/scm/midi.scm
@@ -27,20 +27,20 @@
(set! absolute-volume-alist
(append
'(
- ("sf" . 1.00)
- ("fffff" . 0.95)
- ("ffff" . 0.92)
- ("fff" . 0.85)
- ("ff" . 0.80)
- ("f" . 0.75)
- ("mf" . 0.68)
- ("mp" . 0.61)
- ("p" . 0.55)
- ("pp" . 0.49)
- ("ppp" . 0.42)
- ("pppp" . 0.34)
- ("ppppp" . 0.25)
- )
+ ("sf" . 1.00)
+ ("fffff" . 0.95)
+ ("ffff" . 0.92)
+ ("fff" . 0.85)
+ ("ff" . 0.80)
+ ("f" . 0.75)
+ ("mf" . 0.68)
+ ("mp" . 0.61)
+ ("p" . 0.55)
+ ("pp" . 0.49)
+ ("ppp" . 0.42)
+ ("pppp" . 0.34)
+ ("ppppp" . 0.25)
+ )
absolute-volume-alist))
(define-public (default-dynamic-absolute-volume s)
@@ -51,18 +51,18 @@
(set! instrument-equalizer-alist
(append
'(
- ("flute" . (0 . 0.7))
- ("oboe" . (0 . 0.7))
- ("clarinet" . (0 . 0.7))
- ("bassoon" . (0 . 0.6))
- ("french horn" . (0.1 . 0.7))
- ("trumpet" . (0.1 . 0.8))
- ("timpani" . (0.2 . 0.9))
- ("violin" . (0.2 . 1.0))
- ("viola" . (0.1 . 0.7))
- ("cello" . (0.2 . 0.8))
- ("contrabass" . (0.2 . 0.8))
- )
+ ("flute" . (0 . 0.7))
+ ("oboe" . (0 . 0.7))
+ ("clarinet" . (0 . 0.7))
+ ("bassoon" . (0 . 0.6))
+ ("french horn" . (0.1 . 0.7))
+ ("trumpet" . (0.1 . 0.8))
+ ("timpani" . (0.2 . 0.9))
+ ("violin" . (0.2 . 1.0))
+ ("viola" . (0.1 . 0.7))
+ ("cello" . (0.2 . 0.8))
+ ("contrabass" . (0.2 . 0.8))
+ )
instrument-equalizer-alist))
(define-public (default-instrument-equalizer s)
@@ -73,192 +73,192 @@
(set! instrument-names-alist
(append
`(
- ("acoustic grand" . ,(- 1 1))
- ("bright acoustic" . ,(- 2 1))
- ("electric grand" . ,(- 3 1))
- ("honky-tonk" . ,(- 4 1))
- ("electric piano 1" . ,(- 5 1))
- ("electric piano 2" . ,(- 6 1))
- ("harpsichord" . ,(- 7 1))
- ("clav" . ,(- 8 1))
-
- ;; (9-16 chrom percussion)
- ("celesta" . ,(- 9 1))
- ("glockenspiel" . ,(- 10 1))
- ("music box" . ,(- 11 1))
- ("vibraphone" . ,(- 12 1))
- ("marimba" . ,(- 13 1))
- ("xylophone" . ,(- 14 1))
- ("tubular bells" . ,(- 15 1))
- ("dulcimer" . ,(- 16 1))
-
- ;; (17-24 organ)
- ("drawbar organ" . ,(- 17 1))
- ("percussive organ" . ,(- 18 1))
- ("rock organ" . ,(- 19 1))
- ("church organ" . ,(- 20 1))
- ("reed organ" . ,(- 21 1))
- ("accordion" . ,(- 22 1))
- ("harmonica" . ,(- 23 1))
- ("concertina" . ,(- 24 1))
-
- ;; (25-32 guitar)
- ("acoustic guitar (nylon)" . ,(- 25 1))
- ("acoustic guitar (steel)" . ,(- 26 1))
- ("electric guitar (jazz)" . ,(- 27 1))
- ("electric guitar (clean)" . ,(- 28 1))
- ("electric guitar (muted)" . ,(- 29 1))
- ("overdriven guitar" . ,(- 30 1))
- ("distorted guitar" . ,(- 31 1))
- ("guitar harmonics" . ,(- 32 1))
-
- ;; (33-40 bass)
- ("acoustic bass" . ,(- 33 1))
- ("electric bass (finger)" . ,(- 34 1))
- ("electric bass (pick)" . ,(- 35 1))
- ("fretless bass" . ,(- 36 1))
- ("slap bass 1" . ,(- 37 1))
- ("slap bass 2" . ,(- 38 1))
- ("synth bass 1" . ,(- 39 1))
- ("synth bass 2" . ,(- 40 1))
-
- ;; (41-48 strings)
- ("violin" . ,(- 41 1))
- ("viola" . ,(- 42 1))
- ("cello" . ,(- 43 1))
- ("contrabass" . ,(- 44 1))
- ("tremolo strings" . ,(- 45 1))
- ("pizzicato strings" . ,(- 46 1))
- ("orchestral harp" . ,(- 47 1))
- ("timpani" . ,(- 48 1))
-
- ;; (49-56 ensemble)
- ("string ensemble 1" . ,(- 49 1))
- ("string ensemble 2" . ,(- 50 1))
- ("synthstrings 1" . ,(- 51 1))
- ("synthstrings 2" . ,(- 52 1))
- ("choir aahs" . ,(- 53 1))
- ("voice oohs" . ,(- 54 1))
- ("synth voice" . ,(- 55 1))
- ("orchestra hit" . ,(- 56 1))
-
- ;; (57-64 brass)
- ("trumpet" . ,(- 57 1))
- ("trombone" . ,(- 58 1))
- ("tuba" . ,(- 59 1))
- ("muted trumpet" . ,(- 60 1))
- ("french horn" . ,(- 61 1))
- ("brass section" . ,(- 62 1))
- ("synthbrass 1" . ,(- 63 1))
- ("synthbrass 2" . ,(- 64 1))
-
- ;; (65-72 reed)
- ("soprano sax" . ,(- 65 1))
- ("alto sax" . ,(- 66 1))
- ("tenor sax" . ,(- 67 1))
- ("baritone sax" . ,(- 68 1))
- ("oboe" . ,(- 69 1))
- ("english horn" . ,(- 70 1))
- ("bassoon" . ,(- 71 1))
- ("clarinet" . ,(- 72 1))
-
- ;; (73-80 pipe)
- ("piccolo" . ,(- 73 1))
- ("flute" . ,(- 74 1))
- ("recorder" . ,(- 75 1))
- ("pan flute" . ,(- 76 1))
- ("blown bottle" . ,(- 77 1))
- ("shakuhachi" . ,(- 78 1))
- ("whistle" . ,(- 79 1))
- ("ocarina" . ,(- 80 1))
-
- ;; (81-88 synth lead)
- ("lead 1 (square)" . ,(- 81 1))
- ("lead 2 (sawtooth)" . ,(- 82 1))
- ("lead 3 (calliope)" . ,(- 83 1))
- ("lead 4 (chiff)" . ,(- 84 1))
- ("lead 5 (charang)" . ,(- 85 1))
- ("lead 6 (voice)" . ,(- 86 1))
- ("lead 7 (fifths)" . ,(- 87 1))
- ("lead 8 (bass+lead)" . ,(- 88 1))
-
- ;; (89-96 synth pad)
- ("pad 1 (new age)" . ,(- 89 1))
- ("pad 2 (warm)" . ,(- 90 1))
- ("pad 3 (polysynth)" . ,(- 91 1))
- ("pad 4 (choir)" . ,(- 92 1))
- ("pad 5 (bowed)" . ,(- 93 1))
- ("pad 6 (metallic)" . ,(- 94 1))
- ("pad 7 (halo)" . ,(- 95 1))
- ("pad 8 (sweep)" . ,(- 96 1))
-
- ;; (97-104 synth effects)
- ("fx 1 (rain)" . ,(- 97 1))
- ("fx 2 (soundtrack)" . ,(- 98 1))
- ("fx 3 (crystal)" . ,(- 99 1))
- ("fx 4 (atmosphere)" . ,(- 100 1))
- ("fx 5 (brightness)" . ,(- 101 1))
- ("fx 6 (goblins)" . ,(- 102 1))
- ("fx 7 (echoes)" . ,(- 103 1))
- ("fx 8 (sci-fi)" . ,(- 104 1))
-
- ;; (105-112 ethnic)
- ("sitar" . ,(- 105 1))
- ("banjo" . ,(- 106 1))
- ("shamisen" . ,(- 107 1))
- ("koto" . ,(- 108 1))
- ("kalimba" . ,(- 109 1))
- ("bagpipe" . ,(- 110 1))
- ("fiddle" . ,(- 111 1))
- ("shanai" . ,(- 112 1))
-
- ;; (113-120 percussive)
- ("tinkle bell" . ,(- 113 1))
- ("agogo" . ,(- 114 1))
- ("steel drums" . ,(- 115 1))
- ("woodblock" . ,(- 116 1))
- ("taiko drum" . ,(- 117 1))
- ("melodic tom" . ,(- 118 1))
- ("synth drum" . ,(- 119 1))
- ("reverse cymbal" . ,(- 120 1))
-
- ;; (121-128 sound effects)
- ("guitar fret noise" . ,(- 121 1))
- ("breath noise" . ,(- 122 1))
- ("seashore" . ,(- 123 1))
- ("bird tweet" . ,(- 124 1))
- ("telephone ring" . ,(- 125 1))
- ("helicopter" . ,(- 126 1))
- ("applause" . ,(- 127 1))
- ("gunshot" . ,(- 128 1))
-
- ;; (channel 10 drum-kits - subtract 32768 to get program no.)
- ("standard kit" . ,(+ 32768 0))
- ("standard drums" . ,(+ 32768 0))
- ("drums" . ,(+ 32768 0))
- ("room kit" . ,(+ 32768 8))
- ("room drums" . ,(+ 32768 8))
- ("power kit" . ,(+ 32768 16))
- ("power drums" . ,(+ 32768 16))
- ("rock drums" . ,(+ 32768 16))
- ("electronic kit" . ,(+ 32768 24))
- ("electronic drums" . ,(+ 32768 24))
- ("tr-808 kit" . ,(+ 32768 25))
- ("tr-808 drums" . ,(+ 32768 25))
- ("jazz kit" . ,(+ 32768 32))
- ("jazz drums" . ,(+ 32768 32))
- ("brush kit" . ,(+ 32768 40))
- ("brush drums" . ,(+ 32768 40))
- ("orchestra kit" . ,(+ 32768 48))
- ("orchestra drums" . ,(+ 32768 48))
- ("classical drums" . ,(+ 32768 48))
- ("sfx kit" . ,(+ 32768 56))
- ("sfx drums" . ,(+ 32768 56))
- ("mt-32 kit" . ,(+ 32768 127))
- ("mt-32 drums" . ,(+ 32768 127))
- ("cm-64 kit" . ,(+ 32768 127))
- ("cm-64 drums" . ,(+ 32768 127))
- )
+ ("acoustic grand" . ,(- 1 1))
+ ("bright acoustic" . ,(- 2 1))
+ ("electric grand" . ,(- 3 1))
+ ("honky-tonk" . ,(- 4 1))
+ ("electric piano 1" . ,(- 5 1))
+ ("electric piano 2" . ,(- 6 1))
+ ("harpsichord" . ,(- 7 1))
+ ("clav" . ,(- 8 1))
+
+ ;; (9-16 chrom percussion)
+ ("celesta" . ,(- 9 1))
+ ("glockenspiel" . ,(- 10 1))
+ ("music box" . ,(- 11 1))
+ ("vibraphone" . ,(- 12 1))
+ ("marimba" . ,(- 13 1))
+ ("xylophone" . ,(- 14 1))
+ ("tubular bells" . ,(- 15 1))
+ ("dulcimer" . ,(- 16 1))
+
+ ;; (17-24 organ)
+ ("drawbar organ" . ,(- 17 1))
+ ("percussive organ" . ,(- 18 1))
+ ("rock organ" . ,(- 19 1))
+ ("church organ" . ,(- 20 1))
+ ("reed organ" . ,(- 21 1))
+ ("accordion" . ,(- 22 1))
+ ("harmonica" . ,(- 23 1))
+ ("concertina" . ,(- 24 1))
+
+ ;; (25-32 guitar)
+ ("acoustic guitar (nylon)" . ,(- 25 1))
+ ("acoustic guitar (steel)" . ,(- 26 1))
+ ("electric guitar (jazz)" . ,(- 27 1))
+ ("electric guitar (clean)" . ,(- 28 1))
+ ("electric guitar (muted)" . ,(- 29 1))
+ ("overdriven guitar" . ,(- 30 1))
+ ("distorted guitar" . ,(- 31 1))
+ ("guitar harmonics" . ,(- 32 1))
+
+ ;; (33-40 bass)
+ ("acoustic bass" . ,(- 33 1))
+ ("electric bass (finger)" . ,(- 34 1))
+ ("electric bass (pick)" . ,(- 35 1))
+ ("fretless bass" . ,(- 36 1))
+ ("slap bass 1" . ,(- 37 1))
+ ("slap bass 2" . ,(- 38 1))
+ ("synth bass 1" . ,(- 39 1))
+ ("synth bass 2" . ,(- 40 1))
+
+ ;; (41-48 strings)
+ ("violin" . ,(- 41 1))
+ ("viola" . ,(- 42 1))
+ ("cello" . ,(- 43 1))
+ ("contrabass" . ,(- 44 1))
+ ("tremolo strings" . ,(- 45 1))
+ ("pizzicato strings" . ,(- 46 1))
+ ("orchestral harp" . ,(- 47 1))
+ ("timpani" . ,(- 48 1))
+
+ ;; (49-56 ensemble)
+ ("string ensemble 1" . ,(- 49 1))
+ ("string ensemble 2" . ,(- 50 1))
+ ("synthstrings 1" . ,(- 51 1))
+ ("synthstrings 2" . ,(- 52 1))
+ ("choir aahs" . ,(- 53 1))
+ ("voice oohs" . ,(- 54 1))
+ ("synth voice" . ,(- 55 1))
+ ("orchestra hit" . ,(- 56 1))
+
+ ;; (57-64 brass)
+ ("trumpet" . ,(- 57 1))
+ ("trombone" . ,(- 58 1))
+ ("tuba" . ,(- 59 1))
+ ("muted trumpet" . ,(- 60 1))
+ ("french horn" . ,(- 61 1))
+ ("brass section" . ,(- 62 1))
+ ("synthbrass 1" . ,(- 63 1))
+ ("synthbrass 2" . ,(- 64 1))
+
+ ;; (65-72 reed)
+ ("soprano sax" . ,(- 65 1))
+ ("alto sax" . ,(- 66 1))
+ ("tenor sax" . ,(- 67 1))
+ ("baritone sax" . ,(- 68 1))
+ ("oboe" . ,(- 69 1))
+ ("english horn" . ,(- 70 1))
+ ("bassoon" . ,(- 71 1))
+ ("clarinet" . ,(- 72 1))
+
+ ;; (73-80 pipe)
+ ("piccolo" . ,(- 73 1))
+ ("flute" . ,(- 74 1))
+ ("recorder" . ,(- 75 1))
+ ("pan flute" . ,(- 76 1))
+ ("blown bottle" . ,(- 77 1))
+ ("shakuhachi" . ,(- 78 1))
+ ("whistle" . ,(- 79 1))
+ ("ocarina" . ,(- 80 1))
+
+ ;; (81-88 synth lead)
+ ("lead 1 (square)" . ,(- 81 1))
+ ("lead 2 (sawtooth)" . ,(- 82 1))
+ ("lead 3 (calliope)" . ,(- 83 1))
+ ("lead 4 (chiff)" . ,(- 84 1))
+ ("lead 5 (charang)" . ,(- 85 1))
+ ("lead 6 (voice)" . ,(- 86 1))
+ ("lead 7 (fifths)" . ,(- 87 1))
+ ("lead 8 (bass+lead)" . ,(- 88 1))
+
+ ;; (89-96 synth pad)
+ ("pad 1 (new age)" . ,(- 89 1))
+ ("pad 2 (warm)" . ,(- 90 1))
+ ("pad 3 (polysynth)" . ,(- 91 1))
+ ("pad 4 (choir)" . ,(- 92 1))
+ ("pad 5 (bowed)" . ,(- 93 1))
+ ("pad 6 (metallic)" . ,(- 94 1))
+ ("pad 7 (halo)" . ,(- 95 1))
+ ("pad 8 (sweep)" . ,(- 96 1))
+
+ ;; (97-104 synth effects)
+ ("fx 1 (rain)" . ,(- 97 1))
+ ("fx 2 (soundtrack)" . ,(- 98 1))
+ ("fx 3 (crystal)" . ,(- 99 1))
+ ("fx 4 (atmosphere)" . ,(- 100 1))
+ ("fx 5 (brightness)" . ,(- 101 1))
+ ("fx 6 (goblins)" . ,(- 102 1))
+ ("fx 7 (echoes)" . ,(- 103 1))
+ ("fx 8 (sci-fi)" . ,(- 104 1))
+
+ ;; (105-112 ethnic)
+ ("sitar" . ,(- 105 1))
+ ("banjo" . ,(- 106 1))
+ ("shamisen" . ,(- 107 1))
+ ("koto" . ,(- 108 1))
+ ("kalimba" . ,(- 109 1))
+ ("bagpipe" . ,(- 110 1))
+ ("fiddle" . ,(- 111 1))
+ ("shanai" . ,(- 112 1))
+
+ ;; (113-120 percussive)
+ ("tinkle bell" . ,(- 113 1))
+ ("agogo" . ,(- 114 1))
+ ("steel drums" . ,(- 115 1))
+ ("woodblock" . ,(- 116 1))
+ ("taiko drum" . ,(- 117 1))
+ ("melodic tom" . ,(- 118 1))
+ ("synth drum" . ,(- 119 1))
+ ("reverse cymbal" . ,(- 120 1))
+
+ ;; (121-128 sound effects)
+ ("guitar fret noise" . ,(- 121 1))
+ ("breath noise" . ,(- 122 1))
+ ("seashore" . ,(- 123 1))
+ ("bird tweet" . ,(- 124 1))
+ ("telephone ring" . ,(- 125 1))
+ ("helicopter" . ,(- 126 1))
+ ("applause" . ,(- 127 1))
+ ("gunshot" . ,(- 128 1))
+
+ ;; (channel 10 drum-kits - subtract 32768 to get program no.)
+ ("standard kit" . ,(+ 32768 0))
+ ("standard drums" . ,(+ 32768 0))
+ ("drums" . ,(+ 32768 0))
+ ("room kit" . ,(+ 32768 8))
+ ("room drums" . ,(+ 32768 8))
+ ("power kit" . ,(+ 32768 16))
+ ("power drums" . ,(+ 32768 16))
+ ("rock drums" . ,(+ 32768 16))
+ ("electronic kit" . ,(+ 32768 24))
+ ("electronic drums" . ,(+ 32768 24))
+ ("tr-808 kit" . ,(+ 32768 25))
+ ("tr-808 drums" . ,(+ 32768 25))
+ ("jazz kit" . ,(+ 32768 32))
+ ("jazz drums" . ,(+ 32768 32))
+ ("brush kit" . ,(+ 32768 40))
+ ("brush drums" . ,(+ 32768 40))
+ ("orchestra kit" . ,(+ 32768 48))
+ ("orchestra drums" . ,(+ 32768 48))
+ ("classical drums" . ,(+ 32768 48))
+ ("sfx kit" . ,(+ 32768 56))
+ ("sfx drums" . ,(+ 32768 56))
+ ("mt-32 kit" . ,(+ 32768 127))
+ ("mt-32 drums" . ,(+ 32768 127))
+ ("cm-64 kit" . ,(+ 32768 127))
+ ("cm-64 drums" . ,(+ 32768 127))
+ )
instrument-names-alist))
(define-public (percussion? instrument)
@@ -275,7 +275,7 @@
(entry (assoc-get inst instrument-names-alist)))
(if entry
(modulo entry 32768)
- #f)))
+ #f)))
;; 90 == 90/127 == 0.71 is supposed to be the default value
;; urg: we should set this at start of track
@@ -293,14 +293,14 @@
(define-public (write-performances-midis performances basename . rest)
(let ((midi-ext (ly:get-option 'midi-extension)))
(let
- loop
+ loop
((perfs performances)
(count (if (null? rest) 0 (car rest))))
(if (pair? perfs)
- (begin
- (ly:performance-write
- (car perfs)
- (if (> count 0)
- (format #f "~a-~a.~a" basename count midi-ext)
- (format #f "~a.~a" basename midi-ext)))
- (loop (cdr perfs) (1+ count)))))))
+ (begin
+ (ly:performance-write
+ (car perfs)
+ (if (> count 0)
+ (format #f "~a-~a.~a" basename count midi-ext)
+ (format #f "~a.~a" basename midi-ext)))
+ (loop (cdr perfs) (1+ count)))))))
diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm
index 9617329d77..3db3904726 100644
--- a/scm/modal-transforms.scm
+++ b/scm/modal-transforms.scm
@@ -48,11 +48,11 @@ pitches as members of a scale.
(else
(list-ref scale
- (modulo
- (+ (index pitch scale)
- (- (index to-pitch scale)
- (index from-pitch scale)))
- (length scale)))))))
+ (modulo
+ (+ (index pitch scale)
+ (- (index to-pitch scale)
+ (index from-pitch scale)))
+ (length scale)))))))
(define (inverter-factory scale)
"Returns an inverter for the specified @var{scale}.
@@ -81,11 +81,11 @@ arbitrary items and pitches as members of a scale.
(else
(list-ref scale
- (modulo
- (+ (index to-pitch scale)
- (- (index around-pitch scale)
- (index pitch scale)))
- (length scale)))))))
+ (modulo
+ (+ (index to-pitch scale)
+ (- (index around-pitch scale)
+ (index pitch scale)))
+ (length scale)))))))
(define (replicate-modify lis n mod-proc)
"Apply @code{(mod-proc lis n)} to each element of a list and
@@ -112,8 +112,8 @@ a single pitch as its argument and return a new pitch. These are
LilyPond scheme pitches, e.g. @code{(ly:make-pitch 0 2 0)}
"
(let ((elements (ly:music-property music 'elements))
- (element (ly:music-property music 'element))
- (pitch (ly:music-property music 'pitch)))
+ (element (ly:music-property music 'element))
+ (pitch (ly:music-property music 'pitch)))
(cond
((ly:pitch? pitch)
@@ -135,8 +135,8 @@ Typically used to construct a scale for input to transposer-factory
"
(let ((elements (ly:music-property music 'elements))
- (element (ly:music-property music 'element))
- (pitch (ly:music-property music 'pitch)))
+ (element (ly:music-property music 'element))
+ (pitch (ly:music-property music 'pitch)))
(cond
((ly:pitch? pitch)
@@ -159,10 +159,10 @@ Typically used to construct a scale for input to transposer-factory
(lambda (lis n)
(map
(lambda (i)
- (ly:make-pitch
- (+ (- n 6) (ly:pitch-octave i))
- (ly:pitch-notename i)
- (ly:pitch-alteration i)))
+ (ly:make-pitch
+ (+ (- n 6) (ly:pitch-octave i))
+ (ly:pitch-notename i)
+ (ly:pitch-alteration i)))
lis)))
(let ((scale (make-scale music)))
@@ -215,11 +215,11 @@ Typically used to construct a scale for input to transposer-factory
and transposes from @var{around} to @var{to}."
(let ((p (ly:music-property music 'pitch)))
(if (ly:pitch? p)
- (ly:music-set-property!
- music 'pitch
- (ly:pitch-transpose to (ly:pitch-diff around p))))
+ (ly:music-set-property!
+ music 'pitch
+ (ly:pitch-transpose to (ly:pitch-diff around p))))
music))
(define-public (music-invert around to music)
"Applies pitch-invert to all pitches in @var{music}."
- (music-map (lambda (x) (pitch-invert around to x)) music))
+ (music-map (lambda (x) (pitch-invert around to x)) music))
diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index 95d4c80f3c..5e07229a37 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -28,7 +28,7 @@
;;; ==> set the 'elements property and return it
(define-public ly:music-property
(make-procedure-with-setter ly:music-property
- ly:music-set-property!))
+ ly:music-set-property!))
(define-safe-public (music-is-of-type? mus type)
"Does @code{mus} belong to the music class @code{type}?"
@@ -37,23 +37,23 @@
;; TODO move this
(define-public ly:grob-property
(make-procedure-with-setter ly:grob-property
- ly:grob-set-property!))
+ ly:grob-set-property!))
(define-public ly:grob-object
(make-procedure-with-setter ly:grob-object
- ly:grob-set-object!))
+ ly:grob-set-object!))
(define-public ly:grob-parent
(make-procedure-with-setter ly:grob-parent
- ly:grob-set-parent!))
+ ly:grob-set-parent!))
(define-public ly:prob-property
(make-procedure-with-setter ly:prob-property
- ly:prob-set-property!))
+ ly:prob-set-property!))
(define-public ly:context-property
(make-procedure-with-setter ly:context-property
- ly:context-set-property!))
+ ly:context-set-property!))
(define-public (music-map function music)
"Apply @var{function} to @var{music} and all of the music it contains.
@@ -61,13 +61,13 @@
First it recurses over the children, then the function is applied to
@var{music}."
(let ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element)))
+ (e (ly:music-property music 'element)))
(if (pair? es)
- (set! (ly:music-property music 'elements)
- (map (lambda (y) (music-map function y)) es)))
+ (set! (ly:music-property music 'elements)
+ (map (lambda (y) (music-map function y)) es)))
(if (ly:music? e)
- (set! (ly:music-property music 'element)
- (music-map function e)))
+ (set! (ly:music-property music 'element)
+ (music-map function e)))
(function music)))
(define-public (music-filter pred? music)
@@ -76,31 +76,31 @@ First it recurses over the children, then the function is applied to
(define (inner-music-filter pred? music)
"Recursive function."
(let* ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element))
- (as (ly:music-property music 'articulations))
- (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) as)))
- (filtered-e (if (ly:music? e)
- (inner-music-filter pred? e)
- e))
- (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
+ (e (ly:music-property music 'element))
+ (as (ly:music-property music 'articulations))
+ (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) as)))
+ (filtered-e (if (ly:music? e)
+ (inner-music-filter pred? e)
+ e))
+ (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter pred? y)) es))))
(if (not (null? e))
- (set! (ly:music-property music 'element) filtered-e))
+ (set! (ly:music-property music 'element) filtered-e))
(if (not (null? es))
- (set! (ly:music-property music 'elements) filtered-es))
+ (set! (ly:music-property music 'elements) filtered-es))
(if (not (null? as))
- (set! (ly:music-property music 'articulations) filtered-as))
+ (set! (ly:music-property music 'articulations) filtered-as))
;; if filtering emptied the expression, we remove it completely.
(if (or (not (pred? music))
- (and (eq? filtered-es '()) (not (ly:music? e))
- (or (not (eq? es '()))
- (ly:music? e))))
- (set! music '()))
+ (and (eq? filtered-es '()) (not (ly:music? e))
+ (or (not (eq? es '()))
+ (ly:music? e))))
+ (set! music '()))
music))
(set! music (inner-music-filter pred? music))
(if (ly:music? music)
music
- (make-music 'Music))) ;must return music.
+ (make-music 'Music))) ;must return music.
(define*-public (display-music music #:optional (port (current-output-port)))
"Display music, not done with @code{music-map} for clarity of
@@ -108,16 +108,16 @@ presentation."
(display music port)
(display ": { " port)
(let ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element)))
+ (e (ly:music-property music 'element)))
(display (ly:music-mutable-properties music) port)
(if (pair? es)
- (begin (display "\nElements: {\n" port)
- (for-each (lambda (m) (display-music m port)) es)
- (display "}\n" port)))
+ (begin (display "\nElements: {\n" port)
+ (for-each (lambda (m) (display-music m port)) es)
+ (display "}\n" port)))
(if (ly:music? e)
- (begin
- (display "\nChild:" port)
- (display-music e port))))
+ (begin
+ (display "\nChild:" port)
+ (display-music e port))))
(display " }\n" port)
music)
@@ -134,20 +134,20 @@ For instance,
"Return a keyword, eg. `#:bold', from the `proc' function, eg. #<procedure bold-markup (layout props arg)>"
(let ((cmd-markup (symbol->string (procedure-name proc))))
(symbol->keyword (string->symbol (substring cmd-markup 0 (- (string-length cmd-markup)
- (string-length "-markup")))))))
+ (string-length "-markup")))))))
(define (transform-arg arg)
(cond ((and (pair? arg) (markup? (car arg))) ;; a markup list
- (apply append (map inner-markup->make-markup arg)))
- ((and (not (string? arg)) (markup? arg)) ;; a markup
- (inner-markup->make-markup arg))
- (else ;; scheme arg
- (music->make-music arg))))
+ (apply append (map inner-markup->make-markup arg)))
+ ((and (not (string? arg)) (markup? arg)) ;; a markup
+ (inner-markup->make-markup arg))
+ (else ;; scheme arg
+ (music->make-music arg))))
(define (inner-markup->make-markup mrkup)
(if (string? mrkup)
- `(#:simple ,mrkup)
- (let ((cmd (proc->command-keyword (car mrkup)))
- (args (map transform-arg (cdr mrkup))))
- `(,cmd ,@args))))
+ `(#:simple ,mrkup)
+ (let ((cmd (proc->command-keyword (car mrkup)))
+ (args (map transform-arg (cdr mrkup))))
+ `(,cmd ,@args))))
;; body:
(if (string? markup-expression)
markup-expression
@@ -158,52 +158,52 @@ For instance,
equivalent to @var{obj}, that is, for a music expression, a
@code{(make-music ...)} form."
(cond (;; markup expression
- (markup? obj)
- (markup-expression->make-markup obj))
- (;; music expression
- (ly:music? obj)
- `(make-music
- ',(ly:music-property obj 'name)
- ,@(apply append (map (lambda (prop)
+ (markup? obj)
+ (markup-expression->make-markup obj))
+ (;; music expression
+ (ly:music? obj)
+ `(make-music
+ ',(ly:music-property obj 'name)
+ ,@(apply append (map (lambda (prop)
`(',(car prop)
- ,(music->make-music (cdr prop))))
+ ,(music->make-music (cdr prop))))
(remove (lambda (prop)
(eqv? (car prop) 'origin))
(ly:music-mutable-properties obj))))))
- (;; moment
- (ly:moment? obj)
- `(ly:make-moment ,(ly:moment-main-numerator obj)
- ,(ly:moment-main-denominator obj)
- ,(ly:moment-grace-numerator obj)
- ,(ly:moment-grace-denominator obj)))
- (;; note duration
- (ly:duration? obj)
- `(ly:make-duration ,(ly:duration-log obj)
- ,(ly:duration-dot-count obj)
- ,(ly:duration-scale obj)))
- (;; note pitch
- (ly:pitch? obj)
- `(ly:make-pitch ,(ly:pitch-octave obj)
- ,(ly:pitch-notename obj)
- ,(ly:pitch-alteration obj)))
- (;; scheme procedure
- (procedure? obj)
- (or (procedure-name obj) obj))
- (;; a symbol (avoid having an unquoted symbol)
- (symbol? obj)
- `',obj)
- (;; an empty list (avoid having an unquoted empty list)
- (null? obj)
- `'())
- (;; a proper list
- (list? obj)
- `(list ,@(map music->make-music obj)))
- (;; a pair
- (pair? obj)
- `(cons ,(music->make-music (car obj))
- ,(music->make-music (cdr obj))))
- (else
- obj)))
+ (;; moment
+ (ly:moment? obj)
+ `(ly:make-moment ,(ly:moment-main-numerator obj)
+ ,(ly:moment-main-denominator obj)
+ ,(ly:moment-grace-numerator obj)
+ ,(ly:moment-grace-denominator obj)))
+ (;; note duration
+ (ly:duration? obj)
+ `(ly:make-duration ,(ly:duration-log obj)
+ ,(ly:duration-dot-count obj)
+ ,(ly:duration-scale obj)))
+ (;; note pitch
+ (ly:pitch? obj)
+ `(ly:make-pitch ,(ly:pitch-octave obj)
+ ,(ly:pitch-notename obj)
+ ,(ly:pitch-alteration obj)))
+ (;; scheme procedure
+ (procedure? obj)
+ (or (procedure-name obj) obj))
+ (;; a symbol (avoid having an unquoted symbol)
+ (symbol? obj)
+ `',obj)
+ (;; an empty list (avoid having an unquoted empty list)
+ (null? obj)
+ `'())
+ (;; a proper list
+ (list? obj)
+ `(list ,@(map music->make-music obj)))
+ (;; a pair
+ (pair? obj)
+ `(cons ,(music->make-music (car obj))
+ ,(music->make-music (cdr obj))))
+ (else
+ obj)))
(use-modules (ice-9 pretty-print))
(define*-public (display-scheme-music obj #:optional (port (current-output-port)))
@@ -219,14 +219,14 @@ which often can be read back in order to generate an equivalent expression."
(scm display-lily))
(define*-public (display-lily-music expr parser #:optional (port (current-output-port))
- #:key force-duration)
+ #:key force-duration)
"Display the music expression using LilyPond syntax"
(memoize-clef-names supported-clefs)
(parameterize ((*indent* 0)
- (*previous-duration* (ly:make-duration 2))
- (*force-duration* force-duration))
- (display (music->lily-string expr parser) port)
- (newline port)))
+ (*previous-duration* (ly:make-duration 2))
+ (*force-duration* force-duration))
+ (display (music->lily-string expr parser) port)
+ (newline port)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -236,17 +236,17 @@ which often can be read back in order to generate an equivalent expression."
The number of dots in the shifted music may not be less than zero."
(let ((d (ly:music-property music 'duration)))
(if (ly:duration? d)
- (let* ((cp (ly:duration-scale d))
- (nd (ly:make-duration
+ (let* ((cp (ly:duration-scale d))
+ (nd (ly:make-duration
(+ shift (ly:duration-log d))
(max 0 (+ dot (ly:duration-dot-count d)))
- cp)))
- (set! (ly:music-property music 'duration) nd)))
+ cp)))
+ (set! (ly:music-property music 'duration) nd)))
music))
(define-public (shift-duration-log music shift dot)
(music-map (lambda (x) (shift-one-duration-log x shift dot))
- music))
+ music))
(define-public (make-repeat name times main alts)
"Create a repeat music expression, with all properties initialized
@@ -257,55 +257,55 @@ through MUSIC."
;; NoteEvent or a non-expanded chord-repetition
;; We just take anything that actually sports an announced duration.
(if (ly:duration? (ly:music-property music 'duration))
- (ly:music-property music 'duration)
- (let loop ((elts (if (ly:music? (ly:music-property music 'element))
- (list (ly:music-property music 'element))
- (ly:music-property music 'elements))))
- (and (pair? elts)
- (let ((dur (first-note-duration (car elts))))
- (if (ly:duration? dur)
- dur
- (loop (cdr elts))))))))
+ (ly:music-property music 'duration)
+ (let loop ((elts (if (ly:music? (ly:music-property music 'element))
+ (list (ly:music-property music 'element))
+ (ly:music-property music 'elements))))
+ (and (pair? elts)
+ (let ((dur (first-note-duration (car elts))))
+ (if (ly:duration? dur)
+ dur
+ (loop (cdr elts))))))))
(let ((talts (if (< times (length alts))
- (begin
- (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
- (take alts times))
- alts))
- (r (make-repeated-music name)))
+ (begin
+ (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
+ (take alts times))
+ alts))
+ (r (make-repeated-music name)))
(set! (ly:music-property r 'element) main)
(set! (ly:music-property r 'repeat-count) (max times 1))
(set! (ly:music-property r 'elements) talts)
(if (and (equal? name "tremolo")
- (pair? (extract-named-music main '(EventChord NoteEvent))))
- ;; This works for single-note and multi-note tremolos!
- (let* ((children (if (music-is-of-type? main 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music main '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
- ;; times * children
- (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult))))
- (note-duration (first-note-duration r))
- (duration-log (if (ly:duration? note-duration)
- (ly:duration-log note-duration)
- 1))
- (tremolo-type (ash 1 duration-log)))
- (set! (ly:music-property r 'tremolo-type) tremolo-type)
- (if (not (and (integer? mult) (= (logcount mult) 1)))
- (ly:music-warning
- main
- (ly:format (_ "invalid tremolo repeat count: ~a") times)))
- ;; Adjust the time of the notes
- (ly:music-compress r (ly:make-moment 1 children))
- ;; Adjust the displayed note durations
- (shift-duration-log r shift dots))
- r)))
+ (pair? (extract-named-music main '(EventChord NoteEvent))))
+ ;; This works for single-note and multi-note tremolos!
+ (let* ((children (if (music-is-of-type? main 'sequential-music)
+ ;; \repeat tremolo n { ... }
+ (length (extract-named-music main '(EventChord
+ NoteEvent)))
+ ;; \repeat tremolo n c4
+ 1))
+ ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+ (dots (1- (logcount (* times children))))
+ ;; The remaining missing multiplicator to scale the notes by
+ ;; times * children
+ (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
+ (shift (- (ly:intlog2 (floor mult))))
+ (note-duration (first-note-duration r))
+ (duration-log (if (ly:duration? note-duration)
+ (ly:duration-log note-duration)
+ 1))
+ (tremolo-type (ash 1 duration-log)))
+ (set! (ly:music-property r 'tremolo-type) tremolo-type)
+ (if (not (and (integer? mult) (= (logcount mult) 1)))
+ (ly:music-warning
+ main
+ (ly:format (_ "invalid tremolo repeat count: ~a") times)))
+ ;; Adjust the time of the notes
+ (ly:music-compress r (ly:make-moment 1 children))
+ ;; Adjust the displayed note durations
+ (shift-duration-log r shift dots))
+ r)))
(define (calc-repeat-slash-count music)
"Given the child-list @var{music} in @code{PercentRepeatMusic},
@@ -313,13 +313,13 @@ calculate the number of slashes based on the durations. Returns @code{0}
if durations in @var{music} vary, allowing slash beats and double-percent
beats to be distinguished."
(let* ((durs (map duration-of-note
- (extract-named-music music '(EventChord NoteEvent
- RestEvent SkipEvent))))
- (first-dur (car durs)))
+ (extract-named-music music '(EventChord NoteEvent
+ RestEvent SkipEvent))))
+ (first-dur (car durs)))
(if (every (lambda (d) (equal? d first-dur)) durs)
- (max (- (ly:duration-log first-dur) 2) 1)
- 0)))
+ (max (- (ly:duration-log first-dur) 2) 1)
+ 0)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; clusters.
@@ -328,8 +328,8 @@ beats to be distinguished."
"Replace @code{NoteEvents} by @code{ClusterNoteEvents}."
(if (eq? (ly:music-property music 'name) 'NoteEvent)
(make-music 'ClusterNoteEvent
- 'pitch (ly:music-property music 'pitch)
- 'duration (ly:music-property music 'duration))
+ 'pitch (ly:music-property music 'pitch)
+ 'duration (ly:music-property music 'duration))
music))
(define-public (notes-to-clusters music)
@@ -342,44 +342,44 @@ beats to be distinguished."
"Replace all repeats with unfolded repeats."
(let ((es (ly:music-property music 'elements))
- (e (ly:music-property music 'element)))
+ (e (ly:music-property music 'element)))
(if (music-is-of-type? music 'repeated-music)
- (let* ((props (ly:music-mutable-properties music))
- (old-name (ly:music-property music 'name))
- (flattened (flatten-alist props)))
- (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
- flattened)))
-
- (if (and (equal? old-name 'TremoloRepeatedMusic)
- (pair? (extract-named-music e '(EventChord NoteEvent))))
- ;; This works for single-note and multi-note tremolos!
- (let* ((children (if (music-is-of-type? e 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music e '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- (times (ly:music-property music 'repeat-count))
-
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
- ;; times * children
- (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult)))))
-
- ;; Adjust the time of the notes
- (ly:music-compress music (ly:make-moment children 1))
- ;; Adjust the displayed note durations
- (shift-duration-log music (- shift) (- dots))))))
+ (let* ((props (ly:music-mutable-properties music))
+ (old-name (ly:music-property music 'name))
+ (flattened (flatten-alist props)))
+ (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
+ flattened)))
+
+ (if (and (equal? old-name 'TremoloRepeatedMusic)
+ (pair? (extract-named-music e '(EventChord NoteEvent))))
+ ;; This works for single-note and multi-note tremolos!
+ (let* ((children (if (music-is-of-type? e 'sequential-music)
+ ;; \repeat tremolo n { ... }
+ (length (extract-named-music e '(EventChord
+ NoteEvent)))
+ ;; \repeat tremolo n c4
+ 1))
+ (times (ly:music-property music 'repeat-count))
+
+ ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+ (dots (1- (logcount (* times children))))
+ ;; The remaining missing multiplicator to scale the notes by
+ ;; times * children
+ (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
+ (shift (- (ly:intlog2 (floor mult)))))
+
+ ;; Adjust the time of the notes
+ (ly:music-compress music (ly:make-moment children 1))
+ ;; Adjust the displayed note durations
+ (shift-duration-log music (- shift) (- dots))))))
(if (pair? es)
- (set! (ly:music-property music 'elements)
- (map unfold-repeats es)))
+ (set! (ly:music-property music 'elements)
+ (map unfold-repeats es)))
(if (ly:music? e)
- (set! (ly:music-property music 'element)
- (unfold-repeats e)))
+ (set! (ly:music-property music 'element)
+ (unfold-repeats e)))
music))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -465,24 +465,24 @@ respectively."
"Make a @code{Music} expression that sets @var{gprop} to @var{val} in
@var{grob}. Does a pop first, i.e., this is not an override."
(make-music 'OverrideProperty
- 'symbol grob
- 'grob-property gprop
- 'grob-value val
- 'pop-first #t))
+ 'symbol grob
+ 'grob-property gprop
+ 'grob-value val
+ 'pop-first #t))
(define-public (make-grob-property-override grob gprop val)
"Make a @code{Music} expression that overrides @var{gprop} to @var{val}
in @var{grob}."
(make-music 'OverrideProperty
- 'symbol grob
- 'grob-property gprop
- 'grob-value val))
+ 'symbol grob
+ 'grob-property gprop
+ 'grob-value val))
(define-public (make-grob-property-revert grob gprop)
"Revert the grob property @var{gprop} for @var{grob}."
(make-music 'RevertProperty
- 'symbol grob
- 'grob-property gprop))
+ 'symbol grob
+ 'grob-property gprop))
(define direction-polyphonic-grobs
'(AccidentalSuggestion
@@ -507,25 +507,25 @@ in @var{grob}."
(make-sequential-music
(append
(map (lambda (x) (make-grob-property-set x 'direction
- (if (odd? n) -1 1)))
- direction-polyphonic-grobs)
+ (if (odd? n) -1 1)))
+ direction-polyphonic-grobs)
(list
(make-property-set 'graceSettings
- ;; TODO: take this from voicedGraceSettings or similar.
- '((Voice Stem font-size -3)
- (Voice Flag font-size -3)
- (Voice NoteHead font-size -3)
- (Voice TabNoteHead font-size -4)
- (Voice Dots font-size -3)
- (Voice Stem length-fraction 0.8)
- (Voice Stem no-stem-extend #t)
- (Voice Beam beam-thickness 0.384)
- (Voice Beam length-fraction 0.8)
- (Voice Accidental font-size -4)
- (Voice AccidentalCautionary font-size -4)
- (Voice Script font-size -3)
- (Voice Fingering font-size -8)
- (Voice StringNumber font-size -8)))
+ ;; TODO: take this from voicedGraceSettings or similar.
+ '((Voice Stem font-size -3)
+ (Voice Flag font-size -3)
+ (Voice NoteHead font-size -3)
+ (Voice TabNoteHead font-size -4)
+ (Voice Dots font-size -3)
+ (Voice Stem length-fraction 0.8)
+ (Voice Stem no-stem-extend #t)
+ (Voice Beam beam-thickness 0.384)
+ (Voice Beam length-fraction 0.8)
+ (Voice Accidental font-size -4)
+ (Voice AccidentalCautionary font-size -4)
+ (Voice Script font-size -3)
+ (Voice Fingering font-size -8)
+ (Voice StringNumber font-size -8)))
(make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))))))
@@ -534,25 +534,25 @@ in @var{grob}."
(make-sequential-music
(append
(map (lambda (x) (make-grob-property-override x 'direction
- (if (odd? n) -1 1)))
- direction-polyphonic-grobs)
+ (if (odd? n) -1 1)))
+ direction-polyphonic-grobs)
(list
(make-property-set 'graceSettings
- ;; TODO: take this from voicedGraceSettings or similar.
- '((Voice Stem font-size -3)
- (Voice Flag font-size -3)
- (Voice NoteHead font-size -3)
- (Voice TabNoteHead font-size -4)
- (Voice Dots font-size -3)
- (Voice Stem length-fraction 0.8)
- (Voice Stem no-stem-extend #t)
- (Voice Beam beam-thickness 0.384)
- (Voice Beam length-fraction 0.8)
- (Voice Accidental font-size -4)
- (Voice AccidentalCautionary font-size -4)
- (Voice Script font-size -3)
- (Voice Fingering font-size -8)
- (Voice StringNumber font-size -8)))
+ ;; TODO: take this from voicedGraceSettings or similar.
+ '((Voice Stem font-size -3)
+ (Voice Flag font-size -3)
+ (Voice NoteHead font-size -3)
+ (Voice TabNoteHead font-size -4)
+ (Voice Dots font-size -3)
+ (Voice Stem length-fraction 0.8)
+ (Voice Stem no-stem-extend #t)
+ (Voice Beam beam-thickness 0.384)
+ (Voice Beam length-fraction 0.8)
+ (Voice Accidental font-size -4)
+ (Voice AccidentalCautionary font-size -4)
+ (Voice Script font-size -3)
+ (Voice Fingering font-size -8)
+ (Voice StringNumber font-size -8)))
(make-grob-property-override 'NoteColumn 'horizontal-shift (quotient n 2))
(make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
@@ -561,19 +561,19 @@ in @var{grob}."
(make-sequential-music
(append
(map (lambda (x) (make-grob-property-revert x 'direction))
- direction-polyphonic-grobs)
+ direction-polyphonic-grobs)
(list (make-property-unset 'graceSettings)
- (make-grob-property-revert 'NoteColumn 'horizontal-shift)
- (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
+ (make-grob-property-revert 'NoteColumn 'horizontal-shift)
+ (make-grob-property-revert 'MultiMeasureRest 'staff-position)))))
(define-safe-public (context-spec-music m context #:optional id)
"Add \\context CONTEXT = ID to M."
(let ((cm (make-music 'ContextSpeccedMusic
- 'element m
- 'context-type context)))
+ 'element m
+ 'context-type context)))
(if (string? id)
- (set! (ly:music-property cm 'context-id) id))
+ (set! (ly:music-property cm 'context-id) id))
cm))
(define-public (descend-to-context m context)
@@ -584,82 +584,82 @@ in @var{grob}."
(define-public (make-non-relative-music mus)
(make-music 'UnrelativableMusic
- 'element mus))
+ 'element mus))
(define-public (make-apply-context func)
(make-music 'ApplyContext
- 'procedure func))
+ 'procedure func))
(define-public (make-sequential-music elts)
(make-music 'SequentialMusic
- 'elements elts))
+ 'elements elts))
(define-public (make-simultaneous-music elts)
(make-music 'SimultaneousMusic
- 'elements elts))
+ 'elements elts))
(define-safe-public (make-event-chord elts)
(make-music 'EventChord
- 'elements elts))
+ 'elements elts))
(define-public (make-skip-music dur)
(make-music 'SkipMusic
- 'duration dur))
+ 'duration dur))
(define-public (make-grace-music music)
(make-music 'GraceMusic
- 'element music))
+ 'element music))
;;;;;;;;;;;;;;;;
;; mmrest
(define-public (make-multi-measure-rest duration location)
(make-music 'MultiMeasureRestMusic
- 'origin location
- 'duration duration))
+ 'origin location
+ 'duration duration))
(define-public (make-property-set sym val)
(make-music 'PropertySet
- 'symbol sym
- 'value val))
+ 'symbol sym
+ 'value val))
(define-public (make-property-unset sym)
(make-music 'PropertyUnset
- 'symbol sym))
+ 'symbol sym))
(define-safe-public (make-articulation name)
(make-music 'ArticulationEvent
- 'articulation-type name))
+ 'articulation-type name))
(define-public (make-lyric-event string duration)
(make-music 'LyricEvent
- 'duration duration
- 'text string))
+ 'duration duration
+ 'text string))
(define-safe-public (make-span-event type span-dir)
(make-music type
- 'span-direction span-dir))
+ 'span-direction span-dir))
(define-public (override-head-style heads style)
"Override style for @var{heads} to @var{style}."
(make-sequential-music
- (if (pair? heads)
- (map (lambda (h)
+ (if (pair? heads)
+ (map (lambda (h)
(make-grob-property-override h 'style style))
- heads)
- (list (make-grob-property-override heads 'style style)))))
+ heads)
+ (list (make-grob-property-override heads 'style style)))))
(define-public (revert-head-style heads)
"Revert style for @var{heads}."
(make-sequential-music
- (if (pair? heads)
- (map (lambda (h)
+ (if (pair? heads)
+ (map (lambda (h)
(make-grob-property-revert h 'style))
- heads)
- (list (make-grob-property-revert heads 'style)))))
+ heads)
+ (list (make-grob-property-revert heads 'style)))))
(define-public (style-note-heads heads style music)
- "Set @var{style} for all @var{heads} in @var{music}. Works both
+ "Set @var{style} for all @var{heads} in @var{music}. Works both
inside of and outside of chord construct."
;; are we inside a <...>?
(if (eq? (ly:music-property music 'name) 'NoteEvent)
@@ -670,17 +670,17 @@ inside of and outside of chord construct."
music)
;; not in <...>, so use overrides
(make-sequential-music
- (list
- (override-head-style heads style)
- music
- (revert-head-style heads)))))
+ (list
+ (override-head-style heads style)
+ music
+ (revert-head-style heads)))))
- (define-public (set-mus-properties! m alist)
+(define-public (set-mus-properties! m alist)
"Set all of @var{alist} as properties of @var{m}."
(if (pair? alist)
(begin
- (set! (ly:music-property m (caar alist)) (cdar alist))
- (set-mus-properties! m (cdr alist)))))
+ (set! (ly:music-property m (caar alist)) (cdar alist))
+ (set-mus-properties! m (cdr alist)))))
(define-public (music-separator? m)
"Is @var{m} a separator?"
@@ -689,7 +689,7 @@ inside of and outside of chord construct."
;;; expanding repeat chords
(define-public (copy-repeat-chord original-chord repeat-chord duration
- event-types)
+ event-types)
"Copies all events in @var{event-types} (be sure to include
@code{rhythmic-events}) from @var{original-chord} over to
@var{repeat-chord} with their articulations filtered as well. Any
@@ -701,47 +701,47 @@ duration is replaced with the specified @var{duration}."
(define (keep-element? m)
(any (lambda (t) (music-is-of-type? m t))
- event-types))
+ event-types))
(define origin (ly:music-property repeat-chord 'origin #f))
(define (set-origin! l)
(if origin
- (for-each (lambda (m) (set! (ly:music-property m 'origin) origin)) l))
+ (for-each (lambda (m) (set! (ly:music-property m 'origin) origin)) l))
l)
(for-each
(lambda (field)
(for-each (lambda (e)
- (for-each (lambda (x)
- (set! event-types (delq x event-types)))
- (ly:music-property e 'types)))
- (ly:music-property repeat-chord field)))
+ (for-each (lambda (x)
+ (set! event-types (delq x event-types)))
+ (ly:music-property e 'types)))
+ (ly:music-property repeat-chord field)))
'(elements articulations))
;; now treat the elements
(set! (ly:music-property repeat-chord 'elements)
- (let ((elts
- (set-origin! (ly:music-deep-copy
- (filter keep-element?
- (ly:music-property original-chord
- 'elements))))))
- (for-each
- (lambda (m)
- (let ((arts (ly:music-property m 'articulations)))
- (if (pair? arts)
- (set! (ly:music-property m 'articulations)
- (set-origin! (filter! keep-element? arts))))
- (if (ly:duration? (ly:music-property m 'duration))
- (set! (ly:music-property m 'duration) duration))))
- elts)
- (append! elts (ly:music-property repeat-chord 'elements))))
+ (let ((elts
+ (set-origin! (ly:music-deep-copy
+ (filter keep-element?
+ (ly:music-property original-chord
+ 'elements))))))
+ (for-each
+ (lambda (m)
+ (let ((arts (ly:music-property m 'articulations)))
+ (if (pair? arts)
+ (set! (ly:music-property m 'articulations)
+ (set-origin! (filter! keep-element? arts))))
+ (if (ly:duration? (ly:music-property m 'duration))
+ (set! (ly:music-property m 'duration) duration))))
+ elts)
+ (append! elts (ly:music-property repeat-chord 'elements))))
(let ((arts (filter keep-element?
- (ly:music-property original-chord
- 'articulations))))
+ (ly:music-property original-chord
+ 'articulations))))
(if (pair? arts)
- (set! (ly:music-property repeat-chord 'articulations)
- (append!
- (set-origin! (ly:music-deep-copy arts))
- (ly:music-property repeat-chord 'articulations))))))
+ (set! (ly:music-property repeat-chord 'articulations)
+ (append!
+ (set-origin! (ly:music-deep-copy arts))
+ (ly:music-property repeat-chord 'articulations))))))
(define-public (expand-repeat-chords! event-types music)
@@ -750,24 +750,24 @@ having a duration in @code{duration}) with the notes from their
respective predecessor chord."
(let loop ((music music) (last-chord #f))
(if (music-is-of-type? music 'event-chord)
- (let ((chord-repeat (ly:music-property music 'duration)))
- (cond
- ((not (ly:duration? chord-repeat))
- (if (any (lambda (m) (ly:duration?
- (ly:music-property m 'duration)))
- (ly:music-property music 'elements))
- music
- last-chord))
- (last-chord
- (set! (ly:music-property music 'duration) '())
- (copy-repeat-chord last-chord music chord-repeat event-types)
- music)
- (else
- (ly:music-warning music (_ "Bad chord repetition"))
- #f)))
- (let ((elt (ly:music-property music 'element)))
- (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord)
- (ly:music-property music 'elements)))))
+ (let ((chord-repeat (ly:music-property music 'duration)))
+ (cond
+ ((not (ly:duration? chord-repeat))
+ (if (any (lambda (m) (ly:duration?
+ (ly:music-property m 'duration)))
+ (ly:music-property music 'elements))
+ music
+ last-chord))
+ (last-chord
+ (set! (ly:music-property music 'duration) '())
+ (copy-repeat-chord last-chord music chord-repeat event-types)
+ music)
+ (else
+ (ly:music-warning music (_ "Bad chord repetition"))
+ #f)))
+ (let ((elt (ly:music-property music 'element)))
+ (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord)
+ (ly:music-property music 'elements)))))
music)
;;; splitting chords into voices.
@@ -782,17 +782,17 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
(if (null? lst)
'()
(cons (context-spec-music
- (make-sequential-music
- (list (make-voice-props-set number)
- (make-simultaneous-music (car lst))))
- 'Bottom (number->string (1+ number)))
- (voicify-list (cdr lst) (1+ number)))))
+ (make-sequential-music
+ (list (make-voice-props-set number)
+ (make-simultaneous-music (car lst))))
+ 'Bottom (number->string (1+ number)))
+ (voicify-list (cdr lst) (1+ number)))))
(define (voicify-chord ch)
"Split the parts of a chord into different Voices using separator"
(let ((es (ly:music-property ch 'elements)))
(set! (ly:music-property ch 'elements)
- (voicify-list (split-list-by-separator es music-separator?) 0))
+ (voicify-list (split-list-by-separator es music-separator?) 0))
ch))
(define-public (voicify-music m)
@@ -800,15 +800,15 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
(if (not (ly:music? m))
(ly:error (_ "music expected: ~S") m))
(let ((es (ly:music-property m 'elements))
- (e (ly:music-property m 'element)))
+ (e (ly:music-property m 'element)))
(if (pair? es)
- (set! (ly:music-property m 'elements) (map voicify-music es)))
+ (set! (ly:music-property m 'elements) (map voicify-music es)))
(if (ly:music? e)
- (set! (ly:music-property m 'element) (voicify-music e)))
+ (set! (ly:music-property m 'element) (voicify-music e)))
(if (and (equal? (ly:music-property m 'name) 'SimultaneousMusic)
- (any music-separator? es))
- (set! m (context-spec-music (voicify-chord m) 'Staff)))
+ (any music-separator? es))
+ (set! m (context-spec-music (voicify-chord m) 'Staff)))
m))
(define-public (empty-music)
@@ -829,7 +829,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
@code{\\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1))}"
(let ((meta (ly:grob-property grob 'meta)))
(if (equal? (assoc-get 'name meta) grob-name)
- (set! (ly:grob-property grob symbol) val))))
+ (set! (ly:grob-property grob symbol) val))))
(define-public (skip->rest mus)
@@ -837,8 +837,8 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0.
@code{SkipEvent}. Useful for extracting parts from crowded scores."
(if (memq (ly:music-property mus 'name) '(SkipEvent SkipMusic))
- (make-music 'RestEvent 'duration (ly:music-property mus 'duration))
- mus))
+ (make-music 'RestEvent 'duration (ly:music-property mus 'duration))
+ mus))
(define-public (music-has-type music type)
@@ -899,7 +899,7 @@ actually fully cloned."
(define (vector-extend v x)
"Make a new vector consisting of V, with X added to the end."
(let* ((n (vector-length v))
- (nv (make-vector (+ n 1) '())))
+ (nv (make-vector (+ n 1) '())))
(vector-move-left! v 0 n nv 0)
(vector-set! nv n x)
nv))
@@ -921,9 +921,9 @@ actually fully cloned."
"Set @var{sym}=@var{val} for @var{grob} in @var{context-name}."
(define (set-prop context)
(let* ((where (ly:context-property-where-defined context 'graceSettings))
- (current (ly:context-property where 'graceSettings))
- (new-settings (append current
- (list (list context-name grob sym val)))))
+ (current (ly:context-property where 'graceSettings))
+ (new-settings (append current
+ (list (list context-name grob sym val)))))
(ly:context-set-property! where 'graceSettings new-settings)))
(context-spec-music (make-apply-context set-prop) 'Voice))
@@ -935,14 +935,14 @@ actually fully cloned."
(eq? (caddr property) sym)))
(define (delete-prop context)
(let* ((where (ly:context-property-where-defined context 'graceSettings))
- (current (ly:context-property where 'graceSettings))
+ (current (ly:context-property where 'graceSettings))
(prop-settings (filter
- (lambda(x) (sym-grob-context? x sym grob context-name))
- current))
- (new-settings current))
+ (lambda(x) (sym-grob-context? x sym grob context-name))
+ current))
+ (new-settings current))
(for-each (lambda(x)
- (set! new-settings (delete x new-settings)))
- prop-settings)
+ (set! new-settings (delete x new-settings)))
+ prop-settings)
(ly:context-set-property! where 'graceSettings new-settings)))
(context-spec-music (make-apply-context delete-prop) 'Voice))
@@ -953,11 +953,11 @@ actually fully cloned."
`(define-music-function (parser location music) (ly:music?)
,@docstring
(make-music 'GraceMusic
- 'origin location
- 'element (make-music 'SequentialMusic
- 'elements (list (ly:music-deep-copy ,start)
- music
- (ly:music-deep-copy ,stop))))))
+ 'origin location
+ 'element (make-music 'SequentialMusic
+ 'elements (list (ly:music-deep-copy ,start)
+ music
+ (ly:music-deep-copy ,stop))))))
(defmacro-public define-syntax-function (type args signature . body)
"Helper macro for `ly:make-music-function'.
@@ -982,23 +982,23 @@ predicates, to be used in case of a type error in arguments or
result."
(set! signature (map (lambda (pred)
- (if (pair? pred)
- `(cons ,(car pred)
- ,(and (pair? (cdr pred)) (cadr pred)))
- pred))
- (cons type signature)))
+ (if (pair? pred)
+ `(cons ,(car pred)
+ ,(and (pair? (cdr pred)) (cadr pred)))
+ pred))
+ (cons type signature)))
(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body)))
;; When the music function definition contains a i10n doc string,
;; (_i "doc string"), keep the literal string only
(let ((docstring (cadar body))
- (body (cdr body)))
- `(ly:make-music-function (list ,@signature)
- (lambda ,args
- ,docstring
- ,@body)))
+ (body (cdr body)))
+ `(ly:make-music-function (list ,@signature)
+ (lambda ,args
+ ,docstring
+ ,@body)))
`(ly:make-music-function (list ,@signature)
- (lambda ,args
- ,@body))))
+ (lambda ,args
+ ,@body))))
(defmacro-public define-music-function rest
"Defining macro returning music functions.
@@ -1086,57 +1086,57 @@ set to the @code{location} parameter."
(if (vector? (ly:music-property quote-music 'quoted-events))
(let* ((dir (ly:music-property quote-music 'quoted-voice-direction))
- (clef (ly:music-property quote-music 'quoted-music-clef #f))
- (main-voice (case dir ((1) 1) ((-1) 0) (else #f)))
- (cue-voice (and main-voice (- 1 main-voice)))
- (main-music (ly:music-property quote-music 'element))
- (return-value quote-music))
-
- (if main-voice
- (set! (ly:music-property quote-music 'element)
- (make-sequential-music
- (list
- (make-voice-props-override main-voice)
- main-music
- (make-voice-props-revert)))))
-
- ;; if we have stem dirs, change both quoted and main music
- ;; to have opposite stems.
-
- ;; cannot context-spec Quote-music, since context
- ;; for the quotes is determined in the iterator.
-
- (make-sequential-music
- (delq! #f
- (list
- (and clef (make-cue-clef-set clef))
-
- ;; Need to establish CueVoice context even in #CENTER case
- (context-spec-music
- (if cue-voice
- (make-voice-props-override cue-voice)
- (make-music 'Music))
- 'CueVoice "cue")
- quote-music
- (and cue-voice
- (context-spec-music
- (make-voice-props-revert) 'CueVoice "cue"))
- (and clef (make-cue-clef-unset))))))
+ (clef (ly:music-property quote-music 'quoted-music-clef #f))
+ (main-voice (case dir ((1) 1) ((-1) 0) (else #f)))
+ (cue-voice (and main-voice (- 1 main-voice)))
+ (main-music (ly:music-property quote-music 'element))
+ (return-value quote-music))
+
+ (if main-voice
+ (set! (ly:music-property quote-music 'element)
+ (make-sequential-music
+ (list
+ (make-voice-props-override main-voice)
+ main-music
+ (make-voice-props-revert)))))
+
+ ;; if we have stem dirs, change both quoted and main music
+ ;; to have opposite stems.
+
+ ;; cannot context-spec Quote-music, since context
+ ;; for the quotes is determined in the iterator.
+
+ (make-sequential-music
+ (delq! #f
+ (list
+ (and clef (make-cue-clef-set clef))
+
+ ;; Need to establish CueVoice context even in #CENTER case
+ (context-spec-music
+ (if cue-voice
+ (make-voice-props-override cue-voice)
+ (make-music 'Music))
+ 'CueVoice "cue")
+ quote-music
+ (and cue-voice
+ (context-spec-music
+ (make-voice-props-revert) 'CueVoice "cue"))
+ (and clef (make-cue-clef-unset))))))
quote-music))
(define-public ((quote-substitute quote-tab) music)
(let* ((quoted-name (ly:music-property music 'quoted-music-name))
- (quoted-vector (and (string? quoted-name)
- (hash-ref quote-tab quoted-name #f))))
+ (quoted-vector (and (string? quoted-name)
+ (hash-ref quote-tab quoted-name #f))))
(if (string? quoted-name)
- (if (vector? quoted-vector)
- (begin
- (set! (ly:music-property music 'quoted-events) quoted-vector)
- (set! (ly:music-property music 'iterator-ctor)
- ly:quote-iterator::constructor))
- (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name))))
+ (if (vector? quoted-vector)
+ (begin
+ (set! (ly:music-property music 'quoted-events) quoted-vector)
+ (set! (ly:music-property music 'iterator-ctor)
+ ly:quote-iterator::constructor))
+ (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name))))
music))
@@ -1154,8 +1154,8 @@ set to the @code{location} parameter."
(define found #f)
(define (signal m)
(if (and (ly:music? m)
- (eq? (ly:music-property m 'error-found) #t))
- (set! found #t)))
+ (eq? (ly:music-property m 'error-found) #t))
+ (set! found #t)))
(for-each signal (ly:music-property music 'elements))
(signal (ly:music-property music 'element))
@@ -1166,27 +1166,27 @@ set to the @code{location} parameter."
(define (precompute-music-length music)
(set! (ly:music-property music 'length)
- (ly:music-length music))
+ (ly:music-length music))
music)
(define-public (make-duration-of-length moment)
- "Make duration of the given @code{moment} length."
- (ly:make-duration 0 0
- (ly:moment-main-numerator moment)
- (ly:moment-main-denominator moment)))
+ "Make duration of the given @code{moment} length."
+ (ly:make-duration 0 0
+ (ly:moment-main-numerator moment)
+ (ly:moment-main-denominator moment)))
(define (make-skipped moment bool)
- "Depending on BOOL, set or unset skipTypesetting,
+ "Depending on BOOL, set or unset skipTypesetting,
then make SkipMusic of the given MOMENT length, and
then revert skipTypesetting."
- (make-sequential-music
- (list
- (context-spec-music (make-property-set 'skipTypesetting bool)
- 'Score)
- (make-music 'SkipMusic 'duration
- (make-duration-of-length moment))
- (context-spec-music (make-property-set 'skipTypesetting (not bool))
- 'Score))))
+ (make-sequential-music
+ (list
+ (context-spec-music (make-property-set 'skipTypesetting bool)
+ 'Score)
+ (make-music 'SkipMusic 'duration
+ (make-duration-of-length moment))
+ (context-spec-music (make-property-set 'skipTypesetting (not bool))
+ 'Score))))
(define (skip-as-needed music parser)
"Replace MUSIC by
@@ -1204,9 +1204,9 @@ then revert skipTypesetting."
((show-last (ly:parser-lookup parser 'showLastLength))
(show-first (ly:parser-lookup parser 'showFirstLength))
(show-last-length (and (ly:music? show-last)
- (ly:music-length show-last)))
+ (ly:music-length show-last)))
(show-first-length (and (ly:music? show-first)
- (ly:music-length show-first)))
+ (ly:music-length show-first)))
(orig-length (ly:music-length music)))
;;FIXME: if using either showFirst- or showLastLength,
@@ -1253,9 +1253,9 @@ then revert skipTypesetting."
(define-public toplevel-music-functions
(list
(lambda (music parser) (expand-repeat-chords!
- (cons 'rhythmic-event
- (ly:parser-lookup parser '$chord-repeat-events))
- music))
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music))
(lambda (music parser) (voicify-music music))
(lambda (x parser) (music-map music-check-error x))
(lambda (x parser) (music-map precompute-music-length x))
@@ -1268,7 +1268,7 @@ then revert skipTypesetting."
(lambda (x parser)
(skip-as-needed x parser)
- )))
+ )))
;;;;;;;;;;
;;; general purpose music functions
@@ -1276,9 +1276,9 @@ then revert skipTypesetting."
(define (shift-octave pitch octave-shift)
(_i "Add @var{octave-shift} to the octave of @var{pitch}.")
(ly:make-pitch
- (+ (ly:pitch-octave pitch) octave-shift)
- (ly:pitch-notename pitch)
- (ly:pitch-alteration pitch)))
+ (+ (ly:pitch-octave pitch) octave-shift)
+ (ly:pitch-notename pitch)
+ (ly:pitch-alteration pitch)))
;;;;;;;;;;;;;;;;;
@@ -1287,10 +1287,10 @@ then revert skipTypesetting."
(define (apply-durations lyric-music durations)
(define (apply-duration music)
(if (and (not (equal? (ly:music-length music) ZERO-MOMENT))
- (ly:duration? (ly:music-property music 'duration)))
- (begin
- (set! (ly:music-property music 'duration) (car durations))
- (set! durations (cdr durations)))))
+ (ly:duration? (ly:music-property music 'duration)))
+ (begin
+ (set! (ly:music-property music 'duration) (car durations))
+ (set! durations (cdr durations)))))
(music-map apply-duration lyric-music))
@@ -1312,16 +1312,16 @@ can be omitted when the same note occurs again.
Returns @code{#f} or the reason for the invalidation, a symbol."
(let* ((def (if (pair? alteration-def)
- (car alteration-def)
- alteration-def)))
+ (car alteration-def)
+ alteration-def)))
(and (symbol? def) def)))
(define (extract-alteration alteration-def)
(cond ((number? alteration-def)
- alteration-def)
- ((pair? alteration-def)
- (car alteration-def))
- (else 0)))
+ alteration-def)
+ ((pair? alteration-def)
+ (car alteration-def))
+ (else 0)))
(define (check-pitch-against-signature context pitch barnum laziness octaveness)
"Checks the need for an accidental and a @q{restore} accidental against
@@ -1332,50 +1332,50 @@ we cancel accidentals up to three measures after they first appear.
@var{octaveness} is either @code{'same-octave} or @code{'any-octave} and
specifies whether accidentals should be canceled in different octaves."
(let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t)
- ((equal? octaveness 'same-octave) #f)
- (else
- (ly:warning (_ "Unknown octaveness type: ~S ") octaveness)
- (ly:warning (_ "Defaulting to 'any-octave."))
- #t)))
- (key-sig (ly:context-property context 'keySignature))
- (local-key-sig (ly:context-property context 'localKeySignature))
- (notename (ly:pitch-notename pitch))
- (octave (ly:pitch-octave pitch))
- (pitch-handle (cons octave notename))
- (need-restore #f)
- (need-accidental #f)
- (previous-alteration #f)
- (from-other-octaves #f)
- (from-same-octave (assoc-get pitch-handle local-key-sig))
- (from-key-sig (or (assoc-get notename local-key-sig)
-
- ;; If no key signature match is found from localKeySignature, we may have a custom
- ;; type with octave-specific entries of the form ((octave . pitch) alteration)
- ;; instead of (pitch . alteration). Since this type cannot coexist with entries in
- ;; localKeySignature, try extracting from keySignature instead.
- (assoc-get pitch-handle key-sig))))
+ ((equal? octaveness 'same-octave) #f)
+ (else
+ (ly:warning (_ "Unknown octaveness type: ~S ") octaveness)
+ (ly:warning (_ "Defaulting to 'any-octave."))
+ #t)))
+ (key-sig (ly:context-property context 'keySignature))
+ (local-key-sig (ly:context-property context 'localKeySignature))
+ (notename (ly:pitch-notename pitch))
+ (octave (ly:pitch-octave pitch))
+ (pitch-handle (cons octave notename))
+ (need-restore #f)
+ (need-accidental #f)
+ (previous-alteration #f)
+ (from-other-octaves #f)
+ (from-same-octave (assoc-get pitch-handle local-key-sig))
+ (from-key-sig (or (assoc-get notename local-key-sig)
+
+ ;; If no key signature match is found from localKeySignature, we may have a custom
+ ;; type with octave-specific entries of the form ((octave . pitch) alteration)
+ ;; instead of (pitch . alteration). Since this type cannot coexist with entries in
+ ;; localKeySignature, try extracting from keySignature instead.
+ (assoc-get pitch-handle key-sig))))
;; loop through localKeySignature to search for a notename match from other octaves
(let loop ((l local-key-sig))
(if (pair? l)
- (let ((entry (car l)))
- (if (and (pair? (car entry))
- (= (cdar entry) notename))
- (set! from-other-octaves (cdr entry))
- (loop (cdr l))))))
+ (let ((entry (car l)))
+ (if (and (pair? (car entry))
+ (= (cdar entry) notename))
+ (set! from-other-octaves (cdr entry))
+ (loop (cdr l))))))
;; find previous alteration-def for comparison with pitch
(cond
;; from same octave?
((and (not ignore-octave)
- from-same-octave
- (recent-enough? barnum from-same-octave laziness))
+ from-same-octave
+ (recent-enough? barnum from-same-octave laziness))
(set! previous-alteration from-same-octave))
;; from any octave?
((and ignore-octave
- from-other-octaves
- (recent-enough? barnum from-other-octaves laziness))
+ from-other-octaves
+ (recent-enough? barnum from-other-octaves laziness))
(set! previous-alteration from-other-octaves))
;; not recent enough, extract from key signature/local key signature
@@ -1383,18 +1383,18 @@ specifies whether accidentals should be canceled in different octaves."
(set! previous-alteration from-key-sig)))
(if (accidental-invalid? previous-alteration)
- (set! need-accidental #t)
+ (set! need-accidental #t)
- (let* ((prev-alt (extract-alteration previous-alteration))
- (this-alt (ly:pitch-alteration pitch)))
+ (let* ((prev-alt (extract-alteration previous-alteration))
+ (this-alt (ly:pitch-alteration pitch)))
- (if (not (= this-alt prev-alt))
- (begin
- (set! need-accidental #t)
- (if (and (not (= this-alt 0))
- (and (< (abs this-alt) (abs prev-alt))
- (> (* prev-alt this-alt) 0)))
- (set! need-restore #t))))))
+ (if (not (= this-alt prev-alt))
+ (begin
+ (set! need-accidental #t)
+ (if (and (not (= this-alt 0))
+ (and (< (abs this-alt) (abs prev-alt))
+ (> (* prev-alt this-alt) 0)))
+ (set! need-restore #t))))))
(cons need-restore need-accidental)))
@@ -1455,8 +1455,8 @@ See @code{key-entry-notename} for details."
For convenience, returns @code{0} if entry is @code{#f}."
(if entry
(if (number? (cdr entry))
- (cdr entry)
- (cadr entry))
+ (cdr entry)
+ (cadr entry))
0))
(define-public (find-pitch-entry keysig pitch accept-global accept-local)
@@ -1466,17 +1466,17 @@ For convenience, returns @code{0} if entry is @code{#f}."
If no matching entry is found, @var{#f} is returned."
(and (pair? keysig)
(let* ((entry (car keysig))
- (entryoct (key-entry-octave entry))
- (entrynn (key-entry-notename entry))
- (nn (ly:pitch-notename pitch)))
- (if (and (equal? nn entrynn)
- (or (not entryoct)
- (= entryoct (ly:pitch-octave pitch)))
- (if (key-entry-bar-number entry)
- accept-local
- accept-global))
- entry
- (find-pitch-entry (cdr keysig) pitch accept-global accept-local)))))
+ (entryoct (key-entry-octave entry))
+ (entrynn (key-entry-notename entry))
+ (nn (ly:pitch-notename pitch)))
+ (if (and (equal? nn entrynn)
+ (or (not entryoct)
+ (= entryoct (ly:pitch-octave pitch)))
+ (if (key-entry-bar-number entry)
+ accept-local
+ accept-global))
+ entry
+ (find-pitch-entry (cdr keysig) pitch accept-global accept-local)))))
(define-public (neo-modern-accidental-rule context pitch barnum measurepos)
"An accidental rule that typesets an accidental if it differs from the
@@ -1484,39 +1484,39 @@ key signature @emph{and} does not directly follow a note on the same
staff line. This rule should not be used alone because it does neither
look at bar lines nor different accidentals at the same note name."
(let* ((keysig (ly:context-property context 'localKeySignature))
- (entry (find-pitch-entry keysig pitch #t #t)))
+ (entry (find-pitch-entry keysig pitch #t #t)))
(if (not entry)
- (cons #f #f)
- (let* ((global-entry (find-pitch-entry keysig pitch #t #f))
- (key-acc (key-entry-alteration global-entry))
- (acc (ly:pitch-alteration pitch))
- (entrymp (key-entry-measure-position entry))
- (entrybn (key-entry-bar-number entry)))
- (cons #f (not (or (equal? acc key-acc)
- (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
+ (cons #f #f)
+ (let* ((global-entry (find-pitch-entry keysig pitch #t #f))
+ (key-acc (key-entry-alteration global-entry))
+ (acc (ly:pitch-alteration pitch))
+ (entrymp (key-entry-measure-position entry))
+ (entrybn (key-entry-bar-number entry)))
+ (cons #f (not (or (equal? acc key-acc)
+ (and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
(define-public (teaching-accidental-rule context pitch barnum measurepos)
"An accidental rule that typesets a cautionary accidental if it is
included in the key signature @emph{and} does not directly follow a note
on the same staff line."
(let* ((keysig (ly:context-property context 'localKeySignature))
- (entry (find-pitch-entry keysig pitch #t #t)))
+ (entry (find-pitch-entry keysig pitch #t #t)))
(if (not entry)
- (cons #f #f)
- (let* ((entrymp (key-entry-measure-position entry))
- (entrybn (key-entry-bar-number entry)))
- (cons #f (not (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
+ (cons #f #f)
+ (let* ((entrymp (key-entry-measure-position entry))
+ (entrybn (key-entry-bar-number entry)))
+ (cons #f (not (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
(define-public (set-accidentals-properties extra-natural
- auto-accs auto-cauts
- context)
+ auto-accs auto-cauts
+ context)
(context-spec-music
(make-sequential-music
(append (if (boolean? extra-natural)
- (list (make-property-set 'extraNatural extra-natural))
- '())
- (list (make-property-set 'autoAccidentals auto-accs)
- (make-property-set 'autoCautionaries auto-cauts))))
+ (list (make-property-set 'extraNatural extra-natural))
+ '())
+ (list (make-property-set 'autoAccidentals auto-accs)
+ (make-property-set 'autoCautionaries auto-cauts))))
context))
(define-public (set-accidental-style style . rest)
@@ -1525,163 +1525,163 @@ argument, e.g. @code{'Staff} or @code{'Voice}. The context defaults
to @code{Staff}, except for piano styles, which use @code{GrandStaff}
as a context."
(let ((context (if (pair? rest)
- (car rest) 'Staff))
- (pcontext (if (pair? rest)
- (car rest) 'GrandStaff)))
+ (car rest) 'Staff))
+ (pcontext (if (pair? rest)
+ (car rest) 'GrandStaff)))
(cond
- ;; accidentals as they were common in the 18th century.
- ((equal? style 'default)
- (set-accidentals-properties #t
- `(Staff ,(make-accidental-rule 'same-octave 0))
- '()
- context))
- ;; accidentals from one voice do NOT get canceled in other voices
- ((equal? style 'voice)
- (set-accidentals-properties #t
- `(Voice ,(make-accidental-rule 'same-octave 0))
- '()
- context))
- ;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century.
- ;; This includes all the default accidentals, but accidentals also needs canceling
- ;; in other octaves and in the next measure.
- ((equal? style 'modern)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- '()
- context))
- ;; the accidentals that Stone adds to the old standard as cautionaries
- ((equal? style 'modern-cautionary)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- context))
- ;; same as modern, but accidentals different from the key signature are always
- ;; typeset - unless they directly follow a note of the same pitch.
- ((equal? style 'neo-modern)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- '()
- context))
- ((equal? style 'neo-modern-cautionary)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- context))
- ((equal? style 'neo-modern-voice)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- '()
- context))
- ((equal? style 'neo-modern-voice-cautionary)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0))
- `(Voice ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- ,neo-modern-accidental-rule)
- context))
- ;; Accidentals as they were common in dodecaphonic music with no tonality.
- ;; Each note gets one accidental.
- ((equal? style 'dodecaphonic)
- (set-accidentals-properties #f
- `(Staff ,(lambda (c p bn mp) '(#f . #t)))
- '()
- context))
- ;; Multivoice accidentals to be read both by musicians playing one voice
- ;; and musicians playing all voices.
- ;; Accidentals are typeset for each voice, but they ARE canceled across voices.
- ((equal? style 'modern-voice)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- '()
- context))
- ;; same as modernVoiceAccidental eccept that all special accidentals are typeset
- ;; as cautionaries
- ((equal? style 'modern-voice-cautionary)
- (set-accidentals-properties #f
- `(Voice ,(make-accidental-rule 'same-octave 0))
- `(Voice ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- context))
- ;; stone's suggestions for accidentals on grand staff.
- ;; Accidentals are canceled across the staves in the same grand staff as well
- ((equal? style 'piano)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- GrandStaff
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- '()
- pcontext))
- ((equal? style 'piano-cautionary)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1)
- GrandStaff
- ,(make-accidental-rule 'any-octave 0)
- ,(make-accidental-rule 'same-octave 1))
- pcontext))
-
- ;; same as modern, but cautionary accidentals are printed for all sharp or flat
- ;; tones specified by the key signature.
- ((equal? style 'teaching)
- (set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0))
- `(Staff ,(make-accidental-rule 'same-octave 1)
- ,teaching-accidental-rule)
- context))
-
- ;; do not set localKeySignature when a note alterated differently from
- ;; localKeySignature is found.
- ;; Causes accidentals to be printed at every note instead of
- ;; remembered for the duration of a measure.
- ;; accidentals not being remembered, causing accidentals always to
- ;; be typeset relative to the time signature
- ((equal? style 'forget)
- (set-accidentals-properties '()
- `(Staff ,(make-accidental-rule 'same-octave -1))
- '()
- context))
- ;; Do not reset the key at the start of a measure. Accidentals will be
- ;; printed only once and are in effect until overridden, possibly many
- ;; measures later.
- ((equal? style 'no-reset)
- (set-accidentals-properties '()
- `(Staff ,(make-accidental-rule 'same-octave #t))
- '()
- context))
- (else
- (ly:warning (_ "unknown accidental style: ~S") style)
- (make-sequential-music '())))))
+ ;; accidentals as they were common in the 18th century.
+ ((equal? style 'default)
+ (set-accidentals-properties #t
+ `(Staff ,(make-accidental-rule 'same-octave 0))
+ '()
+ context))
+ ;; accidentals from one voice do NOT get canceled in other voices
+ ((equal? style 'voice)
+ (set-accidentals-properties #t
+ `(Voice ,(make-accidental-rule 'same-octave 0))
+ '()
+ context))
+ ;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century.
+ ;; This includes all the default accidentals, but accidentals also needs canceling
+ ;; in other octaves and in the next measure.
+ ((equal? style 'modern)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ '()
+ context))
+ ;; the accidentals that Stone adds to the old standard as cautionaries
+ ((equal? style 'modern-cautionary)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0))
+ `(Staff ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ context))
+ ;; same as modern, but accidentals different from the key signature are always
+ ;; typeset - unless they directly follow a note of the same pitch.
+ ((equal? style 'neo-modern)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule)
+ '()
+ context))
+ ((equal? style 'neo-modern-cautionary)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0))
+ `(Staff ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule)
+ context))
+ ((equal? style 'neo-modern-voice)
+ (set-accidentals-properties #f
+ `(Voice ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule
+ Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule)
+ '()
+ context))
+ ((equal? style 'neo-modern-voice-cautionary)
+ (set-accidentals-properties #f
+ `(Voice ,(make-accidental-rule 'same-octave 0))
+ `(Voice ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule
+ Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ ,neo-modern-accidental-rule)
+ context))
+ ;; Accidentals as they were common in dodecaphonic music with no tonality.
+ ;; Each note gets one accidental.
+ ((equal? style 'dodecaphonic)
+ (set-accidentals-properties #f
+ `(Staff ,(lambda (c p bn mp) '(#f . #t)))
+ '()
+ context))
+ ;; Multivoice accidentals to be read both by musicians playing one voice
+ ;; and musicians playing all voices.
+ ;; Accidentals are typeset for each voice, but they ARE canceled across voices.
+ ((equal? style 'modern-voice)
+ (set-accidentals-properties #f
+ `(Voice ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ '()
+ context))
+ ;; same as modernVoiceAccidental eccept that all special accidentals are typeset
+ ;; as cautionaries
+ ((equal? style 'modern-voice-cautionary)
+ (set-accidentals-properties #f
+ `(Voice ,(make-accidental-rule 'same-octave 0))
+ `(Voice ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ context))
+ ;; stone's suggestions for accidentals on grand staff.
+ ;; Accidentals are canceled across the staves in the same grand staff as well
+ ((equal? style 'piano)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0)
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ GrandStaff
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ '()
+ pcontext))
+ ((equal? style 'piano-cautionary)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0))
+ `(Staff ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1)
+ GrandStaff
+ ,(make-accidental-rule 'any-octave 0)
+ ,(make-accidental-rule 'same-octave 1))
+ pcontext))
+
+ ;; same as modern, but cautionary accidentals are printed for all sharp or flat
+ ;; tones specified by the key signature.
+ ((equal? style 'teaching)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-rule 'same-octave 0))
+ `(Staff ,(make-accidental-rule 'same-octave 1)
+ ,teaching-accidental-rule)
+ context))
+
+ ;; do not set localKeySignature when a note alterated differently from
+ ;; localKeySignature is found.
+ ;; Causes accidentals to be printed at every note instead of
+ ;; remembered for the duration of a measure.
+ ;; accidentals not being remembered, causing accidentals always to
+ ;; be typeset relative to the time signature
+ ((equal? style 'forget)
+ (set-accidentals-properties '()
+ `(Staff ,(make-accidental-rule 'same-octave -1))
+ '()
+ context))
+ ;; Do not reset the key at the start of a measure. Accidentals will be
+ ;; printed only once and are in effect until overridden, possibly many
+ ;; measures later.
+ ((equal? style 'no-reset)
+ (set-accidentals-properties '()
+ `(Staff ,(make-accidental-rule 'same-octave #t))
+ '()
+ context))
+ (else
+ (ly:warning (_ "unknown accidental style: ~S") style)
+ (make-sequential-music '())))))
(define-public (invalidate-alterations context)
"Invalidate alterations in @var{context}.
@@ -1695,31 +1695,31 @@ to force a repetition of accidentals.
Entries that conform with the current key signature are not invalidated."
(let* ((keysig (ly:context-property context 'keySignature)))
(set! (ly:context-property context 'localKeySignature)
- (map-in-order
- (lambda (entry)
- (let* ((localalt (key-entry-alteration entry)))
- (if (or (accidental-invalid? localalt)
- (not (key-entry-bar-number entry))
- (= localalt
- (key-entry-alteration
- (find-pitch-entry
- keysig
- (ly:make-pitch (key-entry-octave entry)
- (key-entry-notename entry)
- 0)
- #t #t))))
- entry
- (cons (car entry) (cons 'clef (cddr entry))))))
- (ly:context-property context 'localKeySignature)))))
+ (map-in-order
+ (lambda (entry)
+ (let* ((localalt (key-entry-alteration entry)))
+ (if (or (accidental-invalid? localalt)
+ (not (key-entry-bar-number entry))
+ (= localalt
+ (key-entry-alteration
+ (find-pitch-entry
+ keysig
+ (ly:make-pitch (key-entry-octave entry)
+ (key-entry-notename entry)
+ 0)
+ #t #t))))
+ entry
+ (cons (car entry) (cons 'clef (cddr entry))))))
+ (ly:context-property context 'localKeySignature)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public (skip-of-length mus)
"Create a skip of exactly the same length as @var{mus}."
(let* ((skip
- (make-music
- 'SkipEvent
- 'duration (ly:make-duration 0 0))))
+ (make-music
+ 'SkipEvent
+ 'duration (ly:make-duration 0 0))))
(make-event-chord (list (ly:music-compress skip (ly:music-length mus))))))
@@ -1727,29 +1727,29 @@ Entries that conform with the current key signature are not invalidated."
"Create a multi-measure rest of exactly the same length as @var{mus}."
(let* ((skip
- (make-multi-measure-rest
- (ly:make-duration 0 0) '())))
+ (make-multi-measure-rest
+ (ly:make-duration 0 0) '())))
(ly:music-compress skip (ly:music-length mus))
skip))
(define-public (pitch-of-note event-chord)
(let ((evs (filter (lambda (x)
- (music-has-type x 'note-event))
- (ly:music-property event-chord 'elements))))
+ (music-has-type x 'note-event))
+ (ly:music-property event-chord 'elements))))
(and (pair? evs)
- (ly:music-property (car evs) 'pitch))))
+ (ly:music-property (car evs) 'pitch))))
(define-public (duration-of-note event-chord)
(cond
((pair? event-chord)
(or (duration-of-note (car event-chord))
- (duration-of-note (cdr event-chord))))
+ (duration-of-note (cdr event-chord))))
((ly:music? event-chord)
(let ((dur (ly:music-property event-chord 'duration)))
(if (ly:duration? dur)
- dur
- (duration-of-note (ly:music-property event-chord 'elements)))))
+ dur
+ (duration-of-note (ly:music-property event-chord 'elements)))))
(else #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1759,30 +1759,30 @@ Entries that conform with the current key signature are not invalidated."
and only recurse if this returns @code{#f}."
(let loop ((music music))
(or (map? music)
- (let ((elt (ly:music-property music 'element))
- (elts (ly:music-property music 'elements))
- (arts (ly:music-property music 'articulations)))
- (if (ly:music? elt)
- (set! (ly:music-property music 'element)
- (loop elt)))
- (if (pair? elts)
- (set! (ly:music-property music 'elements)
- (map loop elts)))
- (if (pair? arts)
- (set! (ly:music-property music 'articulations)
- (map loop arts)))
- music))))
+ (let ((elt (ly:music-property music 'element))
+ (elts (ly:music-property music 'elements))
+ (arts (ly:music-property music 'articulations)))
+ (if (ly:music? elt)
+ (set! (ly:music-property music 'element)
+ (loop elt)))
+ (if (pair? elts)
+ (set! (ly:music-property music 'elements)
+ (map loop elts)))
+ (if (pair? arts)
+ (set! (ly:music-property music 'articulations)
+ (map loop arts)))
+ music))))
(define-public (for-some-music stop? music)
"Walk through @var{music}, process all elements calling @var{stop?}
and only recurse if this returns @code{#f}."
(let loop ((music music))
(if (not (stop? music))
- (let ((elt (ly:music-property music 'element)))
- (if (ly:music? elt)
- (loop elt))
- (for-each loop (ly:music-property music 'elements))
- (for-each loop (ly:music-property music 'articulations))))))
+ (let ((elt (ly:music-property music 'element)))
+ (if (ly:music? elt)
+ (loop elt))
+ (for-each loop (ly:music-property music 'elements))
+ (for-each loop (ly:music-property music 'articulations))))))
(define-public (fold-some-music pred? proc init music)
"This works recursively on music like @code{fold} does on a list,
@@ -1794,15 +1794,15 @@ and no recursion happens.
The top @var{music} is processed using @var{init} for @samp{previous}."
(let loop ((music music) (previous init))
(if (pred? music)
- (proc music previous)
- (fold loop
- (fold loop
- (let ((elt (ly:music-property music 'element)))
- (if (null? elt)
- previous
- (loop elt previous)))
- (ly:music-property music 'elements))
- (ly:music-property music 'articulations)))))
+ (proc music previous)
+ (fold loop
+ (fold loop
+ (let ((elt (ly:music-property music 'element)))
+ (if (null? elt)
+ previous
+ (loop elt previous)))
+ (ly:music-property music 'elements))
+ (ly:music-property music 'articulations)))))
(define-public (extract-music music pred?)
"Return a flat list of all music matching @var{pred?} inside of
@@ -1827,7 +1827,7 @@ recursing into matches themselves."
music
(if (cheap-list? type)
(lambda (m)
- (any (lambda (t) (music-is-of-type? m t)) type))
+ (any (lambda (t) (music-is-of-type? m t)) type))
(lambda (m) (music-is-of-type? m type)))))
(define*-public (event-chord-wrap! music #:optional parser)
@@ -1839,31 +1839,31 @@ yourself."
(map-some-music
(lambda (m)
(cond ((music-is-of-type? m 'event-chord)
- (if (pair? (ly:music-property m 'articulations))
- (begin
- (set! (ly:music-property m 'elements)
- (append (ly:music-property m 'elements)
- (ly:music-property m 'articulations)))
- (set! (ly:music-property m 'articulations) '())))
- m)
- ((music-is-of-type? m 'rhythmic-event)
- (let ((arts (ly:music-property m 'articulations)))
- (if (pair? arts)
- (set! (ly:music-property m 'articulations) '()))
- (make-event-chord (cons m arts))))
- (else #f)))
+ (if (pair? (ly:music-property m 'articulations))
+ (begin
+ (set! (ly:music-property m 'elements)
+ (append (ly:music-property m 'elements)
+ (ly:music-property m 'articulations)))
+ (set! (ly:music-property m 'articulations) '())))
+ m)
+ ((music-is-of-type? m 'rhythmic-event)
+ (let ((arts (ly:music-property m 'articulations)))
+ (if (pair? arts)
+ (set! (ly:music-property m 'articulations) '()))
+ (make-event-chord (cons m arts))))
+ (else #f)))
(if parser
(expand-repeat-chords!
- (cons 'rhythmic-event
- (ly:parser-lookup parser '$chord-repeat-events))
- music)
+ (cons 'rhythmic-event
+ (ly:parser-lookup parser '$chord-repeat-events))
+ music)
music)))
(define-public (event-chord-notes event-chord)
"Return a list of all notes from @var{event-chord}."
(filter
- (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
- (ly:music-property event-chord 'elements)))
+ (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
+ (ly:music-property event-chord 'elements)))
(define-public (event-chord-pitches event-chord)
"Return a list of all pitches from @var{event-chord}."
@@ -1910,7 +1910,7 @@ base onto the following musical context."
(define (close-enough? x y)
"Values are close enough to ignore the difference"
- (< (abs (- x y)) 0.0001))
+ (< (abs (- x y)) 0.0001))
(define (extent-combine extents)
"Combine a list of extents"
@@ -1923,34 +1923,34 @@ base onto the following musical context."
;; The root is always connectable to itself
(or (eq? root stem)
(and
- ;; Horizontal positions of the stems must be almost the same
- (close-enough? (car (ly:grob-extent root ref X))
- (car (ly:grob-extent stem ref X)))
- ;; The stem must be in the direction away from the root's notehead
- (positive? (* (ly:grob-property root 'direction)
+ ;; Horizontal positions of the stems must be almost the same
+ (close-enough? (car (ly:grob-extent root ref X))
+ (car (ly:grob-extent stem ref X)))
+ ;; The stem must be in the direction away from the root's notehead
+ (positive? (* (ly:grob-property root 'direction)
(- (car (ly:grob-extent stem ref Y))
- (car (ly:grob-extent root ref Y))))))))
+ (car (ly:grob-extent root ref Y))))))))
(define (stem-span-stencil span)
"Connect stems if we have at least one stem connectable to the root"
(let* ((system (ly:grob-system span))
- (root (ly:grob-parent span X))
- (stems (filter (stem-connectable? system root)
- (ly:grob-object span 'stems))))
- (if (<= 2 (length stems))
- (let* ((yextents (map (lambda (st)
- (ly:grob-extent st system Y)) stems))
- (yextent (extent-combine yextents))
- (layout (ly:grob-layout root))
- (blot (ly:output-def-lookup layout 'blot-diameter)))
- ;; Hide spanned stems
- (map (lambda (st)
- (set! (ly:grob-property st 'stencil) #f))
- stems)
- ;; Draw a nice looking stem with rounded corners
- (ly:round-filled-box (ly:grob-extent root root X) yextent blot))
- ;; Nothing to connect, don't draw the span
- #f)))
+ (root (ly:grob-parent span X))
+ (stems (filter (stem-connectable? system root)
+ (ly:grob-object span 'stems))))
+ (if (<= 2 (length stems))
+ (let* ((yextents (map (lambda (st)
+ (ly:grob-extent st system Y)) stems))
+ (yextent (extent-combine yextents))
+ (layout (ly:grob-layout root))
+ (blot (ly:output-def-lookup layout 'blot-diameter)))
+ ;; Hide spanned stems
+ (map (lambda (st)
+ (set! (ly:grob-property st 'stencil) #f))
+ stems)
+ ;; Draw a nice looking stem with rounded corners
+ (ly:round-filled-box (ly:grob-extent root root X) yextent blot))
+ ;; Nothing to connect, don't draw the span
+ #f)))
(define ((make-stem-span! stems trans) root)
"Create a stem span as a child of the cross-staff stem (the root)"
@@ -1964,7 +1964,7 @@ base onto the following musical context."
(define-public (cross-staff-connect stem)
"Set cross-staff property of the stem to this function to connect it to
other stems automatically"
- #t)
+ #t)
(define (stem-is-root? stem)
"Check if automatic connecting of the stem was requested. Stems connected
@@ -1977,21 +1977,21 @@ other stems just because of that."
;; Cannot do extensive checks here, just make sure there are at least
;; two stems at this musical moment
(if (<= 2 (length stems))
- (let ((roots (filter stem-is-root? stems)))
- (map (make-stem-span! stems trans) roots))))
+ (let ((roots (filter stem-is-root? stems)))
+ (map (make-stem-span! stems trans) roots))))
(define-public (Span_stem_engraver ctx)
"Connect cross-staff stems to the stems above in the system"
(let ((stems '()))
(make-engraver
- ;; Record all stems for the given moment
- (acknowledgers
- ((stem-interface trans grob source)
- (set! stems (cons grob stems))))
- ;; Process stems and reset the stem list to empty
- ((process-acknowledged trans)
- (make-stem-spans! ctx stems trans)
- (set! stems '())))))
+ ;; Record all stems for the given moment
+ (acknowledgers
+ ((stem-interface trans grob source)
+ (set! stems (cons grob stems))))
+ ;; Process stems and reset the stem list to empty
+ ((process-acknowledged trans)
+ (make-stem-spans! ctx stems trans)
+ (set! stems '())))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following is used by the alterBroken function.
@@ -2002,16 +2002,16 @@ of list @var{arg}."
(let* ((orig (ly:grob-original grob))
(siblings (ly:spanner-broken-into orig)))
- (define (helper sibs arg)
- (if (null? arg)
- arg
- (if (eq? (car sibs) grob)
- (car arg)
- (helper (cdr sibs) (cdr arg)))))
+ (define (helper sibs arg)
+ (if (null? arg)
+ arg
+ (if (eq? (car sibs) grob)
+ (car arg)
+ (helper (cdr sibs) (cdr arg)))))
- (if (>= (length siblings) 2)
- (helper siblings arg)
- (car arg))))
+ (if (>= (length siblings) 2)
+ (helper siblings arg)
+ (car arg))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; measure counter
@@ -2030,45 +2030,45 @@ Broken measures are numbered in parentheses."
;; a system in the event that a MeasureCounter spanner is broken
(all-cols (ly:grob-array->list (ly:grob-object refp 'columns)))
(all-cols
- (filter
- (lambda (col) (eq? #t (ly:grob-property col 'non-musical)))
- all-cols))
+ (filter
+ (lambda (col) (eq? #t (ly:grob-property col 'non-musical)))
+ all-cols))
(left-bound
- (if (or (null? siblings) ; spanner is unbroken
- (eq? grob (car siblings))) ; or the first piece
- (car bounds)
- (car all-cols)))
+ (if (or (null? siblings) ; spanner is unbroken
+ (eq? grob (car siblings))) ; or the first piece
+ (car bounds)
+ (car all-cols)))
(right-bound
- (if (or (null? siblings)
- (eq? grob (car (reverse siblings))))
- (car (reverse bounds))
- (car (reverse all-cols))))
+ (if (or (null? siblings)
+ (eq? grob (car (reverse siblings))))
+ (car (reverse bounds))
+ (car (reverse all-cols))))
(elts-L (ly:grob-array->list (ly:grob-object left-bound 'elements)))
(elts-R (ly:grob-array->list (ly:grob-object right-bound 'elements)))
(break-alignment-L
- (filter
- (lambda (elt) (grob::has-interface elt 'break-alignment-interface))
- elts-L))
+ (filter
+ (lambda (elt) (grob::has-interface elt 'break-alignment-interface))
+ elts-L))
(break-alignment-R
- (filter
- (lambda (elt) (grob::has-interface elt 'break-alignment-interface))
- elts-R))
+ (filter
+ (lambda (elt) (grob::has-interface elt 'break-alignment-interface))
+ elts-R))
(break-alignment-L-ext (ly:grob-extent (car break-alignment-L) refp X))
(break-alignment-R-ext (ly:grob-extent (car break-alignment-R) refp X))
(num (markup (number->string (ly:grob-property grob 'count-from))))
(num
- (if (or (null? siblings)
- (eq? grob (car siblings)))
- num
- (make-parenthesize-markup num)))
+ (if (or (null? siblings)
+ (eq? grob (car siblings)))
+ num
+ (make-parenthesize-markup num)))
(num (grob-interpret-markup grob num))
(num (ly:stencil-aligned-to num X (ly:grob-property grob 'self-alignment-X)))
(num
- (ly:stencil-translate-axis
- num
- (+ (interval-length break-alignment-L-ext)
- (* 0.5
- (- (car break-alignment-R-ext)
- (cdr break-alignment-L-ext))))
- X)))
+ (ly:stencil-translate-axis
+ num
+ (+ (interval-length break-alignment-L-ext)
+ (* 0.5
+ (- (car break-alignment-R-ext)
+ (cdr break-alignment-L-ext))))
+ X)))
num))
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index 6e2d06a66a..a191d65ae7 100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -38,7 +38,7 @@
(define-public (print-circled-text-callback grob)
(grob-interpret-markup grob (make-circle-markup
- (ly:grob-property grob 'text))))
+ (ly:grob-property grob 'text))))
(define-public (event-cause grob)
(let ((cause (ly:grob-property grob 'cause)))
@@ -50,8 +50,8 @@
(define-public (grob-interpret-markup grob text)
(let* ((layout (ly:grob-layout grob))
- (defs (ly:output-def-lookup layout 'text-font-defaults))
- (props (ly:grob-alist-chain grob defs)))
+ (defs (ly:output-def-lookup layout 'text-font-defaults))
+ (props (ly:grob-alist-chain grob defs)))
(ly:text-interface::interpret-markup layout props text)))
@@ -62,31 +62,31 @@
(define-public grob::unpure-horizontal-skylines-from-stencil
(ly:make-unpure-pure-container
- ly:grob::horizontal-skylines-from-stencil
- ly:grob::pure-simple-horizontal-skylines-from-extents))
+ ly:grob::horizontal-skylines-from-stencil
+ ly:grob::pure-simple-horizontal-skylines-from-extents))
(define-public grob::always-horizontal-skylines-from-stencil
(ly:make-unpure-pure-container
- ly:grob::horizontal-skylines-from-stencil))
+ ly:grob::horizontal-skylines-from-stencil))
(define-public grob::unpure-vertical-skylines-from-stencil
(ly:make-unpure-pure-container
- ly:grob::vertical-skylines-from-stencil
- ly:grob::pure-simple-vertical-skylines-from-extents))
+ ly:grob::vertical-skylines-from-stencil
+ ly:grob::pure-simple-vertical-skylines-from-extents))
(define-public grob::always-vertical-skylines-from-stencil
(ly:make-unpure-pure-container
- ly:grob::vertical-skylines-from-stencil))
+ ly:grob::vertical-skylines-from-stencil))
(define-public grob::always-vertical-skylines-from-element-stencils
(ly:make-unpure-pure-container
- ly:grob::vertical-skylines-from-element-stencils
- ly:grob::pure-vertical-skylines-from-element-stencils))
+ ly:grob::vertical-skylines-from-element-stencils
+ ly:grob::pure-vertical-skylines-from-element-stencils))
(define-public grob::always-horizontal-skylines-from-element-stencils
(ly:make-unpure-pure-container
- ly:grob::horizontal-skylines-from-element-stencils
- ly:grob::pure-horizontal-skylines-from-element-stencils))
+ ly:grob::horizontal-skylines-from-element-stencils
+ ly:grob::pure-horizontal-skylines-from-element-stencils))
;; Using this as a callback for a grob's Y-extent promises
;; that the grob's stencil does not depend on line-spacing.
@@ -101,7 +101,7 @@
(let* ((layout (ly:grob-layout grob))
(line-thickness (ly:output-def-lookup layout 'line-thickness)))
- line-thickness))
+ line-thickness))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; beam slope
@@ -175,10 +175,10 @@
(ly:grob-array->list stems)
'())))
(for-each
- (lambda (g)
- (ly:grob-set-property! g 'stem-begin-position 0)
- (ly:grob-set-property! g 'length 0))
- stems-grobs)
+ (lambda (g)
+ (ly:grob-set-property! g 'stem-begin-position 0)
+ (ly:grob-set-property! g 'length 0))
+ stems-grobs)
pos))
;; calculates each slope of a broken beam individually
@@ -214,10 +214,10 @@
quant2))
(factor (/ (atan (abs slope1)) PI-OVER-TWO))
(base (cons-map
- (lambda (x)
- (+ (* (x quant1) (- 1 factor))
- (* (x quant2) factor)))
- (cons car cdr))))
+ (lambda (x)
+ (+ (* (x quant1) (- 1 factor))
+ (* (x quant2) factor)))
+ (cons car cdr))))
(ly:beam::quanting grob base #f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -238,16 +238,16 @@
(define-public side-position-interface::y-aligned-side
(ly:make-unpure-pure-container
- ly:side-position-interface::y-aligned-side
- ly:side-position-interface::pure-y-aligned-side))
+ ly:side-position-interface::y-aligned-side
+ ly:side-position-interface::pure-y-aligned-side))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; self-alignment stuff
(define-public self-alignment-interface::y-aligned-on-self
(ly:make-unpure-pure-container
- ly:self-alignment-interface::y-aligned-on-self
- ly:self-alignment-interface::pure-y-aligned-on-self))
+ ly:self-alignment-interface::y-aligned-on-self
+ ly:self-alignment-interface::pure-y-aligned-on-self))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; staff symbol
@@ -292,12 +292,12 @@
(define-public (note-head::calc-kievan-duration-log grob)
(min 3
(ly:duration-log
- (ly:event-property (event-cause grob) 'duration))))
+ (ly:event-property (event-cause grob) 'duration))))
(define-public (note-head::calc-duration-log grob)
(min 2
(ly:duration-log
- (ly:event-property (event-cause grob) 'duration))))
+ (ly:event-property (event-cause grob) 'duration))))
(define-public (dots::calc-dot-count grob)
(ly:duration-dot-count
@@ -305,11 +305,11 @@
(define-public (dots::calc-staff-position grob)
(let* ((head (ly:grob-parent grob Y))
- (log (ly:grob-property head 'duration-log)))
+ (log (ly:grob-property head 'duration-log)))
(cond
((or (not (grob::has-interface head 'rest-interface))
- (not (integer? log))) 0)
+ (not (integer? log))) 0)
((= log 7) 4)
((> log 4) 3)
((= log 0) -1)
@@ -331,87 +331,87 @@ and duration-log @var{log}."
((harmonic) "0harmonic")
((harmonic-black) "2harmonic")
((harmonic-mixed) (if (<= log 1) "0harmonic"
- "2harmonic"))
+ "2harmonic"))
((baroque)
;; Oops, I actually would not call this "baroque", but, for
;; backwards compatibility to 1.4, this is supposed to take
;; brevis, longa and maxima from the neo-mensural font and all
;; other note heads from the default font. -- jr
(if (< log 0)
- (string-append (number->string log) "neomensural")
- (number->string log)))
+ (string-append (number->string log) "neomensural")
+ (number->string log)))
((altdefault)
;; Like default, but brevis is drawn with double vertical lines
(if (= log -1)
- (string-append (number->string log) "double")
- (number->string log)))
+ (string-append (number->string log) "double")
+ (number->string log)))
((mensural)
(string-append (number->string log) (symbol->string style)))
((petrucci)
(if (< log 0)
- (string-append (number->string log) "mensural")
- (string-append (number->string log) (symbol->string style))))
+ (string-append (number->string log) "mensural")
+ (string-append (number->string log) (symbol->string style))))
((blackpetrucci)
(if (< log 0)
- (string-append (number->string log) "blackmensural")
- (string-append (number->string log) (symbol->string style))))
+ (string-append (number->string log) "blackmensural")
+ (string-append (number->string log) (symbol->string style))))
((semipetrucci)
(if (< log 0)
- (string-append (number->string log) "semimensural")
- (string-append (number->string log) "petrucci")))
+ (string-append (number->string log) "semimensural")
+ (string-append (number->string log) "petrucci")))
((neomensural)
(string-append (number->string log) (symbol->string style)))
((kievan)
(string-append (number->string log) "kievan"))
(else
(if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
- (symbol->string style)
- (string-append (number->string (max 0 log))
- (symbol->string style))))))
+ (symbol->string style)
+ (string-append (number->string (max 0 log))
+ (symbol->string style))))))
(define-public (note-head::calc-glyph-name grob)
(let* ((style (ly:grob-property grob 'style))
- (log (if (string-match "kievan*" (symbol->string style))
- (min 3 (ly:grob-property grob 'duration-log))
- (min 2 (ly:grob-property grob 'duration-log)))))
+ (log (if (string-match "kievan*" (symbol->string style))
+ (min 3 (ly:grob-property grob 'duration-log))
+ (min 2 (ly:grob-property grob 'duration-log)))))
(select-head-glyph style log)))
(define-public (note-head::brew-ez-stencil grob)
(let* ((log (ly:grob-property grob 'duration-log))
- (pitch (ly:event-property (event-cause grob) 'pitch))
- (pitch-index (ly:pitch-notename pitch))
- (note-names (ly:grob-property grob 'note-names))
- (pitch-string (if (and (vector? note-names)
- (> (vector-length note-names) pitch-index))
- (vector-ref note-names pitch-index)
- (string
- (integer->char
- (+ (modulo (+ pitch-index 2) 7)
- (char->integer #\A))))))
- (staff-space (ly:staff-symbol-staff-space grob))
- (line-thickness (ly:staff-symbol-line-thickness grob))
- (stem (ly:grob-object grob 'stem))
- (stem-thickness (* (if (ly:grob? stem)
- (ly:grob-property stem 'thickness)
- 1.3)
- line-thickness))
- (radius (/ (+ staff-space line-thickness) 2))
- (letter (markup #:center-align #:vcenter pitch-string))
- (filled-circle (markup #:draw-circle radius 0 #t)))
+ (pitch (ly:event-property (event-cause grob) 'pitch))
+ (pitch-index (ly:pitch-notename pitch))
+ (note-names (ly:grob-property grob 'note-names))
+ (pitch-string (if (and (vector? note-names)
+ (> (vector-length note-names) pitch-index))
+ (vector-ref note-names pitch-index)
+ (string
+ (integer->char
+ (+ (modulo (+ pitch-index 2) 7)
+ (char->integer #\A))))))
+ (staff-space (ly:staff-symbol-staff-space grob))
+ (line-thickness (ly:staff-symbol-line-thickness grob))
+ (stem (ly:grob-object grob 'stem))
+ (stem-thickness (* (if (ly:grob? stem)
+ (ly:grob-property stem 'thickness)
+ 1.3)
+ line-thickness))
+ (radius (/ (+ staff-space line-thickness) 2))
+ (letter (markup #:center-align #:vcenter pitch-string))
+ (filled-circle (markup #:draw-circle radius 0 #t)))
(ly:stencil-translate-axis
(grob-interpret-markup
grob
(if (>= log 2)
- (make-combine-markup
- filled-circle
- (make-with-color-markup white letter))
- (make-combine-markup
- (make-combine-markup
- filled-circle
- (make-with-color-markup white (make-draw-circle-markup
- (- radius stem-thickness) 0 #t)))
- letter)))
+ (make-combine-markup
+ filled-circle
+ (make-with-color-markup white letter))
+ (make-combine-markup
+ (make-combine-markup
+ filled-circle
+ (make-with-color-markup white (make-draw-circle-markup
+ (- radius stem-thickness) 0 #t)))
+ letter)))
radius X)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -455,14 +455,14 @@ and duration-log @var{log}."
(define-public (rhythmic-location->file-string a)
(ly:format "~a.~a.~a"
- (car a)
- (ly:moment-main-numerator (cdr a))
- (ly:moment-main-denominator (cdr a))))
+ (car a)
+ (ly:moment-main-numerator (cdr a))
+ (ly:moment-main-denominator (cdr a))))
(define-public (rhythmic-location->string a)
(ly:format "bar ~a ~a"
- (car a)
- (ly:moment->string (cdr a))))
+ (car a)
+ (ly:moment->string (cdr a))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; break visibility
@@ -483,7 +483,7 @@ and duration-log @var{log}."
(define-public (shift-right-at-line-begin g)
"Shift an item to the right, but only at the start of the line."
(if (and (ly:item? g)
- (equal? (ly:item-break-dir g) RIGHT))
+ (equal? (ly:item-break-dir g) RIGHT))
(ly:grob-translate-axis! g 3.5 X)))
(define-public (pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line grob)
@@ -494,11 +494,11 @@ and duration-log @var{log}."
(define-public (pure-from-neighbor-interface::extra-spacing-height grob)
(let* ((height (ly:grob-pure-height grob grob 0 INFINITY-INT))
(from-neighbors (interval-union
- height
- (ly:axis-group-interface::pure-height
- grob
- 0
- INFINITY-INT))))
+ height
+ (ly:axis-group-interface::pure-height
+ grob
+ 0
+ INFINITY-INT))))
(coord-operation - from-neighbors height)))
;; If there are neighbors, we place the height at their midpoint
@@ -528,7 +528,7 @@ and duration-log @var{log}."
(ii (interval-intersection esh (cons -1.01 1.01))))
(if (pair? hsb)
(cons (car (if (and (car hsb)
- (ly:grob-property grob 'allow-span-bar))
+ (ly:grob-property grob 'allow-span-bar))
esh ii))
(cdr (if (cdr hsb) esh ii)))
ii)))
@@ -537,8 +537,8 @@ and duration-log @var{log}."
(let ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
(to-staff (coord-operation -
(interval-widen
- '(0 . 0)
- (ly:staff-symbol-staff-radius grob))
+ '(0 . 0)
+ (ly:staff-symbol-staff-radius grob))
(ly:grob::stencil-height grob))))
(interval-union esh to-staff)))
@@ -556,8 +556,8 @@ and duration-log @var{log}."
(let ((ev (event-cause grob)))
(format #f "~a:~a"
- (ly:event-property ev 'denominator)
- (ly:event-property ev 'numerator))))
+ (ly:event-property ev 'denominator)
+ (ly:event-property ev 'numerator))))
;; a formatter function, which is simply a wrapper around an existing
;; tuplet formatter function. It takes the value returned by the given
@@ -566,21 +566,21 @@ and duration-log @var{log}."
(let ((txt (if function (function grob) #f)))
(if txt
- (markup txt #:fontsize -5 #:note note UP)
- (markup #:fontsize -5 #:note note UP))))
+ (markup txt #:fontsize -5 #:note note UP)
+ (markup #:fontsize -5 #:note note UP))))
;; Print a tuplet denominator with a different number than the one derived from
;; the actual tuplet fraction
(define-public ((tuplet-number::non-default-tuplet-denominator-text denominator)
- grob)
+ grob)
(number->string (if denominator
- denominator
- (ly:event-property (event-cause grob) 'denominator))))
+ denominator
+ (ly:event-property (event-cause grob) 'denominator))))
;; Print a tuplet fraction with different numbers than the ones derived from
;; the actual tuplet fraction
(define-public ((tuplet-number::non-default-tuplet-fraction-text
- denominator numerator) grob)
+ denominator numerator) grob)
(let* ((ev (event-cause grob))
(den (if denominator denominator (ly:event-property ev 'denominator)))
(num (if numerator numerator (ly:event-property ev 'numerator))))
@@ -590,7 +590,7 @@ and duration-log @var{log}."
;; Print a tuplet fraction with note durations appended to the numerator and the
;; denominator
(define-public ((tuplet-number::fraction-with-notes
- denominatornote numeratornote) grob)
+ denominatornote numeratornote) grob)
(let* ((ev (event-cause grob))
(denominator (ly:event-property ev 'denominator))
(numerator (ly:event-property ev 'numerator)))
@@ -601,17 +601,17 @@ and duration-log @var{log}."
;; Print a tuplet fraction with note durations appended to the numerator and the
;; denominator
(define-public ((tuplet-number::non-default-fraction-with-notes
- denominator denominatornote numerator numeratornote) grob)
+ denominator denominatornote numerator numeratornote) grob)
(let* ((ev (event-cause grob))
(den (if denominator denominator (ly:event-property ev 'denominator)))
(num (if numerator numerator (ly:event-property ev 'numerator))))
(make-concat-markup (list
- (make-simple-markup (format #f "~a" den))
- (markup #:fontsize -5 #:note denominatornote UP)
- (make-simple-markup " : ")
- (make-simple-markup (format #f "~a" num))
- (markup #:fontsize -5 #:note numeratornote UP)))))
+ (make-simple-markup (format #f "~a" den))
+ (markup #:fontsize -5 #:note denominatornote UP)
+ (make-simple-markup " : ")
+ (make-simple-markup (format #f "~a" num))
+ (markup #:fontsize -5 #:note numeratornote UP)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -625,7 +625,7 @@ and duration-log @var{log}."
(define-public (rgb-color r g b) (list r g b))
-; predefined colors
+ ; predefined colors
(define-public black '(0.0 0.0 0.0))
(define-public white '(1.0 1.0 1.0))
(define-public red '(1.0 0.0 0.0))
@@ -648,30 +648,30 @@ and duration-log @var{log}."
;; key signature
(define-public (key-signature-interface::alteration-positions
- entry c0-position grob)
+ entry c0-position grob)
(let ((step (car entry))
- (alter (cdr entry)))
+ (alter (cdr entry)))
(if (pair? step)
- (list (+ (cdr step) (* (car step) 7) c0-position))
- (let* ((c-position (modulo c0-position 7))
- (positions
- (if (< alter 0)
- ;; See (flat|sharp)-positions in define-grob-properties.scm
- (ly:grob-property grob 'flat-positions '(3))
- (ly:grob-property grob 'sharp-positions '(3))))
- (p (list-ref positions
- (if (< c-position (length positions))
- c-position 0)))
- (max-position (if (pair? p) (cdr p) p))
- (min-position (if (pair? p) (car p) (- max-position 6)))
- (first-position (+ (modulo (- (+ c-position step)
- min-position)
- 7)
- min-position)))
- (define (prepend x l) (if (> x max-position)
- l
- (prepend (+ x 7) (cons x l))))
- (prepend first-position '())))))
+ (list (+ (cdr step) (* (car step) 7) c0-position))
+ (let* ((c-position (modulo c0-position 7))
+ (positions
+ (if (< alter 0)
+ ;; See (flat|sharp)-positions in define-grob-properties.scm
+ (ly:grob-property grob 'flat-positions '(3))
+ (ly:grob-property grob 'sharp-positions '(3))))
+ (p (list-ref positions
+ (if (< c-position (length positions))
+ c-position 0)))
+ (max-position (if (pair? p) (cdr p) p))
+ (min-position (if (pair? p) (car p) (- max-position 6)))
+ (first-position (+ (modulo (- (+ c-position step)
+ min-position)
+ 7)
+ min-position)))
+ (define (prepend x l) (if (> x max-position)
+ l
+ (prepend (+ x 7) (cons x l))))
+ (prepend first-position '())))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; annotations
@@ -688,9 +688,9 @@ and duration-log @var{log}."
idx
(- n 1))))
(markup #:tiny (helper '("*" "â " "â¡" "§" "¶")
- ""
- (remainder int 5)
- (+ 1 (quotient int 5)))))
+ ""
+ (remainder int 5)
+ (+ 1 (quotient int 5)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accidentals
@@ -704,8 +704,8 @@ and duration-log @var{log}."
(define-public accidental-interface::height
(ly:make-unpure-pure-container
- ly:accidental-interface::height
- ly:accidental-interface::pure-height))
+ ly:accidental-interface::height
+ ly:accidental-interface::pure-height))
(define-public cancellation-glyph-name-alist
'((0 . "accidentals.natural")))
@@ -763,8 +763,8 @@ and duration-log @var{log}."
(1/2 . "accidentals.mensural1")))
(define-public alteration-kievan-glyph-name-alist
- '((-1/2 . "accidentals.kievanM1")
- (1/2 . "accidentals.kievan1")))
+ '((-1/2 . "accidentals.kievanM1")
+ (1/2 . "accidentals.kievan1")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; * Pitch Trill Heads
@@ -772,8 +772,8 @@ and duration-log @var{log}."
(define-public (parentheses-item::calc-parenthesis-stencils grob)
(let* ((font (ly:grob-default-font grob))
- (lp (ly:font-get-glyph font "accidentals.leftparen"))
- (rp (ly:font-get-glyph font "accidentals.rightparen")))
+ (lp (ly:font-get-glyph font "accidentals.leftparen"))
+ (rp (ly:font-get-glyph font "accidentals.rightparen")))
(list lp rp)))
@@ -784,26 +784,26 @@ and duration-log @var{log}."
(width 0.5) ; should it be a property?
(angularity 1.5) ; makes angle brackets
(white-padding 0.1) ; should it be a property?
- (lp (ly:stencil-aligned-to
- (ly:stencil-aligned-to
- (make-parenthesis-stencil y-extent
- half-thickness
- (- width)
- angularity)
- Y CENTER)
- X RIGHT))
+ (lp (ly:stencil-aligned-to
+ (ly:stencil-aligned-to
+ (make-parenthesis-stencil y-extent
+ half-thickness
+ (- width)
+ angularity)
+ Y CENTER)
+ X RIGHT))
(lp-x-extent
- (interval-widen (ly:stencil-extent lp X) white-padding))
- (rp (ly:stencil-aligned-to
- (ly:stencil-aligned-to
- (make-parenthesis-stencil y-extent
- half-thickness
- width
- angularity)
- Y CENTER)
- X LEFT))
- (rp-x-extent
- (interval-widen (ly:stencil-extent rp X) white-padding)))
+ (interval-widen (ly:stencil-extent lp X) white-padding))
+ (rp (ly:stencil-aligned-to
+ (ly:stencil-aligned-to
+ (make-parenthesis-stencil y-extent
+ half-thickness
+ width
+ angularity)
+ Y CENTER)
+ X LEFT))
+ (rp-x-extent
+ (interval-widen (ly:stencil-extent rp X) white-padding)))
(set! lp (ly:make-stencil (ly:stencil-expr lp)
lp-x-extent
(ly:stencil-extent lp Y)))
@@ -815,14 +815,14 @@ and duration-log @var{log}."
(define (parenthesize-elements grob . rest)
(let* ((refp (if (null? rest)
- grob
- (car rest)))
- (elts (ly:grob-object grob 'elements))
- (x-ext (ly:relative-group-extent elts refp X))
- (stencils (ly:grob-property grob 'stencils))
- (lp (car stencils))
- (rp (cadr stencils))
- (padding (ly:grob-property grob 'padding 0.1)))
+ grob
+ (car rest)))
+ (elts (ly:grob-object grob 'elements))
+ (x-ext (ly:relative-group-extent elts refp X))
+ (stencils (ly:grob-property grob 'stencils))
+ (lp (car stencils))
+ (rp (cadr stencils))
+ (padding (ly:grob-property grob 'padding 0.1)))
(ly:stencil-add
(ly:stencil-translate-axis lp (- (car x-ext) padding) X)
@@ -831,11 +831,11 @@ and duration-log @var{log}."
(define-public (parentheses-item::print me)
(let* ((elts (ly:grob-object me 'elements))
- (y-ref (ly:grob-common-refpoint-of-array me elts Y))
- (x-ref (ly:grob-common-refpoint-of-array me elts X))
- (stencil (parenthesize-elements me x-ref))
- (elt-y-ext (ly:relative-group-extent elts y-ref Y))
- (y-center (interval-center elt-y-ext)))
+ (y-ref (ly:grob-common-refpoint-of-array me elts Y))
+ (x-ref (ly:grob-common-refpoint-of-array me elts X))
+ (stencil (parenthesize-elements me x-ref))
+ (elt-y-ext (ly:relative-group-extent elts y-ref Y))
+ (y-center (interval-center elt-y-ext)))
(ly:stencil-translate
stencil
@@ -874,57 +874,57 @@ and duration-log @var{log}."
(< (abs (- a b)) 0.01))
(let* ((delta-y (* 0.5 (ly:grob-property spanner 'delta-position)))
- (left-span (ly:spanner-bound spanner LEFT))
- (dots (if (and (grob::has-interface left-span 'note-head-interface)
- (ly:grob? (ly:grob-object left-span 'dot)))
- (ly:grob-object left-span 'dot) #f))
-
- (right-span (ly:spanner-bound spanner RIGHT))
- (thickness (* (ly:grob-property spanner 'thickness)
- (ly:output-def-lookup (ly:grob-layout spanner)
- 'line-thickness)))
- (padding (ly:grob-property spanner 'padding 0.5))
- (common (ly:grob-common-refpoint right-span
- (ly:grob-common-refpoint spanner
- left-span X)
- X))
- (common-y (ly:grob-common-refpoint spanner left-span Y))
- (minimum-length (ly:grob-property spanner 'minimum-length 0.5))
-
- (left-x (+ padding
- (max
- (interval-end (ly:grob-robust-relative-extent
- left-span common X))
- (if
- (and dots
- (close
- (ly:grob-relative-coordinate dots common-y Y)
- (ly:grob-relative-coordinate spanner common-y Y)))
- (interval-end
- (ly:grob-robust-relative-extent dots common X))
- (- INFINITY-INT)))))
- (right-x (max (- (interval-start
- (ly:grob-robust-relative-extent right-span common X))
- padding)
- (+ left-x minimum-length)))
- (self-x (ly:grob-relative-coordinate spanner common X))
- (dx (- right-x left-x))
- (exp (list 'path thickness
- `(quote
- (rmoveto
- ,(- left-x self-x) 0
-
- rcurveto
- ,(/ dx 3)
- 0
- ,dx ,(* 0.66 delta-y)
- ,dx ,delta-y)))))
+ (left-span (ly:spanner-bound spanner LEFT))
+ (dots (if (and (grob::has-interface left-span 'note-head-interface)
+ (ly:grob? (ly:grob-object left-span 'dot)))
+ (ly:grob-object left-span 'dot) #f))
+
+ (right-span (ly:spanner-bound spanner RIGHT))
+ (thickness (* (ly:grob-property spanner 'thickness)
+ (ly:output-def-lookup (ly:grob-layout spanner)
+ 'line-thickness)))
+ (padding (ly:grob-property spanner 'padding 0.5))
+ (common (ly:grob-common-refpoint right-span
+ (ly:grob-common-refpoint spanner
+ left-span X)
+ X))
+ (common-y (ly:grob-common-refpoint spanner left-span Y))
+ (minimum-length (ly:grob-property spanner 'minimum-length 0.5))
+
+ (left-x (+ padding
+ (max
+ (interval-end (ly:grob-robust-relative-extent
+ left-span common X))
+ (if
+ (and dots
+ (close
+ (ly:grob-relative-coordinate dots common-y Y)
+ (ly:grob-relative-coordinate spanner common-y Y)))
+ (interval-end
+ (ly:grob-robust-relative-extent dots common X))
+ (- INFINITY-INT)))))
+ (right-x (max (- (interval-start
+ (ly:grob-robust-relative-extent right-span common X))
+ padding)
+ (+ left-x minimum-length)))
+ (self-x (ly:grob-relative-coordinate spanner common X))
+ (dx (- right-x left-x))
+ (exp (list 'path thickness
+ `(quote
+ (rmoveto
+ ,(- left-x self-x) 0
+
+ rcurveto
+ ,(/ dx 3)
+ 0
+ ,dx ,(* 0.66 delta-y)
+ ,dx ,delta-y)))))
(ly:make-stencil
exp
(cons (- left-x self-x) (- right-x self-x))
(cons (min 0 delta-y)
- (max 0 delta-y)))))
+ (max 0 delta-y)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -932,24 +932,24 @@ and duration-log @var{log}."
(define-public (grace-spacing::calc-shortest-duration grob)
(let* ((cols (ly:grob-object grob 'columns))
- (get-difference
- (lambda (idx)
- (ly:moment-sub (ly:grob-property
- (ly:grob-array-ref cols (1+ idx)) 'when)
- (ly:grob-property
- (ly:grob-array-ref cols idx) 'when))))
-
- (moment-min (lambda (x y)
- (cond
- ((and x y)
- (if (ly:moment<? x y)
- x
- y))
- (x x)
- (y y)))))
+ (get-difference
+ (lambda (idx)
+ (ly:moment-sub (ly:grob-property
+ (ly:grob-array-ref cols (1+ idx)) 'when)
+ (ly:grob-property
+ (ly:grob-array-ref cols idx) 'when))))
+
+ (moment-min (lambda (x y)
+ (cond
+ ((and x y)
+ (if (ly:moment<? x y)
+ x
+ y))
+ (x x)
+ (y y)))))
(fold moment-min #f (map get-difference
- (iota (1- (ly:grob-array-length cols)))))))
+ (iota (1- (ly:grob-array-length cols)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -968,8 +968,8 @@ and duration-log @var{log}."
(define-public (stroke-finger::calc-text grob)
(let ((event (event-cause grob)))
(or (ly:event-property event 'text #f)
- (vector-ref (ly:grob-property grob 'digit-names)
- (1- (max 1
+ (vector-ref (ly:grob-property grob 'digit-names)
+ (1- (max 1
(min 5 (ly:event-property event 'digit))))))))
@@ -989,18 +989,18 @@ changing @code{'attach-dir} and @code{'padding}. Reads the
between the two text elements."
(let ((left-bound (ly:spanner-bound grob LEFT)))
(if (grob::has-interface left-bound 'dynamic-text-interface)
- (let* ((details (ly:grob-property grob 'bound-details))
- (left-details (ly:assoc-get 'left details))
- (my-padding (ly:assoc-get 'padding left-details))
- (script-padding (ly:grob-property left-bound 'right-padding 0)))
-
- (and (number? my-padding)
- (ly:grob-set-nested-property! grob
- '(bound-details left attach-dir)
- RIGHT)
- (ly:grob-set-nested-property! grob
- '(bound-details left padding)
- (+ my-padding script-padding)))))))
+ (let* ((details (ly:grob-property grob 'bound-details))
+ (left-details (ly:assoc-get 'left details))
+ (my-padding (ly:assoc-get 'padding left-details))
+ (script-padding (ly:grob-property left-bound 'right-padding 0)))
+
+ (and (number? my-padding)
+ (ly:grob-set-nested-property! grob
+ '(bound-details left attach-dir)
+ RIGHT)
+ (ly:grob-set-nested-property! grob
+ '(bound-details left padding)
+ (+ my-padding script-padding)))))))
(define-public ((elbowed-hairpin coords mirrored?) grob)
"Create hairpin based on a list of @var{coords} in @code{(cons x y)}
@@ -1028,39 +1028,39 @@ and draws the stencil based on its coordinates.
(list (car pair) (cdr pair)))
(define (normalize-coords goods x y)
(map
- (lambda (coord)
- (cons (* x (car coord)) (* y (cdr coord))))
- goods))
+ (lambda (coord)
+ (cons (* x (car coord)) (* y (cdr coord))))
+ goods))
(define (my-c-p-s points thick decresc?)
(make-connected-path-stencil
- points
- thick
- (if decresc? -1.0 1.0)
- 1.0
- #f
- #f))
- ; outer let to trigger suicide
+ points
+ thick
+ (if decresc? -1.0 1.0)
+ 1.0
+ #f
+ #f))
+ ; outer let to trigger suicide
(let ((sten (ly:hairpin::print grob)))
(if (grob::is-live? grob)
- (let* ((decresc? (eq? (ly:grob-property grob 'grow-direction) LEFT))
- (thick (ly:grob-property grob 'thickness 0.1))
- (thick (* thick (layout-line-thickness grob)))
- (xex (ly:stencil-extent sten X))
- (lenx (interval-length xex))
- (yex (ly:stencil-extent sten Y))
- (leny (interval-length yex))
- (xtrans (+ (car xex) (if decresc? lenx 0)))
- (ytrans (car yex))
- (uplist (map pair-to-list
- (normalize-coords coords lenx (/ leny 2))))
- (downlist (map pair-to-list
- (normalize-coords coords lenx (/ leny -2)))))
- (ly:stencil-translate
- (ly:stencil-add
- (my-c-p-s uplist thick decresc?)
- (if mirrored? (my-c-p-s downlist thick decresc?) empty-stencil))
- (cons xtrans ytrans)))
- '())))
+ (let* ((decresc? (eq? (ly:grob-property grob 'grow-direction) LEFT))
+ (thick (ly:grob-property grob 'thickness 0.1))
+ (thick (* thick (layout-line-thickness grob)))
+ (xex (ly:stencil-extent sten X))
+ (lenx (interval-length xex))
+ (yex (ly:stencil-extent sten Y))
+ (leny (interval-length yex))
+ (xtrans (+ (car xex) (if decresc? lenx 0)))
+ (ytrans (car yex))
+ (uplist (map pair-to-list
+ (normalize-coords coords lenx (/ leny 2))))
+ (downlist (map pair-to-list
+ (normalize-coords coords lenx (/ leny -2)))))
+ (ly:stencil-translate
+ (ly:stencil-add
+ (my-c-p-s uplist thick decresc?)
+ (if mirrored? (my-c-p-s downlist thick decresc?) empty-stencil))
+ (cons xtrans ytrans)))
+ '())))
(define-public flared-hairpin
(elbowed-hairpin '((0.95 . 0.4) (1.0 . 1.0)) #t))
@@ -1077,8 +1077,8 @@ and draws the stencil based on its coordinates.
(let ((text (ly:grob-property grob 'text)))
(grob-interpret-markup grob (if (string? text)
- (make-tied-lyric-markup text)
- text))))
+ (make-tied-lyric-markup text)
+ text))))
(define-public ((grob::calc-property-by-copy prop) grob)
(ly:event-property (event-cause grob) prop))
@@ -1112,8 +1112,8 @@ parent or the parent has no setting."
(define-public slur::height
(ly:make-unpure-pure-container
- ly:slur::height
- ly:slur::pure-height))
+ ly:slur::height
+ ly:slur::pure-height))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; scripts
@@ -1121,10 +1121,10 @@ parent or the parent has no setting."
(define-public (script-interface::calc-x-offset grob)
(ly:grob-property grob 'positioning-done)
(let* ((shift (ly:grob-property grob 'toward-stem-shift 0.0))
- (note-head-location
- (ly:self-alignment-interface::centered-on-x-parent grob))
- (note-head-grob (ly:grob-parent grob X))
- (stem-grob (ly:grob-object note-head-grob 'stem)))
+ (note-head-location
+ (ly:self-alignment-interface::centered-on-x-parent grob))
+ (note-head-grob (ly:grob-parent grob X))
+ (stem-grob (ly:grob-object note-head-grob 'stem)))
(+ note-head-location
;; If the property 'toward-stem-shift is defined and the script
@@ -1132,15 +1132,15 @@ parent or the parent has no setting."
;; Since scripts can also be over skips, we need to check whether
;; the grob has a stem at all.
(if (ly:grob? stem-grob)
- (let ((dir1 (ly:grob-property grob 'direction))
- (dir2 (ly:grob-property stem-grob 'direction)))
- (if (equal? dir1 dir2)
- (let* ((common-refp (ly:grob-common-refpoint grob stem-grob X))
- (stem-location
- (ly:grob-relative-coordinate stem-grob common-refp X)))
- (* shift (- stem-location note-head-location)))
- 0.0))
- 0.0))))
+ (let ((dir1 (ly:grob-property grob 'direction))
+ (dir2 (ly:grob-property stem-grob 'direction)))
+ (if (equal? dir1 dir2)
+ (let* ((common-refp (ly:grob-common-refpoint grob stem-grob X))
+ (stem-location
+ (ly:grob-relative-coordinate stem-grob common-refp X)))
+ (* shift (- stem-location note-head-location)))
+ 0.0))
+ 0.0))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -1148,48 +1148,48 @@ parent or the parent has no setting."
(define-public (system-start-text::print grob)
(let* ((left-bound (ly:spanner-bound grob LEFT))
- (left-mom (ly:grob-property left-bound 'when))
- (name (if (moment<=? left-mom ZERO-MOMENT)
- (ly:grob-property grob 'long-text)
- (ly:grob-property grob 'text))))
+ (left-mom (ly:grob-property left-bound 'when))
+ (name (if (moment<=? left-mom ZERO-MOMENT)
+ (ly:grob-property grob 'long-text)
+ (ly:grob-property grob 'text))))
(if (and (markup? name)
- (!= (ly:item-break-dir left-bound) CENTER))
+ (!= (ly:item-break-dir left-bound) CENTER))
- (grob-interpret-markup grob name)
- (ly:grob-suicide! grob))))
+ (grob-interpret-markup grob name)
+ (ly:grob-suicide! grob))))
(define-public (system-start-text::calc-x-offset grob)
(let* ((left-bound (ly:spanner-bound grob LEFT))
- (left-mom (ly:grob-property left-bound 'when))
- (layout (ly:grob-layout grob))
- (indent (ly:output-def-lookup layout
- (if (moment<=? left-mom ZERO-MOMENT)
- 'indent
- 'short-indent)
- 0.0))
- (system (ly:grob-system grob))
- (my-extent (ly:grob-extent grob system X))
- (elements (ly:grob-object system 'elements))
- (common (ly:grob-common-refpoint-of-array system elements X))
- (total-ext empty-interval)
- (align-x (ly:grob-property grob 'self-alignment-X 0))
- (padding (min 0 (- (interval-length my-extent) indent)))
- (right-padding (- padding
- (/ (* padding (1+ align-x)) 2))))
+ (left-mom (ly:grob-property left-bound 'when))
+ (layout (ly:grob-layout grob))
+ (indent (ly:output-def-lookup layout
+ (if (moment<=? left-mom ZERO-MOMENT)
+ 'indent
+ 'short-indent)
+ 0.0))
+ (system (ly:grob-system grob))
+ (my-extent (ly:grob-extent grob system X))
+ (elements (ly:grob-object system 'elements))
+ (common (ly:grob-common-refpoint-of-array system elements X))
+ (total-ext empty-interval)
+ (align-x (ly:grob-property grob 'self-alignment-X 0))
+ (padding (min 0 (- (interval-length my-extent) indent)))
+ (right-padding (- padding
+ (/ (* padding (1+ align-x)) 2))))
;; compensate for the variation in delimiter extents by
;; calculating an X-offset correction based on united extents
;; of all delimiters in this system
(let unite-delims ((l (ly:grob-array-length elements)))
(if (> l 0)
- (let ((elt (ly:grob-array-ref elements (1- l))))
+ (let ((elt (ly:grob-array-ref elements (1- l))))
- (if (grob::has-interface elt 'system-start-delimiter-interface)
- (let ((dims (ly:grob-extent elt common X)))
- (if (interval-sane? dims)
- (set! total-ext (interval-union total-ext dims)))))
- (unite-delims (1- l)))))
+ (if (grob::has-interface elt 'system-start-delimiter-interface)
+ (let ((dims (ly:grob-extent elt common X)))
+ (if (interval-sane? dims)
+ (set! total-ext (interval-union total-ext dims)))))
+ (unite-delims (1- l)))))
(+
(ly:side-position-interface::x-aligned-side grob)
@@ -1205,25 +1205,25 @@ parent or the parent has no setting."
(ly:grob-array->list elements))))
(let* ((left-bound (ly:spanner-bound grob LEFT))
- (live-elts (live-elements-list grob))
- (system (ly:grob-system grob))
- (extent empty-interval))
+ (live-elts (live-elements-list grob))
+ (system (ly:grob-system grob))
+ (extent empty-interval))
(if (and (pair? live-elts)
- (interval-sane? (ly:grob-extent grob system Y)))
- (let get-extent ((lst live-elts))
- (if (pair? lst)
- (let ((axis-group (car lst)))
-
- (if (and (ly:spanner? axis-group)
- (equal? (ly:spanner-bound axis-group LEFT)
- left-bound))
- (set! extent (add-point extent
- (ly:grob-relative-coordinate
- axis-group system Y))))
- (get-extent (cdr lst)))))
- ;; no live axis group(s) for this instrument name -> remove from system
- (ly:grob-suicide! grob))
+ (interval-sane? (ly:grob-extent grob system Y)))
+ (let get-extent ((lst live-elts))
+ (if (pair? lst)
+ (let ((axis-group (car lst)))
+
+ (if (and (ly:spanner? axis-group)
+ (equal? (ly:spanner-bound axis-group LEFT)
+ left-bound))
+ (set! extent (add-point extent
+ (ly:grob-relative-coordinate
+ axis-group system Y))))
+ (get-extent (cdr lst)))))
+ ;; no live axis group(s) for this instrument name -> remove from system
+ (ly:grob-suicide! grob))
(+
(ly:self-alignment-interface::y-aligned-on-self grob)
@@ -1235,8 +1235,8 @@ parent or the parent has no setting."
(define-public axis-group-interface::height
(ly:make-unpure-pure-container
- ly:axis-group-interface::height
- ly:axis-group-interface::pure-height))
+ ly:axis-group-interface::height
+ ly:axis-group-interface::pure-height))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ambitus
@@ -1245,32 +1245,32 @@ parent or the parent has no setting."
(let ((heads (ly:grob-object grob 'note-heads)))
(if (and (ly:grob-array? heads)
- (= (ly:grob-array-length heads) 2))
- (let* ((common (ly:grob-common-refpoint-of-array grob heads Y))
- (head-down (ly:grob-array-ref heads 0))
- (head-up (ly:grob-array-ref heads 1))
- (gap (ly:grob-property grob 'gap 0.35))
- (point-min (+ (interval-end (ly:grob-extent head-down common Y))
- gap))
- (point-max (- (interval-start (ly:grob-extent head-up common Y))
- gap)))
-
- (if (< point-min point-max)
- (let* ((layout (ly:grob-layout grob))
- (line-thick (ly:output-def-lookup layout 'line-thickness))
- (blot (ly:output-def-lookup layout 'blot-diameter))
- (grob-thick (ly:grob-property grob 'thickness 2))
- (width (* line-thick grob-thick))
- (x-ext (symmetric-interval (/ width 2)))
- (y-ext (cons point-min point-max))
- (line (ly:round-filled-box x-ext y-ext blot))
- (y-coord (ly:grob-relative-coordinate grob common Y)))
-
- (ly:stencil-translate-axis line (- y-coord) Y))
- empty-stencil))
- (begin
- (ly:grob-suicide! grob)
- (list)))))
+ (= (ly:grob-array-length heads) 2))
+ (let* ((common (ly:grob-common-refpoint-of-array grob heads Y))
+ (head-down (ly:grob-array-ref heads 0))
+ (head-up (ly:grob-array-ref heads 1))
+ (gap (ly:grob-property grob 'gap 0.35))
+ (point-min (+ (interval-end (ly:grob-extent head-down common Y))
+ gap))
+ (point-max (- (interval-start (ly:grob-extent head-up common Y))
+ gap)))
+
+ (if (< point-min point-max)
+ (let* ((layout (ly:grob-layout grob))
+ (line-thick (ly:output-def-lookup layout 'line-thickness))
+ (blot (ly:output-def-lookup layout 'blot-diameter))
+ (grob-thick (ly:grob-property grob 'thickness 2))
+ (width (* line-thick grob-thick))
+ (x-ext (symmetric-interval (/ width 2)))
+ (y-ext (cons point-min point-max))
+ (line (ly:round-filled-box x-ext y-ext blot))
+ (y-coord (ly:grob-relative-coordinate grob common Y)))
+
+ (ly:stencil-translate-axis line (- y-coord) Y))
+ empty-stencil))
+ (begin
+ (ly:grob-suicide! grob)
+ (list)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; laissez-vibrer tie
@@ -1278,7 +1278,7 @@ parent or the parent has no setting."
;; needed so we can make laissez-vibrer a pure print
;;
(define-public (laissez-vibrer::print grob)
- (ly:tie::print grob))
+ (ly:tie::print grob))
(define-public (semi-tie::calc-cross-staff grob)
(let* ((note-head (ly:grob-object grob 'note-head))
@@ -1292,7 +1292,7 @@ parent or the parent has no setting."
(define-public (volta-bracket-interface::pure-height grob start end)
(let ((edge-height (ly:grob-property grob 'edge-height)))
(if (number-pair? edge-height)
- (let ((smaller (min (car edge-height) (cdr edge-height)))
- (larger (max (car edge-height) (cdr edge-height))))
- (interval-union '(0 . 0) (cons smaller larger)))
- '(0 . 0))))
+ (let ((smaller (min (car edge-height) (cdr edge-height)))
+ (larger (max (car edge-height) (cdr edge-height))))
+ (interval-union '(0 . 0) (cons smaller larger)))
+ '(0 . 0))))
diff --git a/scm/output-ps.scm b/scm/output-ps.scm
index dd92175feb..813211f060 100644
--- a/scm/output-ps.scm
+++ b/scm/output-ps.scm
@@ -28,12 +28,12 @@
#:re-export (quote))
(use-modules (guile)
- (ice-9 regex)
- (ice-9 optargs)
- (srfi srfi-1)
- (srfi srfi-13)
- (scm framework-ps)
- (lily))
+ (ice-9 regex)
+ (ice-9 optargs)
+ (srfi srfi-1)
+ (srfi srfi-13)
+ (scm framework-ps)
+ (lily))
;;; helper functions, not part of output interface
;;;
@@ -45,10 +45,10 @@
(define (str4 num)
(if (or (nan? num) (inf? num))
(begin
- (ly:warning (_ "Found infinity or nan in output. Substituting 0.0"))
- (if (ly:get-option 'strict-infinity-checking)
- (exit 1))
- "0.0")
+ (ly:warning (_ "Found infinity or nan in output. Substituting 0.0"))
+ (if (ly:get-option 'strict-infinity-checking)
+ (exit 1))
+ "0.0")
(ly:number->string num)))
(define (number-pair->string4 numpair)
@@ -60,15 +60,15 @@
(define (char font i)
(ly:format "~a (\\~a) show"
- (ps-font-command font)
- (ly:inexact->string i 8)))
+ (ps-font-command font)
+ (ly:inexact->string i 8)))
(define (circle radius thick fill)
(ly:format
"~a ~4f ~4f draw_circle"
(if fill
- "true"
- "false")
+ "true"
+ "false")
radius thick))
(define (start-enclosing-id-node s)
@@ -79,34 +79,34 @@
(define (dashed-line thick on off dx dy phase)
(ly:format "~4f ~4f ~4f [ ~4f ~4f ] ~4f draw_dashed_line"
- dx
- dy
- thick
- on
- off
- phase))
+ dx
+ dy
+ thick
+ on
+ off
+ phase))
(define (draw-line thick x1 y1 x2 y2)
(ly:format "~4f ~4f ~4f ~4f ~4f draw_line"
- (- x2 x1) (- y2 y1)
- x1 y1 thick))
+ (- x2 x1) (- y2 y1)
+ x1 y1 thick))
(define (partial-ellipse x-radius y-radius start-angle end-angle thick connect fill)
(ly:format "~a ~a ~4f ~4f ~4f ~4f ~4f draw_partial_ellipse"
- (if fill "true" "false")
- (if connect "true" "false")
- x-radius
- y-radius
- start-angle
- end-angle
- thick))
+ (if fill "true" "false")
+ (if connect "true" "false")
+ x-radius
+ y-radius
+ start-angle
+ end-angle
+ thick))
(define (ellipse x-radius y-radius thick fill)
(ly:format
"~a ~4f ~4f ~4f draw_ellipse"
(if fill
- "true"
- "false")
+ "true"
+ "false")
x-radius y-radius thick))
(define (embedded-ps string)
@@ -114,78 +114,78 @@
(define (glyph-string pango-font
postscript-font-name
- size
- cid?
- w-x-y-named-glyphs)
+ size
+ cid?
+ w-x-y-named-glyphs)
(define (glyph-spec w h x y g) ; h not used
(let ((prefix (if (string? g) "/" "")))
(ly:format "~4f ~4f ~4f ~a~a"
- w x y
- prefix g)))
+ w x y
+ prefix g)))
(ly:format
(if cid?
-"/~a /CIDFont findresource ~a output-scale div scalefont setfont
+ "/~a /CIDFont findresource ~a output-scale div scalefont setfont
~a
~a print_glyphs"
-"/~a ~a output-scale div selectfont
+ "/~a ~a output-scale div selectfont
~a
~a print_glyphs")
- postscript-font-name
- size
- (string-join (map (lambda (x) (apply glyph-spec x))
- (reverse w-x-y-named-glyphs)) "\n")
- (length w-x-y-named-glyphs)))
+ postscript-font-name
+ size
+ (string-join (map (lambda (x) (apply glyph-spec x))
+ (reverse w-x-y-named-glyphs)) "\n")
+ (length w-x-y-named-glyphs)))
(define (grob-cause offset grob)
(if (ly:get-option 'point-and-click)
(let* ((cause (ly:grob-property grob 'cause))
- (music-origin (if (ly:stream-event? cause)
- (ly:event-property cause 'origin)))
- (point-and-click (ly:get-option 'point-and-click)))
- (if (and
- (ly:input-location? music-origin)
- (cond ((boolean? point-and-click) point-and-click)
- ((symbol? point-and-click)
- (ly:in-event-class? cause point-and-click))
- (else (any (lambda (t)
- (ly:in-event-class? cause t))
- point-and-click))))
- (let* ((location (ly:input-file-line-char-column music-origin))
- (raw-file (car location))
- (file (if (is-absolute? raw-file)
- raw-file
- (string-append (ly-getcwd) "/" raw-file)))
- (x-ext (ly:grob-extent grob grob X))
- (y-ext (ly:grob-extent grob grob Y)))
-
- (if (and (< 0 (interval-length x-ext))
- (< 0 (interval-length y-ext)))
- (ly:format "~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n"
- (+ (car offset) (car x-ext))
- (+ (cdr offset) (car y-ext))
- (+ (car offset) (cdr x-ext))
- (+ (cdr offset) (cdr y-ext))
-
- ;; Backslashes are not valid
- ;; file URI path separators.
- (ly:string-percent-encode
- (ly:string-substitute "\\" "/" file))
-
- (cadr location)
- (caddr location)
- (1+ (cadddr location)))
- ""))
- ""))
+ (music-origin (if (ly:stream-event? cause)
+ (ly:event-property cause 'origin)))
+ (point-and-click (ly:get-option 'point-and-click)))
+ (if (and
+ (ly:input-location? music-origin)
+ (cond ((boolean? point-and-click) point-and-click)
+ ((symbol? point-and-click)
+ (ly:in-event-class? cause point-and-click))
+ (else (any (lambda (t)
+ (ly:in-event-class? cause t))
+ point-and-click))))
+ (let* ((location (ly:input-file-line-char-column music-origin))
+ (raw-file (car location))
+ (file (if (is-absolute? raw-file)
+ raw-file
+ (string-append (ly-getcwd) "/" raw-file)))
+ (x-ext (ly:grob-extent grob grob X))
+ (y-ext (ly:grob-extent grob grob Y)))
+
+ (if (and (< 0 (interval-length x-ext))
+ (< 0 (interval-length y-ext)))
+ (ly:format "~4f ~4f ~4f ~4f (textedit://~a:~a:~a:~a) mark_URI\n"
+ (+ (car offset) (car x-ext))
+ (+ (cdr offset) (car y-ext))
+ (+ (car offset) (cdr x-ext))
+ (+ (cdr offset) (cdr y-ext))
+
+ ;; Backslashes are not valid
+ ;; file URI path separators.
+ (ly:string-percent-encode
+ (ly:string-substitute "\\" "/" file))
+
+ (cadr location)
+ (caddr location)
+ (1+ (cadddr location)))
+ ""))
+ ""))
""))
(define (named-glyph font glyph)
(ly:format "~a /~a glyphshow " ;;Why is there a space at the end?
- (ps-font-command font)
- glyph))
+ (ps-font-command font)
+ glyph))
(define (no-origin)
"")
@@ -197,24 +197,24 @@
(define (polygon points blot-diameter filled?)
(ly:format "~a ~4l ~a ~4f draw_polygon"
- (if filled? "true" "false")
- points
- (- (/ (length points) 2) 1)
- blot-diameter))
+ (if filled? "true" "false")
+ points
+ (- (/ (length points) 2) 1)
+ blot-diameter))
(define (round-filled-box left right bottom top blotdiam)
(let* ((halfblot (/ blotdiam 2))
- (x (- halfblot left))
- (width (- right (+ halfblot x)))
- (y (- halfblot bottom))
- (height (- top (+ halfblot y))))
+ (x (- halfblot left))
+ (width (- right (+ halfblot x)))
+ (y (- halfblot bottom))
+ (height (- top (+ halfblot y))))
(ly:format "~4l draw_round_box"
- (list width height x y blotdiam))))
+ (list width height x y blotdiam))))
;; save current color on stack and set new color
(define (setcolor r g b)
(ly:format "gsave ~4l setrgbcolor\n"
- (list r g b)))
+ (list r g b)))
;; restore color from stack
(define (resetcolor) "grestore\n")
@@ -222,9 +222,9 @@
;; rotation around given point
(define (setrotation ang x y)
(ly:format "gsave ~4l translate ~a rotate ~4l translate\n"
- (list x y)
- ang
- (list (* -1 x) (* -1 y))))
+ (list x y)
+ ang
+ (list (* -1 x) (* -1 y))))
(define (resetrotation ang x y)
"grestore ")
@@ -234,55 +234,55 @@
(define (url-link url x y)
(ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add (~a) mark_URI"
- (car x)
- (car y)
- (cdr x)
- (cdr y)
- url))
+ (car x)
+ (car y)
+ (cdr x)
+ (cdr y)
+ url))
(define (page-link page-no x y)
(if (number? page-no)
- (ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add ~a mark_page_link"
- (car x)
- (car y)
- (cdr x)
- (cdr y)
- page-no)
- ""))
+ (ly:format "~a ~a currentpoint vector_add ~a ~a currentpoint vector_add ~a mark_page_link"
+ (car x)
+ (car y)
+ (cdr x)
+ (cdr y)
+ page-no)
+ ""))
(define* (path thickness exps #:optional (cap 'round) (join 'round) (fill? #f))
(define (convert-path-exps exps)
(if (pair? exps)
- (let*
- ((head (car exps))
- (rest (cdr exps))
- (arity
- (cond
- ((memq head '(rmoveto rlineto lineto moveto)) 2)
- ((memq head '(rcurveto curveto)) 6)
- ((eq? head 'closepath) 0)
- (else 1)))
- (args (take rest arity))
- )
-
- ;; WARNING: this is a vulnerability: a user can output arbitrary PS code here.
- (cons (ly:format
- "~l ~a "
- args
- head)
- (convert-path-exps (drop rest arity))))
- '()))
+ (let*
+ ((head (car exps))
+ (rest (cdr exps))
+ (arity
+ (cond
+ ((memq head '(rmoveto rlineto lineto moveto)) 2)
+ ((memq head '(rcurveto curveto)) 6)
+ ((eq? head 'closepath) 0)
+ (else 1)))
+ (args (take rest arity))
+ )
+
+ ;; WARNING: this is a vulnerability: a user can output arbitrary PS code here.
+ (cons (ly:format
+ "~l ~a "
+ args
+ head)
+ (convert-path-exps (drop rest arity))))
+ '()))
(let ((cap-numeric (case cap ((butt) 0) ((round) 1) ((square) 2)
- (else (begin
- (ly:warning (_ "unknown line-cap-style: ~S")
- (symbol->string cap))
- 1))))
- (join-numeric (case join ((miter) 0) ((round) 1) ((bevel) 2)
- (else (begin
- (ly:warning (_ "unknown line-join-style: ~S")
- (symbol->string join))
- 1)))))
+ (else (begin
+ (ly:warning (_ "unknown line-cap-style: ~S")
+ (symbol->string cap))
+ 1))))
+ (join-numeric (case join ((miter) 0) ((round) 1) ((bevel) 2)
+ (else (begin
+ (ly:warning (_ "unknown line-join-style: ~S")
+ (symbol->string join))
+ 1)))))
(ly:format
"gsave currentpoint translate
~a setlinecap ~a setlinejoin ~a setlinewidth
@@ -295,7 +295,7 @@
(define (setscale x y)
(ly:format "gsave ~4l scale\n"
- (list x y)))
+ (list x y)))
(define (resetscale)
"grestore\n")
diff --git a/scm/output-socket.scm b/scm/output-socket.scm
index 352ff2989d..3532fc9732 100644
--- a/scm/output-socket.scm
+++ b/scm/output-socket.scm
@@ -6,43 +6,43 @@
#:re-export (quote))
(use-modules (guile)
- (srfi srfi-1)
- (srfi srfi-13)
- (lily))
+ (srfi srfi-1)
+ (srfi srfi-13)
+ (lily))
(define format ergonomic-simple-format)
(define (event-cause grob)
(let*
- ((cause (ly:grob-property grob 'cause)))
+ ((cause (ly:grob-property grob 'cause)))
(if (ly:stream-event? cause)
- cause
- #f)))
+ cause
+ #f)))
(define (grob-bbox grob offset)
(let*
- ((x-ext (ly:grob-extent grob grob X))
- (y-ext (ly:grob-extent grob grob Y))
- (x (car offset))
- (y (cdr offset)))
+ ((x-ext (ly:grob-extent grob grob X))
+ (y-ext (ly:grob-extent grob grob Y))
+ (x (car offset))
+ (y (cdr offset)))
(if (interval-empty? x-ext)
- (set! x-ext '(0 . 0)))
+ (set! x-ext '(0 . 0)))
(if (interval-empty? y-ext)
- (set! y-ext '(0 . 0)))
+ (set! y-ext '(0 . 0)))
(list (+ x (car x-ext))
- (+ y (car y-ext))
- (+ x (cdr x-ext))
- (+ y (cdr y-ext)))))
+ (+ y (car y-ext))
+ (+ x (cdr x-ext))
+ (+ y (cdr y-ext)))))
(define (escape-string str)
(string-regexp-substitute
- " " "\\040"
- (string-regexp-substitute "\"" "\\\"" str)))
+ " " "\\040"
+ (string-regexp-substitute "\"" "\\\"" str)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; stencil commands
@@ -50,26 +50,26 @@
(define (draw-line thick x1 y1 x2 y2)
(format #f "drawline ~a ~a ~a ~a ~a"
- thick x1 y2 x2 y2))
+ thick x1 y2 x2 y2))
(define (grob-cause offset grob)
(let*
- ((cause (event-cause grob))
- (tag (if (and cause (integer? (ly:event-property cause 'input-tag)))
- (ly:event-property cause 'input-tag)
- -1))
- (name (assoc-get 'name (ly:grob-property grob 'meta))))
+ ((cause (event-cause grob))
+ (tag (if (and cause (integer? (ly:event-property cause 'input-tag)))
+ (ly:event-property cause 'input-tag)
+ -1))
+ (name (assoc-get 'name (ly:grob-property grob 'meta))))
(apply format #f
- "cause ~a \"~a\" ~a ~a ~a ~a\n" tag name
- (grob-bbox grob offset))))
+ "cause ~a \"~a\" ~a ~a ~a ~a\n" tag name
+ (grob-bbox grob offset))))
(define (named-glyph font glyph)
(format #f "glyphshow ~a \"~a\" ~a \"~a\""
- (ly:font-glyph-name-to-charcode font glyph)
- (ly:font-name font)
- (modified-font-metric-font-scaling font)
- glyph))
+ (ly:font-glyph-name-to-charcode font glyph)
+ (ly:font-name font)
+ (modified-font-metric-font-scaling font)
+ glyph))
(define (no-origin)
"nocause\n")
@@ -81,16 +81,16 @@
(define (polygon xy-coords blot do-fill)
(format #f "polygon ~a ~a ~a"
- blot
- (if do-fill "True" "False")
- (string-join (map number->string xy-coords))))
+ blot
+ (if do-fill "True" "False")
+ (string-join (map number->string xy-coords))))
(define (round-filled-box breapth width depth height blot-diameter)
(format #f "draw_round_box ~a ~a ~a ~a ~a"
- breapth width depth height blot-diameter))
+ breapth width depth height blot-diameter))
(define (utf-8-string descr string)
(format #f "utf-8 \"~a\" \"~a\""
- (escape-string descr)
- ;; don't want unescaped spaces.
- (escape-string string)))
+ (escape-string descr)
+ ;; don't want unescaped spaces.
+ (escape-string string)))
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 354bff4e05..8e2c532a3b 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -23,15 +23,15 @@
;;; set by framework-gnome.scm
(define paper #f)
-
+
(use-modules
- (guile)
- (ice-9 regex)
- (ice-9 format)
- (ice-9 optargs)
- (lily)
- (srfi srfi-1)
- (srfi srfi-13))
+ (guile)
+ (ice-9 regex)
+ (ice-9 format)
+ (ice-9 optargs)
+ (lily)
+ (srfi srfi-1)
+ (srfi srfi-13))
(define fancy-format format)
(define format ergonomic-simple-format)
@@ -41,13 +41,13 @@
;; Helper functions
(define-public (attributes attributes-alist)
(apply string-append
- (map (lambda (x)
- (let ((attr (car x))
- (value (cdr x)))
- (if (number? value)
- (set! value (ly:format "~4f" value)))
- (format #f " ~s=\"~a\"" attr value)))
- attributes-alist)))
+ (map (lambda (x)
+ (let ((attr (car x))
+ (value (cdr x)))
+ (if (number? value)
+ (set! value (ly:format "~4f" value)))
+ (format #f " ~s=\"~a\"" attr value)))
+ attributes-alist)))
(define-public (eo entity . attributes-alist)
"o = open"
@@ -74,7 +74,7 @@
(if (equal? string "")
(apply eoc entity attributes-alist)
(string-append
- (apply eo (cons entity attributes-alist)) string (ec entity))))
+ (apply eo (cons entity attributes-alist)) string (ec entity))))
(define (offset->point o)
(ly:format "~4f ~4f" (car o) (- (cdr o))))
@@ -82,21 +82,21 @@
(define (number-list->point lst)
(define (helper lst)
(if (null? lst)
- '()
- (cons (format #f "~S ~S" (car lst) (- (cadr lst)))
- (helper (cddr lst)))))
+ '()
+ (cons (format #f "~S ~S" (car lst) (- (cadr lst)))
+ (helper (cddr lst)))))
(string-join (helper lst) " "))
(define (svg-bezier lst close)
(let* ((c0 (car (list-tail lst 3)))
- (c123 (list-head lst 3)))
+ (c123 (list-head lst 3)))
(string-append
- (if (not close) "M" "L")
- (offset->point c0)
- "C" (string-join (map offset->point c123) " ")
- (if (not close) "" "z"))))
+ (if (not close) "M" "L")
+ (offset->point c0)
+ "C" (string-join (map offset->point c123) " ")
+ (if (not close) "" "z"))))
(define (sqr x)
(* x x))
@@ -109,7 +109,7 @@
(define (string->entities string)
(apply string-append
- (map (lambda (x) (char->entity x)) (string->list string))))
+ (map (lambda (x) (char->entity x)) (string->list string))))
(define svg-element-regexp
(make-regexp "^(<[a-z]+) ?(.*>)"))
@@ -128,24 +128,24 @@
(define (set-attribute attr val)
(set! alist (assoc-set! alist attr val)))
(let* ((match-1 (regexp-exec pango-description-regexp-comma str))
- (match-2 (regexp-exec pango-description-regexp-nocomma str))
- (match (if match-1 match-1 match-2)))
+ (match-2 (regexp-exec pango-description-regexp-nocomma str))
+ (match (if match-1 match-1 match-2)))
(if (regexp-match? match)
- (begin
- (set-attribute 'font-family (match:prefix match))
- (if (string? (match:substring match 1))
- (set-attribute 'font-weight "bold"))
- (if (string? (match:substring match 2))
- (set-attribute 'font-style "italic"))
- (if (string? (match:substring match 3))
- (set-attribute 'font-variant "small-caps"))
- (set-attribute 'font-size
- (/ (string->number (match:substring match 4))
- lily-unit-length))
- (set-attribute 'text-anchor "start")
- (set-attribute 'fill "currentColor"))
- (ly:warning (_ "cannot decypher Pango description: ~a") str))
+ (begin
+ (set-attribute 'font-family (match:prefix match))
+ (if (string? (match:substring match 1))
+ (set-attribute 'font-weight "bold"))
+ (if (string? (match:substring match 2))
+ (set-attribute 'font-style "italic"))
+ (if (string? (match:substring match 3))
+ (set-attribute 'font-variant "small-caps"))
+ (set-attribute 'font-size
+ (/ (string->number (match:substring match 4))
+ lily-unit-length))
+ (set-attribute 'text-anchor "start")
+ (set-attribute 'fill "currentColor"))
+ (ly:warning (_ "cannot decypher Pango description: ~a") str))
(apply entity 'text expr (reverse! alist))))
@@ -155,21 +155,21 @@
(set! alist (assoc-set! alist attr val)))
(if (not (null? rest))
(let* ((dx (car rest))
- (dy (cadr rest))
- (total-x (+ dx next-horiz-adv)))
- (if (or (not (zero? total-x))
- (not (zero? dy)))
- (let ((x (ly:format "~4f" total-x))
- (y (ly:format "~4f" dy)))
- (set-attribute 'transform
- (string-append
- "translate(" x ", " y ") "
- "scale(" scale ", -" scale ")")))
- (set-attribute 'transform
- (string-append
- "scale(" scale ", -" scale ")"))))
+ (dy (cadr rest))
+ (total-x (+ dx next-horiz-adv)))
+ (if (or (not (zero? total-x))
+ (not (zero? dy)))
+ (let ((x (ly:format "~4f" total-x))
+ (y (ly:format "~4f" dy)))
+ (set-attribute 'transform
+ (string-append
+ "translate(" x ", " y ") "
+ "scale(" scale ", -" scale ")")))
+ (set-attribute 'transform
+ (string-append
+ "scale(" scale ", -" scale ")"))))
(set-attribute 'transform (string-append
- "scale(" scale ", -" scale ")")))
+ "scale(" scale ", -" scale ")")))
(set-attribute 'd path)
(set-attribute 'fill "currentColor")
@@ -201,112 +201,112 @@
;;
(define (glyph-element-regexp name)
(make-regexp (string-append "<glyph"
- "(([[:space:]]+[-a-z]+=\"[^\"]*\")+)?"
- "[[:space:]]+glyph-name=\"("
- name
- ")\""
- "(([[:space:]]+[-a-z]+=\"[^\"]*\")+)?"
- "([[:space:]]+)?"
- "/>")))
+ "(([[:space:]]+[-a-z]+=\"[^\"]*\")+)?"
+ "[[:space:]]+glyph-name=\"("
+ name
+ ")\""
+ "(([[:space:]]+[-a-z]+=\"[^\"]*\")+)?"
+ "([[:space:]]+)?"
+ "/>")))
(define (extract-glyph all-glyphs name size . rest)
(let* ((new-name (regexp-quote name))
- (regexp (regexp-exec (glyph-element-regexp new-name) all-glyphs))
- (glyph (match:substring regexp))
- (unicode-attr (regexp-exec glyph-unicode-value-regexp glyph))
- (unicode-attr-value (match:substring unicode-attr 1))
- (unicode-attr? (regexp-match? unicode-attr))
- (d-attr (regexp-exec glyph-path-regexp glyph))
- (d-attr-value "")
- (d-attr? (regexp-match? d-attr))
- ;; TODO: not urgent, but do not hardcode this value
- (units-per-em 1000)
- (font-scale (ly:format "~4f" (/ size units-per-em)))
- (path ""))
+ (regexp (regexp-exec (glyph-element-regexp new-name) all-glyphs))
+ (glyph (match:substring regexp))
+ (unicode-attr (regexp-exec glyph-unicode-value-regexp glyph))
+ (unicode-attr-value (match:substring unicode-attr 1))
+ (unicode-attr? (regexp-match? unicode-attr))
+ (d-attr (regexp-exec glyph-path-regexp glyph))
+ (d-attr-value "")
+ (d-attr? (regexp-match? d-attr))
+ ;; TODO: not urgent, but do not hardcode this value
+ (units-per-em 1000)
+ (font-scale (ly:format "~4f" (/ size units-per-em)))
+ (path ""))
(if (and unicode-attr? (not unicode-attr-value))
- (ly:warning (_ "Glyph must have a unicode value")))
+ (ly:warning (_ "Glyph must have a unicode value")))
(if d-attr? (set! d-attr-value (match:substring d-attr 1)))
(cond (
- ;; Glyph-strings with path data
- (and d-attr? (not (null? rest)))
- (begin
- (set! path (apply dump-path d-attr-value
- font-scale
- (list (caddr rest) (cadddr rest))))
- (set! next-horiz-adv (+ next-horiz-adv
- (car rest)))
- path))
- ;; Glyph-strings without path data ("space")
- ((and (not d-attr?) (not (null? rest)))
- (begin
- (set! next-horiz-adv (+ next-horiz-adv
- (car rest)))
- ""))
- ;; Font smobs with path data
- ((and d-attr? (null? rest))
- (set! path (dump-path d-attr-value font-scale))
- path)
- ;; Font smobs without path data ("space")
- (else
- ""))))
+ ;; Glyph-strings with path data
+ (and d-attr? (not (null? rest)))
+ (begin
+ (set! path (apply dump-path d-attr-value
+ font-scale
+ (list (caddr rest) (cadddr rest))))
+ (set! next-horiz-adv (+ next-horiz-adv
+ (car rest)))
+ path))
+ ;; Glyph-strings without path data ("space")
+ ((and (not d-attr?) (not (null? rest)))
+ (begin
+ (set! next-horiz-adv (+ next-horiz-adv
+ (car rest)))
+ ""))
+ ;; Font smobs with path data
+ ((and d-attr? (null? rest))
+ (set! path (dump-path d-attr-value font-scale))
+ path)
+ ;; Font smobs without path data ("space")
+ (else
+ ""))))
(define (extract-glyph-info all-glyphs glyph size)
(let* ((offsets (list-head glyph 4))
- (glyph-name (car (reverse glyph))))
+ (glyph-name (car (reverse glyph))))
(apply extract-glyph all-glyphs glyph-name size offsets)))
(define (svg-defs svg-font)
(let ((start (string-contains svg-font "<defs>"))
- (end (string-contains svg-font "</defs>")))
+ (end (string-contains svg-font "</defs>")))
(substring svg-font (+ start 7) (- end 1))))
(define (cache-font svg-font size glyph)
(let ((all-glyphs (svg-defs (cached-file-contents svg-font))))
(if (list? glyph)
- (extract-glyph-info all-glyphs glyph size)
- (extract-glyph all-glyphs glyph size))))
+ (extract-glyph-info all-glyphs glyph size)
+ (extract-glyph all-glyphs glyph size))))
(define (music-string-to-path font size glyph)
(let* ((name-style (font-name-style font))
- (scaled-size (/ size lily-unit-length))
- (font-file (ly:find-file (string-append name-style ".svg"))))
+ (scaled-size (/ size lily-unit-length))
+ (font-file (ly:find-file (string-append name-style ".svg"))))
(if font-file
- (cache-font font-file scaled-size glyph)
- (ly:warning (_ "cannot find SVG font ~S") font-file))))
+ (cache-font font-file scaled-size glyph)
+ (ly:warning (_ "cannot find SVG font ~S") font-file))))
(define (font-smob-to-path font glyph)
(let* ((name-style (font-name-style font))
- (scaled-size (modified-font-metric-font-scaling font))
- (font-file (ly:find-file (string-append name-style ".svg"))))
+ (scaled-size (modified-font-metric-font-scaling font))
+ (font-file (ly:find-file (string-append name-style ".svg"))))
(if font-file
- (cache-font font-file scaled-size glyph)
- (ly:warning (_ "cannot find SVG font ~S") font-file))))
+ (cache-font font-file scaled-size glyph)
+ (ly:warning (_ "cannot find SVG font ~S") font-file))))
(define (woff-font-smob-to-text font expr)
(let* ((name-style (font-name-style font))
- (scaled-size (modified-font-metric-font-scaling font))
- (font-file (ly:find-file (string-append name-style ".woff")))
- (charcode (ly:font-glyph-name-to-charcode font expr))
- (char-lookup (format #f "&#~S;" charcode))
- (glyph-by-name (eoc 'altglyph `(glyphname . ,expr)))
- (apparently-broken
- (comment "FIXME: how to select glyph by name, altglyph is broken?"))
- (text (string-regexp-substitute "\n" ""
- (string-append glyph-by-name apparently-broken char-lookup))))
- (define alist '())
- (define (set-attribute attr val)
- (set! alist (assoc-set! alist attr val)))
- (set-attribute 'font-family name-style)
- (set-attribute 'font-size scaled-size)
- (apply entity 'text text (reverse! alist))))
-
+ (scaled-size (modified-font-metric-font-scaling font))
+ (font-file (ly:find-file (string-append name-style ".woff")))
+ (charcode (ly:font-glyph-name-to-charcode font expr))
+ (char-lookup (format #f "&#~S;" charcode))
+ (glyph-by-name (eoc 'altglyph `(glyphname . ,expr)))
+ (apparently-broken
+ (comment "FIXME: how to select glyph by name, altglyph is broken?"))
+ (text (string-regexp-substitute "\n" ""
+ (string-append glyph-by-name apparently-broken char-lookup))))
+ (define alist '())
+ (define (set-attribute attr val)
+ (set! alist (assoc-set! alist attr val)))
+ (set-attribute 'font-family name-style)
+ (set-attribute 'font-size scaled-size)
+ (apply entity 'text text (reverse! alist))))
+
(define font-smob-to-text
(if (not (ly:get-option 'svg-woff))
font-smob-to-path woff-font-smob-to-text))
@@ -325,41 +325,41 @@
(define (circle radius thick is-filled)
(entity
- 'circle ""
- '(stroke-linejoin . "round")
- '(stroke-linecap . "round")
- `(fill . ,(if is-filled "currentColor" "none"))
- `(stroke . "currentColor")
- `(stroke-width . ,thick)
- `(r . ,radius)))
+ 'circle ""
+ '(stroke-linejoin . "round")
+ '(stroke-linecap . "round")
+ `(fill . ,(if is-filled "currentColor" "none"))
+ `(stroke . "currentColor")
+ `(stroke-width . ,thick)
+ `(r . ,radius)))
(define (dashed-line thick on off dx dy phase)
(draw-line thick 0 0 dx dy
- `(stroke-dasharray . ,(format #f "~a,~a" on off))))
+ `(stroke-dasharray . ,(format #f "~a,~a" on off))))
(define (draw-line thick x1 y1 x2 y2 . alist)
(apply entity 'line ""
- (append
- `((stroke-linejoin . "round")
- (stroke-linecap . "round")
- (stroke-width . ,thick)
- (stroke . "currentColor")
- (x1 . ,x1)
- (y1 . ,(- y1))
- (x2 . ,x2)
- (y2 . ,(- y2)))
- alist)))
+ (append
+ `((stroke-linejoin . "round")
+ (stroke-linecap . "round")
+ (stroke-width . ,thick)
+ (stroke . "currentColor")
+ (x1 . ,x1)
+ (y1 . ,(- y1))
+ (x2 . ,x2)
+ (y2 . ,(- y2)))
+ alist)))
(define (ellipse x-radius y-radius thick is-filled)
(entity
- 'ellipse ""
- '(stroke-linejoin . "round")
- '(stroke-linecap . "round")
- `(fill . ,(if is-filled "currentColor" "none"))
- `(stroke . "currentColor")
- `(stroke-width . ,thick)
- `(rx . ,x-radius)
- `(ry . ,y-radius)))
+ 'ellipse ""
+ '(stroke-linejoin . "round")
+ '(stroke-linecap . "round")
+ `(fill . ,(if is-filled "currentColor" "none"))
+ `(stroke . "currentColor")
+ `(stroke-width . ,thick)
+ `(rx . ,x-radius)
+ `(ry . ,y-radius)))
(define (partial-ellipse x-radius y-radius start-angle end-angle thick connect fill)
(define (make-ellipse-radius x-radius y-radius angle)
@@ -369,38 +369,38 @@
(* (* x-radius x-radius)
(* (sin angle) (sin angle)))))))
(let*
- ((new-start-angle (* PI-OVER-180 (angle-0-360 start-angle)))
- (start-radius (make-ellipse-radius x-radius y-radius new-start-angle))
- (new-end-angle (* PI-OVER-180 (angle-0-360 end-angle)))
- (end-radius (make-ellipse-radius x-radius y-radius new-end-angle))
- (epsilon 1.5e-3)
- (x-end (- (* end-radius (cos new-end-angle))
- (* start-radius (cos new-start-angle))))
- (y-end (- (* end-radius (sin new-end-angle))
- (* start-radius (sin new-start-angle)))))
- (if (and (< (abs x-end) epsilon) (< (abs y-end) epsilon))
- (entity
- 'ellipse ""
- `(fill . ,(if fill "currentColor" "none"))
- `(stroke . "currentColor")
- `(stroke-width . ,thick)
- '(stroke-linejoin . "round")
- '(stroke-linecap . "round")
- '(cx . 0)
- '(cy . 0)
- `(rx . ,x-radius)
- `(ry . ,y-radius))
- (entity
- 'path ""
- `(fill . ,(if fill "currentColor" "none"))
- `(stroke . "currentColor")
- `(stroke-width . ,thick)
- '(stroke-linejoin . "round")
- '(stroke-linecap . "round")
- (cons
- 'd
- (string-append
- (ly:format
+ ((new-start-angle (* PI-OVER-180 (angle-0-360 start-angle)))
+ (start-radius (make-ellipse-radius x-radius y-radius new-start-angle))
+ (new-end-angle (* PI-OVER-180 (angle-0-360 end-angle)))
+ (end-radius (make-ellipse-radius x-radius y-radius new-end-angle))
+ (epsilon 1.5e-3)
+ (x-end (- (* end-radius (cos new-end-angle))
+ (* start-radius (cos new-start-angle))))
+ (y-end (- (* end-radius (sin new-end-angle))
+ (* start-radius (sin new-start-angle)))))
+ (if (and (< (abs x-end) epsilon) (< (abs y-end) epsilon))
+ (entity
+ 'ellipse ""
+ `(fill . ,(if fill "currentColor" "none"))
+ `(stroke . "currentColor")
+ `(stroke-width . ,thick)
+ '(stroke-linejoin . "round")
+ '(stroke-linecap . "round")
+ '(cx . 0)
+ '(cy . 0)
+ `(rx . ,x-radius)
+ `(ry . ,y-radius))
+ (entity
+ 'path ""
+ `(fill . ,(if fill "currentColor" "none"))
+ `(stroke . "currentColor")
+ `(stroke-width . ,thick)
+ '(stroke-linejoin . "round")
+ '(stroke-linecap . "round")
+ (cons
+ 'd
+ (string-append
+ (ly:format
"M~4f ~4fA~4f ~4f 0 ~4f 0 ~4f ~4f"
(* start-radius (cos new-start-angle))
(- (* start-radius (sin new-start-angle)))
@@ -409,11 +409,11 @@
(if (> 0 (- new-start-angle new-end-angle)) 0 1)
(* end-radius (cos new-end-angle))
(- (* end-radius (sin new-end-angle))))
- (if connect
- (ly:format "L~4f,~4f"
- (* start-radius (cos new-start-angle))
- (- (* start-radius (sin new-start-angle))))
- "")))))))
+ (if connect
+ (ly:format "L~4f,~4f"
+ (* start-radius (cos new-start-angle))
+ (- (* start-radius (sin new-start-angle))))
+ "")))))))
(define (embedded-svg string)
string)
@@ -423,51 +423,51 @@
(if (= 1 (length glyphs))
(set! path (music-string-to-path font size (car glyphs)))
(begin
- (set! path
- (string-append (eo 'g)
- (string-join
- (map (lambda (x)
- (music-string-to-path font size x))
- glyphs)
- "\n")
- (ec 'g)))))
+ (set! path
+ (string-append (eo 'g)
+ (string-join
+ (map (lambda (x)
+ (music-string-to-path font size x))
+ glyphs)
+ "\n")
+ (ec 'g)))))
(set! next-horiz-adv 0.0)
path)
(define (woff-glyph-string pango-font font-name size cid? w-h-x-y-named-glyphs)
(let* ((name-style (font-name-style font-name))
- (family-designsize (regexp-exec (make-regexp "(.*)-([0-9]*)")
- font-name))
- (family (if (regexp-match? family-designsize)
- (match:substring family-designsize 1)
- font-name))
- (design-size (if (regexp-match? family-designsize)
- (match:substring family-designsize 2)
- #f))
- (scaled-size (/ size lily-unit-length))
- (font (ly:paper-get-font paper `(((font-family . ,family)
- ,(if design-size
- `(design-size . design-size)))))))
+ (family-designsize (regexp-exec (make-regexp "(.*)-([0-9]*)")
+ font-name))
+ (family (if (regexp-match? family-designsize)
+ (match:substring family-designsize 1)
+ font-name))
+ (design-size (if (regexp-match? family-designsize)
+ (match:substring family-designsize 2)
+ #f))
+ (scaled-size (/ size lily-unit-length))
+ (font (ly:paper-get-font paper `(((font-family . ,family)
+ ,(if design-size
+ `(design-size . design-size)))))))
(define (glyph-spec w h x y g) ; h not used
(let* ((charcode (ly:font-glyph-name-to-charcode font g))
- (char-lookup (format #f "&#~S;" charcode))
- (glyph-by-name (eoc 'altglyph `(glyphname . ,g)))
- (apparently-broken
- (comment "XFIXME: how to select glyph by name, altglyph is broken?")))
- ;; what is W?
- (ly:format
- "<text~a font-family=\"~a\" font-size=\"~a\">~a</text>"
- (if (or (> (abs x) 0.00001)
- (> (abs y) 0.00001))
- (ly:format " transform=\"translate(~4f,~4f)\"" x y)
- " ")
- name-style scaled-size
- (string-regexp-substitute
- "\n" ""
- (string-append glyph-by-name apparently-broken char-lookup)))))
+ (char-lookup (format #f "&#~S;" charcode))
+ (glyph-by-name (eoc 'altglyph `(glyphname . ,g)))
+ (apparently-broken
+ (comment "XFIXME: how to select glyph by name, altglyph is broken?")))
+ ;; what is W?
+ (ly:format
+ "<text~a font-family=\"~a\" font-size=\"~a\">~a</text>"
+ (if (or (> (abs x) 0.00001)
+ (> (abs y) 0.00001))
+ (ly:format " transform=\"translate(~4f,~4f)\"" x y)
+ " ")
+ name-style scaled-size
+ (string-regexp-substitute
+ "\n" ""
+ (string-append glyph-by-name apparently-broken char-lookup)))))
(string-join (map (lambda (x) (apply glyph-spec x))
- (reverse w-h-x-y-named-glyphs)) "\n")))
+ (reverse w-h-x-y-named-glyphs)) "\n")))
(define glyph-string
(if (not (ly:get-option 'svg-woff)) embedded-glyph-string woff-glyph-string))
@@ -484,83 +484,83 @@
(define* (path thick commands #:optional (cap 'round) (join 'round) (fill? #f))
(define (convert-path-exps exps)
(if (pair? exps)
- (let*
- ((head (car exps))
- (rest (cdr exps))
- (arity
- (cond ((memq head '(rmoveto rlineto lineto moveto)) 2)
- ((memq head '(rcurveto curveto)) 6)
- ((eq? head 'closepath) 0)
- (else 1)))
- (args (take rest arity))
- (svg-head (assoc-get head
- '((rmoveto . m)
- (rcurveto . c)
- (curveto . C)
- (moveto . M)
- (lineto . L)
- (rlineto . l)
- (closepath . z))
- "")))
-
- (cons (format #f "~a~a" svg-head (number-list->point args))
- (convert-path-exps (drop rest arity))))
- '()))
+ (let*
+ ((head (car exps))
+ (rest (cdr exps))
+ (arity
+ (cond ((memq head '(rmoveto rlineto lineto moveto)) 2)
+ ((memq head '(rcurveto curveto)) 6)
+ ((eq? head 'closepath) 0)
+ (else 1)))
+ (args (take rest arity))
+ (svg-head (assoc-get head
+ '((rmoveto . m)
+ (rcurveto . c)
+ (curveto . C)
+ (moveto . M)
+ (lineto . L)
+ (rlineto . l)
+ (closepath . z))
+ "")))
+
+ (cons (format #f "~a~a" svg-head (number-list->point args))
+ (convert-path-exps (drop rest arity))))
+ '()))
(let* ((line-cap-styles '(butt round square))
- (line-join-styles '(miter round bevel))
- (cap-style (if (not (memv cap line-cap-styles))
- (begin
- (ly:warning (_ "unknown line-cap-style: ~S")
- (symbol->string cap))
- 'round)
- cap))
- (join-style (if (not (memv join line-join-styles))
- (begin
- (ly:warning (_ "unknown line-join-style: ~S")
- (symbol->string join))
- 'round)
- join)))
+ (line-join-styles '(miter round bevel))
+ (cap-style (if (not (memv cap line-cap-styles))
+ (begin
+ (ly:warning (_ "unknown line-cap-style: ~S")
+ (symbol->string cap))
+ 'round)
+ cap))
+ (join-style (if (not (memv join line-join-styles))
+ (begin
+ (ly:warning (_ "unknown line-join-style: ~S")
+ (symbol->string join))
+ 'round)
+ join)))
(entity 'path ""
- `(stroke-width . ,thick)
- `(stroke-linejoin . ,(symbol->string join-style))
- `(stroke-linecap . ,(symbol->string cap-style))
- '(stroke . "currentColor")
- `(fill . ,(if fill? "currentColor" "none"))
- `(d . ,(apply string-append (convert-path-exps commands))))))
+ `(stroke-width . ,thick)
+ `(stroke-linejoin . ,(symbol->string join-style))
+ `(stroke-linecap . ,(symbol->string cap-style))
+ '(stroke . "currentColor")
+ `(fill . ,(if fill? "currentColor" "none"))
+ `(d . ,(apply string-append (convert-path-exps commands))))))
(define (placebox x y expr)
(if (string-null? expr)
""
(let*
- ((normal-element (regexp-exec svg-element-regexp expr))
- (scaled-element (regexp-exec scaled-element-regexp expr))
- (scaled? (if scaled-element #t #f))
- (match (if scaled? scaled-element normal-element))
- (string1 (match:substring match 1))
- (string2 (match:substring match 2)))
-
- (if scaled?
- (string-append string1
- (ly:format "translate(~4f, ~4f) " x (- y))
- string2
- "\n")
- (string-append string1
- (ly:format " transform=\"translate(~4f, ~4f)\" "
- x (- y))
- string2
- "\n")))))
+ ((normal-element (regexp-exec svg-element-regexp expr))
+ (scaled-element (regexp-exec scaled-element-regexp expr))
+ (scaled? (if scaled-element #t #f))
+ (match (if scaled? scaled-element normal-element))
+ (string1 (match:substring match 1))
+ (string2 (match:substring match 2)))
+
+ (if scaled?
+ (string-append string1
+ (ly:format "translate(~4f, ~4f) " x (- y))
+ string2
+ "\n")
+ (string-append string1
+ (ly:format " transform=\"translate(~4f, ~4f)\" "
+ x (- y))
+ string2
+ "\n")))))
(define (polygon coords blot-diameter is-filled)
(entity
- 'polygon ""
- '(stroke-linejoin . "round")
- '(stroke-linecap . "round")
- `(stroke-width . ,blot-diameter)
- `(fill . ,(if is-filled "currentColor" "none"))
- '(stroke . "currentColor")
- `(points . ,(string-join
- (map offset->point (ly:list->offsets '() coords))))))
+ 'polygon ""
+ '(stroke-linejoin . "round")
+ '(stroke-linecap . "round")
+ `(stroke-width . ,blot-diameter)
+ `(fill . ,(if is-filled "currentColor" "none"))
+ '(stroke . "currentColor")
+ `(points . ,(string-join
+ (map offset->point (ly:list->offsets '() coords))))))
(define (resetcolor)
"</g>\n")
@@ -573,34 +573,34 @@
(define (round-filled-box breapth width depth height blot-diameter)
(entity
- 'rect ""
- ;; The stroke will stick out. To use stroke,
- ;; the stroke-width must be subtracted from all other dimensions.
- ;;'(stroke-linejoin . "round")
- ;;'(stroke-linecap . "round")
- ;;`(stroke-width . ,blot)
- ;;'(stroke . "red")
- ;;'(fill . "orange")
-
- `(x . ,(- breapth))
- `(y . ,(- height))
- `(width . ,(+ breapth width))
- `(height . ,(+ depth height))
- `(ry . ,(/ blot-diameter 2))
- '(fill . "currentColor")))
+ 'rect ""
+ ;; The stroke will stick out. To use stroke,
+ ;; the stroke-width must be subtracted from all other dimensions.
+ ;;'(stroke-linejoin . "round")
+ ;;'(stroke-linecap . "round")
+ ;;`(stroke-width . ,blot)
+ ;;'(stroke . "red")
+ ;;'(fill . "orange")
+
+ `(x . ,(- breapth))
+ `(y . ,(- height))
+ `(width . ,(+ breapth width))
+ `(height . ,(+ depth height))
+ `(ry . ,(/ blot-diameter 2))
+ '(fill . "currentColor")))
(define (setcolor r g b)
(format #f "<g color=\"rgb(~a%, ~a%, ~a%)\">\n"
- (* 100 r) (* 100 g) (* 100 b)))
+ (* 100 r) (* 100 g) (* 100 b)))
;; rotate around given point
(define (setrotation ang x y)
(ly:format "<g transform=\"rotate(~4f, ~4f, ~4f)\">\n"
- (- ang) x (- y)))
+ (- ang) x (- y)))
(define (setscale x y)
(ly:format "<g transform=\"scale(~4f, ~4f)\">\n"
- x y))
+ x y))
(define (text font string)
(fontify font (entity 'tspan (string->entities string))))
@@ -609,18 +609,18 @@
(string-append
(eo 'a `(xlink:href . ,url))
(eoc 'rect
- `(x . ,(car x))
- `(y . ,(car y))
- `(width . ,(- (cdr x) (car x)))
- `(height . ,(- (cdr y) (car y)))
- '(fill . "none")
- '(stroke . "none")
- '(stroke-width . "0.0"))
+ `(x . ,(car x))
+ `(y . ,(car y))
+ `(width . ,(- (cdr x) (car x)))
+ `(height . ,(- (cdr y) (car y)))
+ '(fill . "none")
+ '(stroke . "none")
+ '(stroke-width . "0.0"))
(ec 'a)))
(define (utf-8-string pango-font-description string)
(let ((escaped-string (string-regexp-substitute
- "<" "<"
- (string-regexp-substitute "&" "&" string))))
+ "<" "<"
+ (string-regexp-substitute "&" "&" string))))
(fontify pango-font-description
(entity 'tspan escaped-string))))
diff --git a/scm/page.scm b/scm/page.scm
index ada4a890f9..bfae0ea2f4 100644
--- a/scm/page.scm
+++ b/scm/page.scm
@@ -18,25 +18,25 @@
(define-module (scm page)
#:export (make-page
- page-property
- page-set-property!
- page-prev
- page-printable-height
- layout->page-init
- page-force
- page-penalty
- page-configuration
- page-lines
- page-page-number
- page-system-numbers
- page-stencil
- page-free-height
- page?
- ))
+ page-property
+ page-set-property!
+ page-prev
+ page-printable-height
+ layout->page-init
+ page-force
+ page-penalty
+ page-configuration
+ page-lines
+ page-page-number
+ page-system-numbers
+ page-stencil
+ page-free-height
+ page?
+ ))
(use-modules (lily)
- (scm paper-system)
- (srfi srfi-1))
+ (scm paper-system)
+ (srfi srfi-1))
(define (annotate? layout)
@@ -48,9 +48,9 @@
(define (make-page paper-book . args)
(let*
((p (apply ly:make-prob (append
- (list 'page (layout->page-init (ly:paper-book-paper paper-book))
- 'paper-book paper-book)
- args))))
+ (list 'page (layout->page-init (ly:paper-book-paper paper-book))
+ 'paper-book paper-book)
+ args))))
(page-set-property! p 'head-stencil (page-header p))
(page-set-property! p 'foot-stencil (page-footer p))
@@ -84,61 +84,61 @@
(lambda (sys-off)
(let*
- ((sys (car sys-off))
- (off (cadr sys-off)))
+ ((sys (car sys-off))
+ (off (cadr sys-off)))
(if (not (number? (ly:prob-property sys 'Y-offset)))
- (ly:prob-set-property! sys 'Y-offset off))))
+ (ly:prob-set-property! sys 'Y-offset off))))
(zip (page-property page 'lines)
- (page-property page 'configuration))))
+ (page-property page 'configuration))))
(define (annotate-top-space first-system layout header-stencil stencil)
(let* ((top-margin (ly:output-def-lookup layout 'top-margin))
- (sym (if (paper-system-title? first-system)
- 'top-markup-spacing
- 'top-system-spacing))
- (spacing-spec (ly:output-def-lookup layout sym))
- (X-offset (ly:prob-property first-system 'X-offset 5))
- (header-extent (ly:stencil-extent header-stencil Y)))
+ (sym (if (paper-system-title? first-system)
+ 'top-markup-spacing
+ 'top-system-spacing))
+ (spacing-spec (ly:output-def-lookup layout sym))
+ (X-offset (ly:prob-property first-system 'X-offset 5))
+ (header-extent (ly:stencil-extent header-stencil Y)))
(set! stencil
- (ly:stencil-add stencil
- (ly:stencil-translate-axis
- (annotate-spacing-spec layout
- spacing-spec
- (- top-margin)
- (car header-extent)
- #:base-color red)
- X-offset X)))
+ (ly:stencil-add stencil
+ (ly:stencil-translate-axis
+ (annotate-spacing-spec layout
+ spacing-spec
+ (- top-margin)
+ (car header-extent)
+ #:base-color red)
+ X-offset X)))
stencil))
(define (annotate-page layout stencil)
(let ((top-margin (ly:output-def-lookup layout 'top-margin))
- (paper-height (ly:output-def-lookup layout 'paper-height))
- (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
- (add-stencil (lambda (y)
- (set! stencil
- (ly:stencil-add stencil
- (ly:stencil-translate-axis y 6 X))))))
+ (paper-height (ly:output-def-lookup layout 'paper-height))
+ (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
+ (add-stencil (lambda (y)
+ (set! stencil
+ (ly:stencil-add stencil
+ (ly:stencil-translate-axis y 6 X))))))
(add-stencil
(ly:stencil-translate-axis
(annotate-y-interval layout "paper-height"
- (cons (- paper-height) 0)
- #t)
+ (cons (- paper-height) 0)
+ #t)
1 X))
(add-stencil
(ly:stencil-translate-axis
(annotate-y-interval layout "top-margin"
- (cons (- top-margin) 0)
- #t)
+ (cons (- top-margin) 0)
+ #t)
2 X))
(add-stencil
(ly:stencil-translate-axis
(annotate-y-interval layout "bottom-margin"
- (cons (- paper-height) (- bottom-margin paper-height))
- #t)
+ (cons (- paper-height) (- bottom-margin paper-height))
+ #t)
2 X))
stencil))
@@ -147,16 +147,16 @@
((paper-book (page-property page 'paper-book))
(layout (ly:paper-book-paper paper-book))
(arrow (annotate-y-interval layout
- "space left"
- (cons (- 0.0
- (page-property page 'bottom-edge)
- (let ((foot (page-property page 'foot-stencil)))
- (if (and (ly:stencil? foot)
- (not (ly:stencil-empty? foot)))
- (car (ly:stencil-extent foot Y))
- 0.0)))
- (page-property page 'bottom-system-edge))
- #t)))
+ "space left"
+ (cons (- 0.0
+ (page-property page 'bottom-edge)
+ (let ((foot (page-property page 'foot-stencil)))
+ (if (and (ly:stencil? foot)
+ (not (ly:stencil-empty? foot)))
+ (car (ly:stencil-extent foot Y))
+ 0.0)))
+ (page-property page 'bottom-system-edge))
+ #t)))
(set! arrow (ly:stencil-translate-axis arrow 8 X))
@@ -172,13 +172,13 @@
(is-last-bookpart (page-property page 'is-last-bookpart))
(is-bookpart-last-page (page-property page 'is-bookpart-last-page))
(sym (if (= dir UP)
- 'make-header
- 'make-footer))
+ 'make-header
+ 'make-footer))
(header-proc (ly:output-def-lookup layout sym)))
(if (procedure? header-proc)
- (header-proc layout scopes number is-last-bookpart is-bookpart-last-page)
- #f)))
+ (header-proc layout scopes number is-last-bookpart is-bookpart-last-page)
+ #f)))
(define (page-header page)
@@ -195,7 +195,7 @@
(left-margin (ly:output-def-lookup layout 'left-margin))
(right-margin (ly:output-def-lookup layout 'right-margin))
(bottom-edge (- paper-height
- (ly:output-def-lookup layout 'bottom-margin)) )
+ (ly:output-def-lookup layout 'bottom-margin)) )
(top-margin (ly:output-def-lookup layout 'top-margin))
)
@@ -225,114 +225,114 @@
(system-xoffset (ly:output-def-lookup layout 'horizontal-shift 0.0))
(system-separator-markup (ly:output-def-lookup layout 'system-separator-markup))
(system-separator-stencil (if (markup? system-separator-markup)
- (interpret-markup layout
- (layout-extract-page-properties layout)
- system-separator-markup)
- #f))
+ (interpret-markup layout
+ (layout-extract-page-properties layout)
+ system-separator-markup)
+ #f))
(page-stencil (ly:make-stencil '()))
(last-system #f)
(last-y 0.0)
(add-to-page (lambda (stencil x y)
- (set! page-stencil
- (ly:stencil-add page-stencil
- (ly:stencil-translate stencil
- (cons
- (+ system-xoffset x)
- (- 0 y (prop 'top-margin)))
-
- )))))
+ (set! page-stencil
+ (ly:stencil-add page-stencil
+ (ly:stencil-translate stencil
+ (cons
+ (+ system-xoffset x)
+ (- 0 y (prop 'top-margin)))
+
+ )))))
(add-system
- (lambda (system)
- (let* ((stencil (paper-system-stencil system))
- (y (ly:prob-property system 'Y-offset 0))
- (is-title (paper-system-title?
- system)))
- (add-to-page stencil
- (ly:prob-property system 'X-offset 0.0)
- y)
- (if (and (ly:stencil? system-separator-stencil)
- last-system
- (not (paper-system-title? system))
- (not (paper-system-title? last-system)))
- (add-to-page
- system-separator-stencil
- 0
- (average (- last-y
- (car (paper-system-staff-extents last-system)))
- (- y
- (cdr (paper-system-staff-extents system))))))
- (set! last-system system)
- (set! last-y y))))
+ (lambda (system)
+ (let* ((stencil (paper-system-stencil system))
+ (y (ly:prob-property system 'Y-offset 0))
+ (is-title (paper-system-title?
+ system)))
+ (add-to-page stencil
+ (ly:prob-property system 'X-offset 0.0)
+ y)
+ (if (and (ly:stencil? system-separator-stencil)
+ last-system
+ (not (paper-system-title? system))
+ (not (paper-system-title? last-system)))
+ (add-to-page
+ system-separator-stencil
+ 0
+ (average (- last-y
+ (car (paper-system-staff-extents last-system)))
+ (- y
+ (cdr (paper-system-staff-extents system))))))
+ (set! last-system system)
+ (set! last-y y))))
(head (prop 'head-stencil))
(foot (prop 'foot-stencil))
)
(if (and
- (ly:stencil? head)
- (not (ly:stencil-empty? head)))
- (begin
- ;; Ensure that the top of the header just touches the top margin.
- (set! head (ly:stencil-translate-axis head
- (- 0 (cdr (ly:stencil-extent head Y)) (prop 'top-margin)) Y))
- (set! page-stencil (ly:stencil-add page-stencil head))))
+ (ly:stencil? head)
+ (not (ly:stencil-empty? head)))
+ (begin
+ ;; Ensure that the top of the header just touches the top margin.
+ (set! head (ly:stencil-translate-axis head
+ (- 0 (cdr (ly:stencil-extent head Y)) (prop 'top-margin)) Y))
+ (set! page-stencil (ly:stencil-add page-stencil head))))
(if (and
- (annotate? layout)
- (pair? lines))
+ (annotate? layout)
+ (pair? lines))
- (begin
- (set! page-stencil (annotate-top-space (car lines) layout head page-stencil))
+ (begin
+ (set! page-stencil (annotate-top-space (car lines) layout head page-stencil))
- (for-each (lambda (sys next-sys)
- (paper-system-annotate sys next-sys layout))
- lines
- (append (cdr lines) (list #f)))
- (paper-system-annotate-last (car (last-pair lines)) layout)))
+ (for-each (lambda (sys next-sys)
+ (paper-system-annotate sys next-sys layout))
+ lines
+ (append (cdr lines) (list #f)))
+ (paper-system-annotate-last (car (last-pair lines)) layout)))
(map add-system lines)
(ly:prob-set-property! page 'bottom-system-edge
- (car (ly:stencil-extent page-stencil Y)))
+ (car (ly:stencil-extent page-stencil Y)))
(ly:prob-set-property! page 'space-left
- (+ (prop 'bottom-edge)
- (prop 'bottom-system-edge)
- (if (and (ly:stencil? foot)
- (not (ly:stencil-empty? foot)))
- (car (ly:stencil-extent foot Y))
- 0.0)))
+ (+ (prop 'bottom-edge)
+ (prop 'bottom-system-edge)
+ (if (and (ly:stencil? foot)
+ (not (ly:stencil-empty? foot)))
+ (car (ly:stencil-extent foot Y))
+ 0.0)))
(if (annotate? layout)
- (set! page-stencil
- (ly:stencil-add page-stencil
- (annotate-space-left page))))
+ (set! page-stencil
+ (ly:stencil-add page-stencil
+ (annotate-space-left page))))
(if (and (ly:stencil? foot)
- (not (ly:stencil-empty? foot)))
- (set! page-stencil
- (ly:stencil-add
- page-stencil
- (ly:stencil-translate
- foot
- (cons 0
- (+ (- (prop 'bottom-edge))
- (- (car (ly:stencil-extent foot Y)))))))))
+ (not (ly:stencil-empty? foot)))
+ (set! page-stencil
+ (ly:stencil-add
+ page-stencil
+ (ly:stencil-translate
+ foot
+ (cons 0
+ (+ (- (prop 'bottom-edge))
+ (- (car (ly:stencil-extent foot Y)))))))))
(if (ly:output-def-lookup layout 'two-sided #f)
- (set! page-stencil
- (ly:stencil-translate page-stencil
- (cons (prop (if (even? number)
- 'left-margin
- 'right-margin))
- 0)))
- (set! page-stencil
- (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0))))
+ (set! page-stencil
+ (ly:stencil-translate page-stencil
+ (cons (prop (if (even? number)
+ 'left-margin
+ 'right-margin))
+ 0)))
+ (set! page-stencil
+ (ly:stencil-translate page-stencil (cons (prop 'left-margin) 0))))
;; annotation.
(if (annotate? layout)
- (set! page-stencil (annotate-page layout page-stencil)))
+ (set! page-stencil (annotate-page layout page-stencil)))
page-stencil))
@@ -352,18 +352,18 @@
((paper-book (page-property page 'paper-book))
(layout (ly:paper-book-paper paper-book))
(h (- (ly:output-def-lookup layout 'paper-height)
- (ly:output-def-lookup layout 'top-margin)
- (ly:output-def-lookup layout 'bottom-margin)))
+ (ly:output-def-lookup layout 'top-margin)
+ (ly:output-def-lookup layout 'bottom-margin)))
(head (page-property page 'head-stencil))
(foot (page-property page 'foot-stencil))
(available
- (- h (if (ly:stencil? head)
- (interval-length (ly:stencil-extent head Y))
- 0)
- (if (ly:stencil? foot)
- (interval-length (ly:stencil-extent foot Y))
- 0))))
+ (- h (if (ly:stencil? head)
+ (interval-length (ly:stencil-extent head Y))
+ 0)
+ (if (ly:stencil? foot)
+ (interval-length (ly:stencil-extent foot Y))
+ 0))))
;; (display (list "\n available" available head foot))
available))
diff --git a/scm/paper-system.scm b/scm/paper-system.scm
index 8269c77e18..e75440b968 100644
--- a/scm/paper-system.scm
+++ b/scm/paper-system.scm
@@ -18,12 +18,12 @@
(define-module (scm paper-system))
(use-modules (lily)
- (srfi srfi-1)
- (ice-9 optargs))
+ (srfi srfi-1)
+ (ice-9 optargs))
(define-public (paper-system-title? system)
(equal? #t (ly:prob-property system 'is-title)
- ))
+ ))
(define (system-stencil system-grob main-stencil)
(let* ((padding (ly:grob-property system-grob 'in-note-padding #f))
@@ -31,8 +31,8 @@
(in-notes (if in-notes in-notes empty-stencil))
(direction (if padding (ly:grob-property system-grob 'in-note-direction) UP)))
(if padding
- (ly:stencil-combine-at-edge main-stencil Y direction in-notes padding)
- main-stencil)))
+ (ly:stencil-combine-at-edge main-stencil Y direction in-notes padding)
+ main-stencil)))
(define-public (paper-system-stencil system)
(let ((main-stencil (ly:prob-property system 'stencil))
@@ -46,8 +46,8 @@
((g (paper-system-system-grob system)))
(if (ly:grob? g)
- (ly:grob-layout g)
- #f)))
+ (ly:grob-layout g)
+ #f)))
(define-public (paper-system-system-grob paper-system)
(ly:prob-property paper-system 'system-grob))
@@ -64,199 +64,199 @@
(y-extent (paper-system-extent system Y))
(x-extent (paper-system-extent system X))
(stencil (ly:prob-property system 'stencil))
-
+
(arrow (if (number? bottomspace)
- (annotate-y-interval layout
- "bottom-space"
- (cons (- (car y-extent) bottomspace)
- (car y-extent))
- #t)
- #f)))
-
+ (annotate-y-interval layout
+ "bottom-space"
+ (cons (- (car y-extent) bottomspace)
+ (car y-extent))
+ #t)
+ #f)))
+
(if arrow
- (set! stencil
- (ly:stencil-add stencil arrow)))
+ (set! stencil
+ (ly:stencil-add stencil arrow)))
(set! (ly:prob-property system 'stencil)
- stencil)
- ))
+ stencil)
+ ))
;; Y-ext and next-Y-ext are either skyline-pairs or extents
(define*-public (annotate-padding system-Y system-X Y-ext X-ext
- next-system-Y next-system-X next-Y-ext next-X-ext
- layout horizon-padding padding #:key (base-color blue))
+ next-system-Y next-system-X next-Y-ext next-X-ext
+ layout horizon-padding padding #:key (base-color blue))
(let* ((eps 0.001)
- (skyline (and (ly:skyline-pair? Y-ext)
- (ly:skyline-pair::skyline Y-ext DOWN)))
- (next-skyline (and (ly:skyline-pair? next-Y-ext)
- (ly:skyline-pair::skyline next-Y-ext UP)))
- (annotation-X (cond
- ((and skyline next-skyline)
- (-
- (ly:skyline::get-touching-point skyline next-skyline horizon-padding)
- horizon-padding))
- (skyline
- (ly:skyline::get-max-height-position skyline))
- (next-skyline
- (ly:skyline::get-max-height-position next-skyline))
- (else
- (max (cdr X-ext)
- (cdr next-X-ext)))))
- (annotation-Y (if skyline
- (ly:skyline::get-height skyline annotation-X)
- (car Y-ext)))
- (next-annotation-Y (if next-skyline
- (- (+ (ly:skyline::get-height next-skyline
- (- (+ annotation-X system-X)
- next-system-X))
- next-system-Y)
- system-Y)
- (cdr next-Y-ext)))
- (padding-blocks (>= next-annotation-Y (- annotation-Y padding eps)))
- (contrast-color (append (cdr base-color) (list (car base-color))))
- (color (if padding-blocks contrast-color base-color))
- (annotation (ly:stencil-translate-axis
- (annotate-y-interval
- layout
- "padding"
- `(,(- annotation-Y padding). ,annotation-Y)
- #t
- #:color color)
- annotation-X X)))
+ (skyline (and (ly:skyline-pair? Y-ext)
+ (ly:skyline-pair::skyline Y-ext DOWN)))
+ (next-skyline (and (ly:skyline-pair? next-Y-ext)
+ (ly:skyline-pair::skyline next-Y-ext UP)))
+ (annotation-X (cond
+ ((and skyline next-skyline)
+ (-
+ (ly:skyline::get-touching-point skyline next-skyline horizon-padding)
+ horizon-padding))
+ (skyline
+ (ly:skyline::get-max-height-position skyline))
+ (next-skyline
+ (ly:skyline::get-max-height-position next-skyline))
+ (else
+ (max (cdr X-ext)
+ (cdr next-X-ext)))))
+ (annotation-Y (if skyline
+ (ly:skyline::get-height skyline annotation-X)
+ (car Y-ext)))
+ (next-annotation-Y (if next-skyline
+ (- (+ (ly:skyline::get-height next-skyline
+ (- (+ annotation-X system-X)
+ next-system-X))
+ next-system-Y)
+ system-Y)
+ (cdr next-Y-ext)))
+ (padding-blocks (>= next-annotation-Y (- annotation-Y padding eps)))
+ (contrast-color (append (cdr base-color) (list (car base-color))))
+ (color (if padding-blocks contrast-color base-color))
+ (annotation (ly:stencil-translate-axis
+ (annotate-y-interval
+ layout
+ "padding"
+ `(,(- annotation-Y padding). ,annotation-Y)
+ #t
+ #:color color)
+ annotation-X X)))
(if (> padding 0.0)
- annotation
- empty-stencil)))
+ annotation
+ empty-stencil)))
+
-
(define-public (paper-system-annotate system next-system layout)
"Add arrows and texts to indicate which lengths are set."
(let* ((grob (ly:prob-property system 'system-grob))
- (paper-height (ly:output-def-lookup layout 'paper-height))
- (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
- (top-margin (ly:output-def-lookup layout 'top-margin))
- (spaceable-staves (if (ly:grob? grob) (ly:system::get-spaceable-staves grob) '()))
- (all-staves (if (ly:grob? grob) (ly:system::get-staves grob) '()))
- (spaceable-staff-annotate
- (lambda (before-staff after-staff)
- (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
- (after-Y (ly:grob-relative-coordinate after-staff grob Y)))
- (annotate-spacing-spec
- layout
- (ly:get-spacing-spec before-staff after-staff)
- before-Y
- after-Y))))
+ (paper-height (ly:output-def-lookup layout 'paper-height))
+ (bottom-margin (ly:output-def-lookup layout 'bottom-margin))
+ (top-margin (ly:output-def-lookup layout 'top-margin))
+ (spaceable-staves (if (ly:grob? grob) (ly:system::get-spaceable-staves grob) '()))
+ (all-staves (if (ly:grob? grob) (ly:system::get-staves grob) '()))
+ (spaceable-staff-annotate
+ (lambda (before-staff after-staff)
+ (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
+ (after-Y (ly:grob-relative-coordinate after-staff grob Y)))
+ (annotate-spacing-spec
+ layout
+ (ly:get-spacing-spec before-staff after-staff)
+ before-Y
+ after-Y))))
- (staff-padding-annotate
- (lambda (before-staff after-staff)
- (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
- (before-X (ly:grob-relative-coordinate before-staff grob X))
- (before-X-ext (ly:grob-extent before-staff before-staff X))
- (after-Y (ly:grob-relative-coordinate after-staff grob Y))
- (after-X (ly:grob-relative-coordinate after-staff grob X))
- (after-X-ext (ly:grob-extent after-staff after-staff X))
- (skylines (ly:grob-property before-staff 'vertical-skylines))
- (after-skylines (ly:grob-property after-staff 'vertical-skylines))
- (padding (assoc-get 'padding
- (ly:get-spacing-spec before-staff after-staff)
- 0.0))
- (horizon-padding (ly:grob-property before-staff
- 'skyline-horizontal-padding
- 0.0)))
- (ly:stencil-translate
- (annotate-padding
- before-Y before-X skylines before-X-ext
- after-Y after-X after-skylines after-X-ext
- layout horizon-padding padding)
- (cons before-X before-Y)))))
+ (staff-padding-annotate
+ (lambda (before-staff after-staff)
+ (let ((before-Y (ly:grob-relative-coordinate before-staff grob Y))
+ (before-X (ly:grob-relative-coordinate before-staff grob X))
+ (before-X-ext (ly:grob-extent before-staff before-staff X))
+ (after-Y (ly:grob-relative-coordinate after-staff grob Y))
+ (after-X (ly:grob-relative-coordinate after-staff grob X))
+ (after-X-ext (ly:grob-extent after-staff after-staff X))
+ (skylines (ly:grob-property before-staff 'vertical-skylines))
+ (after-skylines (ly:grob-property after-staff 'vertical-skylines))
+ (padding (assoc-get 'padding
+ (ly:get-spacing-spec before-staff after-staff)
+ 0.0))
+ (horizon-padding (ly:grob-property before-staff
+ 'skyline-horizontal-padding
+ 0.0)))
+ (ly:stencil-translate
+ (annotate-padding
+ before-Y before-X skylines before-X-ext
+ after-Y after-X after-skylines after-X-ext
+ layout horizon-padding padding)
+ (cons before-X before-Y)))))
- (staff-annotations (if (< 1 (length spaceable-staves))
- (map spaceable-staff-annotate
- (drop-right spaceable-staves 1)
- (drop spaceable-staves 1))
- '()))
- (staff-padding-annotations (if (< 1 (length all-staves))
- (map staff-padding-annotate
- (drop-right all-staves 1)
- (drop all-staves 1))
- '()))
- (estimate-extent (if (ly:grob? grob)
- (annotate-y-interval layout
- "extent-estimate"
- (ly:grob-property grob 'pure-Y-extent)
- #f)
- #f))
+ (staff-annotations (if (< 1 (length spaceable-staves))
+ (map spaceable-staff-annotate
+ (drop-right spaceable-staves 1)
+ (drop spaceable-staves 1))
+ '()))
+ (staff-padding-annotations (if (< 1 (length all-staves))
+ (map staff-padding-annotate
+ (drop-right all-staves 1)
+ (drop all-staves 1))
+ '()))
+ (estimate-extent (if (ly:grob? grob)
+ (annotate-y-interval layout
+ "extent-estimate"
+ (ly:grob-property grob 'pure-Y-extent)
+ #f)
+ #f))
- (spacing-spec (cond ((and next-system
- (paper-system-title? system)
- (paper-system-title? next-system))
- (ly:output-def-lookup layout 'markup-markup-spacing))
- ((paper-system-title? system)
- (ly:output-def-lookup layout 'markup-system-spacing))
- ((and next-system
- (paper-system-title? next-system))
- (ly:output-def-lookup layout 'score-markup-spacing))
- ((not next-system)
- (ly:output-def-lookup layout 'last-bottom-spacing))
- ((ly:prob-property system 'last-in-score #f)
- (ly:output-def-lookup layout 'score-system-spacing))
- (else
- (ly:output-def-lookup layout 'system-system-spacing))))
- (last-staff-Y (car (paper-system-staff-extents system)))
- (system-Y (ly:prob-property system 'Y-offset 0.0))
- (system-X (ly:prob-property system 'X-offset 0.0))
- (next-system-Y (and next-system
- (ly:prob-property next-system 'Y-offset 0.0)))
- (next-system-X (and next-system
- (ly:prob-property next-system 'X-offset 0.0)))
- (first-staff-next-system-Y (if next-system
- (- (+ (cdr (paper-system-staff-extents next-system))
- system-Y)
- next-system-Y)
- (+ system-Y top-margin bottom-margin (- paper-height))))
+ (spacing-spec (cond ((and next-system
+ (paper-system-title? system)
+ (paper-system-title? next-system))
+ (ly:output-def-lookup layout 'markup-markup-spacing))
+ ((paper-system-title? system)
+ (ly:output-def-lookup layout 'markup-system-spacing))
+ ((and next-system
+ (paper-system-title? next-system))
+ (ly:output-def-lookup layout 'score-markup-spacing))
+ ((not next-system)
+ (ly:output-def-lookup layout 'last-bottom-spacing))
+ ((ly:prob-property system 'last-in-score #f)
+ (ly:output-def-lookup layout 'score-system-spacing))
+ (else
+ (ly:output-def-lookup layout 'system-system-spacing))))
+ (last-staff-Y (car (paper-system-staff-extents system)))
+ (system-Y (ly:prob-property system 'Y-offset 0.0))
+ (system-X (ly:prob-property system 'X-offset 0.0))
+ (next-system-Y (and next-system
+ (ly:prob-property next-system 'Y-offset 0.0)))
+ (next-system-X (and next-system
+ (ly:prob-property next-system 'X-offset 0.0)))
+ (first-staff-next-system-Y (if next-system
+ (- (+ (cdr (paper-system-staff-extents next-system))
+ system-Y)
+ next-system-Y)
+ (+ system-Y top-margin bottom-margin (- paper-height))))
- (skyline (or
- (ly:prob-property system 'vertical-skylines #f)
- (paper-system-extent system Y)))
- (next-skyline (and next-system
- (or
- (ly:prob-property next-system 'vertical-skylines #f)
- (paper-system-extent next-system Y))))
- (horizon-padding (and
- (ly:grob? grob)
- (ly:grob-property grob 'skyline-horizontal-padding 0)))
- (padding-annotation (if (skyline-pair-and-non-empty? next-system)
- (annotate-padding
- (- system-Y) system-X skyline (paper-system-extent system X)
- (- next-system-Y) next-system-X next-skyline (paper-system-extent next-system X)
- layout
- horizon-padding
- (assoc-get 'padding spacing-spec 0.0)
- #:base-color blue)
- empty-stencil))
+ (skyline (or
+ (ly:prob-property system 'vertical-skylines #f)
+ (paper-system-extent system Y)))
+ (next-skyline (and next-system
+ (or
+ (ly:prob-property next-system 'vertical-skylines #f)
+ (paper-system-extent next-system Y))))
+ (horizon-padding (and
+ (ly:grob? grob)
+ (ly:grob-property grob 'skyline-horizontal-padding 0)))
+ (padding-annotation (if (skyline-pair-and-non-empty? next-system)
+ (annotate-padding
+ (- system-Y) system-X skyline (paper-system-extent system X)
+ (- next-system-Y) next-system-X next-skyline (paper-system-extent next-system X)
+ layout
+ horizon-padding
+ (assoc-get 'padding spacing-spec 0.0)
+ #:base-color blue)
+ empty-stencil))
- (system-annotation (annotate-spacing-spec
- layout spacing-spec
- last-staff-Y
- first-staff-next-system-Y))
- (annotations (ly:stencil-add
- padding-annotation
- (stack-stencils Y DOWN 0.0 staff-padding-annotations)
- (stack-stencils Y DOWN 0.0 (append staff-annotations (list system-annotation))))))
+ (system-annotation (annotate-spacing-spec
+ layout spacing-spec
+ last-staff-Y
+ first-staff-next-system-Y))
+ (annotations (ly:stencil-add
+ padding-annotation
+ (stack-stencils Y DOWN 0.0 staff-padding-annotations)
+ (stack-stencils Y DOWN 0.0 (append staff-annotations (list system-annotation))))))
- (if estimate-extent
- (set! annotations
- (stack-stencils X RIGHT 5.5
- (list annotations
- estimate-extent))))
+ (if estimate-extent
+ (set! annotations
+ (stack-stencils X RIGHT 5.5
+ (list annotations
+ estimate-extent))))
- (if (not (null? annotations))
- (set! (ly:prob-property system 'stencil)
- (ly:stencil-add
- (ly:prob-property system 'stencil)
- (ly:make-stencil
- (ly:stencil-expr annotations)
- (ly:stencil-extent empty-stencil X)
- (ly:stencil-extent empty-stencil Y)))))
- (ly:prob-property system 'stencil)))
+ (if (not (null? annotations))
+ (set! (ly:prob-property system 'stencil)
+ (ly:stencil-add
+ (ly:prob-property system 'stencil)
+ (ly:make-stencil
+ (ly:stencil-expr annotations)
+ (ly:stencil-extent empty-stencil X)
+ (ly:stencil-extent empty-stencil Y)))))
+ (ly:prob-property system 'stencil)))
diff --git a/scm/paper.scm b/scm/paper.scm
index 4cd029b75e..5e788af312 100644
--- a/scm/paper.scm
+++ b/scm/paper.scm
@@ -15,38 +15,38 @@
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-; for define-safe-public when byte-compiling using Guile V2
+ ; for define-safe-public when byte-compiling using Guile V2
(use-modules (scm safe-utility-defs))
(define-public (set-paper-dimension-variables mod)
(module-define! mod 'dimension-variables
- '(blot-diameter
- bottom-margin
- cm
- footnote-footer-padding
- footnote-padding
- horizontal-shift
- in
- indent
- inner-margin
- inner-margin-default-scaled
- ledger-line-thickness
- left-margin
+ '(blot-diameter
+ bottom-margin
+ cm
+ footnote-footer-padding
+ footnote-padding
+ horizontal-shift
+ in
+ indent
+ inner-margin
+ inner-margin-default-scaled
+ ledger-line-thickness
+ left-margin
left-margin-default-scaled
- line-thickness
- line-width
- mm
- outer-margin
- outer-margin-default-scaled
- paper-height
- paper-width
- pt
- right-margin
+ line-thickness
+ line-width
+ mm
+ outer-margin
+ outer-margin-default-scaled
+ paper-height
+ paper-width
+ pt
+ right-margin
right-margin-default-scaled
- short-indent
- staff-height
- staff-space
- top-margin)))
+ short-indent
+ staff-height
+ staff-space
+ top-margin)))
(define (calc-line-thickness staff-space pt)
;; linear interpolation.
@@ -70,7 +70,7 @@
(ss (/ staff-height 4))
(factor (/ staff-height (* 20 pt)))
(setm! (lambda (sym val)
- (module-define! module sym val))))
+ (module-define! module sym val))))
;; Synchronized with the `text-font-size'
;; binding in add-pango-fonts (see font.scm).
@@ -104,23 +104,23 @@
(define-safe-public (set-global-staff-size sz)
"Set the default staff size, where SZ is thought to be in PT."
(let* ((current-mod (current-module))
- (parser (eval 'parser current-mod))
- (pap (ly:parser-lookup parser '$defaultpaper))
- (in-layout? (or (module-defined? current-mod 'is-paper)
- (module-defined? current-mod 'is-layout)))
-
- ;; maybe not necessary.
- ;; but let's be paranoid. Maybe someone still refers to the
- ;; old one.
- (new-paper (ly:output-def-clone pap))
+ (parser (eval 'parser current-mod))
+ (pap (ly:parser-lookup parser '$defaultpaper))
+ (in-layout? (or (module-defined? current-mod 'is-paper)
+ (module-defined? current-mod 'is-layout)))
+
+ ;; maybe not necessary.
+ ;; but let's be paranoid. Maybe someone still refers to the
+ ;; old one.
+ (new-paper (ly:output-def-clone pap))
- (new-scope (ly:output-def-scope new-paper)))
+ (new-scope (ly:output-def-scope new-paper)))
(if in-layout?
- (ly:warning (_ "set-global-staff-size: not in toplevel scope")))
+ (ly:warning (_ "set-global-staff-size: not in toplevel scope")))
(layout-set-absolute-staff-size-in-module new-scope
- (* sz (eval 'pt new-scope)))
+ (* sz (eval 'pt new-scope)))
(module-define! current-mod '$defaultpaper new-paper)))
(define-public paper-alist
@@ -245,17 +245,17 @@
where @var{landscape?} specifies whether the dimensions should be swapped
unless explicitly overriden in the name."
(let* ((swapped?
- (cond ((string-suffix? "landscape" name)
- (set! name
- (string-trim-right (string-drop-right name 9)))
- #t)
- ((string-suffix? "portrait" name)
- (set! name
- (string-trim-right (string-drop-right name 8)))
- #f)
- (else landscape?)))
- (is-paper? (module-defined? module 'is-paper))
- (entry (and is-paper?
+ (cond ((string-suffix? "landscape" name)
+ (set! name
+ (string-trim-right (string-drop-right name 9)))
+ #t)
+ ((string-suffix? "portrait" name)
+ (set! name
+ (string-trim-right (string-drop-right name 8)))
+ #f)
+ (else landscape?)))
+ (is-paper? (module-defined? module 'is-paper))
+ (entry (and is-paper?
(eval-carefully (assoc-get name paper-alist)
module
#f))))
@@ -275,21 +275,21 @@ unless explicitly overriden in the name."
;; Output_def::normalize () needs to know
;; whether the user set the value or not.
(scaleable-values '(("left-margin" #f . #t)
- ("right-margin" #f . #t)
- ("inner-margin" #f . #t)
- ("outer-margin" #f . #t)
- ("binding-offset" #f . #f)
- ("top-margin" #t . #f)
- ("bottom-margin" #t . #f)
- ("indent" #f . #f)
- ("short-indent" #f . #f)))
+ ("right-margin" #f . #t)
+ ("inner-margin" #f . #t)
+ ("outer-margin" #f . #t)
+ ("binding-offset" #f . #f)
+ ("top-margin" #t . #f)
+ ("bottom-margin" #t . #f)
+ ("indent" #f . #f)
+ ("short-indent" #f . #f)))
(scaled-values
- (map
+ (map
(lambda (entry)
(let ((entry-symbol
- (string->symbol
- (string-append (car entry) "-default")))
- (vertical? (cadr entry)))
+ (string->symbol
+ (string-append (car entry) "-default")))
+ (vertical? (cadr entry)))
(cons (if (cddr entry)
(string-append (car entry) "-default-scaled")
(car entry))
@@ -308,8 +308,8 @@ unless explicitly overriden in the name."
(for-each
(lambda (value)
(let ((value-symbol (string->symbol (car value)))
- (number (cdr value)))
- (module-define! m value-symbol number)))
+ (number (cdr value)))
+ (module-define! m value-symbol number)))
scaled-values)))
(define (internal-set-paper-size module name landscape?)
@@ -320,10 +320,10 @@ unless explicitly overriden in the name."
(ly:warning (_ "This is not a \\layout {} object, ~S") module))
(entry
(set-paper-dimensions module (car entry) (cdr entry) landscape?)
-
+
(module-define! module 'papersizename name)
(module-define! module 'landscape
- (if landscape? #t #f)))
+ (if landscape? #t #f)))
(else
(ly:warning (_ "Unknown paper size: ~a") name)))))
@@ -340,7 +340,7 @@ unless explicitly overriden in the name."
(define-public (set-paper-size name . rest)
(if (module-defined? (current-module) 'is-paper)
(internal-set-paper-size (current-module) name
- (memq 'landscape rest))
+ (memq 'landscape rest))
;;; TODO: should raise (generic) exception with throw, and catch
;;; that in parse-scm.cc
@@ -349,19 +349,19 @@ unless explicitly overriden in the name."
(define-public (scale-layout paper scale)
"Return a clone of the paper, scaled by the given scale factor."
(let* ((new-paper (ly:output-def-clone paper))
- (dim-vars (ly:output-def-lookup paper 'dimension-variables))
- (old-scope (ly:output-def-scope paper))
- (scope (ly:output-def-scope new-paper)))
+ (dim-vars (ly:output-def-lookup paper 'dimension-variables))
+ (old-scope (ly:output-def-scope paper))
+ (scope (ly:output-def-scope new-paper)))
(for-each
(lambda (v)
(let* ((var (module-variable old-scope v))
- (val (if (variable? var) (variable-ref var) #f)))
+ (val (if (variable? var) (variable-ref var) #f)))
- (if (number? val)
- (module-define! scope v (/ val scale))
- ;; Cannot warn for non-numbers, eg. for paper-width, paper-height.
- )))
+ (if (number? val)
+ (module-define! scope v (/ val scale))
+ ;; Cannot warn for non-numbers, eg. for paper-width, paper-height.
+ )))
dim-vars)
;; Mark the clone.
(ly:output-def-set-variable! new-paper 'cloned #t)
diff --git a/scm/parser-clef.scm b/scm/parser-clef.scm
index 5dd09a059d..719cc4ce50 100644
--- a/scm/parser-clef.scm
+++ b/scm/parser-clef.scm
@@ -122,23 +122,23 @@
(map (lambda (x) (set! (ly:music-property m (car x)) (cdr x))) props)
m))
(let ((e '())
- (c0 0)
- (oct 0)
- (style 'default)
- (match (string-match "^(.*)([_^])([^0-9a-zA-Z]*)([1-9][0-9]*)([^0-9a-zA-Z]*)$" clef-name)))
+ (c0 0)
+ (oct 0)
+ (style 'default)
+ (match (string-match "^(.*)([_^])([^0-9a-zA-Z]*)([1-9][0-9]*)([^0-9a-zA-Z]*)$" clef-name)))
(if match
- (begin
- (set! clef-name (match:substring match 1))
- (set! oct
- (* (if (equal? (match:substring match 2) "^") -1 1)
- (- (string->number (match:substring match 4)) 1)))
+ (begin
+ (set! clef-name (match:substring match 1))
+ (set! oct
+ (* (if (equal? (match:substring match 2) "^") -1 1)
+ (- (string->number (match:substring match 4)) 1)))
(set! style
(cond ((equal? (match:substring match 3) "(") 'parenthesized)
((equal? (match:substring match 3) "[") 'bracketed)
(else style)))))
(set! e (assoc-get clef-name supported-clefs))
(if e
- (let* ((prop-list `(((symbol . clefGlyph) (value . ,(car e)))
+ (let* ((prop-list `(((symbol . clefGlyph) (value . ,(car e)))
((symbol . middleCClefPosition)
(value . ,(+ oct
(cadr e)
@@ -150,22 +150,22 @@
(prop-list (if (eq? style 'default)
prop-list
(append
- prop-list
- `(((symbol . clefTranspositionStyle)
- (value . ,style))))))
- (musics (map make-prop-set prop-list))
- (recalc-mid-C (make-music 'ApplyContext))
- (seq (make-music 'SequentialMusic
- 'elements (append musics (list recalc-mid-C))))
- (csp (make-music 'ContextSpeccedMusic)))
- (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
- (context-spec-music seq 'Staff))
- (begin
- (ly:warning (_ "unknown clef type `~a'") clef-name)
- (ly:warning (_ "supported clefs: ~a")
- (string-join
- (sort (map car supported-clefs) string<?)))
- (make-music 'Music)))))
+ prop-list
+ `(((symbol . clefTranspositionStyle)
+ (value . ,style))))))
+ (musics (map make-prop-set prop-list))
+ (recalc-mid-C (make-music 'ApplyContext))
+ (seq (make-music 'SequentialMusic
+ 'elements (append musics (list recalc-mid-C))))
+ (csp (make-music 'ContextSpeccedMusic)))
+ (set! (ly:music-property recalc-mid-C 'procedure) ly:set-middle-C!)
+ (context-spec-music seq 'Staff))
+ (begin
+ (ly:warning (_ "unknown clef type `~a'") clef-name)
+ (ly:warning (_ "supported clefs: ~a")
+ (string-join
+ (sort (map car supported-clefs) string<?)))
+ (make-music 'Music)))))
(define-public (make-cue-clef-set clef-name)
"Generate the clef setting commands for a cue clef with name
diff --git a/scm/parser-ly-from-scheme.scm b/scm/parser-ly-from-scheme.scm
index 23978608a2..7d72a25e87 100644
--- a/scm/parser-ly-from-scheme.scm
+++ b/scm/parser-ly-from-scheme.scm
@@ -21,58 +21,58 @@
from @var{port} and return the corresponding Scheme music expression.
@samp{$} and @samp{#} introduce immediate and normal Scheme forms."
(let* ((closures '())
- (filename (port-filename port))
- (line (port-line port))
- (lily-string (call-with-output-string
- (lambda (out)
- (let ((copycat
- (make-soft-port
- (vector #f #f #f
- (lambda ()
- (let ((x (read-char port)))
- (write-char x out)
- x)) #f)
- "r")))
- (set-port-filename! copycat filename)
- (do ((c (read-char port) (read-char port)))
- ((and (char=? c #\#)
- (char=? (peek-char port) #\}))
- ;; we stop when #} is encountered
- (read-char port))
- (write-char c out)
- ;; a #scheme or $scheme expression
- (if (or (char=? c #\#) (char=? c #\$))
- (let* ((p (ftell out))
- (expr
- (begin
- (set-port-line! copycat
- (port-line port))
- (set-port-column! copycat
- (port-column port))
- (if (char=? (peek-char port) #\@)
- (read-char copycat))
- (read copycat))))
- ;; kill unused lookahead, it has been
- ;; written out already
- (drain-input copycat)
- ;; only put symbols and non-quote
- ;; lists into closures -- constants
- ;; don't need lexical environments
- ;; for evaluation.
- (if (or (symbol? expr)
- (and (pair? expr)
- (not (eq? 'quote (car expr)))))
- (set! closures
- (cons `(cons ,p (lambda () ,expr))
- closures)))))))))))
+ (filename (port-filename port))
+ (line (port-line port))
+ (lily-string (call-with-output-string
+ (lambda (out)
+ (let ((copycat
+ (make-soft-port
+ (vector #f #f #f
+ (lambda ()
+ (let ((x (read-char port)))
+ (write-char x out)
+ x)) #f)
+ "r")))
+ (set-port-filename! copycat filename)
+ (do ((c (read-char port) (read-char port)))
+ ((and (char=? c #\#)
+ (char=? (peek-char port) #\}))
+ ;; we stop when #} is encountered
+ (read-char port))
+ (write-char c out)
+ ;; a #scheme or $scheme expression
+ (if (or (char=? c #\#) (char=? c #\$))
+ (let* ((p (ftell out))
+ (expr
+ (begin
+ (set-port-line! copycat
+ (port-line port))
+ (set-port-column! copycat
+ (port-column port))
+ (if (char=? (peek-char port) #\@)
+ (read-char copycat))
+ (read copycat))))
+ ;; kill unused lookahead, it has been
+ ;; written out already
+ (drain-input copycat)
+ ;; only put symbols and non-quote
+ ;; lists into closures -- constants
+ ;; don't need lexical environments
+ ;; for evaluation.
+ (if (or (symbol? expr)
+ (and (pair? expr)
+ (not (eq? 'quote (car expr)))))
+ (set! closures
+ (cons `(cons ,p (lambda () ,expr))
+ closures)))))))))))
(define (embedded-lilypond parser lily-string filename line
closures location)
(let* ((clone (ly:parser-clone parser closures location))
- (result (ly:parse-string-expression clone lily-string
- filename line)))
- (if (ly:parser-has-error? clone)
- (ly:parser-error parser (_ "error in #{ ... #}")))
- result))
+ (result (ly:parse-string-expression clone lily-string
+ filename line)))
+ (if (ly:parser-has-error? clone)
+ (ly:parser-error parser (_ "error in #{ ... #}")))
+ result))
(list embedded-lilypond
'parser lily-string filename line
(cons 'list (reverse! closures))
diff --git a/scm/part-combiner.scm b/scm/part-combiner.scm
index 279123222b..dadce94863 100644
--- a/scm/part-combiner.scm
+++ b/scm/part-combiner.scm
@@ -46,10 +46,10 @@
(define-method (previous-voice-state (vs <Voice-state>))
(let ((i (slot-ref vs 'vector-index))
- (v (slot-ref vs 'state-vector)))
+ (v (slot-ref vs 'state-vector)))
(if (< 0 i)
- (vector-ref v (1- i))
- #f)))
+ (vector-ref v (1- i))
+ #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -62,7 +62,7 @@
;; voice-states are states starting with the Split-state or later
;;
(is #:init-keyword #:voice-states #:accessor voice-states)
- (synced #:init-keyword #:synced #:init-value #f #:getter synced?))
+ (synced #:init-keyword #:synced #:init-value #f #:getter synced?))
(define-method (write (x <Split-state> ) f)
@@ -82,13 +82,13 @@
(define (make-voice-states evl)
(let ((vec (list->vector (map (lambda (v)
- (make <Voice-state>
- #:moment (caar v)
- #:tuning (cdar v)
- #:events (map car (cdr v))))
- evl))))
+ (make <Voice-state>
+ #:moment (caar v)
+ #:tuning (cdar v)
+ #:events (map car (cdr v))))
+ evl))))
(do ((i 0 (1+ i)))
- ((= i (vector-length vec)) vec)
+ ((= i (vector-length vec)) vec)
(slot-set! (vector-ref vec i) 'vector-index i)
(slot-set! (vector-ref vec i) 'state-vector vec))))
@@ -99,29 +99,29 @@ Voice-state objects
"
(define (helper ss-idx ss-list idx1 idx2)
(let* ((state1 (if (< idx1 (vector-length vs1)) (vector-ref vs1 idx1) #f))
- (state2 (if (< idx2 (vector-length vs2)) (vector-ref vs2 idx2) #f))
- (min (cond ((and state1 state2) (moment-min (moment state1) (moment state2)))
- (state1 (moment state1))
- (state2 (moment state2))
- (else #f)))
- (inc1 (if (and state1 (equal? min (moment state1))) 1 0))
- (inc2 (if (and state2 (equal? min (moment state2))) 1 0))
- (ss-object (if min
- (make <Split-state>
- #:moment min
- #:voice-states (cons state1 state2)
- #:synced (= inc1 inc2))
- #f)))
+ (state2 (if (< idx2 (vector-length vs2)) (vector-ref vs2 idx2) #f))
+ (min (cond ((and state1 state2) (moment-min (moment state1) (moment state2)))
+ (state1 (moment state1))
+ (state2 (moment state2))
+ (else #f)))
+ (inc1 (if (and state1 (equal? min (moment state1))) 1 0))
+ (inc2 (if (and state2 (equal? min (moment state2))) 1 0))
+ (ss-object (if min
+ (make <Split-state>
+ #:moment min
+ #:voice-states (cons state1 state2)
+ #:synced (= inc1 inc2))
+ #f)))
(if state1
- (set! (split-index state1) ss-idx))
+ (set! (split-index state1) ss-idx))
(if state2
- (set! (split-index state2) ss-idx))
+ (set! (split-index state2) ss-idx))
(if min
- (helper (1+ ss-idx)
- (cons ss-object ss-list)
- (+ idx1 inc1)
- (+ idx2 inc2))
- ss-list)))
+ (helper (1+ ss-idx)
+ (cons ss-object ss-list)
+ (+ idx1 inc1)
+ (+ idx2 inc2))
+ ss-list)))
(list->vector (reverse! (helper 0 '() 0 0) '())))
(define (analyse-spanner-states voice-state-vec)
@@ -131,70 +131,70 @@ Voice-state objects
(define (analyse-tie-start active ev)
(if (ly:in-event-class? ev 'tie-event)
- (acons 'tie (split-index (vector-ref voice-state-vec index))
- active)
- active))
+ (acons 'tie (split-index (vector-ref voice-state-vec index))
+ active)
+ active))
(define (analyse-tie-end active ev)
(if (ly:in-event-class? ev 'note-event)
- (assoc-remove! active 'tie)
- active))
+ (assoc-remove! active 'tie)
+ active))
(define (analyse-absdyn-end active ev)
(if (or (ly:in-event-class? ev 'absolute-dynamic-event)
- (and (ly:in-event-class? ev 'span-dynamic-event)
- (equal? STOP (ly:event-property ev 'span-direction))))
- (assoc-remove! (assoc-remove! active 'cresc) 'decr)
- active))
+ (and (ly:in-event-class? ev 'span-dynamic-event)
+ (equal? STOP (ly:event-property ev 'span-direction))))
+ (assoc-remove! (assoc-remove! active 'cresc) 'decr)
+ active))
(define (active<? a b)
(cond ((symbol<? (car a) (car b)) #t)
- ((symbol<? (car b) (car a)) #f)
- (else (< (cdr a) (cdr b)))))
+ ((symbol<? (car b) (car a)) #f)
+ (else (< (cdr a) (cdr b)))))
(define (analyse-span-event active ev)
(let* ((name (car (ly:event-property ev 'class)))
- (key (cond ((equal? name 'slur-event) 'slur)
- ((equal? name 'phrasing-slur-event) 'tie)
- ((equal? name 'beam-event) 'beam)
- ((equal? name 'crescendo-event) 'cresc)
- ((equal? name 'decrescendo-event) 'decr)
- (else #f)))
- (sp (ly:event-property ev 'span-direction)))
- (if (and (symbol? key) (ly:dir? sp))
- (if (= sp STOP)
- (assoc-remove! active key)
- (acons key
- (split-index (vector-ref voice-state-vec index))
- active))
- active)))
+ (key (cond ((equal? name 'slur-event) 'slur)
+ ((equal? name 'phrasing-slur-event) 'tie)
+ ((equal? name 'beam-event) 'beam)
+ ((equal? name 'crescendo-event) 'cresc)
+ ((equal? name 'decrescendo-event) 'decr)
+ (else #f)))
+ (sp (ly:event-property ev 'span-direction)))
+ (if (and (symbol? key) (ly:dir? sp))
+ (if (= sp STOP)
+ (assoc-remove! active key)
+ (acons key
+ (split-index (vector-ref voice-state-vec index))
+ active))
+ active)))
(define (analyse-events active evs)
"Run all analyzers on ACTIVE and EVS"
(define (run-analyzer analyzer active evs)
- (if (pair? evs)
- (run-analyzer analyzer (analyzer active (car evs)) (cdr evs))
- active))
+ (if (pair? evs)
+ (run-analyzer analyzer (analyzer active (car evs)) (cdr evs))
+ active))
(define (run-analyzers analyzers active evs)
- (if (pair? analyzers)
- (run-analyzers (cdr analyzers)
- (run-analyzer (car analyzers) active evs)
- evs)
- active))
+ (if (pair? analyzers)
+ (run-analyzers (cdr analyzers)
+ (run-analyzer (car analyzers) active evs)
+ evs)
+ active))
(sort ;; todo: use fold or somesuch.
(run-analyzers (list analyse-absdyn-end analyse-span-event
- ;; note: tie-start/span comes after tie-end/absdyn.
- analyse-tie-end analyse-tie-start)
- active evs)
+ ;; note: tie-start/span comes after tie-end/absdyn.
+ analyse-tie-end analyse-tie-start)
+ active evs)
active<?))
;; must copy, since we use assoc-remove!
(if (< index (vector-length voice-state-vec))
- (begin
- (set! active (analyse-events active (events (vector-ref voice-state-vec index))))
- (set! (span-state (vector-ref voice-state-vec index))
- (list-copy active))
- (helper (1+ index) active))))
+ (begin
+ (set! active (analyse-events active (events (vector-ref voice-state-vec index))))
+ (set! (span-state (vector-ref voice-state-vec index))
+ (list-copy active))
+ (helper (1+ index) active))))
(helper 0 '()))
@@ -204,69 +204,69 @@ Voice-state objects
in a chronological list, similar to the @code{Recording_group_engraver} in
LilyPond version 2.8 and earlier."
(let*
- ((context-list '())
- (now-mom (ly:make-moment 0 0))
- (global (ly:make-global-context odef))
- (mom-listener (ly:make-listener
- (lambda (tev) (set! now-mom (ly:event-property tev 'moment)))))
- (new-context-listener
- (ly:make-listener
- (lambda (sev)
- (let*
- ((child (ly:event-property sev 'context))
- (this-moment-list (cons (ly:context-id child) '()))
- (dummy (set! context-list (cons this-moment-list context-list)))
- (acc '())
- (accumulate-event-listener
- (ly:make-listener (lambda (ev)
- (set! acc (cons (cons ev #t) acc)))))
- (save-acc-listener
- (ly:make-listener (lambda (tev)
- (if (pair? acc)
- (let ((this-moment
- (cons (cons now-mom
- (ly:context-property child 'instrumentTransposition))
- ;; The accumulate-event-listener above creates
- ;; the list of events in reverse order, so we
- ;; have to revert it to the original order again
- (reverse acc))))
- (set-cdr! this-moment-list
- (cons this-moment (cdr this-moment-list)))
- (set! acc '())))))))
- (ly:add-listener accumulate-event-listener
- (ly:context-event-source child) 'StreamEvent)
- (ly:add-listener save-acc-listener
- (ly:context-event-source global) 'OneTimeStep))))))
+ ((context-list '())
+ (now-mom (ly:make-moment 0 0))
+ (global (ly:make-global-context odef))
+ (mom-listener (ly:make-listener
+ (lambda (tev) (set! now-mom (ly:event-property tev 'moment)))))
+ (new-context-listener
+ (ly:make-listener
+ (lambda (sev)
+ (let*
+ ((child (ly:event-property sev 'context))
+ (this-moment-list (cons (ly:context-id child) '()))
+ (dummy (set! context-list (cons this-moment-list context-list)))
+ (acc '())
+ (accumulate-event-listener
+ (ly:make-listener (lambda (ev)
+ (set! acc (cons (cons ev #t) acc)))))
+ (save-acc-listener
+ (ly:make-listener (lambda (tev)
+ (if (pair? acc)
+ (let ((this-moment
+ (cons (cons now-mom
+ (ly:context-property child 'instrumentTransposition))
+ ;; The accumulate-event-listener above creates
+ ;; the list of events in reverse order, so we
+ ;; have to revert it to the original order again
+ (reverse acc))))
+ (set-cdr! this-moment-list
+ (cons this-moment (cdr this-moment-list)))
+ (set! acc '())))))))
+ (ly:add-listener accumulate-event-listener
+ (ly:context-event-source child) 'StreamEvent)
+ (ly:add-listener save-acc-listener
+ (ly:context-event-source global) 'OneTimeStep))))))
(ly:add-listener new-context-listener
- (ly:context-events-below global) 'AnnounceNewContext)
+ (ly:context-events-below global) 'AnnounceNewContext)
(ly:add-listener mom-listener (ly:context-event-source global) 'Prepare)
(ly:interpret-music-expression (make-non-relative-music music) global)
context-list))
(define-public (make-part-combine-music parser music-list direction)
(let* ((m (make-music 'PartCombineMusic))
- (m1 (make-non-relative-music (context-spec-music (first music-list) 'Voice "one")))
- (m2 (make-non-relative-music (context-spec-music (second music-list) 'Voice "two")))
- (listener (ly:parser-lookup parser 'partCombineListener))
- (evs2 (recording-group-emulate m2 listener))
- (evs1 (recording-group-emulate m1 listener)))
+ (m1 (make-non-relative-music (context-spec-music (first music-list) 'Voice "one")))
+ (m2 (make-non-relative-music (context-spec-music (second music-list) 'Voice "two")))
+ (listener (ly:parser-lookup parser 'partCombineListener))
+ (evs2 (recording-group-emulate m2 listener))
+ (evs1 (recording-group-emulate m1 listener)))
(set! (ly:music-property m 'elements) (list m1 m2))
(set! (ly:music-property m 'direction) direction)
(set! (ly:music-property m 'split-list)
- (if (and (assoc "one" evs1) (assoc "two" evs2))
- (determine-split-list (reverse! (assoc-get "one" evs1) '())
- (reverse! (assoc-get "two" evs2) '()))
- '()))
+ (if (and (assoc "one" evs1) (assoc "two" evs2))
+ (determine-split-list (reverse! (assoc-get "one" evs1) '())
+ (reverse! (assoc-get "two" evs2) '()))
+ '()))
m))
(define-public (determine-split-list evl1 evl2)
"@var{evl1} and @var{evl2} should be ascending."
(let* ((pc-debug #f)
- (chord-threshold 8)
- (voice-state-vec1 (make-voice-states evl1))
- (voice-state-vec2 (make-voice-states evl2))
- (result (make-split-state voice-state-vec1 voice-state-vec2)))
+ (chord-threshold 8)
+ (voice-state-vec1 (make-voice-states evl1))
+ (voice-state-vec2 (make-voice-states evl2))
+ (result (make-split-state voice-state-vec1 voice-state-vec2)))
;; Go through all moments recursively and check if the events of that
;; moment contain a part-combine-force-event override. If so, store its
@@ -275,274 +275,274 @@ LilyPond version 2.8 and earlier."
(define (analyse-forced-combine result-idx prev-res)
(define (get-forced-event x)
- (if (ly:in-event-class? x 'part-combine-force-event)
- (cons (ly:event-property x 'forced-type) (ly:event-property x 'once))
- #f))
+ (if (ly:in-event-class? x 'part-combine-force-event)
+ (cons (ly:event-property x 'forced-type) (ly:event-property x 'once))
+ #f))
(define (part-combine-events vs)
- (if (not vs)
- '()
- (filter-map get-forced-event (events vs))))
+ (if (not vs)
+ '()
+ (filter-map get-forced-event (events vs))))
;; end part-combine-events
;; forced-result: Take the previous config and analyse whether
;; any change happened.... Return new once and permanent config
(define (forced-result evt state)
- ;; sanity check, evt should always be (new-state . once)
- (if (not (and (pair? evt) (pair? state)))
- state
- (if (cdr evt)
- ;; Once-event, leave permanent state unchanged
- (cons (car evt) (cdr state))
- ;; permanent change, leave once state unchanged
- (cons (car state) (car evt)))))
+ ;; sanity check, evt should always be (new-state . once)
+ (if (not (and (pair? evt) (pair? state)))
+ state
+ (if (cdr evt)
+ ;; Once-event, leave permanent state unchanged
+ (cons (car evt) (cdr state))
+ ;; permanent change, leave once state unchanged
+ (cons (car state) (car evt)))))
;; end forced-combine-result
;; body of analyse-forced-combine:
(if (< result-idx (vector-length result))
- (let* ((now-state (vector-ref result result-idx)) ; current result
- ;; Extract all part-combine force events
- (ev1 (part-combine-events (car (voice-states now-state))))
- (ev2 (part-combine-events (cdr (voice-states now-state))))
- (evts (append ev1 ev2))
- ;; result is (once-state permament-state):
- (state (fold forced-result (cons 'automatic prev-res) evts))
- ;; Now let once override permanent changes:
- (force-state (if (equal? (car state) 'automatic)
- (cdr state)
- (car state))))
- (set! (forced-configuration (vector-ref result result-idx))
- force-state)
- ;; For the next moment, ignore the once override (car stat)
- ;; and pass on the permanent override, stored as (cdr state)
- (analyse-forced-combine (1+ result-idx) (cdr state)))))
+ (let* ((now-state (vector-ref result result-idx)) ; current result
+ ;; Extract all part-combine force events
+ (ev1 (part-combine-events (car (voice-states now-state))))
+ (ev2 (part-combine-events (cdr (voice-states now-state))))
+ (evts (append ev1 ev2))
+ ;; result is (once-state permament-state):
+ (state (fold forced-result (cons 'automatic prev-res) evts))
+ ;; Now let once override permanent changes:
+ (force-state (if (equal? (car state) 'automatic)
+ (cdr state)
+ (car state))))
+ (set! (forced-configuration (vector-ref result result-idx))
+ force-state)
+ ;; For the next moment, ignore the once override (car stat)
+ ;; and pass on the permanent override, stored as (cdr state)
+ (analyse-forced-combine (1+ result-idx) (cdr state)))))
;; end analyse-forced-combine
(define (analyse-time-step result-idx)
(define (put x . index)
- "Put the result to X, starting from INDEX backwards.
+ "Put the result to X, starting from INDEX backwards.
Only set if not set previously.
"
- (let ((i (if (pair? index) (car index) result-idx)))
- (if (and (<= 0 i)
- (not (symbol? (configuration (vector-ref result i)))))
- (begin
- (set! (configuration (vector-ref result i)) x)
- (put x (1- i))))))
+ (let ((i (if (pair? index) (car index) result-idx)))
+ (if (and (<= 0 i)
+ (not (symbol? (configuration (vector-ref result i)))))
+ (begin
+ (set! (configuration (vector-ref result i)) x)
+ (put x (1- i))))))
(define (copy-state-from state-vec vs)
- (define (copy-one-state key-idx)
- (let* ((idx (cdr key-idx))
- (prev-ss (vector-ref result idx))
- (prev (configuration prev-ss)))
- (if (symbol? prev)
- (put prev))))
- (map copy-one-state (span-state vs)))
+ (define (copy-one-state key-idx)
+ (let* ((idx (cdr key-idx))
+ (prev-ss (vector-ref result idx))
+ (prev (configuration prev-ss)))
+ (if (symbol? prev)
+ (put prev))))
+ (map copy-one-state (span-state vs)))
(define (analyse-notes now-state)
- (let* ((vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state)))
- (notes1 (note-events vs1))
- (durs1 (sort (map (lambda (x) (ly:event-property x 'duration))
- notes1)
- ly:duration<?))
- (pitches1 (sort (map (lambda (x) (ly:event-property x 'pitch))
- notes1)
- ly:pitch<?))
- (notes2 (note-events vs2))
- (durs2 (sort (map (lambda (x) (ly:event-property x 'duration))
- notes2)
- ly:duration<?))
- (pitches2 (sort (map (lambda (x) (ly:event-property x 'pitch))
- notes2)
- ly:pitch<?)))
- (cond ((> (length notes1) 1) (put 'apart))
- ((> (length notes2) 1) (put 'apart))
- ((= 1 (+ (length notes2) (length notes1))) (put 'apart))
- ((and (= (length durs1) 1)
- (= (length durs2) 1)
- (not (equal? (car durs1) (car durs2))))
- (put 'apart))
- (else
- (if (and (= (length pitches1) (length pitches2)))
- (if (and (pair? pitches1)
- (pair? pitches2)
- (or
- (< chord-threshold (ly:pitch-steps
- (ly:pitch-diff (car pitches1)
- (car pitches2))))
-
- ;; voice crossings:
- (> 0 (ly:pitch-steps (ly:pitch-diff (car pitches1)
- (car pitches2))))
- ))
- (put 'apart)
- ;; copy previous split state from spanner state
- (begin
- (if (previous-voice-state vs1)
- (copy-state-from voice-state-vec1
- (previous-voice-state vs1)))
- (if (previous-voice-state vs2)
- (copy-state-from voice-state-vec2
- (previous-voice-state vs2)))
- (if (and (null? (span-state vs1)) (null? (span-state vs2)))
- (put 'chords)))))))))
+ (let* ((vs1 (car (voice-states now-state)))
+ (vs2 (cdr (voice-states now-state)))
+ (notes1 (note-events vs1))
+ (durs1 (sort (map (lambda (x) (ly:event-property x 'duration))
+ notes1)
+ ly:duration<?))
+ (pitches1 (sort (map (lambda (x) (ly:event-property x 'pitch))
+ notes1)
+ ly:pitch<?))
+ (notes2 (note-events vs2))
+ (durs2 (sort (map (lambda (x) (ly:event-property x 'duration))
+ notes2)
+ ly:duration<?))
+ (pitches2 (sort (map (lambda (x) (ly:event-property x 'pitch))
+ notes2)
+ ly:pitch<?)))
+ (cond ((> (length notes1) 1) (put 'apart))
+ ((> (length notes2) 1) (put 'apart))
+ ((= 1 (+ (length notes2) (length notes1))) (put 'apart))
+ ((and (= (length durs1) 1)
+ (= (length durs2) 1)
+ (not (equal? (car durs1) (car durs2))))
+ (put 'apart))
+ (else
+ (if (and (= (length pitches1) (length pitches2)))
+ (if (and (pair? pitches1)
+ (pair? pitches2)
+ (or
+ (< chord-threshold (ly:pitch-steps
+ (ly:pitch-diff (car pitches1)
+ (car pitches2))))
+
+ ;; voice crossings:
+ (> 0 (ly:pitch-steps (ly:pitch-diff (car pitches1)
+ (car pitches2))))
+ ))
+ (put 'apart)
+ ;; copy previous split state from spanner state
+ (begin
+ (if (previous-voice-state vs1)
+ (copy-state-from voice-state-vec1
+ (previous-voice-state vs1)))
+ (if (previous-voice-state vs2)
+ (copy-state-from voice-state-vec2
+ (previous-voice-state vs2)))
+ (if (and (null? (span-state vs1)) (null? (span-state vs2)))
+ (put 'chords)))))))))
(if (< result-idx (vector-length result))
- (let* ((now-state (vector-ref result result-idx))
- (vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state))))
-
- (cond ((not vs1) (put 'apart))
- ((not vs2) (put 'apart))
- (else
- (let ((active1 (previous-span-state vs1))
- (active2 (previous-span-state vs2))
- (new-active1 (span-state vs1))
- (new-active2 (span-state vs2)))
- (if #f ; debug
- (display (list (moment now-state) result-idx
- active1 "->" new-active1
- active2 "->" new-active2
- "\n")))
- (if (and (synced? now-state)
- (equal? active1 active2)
- (equal? new-active1 new-active2))
- (analyse-notes now-state)
-
- ;; active states different:
- (put 'apart)))
-
- ;; go to the next one, if it exists.
- (analyse-time-step (1+ result-idx)))))))
+ (let* ((now-state (vector-ref result result-idx))
+ (vs1 (car (voice-states now-state)))
+ (vs2 (cdr (voice-states now-state))))
+
+ (cond ((not vs1) (put 'apart))
+ ((not vs2) (put 'apart))
+ (else
+ (let ((active1 (previous-span-state vs1))
+ (active2 (previous-span-state vs2))
+ (new-active1 (span-state vs1))
+ (new-active2 (span-state vs2)))
+ (if #f ; debug
+ (display (list (moment now-state) result-idx
+ active1 "->" new-active1
+ active2 "->" new-active2
+ "\n")))
+ (if (and (synced? now-state)
+ (equal? active1 active2)
+ (equal? new-active1 new-active2))
+ (analyse-notes now-state)
+
+ ;; active states different:
+ (put 'apart)))
+
+ ;; go to the next one, if it exists.
+ (analyse-time-step (1+ result-idx)))))))
(define (analyse-a2 result-idx)
(if (< result-idx (vector-length result))
- (let* ((now-state (vector-ref result result-idx))
- (vs1 (car (voice-states now-state)))
- (vs2 (cdr (voice-states now-state))))
- (if (and (equal? (configuration now-state) 'chords)
- vs1 vs2)
- (let ((notes1 (note-events vs1))
- (notes2 (note-events vs2)))
- (cond ((and (= 1 (length notes1))
- (= 1 (length notes2))
- (equal? (ly:event-property (car notes1) 'pitch)
- (ly:event-property (car notes2) 'pitch)))
- (set! (configuration now-state) 'unisono))
- ((and (= 0 (length notes1))
- (= 0 (length notes2)))
- (set! (configuration now-state) 'unisilence)))))
- (analyse-a2 (1+ result-idx)))))
+ (let* ((now-state (vector-ref result result-idx))
+ (vs1 (car (voice-states now-state)))
+ (vs2 (cdr (voice-states now-state))))
+ (if (and (equal? (configuration now-state) 'chords)
+ vs1 vs2)
+ (let ((notes1 (note-events vs1))
+ (notes2 (note-events vs2)))
+ (cond ((and (= 1 (length notes1))
+ (= 1 (length notes2))
+ (equal? (ly:event-property (car notes1) 'pitch)
+ (ly:event-property (car notes2) 'pitch)))
+ (set! (configuration now-state) 'unisono))
+ ((and (= 0 (length notes1))
+ (= 0 (length notes2)))
+ (set! (configuration now-state) 'unisilence)))))
+ (analyse-a2 (1+ result-idx)))))
(define (analyse-solo12 result-idx)
(define (previous-config vs)
- (let* ((pvs (previous-voice-state vs))
- (spi (if pvs (split-index pvs) #f))
- (prev-split (if spi (vector-ref result spi) #f)))
- (if prev-split
- (configuration prev-split)
- 'apart)))
+ (let* ((pvs (previous-voice-state vs))
+ (spi (if pvs (split-index pvs) #f))
+ (prev-split (if spi (vector-ref result spi) #f)))
+ (if prev-split
+ (configuration prev-split)
+ 'apart)))
(define (put-range x a b)
- ;; (display (list "put range " x a b "\n"))
- (do ((i a (1+ i)))
- ((> i b) b)
- (set! (configuration (vector-ref result i)) x)))
+ ;; (display (list "put range " x a b "\n"))
+ (do ((i a (1+ i)))
+ ((> i b) b)
+ (set! (configuration (vector-ref result i)) x)))
(define (put x)
- ;; (display (list "putting " x "\n"))
- (set! (configuration (vector-ref result result-idx)) x))
+ ;; (display (list "putting " x "\n"))
+ (set! (configuration (vector-ref result result-idx)) x))
(define (current-voice-state now-state voice-num)
- (define vs ((if (= 1 voice-num) car cdr)
- (voice-states now-state)))
- (if (or (not vs) (equal? (moment now-state) (moment vs)))
- vs
- (previous-voice-state vs)))
+ (define vs ((if (= 1 voice-num) car cdr)
+ (voice-states now-state)))
+ (if (or (not vs) (equal? (moment now-state) (moment vs)))
+ vs
+ (previous-voice-state vs)))
(define (try-solo type start-idx current-idx)
- "Find a maximum stretch that can be marked as solo. Only set
+ "Find a maximum stretch that can be marked as solo. Only set
the mark when there are no spanners active.
return next idx to analyse.
"
- (if (< current-idx (vector-length result))
- (let* ((now-state (vector-ref result current-idx))
- (solo-state (current-voice-state now-state (if (equal? type 'solo1) 1 2)))
- (silent-state (current-voice-state now-state (if (equal? type 'solo1) 2 1)))
- (silent-notes (if silent-state (note-events silent-state) '()))
- (solo-notes (if solo-state (note-events solo-state) '())))
- ;; (display (list "trying " type " at " (moment now-state) solo-state silent-state "\n"))
- (cond ((not (equal? (configuration now-state) 'apart))
- current-idx)
- ((> (length silent-notes) 0) start-idx)
- ((not solo-state)
- (put-range type start-idx current-idx)
- current-idx)
- ((and
- (null? (span-state solo-state)))
-
- ;;
- ;; This includes rests. This isn't a problem: long rests
- ;; will be shared with the silent voice, and be marked
- ;; as unisilence. Therefore, long rests won't
- ;; accidentally be part of a solo.
- ;;
- (put-range type start-idx current-idx)
- (try-solo type (1+ current-idx) (1+ current-idx)))
- (else
- (try-solo type start-idx (1+ current-idx)))))
- ;; try-solo
- start-idx))
+ (if (< current-idx (vector-length result))
+ (let* ((now-state (vector-ref result current-idx))
+ (solo-state (current-voice-state now-state (if (equal? type 'solo1) 1 2)))
+ (silent-state (current-voice-state now-state (if (equal? type 'solo1) 2 1)))
+ (silent-notes (if silent-state (note-events silent-state) '()))
+ (solo-notes (if solo-state (note-events solo-state) '())))
+ ;; (display (list "trying " type " at " (moment now-state) solo-state silent-state "\n"))
+ (cond ((not (equal? (configuration now-state) 'apart))
+ current-idx)
+ ((> (length silent-notes) 0) start-idx)
+ ((not solo-state)
+ (put-range type start-idx current-idx)
+ current-idx)
+ ((and
+ (null? (span-state solo-state)))
+
+ ;;
+ ;; This includes rests. This isn't a problem: long rests
+ ;; will be shared with the silent voice, and be marked
+ ;; as unisilence. Therefore, long rests won't
+ ;; accidentally be part of a solo.
+ ;;
+ (put-range type start-idx current-idx)
+ (try-solo type (1+ current-idx) (1+ current-idx)))
+ (else
+ (try-solo type start-idx (1+ current-idx)))))
+ ;; try-solo
+ start-idx))
(define (analyse-moment result-idx)
- "Analyse 'apart starting at RESULT-IDX. Return next index."
- (let* ((now-state (vector-ref result result-idx))
- (vs1 (current-voice-state now-state 1))
- (vs2 (current-voice-state now-state 2))
- ;; (vs1 (car (voice-states now-state)))
- ;; (vs2 (cdr (voice-states now-state)))
- (notes1 (if vs1 (note-events vs1) '()))
- (notes2 (if vs2 (note-events vs2) '()))
- (n1 (length notes1))
- (n2 (length notes2)))
- ;; (display (list "analyzing step " result-idx " moment " (moment now-state) vs1 vs2 "\n"))
- (max
- ;; we should always increase.
- (cond ((and (= n1 0) (= n2 0))
- (put 'apart-silence)
- (1+ result-idx))
- ((and (= n2 0)
- (equal? (moment vs1) (moment now-state))
- (null? (previous-span-state vs1)))
- (try-solo 'solo1 result-idx result-idx))
- ((and (= n1 0)
- (equal? (moment vs2) (moment now-state))
- (null? (previous-span-state vs2)))
- (try-solo 'solo2 result-idx result-idx))
-
- (else (1+ result-idx)))
- ;; analyse-moment
- (1+ result-idx))))
+ "Analyse 'apart starting at RESULT-IDX. Return next index."
+ (let* ((now-state (vector-ref result result-idx))
+ (vs1 (current-voice-state now-state 1))
+ (vs2 (current-voice-state now-state 2))
+ ;; (vs1 (car (voice-states now-state)))
+ ;; (vs2 (cdr (voice-states now-state)))
+ (notes1 (if vs1 (note-events vs1) '()))
+ (notes2 (if vs2 (note-events vs2) '()))
+ (n1 (length notes1))
+ (n2 (length notes2)))
+ ;; (display (list "analyzing step " result-idx " moment " (moment now-state) vs1 vs2 "\n"))
+ (max
+ ;; we should always increase.
+ (cond ((and (= n1 0) (= n2 0))
+ (put 'apart-silence)
+ (1+ result-idx))
+ ((and (= n2 0)
+ (equal? (moment vs1) (moment now-state))
+ (null? (previous-span-state vs1)))
+ (try-solo 'solo1 result-idx result-idx))
+ ((and (= n1 0)
+ (equal? (moment vs2) (moment now-state))
+ (null? (previous-span-state vs2)))
+ (try-solo 'solo2 result-idx result-idx))
+
+ (else (1+ result-idx)))
+ ;; analyse-moment
+ (1+ result-idx))))
(if (< result-idx (vector-length result))
- (if (equal? (configuration (vector-ref result result-idx)) 'apart)
- (analyse-solo12 (analyse-moment result-idx))
- (analyse-solo12 (1+ result-idx))))) ; analyse-solo12
+ (if (equal? (configuration (vector-ref result result-idx)) 'apart)
+ (analyse-solo12 (analyse-moment result-idx))
+ (analyse-solo12 (1+ result-idx))))) ; analyse-solo12
(analyse-spanner-states voice-state-vec1)
(analyse-spanner-states voice-state-vec2)
(if #f
- (begin
- (display voice-state-vec1)
- (display "***\n")
- (display voice-state-vec2)
- (display "***\n")
- (display result)
- (display "***\n")))
+ (begin
+ (display voice-state-vec1)
+ (display "***\n")
+ (display voice-state-vec2)
+ (display "***\n")
+ (display result)
+ (display "***\n")))
;; Extract all forced combine strategies, i.e. events inserted by
;; \partcombine(Apart|Automatic|SoloI|SoloII|Chords)[Once]
@@ -560,11 +560,11 @@ the mark when there are no spanners active.
(analyse-solo12 0)
;; (display result)
(set! result (map
- ;; forced-configuration overrides, if it is set
- (lambda (x) (cons (moment x) (or (forced-configuration x) (configuration x))))
- (vector->list result)))
+ ;; forced-configuration overrides, if it is set
+ (lambda (x) (cons (moment x) (or (forced-configuration x) (configuration x))))
+ (vector->list result)))
(if #f ;; pc-debug
- (display result))
+ (display result))
result))
diff --git a/scm/predefined-fretboards.scm b/scm/predefined-fretboards.scm
index d3286c45d1..be46fb3a3f 100644
--- a/scm/predefined-fretboards.scm
+++ b/scm/predefined-fretboards.scm
@@ -19,40 +19,40 @@
(define-public (parse-terse-string terse-definition)
"Parse a @code{fret-diagram-terse} definition string @var{terse-definition}
and return a marking list, which can be used with a fretboard grob."
- (cdr (fret-parse-terse-definition-string (list '()) terse-definition)))
+ (cdr (fret-parse-terse-definition-string (list '()) terse-definition)))
(define-public (get-chord-shape shape-code tuning base-chord-shapes)
"Return the chord shape associated with @var{shape-code} and
@var{tuning} in the hash-table @var{base-chord-shapes}."
(let ((hash-handle (hash-get-handle base-chord-shapes
- (cons shape-code tuning))))
- (if hash-handle
- (cdr hash-handle)
- '())))
+ (cons shape-code tuning))))
+ (if hash-handle
+ (cdr hash-handle)
+ '())))
(define-public (offset-fret fret-offset diagram-definition)
"Add @var{fret-offset} to each fret indication in
@var{diagram-definition} and return the resulting verbose
@code{fret-diagram-definition}."
- (let ((verbose-definition
- (if (string? diagram-definition)
- (parse-terse-string diagram-definition)
- diagram-definition)))
- (map (lambda(item)
- (let ((code (car item)))
- (cond
- ((eq? code 'barre)
- (list-set! item 3
- (+ fret-offset (list-ref item 3)))
- item)
- ((eq? code 'capo)
- (list-set! item 1
- (+ fret-offset (list-ref item 1)))
- item)
- ((eq? code 'place-fret)
- (list-set! item 2
- (+ fret-offset (list-ref item 2)))
- item)
- (else item))))
- verbose-definition)))
+ (let ((verbose-definition
+ (if (string? diagram-definition)
+ (parse-terse-string diagram-definition)
+ diagram-definition)))
+ (map (lambda(item)
+ (let ((code (car item)))
+ (cond
+ ((eq? code 'barre)
+ (list-set! item 3
+ (+ fret-offset (list-ref item 3)))
+ item)
+ ((eq? code 'capo)
+ (list-set! item 1
+ (+ fret-offset (list-ref item 1)))
+ item)
+ ((eq? code 'place-fret)
+ (list-set! item 2
+ (+ fret-offset (list-ref item 2)))
+ item)
+ (else item))))
+ verbose-definition)))
diff --git a/scm/ps-to-png.scm b/scm/ps-to-png.scm
index 5e78d0c7c0..0becaeef97 100644
--- a/scm/ps-to-png.scm
+++ b/scm/ps-to-png.scm
@@ -42,9 +42,9 @@
(define (search-executable names)
(define (helper path lst)
(if (null? (cdr lst))
- (car lst)
- (if (search-path path (car lst)) (car lst)
- (helper path (cdr lst)))))
+ (car lst)
+ (if (search-path path (car lst)) (car lst)
+ (helper path (cdr lst)))))
(let ((path (parse-path (getenv "PATH"))))
(helper path names)))
@@ -67,33 +67,33 @@
(set! status (system cmd))
(if (not (= status 0))
(begin
- (ly:error (_ "~a exited with status: ~S") "GS" status)
- (if exit-on-error (exit 1))))
+ (ly:error (_ "~a exited with status: ~S") "GS" status)
+ (if exit-on-error (exit 1))))
status)
(define (scale-down-image be-verbose factor file)
(define (with-pbm)
(let* ((status 0)
- (old (string-append file ".old")))
-
+ (old (string-append file ".old")))
+
(rename-file file old)
(my-system
be-verbose #t
(format #f
- "pngtopnm \"~a\" | pnmscale -reduce ~a 2>/dev/null | pnmtopng -compression 9 2>/dev/null > \"~a\""
- old factor file))
+ "pngtopnm \"~a\" | pnmscale -reduce ~a 2>/dev/null | pnmtopng -compression 9 2>/dev/null > \"~a\""
+ old factor file))
(delete-file old)))
(with-pbm))
(define-public (ps-page-count ps-name)
(let* ((byte-count 10240)
- (header (gulp-file ps-name byte-count))
- (first-null (string-index header #\nul))
- (match (string-match "%%Pages: ([0-9]+)"
- (if (number? first-null)
- (substring header 0 first-null)
- header))))
+ (header (gulp-file ps-name byte-count))
+ (first-null (string-index header #\nul))
+ (match (string-match "%%Pages: ([0-9]+)"
+ (if (number? first-null)
+ (substring header 0 first-null)
+ header))))
(if match (string->number (match:substring match 1)) 0)))
(define-public (make-ps-images ps-name . rest)
@@ -108,25 +108,25 @@
(anti-alias-factor 1))
(let* ((format-str (format #f "~a" pixmap-format))
- (extension (cond
- ((string-contains format-str "png") "png")
- ((string-contains format-str "jpg") "jpeg")
- ((string-contains format-str "jpeg") "jpeg")
- (else
- (ly:error "Unknown pixmap format ~a" pixmap-format))))
- (base (dir-basename ps-name ".ps" ".eps"))
- (png1 (format #f "~a.~a" base extension))
- (pngn (format #f "~a-page%d.~a" base extension))
- (page-count (ps-page-count ps-name))
- (multi-page? (> page-count 1))
- (output-file (if multi-page? pngn png1))
-
- (gs-variable-options
- (if (string-suffix-ci? ".eps" ps-name)
- "-dEPSCrop"
- (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f"
- page-width page-height)))
- (cmd (ly:format "~a\
+ (extension (cond
+ ((string-contains format-str "png") "png")
+ ((string-contains format-str "jpg") "jpeg")
+ ((string-contains format-str "jpeg") "jpeg")
+ (else
+ (ly:error "Unknown pixmap format ~a" pixmap-format))))
+ (base (dir-basename ps-name ".ps" ".eps"))
+ (png1 (format #f "~a.~a" base extension))
+ (pngn (format #f "~a-page%d.~a" base extension))
+ (page-count (ps-page-count ps-name))
+ (multi-page? (> page-count 1))
+ (output-file (if multi-page? pngn png1))
+
+ (gs-variable-options
+ (if (string-suffix-ci? ".eps" ps-name)
+ "-dEPSCrop"
+ (format #f "-dDEVICEWIDTHPOINTS=~,2f -dDEVICEHEIGHTPOINTS=~,2f"
+ page-width page-height)))
+ (cmd (ly:format "~a\
~a\
~a\
-dGraphicsAlphaBits=4\
@@ -137,46 +137,46 @@
-r~a\
~S\
-c quit"
- (search-gs)
- (if be-verbose "" "-q")
- gs-variable-options
- pixmap-format
- output-file
- (* anti-alias-factor resolution) ps-name))
- (status 0)
- (files '()))
+ (search-gs)
+ (if be-verbose "" "-q")
+ gs-variable-options
+ pixmap-format
+ output-file
+ (* anti-alias-factor resolution) ps-name))
+ (status 0)
+ (files '()))
;; The wrapper on windows cannot handle `=' signs,
;; gs has a workaround with #.
(if (eq? PLATFORM 'windows)
- (begin
- (set! cmd (re-sub "=" "#" cmd))
- (set! cmd (re-sub "-dSAFER " "" cmd))))
+ (begin
+ (set! cmd (re-sub "=" "#" cmd))
+ (set! cmd (re-sub "-dSAFER " "" cmd))))
(set! status (my-system be-verbose #f cmd))
(set! files
- (if multi-page?
- (map
- (lambda (n)
- (format #f "~a-page~a.png" base (1+ n)))
- (iota page-count))
- (list (format #f "~a.png" base))))
-
+ (if multi-page?
+ (map
+ (lambda (n)
+ (format #f "~a-page~a.png" base (1+ n)))
+ (iota page-count))
+ (list (format #f "~a.png" base))))
+
(if (not (= 0 status))
- (begin
- (map delete-file files)
- (exit 1)))
+ (begin
+ (map delete-file files)
+ (exit 1)))
(if (and rename-page-1 multi-page?)
- (begin
- (rename-file (re-sub "%d" "1" pngn) png1)
- (set! files
- (cons png1
- (cdr files)))
- ))
+ (begin
+ (rename-file (re-sub "%d" "1" pngn) png1)
+ (set! files
+ (cons png1
+ (cdr files)))
+ ))
(if (not (= 1 anti-alias-factor))
- (for-each
- (lambda (f) (scale-down-image be-verbose anti-alias-factor f)) files))
+ (for-each
+ (lambda (f) (scale-down-image be-verbose anti-alias-factor f)) files))
files)))
diff --git a/scm/safe-utility-defs.scm b/scm/safe-utility-defs.scm
index 57941b2b9a..057639d7fa 100644
--- a/scm/safe-utility-defs.scm
+++ b/scm/safe-utility-defs.scm
@@ -19,12 +19,12 @@
;;; Author Ian Hulin
;;; Date 16 October 2011
;;;
-
+
(define-module (scm safe-utility-defs)
-#:use-module (ice-9 optargs)
-#:export (safe-objects)
-#:export-syntax (define-safe-public)
-#:re-export-syntax (define*-public))
+ #:use-module (ice-9 optargs)
+ #:export (safe-objects)
+ #:export-syntax (define-safe-public)
+ #:re-export-syntax (define*-public))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Safe definitions utility
diff --git a/scm/scheme-engravers.scm b/scm/scheme-engravers.scm
index c845f21bd3..0766cbc19c 100644
--- a/scm/scheme-engravers.scm
+++ b/scm/scheme-engravers.scm
@@ -34,70 +34,70 @@ successive measures, and boundaries are shared by adjoining spanners."
(elapsed 0))
(make-engraver
- (listeners ((measure-counter-event engraver event)
- (set! last-measure-seen (ly:context-property context 'currentBarNumber))
- (set! new-measure? #t)
- (cond
- ((and (= START (ly:event-property event 'span-direction))
- go?)
- (begin
- (set! stop? #t)
- (ly:input-warning
- (ly:event-property event 'origin)
- "count not ended before another begun")))
- ((= START (ly:event-property event 'span-direction))
- (set! go? #t))
- ((= STOP (ly:event-property event 'span-direction))
- (begin
- (set! stop? #t)
- (set! go? #f))))))
+ (listeners ((measure-counter-event engraver event)
+ (set! last-measure-seen (ly:context-property context 'currentBarNumber))
+ (set! new-measure? #t)
+ (cond
+ ((and (= START (ly:event-property event 'span-direction))
+ go?)
+ (begin
+ (set! stop? #t)
+ (ly:input-warning
+ (ly:event-property event 'origin)
+ "count not ended before another begun")))
+ ((= START (ly:event-property event 'span-direction))
+ (set! go? #t))
+ ((= STOP (ly:event-property event 'span-direction))
+ (begin
+ (set! stop? #t)
+ (set! go? #f))))))
- ((process-music trans)
- (let ((col (ly:context-property context 'currentCommandColumn))
- (now (ly:context-property context 'measurePosition))
- (current-bar (ly:context-property context 'currentBarNumber)))
- ;; If the counter has been started, make sure we're in a new bar
- ;; before finishing a count-spanner and starting a new one.
- ;; Since we consider all CommandColumns encountered, we need this
- ;; check so that a count-spanner is not created for each pair.
- (if (and (ly:grob? count-spanner)
- (> current-bar last-measure-seen))
- (set! new-measure? #t))
- (if new-measure?
- (begin
- ;; Check if we have the first column of the measure.
- ;; The possibility of initial grace notes is considered.
- (if (moment<=? now ZERO-MOMENT)
- (begin
- ;; If we have the first column, finish the previous
- ;; counter-spanner (if there is one).
- (if (ly:grob? count-spanner)
- (begin
- (ly:spanner-set-bound! count-spanner RIGHT col)
- (ly:pointer-group-interface::add-grob count-spanner 'columns col)
- (ly:engraver-announce-end-grob trans count-spanner col)
- (set! count-spanner '())))
- ;; if count is over, reset variables
- (if stop?
- (begin
- (set! elapsed 0)
- (set! stop? #f)))
- ;; if count is in progress, begin a counter object
- (if go?
- (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
- (counter (ly:grob-property c 'count-from)))
- (ly:spanner-set-bound! c LEFT col)
- (ly:pointer-group-interface::add-grob c 'columns col)
- (set! (ly:grob-property c 'count-from) (+ counter elapsed))
- (set! count-spanner c)
- (set! elapsed (1+ elapsed))))
- (set! new-measure? #f)))))
- (set! last-measure-seen current-bar)))
+ ((process-music trans)
+ (let ((col (ly:context-property context 'currentCommandColumn))
+ (now (ly:context-property context 'measurePosition))
+ (current-bar (ly:context-property context 'currentBarNumber)))
+ ;; If the counter has been started, make sure we're in a new bar
+ ;; before finishing a count-spanner and starting a new one.
+ ;; Since we consider all CommandColumns encountered, we need this
+ ;; check so that a count-spanner is not created for each pair.
+ (if (and (ly:grob? count-spanner)
+ (> current-bar last-measure-seen))
+ (set! new-measure? #t))
+ (if new-measure?
+ (begin
+ ;; Check if we have the first column of the measure.
+ ;; The possibility of initial grace notes is considered.
+ (if (moment<=? now ZERO-MOMENT)
+ (begin
+ ;; If we have the first column, finish the previous
+ ;; counter-spanner (if there is one).
+ (if (ly:grob? count-spanner)
+ (begin
+ (ly:spanner-set-bound! count-spanner RIGHT col)
+ (ly:pointer-group-interface::add-grob count-spanner 'columns col)
+ (ly:engraver-announce-end-grob trans count-spanner col)
+ (set! count-spanner '())))
+ ;; if count is over, reset variables
+ (if stop?
+ (begin
+ (set! elapsed 0)
+ (set! stop? #f)))
+ ;; if count is in progress, begin a counter object
+ (if go?
+ (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
+ (counter (ly:grob-property c 'count-from)))
+ (ly:spanner-set-bound! c LEFT col)
+ (ly:pointer-group-interface::add-grob c 'columns col)
+ (set! (ly:grob-property c 'count-from) (+ counter elapsed))
+ (set! count-spanner c)
+ (set! elapsed (1+ elapsed))))
+ (set! new-measure? #f)))))
+ (set! last-measure-seen current-bar)))
- ((finalize trans)
- (if go?
- (begin
- (set! go? #f)
- (ly:grob-suicide! count-spanner)
- (set! count-spanner '())
- (ly:warning "measure count left unfinished")))))))
+ ((finalize trans)
+ (if go?
+ (begin
+ (set! go? #f)
+ (ly:grob-suicide! count-spanner)
+ (set! count-spanner '())
+ (ly:warning "measure count left unfinished")))))))
diff --git a/scm/script.scm b/scm/script.scm
index b5e14bae56..6564d5f2d4 100644
--- a/scm/script.scm
+++ b/scm/script.scm
@@ -19,336 +19,336 @@
`(
("accent"
. (
- (avoid-slur . around)
- (padding . 0.20)
- (script-stencil . (feta . ("sforzato" . "sforzato")))
- (side-relative-direction . ,DOWN)))
+ (avoid-slur . around)
+ (padding . 0.20)
+ (script-stencil . (feta . ("sforzato" . "sforzato")))
+ (side-relative-direction . ,DOWN)))
("accentus"
. (
- (script-stencil . (feta . ("uaccentus" . "uaccentus")))
- (side-relative-direction . ,DOWN)
- (avoid-slur . ignore)
- (padding . 0.20)
- (quantize-position . #t)
- (script-priority . -100)
- (direction . ,UP)))
+ (script-stencil . (feta . ("uaccentus" . "uaccentus")))
+ (side-relative-direction . ,DOWN)
+ (avoid-slur . ignore)
+ (padding . 0.20)
+ (quantize-position . #t)
+ (script-priority . -100)
+ (direction . ,UP)))
("circulus"
. (
- (script-stencil . (feta . ("circulus" . "circulus")))
- (side-relative-direction . ,DOWN)
- (avoid-slur . ignore)
- (padding . 0.20)
- (quantize-position . #t)
- (script-priority . -100)
- (direction . ,UP)))
+ (script-stencil . (feta . ("circulus" . "circulus")))
+ (side-relative-direction . ,DOWN)
+ (avoid-slur . ignore)
+ (padding . 0.20)
+ (quantize-position . #t)
+ (script-priority . -100)
+ (direction . ,UP)))
("coda"
. (
- (script-stencil . (feta . ("coda" . "coda")))
- (padding . 0.20)
- (avoid-slur . outside)
- (direction . ,UP)))
+ (script-stencil . (feta . ("coda" . "coda")))
+ (padding . 0.20)
+ (avoid-slur . outside)
+ (direction . ,UP)))
("comma"
. (
- (script-stencil . (feta . ("lcomma" . "rcomma")))
- (quantize-position . #t)
- (padding . 0.20)
- (avoid-slur . ignore)
- (direction . ,UP)))
+ (script-stencil . (feta . ("lcomma" . "rcomma")))
+ (quantize-position . #t)
+ (padding . 0.20)
+ (avoid-slur . ignore)
+ (direction . ,UP)))
("downbow"
. (
- (script-stencil . (feta . ("downbow" . "downbow")))
- (padding . 0.20)
- (skyline-horizontal-padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)
- (script-priority . 150)))
+ (script-stencil . (feta . ("downbow" . "downbow")))
+ (padding . 0.20)
+ (skyline-horizontal-padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)
+ (script-priority . 150)))
("downmordent"
. (
- (script-stencil . (feta . ("downmordent" . "downmordent")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("downmordent" . "downmordent")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("downprall"
. (
- (script-stencil . (feta . ("downprall" . "downprall")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("downprall" . "downprall")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("espressivo"
. (
- (avoid-slur . around)
- (padding . 0.20)
- (script-stencil . (feta . ("espr" . "espr")))
- (side-relative-direction . ,DOWN)))
+ (avoid-slur . around)
+ (padding . 0.20)
+ (script-stencil . (feta . ("espr" . "espr")))
+ (side-relative-direction . ,DOWN)))
("fermata"
. (
- (script-stencil . (feta . ("dfermata" . "ufermata")))
- (padding . 0.20)
- (avoid-slur . around)
- (script-priority . 4000)
- (direction . ,UP)))
+ (script-stencil . (feta . ("dfermata" . "ufermata")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (script-priority . 4000)
+ (direction . ,UP)))
("flageolet"
. (
- (script-stencil . (feta . ("flageolet" . "flageolet")))
- (padding . 0.20)
- (avoid-slur . around) ;guessing?
- (direction . ,UP)))
+ (script-stencil . (feta . ("flageolet" . "flageolet")))
+ (padding . 0.20)
+ (avoid-slur . around) ;guessing?
+ (direction . ,UP)))
("halfopen"
. (
- (avoid-slur . outside)
- (padding . 0.20)
- (script-stencil . (feta . ("halfopen" . "halfopen")))
- (direction . ,UP)))
+ (avoid-slur . outside)
+ (padding . 0.20)
+ (script-stencil . (feta . ("halfopen" . "halfopen")))
+ (direction . ,UP)))
("ictus"
. (
- (script-stencil . (feta . ("ictus" . "ictus")))
- (side-relative-direction . ,DOWN)
- (quantize-position . #t)
- (avoid-slur . ignore)
- (padding . 0.20)
- (script-priority . -100)
- (direction . ,DOWN)))
+ (script-stencil . (feta . ("ictus" . "ictus")))
+ (side-relative-direction . ,DOWN)
+ (quantize-position . #t)
+ (avoid-slur . ignore)
+ (padding . 0.20)
+ (script-priority . -100)
+ (direction . ,DOWN)))
("lheel"
. (
- (script-stencil . (feta . ("upedalheel" . "upedalheel")))
- (padding . 0.20)
- (avoid-slur . around) ;guessing?
- (direction . ,DOWN)))
+ (script-stencil . (feta . ("upedalheel" . "upedalheel")))
+ (padding . 0.20)
+ (avoid-slur . around) ;guessing?
+ (direction . ,DOWN)))
("lineprall"
. (
- (script-stencil . (feta . ("lineprall" . "lineprall")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("lineprall" . "lineprall")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("longfermata"
. (
- (script-stencil . (feta . ("dlongfermata" . "ulongfermata")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("dlongfermata" . "ulongfermata")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("ltoe"
. (
- (script-stencil . (feta . ("upedaltoe" . "upedaltoe")))
- (padding . 0.20)
- (avoid-slur . around) ;guessing?
- (direction . ,DOWN)))
+ (script-stencil . (feta . ("upedaltoe" . "upedaltoe")))
+ (padding . 0.20)
+ (avoid-slur . around) ;guessing?
+ (direction . ,DOWN)))
("marcato"
. (
- (script-stencil . (feta . ("dmarcato" . "umarcato")))
- (padding . 0.20)
- (avoid-slur . inside)
+ (script-stencil . (feta . ("dmarcato" . "umarcato")))
+ (padding . 0.20)
+ (avoid-slur . inside)
;;(staff-padding . ())
- (quantize-position . #t)
- (side-relative-direction . ,DOWN)))
+ (quantize-position . #t)
+ (side-relative-direction . ,DOWN)))
("mordent"
. (
- (script-stencil . (feta . ("mordent" . "mordent")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("mordent" . "mordent")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("open"
. (
- (avoid-slur . outside)
- (padding . 0.20)
- (script-stencil . (feta . ("open" . "open")))
- (direction . ,UP)))
+ (avoid-slur . outside)
+ (padding . 0.20)
+ (script-stencil . (feta . ("open" . "open")))
+ (direction . ,UP)))
("portato"
. (
- (script-stencil . (feta . ("uportato" . "dportato")))
- (avoid-slur . around)
- (padding . 0.45)
- (side-relative-direction . ,DOWN)))
+ (script-stencil . (feta . ("uportato" . "dportato")))
+ (avoid-slur . around)
+ (padding . 0.45)
+ (side-relative-direction . ,DOWN)))
("prall"
. (
- (script-stencil . (feta . ("prall" . "prall")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("prall" . "prall")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("pralldown"
. (
- (script-stencil . (feta . ("pralldown" . "pralldown")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("pralldown" . "pralldown")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("prallmordent"
. (
- (script-stencil . (feta . ("prallmordent" . "prallmordent")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("prallmordent" . "prallmordent")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("prallprall"
. (
- (script-stencil . (feta . ("prallprall" . "prallprall")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("prallprall" . "prallprall")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("prallup"
. (
- (script-stencil . (feta . ("prallup" . "prallup")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("prallup" . "prallup")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("reverseturn"
. (
- (script-stencil . (feta . ("reverseturn" . "reverseturn")))
- (padding . 0.20)
- (avoid-slur . inside)
- (direction . ,UP)))
+ (script-stencil . (feta . ("reverseturn" . "reverseturn")))
+ (padding . 0.20)
+ (avoid-slur . inside)
+ (direction . ,UP)))
("rheel"
. (
- (script-stencil . (feta . ("dpedalheel" . "dpedalheel")))
- (padding . 0.20)
- (avoid-slur . around) ;guessing?
- (direction . ,UP)))
+ (script-stencil . (feta . ("dpedalheel" . "dpedalheel")))
+ (padding . 0.20)
+ (avoid-slur . around) ;guessing?
+ (direction . ,UP)))
("rtoe"
. (
- (script-stencil . (feta . ("dpedaltoe" . "dpedaltoe")))
- (padding . 0.20)
- (avoid-slur . around) ;guessing?
- (direction . ,UP)))
+ (script-stencil . (feta . ("dpedaltoe" . "dpedaltoe")))
+ (padding . 0.20)
+ (avoid-slur . around) ;guessing?
+ (direction . ,UP)))
("segno"
. (
- (script-stencil . (feta . ("segno" . "segno")))
- (padding . 0.20)
- (avoid-slur . outside)
- (direction . ,UP)))
+ (script-stencil . (feta . ("segno" . "segno")))
+ (padding . 0.20)
+ (avoid-slur . outside)
+ (direction . ,UP)))
("semicirculus"
. (
- (script-stencil . (feta . ("dsemicirculus" . "dsemicirculus")))
- (side-relative-direction . ,DOWN)
- (quantize-position . #t)
- (avoid-slur . ignore)
- (padding . 0.20)
- (script-priority . -100)
- (direction . ,UP)))
+ (script-stencil . (feta . ("dsemicirculus" . "dsemicirculus")))
+ (side-relative-direction . ,DOWN)
+ (quantize-position . #t)
+ (avoid-slur . ignore)
+ (padding . 0.20)
+ (script-priority . -100)
+ (direction . ,UP)))
("shortfermata"
. (
- (script-stencil . (feta . ("dshortfermata" . "ushortfermata")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("dshortfermata" . "ushortfermata")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("signumcongruentiae"
. (
- (script-stencil . (feta . ("dsignumcongruentiae" . "usignumcongruentiae")))
- (padding . 0.20)
- (avoid-slur . outside)
- (direction . ,UP)))
+ (script-stencil . (feta . ("dsignumcongruentiae" . "usignumcongruentiae")))
+ (padding . 0.20)
+ (avoid-slur . outside)
+ (direction . ,UP)))
("snappizzicato"
. (
- (script-stencil . (feta . ("snappizzicato" . "snappizzicato")))
- (padding . 0.20)
- (avoid-slur . outside)
- (direction . ,UP)))
+ (script-stencil . (feta . ("snappizzicato" . "snappizzicato")))
+ (padding . 0.20)
+ (avoid-slur . outside)
+ (direction . ,UP)))
("staccatissimo"
. (
- (avoid-slur . inside)
- (quantize-position . #t)
- (script-stencil . (feta . ("dstaccatissimo" . "ustaccatissimo")))
- (padding . 0.20)
- (skyline-horizontal-padding . 0.10)
- (side-relative-direction . ,DOWN)))
+ (avoid-slur . inside)
+ (quantize-position . #t)
+ (script-stencil . (feta . ("dstaccatissimo" . "ustaccatissimo")))
+ (padding . 0.20)
+ (skyline-horizontal-padding . 0.10)
+ (side-relative-direction . ,DOWN)))
("staccato"
. (
- (script-stencil . (feta . ("staccato" . "staccato")))
- (side-relative-direction . ,DOWN)
- (quantize-position . #t)
- (avoid-slur . inside)
- (toward-stem-shift . 0.5)
- (padding . 0.20)
- (skyline-horizontal-padding . 0.10)
- (script-priority . -100)))
+ (script-stencil . (feta . ("staccato" . "staccato")))
+ (side-relative-direction . ,DOWN)
+ (quantize-position . #t)
+ (avoid-slur . inside)
+ (toward-stem-shift . 0.5)
+ (padding . 0.20)
+ (skyline-horizontal-padding . 0.10)
+ (script-priority . -100)))
("stopped"
. (
- (script-stencil . (feta . ("stopped" . "stopped")))
- (avoid-slur . inside)
- (padding . 0.20)
- (direction . ,UP)))
+ (script-stencil . (feta . ("stopped" . "stopped")))
+ (avoid-slur . inside)
+ (padding . 0.20)
+ (direction . ,UP)))
("tenuto"
. (
- (script-stencil . (feta . ("tenuto" . "tenuto")))
- (quantize-position . #t)
- (avoid-slur . inside)
- (padding . 0.20)
- (side-relative-direction . ,DOWN)))
+ (script-stencil . (feta . ("tenuto" . "tenuto")))
+ (quantize-position . #t)
+ (avoid-slur . inside)
+ (padding . 0.20)
+ (side-relative-direction . ,DOWN)))
("trill"
. (
- (script-stencil . (feta . ("trill" . "trill")))
- (direction . ,UP)
- (padding . 0.20)
- (avoid-slur . outside)
- (script-priority . 2000)))
+ (script-stencil . (feta . ("trill" . "trill")))
+ (direction . ,UP)
+ (padding . 0.20)
+ (avoid-slur . outside)
+ (script-priority . 2000)))
("turn"
. (
- (script-stencil . (feta . ("turn" . "turn")))
- (avoid-slur . inside)
- (padding . 0.20)
- (direction . ,UP)))
+ (script-stencil . (feta . ("turn" . "turn")))
+ (avoid-slur . inside)
+ (padding . 0.20)
+ (direction . ,UP)))
("upbow"
. (
- (script-stencil . (feta . ("upbow" . "upbow")))
- (avoid-slur . around)
- (padding . 0.20)
- (direction . ,UP)
- (script-priority . 150)))
+ (script-stencil . (feta . ("upbow" . "upbow")))
+ (avoid-slur . around)
+ (padding . 0.20)
+ (direction . ,UP)
+ (script-priority . 150)))
("upmordent"
. (
- (script-stencil . (feta . ("upmordent" . "upmordent")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("upmordent" . "upmordent")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("upprall"
. (
- (script-stencil . (feta . ("upprall" . "upprall")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
+ (script-stencil . (feta . ("upprall" . "upprall")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
("varcoda"
. (
- (script-stencil . (feta . ("varcoda" . "varcoda")))
- (padding . 0.20)
- (avoid-slur . outside)
- (direction . ,UP)))
+ (script-stencil . (feta . ("varcoda" . "varcoda")))
+ (padding . 0.20)
+ (avoid-slur . outside)
+ (direction . ,UP)))
("varcomma"
. (
- (script-stencil . (feta . ("lvarcomma" . "rvarcomma")))
- (quantize-position . #t)
- (padding . 0.20)
- (avoid-slur . ignore)
- (direction . ,UP)))
+ (script-stencil . (feta . ("lvarcomma" . "rvarcomma")))
+ (quantize-position . #t)
+ (padding . 0.20)
+ (avoid-slur . ignore)
+ (direction . ,UP)))
("verylongfermata"
. (
- (script-stencil . (feta . ("dverylongfermata" . "uverylongfermata")))
- (padding . 0.20)
- (avoid-slur . around)
- (direction . ,UP)))
- ))
+ (script-stencil . (feta . ("dverylongfermata" . "uverylongfermata")))
+ (padding . 0.20)
+ (avoid-slur . around)
+ (direction . ,UP)))
+ ))
diff --git a/scm/song-util.scm b/scm/song-util.scm
index 5eec46fdd6..c0c226d7c2 100644
--- a/scm/song-util.scm
+++ b/scm/song-util.scm
@@ -77,7 +77,7 @@
(lambda (record) ((record-predicate ,record) record)))
(set! ,$make-record
(lambda* (#:key ,@slots)
- ((record-constructor ,record) ,@(map car slots*))))
+ ((record-constructor ,record) ,@(map car slots*))))
(set! ,$copy-record
(lambda (record)
(,$make-record ,@(apply
@@ -160,11 +160,11 @@ If it unsets the property, return @code{#f}."
"Return list of all @var{music}'s top-level children."
(let ((elt (ly:music-property music 'element))
(elts (ly:music-property music 'elements))
- (arts (ly:music-property music 'articulations)))
+ (arts (ly:music-property music 'articulations)))
(if (pair? arts)
- (set! elts (append elts arts)))
+ (set! elts (append elts arts)))
(if (null? elt)
- elts
+ elts
(cons elt elts))))
(define-public (find-child music predicate)
@@ -193,9 +193,9 @@ If a non-boolean is returned, it is considered the material to recurse."
(let* ((elt (car queue))
(stop (function elt)))
(process-music (if (boolean? stop)
- (if stop
- (cdr queue)
- (append (music-elements elt) (cdr queue)))
- ((if (cheap-list? stop) append cons)
- stop (cdr queue)))))))
+ (if stop
+ (cdr queue)
+ (append (music-elements elt) (cdr queue)))
+ ((if (cheap-list? stop) append cons)
+ stop (cdr queue)))))))
(process-music (list music)))
diff --git a/scm/song.scm b/scm/song.scm
index 35b7f2f6fa..9bf68fc73d 100644
--- a/scm/song.scm
+++ b/scm/song.scm
@@ -139,26 +139,26 @@
(define (tempo->beats music)
(let* ((tempo-spec (find-child-named music 'SequentialMusic))
(tempo (cond
- (tempo-spec
- (let ((tempo-event (find-child-named tempo-spec
- 'TempoChangeEvent)))
- (and tempo-event
- (let ((count (ly:music-property tempo-event
- 'metronome-count)))
- (* (if (pair? count)
- (round (/ (+ (car count) (cdr count)) 2))
- count)
- (duration->number
- (ly:music-property tempo-event 'tempo-unit)))))))
- (else
+ (tempo-spec
+ (let ((tempo-event (find-child-named tempo-spec
+ 'TempoChangeEvent)))
+ (and tempo-event
+ (let ((count (ly:music-property tempo-event
+ 'metronome-count)))
+ (* (if (pair? count)
+ (round (/ (+ (car count) (cdr count)) 2))
+ count)
+ (duration->number
+ (ly:music-property tempo-event 'tempo-unit)))))))
+ (else
(format #t "Programming error (tempo->beats): ~a~%"
- tempo-spec)))))
+ tempo-spec)))))
(debug-enable 'backtrace)
(and tempo
- (set! *default-tempo* (property-value
- (find-child tempo-spec (lambda (elt)
- (music-property? elt 'tempoWholesPerMinute)))))
- (round (* tempo (expt 2 (+ 2 (*base-octave-shift*))))))))
+ (set! *default-tempo* (property-value
+ (find-child tempo-spec (lambda (elt)
+ (music-property? elt 'tempoWholesPerMinute)))))
+ (round (* tempo (expt 2 (+ 2 (*base-octave-shift*))))))))
(defstruct music-context
music
@@ -173,8 +173,8 @@
(cond
((music-name? music* 'LyricCombineMusic)
(push! (make-music-context #:music music*
- #:context (ly:music-property music* 'associated-context))
- music-context-list)
+ #:context (ly:music-property music* 'associated-context))
+ music-context-list)
#t)
((and (music-name? music* 'ContextSpeccedMusic)
(music-property-value? music* 'context-type 'Lyrics)
@@ -182,7 +182,7 @@
(let ((name-node (find-child music* (lambda (node) (music-property? node 'associatedVoice)))))
(if name-node
(push! (make-music-context #:music music* #:context (property-value name-node))
- music-context-list)))
+ music-context-list)))
#t)
(else
#f))))
@@ -214,12 +214,12 @@
((music-name? music '(EventChord LyricEvent))
(let ((lyric-event (find-child-named music 'LyricEvent)))
(push! (make-lyrics
- #:text (ly:music-property lyric-event 'text)
- #:duration (* (duration->number (ly:music-property lyric-event 'duration)) 4)
- #:unfinished (and (not (*syllabify*)) (find-child-named music 'HyphenEvent))
- #:ignore-melismata ignore-melismata
- #:context current-voice)
- lyrics-list))
+ #:text (ly:music-property lyric-event 'text)
+ #:duration (* (duration->number (ly:music-property lyric-event 'duration)) 4)
+ #:unfinished (and (not (*syllabify*)) (find-child-named music 'HyphenEvent))
+ #:ignore-melismata ignore-melismata
+ #:context current-voice)
+ lyrics-list))
;; LilyPond delays applying settings
(set! ignore-melismata next-ignore-melismata)
(set! current-voice next-current-voice)
@@ -227,9 +227,9 @@
;; skipping
((music-name? music 'SkipMusic)
(push! (make-skip
- #:duration (* (duration->number (ly:music-property music 'duration)) 4)
- #:context current-voice)
- lyrics-list)
+ #:duration (* (duration->number (ly:music-property music 'duration)) 4)
+ #:context current-voice)
+ lyrics-list)
#t)
;; parameter change
((music-property? music 'ignoreMelismata)
@@ -261,7 +261,7 @@
(defstruct score-notes
note/rest-list ; list of note and rest instances
(verse-block-list '()) ; lyrics attached to notes -- multiple elements are
- ; possible for multiple stanzas
+ ; possible for multiple stanzas
)
(defstruct note
@@ -295,10 +295,10 @@
(let ((context (ly:music-property music 'context-id))
(children (music-elements music)))
(add! (make-score-voice #:context (debug "Changing context" context)
- #:elements (append-map (lambda (elt)
- (get-notes* elt autobeaming))
- children))
- result-list))
+ #:elements (append-map (lambda (elt)
+ (get-notes* elt autobeaming))
+ children))
+ result-list))
#t)
;; timing change
((music-property? music 'timeSignatureFraction)
@@ -317,10 +317,10 @@
(let ((repeat-count (ly:music-property music 'repeat-count))
(children (music-elements music)))
(add! (make-score-repetice #:count repeat-count
- #:elements (append-map
- (lambda (elt) (get-notes* elt autobeaming))
- children))
- result-list))
+ #:elements (append-map
+ (lambda (elt) (get-notes* elt autobeaming))
+ children))
+ result-list))
#t)
;; a note or rest
((or (music-name? music 'EventChord)
@@ -350,7 +350,7 @@
events))))
(set! in-slur (+ in-slur slur-start (- slur-end)))
(let ((note-spec (make-note #:pitch pitch #:duration duration #:joined in-slur
- #:origin (ly:music-property note 'origin)))
+ #:origin (ly:music-property note 'origin)))
(last-result (and (not (null? result-list)) (last result-list))))
(set! last-note-spec note-spec)
(if (and last-result
@@ -363,29 +363,29 @@
(debug "Rest" rest)
(let* ((duration (* (duration->number (ly:music-property rest 'duration)) 4))
(rest-spec (make-rest #:duration duration
- #:origin (ly:music-property rest 'origin)))
+ #:origin (ly:music-property rest 'origin)))
(last-result (and (not (null? result-list)) (last result-list))))
(if (and last-result
(score-notes? last-result))
(set-score-notes-note/rest-list! last-result
- (append (score-notes-note/rest-list last-result)
- (list rest-spec)))
+ (append (score-notes-note/rest-list last-result)
+ (list rest-spec)))
(add! (make-score-notes #:note/rest-list (list rest-spec)) result-list))))))
- (filter
- (lambda (m)
- (not (music-name? m '(RestEvent
- NoteEvent
- LyricEvent
- MultiMeasureRestEvent))))
- (ly:music-property music 'elements)))
- ((music-name? music '(RestEvent
- NoteEvent
- LyricEvent
- MultiMeasureRestEvent))
- (make-music 'EventChord
- 'elements
- (cons music
- (ly:music-property music 'articulations))))
+ (filter
+ (lambda (m)
+ (not (music-name? m '(RestEvent
+ NoteEvent
+ LyricEvent
+ MultiMeasureRestEvent))))
+ (ly:music-property music 'elements)))
+ ((music-name? music '(RestEvent
+ NoteEvent
+ LyricEvent
+ MultiMeasureRestEvent))
+ (make-music 'EventChord
+ 'elements
+ (cons music
+ (ly:music-property music 'articulations))))
;; autobeaming change
((music-property? music 'autoBeaming)
(set! autobeaming (property-value music))
@@ -396,21 +396,21 @@
(set! in-slur (+ in-slur change))
(if last-note-spec
(set-note-joined! last-note-spec (+ (note-joined last-note-spec) change))))
- #t)
+ #t)
;; tempo change
((music-property? music 'tempoWholesPerMinute)
(set! *tempo-compression* (ly:moment-div *default-tempo* (property-value music)))
- #t)
+ #t)
;; breathe
((music-name? music 'BreathingEvent)
(if last-note-spec
(let* ((note-duration (note-duration last-note-spec))
(rest-spec (make-rest #:duration (* note-duration (- 1 (*breathe-shortage*)))
- #:origin (ly:music-property music 'origin))))
+ #:origin (ly:music-property music 'origin))))
(set-note-duration! last-note-spec (* note-duration (*breathe-shortage*)))
(add! (make-score-notes #:note/rest-list (list rest-spec)) result-list))
(warning music "\\\\breathe without previous note known"))
- #t)
+ #t)
;; anything else
(else
#f))))
@@ -503,12 +503,12 @@
(let ((new-context (score-voice-context score)))
(if (equal? new-context lyrics-context)
(insert-lyrics*! lyrics/skip-list
- (append (score-voice-elements score)
- (if (null? (cdr score-list))
- '()
- (list (make-score-voice #:context context
- #:elements (cdr score-list)))))
- new-context)
+ (append (score-voice-elements score)
+ (if (null? (cdr score-list))
+ '()
+ (list (make-score-voice #:context context
+ #:elements (cdr score-list)))))
+ new-context)
(insert-lyrics*! lyrics/skip-list (cdr score-list) context))))
((score-choice? score)
(let* ((lists* (score-choice-lists score))
@@ -519,32 +519,32 @@
(score* #f))
(while (and (not score*)
(not (null? lists)))
- (set! score* (find-lyrics-score (car lists) lyrics-context allow-default))
- (set! lists (cdr lists))
- (if (not score*)
- (set! n (+ n 1)))
- (if (and (null? lists)
- (not allow-default)
- (equal? lyrics-context context))
- (begin
- (set! allow-default #t)
- (set! n 0)
- (set! lists (score-choice-lists score)))))
+ (set! score* (find-lyrics-score (car lists) lyrics-context allow-default))
+ (set! lists (cdr lists))
+ (if (not score*)
+ (set! n (+ n 1)))
+ (if (and (null? lists)
+ (not allow-default)
+ (equal? lyrics-context context))
+ (begin
+ (set! allow-default #t)
+ (set! n 0)
+ (set! lists (score-choice-lists score)))))
(debug "Selected score" score*)
(if (and score*
(>= n n-assigned))
(begin
(if (> n n-assigned)
(receive (assigned-elts unassigned-elts) (split-at lists* n-assigned)
- (set-score-choice-lists! score (append assigned-elts
- (list (list-ref lists* n))
- (take unassigned-elts (- n n-assigned))
- lists))))
+ (set-score-choice-lists! score (append assigned-elts
+ (list (list-ref lists* n))
+ (take unassigned-elts (- n n-assigned))
+ lists))))
(set-score-choice-n-assigned! score (+ n-assigned 1))))
(insert-lyrics*! lyrics/skip-list (append (if score* (list score*) '()) (cdr score-list)) context)))
((score-repetice? score)
(insert-lyrics*! lyrics/skip-list
- (append (score-repetice-elements score) (cdr score-list)) context))
+ (append (score-repetice-elements score) (cdr score-list)) context))
((score-notes? score)
;; This is the only part which actually attaches the processed lyrics.
;; The subsequent calls return verses which we collect into a verse block.
@@ -563,66 +563,66 @@
(unfinished-verse #f)
(verse-list '()))
(while (not (null? note-list))
- (if (null? lyrics/skip-list)
- (let ((final-rests '()))
- (while (and (not (null? note-list))
- (rest? (car note-list)))
- (push! (car note-list) final-rests)
- (set! note-list (cdr note-list)))
- (if (not (null? final-rests))
- (set! verse-list (append verse-list
- (list (make-verse #:text ""
+ (if (null? lyrics/skip-list)
+ (let ((final-rests '()))
+ (while (and (not (null? note-list))
+ (rest? (car note-list)))
+ (push! (car note-list) final-rests)
+ (set! note-list (cdr note-list)))
+ (if (not (null? final-rests))
+ (set! verse-list (append verse-list
+ (list (make-verse #:text ""
#:notelist/rests (reverse! final-rests))))))
- (if (not (null? note-list))
- (begin
- (warning (car note-list) "Missing lyrics: ~a ~a" context note-list)
- (set! note-list '()))))
- (let ((lyrics/skip (car lyrics/skip-list)))
- (receive (notelist/rest note-list*) (if (lyrics? lyrics/skip)
- (consume-lyrics-notes lyrics/skip note-list context)
- (consume-skip-notes lyrics/skip note-list context))
- (debug "Consumed notes" (list lyrics/skip notelist/rest))
- (set! note-list note-list*)
- (cond
- ((null? notelist/rest)
- #f)
- ;; Lyrics
- ((and (lyrics? lyrics/skip)
- unfinished-verse)
- (set-verse-text!
- unfinished-verse
- (string-append (verse-text unfinished-verse) (lyrics-text lyrics/skip)))
- (set-verse-notelist/rests!
- unfinished-verse
- (append (verse-notelist/rests unfinished-verse) (list notelist/rest)))
- (if (not (lyrics-unfinished lyrics/skip))
- (set! unfinished-verse #f)))
- ((lyrics? lyrics/skip)
- (let ((verse (make-verse #:text (if (rest? notelist/rest)
- ""
- (lyrics-text lyrics/skip))
- #:notelist/rests (list notelist/rest))))
- (add! verse verse-list)
- (set! unfinished-verse (if (lyrics-unfinished lyrics/skip) verse #f))))
- ;; Skip
- ((skip? lyrics/skip)
- (cond
- ((rest? notelist/rest)
- (if (null? verse-list)
- (set! verse-list (list (make-verse #:text ""
- #:notelist/rests (list notelist/rest))))
- (let ((last-verse (last verse-list)))
- (set-verse-notelist/rests!
- last-verse
- (append (verse-notelist/rests last-verse) (list notelist/rest))))))
- ((pair? notelist/rest)
- (add! (make-verse #:text (*skip-word*) #:notelist/rests (list notelist/rest))
- verse-list))
- (else
- (error "Unreachable branch reached")))
- (set! unfinished-verse #f)))
- (if (not (rest? notelist/rest))
- (set! lyrics/skip-list (cdr lyrics/skip-list)))))))
+ (if (not (null? note-list))
+ (begin
+ (warning (car note-list) "Missing lyrics: ~a ~a" context note-list)
+ (set! note-list '()))))
+ (let ((lyrics/skip (car lyrics/skip-list)))
+ (receive (notelist/rest note-list*) (if (lyrics? lyrics/skip)
+ (consume-lyrics-notes lyrics/skip note-list context)
+ (consume-skip-notes lyrics/skip note-list context))
+ (debug "Consumed notes" (list lyrics/skip notelist/rest))
+ (set! note-list note-list*)
+ (cond
+ ((null? notelist/rest)
+ #f)
+ ;; Lyrics
+ ((and (lyrics? lyrics/skip)
+ unfinished-verse)
+ (set-verse-text!
+ unfinished-verse
+ (string-append (verse-text unfinished-verse) (lyrics-text lyrics/skip)))
+ (set-verse-notelist/rests!
+ unfinished-verse
+ (append (verse-notelist/rests unfinished-verse) (list notelist/rest)))
+ (if (not (lyrics-unfinished lyrics/skip))
+ (set! unfinished-verse #f)))
+ ((lyrics? lyrics/skip)
+ (let ((verse (make-verse #:text (if (rest? notelist/rest)
+ ""
+ (lyrics-text lyrics/skip))
+ #:notelist/rests (list notelist/rest))))
+ (add! verse verse-list)
+ (set! unfinished-verse (if (lyrics-unfinished lyrics/skip) verse #f))))
+ ;; Skip
+ ((skip? lyrics/skip)
+ (cond
+ ((rest? notelist/rest)
+ (if (null? verse-list)
+ (set! verse-list (list (make-verse #:text ""
+ #:notelist/rests (list notelist/rest))))
+ (let ((last-verse (last verse-list)))
+ (set-verse-notelist/rests!
+ last-verse
+ (append (verse-notelist/rests last-verse) (list notelist/rest))))))
+ ((pair? notelist/rest)
+ (add! (make-verse #:text (*skip-word*) #:notelist/rests (list notelist/rest))
+ verse-list))
+ (else
+ (error "Unreachable branch reached")))
+ (set! unfinished-verse #f)))
+ (if (not (rest? notelist/rest))
+ (set! lyrics/skip-list (cdr lyrics/skip-list)))))))
(if unfinished-verse
(set-verse-unfinished! unfinished-verse #t))
(set-score-notes-verse-block-list!
@@ -642,13 +642,13 @@
(consumed '()))
(while (and join
(not (null? note-list)))
- (let ((note (car note-list)))
- (push! note consumed)
- (let ((note-slur (note-joined note)))
- (if (< note-slur 0)
- (warning note "Slur underrun"))
- (set! join (and (not ignore-melismata) (> note-slur 0)))))
- (set! note-list (cdr note-list)))
+ (let ((note (car note-list)))
+ (push! note consumed)
+ (let ((note-slur (note-joined note)))
+ (if (< note-slur 0)
+ (warning note "Slur underrun"))
+ (set! join (and (not ignore-melismata) (> note-slur 0)))))
+ (set! note-list (cdr note-list)))
(if join
(warning (safe-car (if (null? note-list) consumed note-list))
"Unfinished slur: ~a ~a" context consumed))
@@ -662,19 +662,19 @@
(consumed '()))
(while (and (> duration epsilon)
(not (null? note-list)))
- (let ((note (car note-list)))
- (assert (note? note))
- (push! note consumed)
- (set! duration (- duration (note-duration note))))
- (set! note-list (cdr note-list)))
+ (let ((note (car note-list)))
+ (assert (note? note))
+ (push! note consumed)
+ (set! duration (- duration (note-duration note))))
+ (set! note-list (cdr note-list)))
(set! consumed (reverse! consumed))
(cond
((> duration epsilon)
(warning (if (null? note-list) (safe-last consumed) (safe-car note-list))
- "Excessive skip: ~a ~a ~a ~a" context skip duration consumed))
+ "Excessive skip: ~a ~a ~a ~a" context skip duration consumed))
((< duration (- epsilon))
(warning (if (null? note-list) (safe-last consumed) (safe-car note-list))
- "Skip misalignment: ~a ~a ~a ~a" context skip duration consumed)))
+ "Skip misalignment: ~a ~a ~a ~a" context skip duration consumed)))
(values (if (*skip-word*)
consumed
'())
@@ -694,8 +694,8 @@
(score-choice-lists score)))))
((score-repetice? score)
(list (make-repeated-blocks #:count (score-repetice-count score)
- #:block-list (append-map extract-verse-blocks
- (score-repetice-elements score)))))
+ #:block-list (append-map extract-verse-blocks
+ (score-repetice-elements score)))))
((score-notes? score)
(list (make-parallel-blocks #:block-list (score-notes-verse-block-list score))))
(else
@@ -709,20 +709,20 @@
(debug "Final score list" score-list)
(let ((verse-block-list (debug "Verse blocks" (append-map extract-verse-blocks score-list))))
(letrec ((combine (lambda (lst-1 lst-2)
- (debug "Combining lists" (list lst-1 lst-2))
- (if (null? lst-2)
- lst-1
- (let ((diff (- (length lst-1) (length lst-2))))
- (if (< diff 0)
- (let ((last-elt (last lst-1)))
- (while (< diff 0)
- (add! last-elt lst-1)
- (set! diff (+ diff 1))))
- (let ((last-elt (last lst-2)))
- (while (> diff 0)
- (add! last-elt lst-2)
- (set! diff (- diff 1)))))
- (debug "Combined" (map append lst-1 lst-2))))))
+ (debug "Combining lists" (list lst-1 lst-2))
+ (if (null? lst-2)
+ lst-1
+ (let ((diff (- (length lst-1) (length lst-2))))
+ (if (< diff 0)
+ (let ((last-elt (last lst-1)))
+ (while (< diff 0)
+ (add! last-elt lst-1)
+ (set! diff (+ diff 1))))
+ (let ((last-elt (last lst-2)))
+ (while (> diff 0)
+ (add! last-elt lst-2)
+ (set! diff (- diff 1)))))
+ (debug "Combined" (map append lst-1 lst-2))))))
(expand* (lambda (block)
(cond
((parallel-blocks? block)
@@ -736,13 +736,13 @@
(expanded (expand (repeated-blocks-block-list block)))
(expanded* '()))
(while (not (null? expanded))
- (let ((count* count)
- (item '()))
- (while (and (> count* 0) (not (null? expanded)))
- (set! item (append item (car expanded)))
- (set! expanded (cdr expanded))
- (set! count* (- count* 1)))
- (push! item expanded*)))
+ (let ((count* count)
+ (item '()))
+ (while (and (> count* 0) (not (null? expanded)))
+ (set! item (append item (car expanded)))
+ (set! expanded (cdr expanded))
+ (set! count* (- count* 1)))
+ (push! item expanded*)))
(reverse expanded*)))
(else
(list (list block))))))
@@ -751,7 +751,7 @@
(if (null? block-list)
'()
(debug "Expanded" (combine (expand* (car block-list))
- (expand (cdr block-list)))))))
+ (expand (cdr block-list)))))))
(merge (lambda (verse-list)
(cond
((null? verse-list)
@@ -760,15 +760,15 @@
(let ((verse-1 (first verse-list))
(verse-2 (second verse-list)))
(merge (cons (make-verse #:text (string-append (verse-text verse-1)
- (verse-text verse-2))
- #:notelist/rests (append (verse-notelist/rests verse-1)
- (verse-notelist/rests verse-2))
- #:unfinished (verse-unfinished verse-2))
+ (verse-text verse-2))
+ #:notelist/rests (append (verse-notelist/rests verse-1)
+ (verse-notelist/rests verse-2))
+ #:unfinished (verse-unfinished verse-2))
(cddr verse-list)))))
(else
(cons (car verse-list) (merge (cdr verse-list))))))))
(debug "Final verses" (merge (append-map (lambda (lst) (append-map verse-block-verse-list lst))
- (expand verse-block-list)))))))
+ (expand verse-block-list)))))))
(define (handle-music music)
;; Returns list of verses.
@@ -791,7 +791,7 @@
(define festival-note-mapping '((0 "C") (1 "C#") (2 "D") (3 "D#") (4 "E") (5 "F") (6 "F#")
- (7 "G") (8 "G#") (9 "A") (10 "A#") (11 "B")))
+ (7 "G") (8 "G#") (9 "A") (10 "A#") (11 "B")))
(define (festival-pitch pitch)
(let* ((semitones (ly:pitch-semitones pitch))
(octave (inexact->exact (floor (/ semitones 12))))
@@ -815,17 +815,17 @@
(let ((text (verse-text verse))
(note/rest-list (verse-notelist/rests verse)))
(receive (rest-list note-listlist) (partition rest? note/rest-list)
- (debug "Rest list" rest-list)
- (debug "Note list" note-listlist)
- (if (not (null? rest-list))
- (set! rest-dur (+ rest-dur (apply + (map rest-duration rest-list)))))
- (if (not (null? note-listlist))
- (begin
- (if (> rest-dur 0)
- (begin
- (write-rest-element port rest-dur)
- (set! rest-dur 0)))
- (write-lyrics-element port text note-listlist))))))
+ (debug "Rest list" rest-list)
+ (debug "Note list" note-listlist)
+ (if (not (null? rest-list))
+ (set! rest-dur (+ rest-dur (apply + (map rest-duration rest-list)))))
+ (if (not (null? note-listlist))
+ (begin
+ (if (> rest-dur 0)
+ (begin
+ (write-rest-element port rest-dur)
+ (set! rest-dur 0)))
+ (write-lyrics-element port text note-listlist))))))
(handle-music music))
(if (> rest-dur 0)
(write-rest-element port rest-dur))))
diff --git a/scm/standalone.scm b/scm/standalone.scm
index bd3b7593ac..ee44d43878 100644
--- a/scm/standalone.scm
+++ b/scm/standalone.scm
@@ -24,26 +24,26 @@
(define (gulp-file name)
(let* ((file (open-input-file name))
- (text (read-delimited "" file)))
+ (text (read-delimited "" file)))
(close file)
text))
(define (scm-gulp-file name)
- (set! %load-path
- (cons (string-append (getenv "LILYPOND_DATADIR") "/ly")
- (cons (string-append (getenv "LILYPOND_DATADIR") "/ps")
- %load-path)))
+ (set! %load-path
+ (cons (string-append (getenv "LILYPOND_DATADIR") "/ly")
+ (cons (string-append (getenv "LILYPOND_DATADIR") "/ps")
+ %load-path)))
(let ((path (%search-load-path name)))
- (if path
- (gulp-file path)
- (gulp-file name))))
+ (if path
+ (gulp-file path)
+ (gulp-file name))))
(define (scm-number->string x)
(let ((e (inexact->exact x)))
(string-append (if (= e x)
- (number->string e)
- (number->string x))
- " ")))
+ (number->string e)
+ (number->string x))
+ " ")))
(define ly:gulp-file scm-gulp-file)
(define ly:number->string scm-number->string)
diff --git a/scm/stencil.scm b/scm/stencil.scm
index d492f17a1c..8bbbed086f 100644
--- a/scm/stencil.scm
+++ b/scm/stencil.scm
@@ -34,10 +34,10 @@
,(car (list-ref coords 6))
,(cdr (list-ref coords 6))
closepath)))
- (ly:make-stencil
- `(path ,thick `(,@' ,command-list) 'round 'round #t)
- xext
- yext)))
+ (ly:make-stencil
+ `(path ,thick `(,@' ,command-list) 'round 'round #t)
+ xext
+ yext)))
(define-public (stack-stencils axis dir padding stils)
"Stack stencils @var{stils} in direction @var{axis}, @var{dir}, using
@@ -85,16 +85,16 @@ a list of @var{paddings}."
"Add brackets around @var{stil}, producing a new stencil."
(let* ((ext (ly:stencil-extent stil axis))
- (lb (ly:bracket axis ext thick protrusion))
- (rb (ly:bracket axis ext thick (- protrusion))))
+ (lb (ly:bracket axis ext thick protrusion))
+ (rb (ly:bracket axis ext thick (- protrusion))))
(set! stil
- (ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding))
+ (ly:stencil-combine-at-edge stil (other-axis axis) 1 rb padding))
(set! stil
- (ly:stencil-combine-at-edge stil (other-axis axis) -1 lb padding))
+ (ly:stencil-combine-at-edge stil (other-axis axis) -1 lb padding))
stil))
(define (make-parenthesis-stencil
- y-extent half-thickness width angularity)
+ y-extent half-thickness width angularity)
"Create a parenthesis stencil.
@var{y-extent} is the Y extent of the markup inside the parenthesis.
@var{half-thickness} is the half thickness of the parenthesis.
@@ -102,70 +102,70 @@ a list of @var{paddings}."
The higher the value of number @var{angularity},
the more angular the shape of the parenthesis."
(let* ((line-width 0.1)
- ;; Horizontal position of baseline that end points run through.
- (base-x
- (if (< width 0)
- (- width)
- 0))
+ ;; Horizontal position of baseline that end points run through.
+ (base-x
+ (if (< width 0)
+ (- width)
+ 0))
;; X value farthest from baseline on outside of curve
(outer-x (+ base-x width))
;; X extent of bezier sandwich centerline curves
(x-extent (ordered-cons base-x outer-x))
- (bottom-y (interval-start y-extent))
- (top-y (interval-end y-extent))
-
- (lower-end-point (cons base-x bottom-y))
- (upper-end-point (cons base-x top-y))
-
- (outer-control-x (+ base-x (* 4/3 width)))
- (inner-control-x (+ outer-control-x
- (if (< width 0)
- half-thickness
- (- half-thickness))))
-
- ;; Vertical distance between a control point
- ;; and the end point it connects to.
- (offset-index (- (* 0.6 angularity) 0.8))
- (lower-control-y (interval-index y-extent offset-index))
- (upper-control-y (interval-index y-extent (- offset-index)))
-
- (lower-outer-control-point
- (cons outer-control-x lower-control-y))
- (upper-outer-control-point
- (cons outer-control-x upper-control-y))
- (upper-inner-control-point
- (cons inner-control-x upper-control-y))
- (lower-inner-control-point
- (cons inner-control-x lower-control-y)))
+ (bottom-y (interval-start y-extent))
+ (top-y (interval-end y-extent))
+
+ (lower-end-point (cons base-x bottom-y))
+ (upper-end-point (cons base-x top-y))
+
+ (outer-control-x (+ base-x (* 4/3 width)))
+ (inner-control-x (+ outer-control-x
+ (if (< width 0)
+ half-thickness
+ (- half-thickness))))
+
+ ;; Vertical distance between a control point
+ ;; and the end point it connects to.
+ (offset-index (- (* 0.6 angularity) 0.8))
+ (lower-control-y (interval-index y-extent offset-index))
+ (upper-control-y (interval-index y-extent (- offset-index)))
+
+ (lower-outer-control-point
+ (cons outer-control-x lower-control-y))
+ (upper-outer-control-point
+ (cons outer-control-x upper-control-y))
+ (upper-inner-control-point
+ (cons inner-control-x upper-control-y))
+ (lower-inner-control-point
+ (cons inner-control-x lower-control-y)))
(make-bezier-sandwich-stencil
- (list
- ;; Step 4: curve through inner control points
- ;; to lower end point.
- upper-inner-control-point
- lower-inner-control-point
- lower-end-point
- ;; Step 3: move to upper end point.
- upper-end-point
- ;; Step 2: curve through outer control points
- ;; to upper end point.
- lower-outer-control-point
- upper-outer-control-point
- upper-end-point
- ;; Step 1: move to lower end point.
- lower-end-point)
- line-width
- (interval-widen x-extent (/ line-width 2))
- (interval-widen y-extent (/ line-width 2)))))
+ (list
+ ;; Step 4: curve through inner control points
+ ;; to lower end point.
+ upper-inner-control-point
+ lower-inner-control-point
+ lower-end-point
+ ;; Step 3: move to upper end point.
+ upper-end-point
+ ;; Step 2: curve through outer control points
+ ;; to upper end point.
+ lower-outer-control-point
+ upper-outer-control-point
+ upper-end-point
+ ;; Step 1: move to lower end point.
+ lower-end-point)
+ line-width
+ (interval-widen x-extent (/ line-width 2))
+ (interval-widen y-extent (/ line-width 2)))))
(define-public (parenthesize-stencil
- stencil half-thickness width angularity padding)
+ stencil half-thickness width angularity padding)
"Add parentheses around @var{stencil}, returning a new stencil."
(let* ((y-extent (ly:stencil-extent stencil Y))
- (lp (make-parenthesis-stencil
- y-extent half-thickness (- width) angularity))
- (rp (make-parenthesis-stencil
- y-extent half-thickness width angularity)))
+ (lp (make-parenthesis-stencil
+ y-extent half-thickness (- width) angularity))
+ (rp (make-parenthesis-stencil
+ y-extent half-thickness width angularity)))
(set! stencil (ly:stencil-combine-at-edge stencil X LEFT lp padding))
(set! stencil (ly:stencil-combine-at-edge stencil X RIGHT rp padding))
stencil))
@@ -175,30 +175,30 @@ the more angular the shape of the parenthesis."
(let ((xext (cons (min startx endx) (max startx endx)))
(yext (cons (min starty endy) (max starty endy))))
(ly:make-stencil
- (list 'draw-line width startx starty endx endy)
- ;; Since the line has rounded edges, we have to / can safely add half the
- ;; width to all coordinates!
- (interval-widen xext (/ width 2))
- (interval-widen yext (/ width 2)))))
+ (list 'draw-line width startx starty endx endy)
+ ;; Since the line has rounded edges, we have to / can safely add half the
+ ;; width to all coordinates!
+ (interval-widen xext (/ width 2))
+ (interval-widen yext (/ width 2)))))
(define-public (make-filled-box-stencil xext yext)
"Make a filled box."
(ly:make-stencil
- (list 'round-filled-box (- (car xext)) (cdr xext)
- (- (car yext)) (cdr yext) 0.0)
- xext yext))
+ (list 'round-filled-box (- (car xext)) (cdr xext)
+ (- (car yext)) (cdr yext) 0.0)
+ xext yext))
(define-public (make-circle-stencil radius thickness fill)
"Make a circle of radius @var{radius} and thickness @var{thickness}."
(let*
((out-radius (+ radius (/ thickness 2.0))))
- (ly:make-stencil
- (list 'circle radius thickness fill)
- (cons (- out-radius) out-radius)
- (cons (- out-radius) out-radius))))
+ (ly:make-stencil
+ (list 'circle radius thickness fill)
+ (cons (- out-radius) out-radius)
+ (cons (- out-radius) out-radius))))
(define-public (make-oval-stencil x-radius y-radius thickness fill)
"Make an oval from two Bezier curves, of x@tie{}radius @var{x-radius},
@@ -216,14 +216,14 @@ defined by @code{fill}."
,(list 'curveto x-min y-min x-max y-min x-max 0)
,(list 'closepath)))
(command-list (fold-right append '() commands)))
- (ly:make-stencil
- `(path ,thickness `(,@',command-list) 'round 'round ,fill)
- (cons (- x-out-radius) x-out-radius)
- (cons (- y-out-radius) y-out-radius))))
+ (ly:make-stencil
+ `(path ,thickness `(,@',command-list) 'round 'round ,fill)
+ (cons (- x-out-radius) x-out-radius)
+ (cons (- y-out-radius) y-out-radius))))
(define-public
(make-partial-ellipse-stencil
- x-radius y-radius start-angle end-angle thick connect fill)
+ x-radius y-radius start-angle end-angle thick connect fill)
"Create an elliptical arc
@var{x-radius} is the X radius of the arc.
@var{y-radius} is the Y radius of the arc.
@@ -238,7 +238,7 @@ be connected to the start by a line.
the partial ellipse until 7*PI/2. For example, in pseudo-code:
> (make-radius-list 2 3)
((0.0 . 2) (PI/2 . 3) (PI . -2) (3*PI/2 . -3)
-(2*PI . 2) (5*PI/2 . 3) (3*PI . -2) (7*PI/2 . -3))
+ (2*PI . 2) (5*PI/2 . 3) (3*PI . -2) (7*PI/2 . -3))
"
(apply append
(map (lambda (adder)
@@ -363,38 +363,38 @@ then reduce using @var{min-max}:
(define (bezier-part-min-max x1 x2 x3 x4)
((lambda (x) (list (reduce min 10000 x) (reduce max -10000 x)))
- (map
- (lambda (x)
- (+ (* x1 (expt (- 1 x) 3))
- (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
- (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
- (* x4 (expt x 3))))))
- (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
- (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
+ (map
+ (lambda (x)
+ (+ (* x1 (expt (- 1 x) 3))
+ (+ (* 3 (* x2 (* (expt (- 1 x) 2) x)))
+ (+ (* 3 (* x3 (* (- 1 x) (expt x 2))))
+ (* x4 (expt x 3))))))
+ (if (< (+ (expt x2 2) (+ (expt x3 2) (* x1 x4)))
+ (+ (* x1 x3) (+ (* x2 x4) (* x2 x3))))
+ (list 0.0 1.0)
+ (filter
+ (lambda (x) (and (>= x 0) (<= x 1)))
+ (append
(list 0.0 1.0)
- (filter
- (lambda (x) (and (>= x 0) (<= x 1)))
- (append
- (list 0.0 1.0)
- (map (lambda (op)
- (if (not (eqv? 0.0
- (exact->inexact (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))))
- ;; Zeros of the bezier curve
- (/ (+ (- x1 (* 2 x2))
- (op x3
- (sqrt (- (+ (expt x2 2)
- (+ (expt x3 2) (* x1 x4)))
- (+ (* x1 x3)
- (+ (* x2 x4) (* x2 x3)))))))
- (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
- ;; Apply L'hopital's rule to get the zeros if 0/0
- (* (op 0 1)
- (/ (/ (- x4 x3) 2)
- (sqrt (- (+ (* x2 x2)
- (+ (* x3 x3) (* x1 x4)))
+ (map (lambda (op)
+ (if (not (eqv? 0.0
+ (exact->inexact (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))))
+ ;; Zeros of the bezier curve
+ (/ (+ (- x1 (* 2 x2))
+ (op x3
+ (sqrt (- (+ (expt x2 2)
+ (+ (expt x3 2) (* x1 x4)))
(+ (* x1 x3)
- (+ (* x2 x4) (* x2 x3)))))))))
- (list + -))))))))
+ (+ (* x2 x4) (* x2 x3)))))))
+ (- (+ x1 (* 3 x3)) (+ x4 (* 3 x2))))
+ ;; Apply L'hopital's rule to get the zeros if 0/0
+ (* (op 0 1)
+ (/ (/ (- x4 x3) 2)
+ (sqrt (- (+ (* x2 x2)
+ (+ (* x3 x3) (* x1 x4)))
+ (+ (* x1 x3)
+ (+ (* x2 x4) (* x2 x3)))))))))
+ (list + -))))))))
(define (bezier-min-max x1 y1 x2 y2 x3 y3 x4 y4)
(map (lambda (x)
@@ -410,21 +410,21 @@ then reduce using @var{min-max}:
((lambda (x)
(list
- (reduce min +inf.0 (map caar x))
- (reduce max -inf.0 (map cadar x))
- (reduce min +inf.0 (map caadr x))
- (reduce max -inf.0 (map cadadr x))))
- (map (lambda (x)
- (if (= (length x) 8)
- (apply bezier-min-max x)
- (apply line-min-max x)))
- (map (lambda (x y)
- (append (list (cadr (reverse x)) (car (reverse x))) y))
- (append (list origin)
- (reverse (cdr (reverse pointlist)))) pointlist))))
+ (reduce min +inf.0 (map caar x))
+ (reduce max -inf.0 (map cadar x))
+ (reduce min +inf.0 (map caadr x))
+ (reduce max -inf.0 (map cadadr x))))
+ (map (lambda (x)
+ (if (= (length x) 8)
+ (apply bezier-min-max x)
+ (apply line-min-max x)))
+ (map (lambda (x y)
+ (append (list (cadr (reverse x)) (car (reverse x))) y))
+ (append (list origin)
+ (reverse (cdr (reverse pointlist)))) pointlist))))
(define-public (make-connected-path-stencil pointlist thickness
- x-scale y-scale connect fill)
+ x-scale y-scale connect fill)
"Make a connected path described by the list @var{pointlist}, with
thickness @var{thickness}, and scaled by @var{x-scale} in the X direction
and @var{y-scale} in the Y direction. @var{connect} and @var{fill} are
@@ -433,48 +433,48 @@ respectively."
;; paths using this routine are designed to begin at point '(0 . 0)
(let* ((origin (list 0 0))
- (boundlist (path-min-max origin pointlist))
- ;; modify pointlist to scale the coordinates
- (path (map (lambda (x)
- (apply
- (if (= 6 (length x))
- (lambda (x1 x2 x3 x4 x5 x6)
- (list 'curveto
- (* x1 x-scale)
- (* x2 y-scale)
- (* x3 x-scale)
- (* x4 y-scale)
- (* x5 x-scale)
- (* x6 y-scale)))
- (lambda (x1 x2)
- (list 'lineto
- (* x1 x-scale)
- (* x2 y-scale))))
- x))
- pointlist))
- ;; a path must begin with a `moveto'
- (prepend-origin (apply list (cons 'moveto origin) path))
- ;; if this path is connected, add closepath to the end
- (final-path (if connect
- (append prepend-origin (list 'closepath))
- prepend-origin))
- (command-list (fold-right append '() final-path)))
- (ly:make-stencil
- `(path ,thickness
- `(,@',command-list)
- 'round
- 'round
- ,(if fill #t #f))
- (coord-translate
+ (boundlist (path-min-max origin pointlist))
+ ;; modify pointlist to scale the coordinates
+ (path (map (lambda (x)
+ (apply
+ (if (= 6 (length x))
+ (lambda (x1 x2 x3 x4 x5 x6)
+ (list 'curveto
+ (* x1 x-scale)
+ (* x2 y-scale)
+ (* x3 x-scale)
+ (* x4 y-scale)
+ (* x5 x-scale)
+ (* x6 y-scale)))
+ (lambda (x1 x2)
+ (list 'lineto
+ (* x1 x-scale)
+ (* x2 y-scale))))
+ x))
+ pointlist))
+ ;; a path must begin with a `moveto'
+ (prepend-origin (apply list (cons 'moveto origin) path))
+ ;; if this path is connected, add closepath to the end
+ (final-path (if connect
+ (append prepend-origin (list 'closepath))
+ prepend-origin))
+ (command-list (fold-right append '() final-path)))
+ (ly:make-stencil
+ `(path ,thickness
+ `(,@',command-list)
+ 'round
+ 'round
+ ,(if fill #t #f))
+ (coord-translate
((if (< x-scale 0) reverse-interval identity)
- (cons (* x-scale (list-ref boundlist 0))
- (* x-scale (list-ref boundlist 1))))
- `(,(/ thickness -2) . ,(/ thickness 2)))
- (coord-translate
+ (cons (* x-scale (list-ref boundlist 0))
+ (* x-scale (list-ref boundlist 1))))
+ `(,(/ thickness -2) . ,(/ thickness 2)))
+ (coord-translate
((if (< y-scale 0) reverse-interval identity)
- (cons (* y-scale (list-ref boundlist 2))
- (* y-scale (list-ref boundlist 3))))
- `(,(/ thickness -2) . ,(/ thickness 2))))))
+ (cons (* y-scale (list-ref boundlist 2))
+ (* y-scale (list-ref boundlist 3))))
+ `(,(/ thickness -2) . ,(/ thickness 2))))))
(define-public (make-ellipse-stencil x-radius y-radius thickness fill)
"Make an ellipse of x@tie{}radius @var{x-radius}, y@tie{}radius
@@ -484,17 +484,17 @@ respectively."
((x-out-radius (+ x-radius (/ thickness 2.0)))
(y-out-radius (+ y-radius (/ thickness 2.0))) )
- (ly:make-stencil
- (list 'ellipse x-radius y-radius thickness fill)
- (cons (- x-out-radius) x-out-radius)
- (cons (- y-out-radius) y-out-radius))))
+ (ly:make-stencil
+ (list 'ellipse x-radius y-radius thickness fill)
+ (cons (- x-out-radius) x-out-radius)
+ (cons (- y-out-radius) y-out-radius))))
(define-public (box-grob-stencil grob)
"Make a box of exactly the extents of the grob. The box precisely
encloses the contents."
(let* ((xext (ly:grob-extent grob grob 0))
- (yext (ly:grob-extent grob grob 1))
- (thick 0.01))
+ (yext (ly:grob-extent grob grob 1))
+ (thick 0.01))
(ly:stencil-add
(make-filled-box-stencil xext (cons (- (car yext) thick) (car yext)))
@@ -506,10 +506,10 @@ encloses the contents."
(define-public (box-stencil stencil thickness padding)
"Add a box around @var{stencil}, producing a new stencil."
(let* ((x-ext (interval-widen (ly:stencil-extent stencil 0) padding))
- (y-ext (interval-widen (ly:stencil-extent stencil 1) padding))
- (y-rule (make-filled-box-stencil (cons 0 thickness) y-ext))
- (x-rule (make-filled-box-stencil
- (interval-widen x-ext thickness) (cons 0 thickness))))
+ (y-ext (interval-widen (ly:stencil-extent stencil 1) padding))
+ (y-rule (make-filled-box-stencil (cons 0 thickness) y-ext))
+ (x-rule (make-filled-box-stencil
+ (interval-widen x-ext thickness) (cons 0 thickness))))
(set! stencil (ly:stencil-combine-at-edge stencil X 1 y-rule padding))
(set! stencil (ly:stencil-combine-at-edge stencil X -1 y-rule padding))
(set! stencil (ly:stencil-combine-at-edge stencil Y 1 x-rule 0.0))
@@ -519,74 +519,74 @@ encloses the contents."
(define-public (circle-stencil stencil thickness padding)
"Add a circle around @var{stencil}, producing a new stencil."
(let* ((x-ext (ly:stencil-extent stencil X))
- (y-ext (ly:stencil-extent stencil Y))
- (diameter (max (interval-length x-ext)
+ (y-ext (ly:stencil-extent stencil Y))
+ (diameter (max (interval-length x-ext)
(interval-length y-ext)))
- (radius (+ (/ diameter 2) padding thickness))
- (circle (make-circle-stencil radius thickness #f)))
+ (radius (+ (/ diameter 2) padding thickness))
+ (circle (make-circle-stencil radius thickness #f)))
(ly:stencil-add
stencil
(ly:stencil-translate circle
- (cons
- (interval-center x-ext)
- (interval-center y-ext))))))
+ (cons
+ (interval-center x-ext)
+ (interval-center y-ext))))))
(define-public (oval-stencil stencil thickness x-padding y-padding)
"Add an oval around @code{stencil}, padded by the padding pair,
producing a new stencil."
(let* ((x-ext (ly:stencil-extent stencil X))
- (y-ext (ly:stencil-extent stencil Y))
+ (y-ext (ly:stencil-extent stencil Y))
(x-length (+ (interval-length x-ext) x-padding thickness))
(y-length (+ (interval-length y-ext) y-padding thickness))
(x-radius (* 0.707 x-length) )
(y-radius (* 0.707 y-length) )
- (oval (make-oval-stencil x-radius y-radius thickness #f)))
+ (oval (make-oval-stencil x-radius y-radius thickness #f)))
(ly:stencil-add
stencil
(ly:stencil-translate oval
- (cons
- (interval-center x-ext)
- (interval-center y-ext))))))
+ (cons
+ (interval-center x-ext)
+ (interval-center y-ext))))))
(define-public (ellipse-stencil stencil thickness x-padding y-padding)
"Add an ellipse around @var{stencil}, padded by the padding pair,
producing a new stencil."
(let* ((x-ext (ly:stencil-extent stencil X))
- (y-ext (ly:stencil-extent stencil Y))
+ (y-ext (ly:stencil-extent stencil Y))
(x-length (+ (interval-length x-ext) x-padding thickness))
(y-length (+ (interval-length y-ext) y-padding thickness))
;; (aspect-ratio (/ x-length y-length))
(x-radius (* 0.707 x-length) )
(y-radius (* 0.707 y-length) )
- ;; (diameter (max (- (cdr x-ext) (car x-ext))
- ;; (- (cdr y-ext) (car y-ext))))
- ;; radius (+ (/ diameter 2) padding thickness))
- (ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
+ ;; (diameter (max (- (cdr x-ext) (car x-ext))
+ ;; (- (cdr y-ext) (car y-ext))))
+ ;; radius (+ (/ diameter 2) padding thickness))
+ (ellipse (make-ellipse-stencil x-radius y-radius thickness #f)))
(ly:stencil-add
stencil
(ly:stencil-translate ellipse
- (cons
- (interval-center x-ext)
- (interval-center y-ext))))))
+ (cons
+ (interval-center x-ext)
+ (interval-center y-ext))))))
(define-public (rounded-box-stencil stencil thickness padding blot)
- "Add a rounded box around @var{stencil}, producing a new stencil."
+ "Add a rounded box around @var{stencil}, producing a new stencil."
(let* ((xext (interval-widen (ly:stencil-extent stencil 0) padding))
- (yext (interval-widen (ly:stencil-extent stencil 1) padding))
- (min-ext (min (-(cdr xext) (car xext)) (-(cdr yext) (car yext))))
- (ideal-blot (min blot (/ min-ext 2)))
- (ideal-thickness (min thickness (/ min-ext 2)))
- (outer (ly:round-filled-box
- (interval-widen xext ideal-thickness)
- (interval-widen yext ideal-thickness)
- ideal-blot))
- (inner (ly:make-stencil (list 'color (x11-color 'white)
- (ly:stencil-expr (ly:round-filled-box
- xext yext (- ideal-blot ideal-thickness)))))))
+ (yext (interval-widen (ly:stencil-extent stencil 1) padding))
+ (min-ext (min (-(cdr xext) (car xext)) (-(cdr yext) (car yext))))
+ (ideal-blot (min blot (/ min-ext 2)))
+ (ideal-thickness (min thickness (/ min-ext 2)))
+ (outer (ly:round-filled-box
+ (interval-widen xext ideal-thickness)
+ (interval-widen yext ideal-thickness)
+ ideal-blot))
+ (inner (ly:make-stencil (list 'color (x11-color 'white)
+ (ly:stencil-expr (ly:round-filled-box
+ xext yext (- ideal-blot ideal-thickness)))))))
(set! stencil (ly:stencil-add outer inner))
stencil))
@@ -605,7 +605,7 @@ producing a new stencil."
(ly:stencil-add
(stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
- white)
+ white)
stencil)
))
@@ -614,63 +614,63 @@ producing a new stencil."
with optional arrows of @code{max-size} on start and end controlled by
@var{start?} and @var{end?}."
(lambda (destination max-size)
- (let*
- ((e_x 1+0i)
- (e_y 0+1i)
- (distance (sqrt (+ (* (car destination) (car destination))
- (* (cdr destination) (cdr destination)))))
- (size (min max-size (/ distance 3)))
- (rotate (lambda (z ang)
- (* (make-polar 1 ang)
- z)))
- (complex-to-offset (lambda (z)
- (list (real-part z) (imag-part z))))
-
- (z-dest (+ (* e_x (car destination)) (* e_y (cdr destination))))
- (e_z (/ z-dest (magnitude z-dest)))
- (triangle-points (list
- (* size -1+0.25i)
- 0
- (* size -1-0.25i)))
- (p1s (map (lambda (z)
- (+ z-dest (rotate z (angle z-dest))))
- triangle-points))
- (p2s (map (lambda (z)
- (rotate z (angle (- z-dest))))
- triangle-points))
- (null (cons 0 0))
- (arrow-1
- (ly:make-stencil
- `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
- 0.0
- #t) null null))
- (arrow-2
- (ly:make-stencil
- `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
- 0.0
- #t) null null ) )
- (thickness (min (/ distance 12) 0.1))
- (shorten-line (min (/ distance 3) 0.5))
- (start (complex-to-offset (/ (* e_z shorten-line) 2)))
- (end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2))))
-
- (line (ly:make-stencil
- `(draw-line ,thickness
- ,(car start) ,(cadr start)
- ,(car end) ,(cadr end)
- )
- (cons (min 0 (car destination))
- (min 0 (cdr destination)))
- (cons (max 0 (car destination))
- (max 0 (cdr destination)))))
-
- (result
- (ly:stencil-add
+ (let*
+ ((e_x 1+0i)
+ (e_y 0+1i)
+ (distance (sqrt (+ (* (car destination) (car destination))
+ (* (cdr destination) (cdr destination)))))
+ (size (min max-size (/ distance 3)))
+ (rotate (lambda (z ang)
+ (* (make-polar 1 ang)
+ z)))
+ (complex-to-offset (lambda (z)
+ (list (real-part z) (imag-part z))))
+
+ (z-dest (+ (* e_x (car destination)) (* e_y (cdr destination))))
+ (e_z (/ z-dest (magnitude z-dest)))
+ (triangle-points (list
+ (* size -1+0.25i)
+ 0
+ (* size -1-0.25i)))
+ (p1s (map (lambda (z)
+ (+ z-dest (rotate z (angle z-dest))))
+ triangle-points))
+ (p2s (map (lambda (z)
+ (rotate z (angle (- z-dest))))
+ triangle-points))
+ (null (cons 0 0))
+ (arrow-1
+ (ly:make-stencil
+ `(polygon (quote ,(concatenate (map complex-to-offset p1s)))
+ 0.0
+ #t) null null))
+ (arrow-2
+ (ly:make-stencil
+ `(polygon (quote ,(concatenate (map complex-to-offset p2s)))
+ 0.0
+ #t) null null ) )
+ (thickness (min (/ distance 12) 0.1))
+ (shorten-line (min (/ distance 3) 0.5))
+ (start (complex-to-offset (/ (* e_z shorten-line) 2)))
+ (end (complex-to-offset (- z-dest (/ (* e_z shorten-line) 2))))
+
+ (line (ly:make-stencil
+ `(draw-line ,thickness
+ ,(car start) ,(cadr start)
+ ,(car end) ,(cadr end)
+ )
+ (cons (min 0 (car destination))
+ (min 0 (cdr destination)))
+ (cons (max 0 (car destination))
+ (max 0 (cdr destination)))))
+
+ (result
+ (ly:stencil-add
(if start? arrow-2 empty-stencil)
(if end? arrow-1 empty-stencil)
line)))
- result)))
+ result)))
(define-public dimension-arrows (arrow-stencil-maker #t #t))
@@ -684,20 +684,20 @@ with optional arrows of @code{max-size} on start and end controlled by
(define*-public (annotate-y-interval layout name extent is-length
#:key (color darkblue))
(let ((text-props (cons '((font-size . -3)
- (font-family . typewriter))
- (layout-extract-page-properties layout)))
- (annotation #f))
+ (font-family . typewriter))
+ (layout-extract-page-properties layout)))
+ (annotation #f))
(define (center-stencil-on-extent stil)
(ly:stencil-translate (ly:stencil-aligned-to stil Y CENTER)
(cons 0 (interval-center extent))))
;; do something sensible for 0,0 intervals.
(set! extent (interval-widen extent 0.001))
(if (not (interval-sane? extent))
- (set! annotation (interpret-markup
- layout text-props
- (make-simple-markup (simple-format #f "~a: NaN/inf" name))))
- (let ((text-stencil (interpret-markup
- layout text-props
+ (set! annotation (interpret-markup
+ layout text-props
+ (make-simple-markup (simple-format #f "~a: NaN/inf" name))))
+ (let ((text-stencil (interpret-markup
+ layout text-props
(markup #:whiteout #:simple name)))
(dim-stencil (interpret-markup
layout text-props
@@ -709,88 +709,88 @@ with optional arrows of @code{max-size} on start and end controlled by
(ly:format "~$" (interval-length extent)))
(else
(ly:format "(~$,~$)"
- (car extent) (cdr extent)))))))
- (arrows (ly:stencil-translate-axis
- (dimension-arrows (cons 0 (interval-length extent)) 1.0)
- (interval-start extent) Y)))
- (set! annotation
+ (car extent) (cdr extent)))))))
+ (arrows (ly:stencil-translate-axis
+ (dimension-arrows (cons 0 (interval-length extent)) 1.0)
+ (interval-start extent) Y)))
+ (set! annotation
(center-stencil-on-extent text-stencil))
- (set! annotation
- (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5))
- (set! annotation
- (ly:stencil-combine-at-edge annotation X LEFT
+ (set! annotation
+ (ly:stencil-combine-at-edge arrows X RIGHT annotation 0.5))
+ (set! annotation
+ (ly:stencil-combine-at-edge annotation X LEFT
(center-stencil-on-extent dim-stencil)
0.5))
- (set! annotation
- (stencil-with-color annotation color))))
+ (set! annotation
+ (stencil-with-color annotation color))))
annotation))
;; TODO: figure out how to annotate padding nicely
;; TODO: emphasize either padding or min-dist depending on which constraint was active
(define*-public (annotate-spacing-spec layout spacing-spec start-Y-offset next-staff-Y
- #:key (base-color blue))
- (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
- (space (get-spacing-var 'basic-distance))
- (padding (get-spacing-var 'padding))
- (min-dist (get-spacing-var 'minimum-distance))
- (contrast-color (append (cdr base-color) (list (car base-color))))
- (min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y))
- (min-dist-color (if min-dist-blocks contrast-color base-color))
- (basic-annotation (annotate-y-interval layout
- "basic-dist"
- (cons (- start-Y-offset space) start-Y-offset)
- #t
- #:color (map (lambda (x) (* x 0.25)) base-color)))
- (min-annotation (annotate-y-interval layout
- "min-dist"
- (cons (- start-Y-offset min-dist) start-Y-offset)
- #t
- #:color min-dist-color))
- (extra-annotation (annotate-y-interval layout
- "extra dist"
- (cons next-staff-Y (- start-Y-offset min-dist))
- #t
- #:color (map (lambda (x) (* x 0.5)) min-dist-color))))
+ #:key (base-color blue))
+ (let* ((get-spacing-var (lambda (sym) (assoc-get sym spacing-spec 0.0)))
+ (space (get-spacing-var 'basic-distance))
+ (padding (get-spacing-var 'padding))
+ (min-dist (get-spacing-var 'minimum-distance))
+ (contrast-color (append (cdr base-color) (list (car base-color))))
+ (min-dist-blocks (<= (- start-Y-offset min-dist) next-staff-Y))
+ (min-dist-color (if min-dist-blocks contrast-color base-color))
+ (basic-annotation (annotate-y-interval layout
+ "basic-dist"
+ (cons (- start-Y-offset space) start-Y-offset)
+ #t
+ #:color (map (lambda (x) (* x 0.25)) base-color)))
+ (min-annotation (annotate-y-interval layout
+ "min-dist"
+ (cons (- start-Y-offset min-dist) start-Y-offset)
+ #t
+ #:color min-dist-color))
+ (extra-annotation (annotate-y-interval layout
+ "extra dist"
+ (cons next-staff-Y (- start-Y-offset min-dist))
+ #t
+ #:color (map (lambda (x) (* x 0.5)) min-dist-color))))
(stack-stencils X RIGHT 0.0
- (list
- basic-annotation
- (if min-dist-blocks
- min-annotation
- (ly:stencil-add min-annotation extra-annotation))))))
+ (list
+ basic-annotation
+ (if min-dist-blocks
+ min-annotation
+ (ly:stencil-add min-annotation extra-annotation))))))
(define-public (eps-file->stencil axis size file-name)
(let*
((contents (ly:gulp-file file-name))
(bbox (get-postscript-bbox (car (string-split contents #\nul))))
(bbox-size (if (= axis X)
- (- (list-ref bbox 2) (list-ref bbox 0))
- (- (list-ref bbox 3) (list-ref bbox 1))
- ))
+ (- (list-ref bbox 2) (list-ref bbox 0))
+ (- (list-ref bbox 3) (list-ref bbox 1))
+ ))
(factor (if (< 0 bbox-size)
- (exact->inexact (/ size bbox-size))
- 0))
+ (exact->inexact (/ size bbox-size))
+ 0))
(scaled-bbox
- (map (lambda (x) (* factor x)) bbox))
+ (map (lambda (x) (* factor x)) bbox))
;; We need to shift the whole eps to (0,0), otherwise it will appear
;; displaced in lilypond (displacement will depend on the scaling!)
(translate-string (ly:format "~a ~a translate" (- (list-ref bbox 0)) (- (list-ref bbox 1))))
(clip-rect-string (ly:format
- "~a ~a ~a ~a rectclip"
- (list-ref bbox 0)
- (list-ref bbox 1)
- (- (list-ref bbox 2) (list-ref bbox 0))
- (- (list-ref bbox 3) (list-ref bbox 1)))))
+ "~a ~a ~a ~a rectclip"
+ (list-ref bbox 0)
+ (list-ref bbox 1)
+ (- (list-ref bbox 2) (list-ref bbox 0))
+ (- (list-ref bbox 3) (list-ref bbox 1)))))
(if bbox
- (ly:make-stencil
- (list
- 'embedded-ps
- (string-append
- (ly:format
- "
+ (ly:make-stencil
+ (list
+ 'embedded-ps
+ (string-append
+ (ly:format
+ "
gsave
currentpoint translate
BeginEPSF
@@ -800,19 +800,19 @@ BeginEPSF
%%BeginDocument: ~a
" factor translate-string clip-rect-string
- file-name
- )
- contents
- "%%EndDocument
+file-name
+)
+ contents
+ "%%EndDocument
EndEPSF
grestore
"))
- ;; Stencil starts at (0,0), since we have shifted the eps, and its
+ ;; Stencil starts at (0,0), since we have shifted the eps, and its
;; size is exactly the size of the scaled bounding box
- (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0)))
- (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1))))
+ (cons 0 (- (list-ref scaled-bbox 2) (list-ref scaled-bbox 0)))
+ (cons 0 (- (list-ref scaled-bbox 3) (list-ref scaled-bbox 1))))
- (ly:make-stencil "" '(0 . 0) '(0 . 0)))
+ (ly:make-stencil "" '(0 . 0) '(0 . 0)))
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -821,12 +821,12 @@ grestore
(define-public (write-system-signatures basename paper-systems count)
(if (pair? paper-systems)
(begin
- (let*
- ((outname (simple-format #f "~a-~a.signature" basename count)) )
+ (let*
+ ((outname (simple-format #f "~a-~a.signature" basename count)) )
- (ly:message "Writing ~a" outname)
- (write-system-signature outname (car paper-systems))
- (write-system-signatures basename (cdr paper-systems) (1+ count))))))
+ (ly:message "Writing ~a" outname)
+ (write-system-signature outname (car paper-systems))
+ (write-system-signatures basename (cdr paper-systems) (1+ count))))))
(use-modules (scm paper-system))
(define-public (write-system-signature filename paper-system)
@@ -846,20 +846,20 @@ grestore
((float? expr) #f)
((ly:font-metric? expr) (ly:font-name expr))
((pair? expr) (cons (strip-floats (car expr))
- (strip-floats (cdr expr))))
+ (strip-floats (cdr expr))))
(else expr)))
(define (fold-false-pairs expr)
"Try to remove lists of #f as much as possible."
(if (pair? expr)
- (let*
- ((first (car expr))
- (rest (fold-false-pairs (cdr expr))))
+ (let*
+ ((first (car expr))
+ (rest (fold-false-pairs (cdr expr))))
- (if first
- (cons (fold-false-pairs first) rest)
- rest))
- expr))
+ (if first
+ (cons (fold-false-pairs first) rest)
+ rest))
+ expr))
(define (raw-string expr)
"escape quotes and slashes for python consumption"
@@ -867,65 +867,65 @@ grestore
(define (raw-pair expr)
(simple-format #f "~a ~a"
- (car expr) (cdr expr)))
+ (car expr) (cdr expr)))
(define (found-grob expr)
(let*
- ((grob (car expr))
- (rest (cdr expr))
- (collected '())
- (cause (event-cause grob))
- (input (if (ly:stream-event? cause) (ly:event-property cause 'origin) #f))
- (location (if (ly:input-location? input) (ly:input-file-line-char-column input) '()))
-
- ;; todo: use stencil extent if available.
- (x-ext (ly:grob-extent grob system-grob X))
- (y-ext (ly:grob-extent grob system-grob Y))
- (expression-skeleton
- (if compare-expressions
- (interpret-for-signature
- #f (lambda (e)
- (set! collected (cons e collected)))
- rest)
- "")))
+ ((grob (car expr))
+ (rest (cdr expr))
+ (collected '())
+ (cause (event-cause grob))
+ (input (if (ly:stream-event? cause) (ly:event-property cause 'origin) #f))
+ (location (if (ly:input-location? input) (ly:input-file-line-char-column input) '()))
+
+ ;; todo: use stencil extent if available.
+ (x-ext (ly:grob-extent grob system-grob X))
+ (y-ext (ly:grob-extent grob system-grob Y))
+ (expression-skeleton
+ (if compare-expressions
+ (interpret-for-signature
+ #f (lambda (e)
+ (set! collected (cons e collected)))
+ rest)
+ "")))
(simple-format output
- "~a@~a@~a@~a@~a\n"
- (cdr (assq 'name (ly:grob-property grob 'meta) ))
- (raw-string location)
- (raw-pair (if (interval-empty? x-ext) '(1 . -1) x-ext))
- (raw-pair (if (interval-empty? y-ext) '(1 . -1) y-ext))
- (raw-string collected))
+ "~a@~a@~a@~a@~a\n"
+ (cdr (assq 'name (ly:grob-property grob 'meta) ))
+ (raw-string location)
+ (raw-pair (if (interval-empty? x-ext) '(1 . -1) x-ext))
+ (raw-pair (if (interval-empty? y-ext) '(1 . -1) y-ext))
+ (raw-string collected))
))
(define (interpret-for-signature escape collect expr)
(define (interpret expr)
(let*
- ((head (if (pair? expr)
- (car expr)
- #f)))
-
- (cond
- ((eq? head 'grob-cause) (escape (cdr expr)))
- ((eq? head 'color) (interpret (caddr expr)))
- ((eq? head 'rotate-stencil) (interpret (caddr expr)))
- ((eq? head 'translate-stencil) (interpret (caddr expr)))
- ((eq? head 'combine-stencil)
- (for-each (lambda (e) (interpret e)) (cdr expr)))
- (else
- (collect (fold-false-pairs (strip-floats expr))))
-
- )))
+ ((head (if (pair? expr)
+ (car expr)
+ #f)))
+
+ (cond
+ ((eq? head 'grob-cause) (escape (cdr expr)))
+ ((eq? head 'color) (interpret (caddr expr)))
+ ((eq? head 'rotate-stencil) (interpret (caddr expr)))
+ ((eq? head 'translate-stencil) (interpret (caddr expr)))
+ ((eq? head 'combine-stencil)
+ (for-each (lambda (e) (interpret e)) (cdr expr)))
+ (else
+ (collect (fold-false-pairs (strip-floats expr))))
+
+ )))
(interpret expr))
(if (ly:grob? system-grob)
(begin
- (display (simple-format #f "# Output signature\n# Generated by LilyPond ~a\n" (lilypond-version))
- output)
- (interpret-for-signature found-grob (lambda (x) #f)
- (ly:stencil-expr
- (paper-system-stencil paper-system)))))
+ (display (simple-format #f "# Output signature\n# Generated by LilyPond ~a\n" (lilypond-version))
+ output)
+ (interpret-for-signature found-grob (lambda (x) #f)
+ (ly:stencil-expr
+ (paper-system-stencil paper-system)))))
;; should be superfluous, but leaking "too many open files"?
(close-port output))
diff --git a/scm/tablature.scm b/scm/tablature.scm
index 3304e24af7..d62f0aa017 100644
--- a/scm/tablature.scm
+++ b/scm/tablature.scm
@@ -42,7 +42,7 @@
;; define sans serif-style tab-Clefs as a markup:
(define-markup-command (customTabClef
- layout props num-strings staff-space)
+ layout props num-strings staff-space)
(integer? number?)
#:category music
"Draw a tab clef sans-serif style."
@@ -67,8 +67,8 @@
;; if it is "moderntab", we'll draw it
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (if (ly:grob? staff-symbol)
- (ly:grob-property staff-symbol 'line-count)
- 0))
+ (ly:grob-property staff-symbol 'line-count)
+ 0))
(staff-space (ly:staff-symbol-staff-space grob)))
(grob-interpret-markup grob (make-customTabClef-markup line-count
@@ -142,10 +142,10 @@
;; tab note head is visible
(if tab-note-head-parenthesized
(begin
- (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
+ (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
(ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
;; tab note head is invisible
- (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
+ (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
;; tie is not split
(ly:grob-set-property! tied-tab-note-head 'transparent #t)))))
@@ -169,14 +169,14 @@
(tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
(tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))
- (if tab-note-head-visible
- ;; tab note head is visible
- (if tab-note-head-parenthesized
- (begin
- (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
- (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
- ;; tab note head is invisible
- (ly:grob-set-property! tied-tab-note-head 'transparent #t))))))
+ (if tab-note-head-visible
+ ;; tab note head is visible
+ (if tab-note-head-parenthesized
+ (begin
+ (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
+ (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
+ ;; tab note head is invisible
+ (ly:grob-set-property! tied-tab-note-head 'transparent #t))))))
;; the slurs should not be too far apart from the corresponding fret number, so
;; we move the slur towards the TabNoteHeads; moreover, if the left fret number is
@@ -196,7 +196,7 @@
(* staff-space
(ly:grob-property grob 'direction)
0.35))))
- control-points)))
+ control-points)))
(ly:grob-set-property! grob 'control-points new-control-points)
(ly:slur::print grob)))
@@ -231,48 +231,48 @@
(define (is-harmonic? grob)
(let ((arts (ly:event-property (event-cause grob) 'articulations)))
(or (pair? (filter (lambda (a)
- (ly:in-event-class? a 'harmonic-event))
- arts))
- (eq? (ly:grob-property grob 'style) 'harmonic))))
+ (ly:in-event-class? a 'harmonic-event))
+ arts))
+ (eq? (ly:grob-property grob 'style) 'harmonic))))
(let* ((cautionary (ly:grob-property grob 'display-cautionary #f))
- (details (ly:grob-property grob 'details '()))
- (harmonic-props (assoc-get 'harmonic-properties details '()))
- (harmonic-angularity (assoc-get 'angularity harmonic-props 2))
- (harmonic-half-thick (assoc-get 'half-thickness harmonic-props 0.075))
- (harmonic-padding (assoc-get 'padding harmonic-props 0))
- (harmonic-proc (assoc-get 'procedure harmonic-props parenthesize-stencil))
- (harmonic-width (assoc-get 'width harmonic-props 0.25))
- (cautionary-props (assoc-get 'cautionary-properties details '()))
- (cautionary-angularity (assoc-get 'angularity cautionary-props 2))
- (cautionary-half-thick (assoc-get 'half-thickness cautionary-props 0.075))
- (cautionary-padding (assoc-get 'padding cautionary-props 0))
- (cautionary-proc (assoc-get 'procedure cautionary-props parenthesize-stencil))
- (cautionary-width (assoc-get 'width cautionary-props 0.25))
+ (details (ly:grob-property grob 'details '()))
+ (harmonic-props (assoc-get 'harmonic-properties details '()))
+ (harmonic-angularity (assoc-get 'angularity harmonic-props 2))
+ (harmonic-half-thick (assoc-get 'half-thickness harmonic-props 0.075))
+ (harmonic-padding (assoc-get 'padding harmonic-props 0))
+ (harmonic-proc (assoc-get 'procedure harmonic-props parenthesize-stencil))
+ (harmonic-width (assoc-get 'width harmonic-props 0.25))
+ (cautionary-props (assoc-get 'cautionary-properties details '()))
+ (cautionary-angularity (assoc-get 'angularity cautionary-props 2))
+ (cautionary-half-thick (assoc-get 'half-thickness cautionary-props 0.075))
+ (cautionary-padding (assoc-get 'padding cautionary-props 0))
+ (cautionary-proc (assoc-get 'procedure cautionary-props parenthesize-stencil))
+ (cautionary-width (assoc-get 'width cautionary-props 0.25))
(output-grob (ly:text-interface::print grob))
- (ref-grob (grob-interpret-markup grob "8"))
- (offset-factor (assoc-get 'head-offset details 3/5))
- (column-offset (* offset-factor
- (interval-length
- (ly:stencil-extent
- (grob-interpret-markup grob "8")
- X)))))
+ (ref-grob (grob-interpret-markup grob "8"))
+ (offset-factor (assoc-get 'head-offset details 3/5))
+ (column-offset (* offset-factor
+ (interval-length
+ (ly:stencil-extent
+ (grob-interpret-markup grob "8")
+ X)))))
(if (is-harmonic? grob)
(set! output-grob (harmonic-proc output-grob
- harmonic-half-thick
- harmonic-width
- harmonic-angularity
- harmonic-padding)))
+ harmonic-half-thick
+ harmonic-width
+ harmonic-angularity
+ harmonic-padding)))
(if cautionary
(set! output-grob (cautionary-proc output-grob
- cautionary-half-thick
- cautionary-width
- cautionary-angularity
- cautionary-padding)))
+ cautionary-half-thick
+ cautionary-width
+ cautionary-angularity
+ cautionary-padding)))
(ly:stencil-translate-axis (centered-stencil output-grob)
- column-offset
- X)))
+ column-offset
+ X)))
;; Harmonic definitions
@@ -290,13 +290,13 @@
;; According to the arithmetic sum, the position of m/n is at 1/2*(n-2)(n-1)+(m-1)
;; if we start counting from zero
(vector 12
- 7 19
- 5 12 24
- 4 9 16 28
- 3 7 12 19 31
- 2.7 5.8 9.7 14.7 21.7 33.7
- 2.3 5 8 12 17 24 36
- 2 4.4 7 10 14 19 26 38 ))
+ 7 19
+ 5 12 24
+ 4 9 16 28
+ 3 7 12 19 31
+ 2.7 5.8 9.7 14.7 21.7 33.7
+ 2.3 5 8 12 17 24 36
+ 2 4.4 7 10 14 19 26 38 ))
(define partial-pitch
(vector '(0 0 0)
@@ -332,25 +332,25 @@
(- den 1)
1/2)
nom -1)))
- (number->string (vector-ref node-positions index))))
+ (number->string (vector-ref node-positions index))))
(define-public (ratio->pitch ratio)
"Calculate a pitch given @var{ratio} for the harmonic."
(let* ((partial (1- (denominator ratio)))
(pitch (vector-ref partial-pitch partial)))
- (ly:make-pitch (first pitch)
- (second pitch)
- (third pitch))))
+ (ly:make-pitch (first pitch)
+ (second pitch)
+ (third pitch))))
(define-public (fret->pitch fret)
"Calculate a pitch given @var{fret} for the harmonic."
(let* ((partial (assoc-get fret fret-partials 0))
(pitch (vector-ref partial-pitch partial)))
- (ly:make-pitch (first pitch)
- (second pitch)
- (third pitch))))
+ (ly:make-pitch (first pitch)
+ (second pitch)
+ (third pitch))))
(define-public (calc-harmonic-pitch pitch music)
"Calculate the harmonic pitches in @var{music} given
@@ -359,29 +359,29 @@
(e (ly:music-property music 'element))
(p (ly:music-property music 'pitch)))
(cond
- ((pair? es)
- (ly:music-set-property! music 'elements
- (map (lambda (x) (calc-harmonic-pitch pitch x)) es)))
- ((ly:music? e)
- (ly:music-set-property! music 'element (calc-harmonic-pitch pitch e)))
- ((ly:pitch? p)
- (begin
- (set! p (ly:pitch-transpose p pitch))
- (ly:music-set-property! music 'pitch p))))
+ ((pair? es)
+ (ly:music-set-property! music 'elements
+ (map (lambda (x) (calc-harmonic-pitch pitch x)) es)))
+ ((ly:music? e)
+ (ly:music-set-property! music 'element (calc-harmonic-pitch pitch e)))
+ ((ly:pitch? p)
+ (begin
+ (set! p (ly:pitch-transpose p pitch))
+ (ly:music-set-property! music 'pitch p))))
music))
(define-public (make-harmonic mus)
"Convert music variable @var{mus} to harmonics."
(let ((elts (ly:music-property mus 'elements))
(elt (ly:music-property mus 'element)))
- (cond
- ((pair? elts)
- (map make-harmonic elts))
- ((ly:music? elt)
- (make-harmonic elt))
- ((music-is-of-type? mus 'note-event)
- (set! (ly:music-property mus 'articulations)
- (append
- (ly:music-property mus 'articulations)
- (list (make-music 'HarmonicEvent))))))
- mus))
+ (cond
+ ((pair? elts)
+ (map make-harmonic elts))
+ ((ly:music? elt)
+ (make-harmonic elt))
+ ((music-is-of-type? mus 'note-event)
+ (set! (ly:music-property mus 'articulations)
+ (append
+ (ly:music-property mus 'articulations)
+ (list (make-music 'HarmonicEvent))))))
+ mus))
diff --git a/scm/text.scm b/scm/text.scm
index ee399f94ba..1454105912 100644
--- a/scm/text.scm
+++ b/scm/text.scm
@@ -25,5 +25,5 @@
(define-public (internal-add-text-replacements props alist)
(let* ((dummy-replacements (chain-assoc-get 'replacement-alist props '()))
(new-replacements
- (append dummy-replacements alist)))
+ (append dummy-replacements alist)))
(prepend-alist-chain 'replacement-alist new-replacements props)))
diff --git a/scm/time-signature-settings.scm b/scm/time-signature-settings.scm
index d9e62fe1b8..e171149ec4 100644
--- a/scm/time-signature-settings.scm
+++ b/scm/time-signature-settings.scm
@@ -71,7 +71,7 @@
;; in 2/2 time:
;; use defaults, but end beams with 32nd notes each 1 4 beat
((2 . 2) .
- ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8))))))))
+ ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8))))))))
;; in 2/4, 2/8 and 2/16 time:
;; use defaults, so no entries are necessary
@@ -80,7 +80,7 @@
;; use defaults, but end beams with 32nd notes and higher each 1 4 beat
((3 . 2) .
- ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8))))))))
+ ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8))))))))
;; in 3 4 time:
;; use defaults, but combine all beats into a unit if possible
@@ -89,8 +89,8 @@
;; in order to avoid beaming every beam type for the entire measure, we set
;; triplets back to every beat.
((3 . 4) .
- ((beamExceptions . ((end . (((1 . 8) . (6)) ;1/8 note whole measure
- ((1 . 12) . (3 3 3)))))))) ;Anything shorter by beat
+ ((beamExceptions . ((end . (((1 . 8) . (6)) ;1/8 note whole measure
+ ((1 . 12) . (3 3 3)))))))) ;Anything shorter by beat
;; in 3 8 time:
;; beam entire measure together
@@ -102,7 +102,7 @@
;; in 4 2 time:
;; use defaults, but end beams with 16th notes or finer each 1 4 beat
((4 . 2) .
- ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4 4 4))))))))
+ ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4 4 4))))))))
;; in 4 4 (common) time:
;; use defaults, but combine beats 1,2 and 3,4 if only 8th notes
@@ -110,8 +110,8 @@
;; ly/engraver-init.ly where the default time signature is set
;; are set
((4 . 4) .
- ((beamExceptions . ((end . (((1 . 8) . (4 4)) ; 1/8 notes half measure
- ((1 . 12) . (3 3 3 3)))))))) ;Anything shorter by beat
+ ((beamExceptions . ((end . (((1 . 8) . (4 4)) ; 1/8 notes half measure
+ ((1 . 12) . (3 3 3 3)))))))) ;Anything shorter by beat
;; in 4/8 time:
;; combine beats 1 and 2, so beam in 2
@@ -123,7 +123,7 @@
;; in 6 4 time:
;; use defaults, but end beams with 32nd or finer each 1/4 beat
((6 . 4) .
- ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4))))))))
+ ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4))))))))
;; in 6 8 time:
;; use defaults, so no entries necessary
@@ -134,7 +134,7 @@
;; in 9 4 time:
;; use defaults, but end beams with 32nd or finer each 1 4 beat
((9 . 4) .
- ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8))))))))
+ ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8))))))))
;; in 9 8 time
;; use defaults, so no entries necessary
@@ -145,7 +145,7 @@
;; in 12 4 time:
;; use defaults, but end beams with 32nd or finer notes each 1 4 beat
((12 . 4) .
- ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8 8 8 8 8))))))))
+ ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8 8 8 8 8))))))))
;; in 12 8 time:
;; use defaults, so no entries necessary
@@ -156,12 +156,12 @@
;; in 5 8 time:
;; default: group (3 2)
((5 . 8) .
- ((beatStructure . (3 2))))
+ ((beatStructure . (3 2))))
;; in 8 8 time:
;; default: group (3 3 2)
((8 . 8) .
- ((beatStructure . (3 3 2))))
+ ((beatStructure . (3 3 2))))
)) ; end of alist definition
@@ -173,28 +173,28 @@
"Get setting @code{my-symbol} for @code{time-signature} from
@code{time-signature-settings}."
(let ((my-time-signature-settings
- (assoc-get time-signature time-signature-settings '())))
- (assoc-get my-symbol my-time-signature-settings '())))
+ (assoc-get time-signature time-signature-settings '())))
+ (assoc-get my-symbol my-time-signature-settings '())))
(define-public (make-setting base-fraction
beat-structure
beam-exceptions)
(list
- (cons 'baseMoment (if (pair? base-fraction)
- (/ (car base-fraction) (cdr base-fraction))
- base-fraction))
- (cons 'beatStructure beat-structure)
- (cons 'beamExceptions beam-exceptions)))
+ (cons 'baseMoment (if (pair? base-fraction)
+ (/ (car base-fraction) (cdr base-fraction))
+ base-fraction))
+ (cons 'beatStructure beat-structure)
+ (cons 'beamExceptions beam-exceptions)))
(define-public (base-length time-signature time-signature-settings)
"Get @code{baseMoment} rational value for @var{time-signature} from
@var{time-signature-settings}."
- (let ((return-value (get-setting 'baseMoment
- time-signature
- time-signature-settings)))
- (if (null? return-value)
- (/ (cdr time-signature))
- return-value)))
+ (let ((return-value (get-setting 'baseMoment
+ time-signature
+ time-signature-settings)))
+ (if (null? return-value)
+ (/ (cdr time-signature))
+ return-value)))
(define-public (beat-structure base-length time-signature time-signature-settings)
"Get @code{beatStructure} value in @var{base-length} units
@@ -223,7 +223,7 @@ for @var{time-signature} from @var{time-signature-settings}."
(define-public (beam-exceptions time-signature time-signature-settings)
"Get @code{beamExceptions} value for @var{time-signature} from
@var{time-signature-settings}."
- (get-setting 'beamExceptions time-signature time-signature-settings))
+ (get-setting 'beamExceptions time-signature time-signature-settings))
;;; Functions for overriding time-signature settings
@@ -233,10 +233,10 @@ for @var{time-signature} from @var{time-signature-settings}."
"Like the C++ code that executes \\override, but without type
checking."
(begin
- (ly:context-set-property!
- context
- property
- (cons (cons setting value) (ly:context-property context property)))))
+ (ly:context-set-property!
+ context
+ property
+ (cons (cons setting value) (ly:context-property context property)))))
(define (revert-property-setting context property setting)
"Like the C++ code that executes \revert, but without type
@@ -246,50 +246,50 @@ checking."
"Count the number of entries in alist with a key of
ENTRY-KEY."
(cond
- ((null? alist) 0)
- ((equal? (caar alist) entry-key)
- (+ 1 (entry-count (cdr alist) entry-key)))
- (else (entry-count (cdr alist) entry-key))))
+ ((null? alist) 0)
+ ((equal? (caar alist) entry-key)
+ (+ 1 (entry-count (cdr alist) entry-key)))
+ (else (entry-count (cdr alist) entry-key))))
(define (revert-member alist entry-key)
"Return ALIST, with the first entry having a key of
ENTRY-KEY removed. ALIST is not modified, instead
a fresh copy of the list-head is made."
(cond
- ((null? alist) '())
- ((equal? (caar alist) entry-key) (cdr alist))
- (else (cons (car alist)
- (revert-member (cdr alist) entry-key)))))
+ ((null? alist) '())
+ ((equal? (caar alist) entry-key) (cdr alist))
+ (else (cons (car alist)
+ (revert-member (cdr alist) entry-key)))))
;; body of revert-property-setting
(let ((current-value (ly:context-property context property)))
(if (> (entry-count current-value setting) 0)
(ly:context-set-property!
- context
- property
- (revert-member current-value setting)))))
+ context
+ property
+ (revert-member current-value setting)))))
(define-public (override-time-signature-setting time-signature setting)
"Override the time signature settings for the context in
@var{time-signature}, with the new setting alist @var{setting}."
- (context-spec-music
- (make-apply-context
- (lambda (c) (override-property-setting
- c
- 'timeSignatureSettings
- time-signature
- setting)))
- 'Timing))
+ (context-spec-music
+ (make-apply-context
+ (lambda (c) (override-property-setting
+ c
+ 'timeSignatureSettings
+ time-signature
+ setting)))
+ 'Timing))
(define-public (revert-time-signature-setting time-signature)
(context-spec-music
- (make-apply-context
- (lambda (c)
- (revert-property-setting
- c
- 'timeSignatureSettings
- time-signature)))
- 'Timing))
+ (make-apply-context
+ (lambda (c)
+ (revert-property-setting
+ c
+ 'timeSignatureSettings
+ time-signature)))
+ 'Timing))
@@ -312,24 +312,24 @@ a fresh copy of the list-head is made."
(den (car revargs))
(nums (reverse (cdr revargs))))
(make-override-markup '(baseline-skip . 0)
- (make-number-markup
- (make-left-column-markup (list
- (make-center-column-markup (list
- (make-line-markup (insert-markups nums "+"))
- den))))))))
+ (make-number-markup
+ (make-left-column-markup (list
+ (make-center-column-markup (list
+ (make-line-markup (insert-markups nums "+"))
+ den))))))))
(define (format-complex-compound-time time-sig)
(make-override-markup '(baseline-skip . 0)
- (make-number-markup
- (make-line-markup
- (insert-markups (map format-time-fraction time-sig)
- (make-vcenter-markup "+"))))))
+ (make-number-markup
+ (make-line-markup
+ (insert-markups (map format-time-fraction time-sig)
+ (make-vcenter-markup "+"))))))
(define-public (format-compound-time time-sig)
(cond
- ((not (pair? time-sig)) (null-markup))
- ((pair? (car time-sig)) (format-complex-compound-time time-sig))
- (else (format-time-fraction time-sig))))
+ ((not (pair? time-sig)) (null-markup))
+ ((pair? (car time-sig)) (format-complex-compound-time time-sig))
+ (else (format-time-fraction time-sig))))
;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -350,9 +350,9 @@ a fresh copy of the list-head is made."
(define-public (calculate-compound-measure-length time-sig)
(cond
- ((not (pair? time-sig)) (ly:make-moment 4 4))
- ((pair? (car time-sig)) (calculate-complex-compound-time time-sig))
- (else (calculate-time-fraction time-sig))))
+ ((not (pair? time-sig)) (ly:make-moment 4 4))
+ ((pair? (car time-sig)) (calculate-complex-compound-time time-sig))
+ (else (calculate-time-fraction time-sig))))
;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -363,10 +363,10 @@ a fresh copy of the list-head is made."
(define-public (calculate-compound-base-beat time-sig)
(ly:make-moment 1
- (cond
- ((not (pair? time-sig)) 4)
- ((pair? (car time-sig)) (calculate-compound-base-beat-full time-sig))
- (else (calculate-compound-base-beat-full (list time-sig))))))
+ (cond
+ ((not (pair? time-sig)) 4)
+ ((pair? (car time-sig)) (calculate-compound-base-beat-full time-sig))
+ (else (calculate-compound-base-beat-full (list time-sig))))))
;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -386,6 +386,6 @@ a fresh copy of the list-head is made."
(define-public (calculate-compound-beat-grouping time-sig)
(cond
- ((not (pair? time-sig)) '(2 . 2))
- ((pair? (car time-sig)) (beat-grouping-internal time-sig))
- (else (beat-grouping-internal (list time-sig)))))
+ ((not (pair? time-sig)) '(2 . 2))
+ ((pair? (car time-sig)) (beat-grouping-internal time-sig))
+ (else (beat-grouping-internal (list time-sig)))))
diff --git a/scm/titling.scm b/scm/titling.scm
index 7118fb1a06..b5f8b1bb8a 100644
--- a/scm/titling.scm
+++ b/scm/titling.scm
@@ -18,8 +18,8 @@
(define-public (layout-extract-page-properties layout)
(list (append `((line-width . ,(ly:paper-get-number
- layout 'line-width)))
- (ly:output-def-lookup layout 'text-font-defaults))))
+ layout 'line-width)))
+ (ly:output-def-lookup layout 'text-font-defaults))))
;;;;;;;;;;;;;;;;;;
@@ -29,46 +29,46 @@
and interpret them as markup. The @var{props} argument will include
variables set in @var{scopes} and @code{page:is-bookpart-last-page},
@code{page:is-last-bookpart}, @code{page:page-number-string}, and
-@code{page:page-number}."
+@code{page:page-number}."
(define (get sym)
(ly:output-def-lookup layout sym))
(define (interpret-in-page-env potential-markup)
(if (markup? potential-markup)
- (let* ((alists (map ly:module->alist scopes))
- (prefixed-alists
- (map (lambda (alist)
- (map (lambda (entry)
- (cons
- (string->symbol
- (string-append
- "header:"
- (symbol->string (car entry))))
- (cdr entry)))
- alist))
- alists))
- (pgnum-alist
- (list
- (cons 'header:tagline
- (ly:modules-lookup scopes 'tagline
- (ly:output-def-lookup layout 'tagline)))
- (cons 'page:is-last-bookpart is-last-bookpart)
- (cons 'page:is-bookpart-last-page is-bookpart-last-page)
- (cons 'page:page-number-string
- (number->string page-number))
- (cons 'page:page-number page-number)))
- (props (append
- (list pgnum-alist)
- prefixed-alists
- (layout-extract-page-properties layout))))
- (interpret-markup layout props potential-markup))
+ (let* ((alists (map ly:module->alist scopes))
+ (prefixed-alists
+ (map (lambda (alist)
+ (map (lambda (entry)
+ (cons
+ (string->symbol
+ (string-append
+ "header:"
+ (symbol->string (car entry))))
+ (cdr entry)))
+ alist))
+ alists))
+ (pgnum-alist
+ (list
+ (cons 'header:tagline
+ (ly:modules-lookup scopes 'tagline
+ (ly:output-def-lookup layout 'tagline)))
+ (cons 'page:is-last-bookpart is-last-bookpart)
+ (cons 'page:is-bookpart-last-page is-bookpart-last-page)
+ (cons 'page:page-number-string
+ (number->string page-number))
+ (cons 'page:page-number page-number)))
+ (props (append
+ (list pgnum-alist)
+ prefixed-alists
+ (layout-extract-page-properties layout))))
+ (interpret-markup layout props potential-markup))
- empty-stencil))
+ empty-stencil))
(interpret-in-page-env
(if (and (even? page-number)
- (markup? (get what-even)))
+ (markup? (get what-even)))
(get what-even)
(get what-odd))))
@@ -76,28 +76,28 @@ variables set in @var{scopes} and @code{page:is-bookpart-last-page},
"Read variables @var{what} from @var{scopes}, and interpret it as markup.
The @var{props} argument will include variables set in @var{scopes} (prefixed
with `header:'."
-
+
(define (get sym)
(let ((x (ly:modules-lookup scopes sym)))
(if (markup? x) x #f)))
(let* ((alists (map ly:module->alist scopes))
- (prefixed-alist
- (map (lambda (alist)
- (map (lambda (entry)
- (cons
- (string->symbol
- (string-append
- "header:"
- (symbol->string (car entry))))
- (cdr entry)))
- alist))
- alists))
- (props (append prefixed-alist
- (layout-extract-page-properties layout)))
+ (prefixed-alist
+ (map (lambda (alist)
+ (map (lambda (entry)
+ (cons
+ (string->symbol
+ (string-append
+ "header:"
+ (symbol->string (car entry))))
+ (cdr entry)))
+ alist))
+ alists))
+ (props (append prefixed-alist
+ (layout-extract-page-properties layout)))
- (markup (ly:output-def-lookup layout what)))
+ (markup (ly:output-def-lookup layout what)))
(if (markup? markup)
- (interpret-markup layout props markup)
+ (interpret-markup layout props markup)
empty-stencil)))
diff --git a/scm/to-xml.scm b/scm/to-xml.scm
index ea7ce7a0fc..02f918eda9 100644
--- a/scm/to-xml.scm
+++ b/scm/to-xml.scm
@@ -19,9 +19,9 @@
(define-module (scm to-xml))
(use-modules (ice-9 regex)
- (srfi srfi-1)
- (lily)
- (oop goops))
+ (srfi srfi-1)
+ (lily)
+ (oop goops))
"
Todo: this is a quick hack; it makes more sense to define a GOOPS
@@ -47,11 +47,11 @@ is then separated.
(name #:init-value "" #:accessor node-name #:init-keyword #:name)
(value #:init-value "" #:accessor node-value #:init-keyword #:value)
(attributes #:init-value '()
- #:accessor node-attributes
- #:init-keyword #:attributes)
+ #:accessor node-attributes
+ #:init-keyword #:attributes)
(children #:init-value '()
- #:accessor node-children
- #:init-keyword #:children))
+ #:accessor node-children
+ #:init-keyword #:children))
(define node-names
'((NoteEvent . note)
@@ -68,10 +68,10 @@ is then separated.
(string-append
(if xml-name (open-tag xml-name '() '()) "")
(if (equal? (node-value node) "")
- (string-append
- (if xml-name "\n" "")
- (apply string-append (map musicxml-node->string (node-children node))))
- (node-value node))
+ (string-append
+ (if xml-name "\n" "")
+ (apply string-append (map musicxml-node->string (node-children node))))
+ (node-value node))
(if xml-name (close-tag xml-name) "")
(if xml-name "\n" ""))))
@@ -81,7 +81,7 @@ is then separated.
(open-tag (node-name node) (node-attributes node) '())
(if (equal? (node-value node) "")
(string-append
- (apply string-append (map xml-node->string (node-children node))))
+ (apply string-append (map xml-node->string (node-children node))))
(node-value node))
"\n"
(close-tag (node-name node))))
@@ -96,26 +96,26 @@ is then separated.
#:name 'duration
;; #:value (number->string (ash 1 (ly:duration-log d)))))
#:attributes `((log . ,(ly:duration-log d))
- (dots . ,(ly:duration-dot-count d))
- (numer . ,(car (ly:duration-factor d)))
- (denom . ,(cdr (ly:duration-factor d))))))
+ (dots . ,(ly:duration-dot-count d))
+ (numer . ,(car (ly:duration-factor d)))
+ (denom . ,(cdr (ly:duration-factor d))))))
(define (pitch->xml-node p)
(make <xml-node>
#:name 'pitch
#:attributes `((octave . ,(ly:pitch-octave p))
- (notename . ,(ly:pitch-notename p))
- (alteration . ,(ly:pitch-alteration p)))))
+ (notename . ,(ly:pitch-notename p))
+ (alteration . ,(ly:pitch-alteration p)))))
(define (music->xml-node music)
(let* ((name (ly:music-property music 'name))
- (e (ly:music-property music 'element))
- (es (ly:music-property music 'elements))
- (mprops (ly:music-mutable-properties music))
- (d (ly:music-property music 'duration))
- (p (ly:music-property music 'pitch))
- (ignore-props '(origin elements duration pitch element)))
-
+ (e (ly:music-property music 'element))
+ (es (ly:music-property music 'elements))
+ (mprops (ly:music-mutable-properties music))
+ (d (ly:music-property music 'duration))
+ (p (ly:music-property music 'pitch))
+ (ignore-props '(origin elements duration pitch element)))
+
(make <xml-node>
#:name name
#:children
@@ -197,7 +197,7 @@ is then separated.
(if (null? alist)
string
(re-sub (caar alist) (cdar alist)
- (re-sub-alist string (cdr alist)))))
+ (re-sub-alist string (cdr alist)))))
(define xml-entities-alist
'(("\"" . """)
@@ -209,17 +209,17 @@ is then separated.
(define (open-tag tag attrs exceptions)
(define (candidate? x)
(not (memq (car x) exceptions)))
-
+
(define (dump-attr sym-val)
(let* ((sym (car sym-val))
- (val (cdr sym-val)))
-
+ (val (cdr sym-val)))
+
(string-append
"\n "
(symbol->string sym)
"=\""
(let ((s (call-with-output-string (lambda (port) (display val port)))))
- (re-sub-alist s xml-entities-alist))
+ (re-sub-alist s xml-entities-alist))
"\"")))
(string-append
@@ -236,7 +236,7 @@ is then separated.
;; dtd contains # -- This confuses tex during make doc.
;;
;; (display (dtd-header) port)
-
+
(display (open-tag 'music '((type . score)) '()) port)
(display (xml-node->string (music->xml-node music)) port)
(display (close-tag 'music) port))
@@ -249,7 +249,7 @@ is then separated.
;; (display (dtd-header) port)
(define duration->xml-node musicxml-duration->xml-node)
-
+
(display (open-tag 'music '((type . score)) '()) port)
(display (musicxml-node->string (music->xml-node music)) port)
(display (close-tag 'music) port))
diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index 49d8768eb4..bc988ebd5a 100644
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -1,7 +1,7 @@
;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
;;;; (c) 1998--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
-;;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; 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
@@ -32,7 +32,7 @@ way the transposition number is displayed."
(cons "" "")))
(text (string-concatenate (list (car delim) oct (cdr delim)))))
- (make-vcenter-markup text)))
+ (make-vcenter-markup text)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -40,55 +40,55 @@ way the transposition number is displayed."
(define-public (format-metronome-markup event context)
(let ((hide-note (ly:context-property context 'tempoHideNote #f))
- (text (ly:event-property event 'text))
- (dur (ly:event-property event 'tempo-unit))
- (count (ly:event-property event 'metronome-count)))
+ (text (ly:event-property event 'text))
+ (dur (ly:event-property event 'tempo-unit))
+ (count (ly:event-property event 'metronome-count)))
(metronome-markup text dur count hide-note)))
(define-public (metronome-markup text dur count hide-note)
(let* ((note-mark (if (and (not hide-note) (ly:duration? dur))
- (make-smaller-markup
- (make-note-by-number-markup (ly:duration-log dur)
- (ly:duration-dot-count dur)
- 1))
- #f))
- (count-markup (cond ((number? count)
- (if (> count 0)
- (make-simple-markup (number->string count))
- #f))
- ((pair? count)
- (make-concat-markup
- (list
- (make-simple-markup (number->string (car count)))
- (make-simple-markup "â")
- (make-simple-markup "â")
- (make-simple-markup "â")
- (make-simple-markup (number->string (cdr count))))))
- (else #f)))
+ (make-smaller-markup
+ (make-note-by-number-markup (ly:duration-log dur)
+ (ly:duration-dot-count dur)
+ 1))
+ #f))
+ (count-markup (cond ((number? count)
+ (if (> count 0)
+ (make-simple-markup (number->string count))
+ #f))
+ ((pair? count)
+ (make-concat-markup
+ (list
+ (make-simple-markup (number->string (car count)))
+ (make-simple-markup "â")
+ (make-simple-markup "â")
+ (make-simple-markup "â")
+ (make-simple-markup (number->string (cdr count))))))
+ (else #f)))
(note-markup (if (and (not hide-note) count-markup)
- (make-concat-markup
- (list
- (make-general-align-markup Y DOWN note-mark)
- (make-simple-markup " ")
- (make-simple-markup "=")
- (make-simple-markup " ")
- count-markup))
- #f))
+ (make-concat-markup
+ (list
+ (make-general-align-markup Y DOWN note-mark)
+ (make-simple-markup " ")
+ (make-simple-markup "=")
+ (make-simple-markup " ")
+ count-markup))
+ #f))
(text-markup (if (not (null? text))
- (make-bold-markup text)
- #f)))
+ (make-bold-markup text)
+ #f)))
(if text-markup
- (if (and note-markup (not hide-note))
- (make-line-markup (list text-markup
- (make-concat-markup
- (list (make-simple-markup "(")
- note-markup
- (make-simple-markup ")")))))
- (make-line-markup (list text-markup)))
- (if note-markup
- (make-line-markup (list note-markup))
- (make-null-markup)))))
+ (if (and note-markup (not hide-note))
+ (make-line-markup (list text-markup
+ (make-concat-markup
+ (list (make-simple-markup "(")
+ note-markup
+ (make-simple-markup ")")))))
+ (make-line-markup (list text-markup)))
+ (if note-markup
+ (make-line-markup (list note-markup))
+ (make-null-markup)))))
(define-public (format-mark-alphabet mark context)
(make-bold-markup (make-markalphabet-markup (1- mark))))
@@ -107,7 +107,7 @@ way the transposition number is displayed."
(define-public (format-mark-barnumbers mark context)
(make-bold-markup (number->string (ly:context-property context
- 'currentBarNumber))))
+ 'currentBarNumber))))
(define-public (format-mark-box-letters mark context)
(make-bold-markup (make-box-markup (make-markletter-markup (1- mark)))))
@@ -123,13 +123,13 @@ way the transposition number is displayed."
(define-public (format-mark-box-barnumbers mark context)
(make-bold-markup (make-box-markup
- (number->string (ly:context-property context
- 'currentBarNumber)))))
+ (number->string (ly:context-property context
+ 'currentBarNumber)))))
(define-public (format-mark-circle-barnumbers mark context)
(make-bold-markup (make-circle-markup
- (number->string (ly:context-property context
- 'currentBarNumber)))))
+ (number->string (ly:context-property context
+ 'currentBarNumber)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -137,79 +137,79 @@ way the transposition number is displayed."
(define-public (format-bass-figure figure event context)
(let* ((fig (ly:event-property event 'figure))
- (fig-markup (if (number? figure)
-
- ;; this is not very elegant, but center-aligning
- ;; all digits is problematic with other markups,
- ;; and shows problems in the (lack of) overshoot
- ;; of feta-alphabet glyphs.
- ((if (<= 10 figure)
- (lambda (y) (make-translate-scaled-markup
- (cons -0.7 0) y))
- identity)
-
- (cond
- ((eq? #t (ly:event-property event 'diminished))
- (markup #:slashed-digit figure))
- ((eq? #t (ly:event-property event 'augmented-slash))
- (markup #:backslashed-digit figure))
- (else (markup #:number (number->string figure 10)))))
- #f))
-
- (alt (ly:event-property event 'alteration))
- (alt-markup
- (if (number? alt)
- (markup
- #:general-align Y DOWN #:fontsize
- (if (not (= alt DOUBLE-SHARP))
- -2 2)
- (alteration->text-accidental-markup alt))
- #f))
-
- (plus-markup (if (eq? #t (ly:event-property event 'augmented))
- (markup #:number "+")
- #f))
-
- (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
- (plus-dir (ly:context-property context 'figuredBassPlusDirection)))
+ (fig-markup (if (number? figure)
+
+ ;; this is not very elegant, but center-aligning
+ ;; all digits is problematic with other markups,
+ ;; and shows problems in the (lack of) overshoot
+ ;; of feta-alphabet glyphs.
+ ((if (<= 10 figure)
+ (lambda (y) (make-translate-scaled-markup
+ (cons -0.7 0) y))
+ identity)
+
+ (cond
+ ((eq? #t (ly:event-property event 'diminished))
+ (markup #:slashed-digit figure))
+ ((eq? #t (ly:event-property event 'augmented-slash))
+ (markup #:backslashed-digit figure))
+ (else (markup #:number (number->string figure 10)))))
+ #f))
+
+ (alt (ly:event-property event 'alteration))
+ (alt-markup
+ (if (number? alt)
+ (markup
+ #:general-align Y DOWN #:fontsize
+ (if (not (= alt DOUBLE-SHARP))
+ -2 2)
+ (alteration->text-accidental-markup alt))
+ #f))
+
+ (plus-markup (if (eq? #t (ly:event-property event 'augmented))
+ (markup #:number "+")
+ #f))
+
+ (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
+ (plus-dir (ly:context-property context 'figuredBassPlusDirection)))
(if (and (not fig-markup) alt-markup)
- (begin
- (set! fig-markup (markup #:left-align #:pad-around 0.3 alt-markup))
- (set! alt-markup #f)))
+ (begin
+ (set! fig-markup (markup #:left-align #:pad-around 0.3 alt-markup))
+ (set! alt-markup #f)))
;; hmm, how to get figures centered between note, and
;; lone accidentals too?
;; (if (markup? fig-markup)
- ;; (set!
- ;; fig-markup (markup #:translate (cons 1.0 0)
- ;; #:center-align fig-markup)))
+ ;; (set!
+ ;; fig-markup (markup #:translate (cons 1.0 0)
+ ;; #:center-align fig-markup)))
(if alt-markup
- (set! fig-markup
- (markup #:put-adjacent
- X (if (number? alt-dir)
- alt-dir
- LEFT)
- fig-markup
- #:pad-x 0.2 alt-markup)))
+ (set! fig-markup
+ (markup #:put-adjacent
+ X (if (number? alt-dir)
+ alt-dir
+ LEFT)
+ fig-markup
+ #:pad-x 0.2 alt-markup)))
(if plus-markup
- (set! fig-markup
- (if fig-markup
- (markup #:put-adjacent
- X (if (number? plus-dir)
- plus-dir
- LEFT)
- fig-markup
- #:pad-x 0.2 plus-markup)
- plus-markup)))
+ (set! fig-markup
+ (if fig-markup
+ (markup #:put-adjacent
+ X (if (number? plus-dir)
+ plus-dir
+ LEFT)
+ fig-markup
+ #:pad-x 0.2 plus-markup)
+ plus-markup)))
(if (markup? fig-markup)
- (markup #:fontsize -2 fig-markup)
- empty-markup)))
+ (markup #:fontsize -2 fig-markup)
+ empty-markup)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -219,12 +219,12 @@ way the transposition number is displayed."
"Convert @var{placement-list} into a fretboard @var{grob}."
(let* ((tunings (ly:context-property context 'stringTunings))
- (my-string-count (length tunings))
- (details (ly:grob-property grob 'fret-diagram-details)))
+ (my-string-count (length tunings))
+ (details (ly:grob-property grob 'fret-diagram-details)))
;; Add string-count from string-tunings to fret-diagram-details.
(set! (ly:grob-property grob 'fret-diagram-details)
- (acons 'string-count my-string-count details))
+ (acons 'string-count my-string-count details))
;; Create the dot-placement list for the grob
(set! (ly:grob-property grob 'dot-placement-list) placement-list)))
@@ -251,21 +251,21 @@ be returned."
dot placement entries."
(let* ((placements (list->vector
(map (lambda (x) (list 'mute x))
- (iota string-count 1)))))
+ (iota string-count 1)))))
(for-each (lambda (sf)
- (let* ((string (car sf))
- (fret (cadr sf))
- (finger (caddr sf)))
- (vector-set!
- placements
- (1- string)
- (if (= 0 fret)
- (list 'open string)
- (if finger
- (list 'place-fret string fret finger)
- (list 'place-fret string fret))))))
- string-frets)
+ (let* ((string (car sf))
+ (fret (cadr sf))
+ (finger (caddr sf)))
+ (vector-set!
+ placements
+ (1- string)
+ (if (= 0 fret)
+ (list 'open string)
+ (if finger
+ (list 'place-fret string fret finger)
+ (list 'place-fret string fret))))))
+ string-frets)
(vector->list placements)))
(define (placement-list->string-frets placement-list)
@@ -289,12 +289,12 @@ if no string-number is present."
(and (integer? num) (positive? num) num)))
(define (determine-frets-and-strings
- notes
- defined-strings
- defined-fingers
- minimum-fret
- maximum-stretch
- tuning)
+ notes
+ defined-strings
+ defined-fingers
+ minimum-fret
+ maximum-stretch
+ tuning)
"Determine the frets and strings used to play the notes in
@var{notes}, given @var{defined-strings} and @var{defined-fingers}
along with @var{minimum-fret}, @var{maximum-stretch}, and
@@ -302,8 +302,8 @@ along with @var{minimum-fret}, @var{maximum-stretch}, and
(define restrain-open-strings (ly:context-property context
- 'restrainOpenStrings
- #f))
+ 'restrainOpenStrings
+ #f))
(define specified-frets '())
(define free-strings (iota (length tuning) 1))
@@ -320,21 +320,21 @@ along with @var{minimum-fret}, @var{maximum-stretch}, and
"Get the fingering from @var{ev}. Return @var{#f}
if no fingering is present."
(let* ((articulations (ly:event-property ev 'articulations))
- (finger-found #f))
- (map (lambda (art)
- (let* ((num (ly:event-property art 'digit)))
+ (finger-found #f))
+ (map (lambda (art)
+ (let* ((num (ly:event-property art 'digit)))
- (if (and (ly:in-event-class? art 'fingering-event)
- (number? num)
- (> num 0))
- (set! finger-found num))))
- articulations)
- finger-found))
+ (if (and (ly:in-event-class? art 'fingering-event)
+ (number? num)
+ (> num 0))
+ (set! finger-found num))))
+ articulations)
+ finger-found))
(define (delete-free-string string)
(if (number? string)
- (set! free-strings
- (delete string free-strings))))
+ (set! free-strings
+ (delete string free-strings))))
(define (close-enough fret)
"Decide if @var{fret} is acceptable, given the already used frets."
@@ -348,29 +348,29 @@ if no fingering is present."
"Can @var{pitch} be played on @var{string}, given already placed
notes?"
(let* ((fret (calc-fret pitch string tuning)))
- (and (or (and (not restrain-open-strings)
- (zero? fret))
- (>= fret minimum-fret))
- (integer? fret)
- (close-enough fret))))
+ (and (or (and (not restrain-open-strings)
+ (zero? fret))
+ (>= fret minimum-fret))
+ (integer? fret)
+ (close-enough fret))))
(define (open-string string pitch)
"Is @var{pitch} and open-string note on @var{string}, given
the current tuning?"
(let* ((fret (calc-fret pitch string tuning)))
- (zero? fret)))
+ (zero? fret)))
(define (set-fret! pitch-entry string finger)
(let ((this-fret (calc-fret (car pitch-entry)
- string
- tuning)))
- (if (< this-fret 0)
- (ly:warning (_ "Negative fret for pitch ~a on string ~a")
- (car pitch-entry) string)
- (if (not (integer? this-fret))
- (ly:warning (_ "Missing fret for pitch ~a on string ~a")
- (car pitch-entry) string)))
- (delete-free-string string)
+ string
+ tuning)))
+ (if (< this-fret 0)
+ (ly:warning (_ "Negative fret for pitch ~a on string ~a")
+ (car pitch-entry) string)
+ (if (not (integer? this-fret))
+ (ly:warning (_ "Missing fret for pitch ~a on string ~a")
+ (car pitch-entry) string)))
+ (delete-free-string string)
(set! specified-frets (cons this-fret specified-frets))
(list-set! string-fret-fingers
(cdr pitch-entry)
@@ -380,11 +380,11 @@ the current tuning?"
(list-set! string-fret-fingers note-index (list #f #t)))
(define string-fret-fingers
- (map (lambda (string finger)
- (if (null? finger)
- (list string #f)
- (list string #f finger)))
- defined-strings defined-fingers))
+ (map (lambda (string finger)
+ (if (null? finger)
+ (list string #f)
+ (list string #f finger)))
+ defined-strings defined-fingers))
;;; body of determine-frets-and-strings
(let* ((pitches (map note-pitch notes))
@@ -392,87 +392,87 @@ the current tuning?"
;; handle notes with strings assigned and fingering of 0
(for-each
- (lambda (pitch-entry string-fret-finger)
- (let* ((string (list-ref string-fret-finger 0))
- (finger (if (= (length string-fret-finger) 3)
- (list-ref string-fret-finger 2)
- '()))
- (pitch (car pitch-entry))
- (digit (if (null? finger)
- #f
- finger)))
- (if (or (not (null? string))
- (eqv? digit 0))
- (if (eqv? digit 0)
- ;; here we handle fingers of 0 -- open strings
- (let ((fit-string
- (find (lambda (string)
- (open-string string pitch))
- free-strings)))
- (if fit-string
- (set-fret! pitch-entry fit-string #f)
- (ly:warning (_ "No open string for pitch ~a")
- pitch)))
- ;; here we handle assigned strings
- (let ((this-fret
- (calc-fret pitch string tuning))
- (handle-negative
- (ly:context-property context
- 'handleNegativeFrets
- 'recalculate)))
- (cond ((or (and (>= this-fret 0) (integer? this-fret))
- (eq? handle-negative 'include))
- (set-fret! pitch-entry string finger))
- ((eq? handle-negative 'recalculate)
- (begin
- (ly:warning
- (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
- string
- pitch)
- (ly:warning (_ "Ignoring string request and recalculating."))
- (list-set! string-fret-fingers
- (cdr pitch-entry)
- (if (null? finger)
- (list '() #f)
- (list '() #f finger)))))
- ((eq? handle-negative 'ignore)
- (begin
- (ly:warning
- (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
- string
- pitch)
- (ly:warning (_ "Ignoring note in tablature."))
- (kill-note! string-fret-fingers
- (cdr pitch-entry))))))))))
- pitch-alist string-fret-fingers)
- ;; handle notes without strings assigned -- sorted by pitch, so
- ;; we need to use the alist to have the note number available
- (for-each
- (lambda (pitch-entry)
- (let* ((string-fret-finger (list-ref string-fret-fingers
- (cdr pitch-entry)))
- (string (list-ref string-fret-finger 0))
- (finger (if (= (length string-fret-finger) 3)
- (list-ref string-fret-finger 2)
- '()))
- (pitch (car pitch-entry))
- (fit-string
- (find (lambda (string)
- (string-qualifies string pitch))
- free-strings)))
- (if (not (list-ref string-fret-finger 1))
- (if fit-string
- (set-fret! pitch-entry fit-string finger)
- (begin
- (ly:warning (_ "No string for pitch ~a (given frets ~a)")
- pitch
- specified-frets)
- (kill-note! string-fret-fingers
- (cdr pitch-entry)))))))
- (sort pitch-alist (lambda (pitch-entry-a pitch-entry-b)
- (ly:pitch<? (car pitch-entry-b)
- (car pitch-entry-a)))))
- string-fret-fingers)) ;; end of determine-frets-and-strings
+ (lambda (pitch-entry string-fret-finger)
+ (let* ((string (list-ref string-fret-finger 0))
+ (finger (if (= (length string-fret-finger) 3)
+ (list-ref string-fret-finger 2)
+ '()))
+ (pitch (car pitch-entry))
+ (digit (if (null? finger)
+ #f
+ finger)))
+ (if (or (not (null? string))
+ (eqv? digit 0))
+ (if (eqv? digit 0)
+ ;; here we handle fingers of 0 -- open strings
+ (let ((fit-string
+ (find (lambda (string)
+ (open-string string pitch))
+ free-strings)))
+ (if fit-string
+ (set-fret! pitch-entry fit-string #f)
+ (ly:warning (_ "No open string for pitch ~a")
+ pitch)))
+ ;; here we handle assigned strings
+ (let ((this-fret
+ (calc-fret pitch string tuning))
+ (handle-negative
+ (ly:context-property context
+ 'handleNegativeFrets
+ 'recalculate)))
+ (cond ((or (and (>= this-fret 0) (integer? this-fret))
+ (eq? handle-negative 'include))
+ (set-fret! pitch-entry string finger))
+ ((eq? handle-negative 'recalculate)
+ (begin
+ (ly:warning
+ (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
+ string
+ pitch)
+ (ly:warning (_ "Ignoring string request and recalculating."))
+ (list-set! string-fret-fingers
+ (cdr pitch-entry)
+ (if (null? finger)
+ (list '() #f)
+ (list '() #f finger)))))
+ ((eq? handle-negative 'ignore)
+ (begin
+ (ly:warning
+ (_ "Requested string for pitch requires negative fret: string ~a pitch ~a")
+ string
+ pitch)
+ (ly:warning (_ "Ignoring note in tablature."))
+ (kill-note! string-fret-fingers
+ (cdr pitch-entry))))))))))
+ pitch-alist string-fret-fingers)
+ ;; handle notes without strings assigned -- sorted by pitch, so
+ ;; we need to use the alist to have the note number available
+ (for-each
+ (lambda (pitch-entry)
+ (let* ((string-fret-finger (list-ref string-fret-fingers
+ (cdr pitch-entry)))
+ (string (list-ref string-fret-finger 0))
+ (finger (if (= (length string-fret-finger) 3)
+ (list-ref string-fret-finger 2)
+ '()))
+ (pitch (car pitch-entry))
+ (fit-string
+ (find (lambda (string)
+ (string-qualifies string pitch))
+ free-strings)))
+ (if (not (list-ref string-fret-finger 1))
+ (if fit-string
+ (set-fret! pitch-entry fit-string finger)
+ (begin
+ (ly:warning (_ "No string for pitch ~a (given frets ~a)")
+ pitch
+ specified-frets)
+ (kill-note! string-fret-fingers
+ (cdr pitch-entry)))))))
+ (sort pitch-alist (lambda (pitch-entry-a pitch-entry-b)
+ (ly:pitch<? (car pitch-entry-b)
+ (car pitch-entry-a)))))
+ string-fret-fingers)) ;; end of determine-frets-and-strings
(define (get-predefined-fretboard predefined-fret-table tuning pitches)
"Search through @var{predefined-fret-table} looking for a predefined
@@ -482,31 +482,31 @@ chords. Returns a placement-list."
(define (get-fretboard key)
(let ((hash-handle
- (hash-get-handle predefined-fret-table key)))
- (if hash-handle
- (cdr hash-handle) ; return table entry
- '())))
+ (hash-get-handle predefined-fret-table key)))
+ (if hash-handle
+ (cdr hash-handle) ; return table entry
+ '())))
;; body of get-predefined-fretboard
(let ((test-fretboard (get-fretboard (cons tuning pitches))))
(if (not (null? test-fretboard))
- test-fretboard
- (let ((test-fretboard
- (get-fretboard
- (cons tuning (map (lambda (x) (shift-octave x 1)) pitches)))))
- (if (not (null? test-fretboard))
- test-fretboard
- (get-fretboard
- (cons tuning (map (lambda (x) (shift-octave x -1))
- pitches))))))))
+ test-fretboard
+ (let ((test-fretboard
+ (get-fretboard
+ (cons tuning (map (lambda (x) (shift-octave x 1)) pitches)))))
+ (if (not (null? test-fretboard))
+ test-fretboard
+ (get-fretboard
+ (cons tuning (map (lambda (x) (shift-octave x -1))
+ pitches))))))))
;; body of determine-frets
(let* ((predefined-fret-table
- (ly:context-property context 'predefinedDiagramTable))
+ (ly:context-property context 'predefinedDiagramTable))
(tunings (ly:context-property context 'stringTunings))
(string-count (length tunings))
(grob (if (null? rest) '() (car rest)))
- (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))
+ (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))
(defined-strings (map (lambda (x)
(if (null? x)
x
@@ -529,26 +529,26 @@ chords. Returns a placement-list."
tunings
pitches)
'())))
- (if (null? predefined-fretboard)
- (let ((string-frets
- (determine-frets-and-strings
- notes
- strings-used
- defined-fingers
- (ly:context-property context 'minimumFret 0)
- (ly:context-property context 'maximumFretStretch 4)
- tunings)))
- (if (null? grob)
- string-frets
- (create-fretboard
- context grob (string-frets->placement-list
- (filter (lambda (entry)
- (car entry))
- string-frets)
- string-count))))
- (if (null? grob)
- (placement-list->string-frets predefined-fretboard)
- (create-fretboard context grob predefined-fretboard)))))
+ (if (null? predefined-fretboard)
+ (let ((string-frets
+ (determine-frets-and-strings
+ notes
+ strings-used
+ defined-fingers
+ (ly:context-property context 'minimumFret 0)
+ (ly:context-property context 'maximumFretStretch 4)
+ tunings)))
+ (if (null? grob)
+ string-frets
+ (create-fretboard
+ context grob (string-frets->placement-list
+ (filter (lambda (entry)
+ (car entry))
+ string-frets)
+ string-count))))
+ (if (null? grob)
+ (placement-list->string-frets predefined-fretboard)
+ (create-fretboard context grob predefined-fretboard)))))
@@ -561,24 +561,24 @@ chords. Returns a placement-list."
;; The fret letter is taken from 'fretLabels if present
(define-public (fret-letter-tablature-format
context string-number fret-number)
- (let ((labels (ly:context-property context 'fretLabels)))
- (make-vcenter-markup
- (cond
- ((= 0 (length labels))
- (string (integer->char (+ fret-number (char->integer #\a)))))
- ((and (<= 0 fret-number) (< fret-number (length labels)))
- (list-ref labels fret-number))
- (else
- (ly:warning (_ "No label for fret ~a (on string ~a);
+ (let ((labels (ly:context-property context 'fretLabels)))
+ (make-vcenter-markup
+ (cond
+ ((= 0 (length labels))
+ (string (integer->char (+ fret-number (char->integer #\a)))))
+ ((and (<= 0 fret-number) (< fret-number (length labels)))
+ (list-ref labels fret-number))
+ (else
+ (ly:warning (_ "No label for fret ~a (on string ~a);
only ~a fret labels provided")
- fret-number string-number (length labels))
- ".")))))
+ fret-number string-number (length labels))
+ ".")))))
;; Display the fret number as a number
(define-public (fret-number-tablature-format
context string-number fret-number)
(make-vcenter-markup
- (format #f "~a" fret-number)))
+ (format #f "~a" fret-number)))
;; The 5-string banjo has got a extra string, the fifth (duh), which
;; starts at the fifth fret on the neck. Frets on the fifth string
@@ -588,11 +588,11 @@ only ~a fret labels provided")
;; We solve this by defining a new fret-number-tablature function:
(define-public (fret-number-tablature-format-banjo
context string-number fret-number)
- (make-vcenter-markup
- (number->string (cond
- ((and (> fret-number 0) (= string-number 5))
- (+ fret-number 5))
- (else fret-number)))))
+ (make-vcenter-markup
+ (number->string (cond
+ ((and (> fret-number 0) (= string-number 5))
+ (+ fret-number 5))
+ (else fret-number)))))
;; Tab note head staff position functions
;;
@@ -601,13 +601,13 @@ only ~a fret labels provided")
;; lines
(define-public (tablature-position-on-lines context string-number)
- (let* ((string-tunings (ly:context-property context 'stringTunings))
- (string-count (length string-tunings))
- (string-one-topmost (ly:context-property context 'stringOneTopmost))
- (staff-line (- (* 2 string-number) string-count 1)))
- (if string-one-topmost
- (- staff-line)
- staff-line)))
+ (let* ((string-tunings (ly:context-property context 'stringTunings))
+ (string-count (length string-tunings))
+ (string-one-topmost (ly:context-property context 'stringOneTopmost))
+ (staff-line (- (* 2 string-number) string-count 1)))
+ (if string-one-topmost
+ (- staff-line)
+ staff-line)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; bar numbers
@@ -621,7 +621,7 @@ only ~a fret labels provided")
(define-public ((set-bar-number-visibility n) tr)
(let ((bn (ly:context-property tr 'currentBarNumber)))
(ly:context-set-property! tr 'barNumberVisibility
- (modulo-bar-number-visible n (modulo bn n)))))
+ (modulo-bar-number-visible n (modulo bn n)))))
(define-public (first-bar-number-invisible barnum mp)
(> barnum 1))
@@ -641,14 +641,14 @@ only ~a fret labels provided")
(cons (+ alt-number (- (expt 26 pow) an)) (1- pow))))
(define (make-letter so-far an pow)
(if (< pow 0)
- so-far
- (let ((pos (modulo (quotient an (expt 26 pow)) 26)))
- (make-letter (string-append so-far
- (substring "abcdefghijklmnopqrstuvwxyz"
- pos
- (1+ pos)))
- an
- (1- pow)))))
+ so-far
+ (let ((pos (modulo (quotient an (expt 26 pow)) 26)))
+ (make-letter (string-append so-far
+ (substring "abcdefghijklmnopqrstuvwxyz"
+ pos
+ (1+ pos)))
+ an
+ (1- pow)))))
(let* ((number-and-power (get-number-and-power 0 0))
(begin-measure (= 0 (ly:moment-main-numerator measure-pos)))
(maybe-open-parenthesis (if begin-measure "" "("))
@@ -699,10 +699,10 @@ event classes, and @code{acknowledgers} and @code{end-acknowledgers}
with the subordinate symbols being interfaces."
(let loop ((forms forms))
(if (cheap-list? forms)
- `(list
- ,@(map (lambda (form)
- (if (pair? (car form))
- `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form)))
- `(cons ',(car form) ,(loop (cdr form)))))
- forms))
- forms)))
+ `(list
+ ,@(map (lambda (form)
+ (if (pair? (car form))
+ `(cons ',(caar form) (lambda ,(cdar form) ,@(cdr form)))
+ `(cons ',(car form) ,(loop (cdr form)))))
+ forms))
+ forms)))
diff --git a/scm/x11-color.scm b/scm/x11-color.scm
index 5be7657292..f3d65b90c2 100644
--- a/scm/x11-color.scm
+++ b/scm/x11-color.scm
@@ -15,7 +15,7 @@
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-(define x11-color-list
+(define x11-color-list
'((snow 1 0.98039215686274506 0.98039215686274506)
(GhostWhite 0.97254901960784312 0.97254901960784312 1)
(WhiteSmoke 0.96078431372549022 0.96078431372549022 0.96078431372549022)
@@ -677,32 +677,32 @@
(define (make-x11-color-handler)
(let
((x11-color-table (make-hash-table 31)))
-
+
(lambda (arg)
- (let*
- ((arg-sym (if (string? arg)
- (if (string-index arg #\ )
- (let
- ((arg-list (string-split (string-capitalize arg) #\ )))
+ (let*
+ ((arg-sym (if (string? arg)
+ (if (string-index arg #\ )
+ (let
+ ((arg-list (string-split (string-capitalize arg) #\ )))
+
+ (string->symbol
+ (let append-all ((x arg-list))
+ (if (null? x)
+ ""
+ (string-append (car x) (append-all (cdr x)))))))
+
+ (string->symbol arg))
+ arg))
+
+ (temp (hashq-ref x11-color-table arg-sym)))
+
+ (if temp
+ temp
+ (let*
+ ((temp-1 (assq-ref x11-color-list arg-sym))
+ (temp (if temp-1 temp-1 '(0 0 0))))
- (string->symbol
- (let append-all ((x arg-list))
- (if (null? x)
- ""
- (string-append (car x) (append-all (cdr x)))))))
-
- (string->symbol arg))
- arg))
-
- (temp (hashq-ref x11-color-table arg-sym)))
-
- (if temp
- temp
- (let*
- ((temp-1 (assq-ref x11-color-list arg-sym))
- (temp (if temp-1 temp-1 '(0 0 0))))
-
- (hashq-create-handle! x11-color-table arg-sym temp)
- temp))))))
+ (hashq-create-handle! x11-color-table arg-sym temp)
+ temp))))))
(define-public x11-color (make-x11-color-handler))