X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftablature.scm;h=97f688c1d1e868d4242d3a085ab9d4856e3fddf3;hb=a6a51abfd0195a3cf7d6ea095cf69808852f21ce;hp=5dd774aac83f58d397caab89ee0156bb8a917bbf;hpb=d199c2786d16e1fc00bd17fd9b1a54a8312e2079;p=lilypond.git diff --git a/scm/tablature.scm b/scm/tablature.scm index 5dd774aac8..97f688c1d1 100644 --- a/scm/tablature.scm +++ b/scm/tablature.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2009--2011 Marc Hohl +;;;; Copyright (C) 2009--2015 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 @@ -23,17 +23,18 @@ (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, @@ -42,7 +43,7 @@ ;; 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." @@ -67,8 +68,8 @@ ;; 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 @@ -80,23 +81,33 @@ ;; (dotted) half notes to distinguish them from quarter notes: (define-public (tabvoice::make-double-stem-width-for-half-notes grob) (let ((X-extent (ly:stem::width grob))) - - ;; is the note a (dotted) half note? - (if (= 1 (ly:grob-property grob 'duration-log)) - ;; yes -> return double stem width - (cons (car X-extent) (+ 0.5 (* 2 (cdr X-extent)))) - ;; no -> return simple stem width - X-extent))) + ;; 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))) (define-public (tabvoice::draw-double-stem-for-half-notes grob) - (let ((stem (ly:stem::print grob))) - - ;; 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))) + (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: @@ -107,7 +118,7 @@ (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))) @@ -142,10 +153,10 @@ ;; 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))))) @@ -169,14 +180,14 @@ (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 @@ -196,7 +207,7 @@ (* 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))) @@ -223,56 +234,56 @@ ;; 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))) (or (pair? (filter (lambda (a) - (ly:in-event-class? a 'harmonic-event)) - arts)) - (eq? (ly:grob-property grob 'style) 'harmonic)))) + (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")) - (offset-factor (assoc-get 'head-offset details 3/5)) - (column-offset (* offset-factor - (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 @@ -290,13 +301,13 @@ ;; 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) @@ -332,25 +343,25 @@ (- 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 @@ -359,29 +370,29 @@ (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))