;;;; 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))
(use-modules (ice-9 optargs))
Fingering
LaissezVibrerTie
LigatureBracket
+ MultiMeasureRest
PhrasingSlur
RepeatTie
Rest
(Voice Fingering font-size -8)
(Voice StringNumber font-size -8)))
- (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
- (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4))))))
+ (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))))))
+
(define-safe-public (make-voice-props-override n)
(make-sequential-music
(if (ly:music? e)
(set! (ly:music-property m 'element) (voicify-music e)))
(if (and (equal? (ly:music-property m 'name) 'SimultaneousMusic)
- (reduce (lambda (x y ) (or x y)) #f (map music-separator? es)))
+ (any music-separator? es))
(set! m (context-spec-music (voicify-chord m) 'Staff)))
m))
(define-public (music-has-type music type)
(memq type (ly:music-property music 'types)))
-(define-public (music-clone music)
- (define (alist->args alist acc)
- (if (null? alist)
- acc
- (alist->args (cdr alist)
- (cons (caar alist) (cons (cdar alist) acc)))))
-
- (apply
- make-music
- (ly:music-property music 'name)
- (alist->args (ly:music-mutable-properties music) '())))
+(define-public (music-clone music . music-properties)
+ "Clone @var{music} and set properties according to
+@var{music-properties}, a list of alternating property symbols and
+values:
+@example\n(music-clone start-span 'span-direction STOP)
+@end example
+Only properties that are not overriden by @var{music-properties} are
+actually fully cloned."
+ (let ((old-props (list-copy (ly:music-mutable-properties music)))
+ (new-props '())
+ (m (ly:make-music (ly:prob-immutable-properties music))))
+ (define (set-props mus-props)
+ (if (and (not (null? mus-props))
+ (not (null? (cdr mus-props))))
+ (begin
+ (set! old-props (assq-remove! old-props (car mus-props)))
+ (set! new-props
+ (assq-set! new-props
+ (car mus-props) (cadr mus-props)))
+ (set-props (cddr mus-props)))))
+ (set-props music-properties)
+ (for-each
+ (lambda (pair)
+ (set! (ly:music-property m (car pair))
+ (ly:music-deep-copy (cdr pair))))
+ old-props)
+ (for-each
+ (lambda (pair)
+ (set! (ly:music-property m (car pair)) (cdr pair)))
+ new-props)
+ m))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; warn for bare chords at start.
(map (lambda (x) (ly:music-property x 'pitch))
(event-chord-notes event-chord)))
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; The following functions are all associated with the crossStaff
-; function
+(defmacro-public make-relative (pitches last-pitch music)
+ "The list of pitch-carrying variables in @var{pitches} is used as a
+sequence for creating relativable music from @var{music}.
+The variables in @var{pitches} are, when considered inside of
+@code{\\relative}, all considered to be specifications to the preceding
+variable. The first variable is relative to the preceding musical
+context, and @var{last-pitch} specifies the pitch passed as relative
+base onto the following musical context."
+
+ ;; pitch and music generator might be stored instead in music
+ ;; properties, and it might make sense to create a music type of its
+ ;; own for this kind of construct rather than using
+ ;; RelativeOctaveMusic
+ (define ((make-relative::to-relative-callback pitches p->m p->p) music pitch)
+ (let* ((chord (make-event-chord
+ (map
+ (lambda (p)
+ (make-music 'NoteEvent
+ 'pitch p))
+ pitches)))
+ (pitchout (begin
+ (ly:make-music-relative! chord pitch)
+ (event-chord-pitches chord))))
+ (set! (ly:music-property music 'element)
+ (apply p->m pitchout))
+ (apply p->p pitchout)))
+ `(make-music 'RelativeOctaveMusic
+ 'to-relative-callback
+ (,make-relative::to-relative-callback
+ (list ,@pitches)
+ (lambda ,pitches ,music)
+ (lambda ,pitches ,last-pitch))
+ 'element ,music))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; The following functions are all associated with the crossStaff
+;; function
(define (close-enough? x y)
"Values are close enough to ignore the difference"
(define ((stem-connectable? ref root) stem)
"Check if the stem is connectable to the root"
- ; The root is always connectable to itself
+ ;; The root is always connectable to itself
(or (eq? root stem)
(and
- ; Horizontal positions of the stems must be almost the same
+ ;; 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
+ ;; 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))))))))
(yextent (extent-combine yextents))
(layout (ly:grob-layout root))
(blot (ly:output-def-lookup layout 'blot-diameter)))
- ; Hide spanned stems
+ ;; Hide spanned stems
(map (lambda (st)
- (set! (ly:grob-property st 'transparent) #t))
+ (set! (ly:grob-property st 'stencil) #f))
stems)
- ; Draw a nice looking stem with rounded corners
+ ;; 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
+ ;; Nothing to connect, don't draw the span
#f)))
(define ((make-stem-span! stems trans) root)
(let ((span (ly:engraver-make-grob trans 'Stem '())))
(ly:grob-set-parent! span X root)
(set! (ly:grob-object span 'stems) stems)
- ; Suppress positioning, the stem code is confused by this weird stem
+ ;; Suppress positioning, the stem code is confused by this weird stem
(set! (ly:grob-property span 'X-offset) 0)
(set! (ly:grob-property span 'stencil) stem-span-stencil)))
(define (make-stem-spans! ctx stems trans)
"Create stem spans for cross-staff stems"
- ; Cannot do extensive checks here, just make sure there are at least
- ; two stems at this musical moment
+ ;; 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))))
"Connect cross-staff stems to the stems above in the system"
(let ((stems '()))
(make-engraver
- ; Record all stems for the given moment
+ ;; 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 stems and reset the stem list to empty
((process-acknowledged trans)
(make-stem-spans! ctx stems trans)
(set! stems '())))))
(siblings (ly:spanner-broken-into orig)) ; have we been split?
(bounds (ly:grob-array->list (ly:grob-object grob 'columns)))
(refp (ly:grob-system grob))
- ; we use the first and/or last NonMusicalPaperColumn grob(s) of
- ; a system in the event that a MeasureCounter spanner is broken
+ ;; we use the first and/or last NonMusicalPaperColumn grob(s) of
+ ;; 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
projects / lilypond.git / blobdiff