--- /dev/null
+/*
+ tab-harmonic-engraver.cc -- implement Tab_harmonic_engraver
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2005--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+*/
+
+#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<Engraver*> (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 */ "Parenthesize objects whose music cause has the @code{parenthesize} "
+ "property.",
+
+ /* create */
+ "HarmonicParenthesesItem ",
+ /* read */ "",
+ /* write */ "");
\name "TabVoice"
\alias "Voice"
\consists "Tab_note_heads_engraver"
+ \consists "Tab_harmonic_engraver"
+
\remove "Note_heads_engraver"
\remove "Fingering_engraver"
\remove "New_fingering_engraver"
directions, this amount is the correction for two normal sized stems
that overlap completely.")
(stencil ,ly:stencil? "The symbol to print.")
+ (stencils ,list? "Multiple stencils, used as intermediate value.")
(strict-note-spacing ,boolean? "If set, unbroken columns
with non-musical material (clefs, barlines, etc.) are not spaced
separately, but put before musical columns.")
(ParenthesesItem
. ((stencil . ,parentheses-item::print)
+ (stencils . ,parentheses-item::calc-parenthesis-stencils)
(font-size . -6)
(padding . 0.2)
(meta . ((class . Item)
(interfaces . (parentheses-interface font-interface))))
))
+
+ (HarmonicParenthesesItem
+ . ((stencil . ,parentheses-item::print)
+ (padding . 0)
+ (stencils . ,parentheses-item::calc-angled-bracket-stencils)
+ (meta . ((class . Item)
+ (interfaces . (parentheses-interface font-interface))))
+ ))
(PhrasingSlur
. ((details . ,default-slur-details)
(interfaces . (side-position-interface
system-start-delimiter-interface))))))
-
(TabNoteHead
. (
(stencil . ,ly:text-interface::print)
(Y-offset . ,ly:staff-symbol-referencer::callback)
+ (X-offset . ,ly:self-alignment-interface::x-aligned-on-self)
+ (direction . 0)
(font-size . -2)
(stem-attachment . (0.0 . 1.35))
(font-series . bold)
(define-markup-command (whiteout layout props arg) (markup?)
"Provide a white underground for @var{arg}"
- (let* ((stil (interpret-markup layout props arg))
- (white
- (interpret-markup layout props
- (make-with-color-markup
- white
- (make-filled-box-markup
- (ly:stencil-extent stil X)
- (ly:stencil-extent stil Y)
- 0.0)))))
-
- (ly:stencil-add white stil)))
+ (stencil-whiteout (interpret-markup layout props arg)))
(define-markup-command (pad-markup layout props padding arg) (number? markup?)
"Add space around a markup object."
;; The TabNoteHead tablatureFormat callback.
;; Compute the text grob-property
-(define-public (fret-number-tablature-format string tuning pitch)
- (make-whiteout-markup
- (make-vcenter-markup
- (number->string
- (- (ly:pitch-semitones pitch)
- (list-ref tuning
- ;; remove 1 because list index starts at 0 and guitar string at 1.
- (- string 1)))))))
+(define-public (fret-number-tablature-format string
+ context event)
+ (let*
+ ((tuning (ly:context-property context 'stringTunings))
+ (pitch (ly:event-property event 'pitch))
+ (is-harmonic (apply
+ functional-or
+ (map
+ (lambda (ev)
+ (eq? 'harmonic-event (ly:event-property ev 'class)))
+ (ly:event-property event 'articulations)))))
+
+
+ (make-whiteout-markup
+ (make-vcenter-markup
+ (format
+ "~a"
+ (- (ly:pitch-semitones pitch)
+ (list-ref tuning
+ ;; remove 1 because list index starts at 0 and guitar string at 1.
+ (- string 1))))))
+ ))
;; The 5-string banjo has got a extra string, the fifth (duh), wich
;; starts at the fifth fret on the neck. Frets on the fifth string
;; the "first fret" on the fifth string is really the sixth fret
;; on the banjo neck.
;; We solve this by defining a new fret-number-tablature function:
-(define-public (fret-number-tablature-format-banjo string tuning pitch)
+(define-public (fret-number-tablature-format-banjo string
+ context event)
+ (let*
+ ((tuning (ly:context-property context 'stringTuning))
+ (pitch (ly:event-property event 'pitch))
+ )
(make-whiteout-markup
(make-vcenter-markup
(let ((fret (- (ly:pitch-semitones pitch) (list-ref tuning (- string 1)))))
(number->string (cond
((and (> fret 0) (= string 5))
(+ fret 5))
- (else fret)))))))
+ (else fret))))))
+ ))
; default tunings for common string instruments
;; * Pitch Trill Heads
;; * Parentheses
+(define-public (parentheses-item::calc-parenthesis-stencils grob)
+ (let* (
+ (font (ly:grob-default-font grob))
+ (lp (ly:font-get-glyph font "accidentals.leftparen"))
+ (rp (ly:font-get-glyph font "accidentals.rightparen"))
+ )
+
+ (list lp rp)))
+
+
+(define (grob-text grob text)
+ (let*
+ ((layout (ly:grob-layout grob))
+ (defs (ly:output-def-lookup layout 'text-font-defaults))
+ (props (ly:grob-alist-chain grob defs)))
+
+ (ly:text-interface::interpret-markup
+ layout props text)))
+
+(define-public (parentheses-item::calc-angled-bracket-stencils grob)
+ (let* (
+ (font (ly:grob-default-font grob))
+ (lp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-text grob (ly:wide-char->utf-8 #x2329))
+ Y CENTER) X RIGHT))
+ (rp (ly:stencil-aligned-to (ly:stencil-aligned-to (grob-text grob (ly:wide-char->utf-8 #x232A))
+ Y CENTER) X LEFT))
+ )
+
+ (list (stencil-whiteout lp)
+ (stencil-whiteout rp))))
+
(define (parenthesize-elements grob . rest)
(let*
((refp (if (null? rest)
(car rest)))
(elts (ly:grob-object grob 'elements))
(x-ext (ly:relative-group-extent elts refp X))
-
- (font (ly:grob-default-font grob))
- (lp (ly:font-get-glyph font "accidentals.leftparen"))
- (rp (ly:font-get-glyph font "accidentals.rightparen"))
+ (stencils (ly:grob-property grob 'stencils))
+ (lp (car stencils))
+ (rp (cadr stencils))
(padding (ly:grob-property grob 'padding 0.1)))
(ly:stencil-add
))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
`(text ,font-metric ,text) (car b) (cdr b))))
(define-public (fontify-text-white scale font-metric text)
- "Set TEXT with scale factor s"
+ "Set TEXT with scale factor SCALE"
(let* ((b (ly:text-dimension font-metric text))
;;urg -- workaround for using ps font
(c `(white-text ,(* 2 scale) ,text)))
;;urg -- extent is not from ps font, but we hope it's close
(ly:make-stencil c (car b) (cdr b))))
+(define-public (stencil-with-color stencil color)
+ (ly:make-stencil
+ (list 'color color (ly:stencil-expr stencil))
+ (ly:stencil-extent stencil X)
+ (ly:stencil-extent stencil Y)))
+
+(define-public (stencil-whiteout stencil)
+ (let*
+ ((x-ext (ly:stencil-extent stencil X))
+ (y-ext (ly:stencil-extent stencil Y))
+
+ )
+
+ (ly:stencil-add
+ (stencil-with-color (ly:round-filled-box x-ext y-ext 0.0)
+ white)
+ stencil)
+ ))
+
(define-public (dimension-arrows destination)
"Draw twosided arrow from here to @var{destination}"
projects / lilypond.git / commitdiff