[frogs] Working with music properties

[ Thread Index | Date Index | More lilynet.net/frogs Archives ]


Hello again :-)

Following Neil's advice and after some scheme-y research I've made some
rewrites of the code.

The various naturalize-* functions now take as input a list of four
pairs, which determine the cases when pitch alterations are too high or
two low (see naturalize.scm).  The various naturalizeMusic* expressions
in naturalizeMusicIntegrated.ly have been rewritten to use this form.

I also added a music property, naturalize-style (see attached version of
define-music-properties.scm).

As per naturalizeMusicIntegrated.ly the idea would be to set the value
of 'naturalize-style and use that to determine the naturalization rules.

So, as a first step, I'd like to rewrite naturalizeMusic to use the
music property.  Currently it's defined as,

> naturalizeMusic =
> #(define-music-function (parser location m)
>    (ly:music?)
>    (naturalize m (list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))))

I tried replacing that with,

> naturalizeMusic =
> #(define-music-function (parser location m)
>    (ly:music?)
>    (naturalize m (ly:music-property m 'naturalize-style)))

.... but that generated an error:

> GNU LilyPond 2.13.28
> Processing `naturalizeMusicIntegrated.ly'
> Parsing...~/code/lily/out/share/lilypond/current/scm/naturalize.scm:10:33: In procedure list-ref in expression (list-ref pitch-limits 0):
> ~/code/lily/out/share/lilypond/current/scm/naturalize.scm:10:33: Argument 2 out of range: 0

.... which suggests to me that (ly:music-property m 'naturalize-style) is
returning an empty list.

Is that because I'm doing something wrong in setting the value of the
'naturalize-style music property, or is it that I'm incorrectly trying
to _get_ the value?  Either way, can someone advise on the solution?

Thanks & best wishes,

    -- Joe
naturalizeMusic =
#(define-music-function (parser location m)
   (ly:music?)
   (naturalize m (list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))))

naturalizeMusicHarp =
#(define-music-function (parser location m)
   (ly:music?)
   (naturalize m (list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))))

naturalizeMusicTonal =
#(define-music-function (parser location m)
   (ly:music?)
   (naturalize m (list (cons > 1) (cons < -1) (cons > SHARP) (cons < FLAT))))

music = \relative c' { c4 d e g }
microphrase = \relative c'' { geses4 geseh ges geh g gih gis gisih gisis }

\score {
  \new Staff {
    \set Staff.extraNatural = ##f
    \withMusicProperty #'naturalize-style ##f
    \transpose c ais { \music }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusic \transpose c ais { \music }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusicHarp \transpose c ais { \music }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > 1) (cons < -1) (cons > SHARP) (cons < FLAT))
    \naturalizeMusicTonal \transpose c ais { \music }
    \bar "||"

    \withMusicProperty #'naturalize-style ##f
    \transpose c deses { \music }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusic \transpose c deses { \music }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusicHarp \transpose c deses { \music }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > 1) (cons < -1) (cons > SHARP) (cons < FLAT))
    \naturalizeMusicTonal \transpose c deses { \music }
    \bar "||"
    \break

    \time 9/4
    \withMusicProperty #'naturalize-style ##f
    \microphrase
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusic { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusicHarp { \microphrase }
    \bar ":"
    \naturalizeMusicTonal{ \microphrase }
    \break

    \withMusicProperty #'naturalize-style ##f
    \transpose c ais { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusic \transpose c ais { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusicHarp \transpose c ais { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > 1) (cons < -1) (cons > SHARP) (cons < FLAT))
    \naturalizeMusicTonal \transpose c ais { \microphrase }
    \break

    \withMusicProperty #'naturalize-style ##f
    \transpose c deses { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusic \transpose c deses { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusicHarp \transpose c deses { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > 1) (cons < -1) (cons > SHARP) (cons < FLAT))
    \naturalizeMusicTonal \transpose c deses { \microphrase }
    \break

    \withMusicProperty #'naturalize-style ##f
    \transpose c cih { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons >= 1) (cons <= -1) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusic \transpose c cih { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > SHARP) (cons < FLAT) (cons >= SHARP) (cons <= FLAT))
    \naturalizeMusicHarp \transpose c cih { \microphrase }
    \bar ":"
    \withMusicProperty #'naturalize-style #(list (cons > 1) (cons < -1) (cons > SHARP) (cons < FLAT))
    \naturalizeMusicTonal \transpose c cih { \microphrase }
  }
  \layout { }
}

(define (naturalize-limit lim)
  (define (limit a)
    ((car lim) a (cdr lim)))
  limit)

(define-public (naturalize-pitch p pitch-limits)
  (let ((o (ly:pitch-octave p))
        (n (ly:pitch-notename p))
        (a (ly:pitch-alteration p))
        (high (naturalize-limit (list-ref pitch-limits 0)))
        (low (naturalize-limit (list-ref pitch-limits 1)))
        (higheb (naturalize-limit (list-ref pitch-limits 2)))
        (lowcf (naturalize-limit (list-ref pitch-limits 3))))
    (do ((aa 0))
        ((= aa a) (ly:make-pitch o n a))
      (set! aa a)
      (cond
       ((and (higheb a) (or (eq? n 2) (eq? n 6)))
        (set! a (- a (/ 1 2)))
        (set! n (+ n 1)))
       ((and (lowcf a) (or (eq? n 0) (eq? n 3)))
        (set! a (+ a (/ 1 2)))
        (set! n (- n 1))))
      (cond
       ((high a) (set! a (- a 1)) (set! n (+ n 1)))
       ((low a) (set! a (+ a 1)) (set! n (- n 1))))
      (if (< n 0) (begin (set! o (- o 1)) (set! n (+ n 7))))
      (if (> n 6) (begin (set! o (+ o 1)) (set! n (- n 7)))))))

(define-public (naturalize music pitch-limits)
  (let ((es (ly:music-property music 'elements))
        (e (ly:music-property music 'element))
        (p (ly:music-property music 'pitch)))
    (if (pair? es)
        (ly:music-set-property!
         music 'elements
         (map (lambda (x) (naturalize x pitch-limits)) es)))
    (if (ly:music? e)
        (ly:music-set-property!
         music 'element
         (naturalize e pitch-limits)))
    (if (ly:pitch? p)
        (begin
          (set! p (naturalize-pitch p pitch-limits))
          (ly:music-set-property! music 'pitch p)))
    music))
;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
;;;; Copyright (C) 1998--2010  Han-Wen Nienhuys <hanwen@xxxxxxxxx>
;;;;                 Jan Nieuwenhuizen <janneke@xxxxxxx>
;;;;
;;;; 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 <http://www.gnu.org/licenses/>.

(define (music-property-description symbol type? description)
  (if (not (equal? #f (object-property symbol 'music-doc)))
      (ly:error (_ "symbol ~S redefined") symbol))
  (set-object-property! symbol 'music-type? type?)
  (set-object-property! symbol 'music-doc description)
  symbol)

(define-public all-music-properties
  (map
   (lambda (x) (apply music-property-description x))
   `(
     (absolute-octave ,integer?
		      "The absolute octave for a octave check note.")
     (alteration ,number? "Alteration for figured bass.")
     (articulation-type ,string? "Key for script definitions alist.

TODO: Consider making type into symbol.")
     (articulations ,ly:music-list?
		    "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
(with @code{+} sign).")
     (augmented-slash ,boolean? "This figure is for an augmented figured bass
(back-slashed number).")

     (bass ,boolean? "Set if this note is a bass note in a chord.")
     (bracket-start ,boolean? "Start a bracket here.

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.")

     (cautionary ,boolean? "If set, this alteration needs a
cautionary accidental.")
     (change-to-id ,string? "Name of the context to change to.")
     (change-to-type ,symbol? "Type of the context to change to.")
     (compress-procedure ,procedure? "Compress this music expression.
Arg@tie{}1: the music, arg@tie{}2: factor.")
     (context-id ,string? "Name of context.")
     (context-type ,symbol?  "Type of context.")
     (create-new ,boolean? "Create a fresh context.")

     (delta-step ,number? "How much should a fall change pitch?")
     (denominator ,integer? "Denominator in a time signature.")
     (descend-only ,boolean? "If set, this @code{\\context} only descends
in the context tree.")
     (digit ,integer? "Digit for fingering.")
     (diminished ,boolean? "This bass figure should be slashed.")
     (direction ,ly:dir? "Print this up or down?")
     (drum-type ,symbol? "Which percussion instrument to play this note on.")
     (duration ,ly:duration? "Duration of this note or lyric.")

     (element ,ly:music? "The single child of a Music_wrapper music object,
or the body of a repeat.")
     (elements ,ly:music-list? "A list of elements for sequential of
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.")

     (figure ,integer? "A bass figure.")
     (force-accidental ,boolean? "If set, a cautionary accidental should
always be printed on this note.")

     (grob-property ,symbol? "The symbol of the grob property to set.")
     (grob-property-path ,list? "A list of symbols, locating a nested grob
property, e.g., @code{(beamed-lengths details)}.")
     (grob-value ,scheme? "The value of the grob property to set.")

     (input-tag ,scheme? "Arbitrary marker to relate input and output.")
     (inversion ,boolean? "If set, this chord note is inverted.")
     (iterator-ctor ,procedure? "Function to construct a
@code{music-event-iterator} object for this music.")

     (label ,markup? "Label of a mark.")
     (last-pitch ,ly:pitch? "The last pitch after relativization.")
     (length ,ly:moment? "The duration of this music.")
     (length-callback ,procedure? "How to compute the duration of this music.
This property can only be defined as initializer in
@file{scm/@/define-music-types.scm}.")
     (line-break-permission ,symbol? "When the music is at top-level,
whether to allow, forbid or force a line break.")

     (metronome-count ,number? "How many beats in a minute?")

     (name ,symbol? "Name of this music object.")
     (naturalize-style ,list? "The rules for what pitch-alterations are permissible")
     (no-continuation ,boolean? "If set, disallow continuation lines.")
     (numerator ,integer? "Numerator of a time signature.")

     (octavation ,integer? "This pitch was octavated by how many octaves?
For chord inversions, this is negative.")
     (once ,boolean? "Apply this operation only during one time step?")
     (origin ,ly:input-location? "Where was this piece of music defined?")
     (original-chord ,ly:music? "Original chord of a repeated chord.
Used by repeated chords in \\relative mode, to determine the first note octave")

     (page-break-permission ,symbol? "When the music is at top-level,
whether to allow, forbid or force a page break.")
     (page-label ,symbol? "The label of a page marker.")
     (page-marker ,boolean? "If true, and the music expression is found at
top-level, a page marker object is instanciated instead of a score.")
     (page-turn-permission ,symbol? "When the music is at top-level,
whether to allow, forbid or force a page turn.")
     (parenthesize ,boolean? "Enclose resulting objects in parentheses?")
     (part-combine-status ,symbol? "Change to what kind of state?
Options are @code{solo1}, @code{solo2} and @code{unisono}.")
     (pitch ,ly:pitch? "The pitch of this note.")
     (pitch-alist ,list? "A list of pitches jointly forming the scale
of a key signature.")
     (pop-first ,boolean? "Do a revert before we try to do a override
on some grob property.")
     (prob-property ,symbol? "The symbol of the prob property to set.")
     (procedure ,procedure? "The function to run with @code{\\applycontext}.
It must take a single argument, being the context.")
     (property-operations ,list? "Do these operations for instantiating
the context.")

     (quoted-context-id ,string? "The ID of the context to direct quotes to,
e.g., @code{cue}.")
     (quoted-context-type ,symbol? "The name of the context to
direct quotes to, e.g., @code{Voice}.")
     (quoted-events ,vector? "A vector of with @code{moment} and
@code{event-list} entries.")
     (quoted-music-name ,string? "The name of the voice to quote.")
     (quoted-transposition ,ly:pitch? "The pitch used for the quote,
overriding @code{\\transposition}.")
     (quoted-voice-direction ,ly:dir? "Should the quoted voice be up-stem
or down-stem?")

     (repeat-count ,integer? "Do a @code{\\repeat} how often?")

     (span-direction ,ly:dir? "Does this start or stop a spanner?")
     (span-type ,symbol? "What kind of dynamic spanner should be created?
Options are @code{'text} and @code{'hairpin}.")
     (span-text ,markup? "The displayed text for dynamic text spanners
(e.g., cresc.)")
     (split-list ,list? "Splitting moments for part combiner.")
     (start-callback ,procedure? "Function to compute the negative length
of starting grace notes.  This property can only be defined as initializer
in @file{scm/@/define-music-types.scm}.")
     (string-number ,integer? "The number of the string in
a @code{StringNumberEvent}.")
     (symbol ,symbol? "Grob name to perform an override or revert on.")

     (tags ,list? "List of symbols that for denoting extra details, e.g.,
@code{\\tag #'part @dots{}} could tag a piece of music as only being active
in a part.")
     (tempo-unit ,ly:duration? "The unit for the metronome count.")
     (text ,markup? "Markup expression to be printed.")
     (to-relative-callback ,procedure? "How to transform a piece of music
to relative pitches.")
     (tonic ,ly:pitch? "Base of the scale.")
     (tremolo-type ,integer? "Speed of tremolo, e.g., 16 for @code{c4:16}.")
     (trill-pitch ,ly:pitch? "Pitch of other note of the trill.")
     (tweaks ,list? "An alist of properties to override in the backend
for the grob made of this event.")
     (type ,symbol? "The type of this music object.
Determines iteration in some cases.")
     (types ,list? "The types of this music object; determines by what
engraver this music expression is processed.")

     (untransposable ,boolean? "If set, this music is not transposed.")

     (value ,scheme? "Assignment value for a translation property.")
     (void ,boolean? "If this property is @code{#t}, then the
music expression is to be discarded by the toplevel music handler.")

     (what ,symbol? "What to change for auto-change.

FIXME: Naming.")

     (X-offset ,number?
	       "Offset of resulting grob; only used for balloon texts.")

     (Y-offset ,number?
	       "Offset of resulting grob; only used for balloon texts.")
    )))


Mail converted by MHonArc 2.6.19+ http://listengine.tuxfamily.org/