(define-public (grob::is-live? grob)
(pair? (ly:grob-basic-properties grob)))
+(define-public (grob::x-parent-width grob)
+ (ly:grob-property (ly:grob-parent grob X) 'X-extent))
+
(define-public (make-stencil-boxer thickness padding callback)
"Return function that adds a box around the grob passed as argument."
(lambda (grob)
(ly:text-interface::interpret-markup layout props text)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; beam slope
+
+;; calculates each slope of a broken beam individually
+(define-public (beam::place-broken-parts-individually grob)
+ (ly:beam::quanting grob '(+inf.0 . -inf.0) #f))
+
+;; calculates the slope of a beam as a single unit,
+;; even if it is broken. this assures that the beam
+;; will pick up where it left off after a line break
+(define-public (beam::align-with-broken-parts grob)
+ (ly:beam::quanting grob '(+inf.0 . -inf.0) #t))
+
+;; uses the broken beam style from edition peters combines the
+;; values of place-broken-parts-individually and align-with-broken-parts above,
+;; favoring place-broken-parts-individually when the beam naturally has a steeper
+;; incline and align-with-broken-parts when the beam is flat
+(define-public (beam::slope-like-broken-parts grob)
+ (define (slope y x)
+ (/ (- (cdr y) (car y)) (- (cdr x) (car x))))
+ (let* ((quant1 (ly:beam::quanting grob '(+inf.0 . -inf.0) #t))
+ (original (ly:grob-original grob))
+ (siblings (if (ly:grob? original)
+ (ly:spanner-broken-into original)
+ '())))
+ (if (null? siblings)
+ quant1
+ (let* ((quant2 (ly:beam::quanting grob '(+inf.0 . -inf.0) #f))
+ (x-span (ly:grob-property grob 'X-positions))
+ (slope1 (slope quant1 x-span))
+ (slope2 (slope quant2 x-span))
+ (quant2 (if (not (= (sign slope1) (sign slope2)))
+ '(0 . 0)
+ quant2))
+ (factor (/ (atan (abs slope1)) PI-OVER-TWO))
+ (base (cons-map
+ (lambda (x)
+ (+ (* (x quant1) (- 1 factor))
+ (* (x quant2) factor)))
+ (cons car cdr))))
+ (ly:beam::quanting grob base #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; cross-staff stuff
+
+(define-public (script-or-side-position-cross-staff g)
+ (or
+ (ly:script-interface::calc-cross-staff g)
+ (ly:side-position-interface::calc-cross-staff g)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; note heads
(ly:duration-log
(ly:event-property (event-cause grob) 'duration)))
+(define-public (stem::length grob)
+ (let* ((ss (ly:staff-symbol-staff-space grob))
+ (beg (ly:grob-property grob 'stem-begin-position))
+ (beam (ly:grob-object grob 'beam)))
+ (if (null? beam)
+ (abs (- (ly:stem::calc-stem-end-position grob) beg))
+ (begin
+ (ly:programming-error
+ "stem::length called but will not be used for beamed stem.")
+ 0.0))))
+
+(define-public (stem::pure-length grob beg end)
+ (let* ((ss (ly:staff-symbol-staff-space grob))
+ (beg (ly:grob-pure-property grob 'stem-begin-position 0 1000)))
+ (abs (- (ly:stem::pure-calc-stem-end-position grob 0 2147483646) beg))))
+
+(define (stem-stub::do-calculations grob)
+ (and (ly:grob-property (ly:grob-parent grob X) 'cross-staff)
+ (not (ly:grob-property (ly:grob-parent grob X) 'transparent))))
+
+(define-public (stem-stub::pure-height grob beg end)
+ (if (stem-stub::do-calculations grob)
+ '(0 . 0)
+ '(+inf.0 . -inf.0)))
+
+(define-public (stem-stub::width grob)
+ (if (stem-stub::do-calculations grob)
+ (grob::x-parent-width grob)
+ '(+inf.0 . -inf.0)))
+
+(define-public (stem-stub::extra-spacing-height grob)
+ (if (stem-stub::do-calculations grob)
+ (let* ((dad (ly:grob-parent grob X))
+ (refp (ly:grob-common-refpoint grob dad Y))
+ (stem_ph (ly:grob-pure-height dad refp 0 1000000))
+ (my_ph (ly:grob-pure-height grob refp 0 1000000))
+ ;; only account for distance if stem is on different staff than stub
+ (dist (if (grob::has-interface refp 'hara-kiri-group-spanner-interface)
+ 0
+ (- (car my_ph) (car stem_ph)))))
+ (if (interval-empty? (interval-intersection stem_ph my_ph)) #f (coord-translate stem_ph dist)))
+ #f))
+
(define-public (note-head::calc-duration-log grob)
(min 2
(ly:duration-log
(define-public (inherit-x-parent-visibility grob)
(let ((parent (ly:grob-parent grob X)))
(ly:grob-property parent 'break-visibility all-invisible)))
+(define-public (inherit-y-parent-visibility grob)
+ (let ((parent (ly:grob-parent grob X)))
+ (ly:grob-property parent 'break-visibility)))
(define-public spanbar-begin-of-line-invisible #(#t #f #f))
(equal? (ly:item-break-dir g) RIGHT))
(ly:grob-translate-axis! g 3.5 X)))
+(define-public (pure-from-neighbor-interface::extra-spacing-height-at-beginning-of-line grob)
+ (if (= 1 (ly:item-break-dir grob))
+ (pure-from-neighbor-interface::extra-spacing-height grob)
+ (cons -0.1 0.1)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height grob)
+ (let* ((height (ly:grob::stencil-height grob))
+ (from-neighbors (interval-union
+ height
+ (ly:axis-group-interface::pure-height
+ grob
+ 0
+ 10000000))))
+ (coord-operation - from-neighbors height)))
+
+(define-public (pure-from-neighbor-interface::account-for-span-bar grob)
+ (let* ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
+ (hsb (ly:grob-property grob 'has-span-bar))
+ (ii (interval-intersection esh (cons -1.01 1.01))))
+ (if (pair? hsb)
+ (cons (car (if (and (car hsb)
+ (ly:grob-property grob 'allow-span-bar))
+ esh ii))
+ (cdr (if (cdr hsb) esh ii)))
+ ii)))
+
+(define-public (pure-from-neighbor-interface::extra-spacing-height-including-staff grob)
+ (let ((esh (pure-from-neighbor-interface::extra-spacing-height grob))
+ (to-staff (coord-operation -
+ (interval-widen
+ '(0 . 0)
+ (ly:staff-symbol-staff-radius grob))
+ (ly:grob::stencil-height grob))))
+ (interval-union esh to-staff)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Tuplets
+(define-public (tuplet-number::calc-direction grob)
+ (ly:tuplet-bracket::calc-direction (ly:grob-object grob 'bracket)))
+
(define-public (tuplet-number::calc-denominator-text grob)
(number->string (ly:event-property (event-cause grob) 'denominator)))
(define-public (tuplet-number::calc-fraction-text grob)
(let ((ev (event-cause grob)))
- (format "~a:~a"
+ (format #f "~a:~a"
(ly:event-property ev 'denominator)
(ly:event-property ev 'numerator))))
(den (if denominator denominator (ly:event-property ev 'denominator)))
(num (if numerator numerator (ly:event-property ev 'numerator))))
- (format "~a:~a" den num)))
+ (format #f "~a:~a" den num)))
;; Print a tuplet fraction with note durations appended to the numerator and the
;; denominator
(num (if numerator numerator (ly:event-property ev 'numerator))))
(make-concat-markup (list
- (make-simple-markup (format "~a" den))
+ (make-simple-markup (format #f "~a" den))
(markup #:fontsize -5 #:note denominatornote UP)
(make-simple-markup " : ")
- (make-simple-markup (format "~a" num))
+ (make-simple-markup (format #f "~a" num))
(markup #:fontsize -5 #:note numeratornote UP)))))
(+ c0 p))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; annotations
+
+(define-public (numbered-footnotes int)
+ (markup #:tiny (number->string (+ 1 int))))
+
+(define-public (symbol-footnotes int)
+ (define (helper symbols out idx n)
+ (if (< n 1)
+ out
+ (helper symbols
+ (string-append out (list-ref symbols idx))
+ idx
+ (- n 1))))
+ (markup #:tiny (helper '("*" "†" "‡" "§" "¶")
+ ""
+ (remainder int 5)
+ (+ 1 (quotient int 5)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; accidentals
(ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X))))
-(define (parentheses-item::print me)
+(define-public (parentheses-item::print me)
(let* ((elts (ly:grob-object me 'elements))
(y-ref (ly:grob-common-refpoint-of-array me elts Y))
(x-ref (ly:grob-common-refpoint-of-array me elts X))
projects / lilypond.git / blobdiff