X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=c33aff028d8ed8ff7e98f06ce7ce1a0b3f097ec1;hb=e0a5069fde625a2ad97f424e535b0cfafe3b4741;hp=eea76143769952258f68b3dd449f889a1d20b7f1;hpb=16a385de7fce2b05cd70e1c7de3d0b52df62edfc;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index eea7614376..c33aff028d 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2006 Jan Nieuwenhuizen +;;;; (c) 1998--2009 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys @@ -202,67 +202,80 @@ centered, X==1 is at the right, X == -1 is at the left." (define-public (first-bar-number-invisible barnum) (> barnum 1)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; percent repeat counters + +(define-public ((every-nth-repeat-count-visible n) count context) (= 0 (modulo count n))) + +(define-public (all-repeat-counts-visible count context) #t) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; break visibility -(define-public begin-of-line-visible - #(#f #f #t)) -(define-public end-of-line-visible - #(#t #f #f)) -(define-public end-of-line-invisible - #(#f #t #t)) +(define-public all-visible #(#t #t #t)) +(define-public begin-of-line-invisible #(#t #t #f)) +(define-public center-invisible #(#t #f #t)) +(define-public end-of-line-invisible #(#f #t #t)) +(define-public begin-of-line-visible #(#f #f #t)) +(define-public center-visible #(#f #t #f)) +(define-public end-of-line-visible #(#t #f #f)) +(define-public all-invisible #(#f #f #f)) + (define-public spanbar-begin-of-line-invisible #(#t #f #f)) -(define-public all-visible #(#t #t #t)) -(define-public all-invisible #(#f #f #f)) -(define-public begin-of-line-invisible - #(#t #t #f)) -(define-public center-invisible #(#t #f #t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Bar lines. ;; ;; How should a bar line behave at a break? -;; -;; Why prepend `default-' to every scm identifier? +(define bar-glyph-alist + '((":|:" . (":|" . "|:")) + (":|.|:" . (":|" . "|:")) + (":|.:" . (":|" . "|:")) + ("||:" . ("||" . "|:")) + ("dashed" . ("dashed" . '())) + ("|" . ("|" . ())) + ("||:" . ("||" . "|:")) + ("|s" . (() . "|")) + ("|:" . ("|" . "|:")) + ("|." . ("|." . ())) + + ;; hmm... should we end with a bar line here? + (".|" . ("|" . ".|")) + (":|" . (":|" . ())) + ("||" . ("||" . ())) + (".|." . (".|." . ())) + ("|.|" . ("|.|" . ())) + ("" . ("" . "")) + (":" . (":" . "")) + ("." . ("." . ())) + ("'" . ("'" . ())) + ("empty" . (() . ())) + ("brace" . (() . "brace")) + ("bracket" . (() . "bracket")) + )) + (define-public (bar-line::calc-glyph-name grob) (let* ( (glyph (ly:grob-property grob 'glyph)) (dir (ly:item-break-dir grob)) - (result (assoc glyph - '((":|:" . (":|" . "|:")) - ("||:" . ("||" . "|:")) - ("dashed" . ("dashed" . '())) - ("|" . ("|" . ())) - ("||:" . ("||" . "|:")) - ("|s" . (() . "|")) - ("|:" . ("|" . "|:")) - ("|." . ("|." . ())) - - ;; hmm... should we end with a bar line here? - (".|" . ("|" . ".|")) - (":|" . (":|" . ())) - ("||" . ("||" . ())) - (".|." . (".|." . ())) - ("" . ("" . "")) - (":" . (":" . "")) - ("." . ("." . ())) - ("empty" . (() . ())) - ("brace" . (() . "brace")) - ("bracket" . (() . "bracket")) ))) + (result (assoc glyph bar-glyph-alist)) (glyph-name (if (= dir CENTER) glyph (if (and result (string? (index-cell (cdr result) dir))) (index-cell (cdr result) dir) #f))) ) - - (if (not glyph-name) - (ly:grob-suicide! grob)) - glyph-name)) +(define-public (bar-line::calc-break-visibility grob) + (let* ((glyph (ly:grob-property grob 'glyph)) + (result (assoc glyph bar-glyph-alist))) + (if result + (vector (string? (cadr result)) #t (string? (cddr result))) + #(#f #f #f)))) + (define-public (shift-right-at-line-begin g) "Shift an item to the right, but only at the start of the line." @@ -289,6 +302,7 @@ centered, X==1 is at the right, X == -1 is at the left." ;; Color (define-public color? list?) +(define-public (rgb-color r g b) (list r g b)) ; predefined colors (define-public black '(0.0 0.0 0.0)) @@ -379,6 +393,9 @@ centered, X==1 is at the right, X == -1 is at the left." (-3/4 . "accidentals.mirroredflat.flat") )) +;; FIXME: standard vs default, alteration-FOO vs FOO-alteration +(define-public alteration-default-glyph-name-alist standard-alteration-glyph-name-alist) + (define-public makam-alteration-glyph-name-alist '((1 . "accidentals.doublesharp") (8/9 . "accidentals.sharp.slashslashslash.stemstem") @@ -394,24 +411,24 @@ centered, X==1 is at the right, X == -1 is at the left." )) (define-public alteration-hufnagel-glyph-name-alist - '((1/2 . "accidentals.hufnagel-1") + '((-1/2 . "accidentals.hufnagelM1") (0 . "accidentals.vaticana0") - (-1/2 . "accidentals.mensural1"))) + (1/2 . "accidentals.mensural1"))) (define-public alteration-medicaea-glyph-name-alist - '((1/2 . "accidentals.medicaea-1") + '((-1/2 . "accidentals.medicaeaM1") (0 . "accidentals.vaticana0") - (-1/2 . "accidentals.mensural1"))) + (1/2 . "accidentals.mensural1"))) (define-public alteration-vaticana-glyph-name-alist - '((1/2 . "accidentals.vaticana-1") + '((-1/2 . "accidentals.vaticanaM1") (0 . "accidentals.vaticana0") - (-1/2 . "accidentals.mensural1"))) + (1/2 . "accidentals.mensural1"))) (define-public alteration-mensural-glyph-name-alist - '((1/2 . "accidentals.mensural-1") + '((-1/2 . "accidentals.mensuralM1") (0 . "accidentals.vaticana0") - (-1/2 . "accidentals.mensural1"))) + (1/2 . "accidentals.mensural1"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -642,44 +659,32 @@ centered, X==1 is at the right, X == -1 is at the left." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; fret boards -(define (string-frets->description string-frets string-count) - (let* - ((desc (list->vector - (map (lambda (x) (list 'mute (1+ x))) - (iota string-count))))) - - (for-each (lambda (sf) - (let* - ((string (car sf)) - (fret (cadr sf)) - (finger (caddr sf))) - - - (vector-set! desc (1- string) - (if (= 0 fret) - (list 'open string) - (if finger - (list 'place-fret string fret finger) - (list 'place-fret string fret)) - - - )) - )) - string-frets) - - (vector->list desc))) - (define-public (fret-board::calc-stencil grob) - (let* ((string-frets (ly:grob-property grob 'string-fret-finger-combinations)) - (string-count (ly:grob-property grob 'string-count))) - - (grob-interpret-markup grob - (make-fret-diagram-verbose-markup - (string-frets->description string-frets string-count))))) + (grob-interpret-markup + grob + (make-fret-diagram-verbose-markup + (ly:grob-property grob 'dot-placement-list)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; scripts (define-public (script-interface::calc-x-offset grob) (ly:grob-property grob 'positioning-done) - (ly:self-alignment-interface::centered-on-x-parent grob)) + (let* ((shift (ly:grob-property grob 'toward-stem-shift 0.0)) + (note-head-location (ly:self-alignment-interface::centered-on-x-parent grob)) + (note-head-grob (ly:grob-parent grob X)) + (stem-grob (ly:grob-object note-head-grob 'stem))) + (+ note-head-location + ;; If the property 'toward-stem-shift is defined and the script has the + ;; same direction as the stem, move the script accordingly. Since scripts can + ;; also be over skips, we need to check whether the grob has a stem at all. + (if (ly:grob? stem-grob) + (let ((dir1 (ly:grob-property grob 'direction)) + (dir2 (ly:grob-property stem-grob 'direction))) + (if (equal? dir1 dir2) + (let* ((common-refp (ly:grob-common-refpoint grob stem-grob X)) + (stem-location (ly:grob-relative-coordinate stem-grob common-refp X))) + (* shift (- stem-location + note-head-location))) + 0.0)) + 0.0))))