Ich habe nun erstmal Anfänge und Enden des Bogens händisch eingefügt. Das erzeugt allerdings Probleme - siehe letzte Zeile beim Wort "commodi".
Um Verhältnisse zu berechnen, müßte ich an den linken bzw rechten Nachbarn der aktuellen PaperColumn kommen. Dafür kann ich aber leider keinen Zugang finden.
Vergleiche auch das zweite Bild im Anhang, das die Columns nummeriert (6,7,9,11). Kann man diese Nummern auslesen?
Mittels (ly:grob-parent grob X) bekomme ich den Parent. Wie aber bekomme ich mögliche Kinder?
Und welcher Grob enthält alle horizontalen Objekte?
(Ich habe mal ein Snippet aus der Snippet Repository eingefügt, das die Hierarchie eines Grobs anzeigt.)
Im Übrigen habe ich den Score so geändert, das man sieht, wofür meine Einstellung eigentlich gebraucht wird: Um Sprache rhythmisch zu setzen. Die Bögen sollen später zusammengehörige Phrasen verdeutlichen und auch noch zwischen weiteren Stimmen hin und hergehen.
\version "2.18.2"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% HELFER
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (disp vals)
(newline)
(display vals)
)
#(define (dloop vals)
(define n 0)
(for-each
(lambda (x)
(newline)
(display n)
(if (list? n) (loop n) n)
(newline)
(set! n (+ 1 n))
(display x)
)
vals
)
)
#(define (nth n l)
(if
(or (> n (length l)) (< n 0))
(error "Index out of bounds.")
(if
(eq? n 0)
(car l)
(nth (- n 1) (cdr l))
)
)
)
#(define zaehler 0)
#(define (draw-annotation grob)
;; for debugging:
;; draws a number to the grob
(ly:grob-set-nested-property! grob (list 'details 'spanner-id ) zaehler)
(ly:grob-set-property! grob 'annotation (number->string zaehler))
(disp '----------------- )
(disp zaehler)
(set! zaehler (+ zaehler 1))
)
#(define (props grob)
(dloop (ly:grob-properties grob ) )
)
#(define (bprops grob)
(dloop (ly:grob-basic-properties grob ) )
)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% from the snippet repository http://lsr.di.unimi.it/LSR/Item?id=622
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (grob::name grob)
(assq-ref (ly:grob-property grob 'meta) 'name))
#(define (get-ancestry grob)
(if (not (null? (ly:grob-parent grob X)))
(list (grob::name grob)
(get-ancestry (ly:grob-parent grob X))
(get-ancestry (ly:grob-parent grob Y)))
(grob::name grob)))
#(define (format-ancestry lst padding)
(string-append
(symbol->string (car lst))
"\n"
(let ((X-ancestry
(if (list? (cadr lst))
(format-ancestry (cadr lst) (+ padding 3))
(symbol->string (cadr lst))))
(Y-ancestry
(if (list? (caddr lst))
(format-ancestry (caddr lst) (+ padding 3))
(symbol->string (caddr lst)))))
(if (equal? X-ancestry Y-ancestry)
(string-append
(format #f "~&")
(make-string padding #\space)
"X,Y: "
(if (list? (cadr lst))
(format-ancestry (cadr lst) (+ padding 5))
(symbol->string (cadr lst))))
(string-append
(format #f "~&")
(make-string padding #\space)
"X: " X-ancestry
"\n"
(make-string padding #\space)
"Y: " Y-ancestry
(format #f "~&"))))
(format #f "~&")))
#(define (display-ancestry grob)
(format (current-error-port)
"~3&~a~2%~a~&"
(make-string 36 #\-)
(if (ly:grob? grob)
(format-ancestry (get-ancestry grob) 0)
(format #f "~a is not a grob" grob))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (get-cp cps nr xy)
(define wert
(lambda (x)
(cond
((= xy 0)
(car x))
((= xy 1)
(cdr x))
)
)
)
(cond
((= 0 nr)
(wert (car cps)))
((= 1 nr)
(wert (cadr cps)))
((= 2 nr)
(wert (caddr cps)))
((= 3 nr)
(wert (cadddr cps)))
)
)
#(define (get-contr-pts-of-txt note-column)
(let* (
;; get PaperColumns
(pap-col (ly:grob-parent note-column X))
;; get PaperColumns 'elements
(pap-col-elements (ly:grob-array->list (ly:grob-object pap-col 'elements)))
;; filter for LyricText by searching for name LyricText in meta alist
(lyr-txt
(filter
(lambda (e) (equal? 'LyricText (cdr (assoc 'name (ly:grob-property e 'meta)))))
pap-col-elements
)
)
;; set default Extensions in case
;; no lyrics are present
(ext (cons -1 1))
;; optional: for displaying the text belonging to the slur
(txt '-)
(parent (ly:grob-parent pap-col Y))
)
(if (= 1 (length lyr-txt))
(begin
(set! lyr-txt (car lyr-txt))
;; get text extensions
(set! ext (ly:grob-extent lyr-txt note-column X))
;; optional: for displaying the text belonging to the slur
(set! txt (ly:grob-property lyr-txt 'text))
;(disp txt)
;; DEBUGGING
(if (equal? txt "amet," )
(display-ancestry note-column))
;(display-ancestry note-column)
;(set! txt (ly:grob-parent note-column Y))
;(set! txt (ly:grob-parent txt X))
;(set! txt ( ly:grob- note-column ))
;(display-ancestry txt)
;(props txt )
;(set! txt ( ly:axis-group-interface::calc-pure-y-common pap-col))
;(bprops txt)
)
)
ext
)
)
#(define* (set-controlPoint grob nr xy-values)
(cond
((= 0 nr)
(set-car! grob xy-values))
((= 1 nr)
(set-car! (cdr grob) xy-values))
((= 2 nr)
(set-car! (cddr grob) xy-values))
((= 3 nr)
(set-car! (cdddr grob) xy-values))
)
)
#(define (set-start-point grob ncs cps)
;; Calculates Start-Point in splitted and in single-line slurs
;; TODO: exact calculation of 1st and 2nd ControlPoint
(let* (
(ctrl-pts (get-contr-pts-of-txt (first ncs)))
(oldX1 (car (second cps)))
(oldY1 (cdr (second cps)))
(newX0 (- (car ctrl-pts) 1) )
(newX1 newX0);(/ (+ (* newX0 7) oldX1) 8 ))
(newY1 (- oldY1 1))
)
(set-controlPoint cps 0 (cons newX0 .5))
(set-controlPoint cps 1 (cons newX1 newY1))
)
)
#(define (set-end-point grob ncs cps)
;; Calculates End-Point in splitted and in single-line slurs
;; TODO: exact calculation of 3rd and 4th ControlPoint
(let* (
(ctrl-pts (get-contr-pts-of-txt (last ncs)))
(oldX2 (car (third cps)))
(oldY2 (cdr (third cps)))
(newX3 (+ (+ (cdr ctrl-pts) (car (last cps))) .5 ))
(newX2 newX3); (/ (+ (* newX3 7) oldX2) 8 ))
(newY2 (- oldY2 1))
)
(set-controlPoint cps 3 (cons newX3 .5) )
(set-controlPoint cps 2 (cons newX2 newY2))
)
)
#(define (shape-single-slur grob ncs cps)
;; Sets unsplitted single-line slur
(set-start-point grob ncs cps)
(set-end-point grob ncs cps)
)
#(define (shape-start-slur grob ncs cps)
(set-start-point grob ncs cps)
;; Height of Third-Point is written to Fourth-Point
(set-controlPoint cps 3 (cons (car (fourth cps)) (cdr (third cps) )))
)
#(define (shape-middle-slur grob ncs cps)
;; Y of 1st and 4th ControilPoint are calculated for
;; flattening the slur
(let* (
(oldY0 (cdr (first cps)))
(oldX0 (car (first cps)))
(oldY1 (cdr (second cps)))
(oldY2 (cdr (third cps)))
(oldX3 (car (fourth cps)))
(oldY3 (cdr (fourth cps)))
(newY0 (/ (+ oldY0 oldY1) 2) )
(newY3 (/ (+ oldY2 oldY3) 2) )
)
(set-controlPoint cps 0 (cons oldX0 newY0) )
(set-controlPoint cps 3 (cons oldX3 newY3))
)
)
#(define (shape-last-slur grob ncs cps)
(set-end-point grob ncs cps)
;; ;; Height of Second-Point is written to First-Point
(set-controlPoint cps 0 (cons (car (first cps)) (cdr (second cps))))
)
#(define (shape-slurs grob)
(let* (
;; original ControlPoints
(cps (ly:slur::calc-control-points grob))
;; get NoteColumns
(ncs (ly:grob-array->list (ly:grob-object grob 'note-columns)))
;; have we been split?
(orig (ly:grob-original grob))
;; if yes, get the split pieces (our siblings)
(siblings (if (ly:grob? orig)
(ly:spanner-broken-into orig)
'()))
;; Find control-points and map with enumeration to list.
;; The mapped enumeration helps to find the
;; position of a sibling inside a splitted slur.
(n -1)
(sib-points (map
(lambda (gr)
(begin
(set! n (+ 1 n))
(list n (ly:slur::calc-control-points gr))
)
)
siblings))
;; Find position if slur is splitted.
;; Compares control points of actual calculated grob
;; to the control points of the siblings of the original grob.
;; Returns an empty list if slur is not splitted.
(orig-pts (ly:slur::calc-control-points grob))
(slur-position
(filter
(lambda (e) (equal? (cadr e) orig-pts))
sib-points))
)
;; call procedures to set cps positions
(cond
((equal? slur-position '())
(shape-single-slur grob ncs cps))
((equal? 0 (caar slur-position ))
(shape-start-slur grob ncs cps))
((equal? (- (length siblings) 1) (caar slur-position ))
(shape-last-slur grob ncs cps))
(else
(shape-middle-slur grob ncs cps))
)
cps
)
)
shapeSlur =
#(define-music-function (parser location )
()
#{
\override Staff.PhrasingSlur.cross-staff = ##t
\override Staff.PhrasingSlur.outside-staff-priority = ##f
%% extra-offset might be set inside #shape-slurs
\override Staff.PhrasingSlur.extra-offset = #'(0 . -3.6)
%\override Staff.PhrasingSlur.details.free-head-distance = #1
\override PhrasingSlur.direction = #DOWN
\override PhrasingSlur.control-points = #shape-slurs
#})
\paper {
indent = 0
%ragged-right = ##t
ragged-last = ##t
system-system-spacing.basic-distance = #18
}
notes = {
b4 b b2
b4 b \( b2
b b
b b \break
b b
b b
b b \break
b b \)
b4 b
\( b b \)
b2 b
b b \break
b b \(
b b
b b \break
b \) b
}
\score {
<<
\new Staff = "staff" {
\new Voice = "melody" {
\relative c'' {
\shapeSlur
\notes
}
}
}
\new Lyrics
{
\lyricsto "melody" {
Lorem ipsum dolor sit amet, consectetur adipisici elit,
sed eiusmod tempor incidunt ut labore et doloredolore magna aliqua.
Ut enim ad minim veniam, quis nostrud exercitation ullamco
laboris nisi ut aliquid ex ea commodi consequat. Quis aute
iure reprehenderit in voluptate velit esse cillum dolore eu
fugiat nulla pariatur. Excepteur sint obcaecat cupiditat non
proident, sunt in culpa qui officia deserunt mollit anim id
est laborum.
}
}
>>
}
\layout {
\context {
\Score
\remove "Bar_number_engraver"
}
\context {
\Staff
\override Stem.direction = #UP
\remove "Time_signature_engraver"
\remove "Clef_engraver"
\override StaffSymbol.line-count = #1
}
\context {
\Lyrics
\override VerticalAxisGroup.
nonstaff-relatedstaff-spacing = #'((basic-distance . 3.5))
}
}
Noch eine allgemeine Frage zu Scheme:
Gibt es eine Möglichkeit, Variablen wie in Python zu bestimmen, z.B.
x,y = 0,1 ( dann ist x = 0 und y =1)
Das fände ich praktisch, da man es bei Koordinaten oft mit pairs zu tun hat.
