X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=bb8f4ddf50d96c80bdece61ebb473d1d36604396;hb=f0ec420a50f51112d7b79c219530bba9695433c9;hp=82703e14ac1f0bc9ae336ce5f227aa274edcae41;hpb=3cfcd0df1125efe0eddc1f361f9bf24243ed12b7;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 82703e14ac..bb8f4ddf50 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--2011 Jan Nieuwenhuizen +;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify @@ -58,7 +58,6 @@ (ly:text-interface::interpret-markup layout props text))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; beam slope @@ -133,10 +132,43 @@ (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)) + +;; FIXME: NEED TO FIND A BETTER WAY TO HANDLE KIEVAN NOTATION (define-public (note-head::calc-duration-log grob) - (min 2 - (ly:duration-log - (ly:event-property (event-cause grob) 'duration)))) + (let ((style (ly:grob-property grob 'style))) + (if (and (symbol? style) (string-match "kievan*" (symbol->string style))) + (min 3 + (ly:duration-log + (ly:event-property (event-cause grob) 'duration))) + (min 2 + (ly:duration-log + (ly:event-property (event-cause grob) 'duration)))))) (define-public (dots::calc-dot-count grob) (ly:duration-dot-count @@ -200,6 +232,8 @@ and duration-log @var{log}." (string-append (number->string log) "petrucci"))) ((neomensural) (string-append (number->string log) (symbol->string style))) + ((kievan) + (string-append (number->string log) "kievan")) (else (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style)) (symbol->string style) @@ -207,9 +241,10 @@ and duration-log @var{log}." (symbol->string style)))))) (define-public (note-head::calc-glyph-name grob) - (let ((style (ly:grob-property grob 'style)) - (log (min 2 (ly:grob-property grob 'duration-log)))) - + (let* ((style (ly:grob-property grob 'style)) + (log (if (string-match "kievan*" (symbol->string style)) + (min 3 (ly:grob-property grob 'duration-log)) + (min 2 (ly:grob-property grob 'duration-log))))) (select-head-glyph style log))) (define-public (note-head::brew-ez-stencil grob) @@ -362,7 +397,10 @@ and duration-log @var{log}." ("S|:" . ("S" . "|:")) (".S|:" . ("|" . "S|:")) (":|S|:" . (":|" . "S|:")) - (":|S.|:" . (":|S" . "|:")))) + (":|S.|:" . (":|S" . "|:")) + + ;; ancient bar lines + ("kievan" . ("kievan" . "")))) (define-public (bar-line::calc-glyph-name grob) (let* ((glyph (ly:grob-property grob 'glyph)) @@ -390,9 +428,41 @@ and duration-log @var{log}." (equal? (ly:item-break-dir g) RIGHT)) (ly:grob-translate-axis! g 3.5 X))) -(define-public (span-bar-stub::height grob) - (ly:grob-property grob 'elements-filtered) - (ly:axis-group-interface::height grob)) +(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-pure-height grob grob 0 10000000)) + (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 @@ -620,6 +690,9 @@ and duration-log @var{log}." (0 . "accidentals.vaticana0") (1/2 . "accidentals.mensural1"))) +(define-public alteration-kievan-glyph-name-alist + '((-1/2 . "accidentals.kievanM1") + (1/2 . "accidentals.kievan1"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; * Pitch Trill Heads @@ -806,11 +879,6 @@ and duration-log @var{log}." (let* ((event (event-cause grob)) (digit (ly:event-property event 'digit))) - (if (> digit 5) - (ly:input-message (ly:event-property event 'origin) - "Warning: Fingering notation for finger number ~a" - digit)) - (number->string digit 10))) (define-public (string-number::calc-text grob)