X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ly%2Fmusic-functions-init.ly;h=e914b70326435296f9968343badc6d16fa7f3b78;hb=8be47fcb0708d3c1d9f7749be6b89bcdb35c720a;hp=b2780027c72da8200d11510756dea89e831fc1f7;hpb=8b500afb9431f5471e385fa2eeb8fde868e4fc49;p=lilypond.git diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index b2780027c7..e914b70326 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -1,76 +1,95 @@ % -*-Scheme-*- -\version "2.7.39" +\version "2.10.0" -%% need SRFI-1 filter - -#(use-modules (srfi srfi-1)) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% this file is alphabetically sorted. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -tweak = #(define-music-function (parser location sym val arg) - (symbol? scheme? ly:music?) - - "Add @code{sym . val} to the @code{tweaks} property of @var{arg}." +%% need SRFI-1 filter - - (set! - (ly:music-property arg 'tweaks) - (acons sym val - (ly:music-property arg 'tweaks))) - arg) +#(use-modules (srfi srfi-1)) -tag = #(define-music-function (parser location tag arg) - (symbol? ly:music?) +acciaccatura = +#(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic) - "Add @var{tag} to the @code{tags} property of @var{arg}." +addQuote = +#(define-music-function (parser location name music) (string? ly:music?) + (_i "Add a piece of music to be quoted ") + (add-quotable parser name music) + (make-music 'SequentialMusic 'void #t)) - (set! - (ly:music-property arg 'tags) - (cons tag - (ly:music-property arg 'tags))) - arg) +afterGraceFraction = +#(cons 6 8) -clef = -#(define-music-function (parser location type) - (string?) - - "Set the current clef." +afterGrace = +#(define-music-function + (parser location main grace) + (ly:music? ly:music?) - (make-clef-set type)) + (let* + ((main-length (ly:music-length main)) + (fraction (ly:parser-lookup parser 'afterGraceFraction))) + + (make-simultaneous-music + (list + main + (make-sequential-music + (list -bar = -#(define-music-function (parser location type) - (string?) - (context-spec-music - (make-property-set 'whichBar type) - 'Timing)) + (make-music 'SkipMusic + 'duration (ly:make-duration + 0 0 + (* (ly:moment-main-numerator main-length) + (car fraction)) + (* (ly:moment-main-denominator main-length) + (cdr fraction)) )) + (make-music 'GraceMusic + 'element grace))))))) applyMusic = #(define-music-function (parser location func music) (procedure? ly:music?) (func music)) -oldaddlyrics = -#(define-music-function (parser location music lyrics) (ly:music? ly:music?) - - (make-music 'OldLyricCombineMusic - 'origin location - 'elements (list music lyrics))) -grace = -#(def-grace-function startGraceMusic stopGraceMusic) +applyOutput = +#(define-music-function (parser location ctx proc) (symbol? procedure?) + (make-music 'ApplyOutputEvent + 'origin location + 'procedure proc + 'context-type ctx)) -acciaccatura = -#(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic) appoggiatura = #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic) -partcombine = -#(define-music-function (parser location part1 part2) (ly:music? ly:music?) - (make-part-combine-music (list part1 part2))) + + +% for regression testing purposes. +assertBeamQuant = +#(define-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 = +#(define-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)))))) + + autochange = #(define-music-function (parser location music) (ly:music?) - (make-autochange-music music)) + (make-autochange-music parser music)) applyContext = #(define-music-function (parser location proc) (procedure?) @@ -78,105 +97,161 @@ applyContext = 'origin location 'procedure proc)) -shiftDurations = -#(define-music-function (parser location dur dots arg) (integer? integer? ly:music?) - "" +balloonText = +#(define-music-function (parser location offset text) (number-pair? markup?) - (music-map - (lambda (x) - (shift-one-duration-log x dur dots)) arg)) + (make-music 'AnnotateOutputEvent + 'X-offset (car offset) + 'Y-offset (cdr offset) + 'text text)) -musicMap = -#(define-music-function (parser location proc mus) (procedure? ly:music?) - (music-map proc mus)) +balloonGrobText = +#(define-music-function (parser location grob-name offset text) (symbol? number-pair? markup?) + + (make-music 'AnnotateOutputEvent + 'symbol grob-name + 'X-offset (car offset) + 'Y-offset (cdr offset) + 'text text)) -displayMusic = -#(define-music-function (parser location music) (ly:music?) - (display-scheme-music music) - music) +bar = +#(define-music-function (parser location type) + (string?) + (context-spec-music + (make-property-set 'whichBar type) + 'Timing)) + + +barNumberCheck = +#(define-music-function (parser location n) (integer?) + (make-music 'ApplyContext + 'origin location + 'procedure + (lambda (c) + (let* + ((cbn (ly:context-property c 'currentBarNumber))) + (if (and (number? cbn) (not (= cbn n))) + (ly:input-message location "Barcheck failed got ~a expect ~a" + cbn n)))))) -%% FIXME: guile-1.7 required? -%#(use-modules (scm display-lily))invalid module name for use-syntax ((srfi srfi-39)) +%% why a function? +breathe = +#(define-music-function (parser location) () + (make-music 'EventChord + 'origin location + 'elements (list (make-music 'BreathingEvent)))) + +bendAfter = +#(define-music-function (parser location delta) (integer?) + + (make-music 'BendAfterEvent + 'delta-step delta)) + +clef = +#(define-music-function (parser location type) + (string?) + (_i "Set the current clef.") + + (make-clef-set type)) + + +compressMusic = +#(define-music-function + (parser location fraction music) (number-pair? ly:music?) + (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction)))) + + +cueDuring = +#(define-music-function + (parser location what dir main-music) + (string? ly:dir? ly:music?) + (make-music 'QuoteMusic + 'element main-music + 'quoted-context-type 'Voice + 'quoted-context-id "cue" + 'quoted-music-name what + 'quoted-voice-direction dir + 'origin location)) + +%% The following causes an error with guile 1.6.8 (guile 1.6.7 and 1.8.x are fine) #(use-modules (scm display-lily)) -#(display-lily-init parser) + displayLilyMusic = #(define-music-function (parser location music) (ly:music?) - (display-lily-music music) + (newline) + (display-lily-music music parser) music) -applyOutput = -#(define-music-function (parser location ctx proc) (symbol? procedure?) - (make-music 'ApplyOutputEvent - 'origin location - 'procedure proc - 'context-type ctx)) +displayMusic = +#(define-music-function (parser location music) (ly:music?) + (newline) + (display-scheme-music music) + music) -overrideProperty = -#(define-music-function (parser location name property value) - (string? symbol? scheme?) +featherDurations= +#(define-music-function (parser location factor argument) (ly:moment? ly:music?) + (_i "Rearrange durations in ARGUMENT so there is an +acceleration/deceleration. ") + + (let* + ((orig-duration (ly:music-length argument)) + (multiplier (ly:make-moment 1 1))) + (music-map + (lambda (mus) + (if (and (eq? (ly:music-property mus 'name) 'EventChord) + (< 0 (ly:moment-main-denominator (ly:music-length mus)))) + (begin + (ly:music-compress mus multiplier) + (set! multiplier (ly:moment-mul factor multiplier))) + ) + mus) + argument) - "Set @var{property} to @var{value} in all grobs named @var{name}. -The @var{name} argument is a string of the form @code{\"Context.GrobName\"} -or @code{\"GrobName\"}" + (ly:music-compress + argument + (ly:moment-div orig-duration (ly:music-length argument))) - (let* - ((name-components (string-split name #\.)) - (context-name 'Bottom) - (grob-name #f)) + argument)) - (if (> 2 (length name-components)) - (set! grob-name (string->symbol (car name-components))) - (begin - (set! grob-name (string->symbol (list-ref name-components 1))) - (set! context-name (string->symbol (list-ref name-components 0))))) +grace = +#(def-grace-function startGraceMusic stopGraceMusic) - (context-spec-music - (make-music 'ApplyOutputEvent - 'origin location - 'procedure - (lambda (grob orig-context context) - (if (equal? - (cdr (assoc 'name (ly:grob-property grob 'meta))) - grob-name) - (set! (ly:grob-property grob property) value)))) - context-name))) +"instrument-definitions" = #'() -breathe = -#(define-music-function (parser location) () - (make-music 'EventChord - 'origin location - 'elements (list (make-music 'BreathingSignEvent)))) +addInstrumentDefinition = +#(define-music-function + (parser location name lst) (string? list?) + (set! instrument-definitions (acons name lst instrument-definitions)) -unfoldRepeats = -#(define-music-function (parser location music) (ly:music?) - (unfold-repeats music)) + (make-music 'SequentialMusic 'void #t)) -compressMusic = -#(define-music-function - (parser location fraction music) (number-pair? ly:music?) - (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction)))) -makeClusters = +instrumentSwitch = #(define-music-function - (parser location arg) (ly:music?) - (music-map note-to-cluster arg)) + (parser location name) (string?) + (let* + ((handle (assoc name instrument-definitions)) + (instrument-def (if handle (cdr handle) '())) + ) + + (if (not handle) + (ly:input-message "No such instrument: ~a" name)) + (context-spec-music + (make-music 'SimultaneousMusic + 'elements + (map (lambda (kv) + (make-property-set + (car kv) + (cdr kv))) + instrument-def)) + 'Staff))) -removeWithTag = -#(define-music-function - (parser location tag music) (symbol? ly:music?) - (music-filter - (lambda (m) - (let* ((tags (ly:music-property m 'tags)) - (res (memq tag tags))) - (not res))) - music)) - keepWithTag = #(define-music-function (parser location tag music) (symbol? ly:music?) @@ -190,54 +265,96 @@ keepWithTag = music)) -%% Todo: -%% doing -%% define-music-function in a .scm causes crash. -cueDuring = +killCues = #(define-music-function - (parser location what dir main-music) - (string? ly:dir? ly:music?) - (make-music 'QuoteMusic - 'element main-music - 'quoted-context-type 'Voice - 'quoted-context-id "cue" - 'quoted-music-name what - 'quoted-voice-direction dir - 'origin location)) + (parser location music) + (ly:music?) + (music-map + (lambda (mus) + (if (string? (ly:music-property mus 'quoted-music-name)) + (ly:music-property mus 'element) + mus)) music)) + +makeClusters = +#(define-music-function + (parser location arg) (ly:music?) + (music-map note-to-cluster arg)) -transposedCueDuring = # -(define-music-function - (parser location what dir pitch-note main-music) - (string? ly:dir? ly:music? ly:music?) +musicMap = +#(define-music-function (parser location proc mus) (procedure? ly:music?) + (music-map proc mus)) - "Insert notes from the part @var{what} into a voice called @code{cue}, -using the transposition defined by @var{pitch-note}. This happens -simultaneously with @var{main-music}, which is usually a rest. The -argument @var{dir} determines whether the cue notes should be notated -as a first or second voice." - (make-music 'QuoteMusic - 'element main-music - 'quoted-context-type 'Voice - 'quoted-context-id "cue" - 'quoted-music-name what - 'quoted-voice-direction dir - 'quoted-transposition (pitch-of-note pitch-note) - 'origin location)) +oldaddlyrics = +#(define-music-function (parser location music lyrics) (ly:music? ly:music?) -quoteDuring = # -(define-music-function - (parser location what main-music) - (string? ly:music?) - (make-music 'QuoteMusic - 'element main-music - 'quoted-music-name what - 'origin location)) + (make-music 'OldLyricCombineMusic + 'origin location + 'elements (list music lyrics))) + + +overrideProperty = +#(define-music-function (parser location name property value) + (string? symbol? scheme?) + + + (_i "Set @var{property} to @var{value} in all grobs named @var{name}. +The @var{name} argument is a string of the form @code{\"Context.GrobName\"} +or @code{\"GrobName\"}") + + (let* + ((name-components (string-split name #\.)) + (context-name 'Bottom) + (grob-name #f)) + + (if (> 2 (length name-components)) + (set! grob-name (string->symbol (car name-components))) + (begin + (set! grob-name (string->symbol (list-ref name-components 1))) + (set! context-name (string->symbol (list-ref name-components 0))))) + + (make-music 'ApplyOutputEvent + 'origin location + 'context-type context-name + 'procedure + (lambda (grob orig-context context) + (if (equal? + (cdr (assoc 'name (ly:grob-property grob 'meta))) + grob-name) + (set! (ly:grob-property grob property) value)))))) + + +removeWithTag = +#(define-music-function + (parser location tag music) (symbol? ly:music?) + (music-filter + (lambda (m) + (let* ((tags (ly:music-property m 'tags)) + (res (memq tag tags))) + (not res))) + music)) + +%% Todo: +%% doing +%% define-music-function in a .scm causes crash. + +octave = +#(define-music-function (parser location pitch-note) (ly:music?) + (_i "octave check") + (make-music 'RelativeOctaveCheck + 'origin location + 'pitch (pitch-of-note pitch-note) + )) +partcombine = +#(define-music-function (parser location part1 part2) (ly:music? ly:music?) + (make-part-combine-music parser + (list part1 part2))) + pitchedTrill = #(define-music-function (parser location main-note secondary-note) @@ -264,85 +381,20 @@ pitchedTrill = (display sec-note-events))) main-note)) - -killCues = -#(define-music-function - (parser location music) - (ly:music?) - (music-map - (lambda (mus) - (if (string? (ly:music-property mus 'quoted-music-name)) - (ly:music-property mus 'element) - mus)) music)) +parenthesize = +#(define-music-function (parser loc arg) (ly:music?) + (_i "Tag @var{arg} to be parenthesized.") -afterGraceFraction = -#(cons 6 8) - -afterGrace = -#(define-music-function - (parser location main grace) - (ly:music? ly:music?) - - (let* - ((main-length (ly:music-length main)) - (fraction (ly:parser-lookup parser 'afterGraceFraction))) - - (make-simultaneous-music - (list - main - (make-sequential-music - (list - - (make-music 'SkipMusic - 'duration (ly:make-duration - 0 0 - (* (ly:moment-main-numerator main-length) - (car fraction)) - (* (ly:moment-main-denominator main-length) - (cdr fraction)) )) - (make-music 'GraceMusic - 'element grace))))))) - - -barNumberCheck = -#(define-music-function (parser location n) (integer?) - (make-music 'ApplyContext - 'origin location - 'procedure - (lambda (c) - (let* - ((cbn (ly:context-property c 'currentBarNumber))) - (if (not (= cbn n)) - (ly:input-message location "Barcheck failed got ~a expect ~a" - cbn n)))))) - - - -% for regression testing purposes. -assertBeamQuant = -#(define-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 = -#(define-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)))))) + (set! (ly:music-property arg 'parenthesize) #t) + arg) +%% for lambda* +#(use-modules (ice-9 optargs)) parallelMusic = #(define-music-function (parser location voice-ids music) (list? ly:music?) - "Define parallel music sequences, separated by '|' (bar check signs), + (_i "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) @@ -350,6 +402,8 @@ and assign them to the identifiers provided in @var{voice-ids}. @var{music}: a music sequence, containing BarChecks as limiting expressions. Example: + +@verbatim \\parallelMusic #'(A B C) { c c | d d | e e | d d | e e | f f | @@ -358,7 +412,8 @@ Example: A = { c c | d d | } B = { d d | e e | } C = { e e | f f | } -" +@end verbatim +") (let* ((voices (apply circular-list (make-list (length voice-ids) (list)))) (current-voices voices) (current-sequence (list))) @@ -409,7 +464,7 @@ Example: voices) ;; ;; check sequence length - (apply for-each (lambda (. seqs) + (apply for-each (lambda* (#:rest seqs) (let ((moment-reference (ly:music-length (car seqs)))) (for-each (lambda (seq moment) (if (not (equal? moment moment-reference)) @@ -430,60 +485,165 @@ Example: +quoteDuring = # +(define-music-function + (parser location what main-music) + (string? ly:music?) + (make-music 'QuoteMusic + 'element main-music + 'quoted-music-name what + 'origin location)) + + + +resetRelativeOctave = +#(define-music-function + (parser location reference-note) + (ly:music?) + (_i "Set the octave inside a \\relative section.") + + (let* + ((notes (ly:music-property reference-note 'elements)) + (pitch (ly:music-property (car notes) 'pitch))) + + (set! (ly:music-property reference-note 'elements) '()) + (set! (ly:music-property reference-note + 'to-relative-callback) + (lambda (music last-pitch) + pitch)) + + reference-note)) + + + +shiftDurations = +#(define-music-function (parser location dur dots arg) (integer? integer? ly:music?) + (_i "") + + (music-map + (lambda (x) + (shift-one-duration-log x dur dots)) arg)) -%% this is a stub. Write your own to suit the spacing tweak output. spacingTweaks = #(define-music-function (parser location parameters) (list?) + (_i "Set the system stretch, by reading the 'system-stretch property of +the `parameters' assoc list.") + #{ + \overrideProperty #"Score.NonMusicalPaperColumn" + #'line-break-system-details + #$(list (cons 'alignment-extra-space (cdr (assoc 'system-stretch parameters))) + (cons 'system-Y-extent (cdr (assoc 'system-Y-extent parameters)))) + #}) + +%% Parser used to read page-layout file, and then retreive score tweaks. +#(define page-layout-parser #f) + +includePageLayoutFile = +#(define-music-function (parser location) () + (_i "If page breaks and tweak dump is not asked, and the file +-page-layout.ly exists, include it.") + (if (not (ly:get-option 'dump-tweaks)) + (let ((tweak-filename (format #f "~a-page-layout.ly" + (ly:parser-output-name parser)))) + (if (access? tweak-filename R_OK) + (begin + (ly:message "Including tweak file ~a" tweak-filename) + (set! page-layout-parser (ly:parser-clone parser)) + (ly:parser-parse-string page-layout-parser + (format #f "\\include \"~a\"" + tweak-filename)))))) (make-music 'SequentialMusic 'void #t)) -octave = + +rightHandFinger = +#(define-music-function (parser location finger) (number-or-string?) + (_i "Define a StrokeFingerEvent") + + (apply make-music + (append + (list + 'StrokeFingerEvent + 'origin location) + (if (string? finger) + (list 'text finger) + (list 'digit finger))))) + +scoreTweak = +#(define-music-function (parser location name) (string?) + (_i "Include the score tweak, if exists.") + (if (and page-layout-parser (not (ly:get-option 'dump-tweaks))) + (let ((tweak-music (ly:parser-lookup page-layout-parser + (string->symbol name)))) + (if (ly:music? tweak-music) + tweak-music + (make-music 'SequentialMusic))) + (make-music 'SequentialMusic))) + +transposedCueDuring = +#(define-music-function + (parser location what dir pitch-note main-music) + (string? ly:dir? ly:music? ly:music?) + + (_i "Insert notes from the part @var{what} into a voice called @code{cue}, +using the transposition defined by @var{pitch-note}. This happens +simultaneously with @var{main-music}, which is usually a rest. The +argument @var{dir} determines whether the cue notes should be notated +as a first or second voice.") + + (make-music 'QuoteMusic + 'element main-music + 'quoted-context-type 'Voice + 'quoted-context-id "cue" + 'quoted-music-name what + 'quoted-voice-direction dir + 'quoted-transposition (pitch-of-note pitch-note) + 'origin location)) + + + +transposition = #(define-music-function (parser location pitch-note) (ly:music?) - "octave check" + (_i "Set instrument transposition") - (make-music 'RelativeOctaveCheck - 'origin location - 'pitch (pitch-of-note pitch-note) - )) + (context-spec-music + (make-property-set 'instrumentTransposition + (ly:pitch-negate (pitch-of-note pitch-note))) + 'Staff)) -addquote = -#(define-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)) +tweak = #(define-music-function (parser location sym val arg) + (symbol? scheme? ly:music?) - -parenthesize = -#(define-music-function (parser loc arg) (ly:music?) - "Tag @var{arg} to be parenthesized." + (_i "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) - (set! (ly:music-property arg 'parenthesize) #t) +tag = #(define-music-function (parser location tag arg) + (symbol? ly:music?) + + (_i "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) -featherDurations= -#(define-music-function (parser location factor argument) (ly:moment? ly:music?) +unfoldRepeats = +#(define-music-function (parser location music) (ly:music?) + (unfold-repeats music)) - "Rearrange durations in ARGUMENT so there is an -acceleration/deceleration. " - - (let* - ((orig-duration (ly:music-length argument)) - (multiplier (ly:make-moment 1 1))) - (music-map - (lambda (mus) - (if (and (eq? (ly:music-property mus 'name) 'EventChord) - (< 0 (ly:moment-main-denominator (ly:music-length mus)))) - (begin - (ly:music-compress mus multiplier) - (set! multiplier (ly:moment-mul factor multiplier))) - ) - mus) - argument) - (ly:music-compress - argument - (ly:moment-div orig-duration (ly:music-length argument))) +withMusicProperty = +#(define-music-function (parser location sym val music) (symbol? scheme? ly:music?) + (_i "Set @var{sym} to @var{val} in @var{music}.") + + (set! (ly:music-property music sym) val) + music) - argument))