X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=8701b6b188dd9aebf2f887bd3273d5dd7adaa9cd;hb=48678617b169957433c562612151f2a71be50b59;hp=33a03139dead37a6f1e6a09d3cf57259ef466e6e;hpb=3eb0d21c7cac9360c37c3376c8771e6e29c1a588;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 33a03139de..8701b6b188 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -249,6 +249,14 @@ ly:self-alignment-interface::y-aligned-on-self ly:self-alignment-interface::pure-y-aligned-on-self)) +(define-public (self-alignment-interface::self-aligned-on-breakable grob) + "Return the @code{X-offset} that places @var{grob} according to its + @code{self-alignment-X} over the reference point defined by the + @code{break-align-anchor-alignment} of a @code{break-aligned} item + such as a @code{Clef}." + (+ (ly:break-alignable-interface::self-align-callback grob) + (ly:self-alignment-interface::x-aligned-on-self grob))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; staff symbol @@ -562,34 +570,37 @@ and duration-log @var{log}." ;; a formatter function, which is simply a wrapper around an existing ;; tuplet formatter function. It takes the value returned by the given ;; function and appends a note of given length. -(define-public ((tuplet-number::append-note-wrapper function note) grob) +(define ((tuplet-number::append-note-wrapper function note) grob) (let ((txt (if function (function grob) #f))) (if txt (markup txt #:fontsize -5 #:note note UP) (markup #:fontsize -5 #:note note UP)))) +(export tuplet-number::append-note-wrapper) ;; Print a tuplet denominator with a different number than the one derived from ;; the actual tuplet fraction -(define-public ((tuplet-number::non-default-tuplet-denominator-text denominator) +(define ((tuplet-number::non-default-tuplet-denominator-text denominator) grob) (number->string (if denominator denominator (ly:event-property (event-cause grob) 'denominator)))) +(export tuplet-number::non-default-tuplet-denominator-text) ;; Print a tuplet fraction with different numbers than the ones derived from ;; the actual tuplet fraction -(define-public ((tuplet-number::non-default-tuplet-fraction-text +(define ((tuplet-number::non-default-tuplet-fraction-text denominator numerator) grob) (let* ((ev (event-cause grob)) (den (if denominator denominator (ly:event-property ev 'denominator))) (num (if numerator numerator (ly:event-property ev 'numerator)))) (format #f "~a:~a" den num))) +(export tuplet-number::non-default-tuplet-fraction-text) ;; Print a tuplet fraction with note durations appended to the numerator and the ;; denominator -(define-public ((tuplet-number::fraction-with-notes +(define ((tuplet-number::fraction-with-notes denominatornote numeratornote) grob) (let* ((ev (event-cause grob)) (denominator (ly:event-property ev 'denominator)) @@ -597,10 +608,11 @@ and duration-log @var{log}." ((tuplet-number::non-default-fraction-with-notes denominator denominatornote numerator numeratornote) grob))) +(export tuplet-number::fraction-with-notes) ;; Print a tuplet fraction with note durations appended to the numerator and the ;; denominator -(define-public ((tuplet-number::non-default-fraction-with-notes +(define ((tuplet-number::non-default-fraction-with-notes denominator denominatornote numerator numeratornote) grob) (let* ((ev (event-cause grob)) (den (if denominator denominator (ly:event-property ev 'denominator))) @@ -612,6 +624,7 @@ and duration-log @var{log}." (make-simple-markup " : ") (make-simple-markup (format #f "~a" num)) (markup #:fontsize -5 #:note numeratornote UP))))) +(export tuplet-number::non-default-fraction-with-notes) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -620,8 +633,8 @@ and duration-log @var{log}." (define-public (color? x) (and (list? x) (= 3 (length x)) - (apply eq? #t (map number? x)) - (apply eq? #t (map (lambda (y) (<= 0 y 1)) x)))) + (every number? x) + (every (lambda (y) (<= 0 y 1)) x))) (define-public (rgb-color r g b) (list r g b)) @@ -673,6 +686,20 @@ and duration-log @var{log}." (prepend (+ x 7) (cons x l)))) (prepend first-position '()))))) +(define-public (key-signature-interface::alteration-position + step alter c0-position) +;; Deprecated. Not a documented interface, and no longer used in LilyPond, +;; but needed for a popular file, LilyJAZZ.ily for version 2.16 + (if (pair? step) + (+ (cdr step) (* (car step) 7) c0-position) + (let* ((c-pos (modulo c0-position 7)) + (hi (list-ref + (if (< alter 0) + '(2 3 4 2 1 2 1) ; position of highest flat + '(4 5 4 2 3 2 3)); position of highest sharp + c-pos))) + (- hi (modulo (- hi (+ c-pos step)) 7))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; annotations @@ -898,8 +925,8 @@ and duration-log @var{log}." (left-x (+ padding (max - (interval-end (ly:grob-robust-relative-extent - left-span common X)) + (interval-end (ly:generic-bound-extent + left-span common)) (if (and dots (close @@ -909,7 +936,7 @@ and duration-log @var{log}." (ly:grob-robust-relative-extent dots common X)) (- INFINITY-INT))))) (right-x (max (- (interval-start - (ly:grob-robust-relative-extent right-span common X)) + (ly:generic-bound-extent right-span common)) padding) (+ left-x minimum-length))) (self-x (ly:grob-relative-coordinate spanner common X)) @@ -1007,7 +1034,7 @@ between the two text elements." '(bound-details left padding) (+ my-padding script-padding))))))) -(define-public ((elbowed-hairpin coords mirrored?) grob) +(define ((elbowed-hairpin coords mirrored?) grob) "Create hairpin based on a list of @var{coords} in @code{(cons x y)} form. @code{x} is the portion of the width consumed for a given line and @code{y} is the portion of the height. For example, @@ -1066,6 +1093,7 @@ and draws the stencil based on its coordinates. (if mirrored? (my-c-p-s downlist thick decresc?) empty-stencil)) (cons xtrans ytrans))) '()))) +(export elbowed-hairpin) (define-public flared-hairpin (elbowed-hairpin '((0.95 . 0.4) (1.0 . 1.0)) #t)) @@ -1085,13 +1113,14 @@ and draws the stencil based on its coordinates. (make-tied-lyric-markup text) text)))) -(define-public ((grob::calc-property-by-copy prop) grob) +(define ((grob::calc-property-by-copy prop) grob) (ly:event-property (event-cause grob) prop)) +(export grob::calc-property-by-copy) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; general inheritance -(define-public ((grob::inherit-parent-property axis property . default) grob) +(define ((grob::inherit-parent-property axis property . default) grob) "@var{grob} callback generator for inheriting a @var{property} from an @var{axis} parent, defaulting to @var{default} if there is no parent or the parent has no setting." @@ -1101,6 +1130,7 @@ parent or the parent has no setting." (apply ly:grob-property parent property default)) ((pair? default) (car default)) (else '())))) +(export grob::inherit-parent-property) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; fret boards @@ -1127,7 +1157,7 @@ parent or the parent has no setting." (ly:grob-property grob 'positioning-done) (let* ((shift (ly:grob-property grob 'toward-stem-shift 0.0)) (note-head-location - (ly:self-alignment-interface::centered-on-x-parent grob)) + (ly:self-alignment-interface::aligned-on-x-parent grob)) (note-head-grob (ly:grob-parent grob X)) (stem-grob (ly:grob-object note-head-grob 'stem)))