;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2009--2010 Marc Hohl <marc@hohlart.de>
+;;;; Copyright (C) 2009--2015 Marc Hohl <marc@hohlart.de>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
-;; default tunings for common string instruments
-;; guitar tunings
-(define-public guitar-tuning '(4 -1 -5 -10 -15 -20))
-(define-public guitar-seven-string-tuning '(4 -1 -5 -10 -15 -20 -25))
-(define-public guitar-drop-d-tuning '(4 -1 -5 -10 -15 -22))
-(define-public guitar-open-g-tuning '(2 -1 -5 -10 -17 -22))
-(define-public guitar-open-d-tuning '(2 -3 -6 -10 -15 -22))
-(define-public guitar-dadgad-tuning '(2 -3 -5 -10 -15 -22))
-(define-public guitar-lute-tuning '(4 -1 -6 -10 -15 -20))
-(define-public guitar-asus4-tuning '(4 -3 -8 -10 -15 -20))
-;; bass tunings
-(define-public bass-tuning '(-17 -22 -27 -32))
-(define-public bass-four-string-tuning '(-17 -22 -27 -32))
-(define-public bass-drop-d-tuning '(-17 -22 -27 -34))
-(define-public bass-five-string-tuning '(-17 -22 -27 -32 -37))
-(define-public bass-six-string-tuning '(-12 -17 -22 -27 -32 -37))
-;; mandolin
-(define-public mandolin-tuning '(16 9 2 -5))
-;; tunings for 5-string banjo
-(define-public banjo-open-g-tuning '(2 -1 -5 -10 7))
-(define-public banjo-c-tuning '(2 -1 -5 -12 7))
-(define-public banjo-modal-tuning '(2 0 -5 -10 7))
-(define-public banjo-open-d-tuning '(2 -3 -6 -10 9))
-(define-public banjo-open-dm-tuning '(2 -3 -6 -10 9))
-;; convert 5-string banjo tuning to 4-string by removing the 5th string
-(define-public (four-string-banjo tuning)
- (reverse (cdr (reverse tuning))))
-;; ukulele tunings
-(define-public ukulele-tuning '(9 4 0 7)) ;ukulele a' e' c' g'
-(define-public ukulele-d-tuning '(11 6 2 9)) ;ukulele d tuning, b' fis' d' a'
-(define-public ukulele-tenor-tuning '(-5 0 4 9)) ;tenor ukulele, g c' e' a'
-(define-public ukulele-baritone-tuning '(-10 -5 -1 4)) ;baritone ukulele, d g b e'
-
;; for more control over glyph-name calculations,
;; we use a custom callback for tab note heads
(let ((style (ly:grob-property grob 'style)))
(case style
- ((cross) "2cross"))))
+ ((cross) "2cross")
+ ((slash) "2slash")
+ (else #f))))
;; ensure we only call note head callback when
-;; 'style = 'cross
+;; style is set to a known value
(define-public (tab-note-head::whiteout-if-style-set grob)
(let ((style (ly:grob-property grob 'style)))
- (if (and (symbol? style)
- (eq? style 'cross))
- (stencil-whiteout (ly:note-head::print grob))
- (tab-note-head::print grob))))
+ (case style
+ ((cross slash) (stencil-whiteout-box (ly:note-head::print grob)))
+ (else (tab-note-head::print grob)))))
;; definitions for the "moderntab" clef:
;; the "moderntab" clef will be added to the list of known clefs,
;; define sans serif-style tab-Clefs as a markup:
(define-markup-command (customTabClef
- layout props num-strings staff-space)
+ layout props num-strings staff-space)
(integer? number?)
#:category music
"Draw a tab clef sans-serif style."
;; if it is "moderntab", we'll draw it
(let* ((staff-symbol (ly:grob-object grob 'staff-symbol))
(line-count (if (ly:grob? staff-symbol)
- (ly:grob-property staff-symbol 'line-count)
- 0))
+ (ly:grob-property staff-symbol 'line-count)
+ 0))
(staff-space (ly:staff-symbol-staff-space grob)))
(grob-interpret-markup grob (make-customTabClef-markup line-count
;; if stems are drawn, it is nice to have a double stem for
;; (dotted) half notes to distinguish them from quarter notes:
-(define-public (tabvoice::draw-double-stem-for-half-notes grob)
- (let ((stem (ly:stem::print grob)))
+(define-public (tabvoice::make-double-stem-width-for-half-notes grob)
+ (let ((X-extent (ly:stem::width grob)))
+ ;; does the stem exist and is it on a (dotted) half note?
+ (if (and (not (equal? X-extent empty-interval))
+ (= 1 (ly:grob-property grob 'duration-log)))
+
+ ;; yes -> return double stem X-extent
+ (let* ((single-stem-width (- (cdr X-extent) (car X-extent)))
+ (separation (ly:grob-property grob 'double-stem-separation 0.5))
+ (total-width (+ single-stem-width separation))
+ (half-width (/ total-width 2)))
+ (cons (- half-width) half-width))
+ ;; no -> return simple stem X-extent
+ X-extent)))
- ;; is the note a (dotted) half note?
- (if (= 1 (ly:grob-property grob 'duration-log))
- ;; yes -> draw double stem
- (ly:stencil-combine-at-edge stem X RIGHT stem 0.5)
- ;; no -> draw simple stem
- stem)))
+(define-public (tabvoice::draw-double-stem-for-half-notes grob)
+ (let ((stem-stencil (ly:stem::print grob)))
+ ;; does the stem exist and is it on a (dotted) half note?
+ (if (and (ly:stencil? stem-stencil)
+ (= 1 (ly:grob-property grob 'duration-log)))
+
+ ;; yes -> draw double stem
+ (let* ((separation (ly:grob-property grob 'double-stem-separation 0.5))
+ (half-separation (/ separation 2)))
+ (ly:stencil-add
+ (ly:stencil-translate-axis stem-stencil (- half-separation) X)
+ (ly:stencil-translate-axis stem-stencil half-separation X)))
+ ;; no -> draw simple stem (or none at all)
+ stem-stencil)))
;; as default, the glissando line between fret numbers goes
;; upwards, here we have a function to correct this behavior:
(left-pitch (ly:event-property (event-cause left-bound) 'pitch))
(right-pitch (ly:event-property (event-cause right-bound) 'pitch)))
- (if (< (ly:pitch-semitones right-pitch) (ly:pitch-semitones left-pitch))
+ (if (< (ly:pitch-tones right-pitch) (ly:pitch-tones left-pitch))
-0.75
0.75)))
;; tab note head is visible
(if tab-note-head-parenthesized
(begin
- (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
+ (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
(ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
;; tab note head is invisible
- (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
+ (ly:grob-set-property! tied-tab-note-head 'transparent #t)))
;; tie is not split
(ly:grob-set-property! tied-tab-note-head 'transparent #t)))))
(tab-note-head-visible (assoc-get 'note-head-visible repeat-tied-properties #t))
(tab-note-head-parenthesized (assoc-get 'parenthesize repeat-tied-properties #t)))
- (if tab-note-head-visible
- ;; tab note head is visible
- (if tab-note-head-parenthesized
- (begin
- (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
- (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
- ;; tab note head is invisible
- (ly:grob-set-property! tied-tab-note-head 'transparent #t))))))
+ (if tab-note-head-visible
+ ;; tab note head is visible
+ (if tab-note-head-parenthesized
+ (begin
+ (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t)
+ (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)))
+ ;; tab note head is invisible
+ (ly:grob-set-property! tied-tab-note-head 'transparent #t))))))
;; the slurs should not be too far apart from the corresponding fret number, so
;; we move the slur towards the TabNoteHeads; moreover, if the left fret number is
(* staff-space
(ly:grob-property grob 'direction)
0.35))))
- control-points)))
+ control-points)))
(ly:grob-set-property! grob 'control-points new-control-points)
(ly:slur::print grob)))
;; a callback for custom fret labels
-(define-public ((tab-note-head::print-custom-fret-label fret) grob)
- (ly:grob-set-property! grob 'text fret)
+(define ((tab-note-head::print-custom-fret-label fret) grob)
+ (ly:grob-set-property! grob 'text (make-vcenter-markup fret))
(tab-note-head::print grob))
+(export tab-note-head::print-custom-fret-label)
(define-public (tab-note-head::print grob)
(define (is-harmonic? grob)
(let ((arts (ly:event-property (event-cause grob) 'articulations)))
- (not (null? (filter (lambda (a)
- (ly:in-event-class? a 'harmonic-event))
- arts)))))
+ (or (pair? (filter (lambda (a)
+ (ly:in-event-class? a 'harmonic-event))
+ arts))
+ (eq? (ly:grob-property grob 'style) 'harmonic))))
(let* ((cautionary (ly:grob-property grob 'display-cautionary #f))
- (details (ly:grob-property grob 'details '()))
- (harmonic-props (assoc-get 'harmonic-properties details '()))
- (harmonic-angularity (assoc-get 'angularity harmonic-props 2))
- (harmonic-half-thick (assoc-get 'half-thickness harmonic-props 0.075))
- (harmonic-padding (assoc-get 'padding harmonic-props 0))
- (harmonic-proc (assoc-get 'procedure harmonic-props parenthesize-stencil))
- (harmonic-width (assoc-get 'width harmonic-props 0.25))
- (cautionary-props (assoc-get 'cautionary-properties details '()))
- (cautionary-angularity (assoc-get 'angularity cautionary-props 2))
- (cautionary-half-thick (assoc-get 'half-thickness cautionary-props 0.075))
- (cautionary-padding (assoc-get 'padding cautionary-props 0))
- (cautionary-proc (assoc-get 'procedure cautionary-props parenthesize-stencil))
- (cautionary-width (assoc-get 'width cautionary-props 0.25))
+ (details (ly:grob-property grob 'details '()))
+ (harmonic-props (assoc-get 'harmonic-properties details '()))
+ (harmonic-angularity (assoc-get 'angularity harmonic-props 2))
+ (harmonic-half-thick (assoc-get 'half-thickness harmonic-props 0.075))
+ (harmonic-padding (assoc-get 'padding harmonic-props 0))
+ (harmonic-proc (assoc-get 'procedure harmonic-props parenthesize-stencil))
+ (harmonic-width (assoc-get 'width harmonic-props 0.25))
+ (cautionary-props (assoc-get 'cautionary-properties details '()))
+ (cautionary-angularity (assoc-get 'angularity cautionary-props 2))
+ (cautionary-half-thick (assoc-get 'half-thickness cautionary-props 0.075))
+ (cautionary-padding (assoc-get 'padding cautionary-props 0))
+ (cautionary-proc (assoc-get 'procedure cautionary-props parenthesize-stencil))
+ (cautionary-width (assoc-get 'width cautionary-props 0.25))
(output-grob (ly:text-interface::print grob))
- (ref-grob (grob-interpret-markup grob "8"))
- (column-offset (interval-length
- (ly:stencil-extent
- (grob-interpret-markup grob "8")
- X))))
+ (ref-grob (grob-interpret-markup grob "8"))
+ (offset-factor (assoc-get 'head-offset details 3/5))
+ (column-offset (* offset-factor
+ (interval-length
+ (ly:stencil-extent ref-grob X)))))
(if (is-harmonic? grob)
(set! output-grob (harmonic-proc output-grob
- harmonic-half-thick
- harmonic-width
- harmonic-angularity
- harmonic-padding)))
+ harmonic-half-thick
+ harmonic-width
+ harmonic-angularity
+ harmonic-padding)))
(if cautionary
(set! output-grob (cautionary-proc output-grob
- cautionary-half-thick
- cautionary-width
- cautionary-angularity
- cautionary-padding)))
- (ly:stencil-translate-axis (centered-stencil output-grob)
- column-offset
- X)))
+ cautionary-half-thick
+ cautionary-width
+ cautionary-angularity
+ cautionary-padding)))
+ (ly:stencil-translate-axis
+ (ly:stencil-aligned-to output-grob X CENTER)
+ column-offset
+ X)))
;; Harmonic definitions
;; According to the arithmetic sum, the position of m/n is at 1/2*(n-2)(n-1)+(m-1)
;; if we start counting from zero
(vector 12
- 7 19
- 5 12 24
- 4 9 16 28
- 3 7 12 19 31
- 2.7 5.8 9.7 14.7 21.7 33.7
- 2.3 5 8 12 17 24 36
- 2 4.4 7 10 14 19 26 38 ))
+ 7 19
+ 5 12 24
+ 4 9 16 28
+ 3 7 12 19 31
+ 2.7 5.8 9.7 14.7 21.7 33.7
+ 2.3 5 8 12 17 24 36
+ 2 4.4 7 10 14 19 26 38 ))
(define partial-pitch
(vector '(0 0 0)
(- den 1)
1/2)
nom -1)))
- (number->string (vector-ref node-positions index))))
+ (number->string (vector-ref node-positions index))))
(define-public (ratio->pitch ratio)
"Calculate a pitch given @var{ratio} for the harmonic."
(let* ((partial (1- (denominator ratio)))
(pitch (vector-ref partial-pitch partial)))
- (ly:make-pitch (first pitch)
- (second pitch)
- (third pitch))))
+ (ly:make-pitch (first pitch)
+ (second pitch)
+ (third pitch))))
(define-public (fret->pitch fret)
"Calculate a pitch given @var{fret} for the harmonic."
(let* ((partial (assoc-get fret fret-partials 0))
(pitch (vector-ref partial-pitch partial)))
- (ly:make-pitch (first pitch)
- (second pitch)
- (third pitch))))
+ (ly:make-pitch (first pitch)
+ (second pitch)
+ (third pitch))))
(define-public (calc-harmonic-pitch pitch music)
"Calculate the harmonic pitches in @var{music} given
(e (ly:music-property music 'element))
(p (ly:music-property music 'pitch)))
(cond
- ((pair? es)
- (ly:music-set-property! music 'elements
- (map (lambda (x) (calc-harmonic-pitch pitch x)) es)))
- ((ly:music? e)
- (ly:music-set-property! music 'element (calc-harmonic-pitch pitch e)))
- ((ly:pitch? p)
- (begin
- (set! p (ly:pitch-transpose p pitch))
- (ly:music-set-property! music 'pitch p))))
+ ((pair? es)
+ (ly:music-set-property! music 'elements
+ (map (lambda (x) (calc-harmonic-pitch pitch x)) es)))
+ ((ly:music? e)
+ (ly:music-set-property! music 'element (calc-harmonic-pitch pitch e)))
+ ((ly:pitch? p)
+ (begin
+ (set! p (ly:pitch-transpose p pitch))
+ (ly:music-set-property! music 'pitch p))))
music))
(define-public (make-harmonic mus)
"Convert music variable @var{mus} to harmonics."
(let ((elts (ly:music-property mus 'elements))
(elt (ly:music-property mus 'element)))
- (cond
- ((pair? elts)
- (map make-harmonic elts))
- ((ly:music? elt)
- (make-harmonic elt))
- ((music-is-of-type? mus 'note-event)
- (set! (ly:music-property mus 'articulations)
- (append
- (ly:music-property mus 'articulations)
- (list (make-music 'HarmonicEvent))))))
- mus))
+ (cond
+ ((pair? elts)
+ (for-each make-harmonic elts))
+ ((ly:music? elt)
+ (make-harmonic elt))
+ ((music-is-of-type? mus 'note-event)
+ (set! (ly:music-property mus 'articulations)
+ (append
+ (ly:music-property mus 'articulations)
+ (list (make-music 'HarmonicEvent))))))
+ mus))