From 74d8640adb88d2775b1b3033db37f4ca24c5e929 Mon Sep 17 00:00:00 2001 From: Carl Sorensen Date: Wed, 4 Aug 2010 20:28:58 -0600 Subject: [PATCH] Fix 1198: Fix displayLilyMusic for \time and #(set-time-signature) create TimeSignatureMusic to allow the display to work properly * scm/define-music-callbacks.scm Create a new file for music callbacks that are used by iterators to create music events. Moved multimeasure rest and ottava callbacks from scm/define-music-types.scm. Added callback for TimeSignatureMusic. * scm/define-music-display-methods.scm define a display method for TimeSignatureMusic remove extra-display-methods for ContextSpeccedMusic and Timing that caught \time * scm/define-music-properties.scm define beat-structure as a music property * scm/define-music-types.scm Move callbacks for multimeasure rests and ottava to scm/define-music-callbacks.scm add TimeSignatureMusic * scm/lily.scm Add scm/define-music-callbacks.scm to load list * scm/music-functions.scm replace calls to make-beam-rule-time-signature-set with calls to make-music 'TimeSignatureMusic --- scm/define-music-callbacks.scm | 90 ++++++++++++++++++++++++++++ scm/define-music-display-methods.scm | 81 +++++++++++++++---------- scm/define-music-properties.scm | 1 + scm/define-music-types.scm | 39 +++--------- scm/lily.scm | 1 + scm/music-functions.scm | 12 ++-- 6 files changed, 155 insertions(+), 69 deletions(-) create mode 100644 scm/define-music-callbacks.scm diff --git a/scm/define-music-callbacks.scm b/scm/define-music-callbacks.scm new file mode 100644 index 0000000000..fbb8278904 --- /dev/null +++ b/scm/define-music-callbacks.scm @@ -0,0 +1,90 @@ +;;;; This file is part of LilyPond, the GNU music typesetter. +;;;; +;;;; Copyright (C) 1998--2010 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen +;;;; Neil Puttock +;;;; Carl Sorensen +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . + +;; TODO: should link back into user manual. + +(define (mm-rest-child-list music) + "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))) + (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)))) + +(define (make-ottava-set music) + "Set context properties for an ottava bracket." + (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)))) + +(define (make-time-signature-set music) + "Set context properties for a time signature." + (let* ((arguments (ly:music-property music 'time-signature-arguments)) + (num (car arguments)) + (den (cadr arguments)) + (rest (caddr arguments)) + (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-fraction + (base-fraction fraction time-signature-settings)) + (my-beat-structure + (if (null? rest) + (beat-structure my-base-fraction + fraction + time-signature-settings) + rest)) + (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 (fraction->moment my-base-fraction)) + (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 0ee424018b..ec044217dc 100644 --- a/scm/define-music-display-methods.scm +++ b/scm/define-music-display-methods.scm @@ -883,6 +883,21 @@ Otherwise, return #f." properties) (new-line->lily-string)))) +(define-display-method TimeSignatureMusic (expr parser) + (let* ((arguments (ly:music-property expr 'time-signature-arguments)) + (num (car arguments)) + (den (cadr arguments)) + (rest (caddr arguments))) + (if (null? rest) + (format #f + "\\time ~a/~a~a" + num den + (new-line->lily-string)) + (format #f + "#(set-time-signature ~a ~a ~a)~a" + num den rest + (new-line->lily-string))))) + ;;; \melisma and \melismaEnd (define-extra-display-method ContextSpeccedMusic (expr parser) "If expr is a melisma, return \"\\melisma\", otherwise, return #f." @@ -988,39 +1003,39 @@ Otherwise, return #f." #f)))) ;;; \time -(define-extra-display-method ContextSpeccedMusic (expr parser) - "If `expr' is a time signature set, return \"\\time ...\". -Otherwise, return #f. Note: default grouping is not available." - (with-music-match - (expr (music - 'ContextSpeccedMusic - element (music - 'ContextSpeccedMusic - context-type 'Timing - element (music - 'SequentialMusic - elements ?elts)))) - (and - (> (length ?elts) 2) - (with-music-match ((cadr ?elts) - (music 'PropertySet - symbol 'baseMoment)) - #t) - (with-music-match ((caddr ?elts) - (music 'PropertySet - symbol 'measureLength)) - #t) - (with-music-match ((car ?elts) - (music 'PropertySet - value ?num+den - symbol 'timeSignatureFraction)) - (if (eq? (length ?elts) 3) - (format - #f "\\time ~a/~a~a" - (car ?num+den) (cdr ?num+den) (new-line->lily-string)) - (format - #f "#(set-time-signature ~a ~a '())~a" - (car ?num+den) (cdr ?num+den) (new-line->lily-string))))))) +;(define-extra-display-method ContextSpeccedMusic (expr parser) +; "If `expr' is a time signature set, return \"\\time ...\". +;Otherwise, return #f. Note: default grouping is not available." +; (with-music-match +; (expr (music +; 'ContextSpeccedMusic +; element (music +; 'ContextSpeccedMusic +; context-type 'Timing +; element (music +; 'SequentialMusic +; elements ?elts)))) +; (and +; (> (length ?elts) 2) +; (with-music-match ((cadr ?elts) +; (music 'PropertySet +; symbol 'baseMoment)) +; #t) +; (with-music-match ((caddr ?elts) +; (music 'PropertySet +; symbol 'measureLength)) +; #t) +; (with-music-match ((car ?elts) +; (music 'PropertySet +; value ?num+den +; symbol 'timeSignatureFraction)) +; (if (eq? (length ?elts) 3) +; (format +; #f "\\time ~a/~a~a" +; (car ?num+den) (cdr ?num+den) (new-line->lily-string)) +; (format +; #f "#(set-time-signature ~a ~a '())~a" +; (car ?num+den) (cdr ?num+den) (new-line->lily-string))))))) ;;; \bar (define-extra-display-method ContextSpeccedMusic (expr parser) diff --git a/scm/define-music-properties.scm b/scm/define-music-properties.scm index 2694e48ec5..9f0b538cda 100644 --- a/scm/define-music-properties.scm +++ b/scm/define-music-properties.scm @@ -170,6 +170,7 @@ a @code{StringNumberEvent}.") in a part.") (tempo-unit ,ly:duration? "The unit for the metronome count.") (text ,markup? "Markup expression to be printed.") + (time-signature-arguments ,list? "The arguments to a time-signature call.") (to-relative-callback ,procedure? "How to transform a piece of music to relative pitches.") (tonic ,ly:pitch? "Base of the scale.") diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm index d9a5f09ac8..7f4525e001 100644 --- a/scm/define-music-types.scm +++ b/scm/define-music-types.scm @@ -18,38 +18,6 @@ ;; TODO: should link back into user manual. -(define (mm-rest-child-list music) - "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))) - (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)))) - -(define (make-ottava-set music) - "Set context properties for an ottava bracket." - (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)))) - (define-public music-descriptions `( (AbsoluteDynamicEvent @@ -623,6 +591,13 @@ Syntax: @code{\\times @var{fraction} @var{music}}, e.g., (types . (time-scaled-music music-wrapper-music general-music)) )) + (TimeSignatureMusic + . ((description . "Set a new time signature") + (iterator-ctor . ,ly:sequential-iterator::constructor) + (elements-callback . ,make-time-signature-set) + (types . (general-music time-signature-music)) + )) + (TransposedMusic . ((description . "Music that has been transposed.") (iterator-ctor . ,ly:music-wrapper-iterator::constructor) diff --git a/scm/lily.scm b/scm/lily.scm index 332f816b90..515ff2e02c 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -362,6 +362,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." '("lily-library.scm" "file-cache.scm" "define-event-classes.scm" + "define-music-callbacks.scm" "define-music-types.scm" "output-lib.scm" "c++.scm" diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 40c68c0c7d..5dfc7c3bcc 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -279,7 +279,7 @@ through MUSIC." 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 + ;; 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)))) @@ -494,15 +494,19 @@ i.e. this is not an override" ;;; Need to keep this definition for \time calls from parser (define-public (make-time-signature-set num den) "Set properties for time signature NUM/DEN." - (make-beam-rule-time-signature-set num den '())) + (make-music 'TimeSignatureMusic + 'time-signature-arguments + (list num den '()))) ;;; Used for calls that include beat-grouping setting (define-public (set-time-signature num den . rest) "Set properties for time signature @var{num/den}. If @var{rest} is present, it is used to set @code{beatStructure}." - (ly:export (apply make-beam-rule-time-signature-set - (list num den rest)))) + (ly:export + (make-music 'TimeSignatureMusic + 'time-signature-arguments + (list num den (if (null? rest) rest (car rest)))))) (define-public (make-beam-rule-time-signature-set num den rest) "Implement settings for new time signature. Can be -- 2.39.5