% -*-Scheme-*-
-\version "2.6.0"
+\version "2.7.32"
%% need SRFI-1 filter
#(use-modules (srfi srfi-1))
+
+tweak = #(def-music-function (parser location sym val arg)
+ (symbol? scheme? ly:music?)
+
+ "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
+
+
+ (set!
+ (ly:music-property arg 'tweaks)
+ (acons sym val
+ (ly:music-property arg 'tweaks)))
+ arg)
+
+tag = #(def-music-function (parser location tag arg)
+ (symbol? ly:music?)
+
+ "Add @var{tag} to the @code{tags} property of @var{arg}."
+
+ (set!
+ (ly:music-property arg 'tags)
+ (cons tag
+ (ly:music-property arg 'tags)))
+ arg)
+
+clef =
+#(def-music-function (parser location type)
+ (string?)
+
+ "Set the current clef."
+
+ (make-clef-set type))
+
+bar =
+#(def-music-function (parser location type)
+ (string?)
+ (context-spec-music
+ (make-property-set 'whichBar type)
+ 'Timing))
+
applyMusic =
#(def-music-function (parser location func music) (procedure? ly:music?)
(func music))
'origin location
'procedure proc))
-outputProperty =
+overrideProperty =
#(def-music-function (parser location name property value)
(string? symbol? scheme?)
cbn n))))))
-%{
-
-TODO:
-
-remove these from the parser, and softcode here:
-
- * \tag
-with small syntax changes, we could also do
-
- * \bar
- * ?
+% for regression testing purposes.
+assertBeamQuant =
+#(def-music-function (parser location l r) (pair? pair?)
+ (make-grob-property-override 'Beam 'positions
+ (ly:make-simple-closure
+ (ly:make-simple-closure
+ (append
+ (list chain-grob-member-functions `(,cons 0 0))
+ (check-quant-callbacks l r))))))
+
+% for regression testing purposes.
+assertBeamSlope =
+#(def-music-function (parser location comp) (procedure?)
+ (make-grob-property-override 'Beam 'positions
+ (ly:make-simple-closure
+ (ly:make-simple-closure
+ (append
+ (list chain-grob-member-functions `(,cons 0 0))
+ (check-slope-callbacks comp))))))
+
+
+parallelMusic =
+#(def-music-function (parser location voice-ids music) (list? ly:music?)
+ "Define parallel music sequences, separated by '|' (bar check signs),
+and assign them to the identifiers provided in @var{voice-ids}.
+
+@var{voice-ids}: a list of music identifiers (symbols containing only letters)
+
+@var{music}: a music sequence, containing BarChecks as limiting expressions.
+
+Example:
+ \\parallelMusic #'(A B C) {
+ c c | d d | e e |
+ d d | e e | f f |
+ }
+<==>
+ A = { c c | d d | }
+ B = { d d | e e | }
+ C = { e e | f f | }
+"
+ (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
+ (current-voices voices)
+ (current-sequence (list)))
+ ;;
+ ;; utilities
+ (define (push-music m)
+ "Push the music expression into the current sequence"
+ (set! current-sequence (cons m current-sequence)))
+ (define (change-voice)
+ "Stores the previously built sequence into the current voice and
+ change to the following voice."
+ (list-set! current-voices 0 (cons (make-music 'SequentialMusic
+ 'elements (reverse! current-sequence))
+ (car current-voices)))
+ (set! current-sequence (list))
+ (set! current-voices (cdr current-voices)))
+ (define (bar-check? m)
+ "Checks whether m is a bar check."
+ (eq? (ly:music-property m 'name) 'BarCheck))
+ (define (music-origin music)
+ "Recursively search an origin location stored in music."
+ (cond ((null? music) #f)
+ ((not (null? (ly:music-property music 'origin)))
+ (ly:music-property music 'origin))
+ (else (or (music-origin (ly:music-property music 'element))
+ (let ((origins (remove not (map music-origin
+ (ly:music-property music 'elements)))))
+ (and (not (null? origins)) (car origins)))))))
+ ;;
+ ;; first, split the music and fill in voices
+ (map-in-order (lambda (m)
+ (push-music m)
+ (if (bar-check? m) (change-voice)))
+ (ly:music-property music 'elements))
+ (if (not (null? current-sequence)) (change-voice))
+ ;; un-circularize `voices' and reorder the voices
+ (set! voices (map-in-order (lambda (dummy seqs)
+ (reverse! seqs))
+ voice-ids voices))
+ ;;
+ ;; set origin location of each sequence in each voice
+ ;; for better type error tracking
+ (for-each (lambda (voice)
+ (for-each (lambda (seq)
+ (set! (ly:music-property seq 'origin)
+ (or (music-origin seq) location)))
+ voice))
+ voices)
+ ;;
+ ;; check sequence length
+ (apply for-each (lambda (. seqs)
+ (let ((moment-reference (ly:music-length (car seqs))))
+ (for-each (lambda (seq moment)
+ (if (not (equal? moment moment-reference))
+ (ly:music-message seq
+ "Bars in parallel music don't have the same length")))
+ seqs (map-in-order ly:music-length seqs))))
+ voices)
+ ;;
+ ;; bind voice identifiers to the voices
+ (map (lambda (voice-id voice)
+ (ly:parser-define! parser voice-id
+ (make-music 'SequentialMusic
+ 'origin location
+ 'elements voice)))
+ voice-ids voices))
+ ;; Return an empty sequence. this function is actually a "void" function.
+ (make-music 'SequentialMusic 'void #t))
+
+
+
+
+%% this is a stub. Write your own to suit the spacing tweak output.
+spacingTweaks =
+#(def-music-function (parser location parameters) (list?)
+ (make-music 'SequentialMusic 'void #t))
+
+octave =
+#(def-music-function (parser location pitch-note) (ly:music?)
+ "octave check"
+
+ (make-music 'RelativeOctaveCheck
+ 'origin location
+ 'pitch (pitch-of-note pitch-note)
+ ))
-%}
+addquote =
+#(def-music-function (parser location name music) (string? ly:music?)
+ "Add a piece of music to be quoted "
+ (add-quotable name music)
+ (make-music 'SequentialMusic 'void #t))
+
projects / lilypond.git / blobdiff