From: Carl Sorensen Date: Sun, 7 Nov 2010 04:27:44 +0000 (-0600) Subject: Improve tablature -- tie-follow and harmonics X-Git-Tag: release/2.13.42-1~17^2~8 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=388b4b395956457f6a89232622e1250f4cd7836a;p=lilypond.git Improve tablature -- tie-follow and harmonics Create tab-tie-follow-engraver to display tab-note-heads as cautionary after ties and before slurs and glissandi Make new tab-note-head callback that handles harmonic and cautionary display of tab-note-heads Eliminate tab-harmonic-engraver and HarmonicParenthesesItem Add 'harmonic-properties and 'cautionary-properties to TabNoteHead 'details Add harmonic by fret and harmonic by ratio to tablatures Center TabNoteHead columns, instead of left-justifying them. --- diff --git a/input/regression/tablature-harmonic-functions.ly b/input/regression/tablature-harmonic-functions.ly new file mode 100644 index 0000000000..84f90da1bc --- /dev/null +++ b/input/regression/tablature-harmonic-functions.ly @@ -0,0 +1,50 @@ +\version "2.13.42" + +\header { + texidoc = " +Harmonics can be specified either by ratio or by fret number. +" +} + +test = { + e,4 + \harmonicByRatio #1/2 e,\6 + \harmonicByRatio #1/3 a,\5 + \harmonicByRatio #2/3 d,\4 | + \harmonicByRatio #1/4 { g8\3 b\2 e'\1 b\2 < g b e >2 } | + e,1 | % check whether tab note head is restored + \harmonicByFret #12 e'4\1 ~ + \harmonicByFret #12 e'4\1 ( + \ottava #1 + \harmonicByFret #7 e'4\1) + \harmonicByFret #5 e'8\1 + \ottava #2 + \harmonicByFret #4 < b\2 e'\1 >8 | + \harmonicByFret #3 < g\3 b\2 e'\1 >4 + \harmonicByFret #2.7 < g\3 b\2 e'\1 >4 + \harmonicByFret #2.3 < g\3 b\2 e'\1 >4 + \harmonicByFret #2 < g\3 b\2 e'\1 >4 | + \ottava #0 + e,1 | % check whether tab note head is restored +} + +\paper { + ragged-right = ##f +} + +\score { + << + \new Staff { + \new Voice { + \clef "treble_8" + \override Voice.StringNumber #'transparent = ##t + \test + } + } + \new TabStaff { + \new TabVoice { + \test + } + } + >> +} diff --git a/input/regression/tablature-tie-spanner.ly b/input/regression/tablature-tie-spanner.ly new file mode 100644 index 0000000000..2c9c5eb51f --- /dev/null +++ b/input/regression/tablature-tie-spanner.ly @@ -0,0 +1,31 @@ +\version "2.13.42" + +\header { + texidoc = " +If a slur or a glissando follows a tie, the +corresponding fret number is displayed in parentheses. +" +} + +music = { + c'4 ~ c'4 ( d'2 ) | + c'4 ~ c'4 \glissando d'2 | + c'4 ~ c'4 d'2 | + c'4 \glissando d'2. | +} + +\score { + << + \new Staff { + \new Voice { + \clef "G_8" + \music + } + } + \new TabStaff { + \new TabVoice { + \music + } + } + >> +} diff --git a/lily/tab-harmonic-engraver.cc b/lily/tab-harmonic-engraver.cc deleted file mode 100644 index a6e226dd3e..0000000000 --- a/lily/tab-harmonic-engraver.cc +++ /dev/null @@ -1,90 +0,0 @@ -/* - This file is part of LilyPond, the GNU music typesetter. - - Copyright (C) 2005--2010 Han-Wen Nienhuys - - - 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 . -*/ - -#include "engraver.hh" - -#include "item.hh" -#include "pointer-group-interface.hh" -#include "simple-closure.hh" -#include "stream-event.hh" -#include "warn.hh" - -#include "translator.icc" - -class Tab_harmonic_engraver : public Engraver -{ - TRANSLATOR_DECLARATIONS (Tab_harmonic_engraver); - -protected: - DECLARE_ACKNOWLEDGER (note_head); -}; - -Tab_harmonic_engraver::Tab_harmonic_engraver () -{ -} - -void -Tab_harmonic_engraver::acknowledge_note_head (Grob_info info) -{ - if (Stream_event *note = info.event_cause ()) - { - for (SCM s = note->get_property ("articulations"); - scm_is_pair (s); s = scm_cdr (s)) - { - Stream_event *ev = unsmob_stream_event (scm_car (s)); - - if (!ev) - continue; - - - if (ev->in_event_class ("harmonic-event")) - { - if (Item *victim = info.item ()) - { - Engraver *eng = dynamic_cast (info.origin_translator ()); - Item *paren = eng->make_item ("HarmonicParenthesesItem", victim->self_scm ()); - Pointer_group_interface::add_grob (paren, ly_symbol2scm ("elements"), victim); - - paren->set_parent (victim, Y_AXIS); - - Real size = robust_scm2double (paren->get_property ("font-size"), 0.0) - + robust_scm2double (victim->get_property ("font-size"), 0.0); - paren->set_property ("font-size", scm_from_double (size)); - } - } - } - } -} - -ADD_ACKNOWLEDGER (Tab_harmonic_engraver, note_head); -ADD_TRANSLATOR (Tab_harmonic_engraver, - /* doc */ - "In a tablature, parenthesize objects whose music cause has" - " the @code{parenthesize} property.", - - /* create */ - "HarmonicParenthesesItem ", - - /* read */ - "", - - /* write */ - "" - ); diff --git a/lily/tab-tie-follow-engraver.cc b/lily/tab-tie-follow-engraver.cc new file mode 100644 index 0000000000..fcf9965cff --- /dev/null +++ b/lily/tab-tie-follow-engraver.cc @@ -0,0 +1,131 @@ +/* + This file is part of LilyPond, the GNU music typesetter. + + Copyright (C) 2010 Carl D. Sorensen + + 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 . +*/ + +#include +#include + +#include "engraver.hh" + +using namespace std; + +#include "context.hh" +#include "item.hh" +#include "spanner.hh" + +#include "translator.icc" + +/* + Change tab-note-head properties when a tie is followed by a + slurs or glissando. +*/ +class Tab_tie_follow_engraver : public Engraver +{ + vector slurs_; + vector glissandi_; + vector note_heads_; + +public: + TRANSLATOR_DECLARATIONS (Tab_tie_follow_engraver); + +protected: + DECLARE_ACKNOWLEDGER (glissando); + DECLARE_ACKNOWLEDGER (slur); + DECLARE_ACKNOWLEDGER (tab_note_head); + + void stop_translation_timestep (); +}; + +Tab_tie_follow_engraver::Tab_tie_follow_engraver () +{ +} + +void +Tab_tie_follow_engraver::acknowledge_glissando (Grob_info info) +{ + glissandi_.push_back (info.spanner ()); +} + +void +Tab_tie_follow_engraver::acknowledge_tab_note_head (Grob_info info) +{ + note_heads_.push_back (info.item ()); +} + +void +Tab_tie_follow_engraver::acknowledge_slur (Grob_info info) +{ + slurs_.push_back (info.spanner ()); +} + +void +Tab_tie_follow_engraver::stop_translation_timestep () +{ + for (vsize k = 0; k < note_heads_.size (); k++) + { + bool spanner_start = false; + for (vsize j = 0; j < slurs_.size (); j++) + { + Item* left_item = slurs_[j]->get_bound (LEFT); + if (left_item) + { + SCM left_cause = left_item->get_property ("cause"); + Item *slur_cause = unsmob_item (left_cause); + if (slur_cause == note_heads_[k]) + { + note_heads_[k]->set_property ("span-start", SCM_BOOL_T); + spanner_start = true; + break; + } + } + } + if (!spanner_start) + for (vsize j = 0; j < glissandi_.size (); j++) + { + Item *left_bound = glissandi_[j]->get_bound (LEFT); + if (left_bound == note_heads_[k]) + { + note_heads_[k]->set_property ("span-start", SCM_BOOL_T); + break; + } + } + } + slurs_.clear (); + glissandi_.clear (); + note_heads_.clear(); +} + +ADD_ACKNOWLEDGER (Tab_tie_follow_engraver, slur); +ADD_ACKNOWLEDGER (Tab_tie_follow_engraver, glissando); +ADD_ACKNOWLEDGER (Tab_tie_follow_engraver, tab_note_head); + + +ADD_TRANSLATOR (Tab_tie_follow_engraver, + /* doc */ + "Adjust TabNoteHead properties when a tie is followed" + " by a slur or glissando.", + + /* create */ + " ", + + /* read */ + " ", + + /* write */ + " " + ); diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index f2ca7c3e46..26f0de3706 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -724,7 +724,7 @@ context." \name "TabVoice" \alias "Voice" \consists "Tab_note_heads_engraver" - \consists "Tab_harmonic_engraver" + \consists "Tab_tie_follow_engraver" \remove "Note_heads_engraver" \remove "Fingering_engraver" @@ -788,6 +788,7 @@ context." \override Hairpin #'transparent = ##t \override Script #'stencil = ##f \override TextScript #'stencil = ##f + \override Glissando #'stencil = #glissando::draw-tab-glissando %% the direction for glissando lines will be automatically corrected \override Glissando #'extra-dy = #glissando::calc-tab-extra-dy \override Glissando #'bound-details #'right = #`((attach-dir . ,LEFT) @@ -827,8 +828,6 @@ contexts and handles the line spacing, the tablature clef etc. properly." \override Clef #'stencil = #clef::print-modern-tab-if-set %% no time signature \override TimeSignature #'stencil = ##f - %% better parentheses in a TabStaff - \override ParenthesesItem #'stencils = #parentheses-item::calc-tabstaff-parenthesis-stencils %% no arpeggios \override Arpeggio #'stencil = ##f %% we ignore collision warnings that may occur due to diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly index 4a58f05522..67ff1282d4 100644 --- a/ly/music-functions-init.ly +++ b/ly/music-functions-init.ly @@ -302,7 +302,33 @@ grace = #(def-grace-function startGraceMusic stopGraceMusic (_i "Insert @var{music} as grace notes.")) - +harmonicByFret = #(define-music-function (parser location fret music) (number? ly:music?) + (let* ((fret (number->string fret)) + (pitch (fret->pitch fret))) + (make-sequential-music + (list + #{ + \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret) + #} + (make-harmonic + (calc-harmonic-pitch pitch music)) + #{ + \revert TabNoteHead #'stencil + #})))) + +harmonicByRatio = #(define-music-function (parser location ratio music) (number? ly:music?) + (let ((pitch (ratio->pitch ratio)) + (fret (ratio->fret ratio))) + (make-sequential-music + (list + #{ + \override TabNoteHead #'stencil = #(tab-note-head::print-custom-fret-label $fret) + #} + (make-harmonic + (calc-harmonic-pitch pitch music)) + #{ + \revert TabNoteHead #'stencil + #})))) instrumentSwitch = #(define-music-function diff --git a/ly/property-init.ly b/ly/property-init.ly index b08c572497..3bed8193a3 100644 --- a/ly/property-init.ly +++ b/ly/property-init.ly @@ -453,6 +453,7 @@ tabFullNotation = { \revert TabVoice.MultiMeasureRestNumber #'transparent \revert TabVoice.MultiMeasureRestText #'transparent % markups etc. + \revert TabVoice.Glissando #'stencil \revert TabVoice.Script #'stencil \revert TabVoice.TextScript #'stencil \revert TabVoice.TextSpanner #'stencil diff --git a/scm/define-grob-interfaces.scm b/scm/define-grob-interfaces.scm index 735ccb9dcd..87aa26a212 100644 --- a/scm/define-grob-interfaces.scm +++ b/scm/define-grob-interfaces.scm @@ -87,6 +87,11 @@ note)." '(align-dir fret-diagram-details size dot-placement-list thickness)) +(ly:add-interface + 'glissando-interface + "A glissando." + '()) + (ly:add-interface 'grace-spacing-interface "Keep track of durations in a run of grace notes." @@ -206,7 +211,7 @@ interesting enough to maintain a hara-kiri staff." (ly:add-interface 'tab-note-head-interface "A note head in tablature." - '(details)) + '(details display-cautionary span-start)) (ly:add-interface 'trill-spanner-interface diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index 25519bca80..6097eb8f07 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -962,6 +962,7 @@ bounds are spaced.") (direction-source ,ly:grob? "In case @code{side-relative-direction} is set, which grob to get the direction from.") + (display-cautionary ,boolean? "Should the grob be displayed as a cautionary grob?") (dot ,ly:grob? "A reference to a @code{Dots} object.") (dots ,ly:grob-array? "Multiple @code{Dots} objects.") @@ -1013,6 +1014,7 @@ grobs.") (spacing ,ly:grob? "The spacing spanner governing this section.") (spacing-wishes ,ly:grob-array? "An array of note spacing or staff spacing objects.") + (span-start ,boolean? "Is the note head at the start of a spanner?") (staff-grouper ,ly:grob? "The staff grouper we belong to.") (staff-symbol ,ly:grob? "The staff symbol grob that we are in.") (stem ,ly:grob? "A pointer to a @code{Stem} object.") diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index c5c6d1094f..82636f3288 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -818,7 +818,8 @@ (Y-extent . #f) (zigzag-width . 0.75) (meta . ((class . Spanner) - (interfaces . (line-interface + (interfaces . (glissando-interface + line-interface line-spanner-interface unbreakable-spanner-interface)))))) @@ -877,15 +878,6 @@ self-alignment-interface spanner-interface)))))) - (HarmonicParenthesesItem - . ( - (padding . 0) - (stencil . ,parentheses-item::print) - (stencils . ,parentheses-item::calc-angled-bracket-stencils) - (meta . ((class . Item) - (interfaces . (font-interface - parentheses-interface)))))) - (HorizontalBracket . ( (bracket-flare . (0.5 . 0.5)) @@ -1951,13 +1943,24 @@ (details . ((tied-properties . ((break-visibility . ,begin-of-line-visible) (parenthesize . #t))) (repeat-tied-properties . ((note-head-visible . #t) - (parenthesize . #t))))) + (parenthesize . #t))) + (harmonic-properties . ((angularity . 2) + (half-thickness . 0.075) + (padding . 0) + (procedure . ,parenthesize-stencil) + (width . 0.25))) + (cautionary-properties . ((angularity . 0.4) + (half-thickness . 0.075) + (padding . 0) + (procedure . ,parenthesize-stencil) + (width . 0.25))))) + (direction . ,CENTER) (duration-log . ,note-head::calc-duration-log) (font-series . bold) (font-size . -2) (stem-attachment . (0.0 . 1.35)) - (stencil . ,ly:text-interface::print) + (stencil . ,tab-note-head::print) (whiteout . #t) (X-offset . ,ly:self-alignment-interface::x-aligned-on-self) (Y-offset . ,ly:staff-symbol-referencer::callback) diff --git a/scm/lily.scm b/scm/lily.scm index d4a0b23846..00e8308812 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -425,6 +425,7 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "flag-styles.scm" "fret-diagrams.scm" + "tablature.scm" "harp-pedals.scm" "define-woodwind-diagrams.scm" "display-woodwind-diagrams.scm" @@ -439,7 +440,6 @@ LilyPond safe mode. The syntax is the same as `define*-public'." "paper.scm" "backend-library.scm" "x11-color.scm" - "tablature.scm" ;; must be after everything has been defined "safe-lily.scm")) diff --git a/scm/tablature.scm b/scm/tablature.scm index 7845f21927..83ad8bdf31 100644 --- a/scm/tablature.scm +++ b/scm/tablature.scm @@ -66,7 +66,7 @@ (if (and (symbol? style) (eq? style 'cross)) (stencil-whiteout (ly:note-head::print grob)) - (ly:text-interface::print grob)))) + (tab-note-head::print grob)))) ;; definitions for the "moderntab" clef: ;; the "moderntab" clef will be added to the list of known clefs, @@ -134,129 +134,274 @@ -0.75 0.75))) -;; for ties in tablature, fret numbers that are tied to should be invisible, -;; except for 'tied to' numbers after a line break;; these will be -;; parenthesized (thanks to Neil for his solution): -(define-public (parenthesize-tab-note-head grob) - ;; Helper function to parenthesize tab noteheads, - ;; since we can't use ParenthesesItem at this stage - ;; This is basically the same as the C++ function - ;; in accidental.cc, converted to Scheme - (let* ((font (ly:grob-default-font grob)) - (open (stencil-whiteout - (ly:font-get-glyph font "accidentals.leftparen"))) - (close (stencil-whiteout - (ly:font-get-glyph font "accidentals.rightparen"))) - (me (ly:text-interface::print grob))) - - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge me X LEFT open) X RIGHT close))) - -;; ParenthesesItem doesn't work very well for TabNoteHead, since -;; the parentheses are too small and clash with the staff-lines -;; Define a callback for the 'stencils property which will tweak -;; the parentheses' appearance for TabNoteHead -(define-public (parentheses-item::calc-tabstaff-parenthesis-stencils grob) - ;; the grob we want to parenthesize - (let ((victim (ly:grob-array-ref (ly:grob-object grob 'elements) 0))) - - ;; check whether it's a note head - (if (grob::has-interface victim 'note-head-interface) - (begin - ;; tweak appearance before retrieving - ;; list of stencils '(left-paren right-paren) - ;; get the font-size from victim (=TabNoteHead) to handle - ;; grace notes properly - (ly:grob-set-property! grob 'font-size - (ly:grob-property victim 'font-size)) - (ly:grob-set-property! grob 'padding 0) - ;; apply whiteout to each element of the list - (map stencil-whiteout - (parentheses-item::calc-parenthesis-stencils grob))) - (parentheses-item::calc-parenthesis-stencils grob)))) - ;; the handler for ties in tablature; according to TabNoteHead #'details, ;; the 'tied to' note is handled differently after a line break (define-public (tie::handle-tab-note-head grob) (let* ((original (ly:grob-original grob)) (tied-tab-note-head (ly:spanner-bound grob RIGHT)) + (spanner-start (ly:grob-property tied-tab-note-head 'span-start #f)) (siblings (if (ly:grob? original) (ly:spanner-broken-into original) '()))) - (if (and (>= (length siblings) 2) - (eq? (car (last-pair siblings)) grob)) - ;; tie is split -> get TabNoteHead #'details - (let* ((details (ly:grob-property tied-tab-note-head 'details)) - (tied-properties (assoc-get 'tied-properties details '())) - (tab-note-head-parenthesized (assoc-get 'parenthesize tied-properties #t)) - ;; we need the begin-of-line entry in the 'break-visibility vector - (tab-note-head-visible - (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 - (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 + (if spanner-start + ;; tab note head is right bound of a tie and left of spanner, + ;; -> parenthesize it at all events (begin - (ly:grob-set-property! tied-tab-note-head 'transparent #t) - (ly:grob-set-property! tied-tab-note-head 'whiteout #f))))) + (ly:grob-set-property! tied-tab-note-head 'display-cautionary #t) + (ly:grob-set-property! tied-tab-note-head 'stencil tab-note-head::print)) + ;; otherwise, check whether tie is split: + (if (and (>= (length siblings) 2) + (eq? (car (last-pair siblings)) grob)) + ;; tie is split -> get TabNoteHead #'details + (let* ((details (ly:grob-property tied-tab-note-head 'details)) + (tied-properties (assoc-get 'tied-properties details '())) + (tab-note-head-parenthesized (assoc-get 'parenthesize tied-properties #t)) + ;; we need the begin-of-line entry in the 'break-visibility vector + (tab-note-head-visible + (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 + (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))) + + ;; tie is not split + (ly:grob-set-property! tied-tab-note-head 'transparent #t))))) + + ;; repeat ties occur within alternatives in a repeat construct; ;; TabNoteHead #'details handles the appearance in this case (define-public (repeat-tie::handle-tab-note-head grob) (let* ((tied-tab-note-head (ly:grob-object grob 'note-head)) - (details (ly:grob-property tied-tab-note-head 'details)) - (repeat-tied-properties (assoc-get 'repeat-tied-properties details '())) - (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 - (begin - (ly:grob-set-property! tied-tab-note-head 'transparent #t) - (ly:grob-set-property! tied-tab-note-head 'whiteout #f))))) + (spanner-start (ly:grob-property tied-tab-note-head 'span-start #f))) + (if spanner-start + ;; tab note head is between a tie and a slur/glissando + ;; -> parenthesize it at all events + (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)) + ;; otherwise check 'details + (let* ((details (ly:grob-property tied-tab-note-head 'details)) + (repeat-tied-properties (assoc-get 'repeat-tied-properties details '())) + (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)))))) ;; the slurs should not be too far apart from the corresponding fret number, so -;; we move the slur towards the TabNoteHeads: +;; we move the slur towards the TabNoteHeads; moreover, if the left fret number is +;; the right-bound of a tie, we'll set it in parentheses: (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)) + (let* ((original (ly:grob-original grob)) + (left-bound (ly:spanner-bound original LEFT)) + (left-tab-note-head (ly:grob-property left-bound 'cause)) + (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))) + (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))) +;; The glissando routine works similarly to the slur routine; if the +;; fret number is "tied to", it should become parenthesized. +(define-public (glissando::draw-tab-glissando grob) + (let* ((original (ly:grob-original grob)) + (left-tab-note-head (ly:spanner-bound original LEFT)) + (cautionary (ly:grob-property left-tab-note-head 'display-cautionary #f))) + + (and cautionary + ;; increase left padding to avoid collision between + ;; closing parenthesis and glissando line + (ly:grob-set-nested-property! grob '(bound-details left padding) 0.5)) + (ly:line-spanner::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))) + (staff-space (ly:staff-symbol-staff-space grob))) (/ width staff-space))) ;; a callback for custom fret labels (define-public ((tab-note-head::print-custom-fret-label fret) grob) - (grob-interpret-markup grob (markup #:vcenter fret))) + (ly:grob-set-property! grob 'text fret) + (tab-note-head::print grob)) + +(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))))) + + (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)) + (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)))) + + (if (is-harmonic? grob) + (set! output-grob (harmonic-proc output-grob + 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))) + +;; Harmonic definitions + +(define node-positions + ;; for the node on m/n-th of the string length, we get the corresponding + ;; (exact) fret position by calculating p=(-12/log 2)*log(1-(m/n)); + ;; since guitarists normally use the forth fret and not the 3.8th, here + ;; are rounded values, ordered by + ;; 1/2 + ;; 1/3 2/3 + ;; 1/4 2/4 3/4 etc. + ;; The value for 2/4 is irrelevant in practical, bacause the string sounds + ;; only one octave higher, not two, but since scheme normalizes the fractions + ;; anyway, these values are simply placeholders for easier indexing. + ;; 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 )) + +(define partial-pitch + (vector '(0 0 0) + '(1 0 0) + '(1 4 0) + '(2 0 0) + '(2 2 0) + '(2 4 0) + '(2 6 -1/2) + '(3 0 0) + '(3 1 0))) + +(define fret-partials + '(("0" . 0) + ("12" . 1) + ("7" . 2) + ("19" . 2) + ("5" . 3) + ("24" . 3) + ("4" . 4) + ("9" . 4) + ("16" . 4) + ("3" . 5) + ("2.7" . 6) + ("2.3" . 7) + ("2" . 8))) + +(define-public (ratio->fret ratio) + "Calculate a fret number given @var{ratio} for the harmonic." + (let* ((nom (numerator ratio)) + (den (denominator ratio)) + (index (+ (* (- den 2) + (- den 1) + 1/2) + nom -1))) + (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)))) + +(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)))) + +(define-public (calc-harmonic-pitch pitch music) + "Calculate the harmonic pitches in @var{music} given +@var{pitch} as the non-harmonic pitch." + (let ((es (ly:music-property music 'elements)) + (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)))) + 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))