[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [PATCH] Add scheme engraver for StaffTab notation
|
From: |
Ricardo Wurmus |
|
Subject: |
Re: [PATCH] Add scheme engraver for StaffTab notation |
|
Date: |
Sun, 01 Mar 2015 15:31:31 +0100 |
I already implemented the following changes:
- added context definitions for \midi in addition to \layout
- restricted maximum line length to 80 chars
Attached is a new patch.
I suppose this engraver should be documented somewhere, but I'm not sure
which of the many files under Documentation this should go to. Could
you please tell me the most appropriate location in the manual for
documenting this engraver? Is there a similar section in the manual
that I could use as a template (to know just how much it should
contain).
Are there other things you want me to change?
~~ Ricardo
>From e9686ff0e6534292278924de4ac1586e366adcd5 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <address@hidden>
Date: Mon, 23 Feb 2015 23:00:54 +0100
Subject: [PATCH] Add scheme engraver for StaffTab notation
The StaffTab notation is a system combining graphic elements of
tablature with standard music notation and Emmett Chapman's finger
symbols for notating tapping on a Chapman Stick.
---
ly/stafftab.ly | 50 +++++++
ly/string-tunings-init.ly | 19 +++
scm/lily.scm | 1 +
scm/stafftab-engraver.scm | 344 ++++++++++++++++++++++++++++++++++++++++++++++
4 files changed, 414 insertions(+)
create mode 100644 ly/stafftab.ly
create mode 100644 scm/stafftab-engraver.scm
diff --git a/ly/stafftab.ly b/ly/stafftab.ly
new file mode 100644
index 0000000..b0387d6
--- /dev/null
+++ b/ly/stafftab.ly
@@ -0,0 +1,50 @@
+\layout {
+ \context {
+ \Score
+ \accepts "StaffTab"
+ }
+ \context {
+ \Staff
+ \name "StaffTab"
+ \alias "Staff"
+ \denies "Voice"
+ \defaultchild "StickVoice"
+ \accepts "StickVoice"
+ \description "Same as @code{Staff} context, except that it is
+accommodated for typesetting a piece in StaffTab notation."
+ }
+ \context {
+ \Voice
+ \name "StickVoice"
+ \alias "Voice"
+ \description "Same as @code{Voice} context, except that it is
+accomodated for typesetting a piece in StaffTab notation."
+ \remove "Fingering_engraver"
+ \remove "New_fingering_engraver"
+ \consists #stafftab-engraver
+ }
+}
+
+\midi {
+ \context {
+ \Score
+ \accepts "StaffTab"
+ }
+ \context {
+ \Staff
+ \name "StaffTab"
+ \alias "Staff"
+ \denies "Voice"
+ \defaultchild "StickVoice"
+ \accepts "StickVoice"
+ \description "Same as @code{Staff} context, except that it is
+accommodated for typesetting a piece in StaffTab notation."
+ }
+ \context {
+ \Voice
+ \name "StickVoice"
+ \alias "Voice"
+ \description "Same as @code{Voice} context, except that it is
+accomodated for typesetting a piece in StaffTab notation."
+ }
+}
diff --git a/ly/string-tunings-init.ly b/ly/string-tunings-init.ly
index 034e9a2..1f2c969 100644
--- a/ly/string-tunings-init.ly
+++ b/ly/string-tunings-init.ly
@@ -85,8 +85,27 @@ for documentation purposes.")
\makeDefaultStringTuning #'cello-tuning \stringTuning <c, g, d a>
\makeDefaultStringTuning #'double-bass-tuning \stringTuning <e,, a,, d, g,>
+%% tunings for 12-string Chapman Stick
+\makeDefaultStringTuning #'stick-classic-tuning
+ \stringTuning <d' a e b, fis, cis, c,, g,, d, a, e b>
+\makeDefaultStringTuning #'stick-matched-reciprocal-tuning
+ \stringTuning <c' g d a, e, b,, c,, g,, d, a, e b>
+
+
defaultStringTunings = #(reverse! defaultStringTunings)
%% convert 5-string banjo tuning to 4-string by removing the 5th string
four-string-banjo = #(lambda (tuning)
(take tuning 4))
+
+%% convert 12-string Chapman Stick tuning to 10-string tuning
+ten-string-stick = #(lambda (tuning)
+ (append (list-head tuning 5)
+ (list-head (list-tail tuning 6) 5)))
+
+%% get either the bass or the melody string group
+stick-string-group = #(lambda (tuning group)
+ (let ((num (/ (length tuning) 2)))
+ (if (equal? group 'bass)
+ (list-head tuning num)
+ (list-tail tuning num))))
diff --git a/scm/lily.scm b/scm/lily.scm
index 6322e01..151e913 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -585,6 +585,7 @@ messages into errors.")
"define-grob-interfaces.scm"
"define-stencil-commands.scm"
"scheme-engravers.scm"
+ "stafftab-engraver.scm"
"titling.scm"
"text.scm"
diff --git a/scm/stafftab-engraver.scm b/scm/stafftab-engraver.scm
new file mode 100644
index 0000000..f280255
--- /dev/null
+++ b/scm/stafftab-engraver.scm
@@ -0,0 +1,344 @@
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2015 Ricardo Wurmus <address@hidden>
+;;;;
+;;;; 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 <http://www.gnu.org/licenses/>.
+
+(use-modules (srfi srfi-26))
+
+
+;; settings
+(define staff-padding-bass 2.5) ; Padding below bass staff
+(define staff-padding-melody 4.5) ; Padding above melody staff
+(define thickness 0.2) ; Thickness of note head outline
+(define spread 1.5) ; Scaling factor for spreading
+ ; string markers according to
+ ; their fret position
+
+
+(define (extract-property m)
+ "Extract finger or string number from music event."
+ (let ((name (ly:music-property m 'name)))
+ (cond
+ ((eq? name 'FingeringEvent)
+ (cons 'finger
+ (ly:music-property m 'digit)))
+ ((eq? name 'StringNumberEvent)
+ (cons 'string-number
+ (ly:music-property m 'string-number)))
+ (else #f))))
+
+(define (replace-note-head! grob finger filled?)
+ "Replace note head in GROB with FINGER-dependent note head."
+ (define (first)
+ "Draw a circular note head."
+ (let* ((radius 0.45)
+ (out-radius (+ radius (/ thickness 2))))
+ (ly:make-stencil
+ (list 'circle 0.45 thickness filled?)
+ (cons (- out-radius) out-radius)
+ (cons (- out-radius) out-radius))))
+
+ (define (second)
+ "Draw a diamond-shaped note head."
+ (ly:make-stencil
+ `(polygon (list -0.5 0.0
+ 0.0 0.5
+ 0.5 0.0
+ 0.0 -0.5)
+ ,thickness ,filled?)
+ (cons -0.5 0.5)
+ (cons 0 0)))
+
+ (define (third)
+ "Draw a triangular note head."
+ ;; adjust stem-attachment because downward facing stems are
+ ;; broken otherwise
+ (ly:grob-set-property!
+ grob
+ 'stem-attachment
+ (lambda (grob)
+ (let* ((stem (ly:grob-object grob 'stem))
+ (dir (ly:grob-property stem 'direction)))
+ (if (eq? UP dir)
+ '(1 . -0.5)
+ '(1 . 0.5)))))
+ (ly:make-stencil
+ `(polygon (list 0.0 0.4
+ 0.45 -0.4
+ -0.45 -0.4)
+ ,thickness ,filled?)
+ (cons -0.5 0.5)
+ (cons -1 1)))
+
+ (define (fourth)
+ "Draw a rectangular note head."
+ (let* ((width (- 1 thickness))
+ (edge (/ width 2))
+ (outer (+ edge (/ thickness 2))))
+ (ly:make-stencil
+ `(polygon (list ,edge ,edge
+ ,edge ,(- edge)
+ ,(- edge) ,(- edge)
+ ,(- edge) ,edge)
+ ,thickness ,filled?)
+ (cons (- outer) outer)
+ (cons (- outer) outer))))
+
+ ;; select the correct note head and replace stencil
+ (let ((stencil (list-ref
+ (list first second third fourth)
+ (- finger 1))))
+ (ly:grob-set-property! grob 'stencil (stencil))))
+
+
+(define-public (stafftab-engraver context)
+ "An engraver for StaffTab notation.
+
+1. Listen for a music-event: collect pitch, note fill status,
+finger, and string number for each encountered note and store them in
+an alist in *props-list*.
+
+2. Acknowledge note-head-interface: store all encountered note-head
+grobs in the global list *grobs* so that they can be accessed in the
+next stage
+
+3. Process acknowledged: modify grobs dependent on the collected
+properties. This includes replacing the note head, placing a string
+marker, as well as adding an empty fret marker with a list of
+accumulated fret positions to be displayed.
+
+4. Stop translation timestep: compute sorted fret marker text from
+previously collected fret positions.
+
+5. Start next translation timestep: reset all lists for the next
+iteration."
+ (let ((*grobs* '()) ; List of acknowleged grobs.
+
+ (*props-list* '()) ; Properties for each note at
+ ; current timestep.
+
+ (*previous-props-list* '()) ; Copy of *props-list* for
+ ; previous timestep.
+
+ (*adjust-later*
+ '((fret-grob . #f) ; Shared grob for fret numbers.
+ (properties . ()))) ; List of note properties needed
+ ; at the end of the timestep for
+ ; graphical adjustments.
+
+ ;; The tuning of this context (bass or melody side)
+ (tuning (reverse
+ (ly:context-property context 'stringTunings))))
+
+ (define (fret pitch string-number)
+ "Return fret number on the string STRING-NUMBER given PITCH."
+ (let* ((string (remainder (- string-number 1)
+ (length tuning)))
+ (root (list-ref tuning string))
+ (root-semi (ly:pitch-semitones root))
+ (pitch-semi (ly:pitch-semitones pitch)))
+ (- pitch-semi root-semi)))
+
+ (define (make-fret-marker trans string-number)
+ "Create and initialize a grob for fret position annotations in
+translation context TRANS. When STRING-NUMBER is greater than the
+number of strings in this string group, it relates to bass strings and
+thus has to be placed in the other direction."
+ (let* ((grob (ly:engraver-make-grob trans 'TextScript '()))
+ (bass? (> string-number (length tuning)))
+ (dir (if bass? DOWN UP))
+ (pad (if bass?
+ staff-padding-bass
+ staff-padding-melody)))
+ (for-each (lambda (pair)
+ (ly:grob-set-property! grob (car pair) (cdr pair)))
+ `((color . ,(x11-color 'DimGray))
+ (font-size . -5)
+ (side-axis . 0) ;centre align
+ (self-alignment-X . 0) ;centre align
+ (direction . ,dir)
+ (staff-padding . ,pad)))
+ grob))
+
+ (define (make-string-marker trans string-number)
+ "Add string marker for STRING-NUMBER in translation context
+TRANS."
+ (let* ((grob (ly:engraver-make-grob trans 'StringNumber '()))
+ (strings (length tuning))
+ (bass? (> string-number strings))
+ (marker (ly:make-stencil
+ (list 'embedded-ps
+ "gsave
+ currentpoint translate
+ newpath
+ 0 setlinecap
+ 0.05 setlinewidth
+ -1.2 0.2 moveto
+ 1.2 0.2 lineto
+ 1.2 -0.1 lineto
+ -1.2 -0.1 lineto
+ -1.2 0.2 lineto
+ stroke
+ grestore")
+ (cons -1.3 1.3)
+ (cons -0.1 0.2))))
+ ;; centre-align
+ (ly:grob-set-property! grob 'side-axis 0)
+ ;; replace stencil
+ (ly:grob-set-property! grob 'stencil marker)
+ ;; move marker to staff line
+ ;; - default placement on melody side equals to string 3
+ ;; - default placement on bass side equals to third bass string
+ ;; (9 on a Grand, 8 on a 10-string)
+ (ly:grob-set-property! grob 'Y-offset
+ (- (+ 3 (if bass? strings 0))
+ string-number))
+ grob))
+
+ (define (add-properties! new? alist)
+ "Add a property list ALIST to the current object in
+*props-list*. If NEW? is true, the properties are added to a new
+object."
+ (set! *props-list*
+ (if new?
+ (cons alist *props-list*)
+ (if (null? *props-list*)
+ (list alist)
+ (let ((current (car *props-list*)))
+ (cons (append alist current)
+ (cdr *props-list*)))))))
+
+ (define (process-note! trans total index grob props)
+ "Render a note in the translator context TRANS given an
+acknowledged GROB, a property list PROPS and an INDEX to look up the
+matching previous note in a chord of TOTAL notes."
+ (let* ((prev (if (> (length *previous-props-list*) index)
+ (list-ref *previous-props-list* index)
+ #f))
+ (filled? (assoc-ref props 'filled?))
+ (pitch (assoc-ref props 'pitch))
+ (finger (or (assoc-ref props 'finger)
+ (and prev (assoc-ref prev 'finger)) 1))
+ (string-number (or (assoc-ref props 'string-number)
+ (and prev (assoc-ref
+ prev 'string-number)))))
+ (replace-note-head! grob finger filled?)
+ (if string-number
+ (let ((fret-no (fret pitch string-number))
+ (string-marker (make-string-marker trans
+ string-number)))
+ (if (> fret-no 0)
+ (begin
+ ;; If this is the first note in this timestep to
+ ;; need fret annotations, initialise the shared
+ ;; fret-marker first.
+ (if (not (assoc-ref *adjust-later* 'fret-grob))
+ (assoc-set! *adjust-later* 'fret-grob
+ (make-fret-marker trans string-number)))
+ ;; Record fret position + string number + string
+ ;; marker for later adjustment
+ (assoc-set! *adjust-later* 'properties
+ (cons (list fret-no
+ string-number
+ string-marker)
+ (assoc-ref *adjust-later*
+ 'properties)))))))))
+
+ (make-engraver
+ (listeners
+ ((music-event trans event)
+ (let* ((m (ly:event-property event 'music-cause))
+ (name (ly:music-property m 'name)))
+ (if (eq? name 'NoteEvent)
+ ;; create a new object to collect data
+ ;; whenever a note-event is encountered
+ (add-properties!
+ 'as-new-note
+ (append
+ (list
+ (cons 'pitch
+ (ly:event-property event 'pitch))
+ (cons 'filled?
+ (ly:moment<? (ly:music-duration-length m)
+ (ly:make-moment 1 2))))
+ ;; if this event has articulations, get the finger
+ ;; and string number from the inner music object
+ (delq #f
+ (map extract-property
+ (ly:music-property m 'articulations)))))
+ ;; otherwise add properties to existing object
+ (let ((prop (extract-property m)))
+ (if prop (add-properties! #f (list prop))))))))
+
+ (acknowledgers
+ ((note-head-interface trans grob source)
+ (set! *grobs* (cons grob *grobs*))))
+
+ ((process-acknowledged trans)
+ (if (and (not (null? *grobs*))
+ (= (length *grobs*)
+ (length *props-list*)))
+ (begin
+ (for-each (cute process-note!
+ trans (length *props-list*) <...>)
+ (iota (length *props-list*))
+ *grobs*
+ *props-list*)
+ ;; clear grobs now or we will never get past this step
+ (set! *grobs* '()))))
+
+ ;; Reset all state at the beginning of the timestep
+ ((start-translation-timestep trans)
+ (set! *previous-props-list* *props-list*)
+ (set! *props-list* '())
+ (set! *adjust-later* (list (cons 'fret-grob #f)
+ (cons 'properties '()))))
+
+ ;; Perform final graphical adjustments
+ ((stop-translation-timestep trans)
+ (let ((fret-grob (assoc-ref *adjust-later* 'fret-grob))
+ (props (assoc-ref *adjust-later* 'properties)))
+
+ ;; Display fret numbers in string order.
+ (if fret-grob
+ (let* (;; sort on string number (cadr of each pair)
+ (sorted (sort props (lambda (a b)
+ (< (cadr a) (cadr b)))))
+ ;; join all fret numbers with a dot
+ (text (string-join (map (lambda (p)
+ (number->string (car p)))
+ sorted) ".")))
+ ;; update text
+ (ly:grob-set-property! fret-grob 'text text)))
+
+ ;; Adjust the string markers for chords
+ ;; - those with lower fret number should be pushed left
+ ;; - those with higher fret number should be pushed right
+ (let ((frets (map car props)))
+ (if (> (length frets) 1)
+ (let* ((low (apply min frets))
+ (high (apply max frets))
+ (range (- high low)))
+ (if (not (zero? range))
+ (for-each
+ (lambda (p)
+ (let* ((string-marker (caddr p))
+ (fret-no (car p))
+ (offset (/ (- fret-no low (/ range 2))
+ range)))
+ (ly:grob-set-property! string-marker
+ 'X-offset
+ (* spread offset))))
+ props))))))))))
--
2.1.0
- Re: [PATCH] Add scheme engraver for StaffTab notation,
Ricardo Wurmus <=