X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftablature.scm;h=419f93c2cf15012ba6e3deedfc915b4c5ee48dc1;hb=a90b4f6c28f125d797df443241501a679c900424;hp=883b09ae1c1a8f19e84286aef09ad942e0327ab1;hpb=66a729cbb7d3bb1739c7cc843ad2e398ad6ad4e2;p=lilypond.git diff --git a/scm/tablature.scm b/scm/tablature.scm index 883b09ae1c..419f93c2cf 100644 --- a/scm/tablature.scm +++ b/scm/tablature.scm @@ -1,8 +1,19 @@ -;;;; tablature.scm +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter +;;;; Copyright (C) 2009--2010 Marc Hohl ;;;; -;;;; (c) 2009 Marc Hohl +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . ;; default tunings for common string instruments ;; guitar tunings @@ -11,7 +22,7 @@ (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 -7 -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 @@ -31,9 +42,15 @@ ;; 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 noteheads +;; we use a custom callback for tab note heads ;; which will ignore 'style = 'do (define-public (tab-note-head::calc-glyph-name grob) (let ((style (ly:grob-property grob 'style))) @@ -41,7 +58,7 @@ (case style ((cross) "2cross")))) -;; ensure we only call notehead callback when +;; ensure we only call note head callback when ;; 'style = 'cross (define-public (tab-note-head::whiteout-if-style-set grob) (let ((style (ly:grob-property grob 'style))) @@ -57,11 +74,10 @@ (add-new-clef "moderntab" "markup.moderntab" 0 0 0) ;; define sans serif-style tab-Clefs as a markup: -(define-builtin-markup-command (customTabClef +(define-markup-command (customTabClef layout props num-strings staff-space) (integer? number?) - music - () + #:category music "Draw a tab clef sans-serif style." (define (square x) (* x x)) (let* ((scale-factor (/ staff-space 1.5)) @@ -83,7 +99,9 @@ (if (string=? glyph "markup.moderntab") ;; if it is "moderntab", we'll draw it (let* ((staff-symbol (ly:grob-object grob 'staff-symbol)) - (line-count (ly:grob-property staff-symbol 'line-count)) + (line-count (if (ly:grob? staff-symbol) + (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 @@ -176,17 +194,21 @@ (vector-ref (assoc-get 'break-visibility tied-properties #(#f #f #t)) 2))) - (if tab-note-head-visible - ;; tab note head is visible - (if tab-note-head-parenthesized - (ly:grob-set-property! tied-tab-note-head 'stencil - (lambda (grob) - (parenthesize-tab-note-head grob)))) - ;; 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 + (ly:grob-set-property! tied-tab-note-head 'stencil + (lambda (grob) + (parenthesize-tab-note-head grob)))) + ;; tab note head is invisible + (begin + (ly:grob-set-property! tied-tab-note-head 'transparent #t) + (ly:grob-set-property! tied-tab-note-head 'whiteout #f)))) ;; tie is not split -> make fret number invisible - (ly:grob-set-property! tied-tab-note-head 'transparent #t)))) + (begin + (ly:grob-set-property! tied-tab-note-head 'transparent #t) + (ly:grob-set-property! tied-tab-note-head 'whiteout #f))))) ;; repeat ties occur within alternatives in a repeat construct; ;; TabNoteHead #'details handles the appearance in this case @@ -197,11 +219,39 @@ (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 - (ly:grob-set-property! tied-tab-note-head 'stencil - (lambda (grob) - (parenthesize-tab-note-head grob)))) - ;; tab note head is invisible - (ly:grob-set-property! tied-tab-note-head 'transparent #t)))) \ No newline at end of file + (if tab-note-head-visible + ;; tab note head is visible + (if tab-note-head-parenthesized + (ly:grob-set-property! tied-tab-note-head 'stencil + (lambda (grob) + (parenthesize-tab-note-head grob)))) + ;; tab note head is invisible + (begin + (ly:grob-set-property! tied-tab-note-head 'transparent #t) + (ly:grob-set-property! tied-tab-note-head 'whiteout #f))))) + +;; the slurs should not be too far apart from the corresponding fret number, so +;; we move the slur towards the TabNoteHeads: +(define-public (slur::draw-tab-slur grob) + ;; TODO: use a less "brute-force" method to decrease + ;; the distance between the slur ends and the fret numbers + (let* ((staff-space (ly:staff-symbol-staff-space grob)) + (control-points (ly:grob-property grob 'control-points)) + (new-control-points (map + (lambda (p) + (cons (car p) + (- (cdr p) + (* staff-space + (ly:grob-property grob 'direction) + 0.35)))) + control-points))) + + (ly:grob-set-property! grob 'control-points new-control-points) + (ly:slur::print grob))) + +;; for \tabFullNotation, the stem tremolo beams are too big in comparison to +;; normal staves; this wrapper function scales accordingly: +(define-public (stem-tremolo::calc-tab-width grob) + (let ((width (ly:stem-tremolo::calc-width grob)) + (staff-space (ly:staff-symbol-staff-space grob))) + (/ width staff-space)))