Re: square note heads for cluster

[andersvi]

Heres a start on a cluster-chord function.

A question someone might help answer:

When using the music-function on a chord - ie "\clusterKord <e g>2" - it
only 'eats' the first note of the chord, and appends the second one as a
separate note if i dont 'kill it' inside the music-function.

The code below just deletes it and handles stem-lengths explicitly,
however this breaks explicit beaming and possibly other things.

Any hints?

If some lilypond-guru would bother to hint on ways to improve this it
would of course help me a lot further on.  Im just starting to work with
lilypond, and everything seems chaotic atm.  Thanks.  Anders.

cluster-shot.png
Description: PNG image

\version "2.11.57"


#(define (sort-chord chord pred)
   (define (note-y music)
     (let* ((n (ly:music-property music 'element))
            (p (ly:music-property music 'pitch)))
       (cond ((ly:music? n) (note-y n))
             ((ly:pitch? p) (let* ((o (ly:pitch-octave p))
                                   (n (ly:pitch-notename p)))
                              (+ (* 7 o) n))))))
   (sort chord (lambda (n1 n2) (pred (note-y n1) (note-y n2)))))


#(define (chord-y-extent music)
   (define (note-y music)
     (let* ((n (ly:music-property music 'element))
            (p (ly:music-property music 'pitch)))
       (cond ((ly:music? n) (note-y n))
             ((ly:pitch? p) (let* ((o (ly:pitch-octave p))
                                   (n (ly:pitch-notename p)))
                              (+ (* 7 o) n))))))
   (let ((alle-ys  (map note-y (ly:music-property music 'elements))))
     ;;(display alle-ys)
     (cons (apply min alle-ys) (apply max alle-ys))))

#(define (leggtilbokshue akkord)
   (let* ((bunn-topp (chord-y-extent akkord))
          (bunn (car bunn-topp))
          (topp (cdr bunn-topp))
          (filled? (let ((dur (ly:music-property
                               (car (ly:music-property akkord 'elements))
                               'duration)))
                     (and (ly:duration? dur)
                          (> (ly:duration-log dur) 1)))))

     (make-music
      'SequentialMusic
      'elements (cons
                 (make-music
                  'ContextSpeccedMusic 'context-type 'Bottom
                  'element (make-music
                            'OverrideProperty 'pop-first #t
                            'grob-property-path (list (quote stencil))
                            'grob-value ly:text-interface::print
                            'once #t
                            'symbol 'NoteHead))

                 (cons
                  (make-music
                   'ContextSpeccedMusic 'context-type 'Bottom
                   'element (make-music
                             'OverrideProperty 'pop-first #t
                             'grob-property-path (list (quote length))
                             ;; whats the default stem-length?
                             ;; how to find whether a stem is up or down?
                             'grob-value (+ (- topp bunn) 7) 
                             'once #t
                             'symbol 'Stem))
                  (cons (make-music
                         'ContextSpeccedMusic 'context-type 'Bottom
                         'element (make-music
                                   'OverrideProperty
                                   'pop-first #t
                                   'grob-property-path (list (quote text))
                                   ;; adjust to non-filled with 'unfilled durs:
                                   'grob-value
                                   (let ((xs (cons 0 1))
                                         (ys (cons -0.5 (+ (/ (- topp bunn) 2) 
0.5) )))
                                     (if filled?
                                         ;; cludge, replace with graphics-code
                                         (markup #:line (#:line (#:filled-box 
xs ys 0)))
                                         (markup #:line (#:box (#:pad-to-box xs 
ys (#:null))))))
                                   'once #t
                                   'symbol 'NoteHead))
                        ;; this breaks explicit beamings
                        (list (car (sort-chord (ly:music-property akkord 
'elements) <)))))))))


clusterKord = #(define-music-function (parser location music) (ly:music?)
                (leggtilbokshue  music))

% TODO: handle stem-direction, nice drawing-func ('stencil'), get rid of 
grid-lines?, user-choices, 

%{
 headFirkant = {
 \once \override NoteHead #'stencil = #ly:text-interface::print
 \once \override NoteHead #'text =  #(markup #:line (#:filled-box '(0.0 . 1.0) 
'(-0.5 . 2.0) 0))
 }
%}

\layout { ragged-right = ##t }
{
  \clusterKord <d' g'>1
  \clusterKord <a, g''>2
  \clusterKord <a' g'>8
  \clusterKord <a' d'>8
   <a' g'>8[
   <a' d'>8]
}