X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=70e3ba3eeb07885ff46475ec6f20b2a841dd01f8;hb=b4f94970298560fa2a9c8981db1d8e72ca01eda8;hp=f00273add6e236028ade8dffbe917d4f7d8d21d2;hpb=adc6cbf9a271370c1453bfca918f810d9f2906f1;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index f00273add6..70e3ba3eeb 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -56,6 +56,15 @@ (ly:text-interface::interpret-markup layout props text))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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 @@ -63,6 +72,21 @@ (ly:duration-log (ly:event-property (event-cause grob) 'duration))) +(define-public (stem::length grob) + (let* ((d (ly:grob-property grob 'direction)) + (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)) + (ly:grob-property grob 'length)))) + +(define-public (stem::pure-length grob beg end) + (let* ((d (ly:grob-property grob 'direction)) + (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-public (note-head::calc-duration-log grob) (min 2 (ly:duration-log @@ -244,6 +268,9 @@ and duration-log @var{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)) @@ -321,13 +348,16 @@ and duration-log @var{log}." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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)))) @@ -357,7 +387,7 @@ and duration-log @var{log}." (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 @@ -379,10 +409,10 @@ and duration-log @var{log}." (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))))) @@ -461,6 +491,25 @@ and duration-log @var{log}." (+ 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 @@ -586,7 +635,7 @@ and duration-log @var{log}." (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))