X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-lib.scm;h=b93eddaa9ac3d00d089d6b0dbb4987fcd6a83ee0;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=11f427bcec8761f0f8de7d3eb095a67402019cf5;hpb=7831acdea3df3cb6579f02efa54de2752f26d7c4;p=lilypond.git diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 11f427bcec..b93eddaa9a 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--2008 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys @@ -26,22 +26,9 @@ (lambda (grob) (circle-stencil (callback grob) thickness padding))) (define-public (print-circled-text-callback grob) - (let* ((text (ly:grob-property grob 'text)) - - (layout (ly:grob-layout grob)) - (defs (ly:output-def-lookup layout 'text-font-defaults)) - (props (ly:grob-alist-chain grob defs)) - (circle (ly:text-interface::interpret-markup - layout props (make-circle-markup text)))) - circle)) - -(define-public (music-cause grob) - (let* - ((event (event-cause grob))) - - (if (ly:stream-event? event) - (ly:event-property event 'music-cause) - #f))) + (grob-interpret-markup grob (make-circle-markup + (ly:grob-property grob 'text)) + )) (define-public (event-cause grob) (let* @@ -215,67 +202,79 @@ 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." @@ -302,6 +301,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)) @@ -392,6 +392,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") @@ -407,24 +410,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"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -439,7 +442,7 @@ centered, X==1 is at the right, X == -1 is at the left." (list lp rp))) -(define (grob-text grob text) +(define-public (grob-interpret-markup grob text) (let* ((layout (ly:grob-layout grob)) (defs (ly:output-def-lookup layout 'text-font-defaults)) @@ -451,9 +454,9 @@ centered, X==1 is at the right, X == -1 is at the left." (define-public (parentheses-item::calc-angled-bracket-stencils grob) (let* ( (font (ly:grob-default-font grob)) - (lp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-text grob (ly:wide-char->utf-8 #x2329)) + (lp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-interpret-markup grob (ly:wide-char->utf-8 #x2329)) Y CENTER) X RIGHT)) - (rp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-text grob (ly:wide-char->utf-8 #x232A)) + (rp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-interpret-markup grob (ly:wide-char->utf-8 #x232A)) Y CENTER) X LEFT)) ) @@ -642,16 +645,12 @@ centered, X==1 is at the right, X == -1 is at the left." "Allow interpretation of tildes as lyric tieing marks." (let* - ((text (ly:grob-property grob 'text)) - (layout (ly:grob-layout grob)) - (defs (ly:output-def-lookup layout 'text-font-defaults)) - (props (ly:grob-alist-chain grob defs))) + ((text (ly:grob-property grob 'text))) - (ly:text-interface::interpret-markup layout - props - (if (string? text) - (make-tied-lyric-markup text) - text)))) + (grob-interpret-markup grob + (if (string? text) + (make-tied-lyric-markup text) + text)))) (define-public ((grob::calc-property-by-copy prop) grob) (ly:event-property (event-cause grob) prop)) @@ -659,39 +658,15 @@ 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) +(define-public (fret-board::calc-stencil grob) + (grob-interpret-markup + grob + (make-fret-diagram-verbose-markup + (ly:grob-property grob 'dot-placement-list)))) - (vector->list desc))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; scripts -(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)) - (layout (ly:grob-layout grob)) - (defs (ly:output-def-lookup layout 'text-font-defaults)) - (props (ly:grob-alist-chain grob defs))) - - (make-fret-diagram layout props - (string-frets->description string-frets 6)))) +(define-public (script-interface::calc-x-offset grob) + (ly:grob-property grob 'positioning-done) + (ly:self-alignment-interface::centered-on-x-parent grob))