;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 1998--2007 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
(define-public (first-bar-number-invisible barnum) (> barnum 1))
+(define-public (all-bar-numbers-visible barnum) #t)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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?
(define bar-glyph-alist
'((":|:" . (":|" . "|:"))
+ (":|.|:" . (":|" . "|:"))
+ (":|.:" . (":|" . "|:"))
("||:" . ("||" . "|:"))
("dashed" . ("dashed" . '()))
("|" . ("|" . ()))
(":|" . (":|" . ()))
("||" . ("||" . ()))
(".|." . (".|." . ()))
+ ("|.|" . ("|.|" . ()))
("" . ("" . ""))
(":" . (":" . ""))
("." . ("." . ()))
+ ("'" . ("'" . ()))
("empty" . (() . ()))
("brace" . (() . "brace"))
("bracket" . (() . "bracket"))
(ly:event-property ev 'denominator)
(ly:event-property ev 'numerator))))
+
+; 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)
+ (let* ((txt (if function (function grob) #f)))
+ (if txt
+ (markup txt #:fontsize -5 #:note note UP)
+ (markup #:fontsize -5 #:note note UP))))
+
+; 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) grob)
+(number->string (if denominator
+ denominator
+ (ly:event-property (event-cause grob) 'denominator))))
+
+; 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 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 "~a:~a" den num)))
+
+; Print a tuplet fraction with note durations appended to the numerator and the
+; denominator
+(define-public ((tuplet-number::fraction-with-notes denominatornote numeratornote) grob)
+ (let* ((ev (event-cause grob))
+ (denominator (ly:event-property ev 'denominator))
+ (numerator (ly:event-property ev 'numerator)))
+ ((tuplet-number::non-default-fraction-with-notes denominator denominatornote numerator numeratornote) grob)))
+
+; Print a tuplet fraction with note durations appended to the numerator and the
+; denominator
+(define-public ((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)))
+ (num (if numerator numerator (ly:event-property ev 'numerator))))
+ (make-concat-markup (list
+ (make-simple-markup (format "~a" den))
+ (markup #:fontsize -5 #:note denominatornote UP)
+ (make-simple-markup " : ")
+ (make-simple-markup (format "~a" num))
+ (markup #:fontsize -5 #:note numeratornote UP)))))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Color
left-span X)
X))
(common-y (ly:grob-common-refpoint spanner left-span Y))
+ (minimum-length (ly:grob-property spanner 'minimum-length 0.5))
+
(left-x (+ padding
(max (interval-end (ly:grob-robust-relative-extent
left-span common X))
(interval-end (ly:grob-robust-relative-extent dots common X))
-10000) ;; TODO: use real infinity constant.
)))
- (right-x (- (interval-start
- (ly:grob-robust-relative-extent right-span common X))
- padding))
+ (right-x (max (- (interval-start (ly:grob-robust-relative-extent right-span common X))
+ padding)
+ (+ left-x minimum-length)))
(self-x (ly:grob-relative-coordinate spanner common X))
(dx (- right-x left-x))
(exp (list 'path thickness
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))))
projects / lilypond.git / blobdiff