+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; instrument names
+
+(define-public (system-start-text::print grob)
+ (let* ((left-bound (ly:spanner-bound grob LEFT))
+ (left-mom (ly:grob-property left-bound 'when))
+ (name (if (moment<=? left-mom ZERO-MOMENT)
+ (ly:grob-property grob 'long-text)
+ (ly:grob-property grob 'text))))
+
+ (if (and (markup? name)
+ (!= (ly:item-break-dir left-bound) CENTER))
+
+ (grob-interpret-markup grob name)
+ (ly:grob-suicide! grob))))
+
+(define-public (system-start-text::calc-x-offset grob)
+ (let* ((left-bound (ly:spanner-bound grob LEFT))
+ (left-mom (ly:grob-property left-bound 'when))
+ (layout (ly:grob-layout grob))
+ (indent (ly:output-def-lookup layout
+ (if (moment<=? left-mom ZERO-MOMENT)
+ 'indent
+ 'short-indent)
+ 0.0))
+ (system (ly:grob-system grob))
+ (my-extent (ly:grob-extent grob system X))
+ (elements (ly:grob-object system 'elements))
+ (common (ly:grob-common-refpoint-of-array system elements X))
+ (total-ext empty-interval)
+ (align-x (ly:grob-property grob 'self-alignment-X 0))
+ (padding (min 0 (- (interval-length my-extent) indent)))
+ (right-padding (- padding
+ (/ (* padding (1+ align-x)) 2))))
+
+ ;; compensate for the variation in delimiter extents by
+ ;; calculating an X-offset correction based on united extents
+ ;; of all delimiters in this system
+ (let unite-delims ((l (ly:grob-array-length elements)))
+ (if (> l 0)
+ (let ((elt (ly:grob-array-ref elements (1- l))))
+
+ (if (grob::has-interface elt 'system-start-delimiter-interface)
+ (let ((dims (ly:grob-extent elt common X)))
+ (if (interval-sane? dims)
+ (set! total-ext (interval-union total-ext dims)))))
+ (unite-delims (1- l)))))
+
+ (+
+ (ly:side-position-interface::x-aligned-side grob)
+ right-padding
+ (- (interval-length total-ext)))))
+
+(define-public (system-start-text::calc-y-offset grob)
+
+ (define (live-elements-list me)
+ (let ((elements (ly:grob-object me 'elements)))
+
+ (filter! grob::is-live?
+ (ly:grob-array->list elements))))
+
+ (let* ((left-bound (ly:spanner-bound grob LEFT))
+ (live-elts (live-elements-list grob))
+ (system (ly:grob-system grob))
+ (extent empty-interval))
+
+ (if (and (pair? live-elts)
+ (interval-sane? (ly:grob-extent grob system Y)))
+ (let get-extent ((lst live-elts))
+ (if (pair? lst)
+ (let ((axis-group (car lst)))
+
+ (if (and (ly:spanner? axis-group)
+ (equal? (ly:spanner-bound axis-group LEFT)
+ left-bound))
+ (set! extent (add-point extent
+ (ly:grob-relative-coordinate
+ axis-group system Y))))
+ (get-extent (cdr lst)))))
+ ;; no live axis group(s) for this instrument name -> remove from system
+ (ly:grob-suicide! grob))
+
+ (+
+ (ly:self-alignment-interface::y-aligned-on-self grob)
+ (interval-center extent))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ambitus
+
+(define-public (ambitus::print grob)
+ (let ((heads (ly:grob-object grob 'note-heads)))
+
+ (if (and (ly:grob-array? heads)
+ (= (ly:grob-array-length heads) 2))
+ (let* ((common (ly:grob-common-refpoint-of-array grob heads Y))
+ (head-down (ly:grob-array-ref heads 0))
+ (head-up (ly:grob-array-ref heads 1))
+ (gap (ly:grob-property grob 'gap 0.35))
+ (point-min (+ (interval-end (ly:grob-extent head-down common Y))
+ gap))
+ (point-max (- (interval-start (ly:grob-extent head-up common Y))
+ gap)))
+
+ (if (< point-min point-max)
+ (let* ((layout (ly:grob-layout grob))
+ (line-thick (ly:output-def-lookup layout 'line-thickness))
+ (blot (ly:output-def-lookup layout 'blot-diameter))
+ (grob-thick (ly:grob-property grob 'thickness 2))
+ (width (* line-thick grob-thick))
+ (x-ext (symmetric-interval (/ width 2)))
+ (y-ext (cons point-min point-max))
+ (line (ly:round-filled-box x-ext y-ext blot))
+ (y-coord (ly:grob-relative-coordinate grob common Y)))
+
+ (ly:stencil-translate-axis line (- y-coord) Y))
+ empty-stencil))
+ (begin
+ (ly:grob-suicide! grob)
+ (list)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; laissez-vibrer tie
+;;
+;; needed so we can make laissez-vibrer a pure print
+;;
+(define-public (laissez-vibrer::print grob)
+ (ly:tie::print grob))
+