Abstände von Ankerpunkten in vertikaler Richtung finden

[xr]

Hallo,

Ich versuche, die Distanz zwischen verschiedenen Grobs in einer PaperColumn zu bestimmen.
Dazu bestimme ich alle VerticalAlignGroups, die in einer Systemzeile vorkommen, und berechne ihre Extents.

Leider scheint mein Vorgehen nicht auszureichen, da die Ergebnisse zu ungenau sind. Ich erwarte, etwa Mittellinien und Lyrics genau zu treffen. (Vergleiche auch Bild im Anhang)

Weiß vielleicht jemand, welche Abstände alle berechnet werden müssen, um ein genaues Ergebnis zu erhalten?

Hier ist mal mein trotz Reduktion immer noch umfangreicher Code. Codebeispiel 2 und 3 müssen in 1 eingebunden werden.
Es versucht einen Phrasierungsbogen nacheinander auf verschiedene Ankerpunkte zu setzen.

Codebeispiel 1

Code: [Auswählen]

\version "2.19.52"


\header {
  title = "Example"
}
%% include the other two files here
\include "../Helfer/set_control_points2.ly"
\include "forum_duette_bsp_code2.ly"

\paper {
  % system-system-spacing.padding = #0
%   system-system-spacing.basic-distance = #0
%   system-system-spacing.minimal-distance = #0
%   score-markup-spacing.basic-distance = #0
%   score-markup-spacing.minimal-distance = #0
%   score-system-spacing.minimal-distance = #0
%   score-system-spacing.basic-distance = #0
  indent = 0.0\cm
 
}

StimmeA-Toene = \relative c''
    {\stemUp
\time 1/4
\repeat unfold 4 {
f4 \repeat unfold 5 { f4\( f4\) }   f4 \break
}
     }

StimmeB-Toene = \relative c''
    {\stemDown
\time 1/4
\repeat unfold 4 {
b4 \repeat unfold 5 { b4 b4 }   b4 \break
}
     }

StimmeA-Worte = {
    \lyricsto first {
\new fly {

- Eins - Zwei - Drei - Vier
- Fünf - - - Sechs - Sieben - Acht
- Neun

- Eins - - - Zwei - Drei - Vier
- Fünf - Sechs - - - Sieben - Acht
- Neun  - - - - - - - -

        }
    }
}

StimmeB-Worte = {
    \lyricsto second {
\new fly {
    \repeat unfold 4 {
T T T T
T T T T
T T T T
T T T T
}
        }
    }
}

\score {
 
  <<
   
    \new Staff  = "staff_oben" 
        \with {
            \override Staff.PhrasingSlur.cross-staff = ##t
            \override PhrasingSlur.direction = #UP
            \dynamicUp

        }
        \new Voice = "oben"
            \StimmeA-Toene
            \shapeSlur
       
    \new Staff = "staff_mitte"
   
        \with {
             % can't remove PhrasingSlur from the middle staff
             % by \remove "Phrasing_slur_engraver",
             % whereas \consists would work well
             \override PhrasingSlur.stencil = ##f     
        }
        <<                 
            \new Voice = "first" 
                \StimmeA-Toene
            \new Voice = "second"
                \StimmeB-Toene
                 
            \new Lyrics = "txt-oben"
                \with { alignAboveContext = "staff_mitte" }
                \StimmeA-Worte
            \new Lyrics = "txt-unten"
                \StimmeB-Worte
        >>
   
    \new Staff  = "staff_unten"
        \with {
            \override PhrasingSlur.direction = #DOWN
            \shapeSlur
        }
        \new Voice = "unten"
            \StimmeB-Toene   
  >>

  \layout  {
   
    \context {
      \Score
      \remove "Bar_number_engraver"
      \remove "Bar_engraver"
      \consists \collect_cols_slurs_and_lyrics
     
      % for debugging: draw ranks of paper-columns
      % \override NonMusicalPaperColumn #'stencil = #ly:paper-column::print
%       \override PaperColumn #'stencil = #ly:paper-column::print
    }
    \context {
        \Staff
        \remove "Time_signature_engraver"
        \remove "Clef_engraver"
    }
   
    \context {
        \Voice
        \consists \collect_cols_slurs_and_lyrics
        }
   
    \context {
      \Lyrics
     
      \remove "Hyphen_engraver"
      \remove "Lyric_engraver"
     
      \accepts "fly"
      \consists \collect_cols_slurs_and_lyrics
    }
   
    \context {
      \name fly
      \type "Engraver_group"           
      \consists "Lyric_engraver"
      \consists "Hyphen_engraver"
      \override LyricText.self-alignment-X = #-1
      \alias Lyrics
    } 
  }
}


EDIT: Betreff muss heißen in vertikaler Richtung, nicht horizontaler

[xr]

Und Teil 2 meines Posts:

Codebeispiel 2

Code: [Auswählen]

\version "2.19.52"


%%%%%%%%%%%%%%%%%%%%%%%%% SCHEME HELPER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% dummy function
#(define (dummy-fkt) 0)
     

#(define (disp . args)     
     (format #t "\n")
     (for-each
         (lambda (i)
         (format #t "~A  " i))
         args))

#(define (fdisp nr . args)
     (let* (
         (str (format #f "~A~AA ~A " "~" nr "\t"))
        )
        (format #t "\n")
        (for-each
            (lambda (i)
            (format #t str i))
            args)
     )
)

#(define first-time-list '())
#(define (do-once fkt arg nr)
     (if (equal? (member nr first-time-list) #f)
         (begin 
             (set! first-time-list
                   (append first-time-list (list nr)))
             (fkt arg)))) 

#(define (sum elemList)
  (if
    (null? elemList)
    0
    (+ (car elemList) (sum (cdr elemList)))
  )
)

#(define (list-cut! liste start stop)
    (if (or (> (+ start stop) (length liste))
            (> start stop))
        (throw 'FEHLER (disp "ERROR in list-cut! list out of bounds"  )))
   
    (let* (       
        (list-start (list-head liste  stop))
        (list-final (list-tail list-start  start))
        )
    list-final
    )
)

#(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))
        )
    )
)

% function for inserting into ht-columns
#(define (insert-in-ht ht nr mykey myval)
    (let* (
        (tmp (hash-ref ht nr))
        (ht-tmp (make-hash-table))
        )
        (if (equal? tmp #f)
            (begin
            (hash-set! ht-tmp mykey myval )
            (hash-set! ht nr ht-tmp )
            )
            (hash-set! tmp mykey myval )
        )
        ;(disp tmp ht nr)
    )
)




#(define (get-ht-value keyA keyB)
    (hash-ref (hash-ref ht-columns keyB) keyA))


#(define (get-hash-table-keys ht)
    (let* (
        (all (hash-map->list cons ht))
        (keys (map
               (lambda (x)
                   (first x))
               all))
        )
        keys
    )
)

%% mainly for debugging
#(define (sort-hash-table-by-keys ht)
     ; returns a sorted list
    (let* (
        (keys (get-hash-table-keys ht))
        (sorted-keys (sort keys <))
        (sorted-ht-list (map
            (lambda (x)
                (cons x (hash-ref ht x )))
                sorted-keys))
        )
        sorted-ht-list
    )
)

%% for debugging reasons
% display ht-columns
#(define (display-ht ht)
     (let* (
         (all-paps (sort-hash-table-by-keys ht)))
         (for-each (lambda (x)
             (disp (car x) (hash-table->alist  (cdr x))))
             all-paps)))

%%%%%%%%%%%%%%%%%%%%%%%%%% LILYPOND HELPER %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

#(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))     
    (set! zaehler (+ zaehler 1))
)

#(define (draw-annotationB grob)
    ;; for debugging:
    ;; draws a number to the grob
    ;; and a counter plus a line to the console
    (ly:grob-set-nested-property! grob (list 'details 'spanner-id ) zaehler)
    (ly:grob-set-property! grob  'annotation (number->string zaehler))
    (ly:grob-set-property! grob  'annotation-line #t)
    (disp (string-append  (number->string zaehler) " ----------------" ))
    (set! zaehler (+ zaehler 1))
)

#(define (props grob)
     (dloop  (ly:grob-properties grob ) )
     )

#(define (bprops grob)
     (dloop  (ly:grob-basic-properties grob ) )
     )

#(define (grob-name grob)
    (assq-ref (ly:grob-property grob 'meta) 'name))
#(define (get-elements grob)
     (ly:grob-array->list (ly:grob-object  grob 'elements)))


#(define (get-parent-in-hierarchie grob searchword)
     ;; goes up in hierarchie until it finds
     ;; a grob named searchword     
     (define result #f)
     
     (define (get-par grob)
     
         (define compare
             (lambda (x)
                 (and (ly:grob? x)
                      (equal? searchword (grob-name x)))))   

        (let* (
            (parx   (ly:grob-parent grob X))
            (pary   (ly:grob-parent grob Y))
            )
           
            ;(disp (list parx (compare parx) pary (compare pary)))

            (cond
                ((not(equal? result #f))                     
                     result )
                ((compare parx)
                    (set! result parx)
                    result)
                ((compare pary)
                    (set! result pary)
                    result)
                (else
                    (if (ly:grob? parx)
                        (get-par parx))
                    (if(ly:grob? pary)
                        (get-par pary)) 
                )
            )
        )
    )
    ;; the inner function gets called from here
    (let* (
        (result (get-par grob))
        )
        ;; check if we found something
        (if (ly:grob? result)
            result
            #f
        )
    )
)

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%


% counts PaperColumns and NonMusicalPaperColumns
#(define counterPC 0)

% hash table, holding PaperColumns, Lyrics and Notes
% key is the counterPC
#(define ht-columns (make-hash-table))
% Table entry looks like:
%
% col-counter
% col grob
% oben grob
% mitte-oben grob
% mitte-unten grob
% unten grob

%% hash-table and counter for debugging
#(define ht-slurs (make-hash-table))
#(define slur-counter 0)

%% creates hash-table with paper-cols, slurs, lyrics
%% key rank of column
%% for later use with set_control_points
collect_cols_slurs_and_lyrics =
#(make-engraver   
    (acknowledgers
        ;; receive PaperColums and NonMusicalPaperColumns
        ;; System linebreaks will later change from NonMus.. to Items
        ;; automatically. => system line breaks
        ((paper-column-interface engraver grob source-engraver)         
            ; (disp 'pap-col counterPC grob)
            (insert-in-ht ht-columns counterPC "grob" grob)
            (set! counterPC (1+ counterPC ))
        )
 
        ((text-interface  engraver grob source-engraver)
            ; for debugging: write counter to lyrics
            ;(ly:grob-set-property! grob 'text (number->string counterPC))
            (let* (
                (id (ly:context-id (ly:translator-context engraver)))
                )
                ; (disp '---lyrics counterPC id)
                (if (member id (list "txt-oben" "txt-unten"))
                    (begin
                        (insert-in-ht ht-columns (1+ counterPC) id grob)
                        (ly:grob-set-property! grob 'annotation id))
                )
            )
        )
       
        ((note-column-interface  engraver grob source-engraver)
            (let* (
                (id (ly:context-id (ly:translator-context engraver)))
                )
                ; (disp '---note counterPC id)
                (if (member id (list "oben" "unten"))
                    (begin
                        (insert-in-ht ht-columns (1+ counterPC) id grob)
                        (ly:grob-set-property! grob 'annotation id)
                        )
                )
            )
        )
       
        ;; for debugging slurs: create hash-table, mom : counter
        ((slur-interface  engraver grob source-engraver)
            (let* (
                (id (ly:context-id (ly:translator-context engraver)))
                (mom (ly:context-current-moment (ly:translator-context engraver)))
                )
                 (if (member id (list "oben" "unten"))
                     (begin
                     (hash-set! ht-slurs mom  slur-counter)
                     (set! slur-counter (1+ slur-counter))
                     )
                 )
            )
        )       
    )
)


#(define (shape-slurs grob)   
   (let* (
        ;; original ControlPoints
        (cps (ly:slur::calc-control-points grob))
        ; spanner: pair of most left, most right PaperColumn of grob
        (rank-interval  ( ly:grob-spanned-rank-interval  grob ))             
        )

        (set-control-points grob cps rank-interval)
       
        ;; debugging, pick one grob by annotation
        ;(draw-annotationB grob) 
        ; (if (equal? "70" (ly:grob-property grob 'annotation))
;              (let* (
;                  (tmp 0)
;                  )
;                  (display-ancestry grob)
;                  ;(display-ht ht-columns)
;                  tmp))   
    )   
)

shapeSlur =
#(define-music-function (parser location)
    ()
    #{
      \override Staff.PhrasingSlur.cross-staff = ##t
      \override Staff.PhrasingSlur.after-line-breaking = #shape-slurs
    #})



Codebeispiel 3

Code: [Auswählen]

\version "2.19.54"


#(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* (set-controlPoint cps nr xy-values)
     (cond
         ((= 0 nr)
              (set-car! cps xy-values))
         ((= 1 nr)
              (set-car! (cdr cps) xy-values))
         ((= 2 nr)
              (set-car! (cddr cps) xy-values))
         ((= 3 nr)
              (set-car! (cdddr cps) xy-values))
     )
)


#(define (get-ctx grob)
    ;; get ctx from note-columns annotation
    (let* (
        (note-column (ly:grob-parent grob X))
        (ctx  (ly:grob-property note-column 'annotation))
        )
        ;; if slur has no parent (because it sits on a edge)
        ;; get ctx from another nc in the same VerticalAxisGroup
        (if (equal? ctx '())
            (let* (
                (va-group (get-parent-in-hierarchie grob 'VerticalAxisGroup))
                (els (get-elements va-group))
                ;; function for break-loop
                (fkt (lambda (x) (grob::name (list-ref els x ))))
                (nc (break-loop  els fkt 'NoteColumn ))
                )
                (set! ctx (ly:grob-property nc 'annotation))
            )
        )
    ctx)
)

#(define (pairs-to-plain-list list-of-pairs)
  (let (
      (mylist '())
      )
      (for-each
          (lambda (x)
              (set! mylist
                    ( append mylist (list (car x)) (list (cdr x))))
              )
          list-of-pairs
          )
      mylist
  )
)



%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define counter 0)
   

#(define (set-control-point grob rank ctx)
    ;; This method tries to calculate the vertical distances
    ;; between grobs in a PaperColumn.
    ;; It collects all VerticalAxisGroups, gets their extends
    ;; and adds these extends one by one to a slur.
     
    (let* (
        (nc (get-parent-in-hierarchie grob 'NoteColumn))
        (pap (get-parent-in-hierarchie grob 'PaperColumn))
        (cps (ly:slur::calc-control-points grob))
               
        ;; this would have been the easiest solution:
        ;; calculate the vertical distance of a grob
        ;; to the system grob. But using this method
        ;; crashes lilyponds layout without raising errors.
        (refp (ly:grob-system grob))
        (rank-table (hash-ref ht-columns rank ))
        (lyr-grob (hash-ref rank-table (string-append "txt-" ctx)))
        ;; Error happens here:
        ;(abst (ly:grob-extent lyr-grob refp Y))
         

        ;; get all VerticalAxisGroups
        (vertAxis (ly:grob-parent grob Y))
        (vertAlign (ly:grob-parent vertAxis Y))
        (els (get-elements vertAlign))

        ;; Create a list of values
        (fkt ly:axis-group-interface::pure-height)
       
        (VAA (fkt (first els) 0 1 ))
        (VAB (fkt (second els) 0 1 ))
        (VAC (fkt (third els) 0 1 ))
        (VAD (fkt (fourth els) -1 3 )) ;; 0 1 results in (-inf . -inf)
        (VAE (fkt (fifth els) 0 1 ))
       
        (listeA (pairs-to-plain-list (list VAA VAB VAC VAD VAE)))
       
       
        ;; Create another list of values
        (fkt ly:axis-group-interface::height)
       
        (VAA- (fkt (first els)))
        (VAB- (fkt (second els)))
        (VAC- (fkt (third els)))
        (VAD- (fkt (fourth els)))
        (VAE- (fkt (fifth els)))
       
        (listeB (pairs-to-plain-list (list VAA- VAB- VAC- VAD- VAE-)))
       
       
        (liste 0)
       
       
        (mom (ly:grob-property pap 'when))
        (pos  (hash-ref ht-slurs mom))
        (posB (modulo pos 9))
        (zahlen 0)
       
        (tmp 0)
 
       
        )
       
        ;; use listeA for first 9 slurs, listeB for next 9
        ;;
        (cond
            ((= (floor (/ pos 9)) 0) (set! liste listeA))
            ((= (floor (/ pos 9)) 1) (set! liste listeB))
            (#t (set! liste '())))
       
        ;; displaying

        (fdisp 6
            (format #f "nr ~A"  counter)
            (format #f "Liste ~A"  (floor(/ pos 9))) 
            (format #f "Grob-Pos ~A"  pos)
             )
        ;(disp liste)


        ; (disp (ly:grob::stencil-height vertAxis))
;         (disp (ly:hara-kiri-group-spanner::y-extent vertAxis))
;         (disp 'PURE_HEIGHT (ly:system::calc-pure-height refp 0 1 ))
;         (disp 'Staff-Staff-Spacing (ly:axis-group-interface::calc-staff-staff-spacing vertAxis))
                 
         
         

          (if (not (equal? '() liste))
             
              (begin
                  ;; add one list entry every counter step
                  (set! zahlen (list-cut! liste 1 (1+ posB) ))
                  ;; set all entries to negative values
                  (set! zahlen
                      (map (lambda (x)
                          (* (abs x) -1))
                          zahlen))
                  ;; display
                  (disp zahlen)
                 
                  ;(disp 'ERGEBNIS counter zahlen)
                  ;; sum all values in zahlen
                  (set! tmp (+ (sum zahlen) (car VAA)))
                  ;(set! tmp (+ (sum zahlen) 0))
                 
                  (set-controlPoint cps 0 `( -0.2 . ,tmp ))
                 
                  (ly:grob-set-property! grob 'control-points cps)
              )
          )
 
         (set! counter (1+ counter))
    )
)



#(define (set-control-points grob cps rank-interval)
   
    (let* (
        (ctx (get-ctx grob))
        (rank (car rank-interval))
        )
        (set-control-point grob rank ctx)
    )
)

Die eigentliche Magie wird in set-control-point im dritten Codebeispiel ausgeführt. Dort kann auch mit den Werten oder der Art der Berechnung herumgespielt werden.

Vielen Dank für Hilfe oder Anmerkungen im Voraus!
Xaver

[fugenkomponist]

Was hast du denn mit der Info vor? Vielleicht hilft dir dieser aktuelle Thread auf der englischen Liste weiter. Die bisher letzte Mail da ist von gestern, also läuft der Thread vermutlich sogar noch.

[xr]

Herzlichen Dank für den Link. Da wird tatsächlich nach genau der gleichen Sache gefragt. Eine Lösung konnte ich für mich in den Antworten aber noch nicht finden.

Ich will die Phrasierungsbögen setzen, mit denen ich mich hier schon auseinandergesetzt habe:
https://archiv.lilypondforum.de/index.php?topic=2503.msg14153#msg14153
(siehe Bild)

Ich habe auch schon eine Property gefunden, die die Werte enthält, die ich suche:
minimum-translations-alist eines VerticalAlignment Grobs

Die Einträge sehen z.B. so aus:

Code: [Auswählen]

((4 . 12) -4.66666666666667 -9.9921186351706 -15.1929286089239 -20.8017139107612 -24.3517139107612)
((4 . 10) -4.66666666666667 -9.9921186351706 -15.1929286089239 -20.8017139107612 -24.3517139107612)
((4 . 8) -4.66666666666667 -9.9921186351706 -15.1929286089239 -20.8017139107612 -24.3517139107612)
((4 . 6) -4.66666666666667 -8.89953280839895 -13.588193175853 -19.1969784776903 -22.7469784776903)
((2 . 24) -4.66666666666667 -10.0262619422572 -15.2270719160105 -20.8358572178478 -24.3858572178478)
((2 . 22) -4.66666666666667 -10.0262619422572 -15.2270719160105 -20.8358572178478 -24.3858572178478)
((2 . 20) -4.66666666666667 -10.0262619422572 -15.2270719160105 -20.8358572178478 -24.3858572178478)
((2 . 18) -4.66666666666667 -9.9921186351706 -15.1929286089239 -20.8017139107612 -24.3517139107612)
Prinzipiell sind das wohl die Abstände von der Grundlinie des Systems zu jedem Ankerpunkt in der Spalte. Und der erste Wert des Pairs am Anfang ist der Rang der Spalte im Layout.
Ich verstehe aber den zweiten Wert noch nicht.
Und meine Bögen sitzen auch immer auf dem Rang dazwischen, also beispielsweise 3.

Durch Ausprobieren habe ich herausgefunden, dass diese Zeile: ((2 . 18) -4.66666666666667 -9.9921186351706 -15.1929286089239 -20.8017139107612 -24.3517139107612) genau die Werte enthält, die ich suche. Aber wie kann ich die Zeile bestimmen?

[fugenkomponist]

Herzlichen Dank für den Link. Da wird tatsächlich nach genau der gleichen Sache gefragt. Eine Lösung konnte ich für mich in den Antworten aber noch nicht finden.

Dann würd ich vorschlagen, das mal weiter zu verfolgen. harm, der von uns hier im Forum noch am meisten Ahnung von so Scheme-Sachen hat, hat in dem Thread auch schon geschrieben, d. h. er wird da wohl auch weiter mitlesen. Ich ebenfalls und die anderen beiden beteiligten David und Urs sprechen zwar auch beide deutsch, sind aber nicht hier im Forum. Wenn der Thread zu nem Ergebnis kommt, kann man das Ergebnis ja hier dann posten. Vielleicht magst du deine Erkenntnisse da schonmal einbringen? Ich selbst werd mir das heute Abend mal anschauen.

[xr]

Ich habe jetzt eine Lösung mit leichten Ungenauigkeiten.
Ich habe kurzerhand immer den letzten Wert aus der Liste genommen, den mir minimum-translations-alist ausgibt.

Hier der Code. Einfach Codebeispiel 3 damit ersetzen.

Code: [Auswählen]

\version "2.18.2"


#(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* (set-controlPoint cps nr xy-values)
     (cond
         ((= 0 nr)
              (set-car! cps xy-values))
         ((= 1 nr)
              (set-car! (cdr cps) xy-values))
         ((= 2 nr)
              (set-car! (cddr cps) xy-values))
         ((= 3 nr)
              (set-car! (cdddr cps) xy-values))
     )
)


#(define (get-ctx grob)
    ;; get ctx from note-columns annotation
    (let* (
        (note-column (ly:grob-parent grob X))
        (ctx  (ly:grob-property note-column 'annotation))
        )
        ;; if slur has no parent (because it sits on a edge)
        ;; get ctx from another nc in the same VerticalAxisGroup
        (if (equal? ctx '())
            (let* (
                (va-group (get-parent-in-hierarchie grob 'VerticalAxisGroup))
                (els (get-elements va-group))
                ;; function for break-loop
                (fkt (lambda (x) (grob::name (list-ref els x ))))
                (nc (break-loop  els fkt 'NoteColumn ))
                )
                (set! ctx (ly:grob-property nc 'annotation))
            )
        )
    ctx)
)


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define counter 0)
   
#(define (set-control-point grob rank ctx)
    ;; This method tries to calculate the vertical distances
    ;; between grobs in a PaperColumn.
    ;; It reads values from the minimum-translations-alist
    ;; of the VerticalAlignment
   
    (let* (
        (nc (get-parent-in-hierarchie grob 'NoteColumn))
        (pap (get-parent-in-hierarchie grob 'PaperColumn))
        (vertAlign (get-parent-in-hierarchie grob 'VerticalAlignment))
        (cps (ly:slur::calc-control-points grob))

        (mom (ly:grob-property pap 'when))
        (pos  (hash-ref ht-slurs mom))
               
        (trans-list (ly:grob-property vertAlign 'minimum-translations-alist))
        (ht-trans-list (make-hash-table))
       
        (actual-trans-list '())
        (chosen-value 0)
        )
       
        ;; this method uses the last value of the rank
        ;; given in the minimum-translation-list. It overwrites
        ;; all others before.
        (for-each (lambda (x)
            (hash-set! ht-trans-list (caar x)  (cdr x)))
            trans-list)

        (set! actual-trans-list (hash-ref ht-trans-list (1- rank)))
        ;; as the distances are related to the system line, but setting of the slur
        ;; is done from the first VerticalAxisGroup, the first value of the trans-list
        ;; is always substracted
        (set! chosen-value ( - (nth (modulo counter 5) actual-trans-list) (first actual-trans-list)))
       
        (fdisp 6
            (format #f "nr ~A"  counter)
            (format #f "Grob-Pos ~A"  pos)
            (format #f "value ~A"  chosen-value)
             )

          (set-controlPoint cps 0 `( -0.2 . ,chosen-value ))
          (ly:grob-set-property! grob 'control-points cps)

          (set! counter (1+ counter))
    )
)

#(define (set-control-points grob cps rank-interval)
   
    (let* (
        (ctx (get-ctx grob))
        (rank (car rank-interval))
        )
        (set-control-point grob rank ctx)
    )
)

Der Code dient als Beispiel und kann durchaus verfeinert werden. Z.B. wird der Hash-Table, der erstellt wird, bei jedem Durchlauf erneut erstellt. Einmal würde auch reichen.
Im Codebsp 2 könnte auch Code gestrichen werden.

Die Ungenauigkeiten, die ich oben erwähnt habe, sieht man, wenn man Bögen direkt an der h-Linie betrachtet. Manche müßten einen Tacken tiefer. Aber für meine Zwecke reicht das wohl so.


Gruß,
Xaver

[harm6]

harm, der von uns hier im Forum noch am meisten Ahnung von so Scheme-Sachen hat, hat in dem Thread auch schon geschrieben, d. h. er wird da wohl auch weiter mitlesen.

Eigentlich lese ich immer mit
Jedoch habe ich zu häufig keine Zeit mich mit dem jeweiligen Anliegen zu beschäftigen und falls mir was dazu einfällt (was nicht notwendigerweise der Fall ist) das auch zu posten.
Aber jetzt ist ja Wochenende ...

@Xaver
Deinen Code habe ich compiliert, bislang aber nur flüchtig durchgesehen.
Mir ist unklar wie Du die Bögen setzen willst. Damit meine ich wo sollen sie anfangen und enden, nicht im Sinne von numerischen Werten, sondern welche Grobs Du treffen willst?
Du veränderst ja die spanner-bounds nicht...

Sonstige Beobachtungen:
(1)
Sobald Du
system-system-spacing.padding
auf einen anderen (hohen) Wert setzt stimmt alles nicht mehr.
Insoweit mein Interesse an den spanner-bounds
(2)
break-loop
ist in Deinen Beispielen nicht definiert und gibt unter bestimmten Bedingungen einen Fehler aus.
(3)
dloop ebenfalls
(4)
#(define (grob-name grob) ...
Es gibt grob::name im sourcecode, würde ich ersetzen/streichen. Später hast Du grob::name selbst verwendet
(5)
statt
#(define (sum elemList)
  (if
    (null? elemList)
    0
    (+ (car elemList) (sum (cdr elemList)))
  )
)
vielleicht
#(define (sum elemList)
(if (every number? elemList)
    (apply + elemList)
    elemList))
Falls Du anderweitig sicher gestellt hast, daß die Liste wirklich nur Zahlen enthält kann man sich die fool-proof-Bedingung vielleicht sogar sparen.


Soweit erstmal.
Alles erstmal Kleinigkeiten bis auf die spanner-bounds.

Gruß,
  Harm

[xr]

Hallo harms,

hier schonmal eine schnelle Antwort.

(2)
break-loop
ist in Deinen Beispielen nicht definiert und gibt unter bestimmten Bedingungen einen Fehler aus.
(3)
dloop ebenfalls

Hatte ich wohl vergessen zu kopieren. Hier der Code. Einfach einfügen.

Code: [Auswählen]

#(define (dloop vals)
    (define n 0)
    (for-each
        (lambda (x)
            (disp n)
            (if (list? n) (dloop n) n)
            (newline)
            (set! n (+ 1 n))
            (display x)
        )
        vals
    )
)
#(define (break-loop elements fkt condit)
    ;; elements => list
    ;; breaks loop when fkt result equals condit
    ;; or running out of elements
    ;; there should be a better solution for
    ;; the line: set! result ...
    (let* (
        (result #f)
        )
        (do ((i 1 (1+ i))
             (x (fkt 0)  (fkt i))
             )
            (
            (begin
                (set! result (list-ref elements (1- i) ))
                (= i (length elements)) or (equal? condit (fkt (1- i))))
            x)
        )
    result
    )
)


Mir ist unklar wie Du die Bögen setzen willst. Damit meine ich wo sollen sie anfangen und enden, nicht im Sinne von numerischen Werten, sondern welche Grobs Du treffen willst?
Du veränderst ja die spanner-bounds nicht...

Ich versuche die Werte numerisch zu berechnen. Ich habe da auch schon eine Lösung. Die Ausarbeitung dauert aber noch etwas.
Alles andere später.

Gruß,
Xaver

[xr]

Du veränderst ja die spanner-bounds nicht...

Bei diesem Thema ging es mir auch nicht um horizontale Abstände, sondern allein um die vertikalen. Und die kann man innerhalb eines Systems mit den Werten aus der minimum-translations-alist bestimmen. (Spanner bräuchte ich doch nur für horizontale Abstände, oder nicht?)

Ich vermute, dass die Liste verschiedene Berechnungen Lilyponds zur optimalen Positionierung wiederspiegelt, und der letzte Wert dann die beste Annäherung ist. Aber das vermute ich nur, vielleicht ist es auch anders, und es gibt einen internen Vorgang, der aus all diesen Werten später den optimalen aussucht.

Xaver

[xr]

Nachdem ich nun eine Weile und immer mal wieder mit der  minimum-translations-alist herumgespielt habe, ohne jedoch zu einer verläßlichen Lösung zu kommen, bin ich nun dazu übergegangen, die Lilyponddatei zweifach zu compilen. Beim ersten Mal werden die entsprechenden Werte ausgelesen, beim zweiten Mal dann eingesetzt.

Ausgelesen wird mit einer Funktion innerhalb einer Paper Umgebung, die erst angesprochen wird, wenn bereits alle Berechnungen abgeschlossen sind.

Code: [Auswählen]

\paper {   
    #(define (page-post-process layout pages)
        (get-slur-extents layout pages ))
}
Der Code geht mal wieder auf eine Anregung harms zurück:
http://lilypond.1069038.n5.nabble.com/intercepting-implicit-explicit-page-breaks-td194196.html#a194198

Wenn ich mein Ziel erreicht habe und halbwegs kommentierte und geordnete Dateien erzeugt haben werde, poste ich meine Lösung in diesem Thread:
https://archiv.lilypondforum.de/index.php?topic=2503.0

Xaver

[harm6]

Der Code geht mal wieder auf eine Anregung harms zurück

Zuviel der Ehre.

Tatsächlich wurde ich auf das Verfahren durch David Kastrup aufmersam gemacht, der es auf eine Anfrage meinerseits im Usage-Manual gefunden hatte. (Nicht diesen code, aber 'page-post-process')
Implementiert wurde es von Rainhold Kainhofer Jahre zuvor und war lange Zeit schlichtweg in Vergessenheit geraten.

Gruß,
  Harm

[xr]

Um die Abstände der Ankerpunkte zu finden, habe jetzt folgenden Code:

Code: [Auswählen]

#(define counter-va-lines 1)
#(define ht-va-distances (make-hash-table))

#(define (get-slur-extents layout pages)
;; This method has to be the first to be executed. It starts at the end
;; of the first compilation pass. Another pass is neccessary to use the calculated values.
;; It iterates over pages/system-lines/VerticalAlignment/VerticalAxisGroup.
;; Writes the distance between each VerticalAxisGroup
;; and the system baseline to the hash table ht-va-distances.
;; Key is the number of the system line, counted by
;; counter-va-lines
    (for-each (lambda (page)
        (for-each (lambda (line)
            (let* (
                (sys-grob (ly:prob-property line 'system-grob))
                )
                (if (not (equal? sys-grob '()))
                    (begin
                        (let* (
                            (vertAlign (ly:system::get-vertical-alignment sys-grob))
                            (va-groups (ly:grob-array->list (ly:grob-object  vertAlign 'elements)))
                            (tmp '())
                            )
                            (for-each
                             (lambda (group)
                                 ;; a VAGroup with no elements (e.g. no lyrics) will turn
                                 ;; to a spanner grob. As it has no properties, grob::name
                                 ;; returns false.
                                (if (grob::name group)
                                    ;; calculate relative position between
                                    ;; system baseline and VAGroup
                                    (set! tmp (append tmp (list
                                           (ly:grob-relative-coordinate group sys-grob Y))))
                                    (set! tmp (append tmp '(0 0)))
                                )
                             )
                             va-groups
                            )
                            (hash-set! ht-va-distances
                                         (number->string counter-va-lines)
                                         tmp)
                            (set! counter-va-lines (1+ counter-va-lines))
                        )
                    )
                )
            ))
            (ly:prob-property page 'lines)
        ))
        pages
    )
)
Eingebunden wird der Code mit:

Code: [Auswählen]

\paper {   
    #(define (page-post-process layout pages)
        (get-slur-extents layout pages))
}

Dies ist jetzt ein Auszug aus dem kompletten Beispiel in dem anderen Thread, den ich schon angesprochen hatte.
Das komplette Beispiel findet sich hier:
https://github.com/XRoemer/Lilypond/tree/master/Custom_Slurs
Und hier können alle Dateien als zip. heruntergeladen werden:
https://github.com/XRoemer/Lilypond

Gruß,
Xaver